GEOLOGICAL SURVEY PROFESSIONAL PAPER 1172
Geoindex

By PATRICIA FULTON and HAROLD JOHNSON,

assisted by WILLARD L. MClNTOSH, MARGARET EISTER, LAWRENCE BALCERAK,

DONALD HANSON, RICHARD THOENSEN, and PEARL PORTER

GEOLOGICAL SURVEY PROFESSIONAL PAPER 1172

Data base and data-base management system 

for the index to geologic maps

UNITED STATES GOVERNMENT PRINTING OFFICE, WASHINGTON: 1982
UNITED STATES DEPARTMENT OF THE INTERIOR 

JAMES G. WATT, Secretary

GEOLOGICAL SURVEY

Dallas L. Peck, Director

Library of Congress catalog-card No. 82-600504

For sale by the Superintendent of Documents, U.S. Government Printing Office

Washington, D.C. 20402
CONTENTS

Abstract

Introduction

Acknowledgments

Data-base management system

Purpose

Text data

Map data

Storage and retrieval system

Data base

Text data

Map data

System specifications

Status of the system

References cited

Appendix A. System flowchart

Appendix B. Operational instructions

How to run the following:

comtape.ec

chkref

geofmt.ec

to-nbiD

concat

list tape contents

Listing 1. Example of list tape contents

tapedwg

dwgdisk

Listing 2. Example of rdtape.tcl

seldisk

dwgtape

versatec.ec

index versatec

Listing 3. Parameter cards for a Versatec plot

sort.vers.coor.ee

master

state optima

addrad

covert.ee

er.ec

inplot.ee

pn!6

bigsta

usmerg.ec

state to tape

pull off

backup

restore

verplot

Page 

1

1

1

1

1

3

4

4

6

7

7

10

10

10

10

10

11

11

11

9°.

25

29

29

29

30

31

32

32

33

32

34

34

35

36

36

37

37

38

38

38

39

39

39

40

40

41

42

42

42

43

44

44

Appendix B. Operational instructions -Continued

How to run the following -Continued

Listing 4. Formation of the command file for

verplot and an example command file

Listing 5. Commands for verplot

end plot

leerend

Unwind

outline

pattern

plot

reorg

scale

symbol

pin90

Listing 6. The 48 conterminous States and their

corresponding two-digit numbers that are

used for plotting individual States as used in

file stat90

Subroutine name:

rfskip chkref

/*] AQi"i f»Vllf T*PT

blankcheck_chkref

typecheck chkref

Exec com name: geofmt.ec

Subroutine name:

geofmt

geofmtS.qedx

geofmta.qedx

to nbiPP

Subroutine name:

main_concat

locate concat

modify concat

contrl_concat

File name: matrix

Page

45

48

48

48

48

48

48

49

49

50

50

51

CO

5?,

5?,

53

56

57

58

58

59

60

61

6?,

63

65

66

73

75

76

77

81

8?,

83

85

87

88

89

90

9?,

94

94

III
IV CONTENTS

Page

Appendixes: System specifications-Continued

Appendix C. Computer program reference-Continued

Program name:

tapedwg _______________________ 96 

dwgdisk ________________________ 103 

seldisk _______________________ 110 

dwgtape _______________________ 118

Exec_com name: versatec.ec _____________ 125

Program name: index_versatec ____________ 126

Subroutine name:

legend _______________________ 130 

rotate ________________________ 133 

rdftur __________________________ 134 

penchg _______________________ 135 

plotli _________________________ 135 

pllich ________________________ 137 

pltsel ________________________ 140 

ploteh ________________________ 141 

shade ________________________ 143 

srtdup _______________________ 144 

pattern _________________________ 146

Exec_com: sort.vers.coor.ee ______________ 147

Subroutine name:

pgml.vers.exthdr __________________ 149 

pgm2.vers.sequent _________________ 150 

pgmS.vers.merge __________________ 150

Program name: master __________________ 152

Subroutine name:

arcntr_master ____________________ 154 

weight_master ____________________ 158 

adjust_master _____________________ 158 

work_master _____________________ 159

Function name:

dist_master ______________________ 160 

ncross_master ____________________ 161

Subroutine name:

cntest_master _____________________ 161 

dm_master ______________________ 165

File name: areano ___________________ 165

Program name: state_optima _____________ 167

Subroutine name: optima _______________ 168

Exec_com name:

open_si.ec _____________________ 170 

close.ec _______________________ 171

Program name: addrad __________________ 171

Subroutine name:

optima_addrad ___________________ 174 

ibound_addrad ___________________ 176 

decoder_addrad __________________ 177 

srch20_addrad ___________________ 178 

icoder_addrad ___________________ 179 

srch30_addrad ___________________ 180 

rconv_addrad _____________________ 181 

dms __________________________ 183 

read2_addrad ___________________ 183 

srch40_addrad ___________________ 184 

read40_addrad ___________________ 185 

weight_addrad ___________________ 186 

center_addrad ___________________ 187 

ftnumber _______________________ 189

Exec_com name: covert.ec ________________ 190

File name: crfile _____________________ 191

Program name: setmas __________________ 192

Exec_com name:

gr.ec __________________________ 193

Page

Appendixes: System specifications-Continued

Appendix C. Computer program reference-Continued

Exec_com name-Continued

inplot.ec _____________————————— 195

Program name: pn!6 _____________———_ 196

Subroutine name:

pos ___________________________ 205 

plo ___________________________ 205 

plod __________________________ 206 

ploc6 _________________________ 207 

assoc _________________________ 209

Program name: bigsta _________———————— 210

Subroutine name:

outLbigsta ___________————————— 214 

out2_bigsta _____________________ 214 

bigcal_bigsta ______________————__ 215

Function name: irads_bigsta _____———————— 216

Subroutine name: prim_bigsta _________——__ 217

Function name: icards_bigsta _________—_ 218

Exec_com name: usmerg.ec _______—————_ 218

Program name: state_to_tape _________—_ 219

Subroutine name:

heading_state_to_tape _______—————_ 221 

up_file_number ___________——————__ 222 

sts_begin _____________________ 223

Exec_com name:

disk_to_tape_fb_retain.ec _____—————_ 225 

disk_to_tape_vbs_retain.ec ___—————__ 225 

list_state_tape.ec _________—————_ 225

Program name: pull_off ___________——_ 226

Subroutine name:

state_pull_off ___________________ 227 

se]5arate_pull_off _________________ 228

Exec_com name:

tape_to_disk_fb_retain.ec ____________ 230 

tape_to_disk_vbs_retain.ec ____————_ 230

Program name: backup ___________————__ 231

Exec_com name:

backup.ec ______________————————— 231 

dump.ec ________________________ 232

Subroutine name:

backupl _______________________ 232 

backup2 _______________________ 234

Program name: restore _____——————————— 235

Exec_com name: retrieve.ec _____________ 236

Program name: verplot ____________——_ 237

Subroutine name:

change_origin ____________——————__ 240 

change_width _______________——_ 242 

change_symbol _____________————__ 243 

scaleplot _______________—————_ 245 

pattern_verplot ________——————————— 246 

interpret_data ___________—————_ 247 

newpattern ____________———————— 248 

plotoutline _____________________ 253 

find_octal_number ___________———__ 258 

find_number ______________—————__ 259 

set_shade _____________________ 261 

plotlegend _____________________ 262 

plotfile _______________________ 267 

pattern ___________________—_ 280

Program name: pin90 ___________———_ 281

Subroutine name:

enlrg __________________________ 286 

indiv _________________________ 288
Appendixes: System specifications-Continued

Appendix C. Computer program reference-Continued 

Subroutine name-Continued

min_max _______________________ 290 

grid _________________________ 291 

plocv _________________________ 294

CONTENTS V

Page

Appendixes: System specifications-Continued

Appendix D. Formats and notes ___——————————— 297 

Format of refATM files _________________ 297 

Format of reference file ____——————————— 298 

Notes for entering card data ______________ 298

ILLUSTRATIONS

FIGURE 1. Sheet from the published Kentucky index, showing geologic maps whose scales range from smaller than 1:63,360 through and

including 1:250,000 ___________________________________________________________ 2

2. Part of a sheet of bibliographic references taken from the published Kentucky Index _______________________ 5

3. List of attributes (names of data fields) that constitute a record __________________________________ 6 

4, 5. Photographs of a CRT plot showing:

4. Areas of North Dakota for which geologic maps have been published at scales smaller than 1:63,360 __________ 8

5. Some areas of the United States that are covered by published geologic maps _______________________ 9 

6. Plot showing all the areas for which geologic maps have been published in the States of Idaho, Nevada, and Arizona _____ 12 

7, 8. Plots from the on-line data base showing areas geologically mapped in the United States:

7. After 1960 and published at a scale of 1:250,000 ______________________________________ 14

8. At scales larger than 1:250,000 __________________________________________________ 16 

9. Partial list of text data in card image form, for reference 90, Colorado ______________________________ 18 

10, 11. Map data in:

10. Cartesian coordinates for reference 90, Colorado _____________________________________ 18

11. Radians for reference 90, Colorado _____________________________________________ 18

12. Complete record for reference 90, Colorado _____________________________________________ 19

13. Table showing names of files in permanent storage _________________________________________ 20

14. Status map for the Geoindex, automatically generated monthly ___________________________——————— 21
CONVERSION FACTORS

Metric unit Inch-Pound equivalent

Length

millimeter (mm) 

meter (m) 

kilometer (km)

= 0.03937 inch (in) 

= 3.28 feet (ft) 

= .62 mile (mi)

Area

square meter (m2 ) 

square kilometer (km2 ) 

hectare (ha)

= 10.76 square feet (ft2 ) 

= .386 square mile (mi2 ) 

= 2.47 acres

Volume

cubic centimeter (cm3 ) 

liter (L) 

cubic meter (m3 ) 

cubic meter 

cubic hectometer (hm3 ] 

liter 

liter 

liter 

cubic meter

cubic meter

= 0.061 cubic inch (in3 ) 

= 61.03 cubic inches 

= 35.31 cubic feet (ft?) 

= .00081 acre-foot (acre-ft) 

= 810.7 acre-feet 

= 2.113 pints (pt) 

= 1.06 quarts (qt) 

= .26 gallon (gal) 

= .00026 million gallons (Mgal or 

10« gal) 

= 6.290 barrels (bbl) (1 bbl = 42 gal)

Weight

gram (g) 

gram 

metric tons (t) 

metric tons

= 0.035 ounce, avoirdupois (oz avdp) 

= .0022 pound, avoirdupois (Ib avdp) 

= 1.102 tons, short (2,000 Ib) 

rr 0.9842 ton, long (2,240 Ib)

Specific combinations

kilogram per square 

centimeter (kg/ cm2 ) 

kilogram per square 

centimeter 

cubic meter per second 

(mVs)

_ 0.96 atmosphere (atm)

— .98 bar (0.9*869 atm) 

= 35.3 cubic feet per second (ft3/s)

Metric unit

Specific

liter per second (L/s) 

cubic meter per second 

per square kilometer 

[(m3/s)/km2 ] 

meter per day (m/d)

meter per kilometer 

(m/km) 

kilometer per hour 

(km/h) 

meter per second (m/s) 

meter squared per day 

(mVd) 

cubic meter per second 

(m?/s) 

cubic meter per minute 

(m3/min)

liter per second (L/s) 

liter per second per 

meter [(L/s)/m] 

kilometer per hour 

(km/h) 

meter per second (m/s) 

gram per cubic 

centimeter (g/cm3 ) 

gram per square 

centimeter (g/cm2 ) 

gram per square 

centimeter

Inch-Pound equivalent

combinations — Continued

= .0353 cubic foot per second 

= 91.47 cubic feet per second per 

square mile [(ft3/s)/mi2 ]

= 3.28 feet per day (hydraulic 

conductivity) (ft/A) 

= 5.28 feet per mile (ft/mi)

— .9113 foot per second (ft/s)

— 3.28 feet per second

= 10.764 feet squared per day (ft2/d) 

(transmissivity) 

= 22.826 million gallons per day 

(Mgal/d) 

= 264.2 gallons per minute (gal/min)

= 15.85 gallons per minute 

= 4.83 gallons per minute per foot 

[(gal/min) /ft] 

— .62 mile per hour (mi/h)

= 62.43 pounds per cubic foot (Ib/ft3 ) 

= 2.048 pounds per square foot (lb/ft2 ) 

= .0142 pound per square inch (lb/in2 )

Temperature

degree Celsius (°C) 

degrees Celsius 

(temperature)

= 1.8 degrees Fahrenheit (°F) 

= [(1.8X°C)+1 32] degrees Fahrenheit

Any trade names in this publication are used for descriptive purposes only and do not constitute endorsement by the I'.S. Geological Survey.
GEOINDEX

By PATRICIA FULTON and HAROLD JOHNSON,

assisted by WlLLARD L. MclNTOSH,

MARGARET EISTER, LAWRENCE BALCERAK, DONALD HANSON, 

RICHARD THOENSEN, and PEARL PORTER

ABSTRACT

The acquisition and the dissemination of information are everincreasing problems for Federal agencies engaged in research. To 

facilitate the publication of its geologic index maps, the U.S. Geological 

Survey has moved toward computer-based operations. The index to 

geologic maps (Geoindex) has been established and developed as a data 

base and data-base management system that provides three main 

capabilities. The primary capability is to provide the means to generate 

rapidly geologic index maps for publication. A second capability is to 

provide users an immediate access to all items in the data base. The 

third capability is to provide nationwide summary information to 

policy makers.

INTRODUCTION

The first U.S. Geological Survey indexes to geologic 

maps were published in the 1940's. They consisted of 

State base maps at scales of 1:750,000 or 1:1,000,000 on 

which the outlines of published geologic maps were 

shown. By the mid-1960's, most of the indexes were out 

of date. Revision was delayed because of the rising cost 

of color printing (six press runs) and the mechanical difficulty of showing legibly the additional (doubled) 

coverage produced in the 1950's and 1960's.

Some of the problems were solved in the publication of 

the Montana index in 1969. Heretofore, geologic index 

maps had shown all the geologic coverage. In the Montana index, only maps equal or better in quality and comprehensiveness than the State geologic map were included. This limitation imposed a reasonable and standard criterion for determining what should be included 

in the index. All very small scale maps, as well as many 

sketchy or generalized maps, were omitted. Elimination 

of such material produced a more legible index without 

serious loss of geologic-map coverage. The revised index, like previous indexes, included both published and 

open-file maps of the U.S. Geological Survey, published 

maps of the State surveys, and maps published by other 

organizations.

When computer-assisted techniques were introduced, 

the project grew, and ideas continued to change and

evolve. Henceforth, maps published at the following 

scale ranges will be indexed on three separate sheets:

1. Scales of 1:24,000 and larger

2. Scales smaller than 1:24,000, through and including 

1:63,360

3. Scales smaller than 1:63,360, through and including 

1:250,000

ACKNOWLEDGMENTS

The authors thank Joseph Moses Botbol and Roger 

Bowen for their assistance in the use of the GRASP 

system. Diane Lewis and Karen Shallcross completed 

compilation and entered the data into the Geoindex data 

base; Jane Timmins typed the manuscript and arranged 

it in the proper sequence; James Fisher, Kevin Laurent, 

and Maryjon McAvery helped in writing the computer 

programs and in constructing the data base. All these 

people are from the U.S. Geological Survey.

We also thank William Strauss, Denise Maurer, and 

Ray Wisecarver of the Johns Hopkins Applied Physics 

Laboratory for their invaluable assistance in the 

digitization of the data.

THE DATA-BASE MANAGEMENT SYSTEM

PURPOSE

The primary purpose of the Geoindex Data-Base 

Management System is to generate geologic index maps 

as quickly as possible. These published reports are widely distributed to a large, diverse group. A published 

geologic index consists of a series of map sheets and accompanying text material. The Geoindex is constructed 

State by State. Each map sheet consists of a State base 

map on which the outlines of published geologic maps 

and identifying numbers are superimposed (Fulton and 

Mclntosh, 1977). Figure 1 shows a map sheet from the 

published index for the State of Kentucky.
GEOINDEX

FIGURE 1.-Sheet from the published Kentucky index, showing geologic maps

The text material is composed of bibliographic 

references, each of which is numbered to correspond to 

the number on the matching map outline. Figure 2 

shows part of a sheet of bibliographic text from the 

published index for the State of Kentucky.

Each index, then, contains the map outlines and 

bibliographic references for published geologic maps for 

one State. The reports are published in black and white 

and folded to a size that fits the standard file cabinet. 

Because the computer-based operations have introduced 

economies, geologic map indexes are distributed free to 

the public.

A second purpose of a data base in machine readable 

form is to furnish outside users a rapid access to all

items contained in the data base. This second function is 

required by a more specialized group of outside users. 

For example, some specialists in the Earth sciences 

have active projects and need immediate answers to 

their questions. Typically, the procedures involve the 

retrieval of selected items from the data base, followed 

by a series of manipulations, and finally a display of 

various combinations of text and graphics. Alternatively, some outside users whose projects are still in the 

planning stage need information that is contained in the 

data base but does not appear on the published geologic 

index map. To satisfy the two types of users, both text 

and map data are available online from the computer 

system. Aspects of this type of usage of the data-base
THE DATA-BASE MANAGEMENT SYSTEM

whose scales range from smaller than 1:63,360 through and including 1:250,000.

management system are discussed later, under Storage 

and Retrieval System.

A third purpose of the data-base management system 

is to provide nationwide information to policy makers. 

Under this concept, one can access the data base as a 

single entity covering the entire United States instead 

of accessing merely one State at a time. The system can 

present a comprehensive overview of the whole country, 

but all the details shown on State maps are still available. For example, the total area for which geologic 

maps are available in the United States can be computed. Such statistics are valuable for national planning.

To fulfill these requirements, the geologic map index 

exists in two very different forms: as computer files in 

the Geoindex data base, and as published reports. An additional reason for having two different forms is that as 

soon as data have been stored in a computer, new applications become feasible. As a result, computer resident 

data files serve a much larger community of users than 

previously imagined. Because the data files are in digital 

form, they become multifunctional in that retrievals 

from the files can assume totally different appearances. 

These additional capabilities more than justify the initial 

cost in creating machine readable map files.

GLOSSARY AND SYSTEM STRUCTURE

A technical dicussion of the data base structure first 

requires the definition of some of the terms (Honeywell 

Information Systems, Inc., 1978).
GEOINDEX

1. Data base. An integrated collection of data upon 

which operations (such as read, write, and revise) 

can be performed.

2. Data-base management system. A software 

system that accesses an integrated collection of 

data.

3. User. A person who retrieves, updates, or deletes 

data within the data base. Such a person actively 

maintains the data base.

4. Outside user. A person who retrieves data from the 

data base. This is a person who uses the system 

but does not maintain it.

5. Data model or schema. The description of the data 

base that defines the characteristics and organization of the data within the data base.

The Geoindex data base is a relational data base and is 

derived from the mathematical theory of relations. The 

Geoindex Data Base Management System is a relational 

data-base management system. This structure is a 

natural consequence of having the Geologic Retrieval 

and Synopsis Program (GRASP) as the primary storage 

and retrieval program of the system because GRASP 

organizes data in relational form. GRASP is discussed 

more fully in the section entitled Storage and Retrieval 

System. The relational form is essentially a matrix composed of the familiar rows and columns.

The mathematical terminology specific to a relational 

data base must also be defined:

6. File. A collection of organized data, a relation.

7. Record. A representative "row" of data, a tuple.

8. Attribute. Name of a data field within a record, a 

column of information.

9. Attribute value. Value of a data field within a 

record.

10. Domain. The set of all values a data field may 

assume.

11. Data submodel. User's definition of the data base. 

12 Data model. Total definition of the data base.

A relational data base is in matrix form where the 

tuples (records) constitute the rows and the attributes 

(data items) constitute the columns. All tuples within a 

given relation have the same format (all records within a 

file have the same format). This last statement is a 

definitive characteristic of a relational data base.

The Geoindex is both large and complex. Size, of 

course, contributes to complexity, but the major source 

of complexity is the nature of the data that the system 

must process. The data comprise two distinct types: text 

and graphics. A record ("row," definition 7) exists for 

each map. The attribute values (columns, definition 9) 

are composed of text data derived from the bibliographic 

reference and of graphic data derived from the map outline. See figures 1 and 2. The complete list of attributes 

handled by the data-base management system is shown 

in figure 3.

The data-base management system is functionally 

divided into four parts. The first part is composed of 

computer programs and procedures designed to perform two vital tasks. The first task is to capture and 

verify the data. The second task is to create the map 

sheets and bibliographic text sheets as camera copy 

ready for reproduction. The first part of the system will 

be discussed in the section Data Acquisition and the section Publication Copy. The second part of the system is 

composed of computer programs and procedures that 

have one task to accomplish. This part of the system 

loads the data as relations into files that are accessible to 

GRASP, the storage and retrieval program. The third 

part of the system consists of GRASP and several plot 

programs. This third part is described in the section 

Storage and Retrieval System. The fourth part of the 

system consists of computer programs and procedures 

that insure the safety and integrity of the data by providing backup files and permanent archival data 

storage.

The system flow chart, illustrated in Appendix A, 

shows the chronological work flow that is virtually identical with parts one through four mentioned.

DATA ACQUISITION

TEXT DATA

The text data for an individual State are received in 

draft form, which is somewhat similar to that shown in 

figure 2. Each draft is examined, and a list of questions 

is prepared to cover any errors, omissions, or ambiguities that would slow the actual data-entry process. 

This list is returned to the geologist who compiled the index map and who then clarifies the uncertainties. After 

questions are answered and this list is returned, the 

physical keying of the text begins. The attributes, or 

record items, entered at this time are listed as follows: 

Identification number, author, year, title, publisher, 

county or region, emphasis, scale, and series.

The text material is prepared offline in card-image 

form on key-to-disk devices. These are word-processor 

computer terminals, which function both as stand-alone, 

offline, data-entry stations and as communications terminals. Several types are available; however, each hardware unit includes a keyboard for data entry, a cathode 

ray tube (CRT) screen that displays the characters 

entered from the keyboard and messages sent from a 

computer, and dual flexible disks that store data. Line 

printers, some switch-selectable among the units, supply 

the necessary hard copy.
THE DATA-BASE MANAGEMENT SYSTEM

1. Swadley, W.C., 1972,

Geologic map of pario 

of the Lawrenceburg, 

Aurora, and Hooven 

quadrangles, Boone 

County, Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-989. 

1:24,000.

2. Gibbons, A.B., 1972,

Geologic map of parts 

of the Burlington and 

Addyston quadrangles, 

Boone County, Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-1025. 

1:24,000.

3. Luft, S.J., 1971,

Geologic map of part of 

the Covington 

quadrangle, northern 

Kentucky: U.S. Geol. 

Survey Geol. Quad. Map 

GQ-955. 1:24,QUO.

4. Gibbons, A.B., 1973,

Geologic map of parts 

of Newport and 

Wi thamsvi1le 

quadrangles, Campbell 

and Kenton Counties, 

Kentucky: U.S. Geol. 

Survey Geol. Quad. Map 

GQ-1072. 1:24,000.

5. Swadley, W.C., 1971,

Geologic map of part of 

the Rising Sun 

quadrangle, Boone 

County, Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-929. 

1:24,000.

6. Swadley, W.C., 1969, 

Geologic map of the 

Union quadrangle, Boone 

County, Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-779. 

1:24,000.

7. Luft, S.J., 1969,

Geologic map of the 

Independence 

quadrangle, Kenton and 

Boone Counties, 

Kentucky: U.S. Geol. 

Survey Geol. Quad. Map 

GQ-785. 1:24,000.

8. Gibbons, A.B., 1971, 

Geologic map of the 

Alexandria quadrangle, 

Campbell and Kenton 

Counties, Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-926. 

1:24,000.

9. Gibbons, A.B., Kohut,

J.J., and Weiss , M.P., 

1975, Geologic map of 

the New Richmond 

quadrangle, 

Kentucky-Ohio: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-1228. 

1 :24,000.

10. Kohut, J.J., Weiss, M.P., 

and Luft, S.J., 1973, 

Geologic map of the 

Laurel quadrangle, 

Ohio-Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-1075. 

1 :24,000.

11. Swadley, W.C., 1969,

Geologic map of parts 

of the Patriot and 

Florence quadrangles, 

north-central Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-846. 

1:24,000.

12. Swadley, W.C., 1969, 

Geologic map of the 

Verona quadrangle, 

north-central Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-819. 

1:24,000.

13. Luft, S.J., 1973,

Geologic map of the 

Walton quadrangle, 

north-central Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-1080. 

1:24,000.

14. Luft, S.J., 1970,

Geologic map of the De 

Mossville quadrangle, 

north-central Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-862. 

1:24,000.

15. Luft, S.J., 1972,

Geologic map of the 

Butler quadrangle, 

Pendleton and Campbell 

Counties, Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-982. 

1:24,000.

16. Luft, S.J., Osborne,

11.H. , and Weiss, M.P. , 

1973, Geologic map of 

the Moscow quadrangle, 

Ohio-Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-1069. 

1:24,000.

17. Osborne, R.H., Weiss,

M.P., and Outerbridge, 

W.F., 1973, Geologic 

map of the Felicity 

quadrangle, 

Ohio-Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-1063. 

1:24,000.

18. Outerbridge, W.F., Weiss, 

M.P., and Osborne, 

R.H., 1973, Geologic 

map of the Higginsport 

quadrangle,

Ohio-Kentucky, and part 

of the RusselIvi1le 

quadrangle, Mason 

County, Kentucky: U.S. 

Geol. Survey Geol. 

Quad. Map GQ-1065. 

1:24,000.

19. Palmquist, W.N., Jr., and 

Hall, F.R., 1960, 

Geologic map of Boone, 

Campbel1, Grant, 

Kenton, and Pendleton 

Counties, Kentucky: 

U.S. Geol. Survey 

Hydrol. Inv. At las 

HA-15. Map 1, 

1 :125,000.

20. Hall, F.R., and

Palmquist, W.N., Jr. , 

1960, Geologic map of 

Carrol 1, Gallatin, 

Henry, Owen, and 

Trimble Counties, 

Kentucky: U.S. Geol. 

Survey Hydrol. Inv. 

Atlas HA-23. Map 1, 

1:125,000.

21. Swadley, W.C., 1976,

Geologic map of part of 

the Carrol 1 ton 

quadrangle, Carroll and 

Trimble Counties, 

Kentucky: U.S. Geol. 

Survey Geol. Quad. Map 

GQ-1281. 1:24,000.

22. Swadley, W.C., 1973,

Geologic map of parts 

of the Vevay South and 

Vevay North 

quadrangles, 

north-central Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-1123. 

1:24,000.

23. Swadley, W.C., 1973, 

Geologic map of the 

Sanders quadrangle, 

north-central Kentucky: 

U.S. Geol. Survey Geol. 

Quad. Map GQ-1095. 

1:24,000.

FIGURE 2.-Part of a sheet of bibliographic references taken from the published Kentucky Index.
generally square

GEOINDEX

Each map is uniquely identified and has the following

list of attributes:

Mnemonic Attribute

id identifying number for the

bibliographic reference 

state name of the state 

author authors 

year year of publication 

title title 

county county or region 

publish publisher

series title of publication series 

emphasi type of geology - surficial, economic,

stratigraphic, oil, gas, coal, metal 

area area covered by map 

aunit dimension for area,

k i1ome t e r s

nlat extreme north latitude 

slat extreme south latitude 

wlong extreme west longitude 

elong extreme east longitude 

clat center point latitude 

clong center point longitude 

omaps other maps not included

i.e., title 

avail depositories where maps

obta ined 

base USGS topo, DMA-TC topo,

shaded relief

geology only geology shown on the map 

plate plate or map or sheet identification 

idstate FIPS state code

scale map scale - 1:24,000, 1:250,000, etc. 

idsub sub id number, i.e., more than one map 

ibound id number on the boundary outline

ties together text and graphic or

x,y f iles 

ispan secondary number on the boundary

outline further ties text to graphic

file 

othermap phrase used in Bibliography

FIGURE 3. - List of attributes (names of data fields) that constitute a record.

as outlines

can be

photomosaic,

After a line of text data is entered on the keyboard, it 

is stored on the diskette. At the option of the operator, 

the data are simultaneously listed a line at a time on the 

printer or listed all together at the end of a session. This 

printer list is then checked for errors. The operator corrects data by using a key-to-disk technique. When text 

data are as error free as possible, the data-entry devices 

are operated as computer terminals, and the data are 

transmitted directly from the diskette to permanent 

storage on a large host computer.

MAP DATA

The map data, as previously mentioned, are the 

outlines of published geologic maps. These map data are 

received from the geologist as ink or colored-pencil 

outlines overlaid on base maps. The base maps consist of 

green-line images printed on dimensionally stable 

plastic.

The computer group codes a matching base on a stable 

material in preparation for the digitization of county
THE DATA-BASE MANAGEMENT SYSTEM

outlines. These codes are the digits assigned to each 

county and State by the Federal Information Processing 

Standards Publications (FIPS PUBS). This digitization 

or conversion from graphics to machine-readable code is 

done manually on a type of drafting-table digitizer with 

a resolution of 0.025 mm (0.001 in.) (Fulton, 1975).

The lower left-hand corner of the neat line is 

designated as the origin, so that the entire map lies 

within the positive quadrant in the Cartesian coordinate 

system.

Only the end points of straight-line segments are 

recorded. Where the outlines are extremely convoluted, 

stream digitizing is performed and the spacing between 

points is generally about 1 mm (0.04 in.). The data are 

plotted for verification. Because of the complexity of the 

index maps, these plots must be drawn in different colors so that each outline and its identifying number is 

distinct.

PUBLICATION COPY

After the computer-generated plots for the Geoindex 

are judged acceptable, they need further processing to 

create the final version of the maps. The first few 

published indexes were drawn in black ink by means of a 

drum plotter. Several different pens created the various 

line weights so that overlapping areas could be 

distinguished.

Index maps convey information concerning areas. 

Shading portrays areal information very effectively. 

Thus, those who prepared the later maps took advantage of the newer technology inherent in a matrix plotter. Such a plotter now generates the final maps. This 

plotter has a resolution of 160 dots per inch and an effective plotting width of 18 in. To date, 10 different patterns supply sufficient contrast so that various mapped 

areas may be distinguished from one another. See figure

1. which shows a Kentucky map sheet listing the maps 

that range in scale from 1:63,360 through 1:250,000.

At the same time that the map plots are generated, 

the text data are processed. The file is in a machinereadable form almost identical with card-image form, 

but the final output must be in the traditional 

bibliographic form. This change is accomplished by processing the text data file through programs resident on 

a main-frame computer that strip out the extraneous 

data and codes and rearrange the order of the attributes 

(items). Then the modified file is transmitted over 

telephone lines back to the word-processor terminal. 

The final manuscript is printed on coated paper 

automatically. The map plots and text material are then 

sent for photographic reduction, a process that creates 

the photographic plates for mass production. See figure

2. which shows a copy of part of a sheet of text data from 

the published Kentucky index.

STORAGE AND RETRIEVAL SYSTEM

This storage and retrieval system is the Geologic 

Retrieval and Synopsis Program (GRASP), written and 

developed within the Geological Survey by Roger W. 

Bowen and Joseph Moses Botbol (1975). GRASP is used 

extensively within the U.S. Geological Survey. It has 

also been installed on the computers of national agencies 

of several countries in South America and Europe.

The GRASP system implements searches of the text 

files by individual items or by any combination of two or 

more items. All the references for the published geologic 

maps that meet the search criteria are retrieved. The entire contents of all the retrieved text records can be 

listed, or only one or two items can be selected. 

However, the boundary identification number, ibound, 

the bibliographic identification number, id, and the 

subidentification number, idsub, are the only items required to generate a graphic image. Thus, the numeric 

value of these three items are listed on a formatted disk 

file for subsequent plotting. The GRASP system is exited and the plot program pn16 is invoked. This program, too, executes in an interactive mode. Its options 

provide for plots of the State outline, the graticule, the 

county boundaries in solid or dotted lines, and, of 

course, the file of geologic-map outlines. These graphics 

can be plotted interactively on a CRT terminal and then 

printed by a hard-copy unit attached to the terminal.

After a map has been drawn on the CRT, information 

from other files may be added by direct overlay to the 

original graphic on the screen. In addition to the 

features already described, this program offers the opportunity to enlarge any part of the plot repetitively until a cluttered area becomes readable.

At present, the newly published geologic index maps 

are categorized according to scale. The retrieval can be 

executed in GRASP by designating the proper scale as 

the search criteria and querying the file. This first step 

in map generation from digital data is accomplished interactively on a graphics CRT terminal. This same file, 

which has been plotted interactively, can then be 

directed to a drum plotter for reproduction at the 

original scale. Figure 4 shows the maps published at 

scales smaller than 1:63,360 for the State of North 

Dakota as drawn on the CRT screen.

Several other programs enable a user to plot the entire United States. The programs take geographic coordinates from either a GRASP retrieval or directly from 

the map-data files. These programs convert the 

geographic coordinates to Cartesian coordinates. Then 

another plot program entitled pin90 operates in an interactive mode similar to that of pn16 to plot these files. 

It, too, has options for specifying various combinations 

of files and enlarging designated areas. Figure 5 shows 

a CRT plot of some areas covered by published maps.
FIGURE 4. - CRT plot for the State of North Dakota, showing geologic maps published at scales smaller than 1:63,360. The figure is a photograph 
THE DATA-BASE MANAGEMENT SYSTEM

o

03

£

•ao

O 

I
10 GEOINDEX

The system also utilizes some machine-independent 

plotting packages that were obtained specifically to provide diversity of output for the Geoindex as well as for 

the entire U.S. Geological Survey. Figure 6, which illustrates geologic mapping on a regional basis, is a map 

showing all the areas covered by geologic maps in the 

western States of Idaho, Nevada, and Arizona.

The storage and retrieval part of the Geoindex system 

has the capability of providing nationwide summary information to policy makers. Examples of maps that present information of special interest to national planners 

are shown in figures 7 and 8. Both of these maps were 

generated from queries to the Geoindex and show 

geologic mapping on a national basis. These maps 

reflect the data resident in the data base at the time of 

query. Figure 7 shows the areas in the United States 

covered by geologic maps that were published at a scale 

of 1:250,000 after 1960. It includes both U.S. Geological 

Survey maps and non-Survey maps. Figure 8 shows 

geologic maps from all sources that were published at 

scales larger than 1:250,000.

DATA BASE

STRUCTURE OF THE DATA

TEXT DATA

As previously mentioned, the Geoindex comprises two 

distinct types of data: text and graphic. These two data 

types are handled separately throughout most of the 

system because of their dissimilar nature. After the 

bibliographic data are captured as keystrokes of coded 

data in digital form, they are usually called text data.

Initially, the text data in machine-readable form look 

very much like a listing of ordinary punched cards. The 

most obvious difference is that a printed line contains 

both uppercase and lowercase characters. Actual data 

fields vary from 4 to 60 characters. The Geoindex data 

base is generated on a State-by-State basis. Each State 

carries the two-digit code assigned by FIPS PUBS. 

Every file name for a particular State contains this same 

numeric code as a suffix. The leading three or four 

characters of the file name are descriptive of the type of 

data in the file. Thus, the initial reference data file for 

Colorado is named refOS.

The format for the text data is as follows:

State identification ____ 2 digits.

Reference number ________________ 4 digits. 

Item number ___________________ 2 digits. 

Informational data ________________ 4 to 60 characters.

Figure 9 shows the text data for reference number 90 

(a record in file refOS) for the State of Colorado as it 

looks in its initial form. This is a reference that contains 

four separate maps, and it was chosen to illustrate the 

complexities of the data structure.

MAP DATA

As stated earlier, the map data are digitized as Cartesian coordinates in the positive quadrant. These coordinate files are structured so that several different types 

of map data are compatible and are handled efficiently 

within the one system. The two major types of graphic 

data are the index-map coordinates and the base-map 

coordinates. The base-map coordinates consist of 

political boundaries, such as State and county, and also 

the geographical positions of the graticule. One 

bibliographic reference may contain several maps, one 

map, or no map at all. Conversely, one map outline, 

typically a county, may be identified by a great number 

of bibliographic references. A unique identifier for each 

map is mandatory and is a combination of three attributes. A primary identification number (id), a secondary identification number (idsub), and a third number 

(second idsub) insure uniqueness. The data for each 

map outline are composed of two different parts. The 

first or header section under a format of (815) consists of 

number codes for the various map features. The 

features and the feature codes are listed as follows:

1. Identification or feature number (id): neatline = 900, 

State = 9NM (NM refers to FIPS code for the particular State)

2. Number of outlines that have this id

3. First subfeature: adjacent county id number, adjacent State = 9NM, national boundary = 993, lake 

boundary = 995

4. Number of points

5. Second subfeature number

6. State id number

7. Graticule = 991, county = 992, island = 994 (values 

recorded only for grid, county, and islands; blank 

for others)

8. Span- that is, one map outline for several references

The second part of the record has a format of (12F6.3) 

and contains the string of Cartesian (x, y) coordinates 

that define the boundary of the published geologic map. 

The first Cartesian pair indicates the position for the 

identifying number. A listing of both parts of the Cartesian coordinate data record for reference number 90 for 

the State of Colorado is shown in figure 10.

TEXT AND MAP DATA

After the data are in digital form, only the map file 

(fig. 10) contains the information that can be used to 

complete the record, the list of attributes named in 

figure 3. The area covered by each geologic map is computed from the Cartesian coordinates, and that information is then stored along with the unit of measurement 

(currently square kilometers). All Cartesian coordinates
REFERENCES CITED 11

are also transformed into latitude and longitude and 

stored as radians. The header cards for the radian files 

are identical with the header cards for the Cartesian 

coordinate files. The data are in card-image form with a 

format of (6F12.9,I8). The decimal point is implied in the 

data files so that there are three latitude-longitude pairs 

per card image with space for sequence numbers. Figure 

11 shows the radian data for reference number 90 for 

Colorado. The names of the files are similar.

Using the radian values, a program determines the 

maximum latitude and longitude for the four directions 

and then stores each map outline. The center of each 

map outline is computed in radians and is stored. The 

data-base management system performs these and 

other computations. The items listed above, derived 

from the map data, are merged into the record, or tuple, 

so that a complete record for each map contains all the 

information shown in figure 3. These two files, text and 

graphic, are compared to ensure that each reference is 

identified by the correct outline. Figure 12 shows a textdata record in its complete form. It represents the final 

form for reference number 90 for the State of Colorado. 

These text data correlate with the map-coordinate data 

shown in figure 10. The data shown in figure 12 are in 

the format required for the storage and retrieval 

system.

Twelve files are stored permanently on two sets of 

magnetic tapes. Each magnetic tape contains the data 

for five States. Figure 13 describes and identifies these 

files.

SYSTEM SPECIFICATIONS

The detailed system specifications are given in the appendixes. Appendix A contains the system flow chart, 

which also shows the input and output files. Appendix B 

contains the operational instructions, which detail the

minimum set of information needed to execute the programs.

Appendix C contains the computer-program reference 

guide. This guide gives complete descriptions of the 

computer programs and listings of the source code for 

each program. Appendix D contains the formats and 

notes needed for data entry.

STATUS OF THE SYSTEM

The data-base management system has passed the 

operational phase and is a fully functional system. The 

primary objective, the generation of geologic index 

maps, is in a production mode, and the data base is 

growing daily. Figure 14 is another computer graphic 

that summarizes the present status of the Geoindex. The 

system automatically generates a new status map at the 

beginning of each month. The files can be accessed in an 

interactive mode, and personalized index maps plotted 

immediately, as shown in figures 4 and 5. The system 

becomes increasingly useful as a tool for policy makers 

as more States are added to the data base. Figures 6, 7, 

and 8 show summary maps that can be of value in making policy and plans.

REFERENCES CITED

Bowen, R. W., and Botbol, J. M., 1975, The Geologic Retrieval and

Synopsis Program (GRASP): U.S. Geological Survey Professional

Paper 966, 87 p. 

Fulton, P. A., 1975, Mapping and Computers, in Rubinot'f, Morris, and

Yovits, M. C., eds.. Advances in Computers, v.13: New York,

Academic Press, p. 73-108. 

Fulton, P. A., and Mclntosh, W. L., 1977, Computerized Data Base for

the Geomap Index: The American Cartographer, v. 4, no. 1, pp.

29-37. 

Honey well Information Systems, Inc., 1978, Level 68 Software

Multics Relational Data Store (MRDS) Reference Manual, p. 1-1,

2-3.
122 120 1 18 1 16 1 14 1 12 1 10 

48

46

42

40

FIGURE 6.-Plot showing all the areas for which geologic maps have been published in the States of Idaho, Nevada, and Arizo
32

120 1 18 16 114 

FIGURE 6.-Continued.

112 1 10
14 GEOINDEX

FIGURE 7. -Plots from the on-line data base showing maps published after 1960 in the United States
GEOINDEX 15

at a scale of 1:250,000. This plot includes both U.S. Geological Survey maps and non-Survey maps.
16 GEOINDEX

97° W

FIGURE 8.-Plots from the on-line data base showing geologic maps published from
GEOINDEX 17

all sources, U.S. Geological Survey and non-Survey, at scales larger than 1:250,000.
18 GEOINDEX

8 90 2Colorado

8 90 SAtwood, W.W.

8 90 81918

8 90 9Relation of landslides and glacial deposits to reservoir

8 9010sites in the San Juan Mountains, Colorado:

8 9012mineral, hinsdale, la plata

8 9017U.S. Geol. Survey

8 901848000

8 901925000

8 902093750

8 902184480

8 9023Bull. 685.

8 9024engineering

8 9038geology

8 9039Fig. 3,

8 9040fig. 4,

8 9041fig. 6,

8 9042fig. 7,

8 9044 8

8 90451

8 90462

8 90473

8 90484

8 90509001

8 90519002

8 90529003

8 90539004

8 9086Also detailed maps.

FIGLFRE 9. -Partial list of text data showing attribute values, in initial (card image) form, for reference number 90, Colorado.

90

6232

90

6700

90

6650

90

7133

4

3662

4

3683

4

4088

4

4248

160800

6162 3979 6689 3947 6677 3597 6146 3615 6162 3979

220800

6627 3765 00000000

360800

6570 4421 7015 4403 7005 4025 6558 4022 6570 4421

460800

7104 4142 7374 4136 7379 3804 7098 3803 7104 4142

FIGURE 10.-Map data in Cartesian coordinates for reference number 90, Colorado.

90 4

1873730163

1871476238

90 4

1871368160

90 4

1871659176

1869857850

90 4

1869229955

1867947965

160

0658147465

0657921102

220

0658268095

360

0659890362

0659663364

460

0660567668

0658801627

8 0

1874116297

1874159720

8 0

1871744737

8 0

1872095935

1872118161

8 0

1869367424

1869368043

0

0659414456

0657951797

0

0658591828

0

0661221254

0659618394

0

0660140064

0658778571

1871448603

1874116297

1869840993

1872095935

1868000881

1869367424

0659327192

0659414456

0661181741

0661221254

0660134288

0660140064

FIGURE 11. - Map data in radians for reference number 90, Colorado.
GEOINDEX 19 

90Colorado Atwood, W.W.,

1918Relation of landslides and glaci 

al deposits to reservoir sites in the San Juan Mountains, Colorado:

mineral, hinsdale, la plata

U.S. Geol. S 

urvey Bull. 685.

engineering 123.5 sq. 

km. 3746053 3741045 10722053 10713033 3744017 10718016

geology Fig 

. 3, 848000 1 9001 Also detailed maps.

90Colorado Atwood, W.W.,

1918Relation of landslides and glaci 

al deposits to reservoir sites in the San Juan Mountains, Colorado:

mineral, hinsdale, la plata

U.S. Geol. S 

urvey Bull. 685.

engineer ing 

3744004 3744004 10714035 10714035 3744004 10714035

geology fig 

. 4, 825000 2 9002 Also detailed maps.

90Colorado Atwood, W.W.,

1918Relation of landslides and glaci 

al deposits to reservoir sites in the San Juan Mountains, Colorado:

mineral, hinsdale, la plata

U.S. Geol. S 

urvey Bull. 685.

engineering 113.2 sq. 

km. 3753006 3747036 10715052 10708002 3750022 10712000

geology fig 

. 6, 893750 3 9003 Also detailed maps.

90Colorado Atwood, W.W.,

1918Relation of landslides and glaci 

al deposits to reservoir sites in the San Juan Mountains, Colorado:

mineral, hinsdale, la plata

U.S. Geol. S 

urvey Bull. 685.

engineering 60.5 sq. 

km. 3749023 3744042 10706024 10701031 3747003 10704002

geology fig 

. 7, 884480 4 9004 Also detailed maps.

FIGURK 12.-Complete text-data record for reference number 90, Colorado. This shows the data in the format required by the

storage and retrieval system.
20

Descr ipt i on 

of file

GEOINDEX

Files in Permanent Storage

Name of file Name of file Name of file

File is 

composed

of

alpha-numer i c 

data

File is 

c omp o s e d

of

Cartes ian 

coordinates

File is 

composed

of 

latitude and

longi tude 

in radians

Identification file bginNM

written on tape for

each State. It names

all the files that

follow belonging to

that State

Outlines of maps shown 

on the index

State outline 

County outlines 

Grat i cule 

Neat line

Centers of map 

out 1 ines

Parameters used to paraNM 

transform Cartesian 

coordinates to 

geographic coordinates 

for each State

Final form of the text redyNM 

files

coorNM

statNM 

counNM 

gr idNM 

bordNM 

cntrNM

cordNM

strdNM 

curdNM

MM is the FIPS code for each State

FIGURE 13. Table showing names of files in permanent storage.
IN COMPILRTION

o

Ho

I1 IN COMPUTER PROCESSING

IN PRESS

PUBLISHED

FIGURE 14.-Status map for the Geoindex, automatically generated monthly.

APPENDIXES: SYSTEM SPECIFICATIONS

APPENDIX A. SYSTEM FLOWCHART

APPENDIX B. OPERATIONAL INSTRUCTIONS

APPENDIX C. COMPUTER-PROGRAM REFERENCE

APPENDIX D. FORMATS AND NOTES

Note:

Program and subroutine names are printed in bold sans-serif type: chkref. 

Variable names are printed in italic sans-serif type: itype. 

Permanent-file names are printed in sans-serif type: matrix. 

Ordinary variables are printed in italics: x, y.

APPENDIX A

APPENDIX A. SYSTEM FLOWCHART

25

MATRIX 

REFnm

MATRIX 

REFnm

REFnm

COORnm 

BORDnm 

GRIDnm 

STATnm 

COUNnm

COORnmDWREFnm

REFnm

final 

Bibliography

STRGnm

LIST TAPE CONTENTS 

TAPEJN. TCL 

digitized maps 

inte Multics

CORDnm 

CURDnm 

STRDnm 

PARAAnm

COORnmDW 

BORDnmDW 

GRIDnmDW 

STATnmDW 

COUNnmDW

;

Pilot drawing 

files on 

Calcomp

-*- COORnmAS

TFILES 

COORnmAS

SELDISK 

separates ascii 

disk file and 

creates a drawing 

file for each 

map

———————— >-.

REDnm 

BLUEnm 

GREENnm
26 GEOINDEX

(

plotmap \ 

separates/

BORDnmDW

GRIDnmDW

STATnmDW

COUNnmDW

REDnm

BLUEnm

GREENnm

DWGTAPE 

drawing file to 

card image tepe 

format for transfer 

to Multics

BORDnm 

GRIDnm 

STATnm 

COORnm 

PVERnm

BORDnm

GRIDnm

STATnm

COUNnm

REDnm

BLUEnm

GREENnm

BORDnm

GRIDnm

STATnm

COUNnm

REDnm

BLUEnm

GREENnm

INDEX VERSATEC 

creates tepe for 

versatec plotter

-»-{ J Plot on versatec

VERSATEC PLOT 

tape created by 

Index^Versatec is 

plotted on versatec

REDnm

BLUEnm

GREENnm

»- COORnm. UNSORT

SORT. VERS. COOR. EC 

runs:

PGM1. VERS. EXTHDR

SORT SEG

PGM2. VERS. SEQUENT

PGM3. VERS. MERGE

COORnm. UNSORT PGM1. VERS. EXTHDR 

creates a file of 

header card images

COORnm. UNSORT. HDR
APPENDIX A 27

COORnm. UNSORT. HDR

COORnm. UNSORT

COORnm. SORT. HDR 

COORnm. SEQUENT

COORnm 

STATnm 

AREANO

STRDnm

MEASnm 

STRGnm 

CORDnm

REDYnm 

MASK 

DEFN 

DICN

INDXnm 

MASK 

DEFN 

DICN

^-COORnm. SORT. HDR

PGM2. VERS. SEQUENT 

converts file from 

stream to sequential

-COORnm. SEQUENT

PGM3. VERS. MERGE 

merges coordinates 

into one ordered 

file

COORnm

MEASnm 

AREAnm 

CNTRnm 

DOUBT

ADDRAD 

inserts map data 

into text files

COVERT. EC 

runs convert to 

load Grasp

GR. EC

seerches Gresp files 

excutes files for 3 

map plots

REDYnm 

COMXnm 

CTRDnm

INDEXnm 

DICN 

FILE 15 

INDEXO

TIP 

T2P 

T3P
28 GEOINDEX

BORDnm

GRIDnm

STATnm

COUNnm

COORnm

SKOD

T1P

T2P

T3P

COORnm

COMXnm

STATnm

STRDnm

CORDnm

COUNnm

CURDnm

CNTRnm

GRIDnm

CNTRnm

CTRDnm

AREAnm

REDYnm

MEASnm

BORDnm

PARAnm

INDXUS 

INDXnm

BORDnm

GRIDnm

STATnm

STRDnm

COUNnm

CURDnm

COORnm

CORDnm

CNTRnm

REDYnm

PARAnm

STORED 

FILES

3 map plots

listing

PULLOFF 

Copies specified 

files from tape 

to CPU

INDXUS

BGINnm

BORDnm

GRIDnm

STATnm

STRDnm

COUNnm

CURDnm

COORnm

CORDnm

CNTRnm

REDYnm

PARAnm _

STORED FILES

STORED 

FILES
APPENDIX B 29

INDXUS

STATPM 

STAT90 

HAWAII 

PUERTO RICO 

ALASKA

STAT90. PAT 

GRASP FILES

RETRIEVE. EC 

RESTORE 

Copies files from 

tape to CPU which 

were written by 

BACKUP. EC

STORED FILES

STATUS MAP

PLOT ON TEKTRONIX

APPENDIX B. OPERATIONAL 

INSTRUCTIONS

HOW TO RUN COMTAPE.EC ON MULTICS

Purpose of the program: comtape.ec allows the user to 

read the tapes containing digital text in ASCII code 

from outside sources into the Multics system. 

Input files: Any outside tape 

Output file: Segment named by the user

To run the program:

A. Label tape "for Multics use," and forward tape to be

processed to production control.

B. Send a message to sys op asking him to locate tape 

nnnnnn. 

Example: sm sys op Please locate tape

nnnnnn

C. After you have been notified that the tape has been 

found, type:

ec comtape nnnnnn SEGNAME 

where nnnnnn is the 6-position volume name, and 

SEGNAME is a name the user wishes to call the 

file, for example, ref21.

D. You will be informed when the tape is mounted and 

the tape drive on which it is mounted. You will also

receive a count number of the records copied into

SEGNAME. This file will automatically be

dprinted.

Example: copy__file -ids "tape_ibm_&l -nib -nb 2 

-fmt fb -den 800 -rec 80 -bk 800" -ods 

"recorcLstream_-target vfile_&2" dp &2 

E. The tape number will be substituted for the &1. The

SEGNAME given by the user will be inserted

where &2 appears.

HOW TO RUN CHKREF ON MULTICS

Purpose of the program: chkref reads through a 

reference file reftVM and checks for various errors 

that might occur.

To run the program:

A. Before running chkref, you must link to it, Type: 

Ik > udd > Geoindx > HJohnson > chkref 

Ik > udd > Geoindx > H Johnson > matrix 

After the first link, you can run it without linking 

again.

B. Type: chkref

C. When asked for the file name, type in the name, such 

as, ref98
30 GEOINDEX

D. Study any error messages that chkref gives, make 

corrections to the reference file, and run chkref 

again until no error messages occur.

HOW TO RUN GEOFMT.EC ON MULTICS

Purpose of the program: geofmt.ec executes a series of 

commands and programs to read the reference file, to 

extract selected data, to arrange it in a predetermined 

order, and to create a columnarized output segment 

ready for printing.

Linking: Before running for the first time, you must link 

to the following segments: 

Ik >udd>Geoindx>PPorter> geofmt.ec 

Ik > udd > Geoindx> PPorter> geofmt 

Ik >udd>Geoindx>PPorter>geofmt.qedx 

Ik > udd > Geoindx > PPorter> geofmta.qedx 

Ik > udd > Geoindx> PPorter> geofmt2.qedx 

Ik > udd > Geoindx > PPorter > geofmtS.qedx 

Ik > udd > Geoindx> PPorter> embed_tabs 

Ik > udd >Geoindx> PPorter>to-nbiPP

Special instructions:

A. The program, geofmt.ec, can be run on any terminal. The only time that you must be on the NBI 

is to run the to-nbiPP program where you must 

use the proportional space printer.

B. To get a rough draft, type anything other than nbipp 

as the third argument of the exec_com.

Example: ec geofmt 84 10 nbino 

Upon termination, type:

dp -dl -nep geofmt.columns

If a file has more than 550 references, do only half 

the file, and after you get the dprint, run the program again using the last half of the file starting 

with a four-column page through the end of the 

file.

C. When three columns are desired on the first page 

with the map, follow the instructions in paragraph 

B with the exception of 8 and 9. For number of 

columns, enter 3 and return. -In answer to the column width, enter 48 and return.

D. When using the seven-column option, you can print a 

single three-column page giving the reference 

numbers for that page, but if more than one page is 

to be printed, you must start with a four-column 

page.

To run the program:

A. Type: ec geofmt pagelength lines nbipp

Example: ec geofmt 84 10 nbipp 

Note: Pagelength specifies the number of lines on 

the page. It can be any number, but presently only 

84 or 140 are used. Lines is an argument specifying the number of lines that should be available at

the bottom of the page in order to print a complete 

reference. There must be a third argument. If you 

want proportional space printing, type: nbipp. 

Otherwise, type some letters or some word for the 

third argument.

B. Then you must respond to the following questions or 

statements:

1. ENTER FILE NAME: Enter the names 

(refNM) and cr (carriage return).

2. TYPE IN STATE NUMBER: Enter 2-digit 

FIPS code and cr.

3. WHAT IS YOUR STARTING REFERENCE 

NUMBER? (use 3 digits): Enter 3 digits and 

cr. Note: We strongly recommend that you 

do no more than 550 references at one time.

4. WHAT IS YOUR ENDING REFERENCE 

NUMBER? (use 3 digits): Enter 3 digits and 

hit cr.

5. fortran_io_: CLOSE FILES? Type yes and 

cr.

6. DO YOU NEED TO EDIT? Type yes or type 

no, and cr. If you typed no, go to step 7. If 

you typed yes, the following will appear on 

the screen:

EDIT.

Enter q to exit editor. 

You are now in the edit mode. Line length is 

set to 80 to make the entire line visible on 

the screen. One line of geofmt.data may 

print out as three lines on the NBI screen. 

Make the necessary changes and be sure to 

write the segment before you exit the editor. 

Under no circumstances should you break or 

interrupt while in qx. After all changes, 

type: 

w

q

7. DO YOU WANT 7 COLUMNS? If you want a 

combination of 4,3,4,3, and so forth, type: 

yes. If you want four columns on every page, 

type: no.

8. EMBED_TABS ENTER NUMBER OF COLUMNS: Enter 4 and cr.

9. EMBED_TABS ENTER COLUMN WIDTH:

Enter 42 and cr. 

10. The ready message will appear on the screen,

and the job is completed.

C. Before recording geofmt.columns on the diskette, 

enter qedx and check the beginning of each page 

to make sure that a new reference begins in each 

column. Also check the last page (not the final 

page) to make sure that you specified enough 

references to fill the page.
APPENDIX B 31

If you are using the seven-column option and doing only part of the reference file, you should end 

with a three-column page (unless you are doing a 

single page). Delete the lines of the four-column 

page, write geofmt.columns and quit the editor. 

D. The file, geofmt.columns, is now ready to be 

recorded on the diskette for printing. Before running to-nbiPP, issue the following commands:

stty -modes Ifecho

Type ct, and then cr. Four options will appear on 

the screen. Type 4, representing computer 4, but 

not cr. Now type:

to-nbiPP cr

1. The following message will appear:

Multics file name to be sent (or q to quit): 

Enter geofmt.columns followed by cr.

2. Multics will respond with ?.

3. Hold down SHIFT key and press the XMIT 

keys. The NBI now receives the document 

line by line. When the last line has been 

received, a single Greek character will remain 

on the screen.

4. Hit BREAK key. CONVERSATIONAL will 

appear on the screen.

5. Type: q cr

Multics will respond with STOP and ready 

message.

6. Hit HOME key. READY will appear on the 

screen and you are now back in NBI word 

processing.

7. Name the document by typing:

co \e,l,document name 

followed by cr.

8. To print the document, insert and aline 

paper and type the following command: 

pr \i,s:document name

HOW TO RUN TO-NBID ON MULTICS

Purpose of the program: to-nbiD allows the user to 

record segments from Multics on the NBI diskette 

(communications disk—four options only) while using 

the NBI System II as a terminal.

To run the program:

A. Turn on machine and insert disk. After READY 

appears on the screen, type ct and cr. Type 3, 

representing computer 3, but not cr. If you accidently hit cr, COMMAND ERROR will appear on 

the screen. If this happens, again type ct, and 

when the four options appear on the screen, type: 

3.

B. Type cm l,c and cr. Note: The 1 is an alphabetic 

character and not the number one. CONVERSATIONAL will appear on the screen. Insert 

telephone in modem and dial Multics number. 

When carrier light comes on, hit cr. Wait for the 

two-line Multics greeting. If you lose the carrier 

light or the greeting does not appear, hang up and 

redial. You are still in CONVERSATIONAL 

mode.

C. Login to Multics as you usually do. If you cannot

login, hit cr and go back to step B. 

| D. You must have the following link in your working 

directory:

Ik >udd >Geoindx > PPorter> to-nbiD 

Note: To print the greater-than sign, press the 

key and CTRL key at the same time.

E. To execute the program, type: to-nbiD cr

F. The following message will appear:

Multics file name to be sent (or q to quit):

G. Type in name of file and then cr.

H. Multics will respond with ?.

I. Hold down SHIFT key and press the XMIT key. The 

NBI now receives the document line by line. When 

the last line has been received, a single Greek 

character will remain on the screen.

J. Hit BREAK key. CONVERSATIONAL will appear 

on the screen.

K. Type: q cr

Multics will respond: STOP 

fortran_Jo_: CLOSE FILES? 

Type: yes 

Multics will then respond with a ready message.

L. You may now logout of Multics as you usually do, or 

you may wish to edit the document to insure that it 

was received correctly. You are still in CONVERSATIONAL mode.

M. Hit HOME key. READY will appear on the screen 

and you are now back in NBI word processing.

N. Name the document by typing:

co \e,l,document name cr

Note: This command expanded means copy letter, 

drive 1, and name you wish to call document.

0. To print the document, insert and aline paper and 

type the following print lines command:

pr \i,s:document name cr

NBI will buzz, giving you a chance to make sure 

that the paper is inserted correctly. Hit cr. Document will start printing.

P. If you are no longer on Multics, go to step Q. If you 

did not logout in step L, you will now have to get 

back in CONVERSATIONAL mode. Type:

cm l,c (as in step B)

CONVERSATIONAL will appear on the screen. 

Logout the way you usually do. After the logout
32 GEOINDEX

message appears on the screen, press the HOME 

key. READY will appear on the screen. 

Q. Type: off cr

Remove disk during countdown, and then turn off

machine.

HOW TO RUN CONCAT ON MULTICS

Purpose of the program: concat takes a reference file 

and builds from it a file suitable for input into 

Bowen's (Bowen and Botbol, 1975) program convert. 

Be sure refNM is the file you want.

Input files: refNM, matrix

Output file: strgNM

To run the program:

A. Before running concat the first time, you must link 

it to your working directory. Type:

Ik > udd > Geoindx > HJohnson > concat 

B. Type: concat

C. When asked for the State code, type in the FIPS 

code for this State. 

Example: concat

ENTER THE 2-DIGIT CODE FOR THE 

STATE BEING PROCESSED 

Type: 15

YOU GOT TO MAIN

YOU WROTE THE 25th VECTOR TO THE 

STRG FILE 

STOP

FORTRAN 10 : CLOSE FILES? 

Type: yes

HOW TO RUN LIST_TAPE_CONTENTS 

ON MULTICS

Purpose of the program: list_tape_contents abstracts 

files from outside tapes containing digital map data 

in ASCII code.

To run the program: After the normal procedure of taking the tape to production control, sending a 

message to the operator asking her to locate the 

tape, and being informed that tape is there, you then 

list the contents of the tape. This can be done by 

list_tape_contents, which prints information 

about files recorded on 9-track magnetic tape. This 

command will list only ANSI (American National 

Standards Institute) standard labeled and IBM 

OS/370 standard labeled tapes.

Example: list_tape_contents nnnnnn -long -iom 

tape__ibm_ where nnnnnn is the volume number, 

-long is an argument that will cause an extensive 

amount of information to be printed about the files, 

and "iom tape_ibm_ invokes the I/O module to attach and read the specified tape volume. The

tape_ibm_ subroutine is specified in order to list 

OS standard labeled tapes. See listing 1.

Now that you have a list of the tape contents, 

determine which files you want to transfer to the 

disk. Transfer can be accomplished by the tape_in 

command, which uses a control file written by the 

user in the tape control language. See listing 2 for an 

example. The volume statement is the volume 

number of the tape. For most outside tapes, Tape, 

Storage, Density, Format, Record, and Block will be 

the same as those shown in listing 2. There will be a 

file number and path statement for each file to be 

transferred. The argument of the file statement will 

be an asterisk. The number statement will specify 

which file number it is on the tape. The argument for 

the path statement will be the name that you wish 

the file to be called after it has been transferred to 

disk.

The control file must have a suffix of .tcl. After you 

have created the control segment with a text editor, 

you can accomplish semantic checking with the 

following command: 

tape_Jn rdtape.tcl -ck

The -ck argument does not cause a tape to be

mounted. If any errors occur, check the tape_in

command in the Honeywell Information Systems'

"MPM Peripheral Input/Output Manual." After

making corrections, type: 

tape_in rdtape.tcl

To simplify the process, procedures are listed

below in steps:

1. sm sys op Please locate tape nnnnnn.

2. list__tape_contents nnnnnn -long -iom 

tape_ibm_

3. Create the .tcl segment. Use uppercase and 

lowercase as shown in listing 2.

4. tape_in rdtape.tcl -ck

5. new_proc

6. tape_in rdtape.tcl

HOW TO RUN TAPEDWG ON DATA GENERAL

Purpose of the program: tapedwg reads a hexadecimal 

ASCII (American Standard Code for Information Interchange) tape written by a 32 bit/word computer 

and places it in the format of a System 101 drawing 

file. The data consists of x, y coordinates in the format 

already specified for map data.

To run the program:

A. Bring the empty drawing file onto the table. Be sure

to display it as a check that it is empty. 

B. Run the overlay program taped wg.
APPENDIX B 33

C. The program will print:

PAUSE MOUNT TAPE ON UNIT 0 

and will pause until you enter cr. After the tape is 

mounted, enter cr. 

D. The program will print:

UNIT 1 OR 0??

and will wait until you enter 1 or 0 followed by cr. 

E. The program will print:

CHARACTER HEIGHT = 

and wait. The usual response is 0.14 and cr. 

F. The program will print:

SYMBOL # =

and wait. The usual response is 1 and cr. 

G. The program will print:

# OF PENS = 1, 2, OR 3 

and wait. The usual response is 3 and cr. 

H. The program will print:

TEXT WANTED?? 1 = YES, 0 = NO. 

and wait. The usual response is 1 and cr. 

I. The program will print:

SKIP FILES?? 

and wait. The usual response is no and cr.

J. If the drawing file is filled, the program will print: 

DRAWING FILE FULL!! 

DO NOT REWIND TAPE!! 

DO NOT REWIND TAPE!! 

SAVE DRAWING FILE, GET NEW DRAWING FILE AND RECALL TAPEDWG 

OVERLAY

The program will then wait. Do exactly as the 

program instructs.

K. If the drawing file is not full, but an EOF is encountered, the program will print: 

END OF FILE REACHED? 

REWIND TAPE?

and wait. The response is y for yes, and cr if there 

are no more files to be read. The response is n for 

no if there are more files to be read. 

L. The program will print:

PROGRAM FINISHED

This means a successful completion of the program.

LISTING I.-Example of list_tape_contents

Mounting volume AAR793 with no write ring. 

AAR793 mounted on tape_01.

File listing of OS Labeled Volume AAR793 Recorded at 1600 bpi.

ID: BID.DAW.OHIOBOR

Number: 1

ID: BID.DAW.OHIOLL 

Number: 2

Format: FB

Mode: ****

Section: 1

Blksize: 6400

Created: 10/27/78

Version: 0

Lrecl:

Expires:

Generation:

80

unknown 

0

ID: BID.DAW.OHIOSB 

Number: 3

ID: BID.DAW.OHIOCB

Number: 4

ID: BID.DAW.OHIO

Number: 5

ID: BID.DAW.OHIOPARM 

Number: 6

ID: BID.DAW.OHIOSBRD

Number: 7

ID: BID.DAW.OHIOCBRD

Number: 8

ID: BID.DAW.OHIORAD 

Number: 9

Displayed characteristics for the last 9 files are identical. 

Finished listing volume AAR793 as specified, 

r 1256 2.427 52.966 633
34 GEOINDEX

M. System error messages are printed whenever a problem occurs. Consult the manuals and take appropriate measures.

HOW TO RUN DWGDISK ON DATA GENERAL

Purpose of the program: dwgdisk reads System 101 

drawing files and creates an ASCII disk file containing the coordinate outline data in Geoindex standard 

format. The sequence is eight integer values comprising the header card information, followed by 

isfno (number of coordinate pairs) pairs of real 

numbers. The second outline immediately follows 

the first and so on.

To run the program:

A. Bring desired drawing file onto table. Make sure 

that the drawing file does not contain extraneous 

information or the program will not execute correctly. For example, if you have deleted something 

from a drawing file, the deletion will change only 

certain parts of that particular record to a zero. 

The record still exists and will cause problems in 

the program. To delete an unwanted record, save 

the file and then bring it back. 

B. Run the overlay program dwgdisk. 

C. The program will print:

PAUSE FOR OPERATORS 

and the program will wait for you to enter cr. 

D. The program will print:

NAME OF DISK OUTPUT FILE = ?? 

and will wait until you type a name in, followed by 

cr. Depending upon your answer, the program will 

type:

OLD-FILE OK?? 

NEW-FILE OK?? 

or print an error message, or end the program (if

LISTING 2.-Example of a tcl 

rdtape.tcl 11/21/78 1455.7 estTue

Volume: AAR793

Tape: ibmsl;

Storage: unstructured;

Density: 1600;

Format: fb;

Record: 80;

Block: 6400;

File: *;

path: ohiobor;

number: 1;

File: *;

path: ohioll;

number: 2;

File: *;

path: ohiosb;

number: 3;

File: *;

path: ohiocb;

number: 4;

File: *;

path: ohio;

number: 5;

File: *;

path: ohioparm;

number: 6;

File: *;

path: ohiosbrd;

number: 7;

File: *;

path: ohiocbrd;

number: 8;

File: *;

path: ohiorad;

number: 9;

End;

r 1455 0.077 0.828 27
APPENDIX B 35

cr is the first character or the escape sequence, 

control d, is entered). A negative answer to the 

first two will cause it to ask the question again. 

After printing the error message, it will ask the 

question again. 

E. The program will print:

DO YOU WISH TO WRITE AN EOF FLAG ON

THIS FILE??

and wait for a y (yes) or n (no). The last part of the 

outline file must have an EOF flag. 

F. The program will print:

TYPE IN 2 DIGIT STATE NUMBER 

Use the FIPS code for this State. This information 

goes on the header card. 

G. The program will then ask:

IS THIS THE GRID BEING PUNCHED 

Answer y (yes) or n (no). No other answer will be 

accepted. This is needed to fill in the header card. 

If the answer is yes, the next question will be skipped. 

H. The program will ask:

IS THIS THE COUNTIES BEING PUNCHED 

Answer y(yes) or n(no).

I. The program will start to process the data. It 

assumes that there is text in the drawing file. If 

not, it will print the message:

NO TEXT IN FILE! 

and exit from the program.

J. When execution is complete, the program prints the 

message:

DONE 

rings a bell, and returns control to the table.

HOW TO RUN SELDISK ON DATA GENERAL

Purpose of the program: seldisk reads an outline disk 

file in Geoindex standard format and creates a System 

101 drawing file. The format used is a header card 

with (815) format followed by the outline with x, y 

coordinate pairs in (12F6.3) format on each card. The 

drawing file will contain only those outlines identified 

by cards that have a feature number and a subfeature 

number. Note: The program does not replace the file 

on the table; instead it appends this data at the end of 

the existing file.

The ASCII disk file will usually be created by using 

the program dwgdisk.

The drawing file will consist of various outlines all 

having the following characteristics: Each outline 

resides in the subfile with a number equal to the 

feature number or 1,000 less than the feature number. 

There are from one to four lines of text, followed by 

one pen up and then a series of pen downs. The text 

consists of the feature number, the subfeature number

(if if no greater than 1), the span (if different from 0) 

and the second subfeature number (if different from 

0).

The outlines will alternate through the three pens so 

that the colors will change for better visibility.

To run the program:

A. Perform the steps necessary to make files available

from the digitizing table. If you wish to place the

incoming data in a drawing file by itself, CLEAR

the drawing file.

B. ACTIVATE AND DISPLAY the drawing file. This

tells the program where to write the information. 

C. Load the cards in the hopper. First will come the 

T-file. This consists of cards with the feature number 

and subfeature number of those outlines wanted in 

the drawing file. These are in (18,12) format. Follow 

these cards with a card that has a -1 as a feature 

number (columns 7 and 8). This will be used as a flag 

for the end of the T-file. 

D. Run the overlay program seldisk. 

E. The program will print:

ISELDISK OVERLAY 

IPAUSE TURN ON CARD READER 

and wait for you to enter cr. This is a reminder to 

make sure it is turned on. If it is not correctly turned on, the program will print:

IFOPFL ERROR! 

and exit. 

F. The program will print:

ICHARACTER HEIGHT = 

and wait for you to type an answer. This will be the 

height in inches of all text read in (usually 0.14). 

G. The program will print:

ISYMBOL # =

and wait for you to type an answer. The answer is 

the number of the symbol that is drawn wherever 

there is a single point for an outline. 

H. The program will print:

NAME OF COORDINATE OUTLINE FILE = 

??

and wait for you to type in the name of a disk file. 

If this is a file that does not exist, the program will 

print:

NEW FILE TRY AGAIN!

and return to ask the question again. Any other error will cause an error message to be printed, and 

then the question will be asked again. A control d 

or a cr on the first character will cause the program to terminate.

I. The program will execute and when finished it 

returns control to the table with the new drawing 

file. Any error in execution will automatically put 

you into the command mode. Some kind of error
36 GEOINDEX

message will be given, and the error should be corrected; then the whole procedure must be started 

again. As the program executes, it will print the 

feature number of all outlines selected for the drawing file.

HOW TO RUN DWGTAPE ON DATA GENERAL

Purpose of the program: dwgtape reads a System 101 

drawing file and writes to tape the header card and 

data cards for all outlines. Each separate outline has a 

header card with (815) format followed by data cards 

in (12F6.3) format. The text position is in the first 

position on the first data card. The program makes no 

attempt to sort the outlines; it just starts at the beginning of the drawing file and processes the file in sequential order.

Several options are available. You can punch cards 

for the whole file or you can pick one subfile number 

(feature number). It will process all outlines that have 

the subfile number you have chosen. The second option gives you the choice of punching all the data cards 

of each outline or of punching only the header card 

and first data card for each outline. This is useful 

when many text position changes have been made that 

would affect only the first data card. The third option 

lets you skip files on the tape so that your file can be 

placed on a tape with other files.

To run the program:

A. Bring desired drawing file onto table. Make sure 

that the drawing file does not contain extraneous 

information or the program will not execute correctly. For example, if you have deleted something 

from a drawing file, the deletion will change only 

certain parts of that particular record to a zero. 

The record still exists and will cause problems in 

the program. To delete an unwanted record, save 

the file and then bring it back.

B. Run the overlay program dwgtape.

C. The program will print:

PAUSE MOUNT TAPE ON UNIT 0 

and will wait for you to enter cr. This gives you a 

chance to mount the tape if you have not already 

done so. The tape must have a write ring.

D. The program will print:

!SUBFILE# = , TYPE 9999 FOR ALL! 

This gives you the option of punching only one 

feature number (subfile) or everything in the file.

E. The program will print:

!DO YOU WISH THE FIRST DATA CARD 

ONLY???

Answer y (yes) or answer n (no). No other answer 

will be accepted.

F. The program will print:

TYPE IN 2 DIGIT STATE NUMBER. 

Use the FIPS code for this State. This information 

goes on the header card. 

G. The program will then ask:

IS THIS THE GRID BEING PUNCHED?? 

Answer y (yes) or answer n (no). No other answer 

will be accepted. This is needed to fill in the header 

card. If the answer is yes, the next question will be 

skipped. 

H. The program will ask:

IS THIS THE COUNTIES BEING 

PUNCHED?? 

Answer y or answer n. 

I. The program will ask:

SKIP FILES?? 

Answer y or answer n. 

J. The program will ask:

HOW MANY FILES??

Type in the number of files you wish to be skipped. 

K. The program will start to process the data. It 

assumes that there is text in the drawing file. If 

not, it will print the message:

!NO TEXT IN FILE! 

and exit.

L. When execution is complete, the program prints the 

message: 

!DONE! 

and returns control to the table.

HOW TO RUN VERSATEC.EC ON MULTICS

Purpose of the program: versatec.ec creates the files 

that are to be used for input to the Multics Versatec 

programs. The input files are those files that were 

created on the Data General minicomputer by the program dwgtape.

To run the program:

A. Before you run this program for the first time, the 

program must be linked. This is done by typing:

Ik >udd >Geoindx>PPorter>versatec.ec 

B. After this is done, the next step is to send the 

systems operator a message to locate the tape:

sm sys op Please locate tape tape number 

After the operator has located the tape, then type 

in:

ec versatec tape number numbers of files filel 

file2 .. . filen. filel, file2 . . . filen must not contain more than 32 characters including blanks. 

C. If there is more than one coordinate file, then these 

coordinate files must be merged into one large coordinate file. This can be done in the editor qedx.
APPENDIX B 37

D. The output file of the merge must be of the form: 

coorNM.unsort, where NM is the State code.

HOW TO RUN INDEX_VERSATEC ON MULTICS

Purpose of the program: index_versatec plots the 

various x, y data files that constitute an index map using the 18-in. Versatec plotter.

To run the program:

A. First link to the following:

Ik > udd > Geoindx > PPorter> index__versatec 

Ik > udd > Geoindx > PPorter > init_vals 

B. For each State NM you wish to plot, place the following files in your working directory (or link). The 

program will access the data via these file 

numbers: 

bordNM 10 

gridNM 11 

statNM 12 

counNM 13 

coorNM 14 

pverNM 15

The format of pverNM is explained in listing 3. 

Note: Before executing any program on Multics, 

you should do a new_proc.

C. Execute the plot program by typing: index_versatec

The program will respond:

TYPE IN TWO DIGIT STATE NUMBER 

Type in the State number. The program will execute and will periodically print out information.

D. The versaplot software will do as many as 100 different plots and automatically store the output in 

segments named vpltOO, vpltOI, vplt02, . . ., 

vplt98, vplt99. These will write over any existing 

segments with that name. Therefore, the first 

thing you should do after completing the program 

is to rename these segments.

E. To execute for another State:

1. Make sure you have renamed the vpltNM 

segments.

2. Do a new_proc.

3. Go to step B.

F. To put plot segments onto tape: There is an exec_com that will place as many segments as you 

wish onto a tape. The best way to do this is to copy 

the exec_com into your segments along with all its 

six names. Type: 

copy >udd>Geoindx>PPorter>gpt.ec- all

G. To use:

1. Take a tape to production control. A label 

"For Multics Use" should be on the tape.

2. Send a message to system operator to get the 

tape: 

sm sys op Please locate tape nnnnnn

LISTING 3.--Parameter cards for a Versatec plot

I. Read input parameter from cards for each data file.

Files

A. Neat line

B. Grid ____

C. State _

Columns

.________________________ 1-22 card 1 

________________________ 23-44 card 1 

.__________________________ 45-66 card 1 

D. Counties ___________________________________________________________ 1-22 card 2 

E. File of selected outlines ___________________________________________________ 23-44 card 2 

F. Outline coordinate ______________________________________________________ 45-66 card 2 

G. 0 = end of all plotting_____________________________________________________ 67 card 1 

1 = more cards follow describing another plot

II. Procedure: plot each of the first four files.

III. Sort the file of selected outlines into ascending order (eliminate duplicates). 

Plot these selected outlines from the master file, or plot all of the master file. 

Each 22-column section contains the following information:

Column 1 ___________________________________________________0 = no plot

1 = plot 

Column 2 ___________________________________________________0 = plot character and lines

1 = plot lines (points) only

2 = plot characters only

._______________Number of different line 

widths to be used in 

plotting this file.

If there are more than one, the program will rotate through those specified, one for each outline. 

Columns 4 through 12 provide values for each line width. Start at left. Lines widths are 1 through 5, which yield lines from 1 to 5 dots

wide. 

Columns 13 through 22 are not used for versatec plotting on Multics.

There will be a separate subroutine for each of the column 2 choices. 

Column 3 _________________________________
38 GEOINDEX

Example: sm sys op Please locate tape 

aar711.

3. Wait for message from operator saying that 

she lias the tape(s).

4 . Execute the exec_com. Usage is:

ec gpt &1 &2 &3 ... &n 

where &1 is the tape number, and &2 to &n 

are segments to be put on this tape. Example:

ec gpt aarTll plotl plot2 plot3 

which places three plots on the tape. Note: 

You can put approximately 1,100 pages of 

segments on a 1,000-inch tape and about 

2,200 pages onto a 2,000-inch tape. The 

exec_com will split a segment between two 

tapes, but you do not want to do this. The 

plotter cannot handle a multiple-tape file produced in this fashion.

HOW TO RUN SORT.VERS.COOR.EC ON 

MULTICS

Purpose of the program: sort.vers.coor.ee creates the 

files that are to be used for input to the Multics Versatec programs. The input files are those files on the 

tape that was created on the digitizer by program 

dwgtape.

To run the program:

A. Before you run these programs for the first time, the 

programs must be linked. This is done by typing: 

Ik > udd> Geoindx> PPorter> pgml.vers.exthdr 

Ik >udd >Geoindx >PPorter >pgm2.vers. sequent 

Ik > udd >Geoindx> PPorter> pgmS.vers.merge 

Ik > udd>Geoindx> PPorter> sort.vers.coor.ee 

B. If there is more than one coordinate file, then these 

coordinate files must be merged into one large 

coordinate file. This can be done in the editor 

qedx. 

C. The output file of the merge must be of the form:

coorNM.unsort 

where NM is the State code.

D. You must have coorNM.unsort in your directory or 

be linked to it. To run, type:

ec sort.vers.coorATM 

where NM is the State code.

E. This exec com is made up of three programs and one 

sort, pgml.vers.exthdr creates an unsorted 

header record file from the unsorted coordinate 

file that was created in the qedx editor. This unsorted header record file is input to the system sort 

where a sorted header record file is created. 

F. pgm2.vers.sequent converts the unsorted coordinate file from a stream to a sequential file. 

G. pgmS.vers.merge merges the sorted header file and

the sequential coordinate file into the sorted coordinate file.

H. As sort.vers.coor.ee is executing, messages are 

displayed on the terminal indicating the progress 

of the job.

I. The files created by versatec.ec and sort.vers.- 

coor.ec can be input to the index_versatec programs.

HOW TO RUN MASTER ON MULTICS

Purpose of the program: master reads coordinate files 

for map outlines and calculates areas for each outline. 

It begins with the area for the entire State. After computing this area, the program compares the area with 

the true area from a file named areano. The true area 

divided by the computed area gives a factor that is 

used to adjust each area computed for each outline.

At the same time, a center point is computed for 

each area. Then these centers are tested to make sure 

that they lie inside each outline and that they are not 

too close to the boundary. If they pass the test, they 

are written to a file cntrNM. Otherwise, they are put 

in a file named doubt. This must be checked by hand 

and, if necessary, adjusted by hand:

Input files: areano, statNM, coorNM.

Output files: areaNM, cntrNM, measNM, doubt

To run the program:

A. Before running master for the first time, you must 

link it to your directory by typing: 

Ik > udd > Geoindx > H Johnson > master 

Ik > udd > Geoindx > H Johnson > areano

B. To run, type: master

C. When asked for it, type the FIPS code for the State.

D. When asked for it, type the denominator of the map 

scale for the map used for this State, format, 

(F8.0). For example, where the scale is given as 

1/1,000,000, type 1000000.. Where the scale is 

1/750,000, type 750000.. Be sure to include the 

decimal point.

E. After the State outline is used to compute State 

area, the machine will tell you the factor. This 

should be close to 1.0. If it is very different from 

1.0, you may have the scale wrong or something 

may be wrong with the State file.

F. After the run is complete, list doubt and make corrections.

HOW TO RUN STATE_OPTIMA ON MULTICS

Purpose of the program: state_optima prints the maximum latitudes and longitudes that border a State 

outline.
APPENDIX B 39

To run the program:

A. You must have the following links:

Ik > udd > Geoindx > HJohnson > state_optima

You must also be linked to the State radian file

strdNM. 

B. Type: state_optima

and follow directions. You will be asked for FIPS

code for the State.

HOW TO RUN ADDRAD ON MULTICS

Purpose of the program: addrad inserts correct areas, 

latitudes, longitudes, centers, and other data into the 

strgNM files for final input to the GRASP convert 

program.

Input files: strgNM, measNM, conxNM, ctrdNM

Output file: redyNM

To run the program:

A. Before running addrad for the first time, you must 

link it to your directory by typing:

Ik > udd > Geoindx > H Johnson > addrad 

B. To run, type: addrad 

C. When asked, type the FIPS code for the State.

To check out error messages in addrad: 

A. While running addrad, the program may write error 

messages in the form: 

THERE IS NO AREA WITH IF = 28 AND ISF

= 1

B. These messages must all be checked out. 

C. The messages are caused by two conditions:

1. The outline for this IF and ISF is a single 

point. This condition is evident from an inspection of coorNM file, where the ISFNO 

number in the header card is 2. When this 

condition occurs, no record appears in 

measNM.

2. An error has occurred. When there is no outline 

for this IF and ISF, then I BOUND and IS PAN 

should not be present, or a record should be 

found in measNM.

Inspect the reference file to see whether an 

outline is present, which is indicated by values 

in items 50-59, 76-85 (IBOUND and ISPAN). 

No record occurs in measNM for this IF and 

ISF. 

D. Try running master again to see if the record in

measNM was somehow dropped.

HOW TO RUN COVERT.EC ON MULTICS

Purpose of the program: covert.ec reads the redyNM 

file and creates a GRASP file for the State.

To run the program:

A. Before running covert.ec for the first time, you 

must create the following links: 

Ik > udd > Geoindx > PFulton > covert, ec 

Ik >udd>Geoindx>PFulton>indexO 

Ik >udd >Geoindx>PFulton> dicn 

Ik > udd >Geoindx >PFulton> defn 

Ik >udd >Geoindx> PFulton> mask 

Ik > udd >Geoindx> PFulton> setmas 

Ik > udd > Geoindx > PFulton > grasp 

Ik > udd > Grasp > grasp 

Ik > udd > Grasp > con vert 

B. Before running, print the indexO, dicn, and mask

file. 

C. Type:

ec covert NM state

where NM is the FIPS code number for the State 

and state is the State name. Example:

ec covert 45 SouthCarolina

D. After running covert.ec, print indexO again to be

sure it has been updated properly. Also compare

the run printout with the sample to be sure it was

successfully completed.

E. After running, be sure you give access on the new

indxNMftie to *.Gmap-Indx.*

F. If the State has to be run through covert.ec again, 

be sure to delete the indxNM file before running 

covert.ec, and delete the State line from indexO.

HOW TO RUN GR.EC ON MULTICS

Purpose of the program: gr.ec sorts the State index file 

by scale and creates three files:

tip for scales less than or equal to 1:24000 

t2p for scales greater than 1:63360 and 

t3p for scales between 1:24001 and 1:63360

To run the program:

A. Before running gr.ec for the first time, create the 

following link: 

Ik >udd >Geoindx>PFulton>gr.ec

B. Before running gr.ec, you must first have run 

covert.ec for the selected State.

C. Type: ec gr NM

where NM is the FIPS code for the selected State. 

Example for Illinois: ec gr 17

D. The program will print the files tip, t2p, and t3p. 

These files should be inspected for accuracy. If any 

discrepancy is found, the redyNM file must be corrected and covert.ec rerun for the selected State. 

Then gr.ec must be rerun to insure that the corrections were entered properly.

E. The three files tip, t2p, and t3p must be kept and 

used in two succeeding programs:
40 GEOINDEX

1. They must be used in inplot.ec.

2. They must be used in index_versatec. After 

the final Versatec plots have been sent out for 

reproduction, the files should be deleted. If 

several States are processed through these 

programs at the same time, then the files 

should be renamed tlpNM, where NM is the 

FIPS code for the selected State. In this way, 

the data can be stored safely until the programs are actually executed, at which time 

the files must resume their original names. 

F. Caution: If the execution fails, be sure to delete the

files that may have been created: t1, t2, t3, tip,

t2p, t3p, and output file. If not, the files will

cause other retrievals to fail.

HOW TO RUN INPLOT.EC ON MULTICS

Purpose of the program: inplot.ec plots the three files 

created by gr.ec, which are tip, t2p, and t3p. It provides a visual check of the integrity of the plot files.

To run the program:

A. Before running for the first time, you must establish 

the links:

Ik >udd>Grasp>assoc 

Ik > udd > Grasp > closer 

Ik >udd >Geoindx>PFulton> inplot.ec 

Ik >udd >Geoindx>PFulton> pn!6 

Ik > udd > Geoindx > PFulton> pos 

Ik > udd >Geoindx> PFulton> plo 

Ik >udd>Geoindx>PFulton> plod 

Ik >udd>Geoindx>PFulton>ploc6 

This program is run soon after gr.ec for the 

selected State and to access Tektronix routines 

type:

setup_tektronix__tcs.

B. Before any execution of the program, you must also 

have all the x, y coordinate files available, such as 

bordNM, coorNM, statNM, and counNM. This 

program must be run on a Tektronix terminal 

because it plots directly on the screen. 

C. To run the program, type: ec inplot NM state

where NM is the FIPS code for the State, and state 

is the name of the selected State. Example, for Illinois: ec inplot 17 Illinois

HOW TO RUN PN16 ON MULTICS

Purpose of the program: pn16 plots a State index map 

interactively on a Tektronix CRT screen. This is a 

two-step process. First, a GRASP retrieval is executed wherein a disk file is created that contains the 

links to the coordinate Geoindex files. This GRASP

file is identified as unit 13 and is described below. 

However, the program is also constructed so that the 

user has the option of plotting any combination of the 

input files.

To run the program:

A. Before running pn16 you must link to it: 

Ik >udd>Geoindx>PFulton>pn!6 

IE >udd>Geoindx>PFulton> skod 

B. Input: You must also have the State base-sheet files 

or link to them. 

These files are:

coorNM, bordNM, statNM, counNM, and 

gridNM

Optionally, you need files created by a GRASP 

retrieval or a file in the same format as the 

coorNM file. 

C. Type: pn!6

D. The program will supply the following prompts. The 

user will supply the replies: 

Prompt 1: NEED STATE CODES (Enter y

for yes.) 

Reply: y (The skod file is then printed; n or

cr presents prompt 3.) 

Prompt 2: TYPE 1 AND HIT RETURN KEY

WHEN READY.

Reply: 1 (MANDATORY REPLY) 

Prompt 3: ENTER STATE ID NUMBER. 

Reply: 18 (example showing FIPS code for

Indiana) 

Prompt 4: IF A COORDINATE FILE IS TO

BE PLOTTED, ENTER Y. 

Reply: y (presents prompt 5)

n or cr (presents prompt 7) 

Prompt 5: ENTER NAME OF FILE TO BE

PLOTTED. 

Reply: tip (example showing name of a file

created by GRASP)

Prompt 6: IF INPUT SHOULD BE SORTED, 

REPLY WITH A Y FOR YES. 

(This file should be sorted the first 

time it is used because the program expects the numeric identifiers in ascending order; n or cr 

presents prompt 7.) 

Reply: y

Prompt 7: ENTER TITLE FOR MAP. 

Reply: Indiana for years greater than 1970

(example)

Prompt 8: TO PLOT STATE ENTER 1. 

Reply: 1 (causes State boundary to be plotted)

0 (No State boundary will be plotted.)
APPENDIX B 41

cr (No State boundary will be plotted.)

Prompt 9: COUNTY PLOT (ENTER 1 FOR 

SOLID LINE, 2 FOR DOTTED, 

ELSE 0.) 

Reply: 1 (County boundaries will be plotted

in solid lines.) 

2 (County boundaries will be plotted

in dotted lines.) 

0 (No county boundaries will be

plotted—presents next prompt.) 

cr (No county boundaries will be

plotted—presents next prompt.) 

Prompt 10: TO PLOT GRID ENTER 1. 

Reply: 1 (Latitude and longitude will be

plotted.) 

0 (No latitude and longitude will be

plotted—presents next prompt.) 

cr (No latitude and longitude will be 

plotted—presents next prompt.) 

Prompt 11: TO SUPERIMPOSE ANOTHER 

FILE, ENTER 0 FOR NO, 1 FOR 

LINES ONLY, 2 FOR LINES 

AND CHARACTERS. (This 

prompt causes another plot file to 

be superimposed on the map. The 

file must have the same format as 

the coordinate files—for example, 

the locations of silver deposits 

could be plotted on the base or index map of Nevada.) 

Reply: 1 (plots outlines and (or) points only;

presents prompt 12) 

2 (plots outlines and (or) points with 

an identifying number; presents 

prompt 12)

0 or cr (No superimposed file will be 

plotted; next erases screen and 

starts plotting.)

Prompt 12: ENTER FILE NAME. (This question is asked only if 1 or 2 were 

the replies to prompt 9.) 

Reply: cu3 (example of the name of a plot

file).

The screen is then erased, and the files are plotted. 

A bell rings when the plots are completed. For one 

hard copy, type the c and cr keys. For multiple 

hard copies, use the copy switch. When finished, 

cr.

Prompt 13: FOR AN ENLARGEMENT OF A

PART OF THIS PLOT, TYPE Y.

Reply: n or cr (No enlargement will be

made—presents prompt 16.) 

y (An enlargement will be made according to the replies from 

prompts 14 and 15.)

Prompt 14: POSITION CURSOR AT LOWER 

LEFT OF DESIRED AREA; 

TYPE C.

Reply: Physically move the crosshair cursor to the required position and 

type c and cr.

Prompt 15: POSITION CURSOR AT UPPER 

RIGHT OF DESIRED AREA; 

TYPE C.

Reply: Physically move the crosshair cursor to the required position and 

type c and cr. (For best results, 

the window defined by the crosshair cursor should approximate 

the shape of the original plot; 

otherwise, geometric distortions 

will be introduced into the plot.) 

The program from prompt 7 through 13 is then 

repeated.

Prompt 16: TO PLOT ANOTHER FILE 

ENTER Y FOR YES.

Reply: y (causes a return to prompt 4)

n or cr (ends the program and 

causes the message "good" to be 

printed to show a successful execution) 

The system prints STOP fortran_io: Close files?

Reply: yes

HOW TO RUN BIGSTA ON MULTICS

Purpose of the program: bigsta compiles statistics on 

most of the files that we use in processing one State. It 

counts cards, computes lengths, and so forth, 

whenever appropriate.

Input files: coorNM, comxNM, statNM, 

strdNM, cordNM, counNM, curdNM, cntrNM, 

ctrdNM, gridNM, areaNM, redyNM, measNM, 

bordNM, and any others you wish to count 

Output files: None

To run the program:

A. Before running bigsta for the first time, you must 

link it to your directory by typing: 

Ik > udd > Geoindx > HJohnson > bigsta 

Ik >udd >Geoindx > HJohnson > bigcal_bigsta 

Ik >udd >Geoindx > HJohnson > out2_bigsta 

Ik > udd > Geoindx > HJohnson > prim__bigsta 

Ik > udd > Geoindx > HJohnson > rads_bigsta 

Ik > udd > Geoindx > HJohnson > cards_bigsta
42 GEOINDEX

Ik >udd >Geoindx >HJohnson >outl_bigsta 

Ik >udd>Geoindx>HJohnson >ftnumber

B. Type: bigsta

C. When asked, enter the two-digit FIPS State code.

D. After running through the standard files, the program asks for any other files you wish processed. 

You may wish to type the following: paraNM

E. After the run is complete, the total number of cards 

is also given. The printout of the total should be 

filed.

HOW TO RUN USMERG.EC ON MULTICS

Purpose of the program: usmerg.ec takes as input a 

newly created indxNM file and appends it to the existing indxus. indxus is the GRASP file that contains all the States. The output file is named usall. 

At the end of the run, it is dprinted for checking.

To run the program:

A. Before running usmerg.ec for the first time, you 

must establish the following links: 

Ik > udd > Geoindx > PFulton> usmerg. ec 

Ik > udd > Geoindx > PFulton> indxus 

After establishing the link to indxus, copy it into 

your directory.

B. To run, type: ec usmerg NM

where NM is the FIPS code for the State that is to 

be added to the indxus file. Example: ec usmerg 

17 will take indx17 for the State of Illinois and append it to indxus.

C. Study the program run listing for any errors, usall 

will be dprinted. Study the listing of usall for any 

errors.

D. If there are no errors, save the existing indxus by 

copying into a file called sindxus. Then delete 

indxus, and rename usall, indxus.

E. Run GRASP and check new indxus.

F. If there is an error:

1. Delete usall and indxus.

2. Copy sindxus to indxus.

3. Rerun, starting at C.

HOW TO RUN STATE_TO_TAPE ON MULTICS

Purpose of the program: state_to_tape must be run 

on a console that gives a printout.

To run the program:

A. Be sure you have created the following links to the 

program:

Ik > udd >Geoindx > HJohnson > state_to_tape 

Ik >udd >Geoindx>HJohnson>

heading_state__to_tape 

Ik > udd >Geoindx > HJohnson > sts_begin

Ik >udd >Geoindx >HJohnson>

list_state_tape.ec 

Ik > udd >Geoindx > HJohnsori> 

disk_to_tape_fb_retain.t'C 

Ik > udd > Geoindx > HJohnson >

disk_to__tape__vbs_retain.ec

B. Be sure you have the following files in your directory 

or that you are linked to an actual segment containing them:

coorNM, cordNM, statNM, strdNM, counNM, 

curdNM, cntrNM, gridNM, bordNM, redyNM, 

paraNM

C. Look up the number of this tape. 

D. Look up the last file number that was written to this 

tape. If you have never run this program on this 

tape, then the last file number is 1 (the file that initialized the tape). 

E. Type:

sm sys op Please find tape number 

(Tape number being your tape number) 

F. Wait until the operator sends a message to your console that he has found the tape. 

G. Type: state_to_tape

(The program will prompt you for the information 

it needs.)

H. As directed by the machine, make two copies of the 

printout. Store these printouts for future 

reference. Then put the original printout in your 

log for this tape. You will need to refer to it 

whenever you add more records to the tape or 

whenever you want to print a listing of these files. 

I. Remember to use a second backup tape with these

files. 

J. To drop these files from your directory, link to:

Ik > udd > Geoindx > HJohnson > drop, ec 

and type: ec drop NM 

where NM is the State number.

HOW TO RUN PULL_OFF ON MULTICS

Purpose of the program: pull_off enables the user to 

select files from the Geoindex files and to write the 

selected files to disk.

To run the program:

A. Make the following links:

Ik >udd >Geoindx > HJohnson >pull_off 

Ik >udd >Geoindx > HJohnson >

separate_pull_off

Ik >udd >Geoindx >HJohnson >state_pull_off 

Ik >udd >Geoindx >HJohnson >up^file__number 

Ik >udd Xjeoindx >HJohnson > 

tape_to_disk_vbs_retain.ec
APPENDIX B 43

Ik >udd>Geoindx>HJohnson>

tape_to_disk_jfb_retain.ec 

Ik > udd > Geoindx > HJohnson >

list_state_tape.ec 

B. You need to know the tape number.

C. You need to decide whether to take off certain 

separate files, or to use all the files for one State.

D. To take off separate files, you must know their exact 

names, and their file numbers (positions) on the 

tape. This information can be obtained from a tape 

map or by using list_state_tape.ec.

E. Send a message to the operator to get your tape: 

sm sys op Please find tape nnnnnn

F. Type: pull_off

Follow directions.

G. This program prints out a tape map at the end. If you 

do not want that, just hit break key after it starts 

printing.

H. Remember that many of the tape files of paraNM, 

cntrNM, and redyNM have an extra record that 

does not end in a newline character. You may have 

to edit these files before using them.

HOW TO RUN BACKUP ON MULTICS (COMPLETE 

DUMP)

Purpose of the program: backup enables you to dump 

one or more segments to your tape. You can even 

dump whole directories. The program creates a file 

named control.dump. You must type in all the absolute 

path names of the segments or directories you want to 

dump to tape. Note: These must be entered in 

alphabetical order.

How to run the program:

A. First you must make the followings links: 

Ik > udd > Geoindx > H Johnson > backup 

Ik > udd > Geoindx > H Johnson > backup, ec 

Ik > udd >Geoindx > H Johnson > backupl 

Ik > udd > Geoindx > H Johnson > backup2 

Ik > udd > Geoindx > H Johnson > dump.ec

B. You must know the absolute path name of the 

segments you want to dump for backup. Example: 

>udd >Geoindx>HJohnso" ^indxus 

>udd >Gmap_Indx >H Johnson 

This would dump the one segment indxus and the 

whole directory >udd > Gmaj __Indx >HJohnson

C. You must know your tape number.

D. You must send a message to the operator to find 

your tape: 

sm sys op Please find tape nnnnnn

E. From operator: Go Ahead

F. Type: backup

Computer will respond: backupl

G. Prompt: DID YOU SEND A MESSAGE TO THE 

OPERATOR TO FIND YOUR TAPE? IF 

YOU DID, TYPE A 1 

Response: 1

Computer responds with a prompt. Last part of 

prompt is:

NOW TYPE IN THE ABSOLUTE PATH 

NAME OF THE NEXT SEGMENT OR DIRECTORY YOU WANT TO BACKUP. TYPE ITS 

ABSOLUTE PATH NAME 

E xample: > udd > Geoindx > H Johnson > indxus

H. Prompt: IF YOU WANT TO DUMP MORE

PATHS, TYPE 1; OTHERWISE, 0 

Stop

Prompt: FORTRAN 10 : CLOSE FILES? 

Response: Yes 

Message: io close filelO

io detach filelO 

Computer prints: backup2 

Prompt: TYPE YOUR TAPE NUMBER, FORMAT A6

Response: nnnnnn (example, 111849) 

Computer prints:

Complete_dump_control.dump HHJ -debug 

> udd > Geoindx >H Johnson > indxus 

Prompt: TYPE PRIMARY_DUMP_TAPE

LABEL

Response: 111849 

Computer prints:

TAPE_: MOUNTING TAPE 111849 FOR 

WRITING TAPE_: TAPE 111849 MOUNTED 

ON DRIVE 1 DUMP FINISHED.

I. The computer prints:

THIS ROUTINE ADDS 1 OR 2 MESSAGE 

FILES TO YOUR DIRECTORY WHICH ARE 

AUTOMATICALLY DPRINTED. THEY ARE 

VERY IMPORTANT AND SHOULD BE 

PICKED UP AND SAVED IN A SAFE 

PLACE.

THEY ARE THE DUMP.MAP AND POSSIBLE ERROR MESSAGE. SAVE THEM IN A 

SAFE PLACE. THROW AWAY ANY OLD 

DUMP.MAPS FOR THIS TAPE, SINCE THEY 

ARE COMPLETELY OBSOLETE. 

Type: Rename indxus indxus_true
44 GEOINDEX

HOW TO RUN RESTORE ON MULTICS

Purpose of the program: restore enables you to put a file 

from a backup tape, (created by the program backup) 

onto the Multics system

How to run the program:

A. First make the following links:

Ik >udd >Geoindx >HJohnson >restore 

Ik >udd Xjeoindx >HJohnson >retrieve.ec 

Decide which segments you want to restore from 

your backup tape. Check the dump.map for that 

tape to make sure that the segments are present. 

You must know their exact pathnames.

B. You must have these segments listed in the same 

order that they appear in the dump.map.

C. Be sure to rename your file before bringing it back 

from tape, such as change indxus to indxus_true.

Then you can use the command:

compare indxus indxus__true 

to see if there are any differences.

D. Type: new_proc

and wait for system to respond; then type: restore

E. Prompt: DID YOU SEND A MESSAGE TO THE 

OPERATOR TO FIND YOUR BACKUP 

TAPE? IF YOU DID, TYPE: 1

F. Prompt: NOW TYPE THE ABSOLUTE PATH 

NAME OF THE NEXT SEGMENT OR 

DIRECTORY THAT YOU WANT TO 

RESTORE; THIS NAME IS ON YOUR 

BACKUP TAPE.

Use its absolute path name. Example: 

Ik > udd > Geoindx > HJohnson > indxus

G. Prompt: IF YOU WANT TO RESTORE MORE 

PATHS, TYPE 1; OTHERWISE, TYPE 0

H. Prompt: TYPE THE NUMBER OF YOUR 

BACKUP TAPE, FORMAT (A6). Example: 111849 

Computer prints:

RETRIEVE CONTROL.RETRIEVE -DEBUG

INPUT TAPE LABEL: 111849

TAPE_: MOUNTING TAPE 111849 FOR

READING

TAPE_: TAPE 111849 MOUNTED ON DRIVE

1

BEGIN AT 01/25/78 2053.3 EST WED.

END OF READABLE DATA.

BK_INPUT: ARE THERE ANY MORE

TAPES TO BE RELOADED? 

User responds:

No

Computer prints:

NORMAL TERMINATION 01/25/78 2053.4

EST WED.

DPRINT -DL CONTROL.RETRIEVE.

RETRIEVE.MAP

1 REQUEST SIGNALLED, 0 ALREADY IN

PRINTER QUEUE 3

This routine automatically dprints a retrieve map. 

Check to make sure that the requested files are in 

your directory.

User should then issue list command to find out 

whether the file has been restored. Example: 

Is indxus

User should then issue compare command to insure the segment restored is the same as the segment that was written to tape using backup. Example: Compare indxus indxus_true 

Computer responds:

NO DISCREPANCIES FOUND.

HOW TO RUN VERPLOT ON MULTICS

Purpose of the program: verplot generates the status 

map for the Geoindex. This program reads a file of 

commands and creates a Versatec plot file using the 

instructions from that file.

To run the program:

A. Link to the following Multics files:

Ik >udd>Geoindx>PPorter>verplot 

Ik >udd >Geoindx>PPorter>init_vals 

Copy or link to the following coordinate files: 

Ik >udd >Geoindx >PPorter >stat90 

Ik >udd >Geoindx >PPorter >hawaii 

Ik >udd >Geoindx > PPorter > alaska 

Ik >udd >Geoindx >PPorter >puerto_rico

B. Create or link to some command file. See listing 4 for 

instructions on the contents of this file. An example is shown in listing 5.

C. Run the program on Multics by typing: verplot

D. The program will ask the following question:

WHAT IS THE NAME OF YOUR COMMAND 

FILE??

USE NO MORE THAN SIX CHARACTERS! 

and will read your answer, then attach and open 

this file for reading. A nonexistent file will give an 

error message on the terminal.

E. The program reads the data and calls the subroutine 

corresponding to that command. Any error in a 

command causes this error message to be written 

along with the entire data record:
APPENDIX B 45

THIS LINE CANNOT BE IDENTIFIED AS A

COMMAND.

Note: All error messages are written to a file 

called temp 10, which is created by the program 

and at the end of the run dprinted to provide a 

hard copy, which is always provided unless the program does not run to completion (example: hitting 

break key); if it is not dprinted, you have no means 

to get the information in temp 10. An abnormal 

termination leaves tempIO as a zero length file. 

F. As each subroutine is called, it will process the information given in the command line and write 

messages to tempW for both valid operations and 

for errors. We have tried to take into account 

every type of possible error for which it gives an 

appropriate error message and have the program 

continue. This program should give a plot and a 

progress and error report to cross-check and to 

identify any errors and omissions. Any error for 

which a report is not given is not a common typing 

or omission error and must be resolved in a different manner.

G. After the program has finished the plots, it prints 

this message:

PLOT FINISHED

N VECTORS LOST

N ACTIVE LINES USED

1 request signalled, N already in printer queue 3.

Stop.

H. To put plot segments onto tape: An exec_com will 

place as many segments as you wish onto a tape. 

The best way to do this is to copy the exec_com into your segments along with all six of its names. 

Type: copy >udd >Geoindex>PPorter>gpt.ec-all 

I. To Use: Label a tape "For Multics Use" and take it to 

production control. Send message to system 

operator:

sm sys op Please locate tape number nnnnnn 

Wait for message from operator saying he has the 

tape(s). Execute the exec_com. Usage is:

ec gpt &1 &2 &3 . . . &n

where &1 is the tape number, and &2 to &n are 

segments to be put on this tape. Example: ec gpt 

aar730 plotl plot2

LISTING 4. -Formation of the command file for verplot and an example command file

The file is composed of one or more instructions taken from a list of eight commands along with a variety of keywords that give almost limitless 

scope in creating a Versatec plot file. Restrictions for a command will be explained in that particular section.

I. All commands consist of records that have a maximum of 80 characters. This record length facilitates the use of cards if wanted.

II. All commands and keywords can be either uppercase or lowercase, but must all be of one type in a particular word. The types can be mixed 

within a record.

III. Each command must start in column 1 (card-image terminology used) and must be immediately followed by a semicolon.

IV. Keywords can be in any order but must be separated by commas. For each command, certain keywords are required and others are optional; default values are present if an optional keyword is missing. Many keywords include some data values.

V. Except for the PLOT command, all commands and keywords must be on the same record.

VI. Blanks are ignored except in the following cases:

A. All commands and keywords must be in a continuous string.

B. Commands must start in column 1 and be immediately followed by a semicolon.

C. Keywords that require a data value must be immediately followed by the character =.

D. When used in a data value as a place holder. Example: x = Ml!!, will be interpreted as x = 100. Example: y = 2!.!!, will be interpreted

as y = 20.

Note: "!" is the symbol used for a blank space.

VII. If at any time the same keyword occurs twice in a record, the second occurrence will take precedence. 

VIII. In all commands, if an error in the data value for a keyword occurs, that value will be either ignored or set to the default value if one exists.

IX. In all commands, if any required keyword is missing, the command is ignored.

X. All numbers can be in either integer or real number format.

XI. An example of a command file, statpm, follows:

statpm

outline; npoint = 5,shade= 1 3

19.4,0.67,19.4,0.92,19.73,0.92,19.73,0.67,19.4,0.67 

outline; npoint^S,shade= 1 2

19.4,1.59,19.4,1.84,19.73,1.84, 19.73,1.59,19.4,1.59 

outline; npoint=5, shade=l

19.4,2.51,19.4,2.76,19.73,2.76,19.73,2.51,19.4,2.51
46 GEOINDEX

LISTING 4. -Formation of the command file for verplot and an example command file-Continued

outline; npoint=5, shade=4

19.4,3.43,19.4,3.68,19.73,3.68,19.73,3.43,19.4,3.43 

legend; x=19.88,y=0.72,height=0.1,nchar=9 

PUBLISHED

legend; x=19 88,y=1.64, height=0.1,nchar=8 

IN PRESS

legend; x=19.88,y=2.56,height=0.1,nchar=22 

IN COMPUTER PROCESSING

legend; x=19.88, y=3.48,height=0.1,nchar=14 

IN COMPILATION 

reorg; x^l.O, y=1.0 

outline; npoint=5

0.0,0.0,0.0,3.2,3.4,3.2,3.4,0.0,0.0,0.0 

legend; x-1.35, y=3.3, height=0.1, nchar=6 

ALASKA

plot; name-alaska, shadeall, pattern=l,13 

end plot;

reorg; x=5.6, y=-0.4 

outline; npoint=5

0.0,0.0,0.0,1.3,2.0,1.3,2.0,0.0,0.0,0.0 

legend; x=0.68, y=1.42, height=0.1, nchar=6 

HAWAII

plot; name=hawaii, shadeall, pattern=l,13 

end plot;

reorg; x=8.0, y=0.7 

outline; npoint=5

0.0,0.0,0.0,0.7,2.0,0.7,2.0,0.0,0.0,0.0 

legend; x=0.37,y=0.8, height=0.1, nchar=ll 

PUERTO RICO

plot; name=puerto_rico, shadeall, pattern=l,13 

end plot;

reorg; x=-14.6, y=-1.3 

linwid; 4 

outline; npoint=5

0.0,0.0,0.0,17.75,22.65,17.75,22.65,0.0,0.0,0.0 

legend; x=6.775, y=16.8, height=0.3, lwidth=4, nchar=30 

STATUS OF GEOLOGIC MAP INDICES

legend; x=7.725, y=16.0, height=0.3, lwidth=4, nchar=23 

SATURDAY, MARCH 1, 1980 

linwid; 1

plot; name = stat90, textfield = 1,6, refclear=, height = 0.1, 

select, selshade 

1 1 13

4 1 13

5 1 13

6 1 1

8 1 13

9 1 1

12 1 1
APPENDIX B 47

LISTING 4. -Formation of the command file for verplot and an example command file -Continued

13 1 12

16 1 13

17 1 13

18 1 13

19 1 13

20 1 13

21 1 13

22 1 13

23 1 13

24 1 1

25 1 1

26 1 1

27 1 1

28 1 13

29 1 13

30 1 13

31 1 13

32 1 13

33 1 1

34 1 13

35 1 13

36 1 13

37 1 13

38 1 13

39 1 13

40 1 1

41 1 1

42 1 1

45 1 13

46 1 13

47 1 1

48 1 12

49 1 13

50 1 1

51 1 13

53 1 1

54 1 13

55 1 1

56 1 13 

END PLOT; 

plot; name = stat90, textfield= 1,6, height = 0.1, select,selshade

10 1 1

44 1 1 

end plot; 

plot; name=stat90, select, selshade

11 1 1

25 2 1

25 3 1

51 2 13 

end plot;
48 GEOINDEX

LISTING 5. -Commands for verplot 

END PLOT

Purpose:

The command END PLOT informs the program that the information describing the plotting of a file is at an end. The only use is in conjunction with the PLOT command.

Command usage:

END PLOT; (or end plot;)-The program will continue reading the command file until the end plot command is reached.

LEGEND

Purpose:

The command LEGEND plots the character string given in a manner described by the keywords.

Command usage:

LEGEND; (or legend;) (keywords) followed by the text string on the next record.

Required keywords:

x- (or X=)-x coordinate of start of text string 

y= (or Y=)-y coordinate of start of text string 

height = (or HEIGHT'= )-Height of each character

nchar= (or ATCHAR = )-Number of characters in text string on next record (Always start in column 1 and use no more than 80 characters, 

which can be either uppercase or lowercase (or mixed).)

Optional keywords:

angle = (or ANGLE=)-The angle at which the text string is plotted (Default = 0 degrees.) 

lwidth= (or LWIDTH=)-The width of the line in dots (Default = 1 dot wide.)

LINWID

Purpose:

The command LINWID changes the line width of all subsequent plotting to the value given.

Command usage:

linwid; (or LINWID;) (number)-The number must be 1,2, 3, 4, or 5 because the Versatec software will accept no others. If no number is present or an error is in the data, the default value of 1 will be used.

OUTLINE

Purpose:

The command OUTLINE plots an outline whose coordinates are on the following record(s).

Command usage:

outline; (or OUTLINE;) (keywords)-Foliowed by the record(s) containing the data points.

Required keywords:

npoint= (or NPOINT= ) - The -number of data pairs of x, y coordinate points that follow (All coordinates must be separated by commas. No 

more than 20 pairs can be used, with no more than 20 values per record.)

Optional Keywords:

shade = (or SHADE=)- Tells the program to shade this outline and gives the reference number of the pattern to use in shading (The valid 

reference numbers are 1 through 20 with any other number defaulting to 1. However, numbers 14 through 20 are blank patterns that 

are reserved for use with the PATTERN command.)

noline (or NOLINE)-Causes the outline not to be plotted (This should not be used unless the shade option is also used).

PATTERN

Purpose:

The command PATTERN reads data values and stores these in an array that will be used as a pattern for shading at some later point in the 

program.

Command usage:

pattern; (or PATTERN;) (keywords)-Foliowed by one or more records containing the data values.
APPENDIX B 49 

LISTING 5. -Commands for verplot-Continued

Required keywords:

refnum= (or REFNUM-)-T\\e reference number to be used in identifying this pattern (It must be from 14 through 20.)

numword= (or NUMWORD- )-The number of data words on the following record(s) (This number can only be 1, 2, 4, 8, or 16. Any other

number will give an error. The maximum number of words accepted by Versatec is 16, and all the others divide evenly into 16.) 

type= (or TYPE=)-The only choices are INTEGER or OCTAL. The data values start on the next record. The program will read as many

records as necessary to satisfy the numword variable. All data values are separated by commas.

PLOT

Purpose:

The command PLOT reads the name of a file, attachs and opens it for input and plots the data in that file according to the other keywords or 

to the default values.

Command usage:

plot; (or PLOT;) (keywords)-Followed by records containing a selective records list. The END PLOT command must always be used in conjunction with this.

Required keywords:

name= (or NAME=)-Contains the name of the file to be plotted (Not more than 20 characters may be used.)

Example: PLOT; NAME=filename

END PLOT;

This constitutes the simpliest use of the plot command. 

Note: This command will plot only those files whose outlines have a header card where the number of pairs of points in the outlines are listed

in integer format in columns 16-20. The data points will follow in (12F6.3) format with the first data point being a text position.

Optional keywords:

height= (or HEIGHT =)-The height of each character in the header card text; default value of 0.14 in.

noline= (or M)L/M?=)-Does not plot the outline but allows all other options, such as character plotting and shading (Default is to plot the 

outlines.)

pattern= (or PATTERN=)~ Followed by a series of numbers (The first is the count of how many more numbers follow. The remaining 

numbers are a sequence of pattern reference numbers, through which the program will rotate when shading outlines. Default pattern sequence is 1 through 10.)

refclear= (orREFCLEAR=)-Wi\\ clear the area around text when shading (This has one major problem. The Versatec software does not 

have a clearing function. Instead, if two or more areas are given in one shading command, the software will alternate shading and clear 

areas as the areas overlap. For our purpose, this is acceptable if the area to be cleared lies entirely within the outline. However, if areas 

overlap or the text lies outside, effects will be confusing. Default is not to clear the area.)

select= (or SELECT= )-Will plot only those outlines listed in the selective file following the keywords.

selshade= (or SELSHAD£?=)-Will shade only those outlines that have a valid pattern reference number listed in the selective file following 

the keywords.

shadeall = (or SHADEALL =) - Will shade all outlines and will rotate through the pattern sequence given (or 1-10 by default) (An outline pattern can be changed by listing a valid pattern reference number in the selective file following the keywords.)

textfield= (or TEXTFIELD= )- Folio wed by a series of numbers, the first number gives the count of how many numbers follow. The remaining numbers are a sequence representing some of the eight fields on the header cards. These are numbered from 1 to 8 from left to right. 

This sequence of numbers tells what fields will be plotted and in what order. Any blank or zero valued field will be ignored.

Example: text field=3,8,1,6 

There are three fields to plot. First field 8, then field 1, and then field 6. Each field will be lined up underneath the previous one.

The keywords may occupy more than one record. All records containing keywords, except the last, must have a comma as the last entry 

on the record. This is the only indication that there are more keywords given. 

A keyword with associated data values must be contained on one record. They cannot span records.

The selective file following the keywords comprises records containing the reference number (field one of the header card), the 

subfeature number (field three), and an optional pattern reference number. These are all five character fields contained in column 1 

through 15 of the record. The two outline identifiers must be in this field exactly as they are in the five character header card field. The pattern reference number is in format (15).

REORG

Purpose:

The command REORG changes the software origin of the plot file. This has the effect of moving the subsequent plotting commands in relation to those done previously.
50 GEOINDEX

LISTING 5. -Commands for verplot-Continued

Command usage:

reorg; (or REORG;) (keywords)

One, but not both, of the following keywords must be present. If one is missing, the default of 0 for that value will be used. A movement to 

the left or down is negative; right or up is positive.

Keywords:

x- (or .X"=)-The amount of movement (inches) in a left or right direction 

y= (or r=)-The amount of movement (inches) up or down

SCALE

Purpose:

The command SCALE changes the scale of all subsequent plotting.

Command usage:

scale (or SCALE) (number) 

A blank data value or an error will default to a scale of 1.

SYMBOL

Purpose:

The command SYMBOL changes the character plotted when a single point is encountered.

Command usage:

symbol (or SYMBOL) (number) 

The number represents some character. Any error in the number will default to a small triangle (number 2).
APPENDIX B 51

HOW TO RUN PIN90 ON MULTICS

Purpose of the program: pin90 will plot the U.S. map 

and then, if the user wishes, will plot numbers, symbols, and outlines using GRASP files and will also plot 

the grid file.

Input files: f/7e74-stat90; file 15 -GRASP files; 

file16-grid file

Output files: None (The only output is the plot on the 

screen.)

To run the program:

A. Before running pin90 for the first time you must link 

it to your directory by typing: 

Ik > udd > Geoindx > PPorter> pin90 

Ik > udd >Geoindx > PPorter> enlrg 

Ik >udd >Geoindx > PPorter> indiv 

Ik > udd >Geoindx > PPorter> min-max 

Ik > udd >Geoindx> PPorter>plocv 

Ik >udd >Geoindx> PPorter> grid

B. To run, type: pin90

C. The user will then respond to the following questions:

1. NEED SYMBOL CODES? (ENTER Y FOR 

YES.) If you want to see the symbol and corresponding number, type y and cr. Otherwise, just enter cr and proceed to C3.

2. TAP 1 AND RETURN KEY WHEN READY

3. Screen is erased.

4. ENTER SYMBOL NUMBER AND FILE TO 

BE PLOTTED. Example: 43silver You may 

enter as many as five files (maximum 

number of eight characters for file name). 

After each entry, enter cr and the message 

will appear again. When you have entered 

the last file or if you have no entry, just 

enter cr.

5. FOR SYMBOL AND NUMBERS (WITH 

PLOTTING), TYPE 1; FOR SYMBOL AND 

(OR) OUTLINE (NO NUMBERS), TYPE 2; 

FOR NUMBERS ONLY (NO SYMBOLS 

OR PLOTTING), TYPE 3. If you had no entry for C4 just enter cr. Otherwise, type in 

the number and cr.

6. Screen is erased.

7. ENTER TITLE FOR MAP. Example: U.S. 

MAP

8. TO PLOT INDIVIDUAL STATES, ENTER

1-FOR ENTIRE U.S., ENTER 2. You 

must enter 1 or 2.

9. TO PLOT GRID, ENTER 1. If you want the 

grid, type 1 and cr; otherwise just type cr.

10. IF YOU WANT A HARD COPY UPON COMPLETION, TYPE C.

11. Screen is erased. If you entered 1 in response 

to C8, the following will appear on the 

screen:

GIVE NUMBER OF STATES TO BE

PLOTTED

LIMIT OF 10 IN ASCENDING ORDER

MUST BE A 2 DIGIT NUMBER, 01-51 

For example, to plot the States of Illinois 

(12), Indiana (13), Kentucky (16), Ohio (34), 

and West Virginia (49), respond with the 

code number for each State, as follows: 

1213163449.

This means a group of as many as 10 

States. The States and their corresponding 

numbers appear on listing 6.

Screen is erased. The States along with 

GRASP files or grid file are plotting; if the 

user typed c in response to CIO, a hard copy 

will be made automatically at this time.

12. FOR AN ENLARGEMENT OF PART OF 

THIS PLOT, TYPE Y. Type y and cr if you 

want an enlargement; otherwise enter cr 

and proceed to C17.

13. FOR A HARD COPY AFTER ENLARGEMENT, TYPE C. If the user wants an 

automatic hard copy, type c and cr; otherwise just enter cr.

14. POSITION CURSOR AT LOWER LEFT OF 

DESIRED AREA: TYPE C. Postion the 

vertical and horizontal cursors at the desired 

location, type c and cr.

15. POSITION CURSOR AT UPPER RIGHT OF 

DESIRED AREA, TYPE C. Position the 

vertical and horizontal cursors at the upper 

right location, type c and cr.

16. Screen is erased. An enlargement of the 

desired area is plotted, and an automatic 

hard copy is made upon completion if the 

user typed c in response to C13.
52 GEOINDEX

LISTING 6. - The 48 conterminous States and District of Columbia and their corresponding two-digit numbers that are used for plotting individual

States

[These are codes used on file stat 90 (not FIPS codes)]

Alabama

Arizona

Arkansas

Calfornia

Colorado

Connecticut

Delaware

District of Columbia

Florida

Georgia

Idaho

Illinois

Indiana

Iowa

Kansas

Kentucky

Louisiana

Maine

Maryland

Massachusetts

Michigan

Minnesota

Mississippi

Missouri

Montana

AL

AZ

AR

CA

CO

CT

DE

DC

FL

GA

ID

IL

IN

IA

KS

KY

LA

ME

MD

MA

MI

MN

MS

MO

MT

01

02

03

04

05

06

07

08

09

10

11

12

13

14

15

16

17

18

19

01-04

21

22

23

24

25

Nebraska

Nevada

New Hampshire

New Jersey

New Mexico

New York

North Carolina

North Dakota

Ohio

Oklahoma

Oregon

Pennsylvania

Rhode Island

South Carolina

South Dakota

Tennessee

Texas

Utah

Vermont

Virginia

Washington

West Virginia

Wisconsin

Wyoming

NE

NV

NH

NJ

NM

NY

NC

ND

OH

OK

OR

PA

RI

SC

SD

TN

TX

UT

VT

VA

WA

WV

WI

WY

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

51

APPENDIX C. COMPUTER-PROGRAM 

REFERENCE

EXEC_COM NAME: COMTAPE.EC

Author: Pearl Porter

Purpose of the program: comtape.ec reads an outside 

ASCII tape into the Multics system and writes the 

tape into a segment given by the user. Comtape.ec is 

written in Multics command language. All the programs in the Geoindex are written in Fortran IV 

unless otherwise specified.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: ec comtape nnnnnn segno/me

Arguments:

-ids- Input description of the tape

-ods- Output description 

Subroutines called: None

Common data referenced: None

Input file: refNM on magnetic-tape

Output file: refNM

Arrays used: None

Called by: None

Error checking and reporting: The comtape.ec segment will work for tapes that are unlabeled and second in the file sequence and have fixed length format, 

density of 800, record length of 80, and block size of 

800. After the comtape.ec has been executed, do not 

try to type in other commands until the process has 

been completed because this can cause errors.

Constants: None

Program logic:

1. An outside ASCII tape is read into the Multics 

system and written to a segment that the user 

specified.

2. The user will receive a count number of the records 

copied onto SEGNAME, and the file will 

automatically be dprinted.

copy_file -ids "tape.ibm_ &1 -nib -nb 2 -fmt fb -den

800" -ods "record_stream_ -target vfile_ &2" dp &2

iqu i t

1600 -rec 80 -bk
APPENDIX C 53

PROGRAM NAME: CHKREF

Author: Harold Johnson

Purpose of the program: chkref is used to check the accuracy of the reference files. It checks whether certain 

records are integer or real numbers, whether the 

records exceed their prescribed lengths, whether the 

State number is consistent, whether the records are in 

the correct order within each individual reference, 

whether the separate references are in correct order, 

and whether the first record is correct.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: None

Arguments: None

Subroutines called: assoc, setup_chkref, 

clean_chkref, checkitem_chkref, reup_chkref, 

rfskip__chkref

Common data referenced: None

Input files: refNM, matrix

Output files: refNM

Arrays used: None

Called by: None

Error checking and reporting: Messages are written to 

the interactive user when the State number is wrong, 

when the id number is out of order, when the item 

number is out of order, when the initial item number 

for a reference is not 2, when the State name is wrong, 

and whenever a read error occurs. The user is informed of the total number of records that were read 

in the reference files.

Constants: None

Program logic:

1. The file to be checked and the control file matrix are 

attached to Fortran numbers 30 and 22 by calling 

assoc.

2. Vectors itype, ichar, and item are set up by the 

subroutine setup, which describes the type and 

number of character postions allocated to each 

reference item.

3. Subroutine clean puts blanks into the words of if He, 

/file, and ifilel.

4. A reference record is read, noting its State number 

istate, reference number jf, and item number/f/n. 

The reference data on this record is read into I file.

5. Subroutine checkitem uses jtm to check if the type 

of data in /file is integer or floating point as 

prescribed by itype for this jtm and whether or 

not jfile lies in limits prescribed by ichar.

6. I file is read into ifilel and reup_chkref transfers 

information from jf, jtm, and jfile into if, itm, and 

if He, respectively.

7. A new record is read into jstate, jf, ftm, and jfile, 

and they are checked by checkitem_chkref. 

i state and jstate are compared to see if they are 

identical.

8. Where if is greater than jf, the if numbers are out of 

order, and an error message notes this; where if is 

less than jf, a new reference file has been reached, 

and it is checked to see if item number jtm is a 2.

9. Where if is equal to jf, item numbers are compared 

to see if jtm is greater than itm. Unless itm is 87 

(indicating that there are repetitions in this 

reference), an error message appears.

10. After an error or after satisfactorily passing each 

test, reup_chkref is called to move jf, jtm, and 

jfile to if, itm, and if He. Then control passes to 

step 7.

11. After all records have been checked, ncard, the 

number of cards read, is written in a message to 

the user.

c ******** CHKREF PROGRAM *****

c SEPT. 16, 1976 H. JOHNSON

c

external io (descriptors)

c

THE FOLLOWING FILES ARE REQUIRED FOR THIS PROGRAM:

INPUT FILES:

22 - "MATRIX" FILE WHICH FORMATS IRIS RECORDS.

30 - REFERENCE FILE TO BE CHECKED.

OUTPUT FILE:

06 - MESSAGE FILE.

c

c

c

c

c

c

c

c

c

c

\cD

c

Converted to Multics February 17, 1977 H 

THIS PROGRAM IS WRITTEN TO RUN ON THE

Johnson 

NEWEST REFERENCE FILES

WHICH ARE MADE UP TO USE WITH THE NEWEST GRASP PROGRAM, IRIS AN 

EATE
54 GEOINDEX

c THIS PROGRAM IS DESIGNED TO RUN THROUGH THE REFERENCE FILES AND

c CHECK FOR THEIR ACCURACY.

c IT CHECKS WHETHER THE FILE IS INTEGER OR REAL IF IT IS SUPPOSED

\c TO

c BE

c IT CHECKS IF THE FILE IS WITHIN THE PRESCRIBED LIMITS

c IT CHECKS ON THE STATE NUMBER

c IT CHECKS ON THE ORDER OF THE SEPARATE FILE SUBJECTS.

c IT CHECKS ON THE OREDER OF THE ITEMS WITHIN A SINGLE SUBJECT.

c

c

dimension itype(46),ichar(46),item(46,10),ifile(73),jfile(73)

dimension ialpha(5),ifilel(50) 

character*32 filename

data iblank/" "/ 

call io ("attach","file22","vfile_ ","matrix","-append","-ssf")

call io ("open'V'file22","si")

write(6,890) 

890 format(" enter the file name to be checked :")

read 895, filename 

895 format (a32)

call io ("attach","file30","vfile_",filename,"-append","-ssf")

call io ("open","file30","si") 

c 

c 

c 

c

idim=46

c IDIM IS THE NUMBER OF RECORDS IN THE MATRIX FILE 

c

call setup_chkref(itype,ichar,item,idim)

c THIS SET UP THE MATRICES ITYPE(IDIM),ICHAR(IDIM),ITEM(IDIM,IWII 

\cDE)

c WHICH DESCRIBE THE TYPE AND NUMBER OF CHARACTER POSITIONS 

c ALLOCATED TO EACH ITEM. 

c

nfile=73

call clean_chkref(ifile,nfile)

c THIS ROUTINE PUTS BLANKS INTO THE WORDS OF IFILE. 

c

call clean_chkref(jfile,nfile)

nfile=40

call clean chkref(ifile1,nfile)

call rf skip__chkref (ncard )

c THIS ROUTINE READS DOWN FILE 30 LOOKING FOR THE FIRST TRUE RECOR 

\cD,

c SKIPPING THE CARDS WHICH MERELY DESCRIBE THE REFERENCE FILE, 

c NCARD IS THE KEY NUMBER FOR THE FIRST RECORD, 

c IT POSITIONS 30 READY TO READ THE FIRST RECORD, 

c

ncard=1
APPENDIX C 55

C

read(30,930,end=1000,err=500)istate,jf,jtm,(jfile(k),k-l,73) 

930 format(12,13,12,73al) 

c

call checkitem_chkref(Idim,ncard,Item,jtm,jfile ,ltype,ichar 

\c)

c THIS ROUTINE CHECKS IF THE FILE IS INTEGER OR FLOATING POINT 

c WHEN ITS ITM NUMBER INDICATES THAT.

c IT ALSO CHECKS IF THE FILE IS CONTAINED WITHIN THE BOUNDARY SET 

\cBY

c ITS ITM NUMBER.

c THESE TYPES AND LIMITS ARE READ FROM MATRIX AND FOUND HERE IN TH 

\cE 

c FILES ITYPE AND ICHAR.

do 5 k=l,40

ifilel(k)=jfile(k) 

5 continue

call reup_chkref(itype,ichar,item,idim,if,itm,ifile,jf,jtm,jfile) 

c THIS ROUTINE PUTS INFORMATION IN THE J-FILES,JF,JT,JFILE, 

c INTO THE IFILES IF,ITM,IFILE. 

c 

10 ncard=ncard+l

read(30,930,end=1000,err=500)jstate,jf,jtm,(jfile(k),k=1,73)

call checkitem_chkref(idim,ncard,item,jtm,jfile,itype,ichar)

if(istate .eq. jstate) go to 20

write(6,940)ncard 

940 format(" THE STATE NUMBER IS WRONG ON RECORD NUMBER M ,i6)

write(6,93 l)jstate,jf,jtm,jfile 

931 format(i2,13,i2,73al)

call reup_chkref(itype,ichar,it em,idim,if,itm,iflle,jf,jtm,jfile)

.go to 10 

c 

20 if(if .le. jf) go to 30

write(6,950)ncard

950 format(" THE IF NUMBER IS OUT OF ORDER IN RECORD NUMBER ",i6 

\c)

write(6,93 l)jstate,jf,jtm,jfile 

call reup_chkref(itype,ichar,it em,idim,if,itm,ifile,jf,jtm,jfile)

go to 10 

c 

30 if(if .it. jf) go to 40

if((itm .It. jtm) .or. (itm .eq. 87)) go to 35

write(6,960)ncard 

960 format(" THE ITEM NUMBER IS OUT OF ORDER AROUND RECORD NUMBER",i6)

write (6,93 l)jstate,jf,jtm,jfile 

35 call reup_chkref(itype,ichar,item,idim,if,itm,ifile,jf,jtm,jfile)

go to 10 

c 

40 if(jtm .eq. 2) go to 50

write(6,9 70)ncard 

970 format (" THE ITEM SHOULD BE 2 IN RECORD NUMBER If ,i6)

write(6,93l)jstate,jf,jtm,jfile 

call reup_chkref(itype,ichar,item,idim,if,itm,if lie,j f,jtm,jfile)

go to 10
56 GEOINDEX

c 

50

60 

c

do 60 k=l,40 

if (ifilel(k) 

cont inue

ne. jfile(k)) go to 70

call reup_chkref(itype,ichar,item,idim,if,itm,ifile,jf,jtm,jfile)

go to 10 

c

70 write(6,980)ncard 

980 format(" THE STATE NAME IS WRONG IN RECORD NUMBER ",i6)

write(6,931) jstate,jf,jtm,jfile 

call reup_chkref(itype,ichar,item,idim,if,itm,ifile,jf,jtm,jfile)

go to 10 

c 

c

500 write(6,990)ncard 

990 formatC" THERE WAS A READ ERROR ON RECORD NUMBER ",16)

call reup_chkref(itype,ichar,item,idim,if,itm,if ile,j f,jtm,jfile)

go to 10 

c 

1000 write(6,1900)ncard

1900 format(" YOU REACHED THE EOF AFTER READING ",i6," RECORDS.") 

c ******************************************************

call io ("close","file22") 

call io ("close","fileSO") 

call io ("detach","file22") 

call io ("detach","fileSO") 

c ******************************************************

stop 

end 

c ******** END **********

SUBROUTINE NAME: RFSKIP_CHKREF

Author: Harold Johnson

Purpose of the program: rfskip_chkref checks to locate

the record having reference number 1 and item

number 2, which should be the first record in most

reference files. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call rfskip_chkref (j) 

Arguments: j-The record number in the reference file,

which has reference number 1 and item number 2 

Subroutines called: None 

Common data referenced: None 

Input files: refNM

Output files: None

Arrays used: None

Called by: chkref

Error checking and reporting: The record number of the 

beginning record is always reported. If no correct first 

record is found, a message to that effect is sent to the 

user.

Constants: None

Program logic:

1. Each record is read to determine its reference

number, ib, and its item number, /c.

2. These are compared with 1 and 2 until a match is 

found. This matching record is reported to the 

user.

3. If no match is found, a warning message is written to 

the user, the file is closed, and control returns to 

chkref.
APPENDIX C 57

c ******* SUBROUTINE R F SKI P_C HKR E F *******

c *

c *******************************************************

c

subroutine r f sk i p_chk ref ( j ) 

data ione/" 1 "/7itwo/"2 "/

1

900

read (30,900,end = 1 00) ia/ib/ic

format Ca2/a4,a1 )

if(ib .eq. ione .and. ic .eq, ic) go to 10

go to 1

10 wri te(6/910) j 

910 formatC" THE REFERENCE DATA BEGINS AT THE",i4,"TH RECORD")

back space 30

return 

c ***************************************************

100 write(6,920)

920 formatC' THERE WAS NO FIRST RECORD FOUND! what's wrong?")

rewind 30

return

end

SUBROUTINE NAME: CLEAN_CHKREF

Author: Harold Johnson

Purpose of the program: clean_chkref inserts blank

characters in each word of the vector if lie. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call clean_chkref (ifile,nfile) 

Arguments:

if He-A vector

n file-The number of elements in if He

Subroutines called: None 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: if He 

Called by: chkref, reup_chkref 

Error checking and reporting: None 

Constants: None 

Program logic:

1. The blank character is inserted into each word of I file 

by a do loop.

c ******* SUBROUTINE CLEAN_CHKREF *******

subroutine clean.chkrefCifi Le/nf i Le)

c THIS ROUTINE PUTS BLANK WORDS INTO THE FILE IFILE. 

c

c HJohnson February 16/ 1977 

c

dimension ifile(nfile)

data iblank/" "/

do 10 k = 1,nfi Le

i fi le(k) = id Lank 

10 cont i nue

retu rn

end 

c ********* END CLEAN.CHKREF *********
58 GEOINDEX

SUBROUTINE NAME: REUP_CHKREF

Author: Harold Johnson

Purpose of the program: reup_chkref transfers the

characters in /file to if He. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call reup_chkref (itype,ichar,item,-

idim,if,itm,ifile,jf,jtm,jfile) 

Arguments:

if He A vector containing the reference data in a 

refer-record

jfHe- The same kind of vector as if lie 

Subroutines called: clean_chkref 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: ifile(73), jfile(73) 

Called by: chkref

Error checking and reporting: None 

Constants: None 

Program logic:

1. clean_chkref is called to put blanks into If He.

2. Characters in jfile are written into if He.

c ******* SUBROUTINE REUP_CHKREF *******

subroutine reup_chkref(itype,ichar,item,idim,if,itm,ifile,jf,jtm,j 

\cfile)

dimension itype(idim),ichar(idim),item(idim,10),ifile(73),jfile(73

&)

c H Johnson February 17, 1977

c

If-Jf

itm=j tm

nfile=73

call clean_chkref(ifile,nfile)

10

c 

c

do 10 k=l,73 

ifile(k)=jfile(k) 

con tinue

return 

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

end

c ******* END REUP CHKREF *******

SUBROUTINE NAME: BLANKCHECK_CHKREF

Author: Harold Johnson

Purpose of the program: blankcheck__chkref checks to

see if the information in the current record being

checked is within the limits prescribed by matrix. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call blankcheck__chkref (ichar,jfile, -

ncard) 

Arguments:

ichar- The admissible length of the current reference 

item

I file- The vector of characters obtained from the current reference record

ncard- The number of the record in the reference file 

currently being examined

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: jfile(73)

Called by: checkitem_chkref

Error checking and reporting: When jfile is too long, a 

message explaining the problem, giving the record 

number along with a printing of the file jfile and the 

number of the erroneous nonblank characters is sent 

to the user.

Constants: None

Program logic:

1. All characters after the icharih are compared with 

the blank character. Discrepancies are reported.
APPENDIX C 59

******* SUBROUTINE 3LANKCHtCK_CHKREF.FORTRAN ******* 

subroutine blankcheck_chkref(ichar*jfile^ncard)

this routine checks to see if

within ichar spaces by seeing

H Johnson February 16* 1977

the file jfile(73) is contained 

if the oth^r spaces are blank

10

900

dimension jfile(73)

data iblank/" "/

Jo 10 k=1,4

i = i c har + k

ifCjfileCi) .ne. iblank) go to 20

con t i nue

return

wri teC6,9UO)ncard/i

formatC" THE FILE IS TOO LONG ON RECORD NUMBER i6 BECAUSE

CHARACTER ",i2/" IS NOT BLANK")

writeC6,901)CjfileCk),k=1,73) 

901 formatC" THIS DATA IS "*73a1)

return 

c ******************************************

end 

C *******£NO BLANKCHECK.CHKREF *******

SUBROUTINE NAME: TYPECHECK_CHKREF

Author: Harold Johnson

Purpose of the program: typecheck_chkref checks to 

see whether the information in the current reference 

record represents an integer or floating-point 

number when that type is indicated by its item 

number.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call typecheck__chref (itype,ifile,ncard)

Arguments:

itype- One of the type of 1 or 2 

if He A vector of characters obtained from a record of

the reference file being checked 

ncard-The number of the current record being 

checked

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: checkitem_chkref

Error checking and reporting: When if He is wrong, this

is reported to the user, along with the record number

and copy of if He. 

Constants: None 

Program logic:

1. If the item number is 1, each character in if fie is 

checked to determine if it is 0,1,2,3,4, 5, 6,7,8,9, 

or blank.

2. If the item number is 2, each character is compared 

with these same integers and then with a period. 

The program checks that exactly one period occurs.

3. Any discrepancies are reported to the user.

******* SUBROUTINE TYPECHECK_CHKREF.FORTRAN *******

subroutine typecheck__chkref (itype, if lie , ncard) 

dimension ifile(73),number(12)

this subroutine checks whether the type indicated by itype

corresponds to what is found in ifile.

H Johnson February 16, 1977
60 

c

\c","7 

&","8

1 

c 

c

GEOINDEX

data number/"0 1

15

10

c 

c

20

II It Q It It It II II / 

» " » > « /

if(itype .eq. 2) go to 20

WHEN ITYPE IS 1 WE TEST TO SEE IF IFILE CONTAINS ONLY INTEGERS, 

do 10 j=l,20 

do 15 k=l,11

if(ifile(j) .eq. number(k)) go to 10 

c ont inue 

go to 500 

cont inue 

return

WHEN ITYPE IS 2 WE TEST TO SEE IF IFILE IS A REAL NUMBER.

cont inue

iflag=0

do 30 j-1,20

do 35 k=l,11

if(ifile(j) .eq. number(k)) go to 30

cont inue

if (if il-e(j) .ne. number(12)) go to 510

iflag = iflag+1

if(iflag .ne. 1) go to 510

cont inue

if(iflag .ne. 1) go to 510

return 

c

500 write(6,920)ncard

920 format(" THERE IS SUPPOSED TO BE AN INTEGER IN RECORD NUMBER ",i6 

\c)

write(6,92 l)ifile

35

30

921

c

510 

930 

\ci6)

format(" THIS DATA IS ",73al) 

return

write(6,930)ncard

format(" THERE IS SUPPOSED TO BE A REAL NUMBER IN RECORD ",

write(6,921)ifile 

return 

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

end

c ******* END TYPECHECK CHKREF *******

SUBROUTINE NAME: LOCAT1_CHKREF

Author: Harold Johnson

Purpose of the program: Iocat1_chkref determines the 

line and column of matrix in which a given item 

number occurs by using the matrix, item, which was 

constructed from matrix.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call locatl_chkref (jtm,idim,item,-

line,kolumn) 

Arguments:

jtm-An item number of the current reference record

idlm -The number of rows in item
APPENDIX C 61

line -The line in item where jtm is located 

kolumn-The column in item where jtm is located

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: item(idim, 10)

Called by: checkitem_chkref

Error checking and reporting: Done by checkitem_chkref when line = 0 

Constants: None 

Program logic: 

1. jtm is compared with each element of item using a do

loop, checking by columns first, since most items

occur in the first column.

c ******* SUBROUTINE LOCAT1_CHKREF *******

subroutine Iocat1_chkref(jtm/idifn/item/line/kolumn)

dimension item(ioim/10)

line=U

koIumn=U

ao 10 k = 1 ,10

do 10 j=1/idim

if(jtm .eq. item(jsk)) go to 20 

10 cont inue

return 

20 Li ne = j

koIumn=k

re t u rn 

c ***************************************************

*******

end 

END LOCAT1 CHKREF *******

SUBROUTINE NAME: CHECKITEM^CHKREF

Author: Harold Johnson

Purpose of the program: checkitem_chkref checks

whether jfile is integer if jtm is 1 or floating point

when jtm is 2. It checks whether the number of

nonblank characters in jfile is at most ichar(lin). 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call checkitem_chkref (idim,ncard,-

item,jfile,itype,ichar) 

Arguments:

idim- The number of lines in matrix

ncard-The number of records that have been read in 

the reference file

jtm-The item number on the current record being 

checked

jfile-The reference data in the current record, a vector

itype-The vector of types from matrix

ichar-The vector of maximum allowable lengths

from matrix

Subroutines called: Iocat1_chkref, typecheck_chkref, 

blankcheck_chkref

Common data referenced: None

Input files: None

Output files: None

Arrays used: jfile(73), item(idim,10), itype(idim), 

ichar(idim)

Called by: chkref

Error checking and reporting: When Iocat1_chkref 

cannot match jtm with any item number in item, a 

message is written along with the file jfile to the user.

Constants: None

Program logic:

1. Iocat1_chkref is called to determine which line of 

matrix contains jtm.

2. If itype(line) is 1 or 2, typecheck_chkref is called to 

check whether jfile is a character representation of 

integer or floating-point data.

3. blankcheck_chkref is called to check whether jfile 

contains at most ichar(line) nonblank characters.
62 GEOINDEX

H

900 

\c)

901

c 

c 

2

c 

c 

c 

50

c 

c 

c

c 

c

******* SUBROUTINE CHECKITEM_CHKREF *******

subroutine checkitem_chkref(idim,ncard,item,jtm,jfile,itype,ichar)

dimension jfile(73),item(idim,10),itype(idim),ichar(idim) 

THIS CHECKS TWO THINGS ABOUT JFILE. 

DOES THE FILE CONTAIN INTEGERS OR FLOATINGPOINT NUMBERS WHEN JTM IS 1 OR 2?

IS THE FILE CONTAINED IN THE LIMITS SET BY MATRIX FOR THIS ITEM?

Johnson February 16, 1977

call locatl_chkref(jtm,idim,item,line,kolumn)

THIS SUBROUTINE LOCATE FINDS THE LINE AND COLUMN OF MATRIX 

WHICH CONTAINS THE ITEM = JTM.

if(line .gt. 0) go 

write(6,900)ncard 

formatC1 THE MATRIX FILE

write(6,901)jfile 

format(" THIS DATA 

return

to 2

DOES NOT CONTAIN THE ITEM ON RECORD

IS ",73al)

i6

IS .GT. 2 JFILE CAN BE ANY 

.or. itype(line) .eq. 0)go

WHEN THE TYPE OF THE ITEM

if (itype(line) .gt. 2

ity=itype(line)

call typecheck_chkref(ity,jfile,ncard) 

THIS SUBROUTINE CHECKS WHETHER THE TYPE INDICATED 

CORRESPONDS TO WHAT IS FOUND IN JFILE.

ich=ichar(line)

call blankcheck_chkref(ich,jfile,ncard) 

THIS CHECKS TO SEE IF JFILE IS CONTAINED IN 

ICHAR(LINE) SPACES.

return 

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

CHARACTER, 

to 50

BY ITYPE(LINE)

end 

*******END CHECKITEM CHKREF *******

SUBROUTINE NAME: SETUP_CHKREF

Author: Harold Johnson

Purpose of the program: setup__chkref reads the file 

matrix to construct vectors itype and ichar and 

matrix item that indicates for each item in the 

reference file its type, its allocated space, and its item 

number.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call setup_chkref (itype,

ichar,item,idim) 

Arguments:

itype-The vector of length idim whose /cth entry is 

the type of the kth kind of record in matrix (integer, 

floating point, or alphanumeric) 

ichar-The vector of length idim whose kth entry is 

the maximum allowable length of the kth kind of 

record described by matrix
APPENDIX C 63

item -The idlm by 10 matrix giving the item 

numbers in matrix allocated to the various kinds of 

records

idim-The number of records in matrix 

Subroutines called: None 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: None 

Called by: chkref

Error checking and reporting: When matrix does not 

contain exactly the number of records indicated by the 

value of idim, an error message is sent to the user.

Constants: None

Program logic:

1. Records in matrix are read into a 1, a2, itype(j), b1, 

b2, ichary), d, c2, (item(j,k\K= 1,10).

2. When the EOF of matrix is sensed, the number of 

read records is compared with idim to see whether 

they are equal.

c ***** SUBROUTINE SETUP_CHKREF *******

subroutine setup_chkref(itype,ichar,item,idim) 

dimension itype(idim),ichar(idim),item(idim,10)

J-o

1 J-J+1

read(22,900,end=100)al,a2,itype(j),bl,b2,ichar(j),cl,c2,c3,(item 

\c(j,k), 

&k=l,10)

900

100

910

200

c

c

c

format(2a4,i2,2a4,i6,2a4,al,10i3)

go to 1

if(j-l.eq. idim)go to 200

write(6,910)j,idim

format(" J = ",i3," BUT IDIM = ",i3)

return 

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

end

c ****** END SETUP CHKREF *****

EXEC_COM NAME: GEOFMT.EC

Authors: Kevin W. Laurent, Larry C. Harms, and

Pearl Porter 

Purpose of the program: geofmt.ec executes a series of

command lines and routines without user intervention.

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: ec geofmt page lines nbipp 

Arguments:

page- Number of lines on the page

lines-Number of lines needed at bottom of page to 

write a complete reference

nbipp-Used to designate whether or not the

proportional-space printer is to be used 

Subroutines called: geofmt, geofmt.qedx,

geofmt2.qedx, geofmtS.qedx, geofmt4.qedx are all

executed. 

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: None

Error checking and reporting: The user must enter the 

arguments when executing geofmt.ec or she will 

receive a message stating the current buffer and level 

and the commands that have not been executed. This 

same message will appear if the user asks for too 

many references to be processed at one time. We 

recommend that 550 references be the maximum 

number processed at one time.

Constants: None

Program logic:

1. A command is given to turn off the COMMAND—LINE to prevent the commands from being written out.

2. The file name given by the user is attached to fileW. 

3 . The output from geofmt, geofmt.data, is attached

tofile11. 

4. The fortran program geofmt is executed.
64 GEOINDEX

5. fileW and file11 are detached.

6. The user is asked if she needs to edit.

7. If the third argument is nbipp, subroutine geofmta.qedx is executed. Otherwise, subroutine 

geof mt.qedx is executed.

8. DL GEOFMT.RUNOFF. This will delete the old 

copy (if one exists).

9. FO GEOFMT. RUNOFF; RF GEOFMT; FO is a 

command to direct geofmt.runoff to a segment, 

and RF will run off geofmt; CO directs output 

back to the terminal.

10. The user is queried whether she wants 7 columns or 

not. This is a combination of 4 on the first page 

and 3 on the next page and so forth. If she 

responds yes, geofmt2.qedx is executed. If she

answers no, geofmtS.qedx is executed, and every 

page will have four columns.

11. DL GEOFMT.COLUMNS. This will delete the old 

copy (if one exists).

12. If the third argument is nbipp, then embed_tabs 

is executed. Otherwise, the next statement is executed.

13. Four segments called over I ay 1, over I ay2, overlays, 

and overt ay4 are combined, using the overlay 

command, into one segment called geofmt.columns.

14. Eight segments created during this process are 

deleted.

15. Quit.

&

& /* The geofmt exec_com is used to perform steps necessary to

& create a columnar print of input reference data* */

&

icomman online off

&

i /* run reformat program */

£

io attach f i I e 1 0 vfile_ [response "ENTER FILE NAME:"]

io attach file11 vfile. geofmt. data

geofmt

io detach filelO 

io detach file11

& /* Edit geofmt. data */

£

iif [query "Do you need to edit?"]

it hen

&else igoto nextstep

& i nput .Line off

&a 1 1 ach

qx

r geofmt. data

est ty -modes I 180

eioa. "Edi t. " /Enter

&det ac h

i

& I abe I nextstep

&

s 1 1 y -modes I 1 1 32

&

& /* create runoff segment */

&

&if [equal &3 "nbipp"]

&then qx jeofmta i 1 ci 2

"" q "" to exit editor.
APPENDIX C 65

Seise qx geofmt S1 &<?

&

& /* put runoff output into segment */

S

dt geofmt.runout -bf

fo geofmt.runout » rf geofmt^co

S

5 /* break output into A files (columns) */

6

Sif Cquery "00 YOU WANT 7 COLUMNS?"]

Sthen qx geofmt2 S 1

Seise qx geofmt3 i1

&

£ /* create columnized output */

&

dl geofmt.columns -bf

&if Cequal S3 "nbipp"J

Sthen embed_tabs & 1

Seise do "fo geofmt.coIumns^over lay overlayl overlay? -in 34 overlay3 -in

S67 overlayA -in 100 -pi Si;co"

&

5 for linolex -- qx geofmtA £1

6

S /* delete intermediate segments */

S

dl geofmt . (runoff runout data) -bf

dl over lay(1 2 3 A) -bf

Squi t

SUBROUTINE NAME: GEOFMT.QEDX

Authors: Kevin W. Laurent, Larry C. Harms, and Pearl

Porter 

Purpose of the program: geof mt.qedx, an edit routine,

creates a RUNOFF segment using geofmt.data,

which was created during the execution of geof mt. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: None 

Arguments:

&1 - Passed from the exec_com and contains the page 

length (usually 84 or 140)

<£#-Contains the number of lines needed at the bottom of the page to type a complete reference 

Subroutines called: None 

Common data referenced: None 

Input files: geofmt.data 

Output files: geofmt.runoff 

Arrays used: None 

Called by: geofmt.ec

Error checking and reporting: Located in geofmt.ec 

Constants: None

Program logic:

1. The two arguments used when executing geofmt.ec 

are read into a buffer called argrs, and the first 

argument (which is the page length) is moved to a 

buffer called lines. The second argument (number 

of lines needed at bottom of page for printing a 

complete reference) is moved to a buffer called 

need. These two argements are used with .PL and 

.NE, respectively, as runoff commands. The initialization routine puts RUNOFF commands into 

buffer 0.

2. Segment geofmt.data is read into a buffer called 

file.

3. A special character {, a brace that is made by 

depressing the shift key and left bracket key 

simultaneously, is appended to the end of 

geofmt.data as an end of file indicator.

4. The RUNOFF commands and one line of data at a 

time is moved from buffer file to buffer 0.

5. Step 4 is repeated until the special end of file indicator is detected, at which time it is deleted.

6. Write geofmt.runoff.

1. Quit to exit from text editor.
66 GEOINDEX

b (ma i n )

$a

b(f i le)

1 m ( i nput )

bO

Sa

. un 7

.ne \c \b (need )

\ c \b( input )

\c\f

w geof mt . runof f

q

\f

b( Loop)

Sa

\ c \b ( ma i n)

\c\b(loop)

\f

b ( args )

1 in ( I i nes )

1 m (need )

b( I i nes )

1s/\c

//

b (need )

1s/\c

bO

$a

-Pi

.11

. ma

. na

.in 7

\f

b(f i le)

r geofmt

$a<\f

bO

\bdoop)

\bdines)

30

0

dat a

SUBROUTINE NAME: GEOFMT

Authors: Kevin W. Laurent, Larry C. Harms, and Pearl

Porter 

Purpose of the program: geof mt reads the reference file,

extracts selected data, arranges it in a predetermined

order, and writes it out as a string of data,

geofmt.data. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: geofmt

Arguments: None

Subroutines called: None

Common data referenced: None

Input files: refNM(NM, two-digit FIPS State code) used

on unit 10 

Output files: geofmt.data format(i3,". ",396al) used on

unit 11 

Arrays used: iordr(34), istor(34), icoma(34), nuse(34),

/cocte(34,60), iout(396) 

Called by: geof mt.ec

Error checking and reporting: Located in geof mt.ec 

Constants: None
APPENDIX C 67

Program logic:

1. Files are attached and opened in geofmt.ec.

2. The user is prompted for the State number, starting reference number, and ending reference 

number.

3. The arrays are loaded with blanks except nuse, 

which is loaded with zeros.

4. The reference file is read until the beginning 

reference number given by the user, ibgin, matches the record just read, /re/. Load iref into /re/.

5. The item number is matched against the array /orIf no match is found, go to step 4.

If item number is 87, load flag87 with an 87. 

If equal, /care/ is loaded into icode(i), item is loaded into istor(i), and a 1 is stored in nuse(i).

6. Continue steps 4 and 5 until jref no longer equals 

iref.

7. If nuse(i), where / equals 13, 15, . . ., 31, equals 1, 

load icoma(i) with a 1. Add 1 to ipnct. Load kk 

with /.

This routine checks for scales and commas can be 

inserted later, ipnct has the number of commas 

that will have to be inserted, and kk contains the 

number as specified by ordr of the last scale. This 

field, kk, will be checked later to determine 

whether or not a period and an extra space are required for output.

8. The number of characters and spaces in icode(i,j)

is loaded into /'save.

9 . If the current record is a scale, check ipnct. 

If ipnct = 0, go to step 12. 

If flag87 = 87, go to step 10. If the reference has

an ITEM 87, a comma will be placed after the

scale rather than a period, as more data will

follow the scale. 

If ipnct = 1, to to step 11. This indicates that there

is only one scale field and that no punctuation will

be needed.

10. If icoma(i) = 0, go to step 12. Add 1 to /save. Load 

icode(i,isave) with a comma.

11. Subtract 1 from ipnct.

12. If the current record is not the year, ITEM 8, go to

step 13. Load icode(i,isave) with a comma. 

Go to step 16.

13. If the current record is not the publisher, ITEM 17,

go to step 14.

If the last character of this record is a period, insert 

an extra blank after the period, add 1 to /save, 

and then go to step 16.

14. If the current record is not the series, ITEM 23, go

to the step 14A.

If the current record is ITEM 23, check istor(11) = 

60, which means that the series is continued on 

another record.

Otherwise, put an extra space after ITEM 23 data.

Go to step 16.

If istor(i) is not = 60, go to 15. Put extra space

after ITEM 60 data. 

Go to step 16.

15. If the current record is not a scale (item 18-22, 

61-65), go to step 16. If / = kk, which means this 

is the last scale in the reference, load a period at 

the end of the field.

Load lout with 1:

Load iout with the scale and necessary commas 

separating the field.

Go to step 17.

16. iout(istart) = icode(i,jj) where // = 1, save. This 

routine will load iout with the current record using /save as the counter to move the exact 

number of characters and spaces for that record.

17. If / = kk, meaning this record is the last scale, istart

= istart + 1.

This will insert another space after the scale, giving 

a total of 2 spaces between the scale and next 

record.

18. If the value of lstor(l) is not equal to 86, go to step

19.

If istor(33) equals blank, and istor(34) equals blank, 

go to 20.

istart = istart + 1 will give a total of 2 spaces between the ITEM 86 record and the next record.

19. If istor(i) is not equal to ITEM 35, go to step 20. If 

istor(34) equals blank, go to step 20. 

istart = istart + 1. This will insert an extra space 

after the ITEM 35 record has been written to 

iout.

20. istart = istart + 1, iout(istart) = blank space. This 

will put a space between each record written to 

iout. Repeat steps 8-20 until / = 34, then go to 

next step.

21. If flag87 = 87, continue reading the records, steps 

8-20, until a new reference number is found. Load 

flag87 = 0. Write geofmt.data on unit 11 using 

jref, (iout(i), i = 1, istart), and format (13,- 

". ",396al).

If jref = iendref, go to step 24. (This means the 

reference number of the record just written is the 

last record to be processed, iendref is the ending 

reference number given by the user.)

If lend = 1, go to step 24. This is the last record on 

the file.

22. Load jref with iref. iref is the reference number of 

the last record read before processing the current 

reference data.

23. Initialize the arrays by loading them with blanks. Go 

to step 5.

24. Stop.
68 GEOINDEX

GEOFMT. FORTRAN

This program reads the reference file/ extracts selected records 

as determined by iordr/ stores them in icode according to iordr 

and writes it out as a string of data.

General outline of program written by Larry Harms of CCD. 

Written in detail by Pearl B. Porter/ April/ 1978

dimension iordr(34)/i stor(34)/nuse(34)/icoma(34)

character*! icard(65) /i code(34/65)/iout (396)

data iordr/3/4/5/8/9/10/11/37/17/23/60/39/18/40/19/

& 41 ,20/42/21 /43/22/66/61/67/62/ 68 /63/69/

& 64/70/65/86/35/34/

10

20

22

24

26

30

40

50

60

70

80

STATE NUMBER")

write (6/10)

format(" TYPE IN

read ( 5/20) j st a

f orma t ( i 2 )

write (6/22) 

ATTENTION For Calif./ ref

format (" WHAT IS YOUR

read (5/24) ibgin 

ATTENTION Change (i3) to

f o rmat ( i 3)

write (6/26) 

ATTENTION For Calif./ ref number will be 4 digits

format (" WHAT IS YOUR ENDING REFERENCE NUMBER?

read (5/24) iendref

number will be 4 digits. 

STARTING REFERENCE NUMBER? (use

(i4) for California.

3 digits)")

(use 3 digits)")

Initialize arrays to blanks

do 30 i=1/65 

icard( i )=" " 

do 40 j=1/34 

do 40 i=1/65 

i code( j /i ) = " 

do 50 k=1/34 

icoma(k)=" " 

do 60 i =1 /34 

nu se ( i ) =0 

i stor(i )=" " 

do 70 i=1/396 

iout (i ) =" " 

i pnc t = 0 

f I

Read reference file until the current record equals the 

beginning reference number given by the user.

read ( 1 O/ 1 1 0/end = 900) i s t a/ i re f / i t em/ i c a rd 

if (iref .ne. ibyin) go to 80 

j ref = iref 

go to 120
APPENDIX C 69

c jref contains the reference number of the data being processed, 

c

100 read(1J/110/end=155) ista/iref/item/icard 

c ATTENTION For Calif./ change i3 to i4. 

110 format(i2/i3/i2/65a1)

if (jref .ne. iref) go to 160 

if (flag87 .eg. 87) go to 160 

c

c Does record contain an item code = to an item code in iordr 

c 

120 do 130 i=1/34

if (item .eq. iordr(i)) go to 140 

if (item .eq. 87) flag87 = 87 

130 cont i nue

go to 100 

c

c Load icode with icard as determined by iordr* store item in istor 

c and turn on nuse(i) which indicates there's data for this 

c particular it em. 

c

140 do 150 j=1/65 

150 icode(i / j) = icard(j) 

i s tor(i ) = i t em 

nuse(i)=1 

go to 100 

c

155 iend = 1 

c

c Check scales to determine how many commas will be needed 

c when written out to file11 (geofmt.data ) . 

c 

160 do 170 i=13/31/2

if (nuse(i) .eq. 0) go to 170

c If nuse(i) = O/ there's no data for this record, 

i coma(i) = 1 

kk = i

i pnc t = i pnc t + 1 

170 continue 

c

c Store in isave the total numoer of characters and 

c significant spaces contained in the record, 

c

if (flag87 .eq. 87) go to 175 

i start = 0 

175 do 500 i=1/34 

i save = 0

if (nuse(i) .eq. 0) go to 50J 

do 180 j=1/o5

if (icode(i/j) .eq. " ") go to 180 

i save= j

180 cont i nue 

c

c Check for scales and if there's more than one scale/ 

c insert commas after the scales.
70 GEOINDEX 

C

if ((istor(i) .ge. 18 .and. istor(i) .le. 22) .or. 

& (istorCi) .ge. 61 .and. istor(i) .le. 65)) go to 190

go to 220 

190 if (ipnct ,eq. 0) go to 220

if (flag87 .eq. 87) go to 200 

if (ipnct .eq. 1) go to 210 

c

200 if (icoma(i) .eq. 0) go to 220 

i save = i save + 1 

icode(i/isave)="/" 

210 i pnc t = i pnct-1 

c

c If item d (year)/ put comma after the year, 

c

220 if (istor(i) .ne. 8) go to 230 

i s ave = isave+1 

icode(i/isave)="/" 

go to 400 

c

c If the publisher has a period at end of field/ 

c two spaces must follow the period, 

c 

230 if (istor(i) .ne. 17) go to 240

if (icode(i/isave) .eq. ".") isave=isave+1 

go to 400 

c

c There must be 2 spaces after the series, 

c

240 if (istor(i) .ne. 23) go to 245 

if (istordl) .eq. 60) go to 245 

i save = i save + 1 

go to 400 

c

245 if (istor(i) .ne. 60) go to 250 

i save = i save + 1 

go to 400 

c

c When working with scales/ precede the scales with "1:" 

c 

250 if ((istor(i) .ge. 18 .and. istor(i) .le. 22) ,or.

& (istor(i) .ge. 61 .and. istor(i) .le. 65)) go to 260

go to 400

260 if (i .ne. xk) go to 270 

i pnc t = 0

if (flag87 .eq. 87) go to 270 

i save = i save + 1 

icode(i/isave)="." 

270 iout(istart+1)= "1" 

iout(istart+2)= ":" 

i sta rt = i star t + 2 

i korp = 0

if (isave .le. 3)go to 400

if (icode(i/isave) .eq. "/" .or. icooe(i/isave) .eq. ".*' 

& ikorp=1
APPENDIX C 71

i thi = 3

if ( i ko rp . eq.

if (isave . ne.

if ir = 2

i sec = 3

go to 330

1 )

9)

i th i = 4

go to 280

c

c Depending on the size of the scale field/ there will be 

c from 1 to 3 moves to load the data in the output, 

c ithi (3rd load) will contain a 3 unless the last 

c position of the scale is a period or comma/ then it 

c will contain 4, isec (2nd) and ifir (1st) will 

c be loaded according to the number of digits in the 

c scales. A comma is loaded after ifir and isec. 

c 

280 if (isave .ne. 8) go to 290

isec = 3

ifir = 2

if (ikorp .eq. 1) ifir = 1

go to 330 

c 

29U if (isave .ne. 7) y o to 300

isec = 3

ifir = 1

if (ikorp .eq. 1) ifir = 0

go to 330 

c 

300 if (isave .ne. 6) go to 310

ifir = 0

isec = 3

if (ikorp .eq. 1) isec = 2

go to 330 

c 

310 if (isave .ne. 5) go to 320

ifir = 0

isec = 2

if (ikorp .eq. 1) isec = 1

go to 330 

c 

320 ifir = 0

i sec = 1

if (ikorp .eq. 1) isec = 0 

c

c Load the first (ifir) set of digits followed by comma, 

c 

330 i pos = 1

i seemv = isec

if (ifir .eq. 0) go to 350

Jo 340 j j = i pos/ifir

istart = istart-H 

340 iout(istart)=icode(i/jj )

iout(i start +1)="/"

istart = istart-H

ipos = i f i r+ 1

isec = i sec + i f i r
72 GEOINDEX 

C

c Load the second (isec) set of digits followed Dy comma, 

c

350 if (isec .eq. U) go to 370 

do 360 jj=ipos/isec 

is tart = istart+1 

360 iout(istart) = icode(i/jj ) 

iout(istart+1)="/" 

istart = istart+1 

i pos = i pos + i s ecmv 

ithi = i t h i + i s e c 

c

c Load third (ithi) set of digits, 

c 

370 do 380 jj=ipos/ithi

istjrt = istart+1 

380 iout(istart)=icode(i/jj)

90 to 425 

c

c Load iout with icode depending on isave. 

c

400 do 420 j j = 1 /isave 

istart = istart+1

420 iout(istart) = icode(isjj) 

425 if (i .eq. kk) istart = istart+1 

c

c If any data follows "Also other maps"/ 

c put 2 spaces after "Also other maps", 

if (istor(i) .ne. 86) go to 430

if ((istor(33) .eq. " ") .and. (istor(34) .eq. " ")) go to 450 

istart = istart+1 

go to 450 

c 

430 if (istor(i) .ne. 35) go to 450

if (istor(34) .eq. " ") go to 450 

istart = istart+1 

c

c Increase istart by 1 so a space appears between records of data 

c 

450 istart = istart+1

iout(istart) = " " 

500 c ont i nue 

c

if (flag&7 .ne. 87) go to 525 

if (jref .ne. iref) go to 510 

if (iend .ne. 1) go to 565 

510 istart = istart-1

if (iout ( istart) .eq. "/") iout(istart) = "." 

if (iout (istart ) .ne. " ") go to 525 

go to 510 

c 

c 

c Write the string of data to file11 (geofmt.data)
APPENDIX C 73

AT

550

560

565

570

590

900

905

1000

write (11/550) jref/(iout (i) * i = 1/istart) 

TENTION For Calif./ change i3 to iA. 

format(i3/". "396a1) 

i start = 0

iendref is the ending reference number given by the user 

if (jref .eq. iendref) go to 1000 

if (iend .eq. 1) go to 1000

jref = iref

Initialize arrays before processing next reference.

do 560 i=1,396 

iout(i) = " " 

do 570 j=1/3A 

do 570 i=1,65 

icode(j/i) = " " 

do 590 i=1/3A 

icoma(i) - " " 

nuse(i) =0 

i stor(i ) = " " 

cont i nue 

flag87 = 0 

go to 120

write (6/905)

format (" THE BEGINNING RECORD WAS NOT FOUND")

stop

end

SUBROUTINE NAME: GEOFMT2.QEDX

Authors: Kevin W. Laurent, Larry C. Harms, and Pearl 

Porter

Purpose of the program: geofmt2.qedx formats the file 

geofmt.runout into alternating 4 and 3 columnar output acceptable for use by the overlay command to 

create a columnarized output segment.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: qx geofmt2 &1

Arguments: &1-H contains the page length (84 or 

140) and was passed from the exec_com, geofmt.ec.

Subroutines called: None

Common data referenced: None

Input files: geofmt.runout

Output files: overlayl, overlay2, overlays, overlay4

Arrays used: None 

Called by: Executed by geofmt.ec 

Error checking and reporting: geofmt.ec 

Program logic:

1. The initialization routine creates four segments: 

overlayl to overlay4. A segment, geofmt.runout, is read into buffer, file. A special character is 

appended to the segment as an end of file indicator.

2. The loop macro will move a specified number of lines 

(determined by the page length argument when 

geofmt.ec was executed) into each of the four 

overlay segments. Then the specified number of 

lines are moved into overlayl, overlay2, and 

overlays. This loop alternates in moving data to all 

four segments, and then three segments, until the 

end of file indicator is read.

3. All four segments are written.

4. Quit the text editor.
74 GEOINDEX

b(4col)

$a

\c\bC test)

1*\c\b(args)m(input)

b(inpu t)

Or over Lay1

1/$w over lay 1

\c\D(test)

1*\c\b(args)m(input)

b C i nput)

Or overlay?

1/$w overlay2

\c\b(test)

1*\c\b(args)m(input)

b(i nput)

Or overlays

1/Sw overlay3

\c\o(test)

1*\c\b(args)m(input)

b C input)

Or ove r I ay4

1/$w overl ay4

\c\b(3col)

\f

b(3col )

$a

\c\b(test)

1/\c\b(args)m(input)

b(inpu t)

Or ove r I ay 1

1*$w over lay 1

\c\b(test)

1/\c\b(args)m(input)

b(i nput)

Or overl ay<2 1 f $w overlay2

\c\bCtest)

1/\c\b(args)m(input)

b(input)

Or overlays

1*$w overl ay3

\c\b(args)+1^$d

U$s/".*$//

Or overlay4 1 f $w ove r Iay4

\c\b(4col)

\f

b( test)

$a

b(file)

1s/"<:/t/ q

\f

b Cargs )

1s/\c
APPENDIX C 75

bO

ec r over lay(1 2 3 A)

b(file)

r geofmt•runout

ia{\f

bO

\bUcol)

SUBROUTINE NAME: GEOFMT3.QEDX

Authors: Kevin W. Laurent, Larry C. Harms, and Pearl

Porter 

Purpose of the program: geofmtS.qedx formats

geofmt.runout into four files acceptable for use by the

OVERLAY command to create a columnized output

segment.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: qx geofmtS &1 

Arguments: &1- Passed from the exec_com, geofmt.-

ec, and contains the page length (84 or 140) 

Subroutines called: None 

Common data referenced: None 

Input files: geofmt.runout 

Output files: overlay 1, overlay2, overlays, overlay4

Arrays used: None

Called by: Executed by geofmt.ec

Error checking and reporting: Located in geofmt.ec

Constants: None

Program logic:

1. The initialization routine creates four segments: 

overlayl to overlay4. A segment, geofmt.runout, 

is read into buffer, file, and a special character {, a 

brace, which is made by depressing the shift key 

and left bracket key simultaneously, is appended as 

an EOF indicator.

2. The loop macro moves a predetermined number of 

lines (page length argument used in geofmt.ec) 

first to overlayl, over I ay2, and so forth, until the 

end of file indicator is read.

3. Write the four output segments.

4. Quit the text editor.

b (loop)

$a

\c\b(test )

1*\c\b(arcjs)m( input)

b ( i npu t)

Or overlayl

1 * $w overlayl

\c\b<test>

1*\c\b(args)m(input)

b ( i npu t)

Or ove rIay2

1 * $w over lay 2

\c\b(test)

1*\c\b(args)m(input)

b ( input)

Or overt ay3

1 * $w overlay3

\c\b(test)

1*\c\o(arjs)m(input)

b (input)

Or ove rIayA

1 f $w overt ayA

\c\b(toop)

\f
76 GEOINDEX

bCtest )

$a

b(fi le)

1s/"</{/

q

\f

b(arjs ) 

1s/\c

bO

ecr overt ay(1 2 3 4)

b( fi le)

r -jeof m t. runout

$aUf

bO

\b(loop)

SUBROUTINE NAME: GEOFMTA.QEDX

Authors: Kevin Laurent and Pearl Porter

Purpose of the program: geofmta.qedx, an edit routine,

creates a RUNOFF segment using the file geofmt.-

data, which was created during the execution of

geofmt.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: qx geofmta &1 &2 

Arguments:

&1 -It contains the page length (usually 84 or 140) and 

was passed from geof mt.ec.

&2-lt contains the number of lines needed at the 

bottom of the page to type a complete reference and 

was passed from geof mt.ec. 

Subroutines called: None 

Common data referenced: None 

Input files: geofm t. da ta 

Output files: geofmt.runoff 

Arrays used: None 

Called by: geof mt.ec

Error checking and reporting: Located in geofmt.ec 

Constants: None 

Program logic: 

1. This qedx routine is executed if the third argument

of geof mt.ec is nbipp. It is very similar to 

geofmt.qedx, except the .UN and .IN commands 

for RUNOFF were increased to allow for 

proportional-space printing. The line length was increased from 30 to 42.

2. The two arguments used when executing geof mt.ec 

are read into a buffer called args, and the first 

argument (which is the page length) is moved to a 

buffer called lines. The second argument (number 

of lines needed at the bottom of the page for printing a complete reference) is moved to a buffer called need. These two arguments are used with .PL 

and .NE respectively as RUNOFF commands.

3. The initialization routine puts RUNOFF commands 

into buffer 0.

4. Segment geofmt.data is read into a buffer called 

file.

5. A special character {, a brace, which is made by 

depressing the shift key and left bracket key 

simultaneously, is appended to the end of 

geofmt.data as an end-of-file indicator.

6. The RUNOFF commands, and one line of data at a 

time is moved a from buffer file to buffer 0.

1. Step 6 is repeated until the special end-of-file indicator is detected, at which time it is deleted.

8. Write geofmt.runoff.

9. Exit from text editor.

b C ma i n )

Sa

b(fi le)

1m(i nput)

bO

$a

. un 11

.ne \c\o(need)
APPENDIX C 77

\ c \b ( i nput ) 

\c\f

w geof mt . runo f f

q

\f

b ( loop )

$a

\ c \b (ma i n )

\c\b( loop)

\f

b ( args )

1 m ( I i nes )

1 m (need)

b( lines)

1s/\c

//

b (need )

1s/\c

bO

Sa

• Pi

. II

.ma

. na

. i n

\f

b(fi le)

r 9 e o f m t

$a<\f

bO

Vb(loop)

\bUines)

42

0

11

data

SUBROUTINE NAME: EMBED_TABS

Author: Kevin Laurent

Purpose of the program: embecLtabs, a PL/1 program,

embeds tab commands between the columns of the file

geofmtcolumns to produce a columnar proportional

spaced printout. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: embed__tabs &1 

Arguments: &1 -It contains the page length (usually 84

or 140) and is passed from geofmt.ec. 

Subroutines called: None 

Common data referenced: None 

Input files: overlay 1, overlay2, overlays, overlay4 

Output files: geofmtcolumns 

Arrays used: None 

Called by: None 

Error checking and reporting: If an error occurs the

error code is passed to the command processor, and a

Multics system message is printed. 

Constants: None 

Program logic:

1. The program asks for the number of columns and the 

column width.

2. Tab positions are calculated depending on the column 

width given by the user.

3. The program writes a SET command to geofmt.columns to be used by the NBI. Left margin is set to 

1; top margin is set to 0; a code, J-1, is passed that 

specifies proportional spaced printing; line length 

is set to 132; page length and text length are set according to the first argument given when executing geofmt.ec.

4. The four overlay segments are concatenated and 

written to geofmtcolumns.

5. If an entire line is blank, only the first tab will be 

written, in order to act as a line feed.

6. Files are closed and detached.
78 GEOINDEX

embed_tabs: et: proc (page_len); /* embed 

\ctab commands in nbi proportional spaced printer stream */

/* Written by KLaurent,USGS,CCD,BSAP 6/27/78 */

/* The embed__tabs program accepts input from the overlay files and ad 

\ cds

the embedded commands between line segments to tab the columns. */

del page_len char (*); /* page 1

\cength parameter */

del ioa_$ioa_switch entry options (variable); /* for wr

\citing our concatenated lines to geofmt. columns */

del iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin

\c(35)>; /* for all attachments */

del iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)

\c);

del iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), f

\cixed bin (35) ) ;

del iox_$close entry (ptr, fixed bin (35));

del iox_$detach_iocb entry (ptr, fixed bin (35));

del com_err_ entry options (variable); /* com_er

\cr_ will interpret all the errors and print a standard message */

del error_table_$end_of_info external fixed bin (35); /* use fo

\cr end of file check */

del command_query_ entry options (variable); /* use to

\c ask for ncols and col_width */

del continue_to_signal_ entry (fixed bin (35)); /* use to

\c pass along the error code to the command processor */

del 1 query__info, /* for pa 

\cssing info to command_query_ */

2 vers fixed bin init (2), /* versio 

\cn of structure */

2 yes_or_no_sw bit (1) unal init ("0"b),

2 suppress_name bit (1) unal init ("0"b),

2 status_code fixed bin (35) init (0), /* not us 

\ced here */

2 query_code fixed bin (35) init (0); /* not us 

\ced here */

del answer char (256) var ; /* answer

\c returned from command_query_ */

del query_info_ptr pointer; /*usedf

\cor command_query_ */

del (ncols, col_width) fixed bin; /* number

\c of columns; column width */

/* Retrieve number of columns and column width */

query_info_ptr = addr (query_info);

call command_query_ (query_info_ptr, answer, "embed_tabs", 

\c"Enter number of columns:");

ncols = answer; /* conver 

\ct to internal format */
APPENDIX C

ca

ArrrjiNjjiA \^,

11 command_query_ (query_Info_ptr, answer, "embed_tabs", 

umn width:");

79

^— U. .*-_•- W V/ 111 «* t* i.& VI VJ U

\c"Enter column width:");

col_width = answer;

begin;

del line (ncols) char (256) var ; /* array

\cfor line segments to be concatenated */

del line_str_var char (256) var init (""); /* varyin

\cg length string */

del line_str char (79) init (""); /* concat

\cenated string */

del line_buff char (50) init (" "); /* buffer

\c for input */

del chars fixed bin (21) init (0);

del (sub, temp) pic"999";

del stmt_no pic"9999"; /* statem

\cent number */

del i fixed bin;

del code fixed bin (35); /* standa

\crd error code */

del (ov_ptr (4), tabout_ptr) pointer; /* pointe

\crs to io control blocks */

del buff_ptr pointer; /* pointe

\cr to input buffer */

del 1 tab_f ormat_array,

2 tab (ncols+1) char (9) var;

/* Initialization */

buff_ptr = addr (line_buff); /* store 

\caddress of input buffer in buffer pointer */

line (*) = ""; /* initia 

\clize lines to blanks */

do sub = 1 to ncols+1; /* calcul 

\cate tab positions */

temp = (sub-1)* (col_width-9)+1; 

tab (sub) = "#(ta," || temp || ")";

end;

call iox_$attach_name ("ovl", ov_ptr (1), "vfile_ over 

\clayl", null (), code);

call iox_$attach_name ("ov2", ov_ptr (2), "vfile_ over 

\clay2", null (), code);

call iox_$attach_name ("ov3", ov_ptr (3), "vfile_ over 

\clay3", null (), code);

call iox_$attach_name ("ov4", ov_ptr (4), "vfile_ over 

\clay4", null (), code);

call iox_$attach_name ("tabout", tabout_ptr, "vfile_ g 

\ceofmt.columns", null (), code);

do i = 1 to ncols ;

call iox_$open (ov_ptr (i), 1, "0"b, code); /* op 

\cen overlay segs */ 

end ;
80 GEOINDEX

call iox_$open (t about_p tr, 2, "O lf b, code); 

call ioa_$ioa_switch (tabout_ptr, "F 0001 #(se ml,tO,j

\c-l, 11 32 , p~a ,x~a ) " , page__len, page_len, code); /* set margins & prop 

\c print */

do stmt_no = 2 to 9999; /* do unt 

\cil endfile */

do i - 1 to ncols;

call iox_$get_line (ov_ptr (i), buff_ptr, 50 

\c, chars, code) ;

if ((code = error_table_$end_of_info) & (i = 

\c 1)) then goto endup;

line (i) = substr (line__buff, 1, max (chars- 

\cl, 0)); /* move input line to hold area */

end ;

if ((line (1) = "") & (line (2) = "") & (line (3) 

\c = "") & (line (4) = ""))

then do;

line_str_var = "F " | | stmt_no | | " " | | tab 

\c (1);

line_str = line_str_var; /* move v 

\carying length string to non-varying string */

call ioa_$ioa_switch (tabout_ptr, line_str, 

\c code ) ;

end; 

else do;

do i = 1 to ncols;

if i = 1

then line_str_var - "F " || stmt_no || 

\c" " || tab (i) || line (i) || "//(EX)";

else if i = ncols

then line_str_var = "F " || stmt_no || 

\c"+" || tab (i) || line (i);

else line_str_var = "F " || stmt_no || 

\c"+" || tab (i) || line (i) || "//(EX)";

line_str = line_str_var; /* move v 

\carying length string to non_varying string */

call ioa_$ioa_switch (tabout_ptr, line_ 

\cstr, code);

end ; 

end ; 

end;

endup :

do i = 1 to ncols ;

call iox_$close (ov_ptr (i), code); 

call iox_$detach_iocb (ov_ptr (i), code); 

end;

call iox_$close (tabout_ptr, code); 

call iox_$detach_iocb (tabout_ptr, code);

end; /* end be 

\cgin block */

end embed_tabs;
APPENDIX C 81

SUBROUTINE NAME: TO-NBIPP

Author: NBI personnel. Modified for use with geofmt 

programs by Pearl Porter.

Purpose of the program: to-nbiPP allows the user to 

record segments from Multics on the NBI diskette 

when using the NBI System II as a terminal.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: to-nbiPP

Arguments: None

Subroutines called: None

Common data referenced: None

Input files: geofmt.columns

Output files: None

Arrays used: None

Called by: None

Error checking and reporting: Provisions exist for 

checking and reporting erroneous names and aborting 

program.

Constants: None

Program logic:

1. The user is prompted with the message:

MULTICS FILE NAME TO BE SENT (OR Q 

TO QUIT):

The user types the file name, which can be a 

maximum of 32 characters. 

At the end of transmission, the user types: q.

2. If file^name = q, go to 13.

3. Attach and open fileW.

4. If istat (which is the error code) is not equal to 0, go 

tol.

5. Read a line from the Multics segment into a format

(79al). 

At end, go to step 10.

6. Write the line using a format (lh,79al)

7. Call ioa_$nal("?"). This prints a ? on the screen.

8. Read this character into lack.

9. If lack = 11, go to 5. Otherwise, go to 6. The above 

loop, steps 5 through 9, sends each line and inputs 

each ACK.

10. The next loop holds computer in program so it does 

not receive ACKs while it is in ready, and NBI still 

receives.

11. Read a value into end, using format (al).

12. If value of end is not equal to q, go to 11.

13. Close and detach fileW and stop the program.

to-nbiPP.fortran

(PROVISIONS EXIST

c NBI-MULTICS HANDSHAKE PROGRAM FOR RECEIVING TO NBI'S DISK.

c (10/4/77)

c name = to-nibPP:SPECIAL TO SEND IN DISKETTE FORMAT - AUTOMATIC

c LINES

dimension line(79)

character file_name*32

double precision ec

equivalence(istat,ec)

c REQUEST AND ACCESS DESIRED "FILE" TO BE SENT, 

c FOR ERRONEOUS NAMES AND ABORTING PROGRAM). 

13 print ,"Multics file name to be sent (or q to quit):

read!7, file_name 

1 7 format(v)

if(file_name.eq."q") go to 5

call io ( If attach","filel0","vfile_ n ,file_name)

call io ("open","filelO","si")

if (istat.ne.O) go to 13

call ioa_$nnl ("?")

read(5,20) iack

c LOOP IN PROGRAM WHICH SENDS EACH LINE AND INPUTS EACH 

c (OR NAK). 

1 read ( 10,10,end-3) line 

10 format(79al)

ACK
82 GEOINDEX

2 write(6,ll) line 

11 format(lh,79al)

call ioa_$nnl ("?")

read (5,20) lack 

20 format(i2)

if ( lack.eq.11) go to

go to 2

c EXIT PROGRAM: INPUT 

c RECEIVE "ACKS" 

c THEN IT CLOSES 

3 read(5,30) end 

30 format(al)

if (end.ne."q") go to 3 

5 call io ("close","fllelO")

call io ("detach","filelO")

s top

end

LOOP HOLDS COMPUTER IN PROGRAM SO IT DOES NOT 

WHILE IT IS IN READY AND NBI STILL RECEIVES. 

FILES .

PROGRAM NAME: TO-NBID

Author: to-nbiD was written by NBI personnel in October 1977. It is written in Fortran and is compiled on 

the Honeywell Series 60 computer.

Purpose of the program: to-nbiD allows the user to 

record segments from Multics on the NBI diskette 

when using the NBI System II as a terminal.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: to-nbiD

Arguments: None

Subroutines called: None

Common data referenced: None

Input files: Name of file to be transferred

Output files: Name of file transferred

Arrays used: None

Called by: None

Error checking and reporting: Provisions exist for

detecting erroneous name and halting program. 

Constants: None

Program logic:

1. The user is prompted with the message:

MULTICS FILE NAME TO BE SENT (OR Q 

TO QUIT):

The user types the file name, which can be as 

many as 32 characters long. 

At the end of transmission, the user types: q.

2. If file_name - q, go to 13.

3. Attach and open filelO.

4. If istat (which is the error code) is not equal to 0, go 

tol.

5. Read a line from the Multics segment into a format 

(133al). At end go to step 10.

6. Write the line using a format (lh,133al)

7. Call ioa_$nal("?"). This prints a ? on the screen.

8. Read this character into lack.

9. If lack = 11 go to 5.

Otherwise, go to 6. The above loop, steps 5 through 

9, sends each line and inputs each ACK.

10. The next loop holds computer in program so it does 

not receive ACKs while it is in ready and NBI still 

receives.

11. Read end using format (al).

12. If end is not equal to q, go to 11.

13. Close and detach filelO and stop the program.

to-nbiD.fort ran

c NBI-MULTICS HANDSHAKE PROGRAM FOR RECEIVING TO NBI'S DISK, 

c (10/4/77)

c name = to-nbiD:SPECIAL TO SEND IN DISKETTE FORMAT - AUTOMATIC 

c LINES

dimension line(133)
APPENDIX C 83

character file_name*32

double precision ec

equivalence(istat,ec)

c REQUEST AND ACCESS DESIRED "FILE" TO BE SENT. (PROVISIONS EXIST 

c FOR ERRONEOUS NAMES AND ABORTING PROGRAM). 

13 print ,"Multics file name to be sent (or q to quit): "

readl?, file_name 

1 7 format(v)

if(file_name.eq."q") go to 5

call io ("attach","filelO","vfile_",file_name)

call io ("open","filelO","si")

if (istat.ne.O) go to 13

call ioa_$nnl ("?")

read(5,20) iack

c LOOP IN PROGRAM WHICH SENDS EACH LINE AND INPUTS EACH ACK 

c (OR NAK).

I read (10,10,end-3) line

10 format(133al)

2 write(6,ll) line

II format(lh,133al)

call ioa_$nnl ("?")

read (5,20) iack 

20 format(i2)

if (iack . eq . 1 1 ) go to 1

go to 2

c EXIT PROGRAM: INPUT LOOP HOLDS COMPUTER IN PROGRAM SO IT DOES NOT 

c RECEIVE "ACKS" WHILE IT IS IN READY AND NBI STILL RECEIVES, 

c THEN IT CLOSES FILES. 

3 read(5,30) end 

30 format(al)

if(end.ne."q") go to 3 

5 call io ("close","filelO")

call io ("detach","filelO")

stop

end

PROGRAM NAME: CONCAT

Author: Harold Johnson

Purpose of the program: concat prepares reference files 

for input to the GRASP system. Each set of records 

from one reference are concatenated in the format 

assigned by matrix into one long vector.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: concat

Arguments: None

Subroutines called: ftnumber, main_concat

Common data referenced: None

Input files:

matrix used onunit 22 (file22) 

refNM used on unit 30 (file30)

Output files:

temp77 used on unit 77 (file??)

strgNM used on unit 40 (file40) 

Arrays used: None 

Called by: None

Error checking and reporting: None 

Constants: None 

Program logic:

1. file22 is attached to matrix, file?? is attached to 

a temporary file named temp??, and the user is 

asked for the State id number for the reference file 

being processed. file30 is attached to this State's 

reference file, and file40 is attached to a new output file named strgNM, where NM is the State 

FIPS code.

2. main__concat is called where the main work is processed.

3. All files are closed.
84 GEOINDEX

c ******* CONCAT ******* 

character*32 filename 

character*1 iblank 

character*^ file/ mode 

character*2 state 

character*6 outfile

dimension iout(1211),i first(46),ichar(46),item(46,10),iate(5) 

data iblank/" "/ 

c UPDATED AS OF DEC 27, 1976 H, JOHNSON

Converted to Multics February 21, 1977 H Johnson 

Modified to allow item 87 to indicate extra records, Ma

H J ohnson.

WARNING: ANY CHANGE IN nrec MUST BE MADE BY HAND IN THE 

SUBROUTINE *********************************! ' J ' ! * • J ' J

rch 3, 1977

mod i fy 

i i i i i i i i i i

THE PURPOSE OF THIS PROGRAM IS TO PREPARE REFER 

FOR INPUT TO THE "CREAT" PROGRAM OF "IRIS". A REF 

IS READ FOR EACH IF, ISF, AND A LONG VECTOR RECORD 

WITH REFERENCE ENTRIES LOCATED IN PRE-ASSIGNED POS

ENCE FILES 

ERENCE FILE 

IS CREATED 

ITIONS

REQUIRED INPUT FILES: 

30 = REFERENCE FILE = "refNM"

22 = MATRIX FILE DESCRIBING THE ASSIGNED LOCATIONS. 

05 = INPUT TO TELL REFERENCE FILE NAME AND NUMBER OF LINES OF 

EXPLANATORY DATA TO BE SKIPPED .

REQUIRED OUTPUT FILES: 

77 = WORK FILE 

40 = "strgNi-J" IS THE MAIN OUTPUT FILE.

THIS PROGRAM CONCATENATES THE DIFFERENT "IF" FILES 

FROM THE REF AND REFU FILES INTO LONG FILES FOR INPUT 

TO THE CREATE PROGRAM OF GRASP.

MAIN PROGRAM

FOR THE STATE BEING PROCESSED")

call io ("attach","fiIe22","vfile_","matrix","-append", 

call io ("open","file22","si")

call io ("attach","fiIe77","vfi le. ","temp77") 

call io ("open","fiIe77","sio" ) 

wri te(6,890)

890 format(" ENTER THt 2-DIGIT CODE 

read(5,891 ) state

891 format(a2)

encodeCoutfile,893)state,iblank

mode = "si"

call ftnumber(30,outfiIe,mode)

-ssf")
APPENDIX C 85

encodeCoutfi le/89!>)state 

895 f ormatC'st rg",a2) 

mode = "so"

call ftnumberC40/outfiIe/mode)

MATRIX IS THE INPUT MATRIX WHICH DESCRIBES WHERE THE INPUT 

RECORDS ARE TO 3E LOCATED AMONG THE POSITIONS IN THE OUTPUT 

FILE TEMP01 WHICH IS SET UP FOR GKASP "CREATE"INPUT.

IT IS ALSO REQUIRED TO EQUATE 30 TO THE INPUT REFU OR REF

FILE.

EQUATE 77 TO A TEMPORARY FILE USED

THE OUPUT FILE IS CALLED TEMP01

ONLY IN THIS PROGRAM.

nrec=1211

i wi de = 10

i d i m = 46

NREC IS THE LENGTH OF THE OUTPUT FILES 

IwIDE IS THE NUMBER OF POSSIBLE PLATES 

IDIM IS THE NUMBER OF DIFFERENT KINDS

TEMP01, OR 40. 

THE SAME OUTLINE. 

FILES IN REF OR REFU.

C NREC IS THE LENGTH OF THE OUTPUT FILES IN

C IwIDE IS THE NUMBER OF POSSIBLE PLATES ON

C IDIM IS THE NUMBER OF DIFFERENT KINDS OF

c

nsk i p = 0

call main_concat(nrec/idifn/iwide/iout*ifirst/ichar/item,nskip) 

c THIS READS THE REFU OR REF FILE AND SETS UP* FOR EACH "If" 

c A VECTOR IOUT CONTAINING DATA FROM THE REF FILE IN POSITIONS 

c DESCRIBED BY THE MATRIX. IT THEN WRITES THESE VECTORS OUT 

c TO FILE 40 WHOSE RECORD LENGTH IS NREC. 

endfile 40 

c

c THIS ROUTINE ADDS 

c THIS IS NECESSARY

A BLANK RECORD TO THE END OF STRGnm 

BECAUSE OF A PECULIARITY IN MULTICS.

call io ("close","file22") 

call io ("close","file40") 

call io ("close","ti Ie30"> 

calI io("detach","fi Ie22") 

call io ("detach","fiIe40") 

call io ("detach","fiIe30")

call io C"close","fi Ie77"> 

call io ("detach","file77") 

stop

end

SUBROUTINE NAME: MAIN_CONCAT

Author: Harold Johnson

Purpose of the program: main_concat calls contrLconcat, which sets up the control vectors and 

matrices that determine positioning of data in output 

vectors. It repeatedly calls vector_concat to write 

this information into long vectors in memory. It calls

wryte_concat to output these vectors to the strgNM

file. Each time it checks for repeated data using

ndflg, the flag for ITEM 87. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call main_concat (nrec,idim,iwide,-

iout,ifirst,ichar,item)
86 GEOINDEX

Arguments:

wee-The length of the output vectors 

idim - The number of different kinds of items - that is,

the number of rows in matrix 

iwide-The maximum number of different items

associated with a single row of matrix 

iout-The output vector of length nrec 

ifirst-The control vector of length idim whose /rth entry is the starting position in iout of data associated 

with the name in the kth row of matrix 

ichar-The control vector of length idim whose kth 

entry is the number of allowable characters for data 

associated with the name of the kth row of matrix 

item-The control matrix of dimension idim by 10 of

item numbers occurring in matrix 

Subroutines called: contrLconcat, vector_concat,

wry te__co neat, modify_concat 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: None

Called by: concat

Error checking and reporting: The user is informed:

YOU GOT TO MAIN

Number of records written to strgNM is counted, and 

the user is informed every 25th record because, during 

the long interactive running of this program, the user 

may become anxious about loops and long CPU time.

Constants: None

Program logic:

1. Subroutine contrLconcat is called to set up the control matrices idim, ichar, and item.

2. Subroutine vector_concat is called to set up the output vector for one reference.

3. wryte_concat is called to output that vector.

4. When an ITEM 87 is found, indicating repeated data, 

modify_concat is called to modify the previous 

output vector according to the data that come after 

ITEM 87.

5. The count of output vectors is incremented and a 

message written each time the count equals a 

multiple of 25.

subroutine main_concat(nrec,idim,iwide,iout,ifirst,ichar, 

\citem, 

& nskip)

c subroutine used in main program "concat" 

c updated as of dec. 27, 1976 h. Johnson 

c converted to multics february 27, 1977 h Johnson

dimension iout(nrec),ifirst(idim),ichar(idim),ifile(60)

dimension itern(idim,10)

write(6,9100)

9100 format(" you got to main") 

c

call contrl_concat(idim,ifirst,ichar,item) 

this sets up the control matrix to run this subroutine, 

item(line,kolumn) is the item number in refu. 

ifirst(line) is the starting position in the output file 

for the item.

ichar(line) is the number of positions for itern(line,kolumn) 

in the outfile.

kount= 1

c

1 call vector_concat(nrec,idim,iout,ndflg,iwide,ichar,ifirst,item,kf

\clg)

c this reads through one "if" file in refu. for those items

c in kolumn=l, it sets up a vector iout(nrec) which is to be the 

first output for this "if", it writes the other cards 

having item with kolumn .gt. 1 into a file 77 which will 

be read repeatedly to produce new vectors iout. kflg = 

the number of cards written to 77. ndflag = 1 when end of 

file 30 is reached.
APPENDIX C 87

call wryte_concat(lout,nrec,item,idim,iwide,kflg, 

ichar,ifirst)

this writes the iout received from vector to the output 

file, 40. it then reads through file 77 using the kolumn 

=2 to change iout, writes this new iout vector, then goes 

to kolumn = 2,3, . . .

if(ndflg .ne. -1) go to 5

call modify_concat(iout,nrec,item,idim,iwide,kflg,ichar,ifirst,ndfl 

\cg) 

c

c this routine reads throught records which follow item = 87 until 

the next item = 87 is encountered. it modifies iout only in 

those records which it finds in file 30 between these two items 87 

and then writes the resulting vector and proceeds to modify until 

it senses a new "if".

continue

kount=kount+l

if (25*(kount/25) .It.

write(6,9110)kount

9110 format(" you wrote the 

10 if(ndflg .eq. l)return

go to 1 

c

end

kount) go to 10

",i5,"th vector to the strg file")

SUBROUTINE NAME: ALTER_CONCAT

Author: Harold Johnson

Purpose of the program: alter_concat modifies the output vector when more than one item occurs associated 

with the same name classification. Those data have 

been written to file77, and alter_concat processes 

them.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call alter_concat (iout,nrec,item,idim,- 

kolumn, mstop, ichar, ifirst)

Arguments: 

iout, nrec, item, idim, ichar, ifirst-See main_concat.

kolumn-An assigned column of item, which is to 

determine what data will be used to modify iout

Subroutines called: locate__concat

Common data referenced: None

Input files: None

Output files: None

Arrays used: iout(nrec), ichar(idim), ifirst(idim),

ifile(60)

Called by: wryte_concat 

Error checking and reporting: None 

Constants: None 

Program logic:

1. mstop is set to 0.

2. file77 is read, and id is compared with those in column number kolumn in item. 

If a match is found, mstop is set to 1, iout is modified 

according to the data in this record of file77, and 

the reading is repeated.

3. If no match is found, the next record in file77 is read.

c ******* SUBKOUTINE ALTER_CONCAT *******

subrout ine a lter_concat(iout/nrec/i tern/i dim*kolumn*mstop/ 

i cha r* \ f i rs t)

c SUBROUTINE USED IN MAIN PROGRAM "CONCAT" 

c UPDATED AS OF DEC. 17, 1976 H. JOHNSON 

c Converted to Multics FEBRUARY 18* 1977 H. Johnson
88 GEOINDEX

1

900 

c

c 

10

20

c

100

dimension iout(nrec)/item(idim/10)/ifil.e(6U)/i ff(3) 

dimension ichar(idim)/ifirst(idim) 

ms t op = 0

read(77,900,end=100)istate/(iff(j)/j=1/3)/itro, 

(i fi le(k),k=1,60) 

format(i2/3a1/i2/6Ua1)

cal I locate_concat(i tm/idim/i tern* Ii ne/kolumn) 

i f( I i ne .9 t. 0) go to 10 

go to 1

ms top=1

no= ichar(line)

do 20 j = 1/no

iout(ifirst<line)+j-1)=ifile(j)

con t i nue

go to 1

rewind 77

return 

end

C ******* END ALTER_CONCAT *******

SUBROUTINE NAME: LOCATE_CONCAT

Author: Harold Johnson

Purpose of the program: locate_concat searches the

rows of item under an assigned column to match a

given item number. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call locate_concat (itm,idim,item,-

line,kolumn) 

Arguments:

idim, item-See main concat.

itm -A given item number that is to be found in item

kolumn-A given column number whose column in 

item is to be searched

I ine-The line number in item where itm is found in

the kolumnth column 

Subroutines called: None 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: item (idim,10) 

Called by: vector_concat, alter concat, modify_-

concat

Error checking and reporting: None 

Constants: None 

Program logic:

1. line is set at 0.

2. The column number kolumn in array item is searched 

for a match with itm.

3. If found, that column is equated to line.

******* SUBROUTINE LOCATE.CONCAT *******

subroutine locate_concat(i tm*idim*item*line/kolumn) 

SUBROUTINE USED IN MAIN PROGRAM "CONCAT" 

UPDATED AS OF DtC. 27, 1976 H. JOHNSON 

converted to Multics February 21, 1977 H. Johnson

dimension item(idim/10)

line=0

do 10 j =1 * i a i m

if(itm .eq. item(j * KOIumn)) go to 20
APPENDIX C 89

10

20

cont i nue 

return 

I i ne= j 

return 

end 

EiMD LOCATE. CON CAT *******

SUBROUTINE NAME: MODIFY_CONCAT

Author: Harold Johnson

Purpose of the program: modify_concat reads through 

the records in a reference file that lie between two successive ITEM 87s or between 87 and the next 

reference number and then modifies the previous iout 

vector according to those intermediate records.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call modify_concat (iout, nrec, item, - 

idim ,iwide ,kflg, ichar, ifir st, ndflg)

Arguments: 

iout, nrec, item, idim, iwide, ichar, ifirst-See

main concat. 

kflg, ndflg, iout-See vector concat.

Subroutines called: wryte_concat, locate concat

Common data referenced: None

Input files: None

Output files: None

Arrays used: newout(1211), ifirst(idim), iout(nrec)

Called by: main_concat

Error checking and reporting: None

Constants: None

Program logic:

1. A vector newout is made identical to the input vector 

iout.

2. A record from the reference file is read.

If this represents a new reference file as indicated by 

a new if number, the input reference file is 

backspaced, the newout vector is written, and program control returns.

If the record is a new ITEM 87, newout is written 

and step 1 is repeated.

If the record is neither of these, the record data is 

entered into newout, and the next record is read 

and step 2 is repeated.

c

nd 

c 

5

7

c

10

91

******* SUBROUTINE MOD IFY_CONCAT *******

suorout i ne modi fy.concat(iout/nrec/i tem/idim/i w i de/kflg/ichar/

i f i rs t /ndfIg)

Subroutine used in the new version of concat/ updated to allow 

extra items flagged by item no. 87. 

H Johnson* March 3/ 1977.

This subroutine read through records which follow item = 87 until 

the next item 87 is noted. It modifies iout only in those records 

which it finds between items 87. It then writes the resulting 

vector and continues. If it senses a new "if" it returns.

dimension iout(nrec)/ifirst(idim)/ichar(idim)/ifi I e(60) 

dimension item(idim/10)/newout(1211)

fig = 0

first/ make newout the same as iout/ the original vector..

do 7 j = 1/n rec

newout(j) = iout(j) 

continue

read(3J/910/end=10G1)istate/(newout(j)/j=2/4)/itm/(ifile(k)/k=1/60) 

U format(i2/3a1/i2/oUa1)
90 GEOINDEX

c check to see if a new "if" has been encountered; if it has* backspace

c and ret urn.

c

do 20 j=2,4

if(newoutCj) .ne. iout(j)) go to 1000 

20 cont i nue 

c

c Check to see if a new item 87 has been encountered. If it has* 

c write the newout vector and repeat the process, 

c

i f(i tm .ne. 87) go to 100 

Kflg = 0

calI wryte_concat(newout/nrec/item/idim/iwide/kflg/i cha r/i fi rst) 

go to 5 

c

100 cont i nue

c Now locate the line in matrix which this last-read item occurs in. 

c

do 110 kolumn = 1/10

calI locate^concat(i tm/i d i m/i tem/line/kolumn)

i f( line .ne. 0) go to 120 

110 cont i nue 

c

120 cont i nue

c Modify newout according to ifile in the positions indicated by 

c ichar(line) and ifirst(Iine) . 

c

no = icnar(line) 

Jo 130 j = 1/no

130 newout(ifirst( I ine) + j - 1) = ifile(j) 

c

jo to 10 

c

1000 backspace 3D 

do 1020 j = 2,4 

1020 newout(j) = iout(j)

caI I wryte.concatCnewout/nrec/i tem/idim/iwide/kflg/i char/i fi rst)

ret urn 

c

1001 ndflg=1 

return 

end 

C ******* END MODIFY_CONCAT *******

SUBROUTINE NAME: VECTOR_CONCAT

Author: Harold Johnson

Purpose of the program: vector_concat sets up the output vector for one reference file. When ITEM 87 is 

found, it writes the remaining records for the 

reference to a temporary holding file77.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call vector_concat (nrec,idim,iout,-

ndflg,iwide,ichar,ifirst,item,kflg) 

Arguments: 

nrec, idim, iout, iwide, ichar, ifirst, item-See

main__concat.

ndflag- Indicates by 1 that the end of the input 

reference has been reached
APPENDIX C 91

k fig -The number of records from the reference file

that vector__concat temporarily stored in file?? 

Subroutines called: locate__concat

Common data referenced: None

Input files: refNM

Output files: None

Arrays used: iout(nrec), ifile(60), ichar(idim),

ifirst(idim)

Called by: main_concat 

Error checking and reporting: None 

Constants: None 

Program logic:

1. The output vector lout is first blanked out.

2. The first reference record for the current reference

file is read to set up the reference id and the State 

FIPS code in lout.

3. The rest of the records are read and the row and column of the matrix file is determined where the corresponding item is located. This is done by calling 

locate_concat.

4. Data in each record is inserted into iout using the 

information determined in 3.

5. When ITEM 87 has been read, control is returned to 

main_concat.

6. Whenever items are found that occur in columns of 

item other than the first, those records are written 

to a temporary holding file??. wryte_concat processes file?? to update iout.

c ******* SUBROUTINE VECTOR.CONCAT *******

subroutine vector.concat(nrec/idim/iout/ndflag/iwide/ichar/ 

i f i rst f i tem/ k f lg)

c SUBROUTINE USED IN MAIN PROGRAM "CONCAT" 

c UPDATED AS OF DEC. 27/ 1976 H. JOHNSON 

c Converted to Multics February 21/ 1977 H Johnson, 

c

dimension iout(nrec)/ifile(60),i f i rst(idim)/ichar(idim)

dimension item(idim/10)/iff(3) 

c

data iblank/" "/

ndf lag = 0

kflg=U 

c 

c FIRST/ MAKE IOUT ALL BLANK

do 10 j = 1/nrec

i out(j) = iblank 

10 continue 

c

c READ THE FIRST RECORD TO SET UP THE "ID" NUMBER 

c AND THE STATE IN IOUT 

C

read(3U/90U/end=10U1)istate/(iout(j)/j=2/4)/itm/ 

(i file(k),k = 1,60) 

900 format(i2/3a1/i2/60a1)

do 20 j=1*20

iout(4 + j) = i tile(j)

20 continue

c

30 read(30*90u,end=1001)istate,<iff(j),j=1/3>,itm,(ifile<k>, 

k=1,60)

C CHECK TO SEE IF THIS IS A NEW IF; IN WHICH CASE/ STOP, 

c

do 35 j=1/3

if(iff(j) .ne. iout(1+j)) go to 1000 

35 conti nue 

c

i f(i tm .ne. 87) go to 37 

ndf I ag = -1
92 GEOINDEX

i f (kf tg gt . 0) rewind 77

return % 

37 cont i nue 

c

c When itm = 87 is encountered/ it indicates that the last output 

c vector is to be modified by the next records which follow 

c until the next item = 87 is encountered. Any further records 

c with the same "if" will modify the last output vector obtained from 

c the original file.

c NOW LOCATE THE LINE AND KOLUMN IN WHICH ITM OCCURS. 

c IF IT OCCURS IN KOLUMN 1 , WRITE TO IOUT; OTHERWISE WRITE 

c TO FILE 77.

40

c

50

c

koIumn=1

ca I I locate_concat(i tm/idim/i tern* Iine/kolumn)

WHEN LINE = 0* NO MATCH HAS BEEN FOUND IN KOLUM.M 1. 

IT IS NECESSARY TO CHECK THE OTHER COLUMNS.

if(line .eq. 0) go to 50 

no= ichar(line) 

do 40 j=1*no

iout(ifirst(line)+j-1)=ifi le(j) 

con t i nue 

go to 30

kflg=kf lg+1

c

1000

c

1001

*******

write(77,900)istate,(iff(j),j=1,3),itm,(ifile(k),k=1,60) 

go to 30

back space 30

i f (kf Ig .gt. 0)rewind 77

ret urn

ndf lag=1

if(kf Ig .gt. 0)rewind 77 

return 

end 

END VECTOR.CONCAT *******

SUBROUTINE NAME: WRYTE_CONCAT

Author: Harold Johnson

Purpose of the program: wryte_concat is used to write

the vector iout to the output file strgNM. It also

modifies iout when multiple item numbers occur that

have been written to file??. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call wryte_concat (iout,nrec,item,-

idim,iwide,kflg,ichar,ifirst)

Arguments: 

iout, nrec, item, idim, iwide, ichar, ifirst-See

main_concat. 

kfig -See vector_concat.

Subroutines called: alter__concat 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: iout(nrec), leftov(80) 

Called by: main_concat, modify_concat 

Error checking and reporting: None 

Constants: None
APPENDIX C 93

Program logic:

1. An 80-character vector named leftov is blanked out.

2. Each successive 80-character segment of iout is written to strgNM until a segment of less than 80 

characters remains.

3. This last segment, with blanks from leftov added to 

its right-hand side to make up 80 characters, is 

written to strgNM.

4. If kflg indicates that data exists in file?? for this 

reference, alter_concat is called to modify iout. 

Then step 2 is repeated, kolumn begins at 1 and is 

incremented by 1 until no match is found by 

alter_concat. In this way, repeated data are introduced into iout one column at a time according 

to matrix.

******* SUBROUTINE WRYTE.CONCAT *******

subroutine wryte_concat(iout*nrec*item*idim/iwide*k 

i cha r, i f i rs t )

SUBROUTINE USED IN MAIN PROGRAM "CONCAT"

EARNING: THERE IS A SUBROUTINE CALLED WRYTE IN THE PROGRAM " 

UPDATED DEC. 2.1* 1976 H. JOHNSON 

converted to Multics February 18/ 1977 H. Johnson

tlg

dimension iout(nrec)*item(idim*10)*v(3) 

dimension ichar(idim)/ifirst(idim)/leftov(8J)

data iblank/" " / 

do 1000 j=1,80 

lef tov( j )= i blank 

1000 continue 

kol umn=1

900

10

no=nrec/80 

do 10 j = 1 *no

write<4G*900)<iout(<JO*(j-1)+k),k 

format(SOal) 

con t i nue

mo=(no+1)*80 - nrec 

no=80*no+1

if(kflj .eq. 0)return

kol urn n= kol umn + 1

ifCkolumn ,gt. iwide)return

cat I alter_concat (iout^ 

ichar^ifirst)

c THIS RUMS THROUGH FILE 77 AND COMPARES ITM WITH ITEM 

c (J, KOLUMN) *J=1 /IOIM. WHEN A MATCH IS FOUND, IOUT IS 

c MSTOP = 0 WHEN NO MATCH HAS BEEN FOUND.

if(mstop .eq. 0) return

if(kolumn .eq. iwiae)return

go to 1

CHANGED

c *******

end 

END *RYTE_CONCAT *******
94 GEOINDEX

SUBROUTINE NAME: CONTRL_CONCAT

Author: Harold Johnson

Purpose of the program: contrLconcat sets up the control vectors ifirst and ichar and the matrix item that 

are used to process the records.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call contrLconcat (idim, ifirst, ichar, - 

item)

Arguments: See main__concat.

Subroutines called: None

Common data referenced: None

Input files: matrix used on unit 22 (file22)

Output files: None

Arrays used: None

Called by: main_concat

Error checking and reporting: None

Constants: None

Program logic:

1. By means of a do loop, the file matrix is read to determine for each row the locations of the first 

character, the number of admissible characters, 

and the associated item numbers for each kind of 

data.

c ******* SUBROUTINE CONTRL_CONCAT *******

subroutine contrl_concat(idim*ifirst*ichar*item) 

c SUBROUTINE USED IN MAIN PROGRAM "CONCAT" 

c UPDATED AS OF DEC. 27, 1976 H. JOHNSON 

c Converted to Multics February 21 r 1977 H Johnson 

c

dimension itirst(idim)*ichar(idim)*item(idim*lU)

do 10 j =1 * i d im

900

10

(i tem(j,k),k=1,10) 

format(2a4,a2,i 5,i9,i 9,1Qi3) 

con t i nue 

return 

end 

c ******* END CONTRL_CO!MCAT ******

FILE NAME: MATRIX

Purpose of the file: matrix assigns to the item numbers 

that occur in the reference files the following data: 

acronyms, type numbers, intitial character positions, 

maximum character lengths, and terminal character 

positions in the strgNM and redyNM files that are 

used as input to the GRASP routines.

Format: Each record contains iacron, itype, ifirst, 

ichar, Hast, and from 1 to 10 items, located as follows: 

a9 (left-justified), il, i5, i9, i6, 3X, and from 1 to 10 as 

i3.

Arguments: 

iacron-An acronym associated with the items

/type-A code for the GRASP program to indicate 

what type of data occurs in the record (1 means integer; 2 means floating point number; 3 means dictionary character; 6 means character string)

if irst-The initial position in the records of strgNM 

and redyNM files where this information is to be 

stored

ichar-Maximum allowable length of this information

Has t- Last position in the records of strgNM and 

redyNM where this information is allowed

item -From 1 to 10 item numbers that are associated

with this acronym 

Referenced by: chkref, concat, GRASP

mat rix

ID

STATE

AUTHOR 1

AUTHOR2

AUTHORS

YEAR

1

3

6

6

6

1

1

5

25

85

145

205

4

20

60

60

60

4

4

24

84

144

204

208
APPENDIX C 95

TITLE1

TITLE2

TITLES

TITLE4

COUNTY1

COUNTY2

COUNTY3

PUBLISH

SERIES

SERIES2

EMPHASI

AREA

AUNIT

NLAT

SLAT

WLONG

ELONG

CLAT

CLONG

OMAPS

AVAIL

BASE

GEOLOGY

PLATE

IDSTAT

SCALE

IDSUB

IBOUND

ISPAN

ALSOMAP

DUMO

DUM1

DUM2

DUM3

DUMA

DUM5

DUM6

DUM7

DUMB

DUM9

6

6

6

6

6

6

6

6

6

6

6

2

6

1

1

1

1

1

1

6

6

3

3

6

1

1

1

1

1

6

1

1

1

1

1

1

1

1

1

1

209

269

329

389

449

509

569

629

689

749

809

869

877

884

896

908

920

932

944

956

1016

1076

1106

1118

1148

1150

1158

1160

1166

1172

1202

1203

1204

1205

1206

1207

1208

1209

1210

1211

60

60

60

60

60

60

60

60

60

60

60

8

7

12

12

12

12

12

12

60

60

30

12

30

2

8

2

6

6

30

1

1

1

1

1

1

1

1

1

1

268

328

388

448

508

568

628

688

748

808

868

876

883

895

907

919

931

943

955

1015

1075

1105

1117

1147

1149

1157

1159

1165

1171

1201

1202

1203

1204

1205

1206

1207

1208

1209

1210

1211

9

10

11

37

12

13

14

17

23

60

24

25

26

27

28

29

30

31

32

34

35

36

38

39 40 41 42 43 66

44

18 19 20 21 22 61

45 46 47 48 49 71

50 51 52 53 54 76

55 56 57 58 59 81

86

87

88

89

90

91

92

93

94

95

96

67 68 69 70

62 63 64 65

72 73 74 75

77 78 79 80

82 83 84 85

PROGRAM NAME: TAPEDWG

Author: Richard Thoensen

Purpose of the program: tapedwg reads a group of card 

images from a tape created on a 32 bit machine and 

creates a System 101 drawing file. The header card is 

followed by data cards that contain 6 points per card 

in (12F6.3) format.

Data base: Geoindex

Computer: Data General Nova 1220

Operating system: System 101

Calling sequence: tapedwg

Arguments: None

Subroutines called: save, msgot, numin, yesno, 

modlc, fckbk, rdtape, ckcrd, hex8, rdhdr, asflc, 

erase, rdcrd, rwcon, rewin, bell, ovrly, exit2, skip

Common data referenced: Iblkl, Ipntr/, Imenull, /exec/, 

/dskbf/, /ident/, /tape/, /tpdwl/, /tpdw2/, /font/

Input files: Tape that contains mapNM

Output files: coorNMdw, bordNMdw, gridNMdw, 

statNMdw, counNMdw

Arrays used: None

Called by: None

Error checking and reporting: A message will be printed 

out if a data error or tape error occurs.
96 GEOINDEX

Constants: None 

Program logic:

1. Initialize data fields.

2. Send message to terminal: 

TAPEDWG OVERLAY 

PAUSE MOUNT TAPE ON UNIT 0

3. Send message to terminal:

CHARACTER HEIGHT = 

and store the response in texth.

4. Send message to terminal: 

SYMBOL # =

5. Send message to terminal: 

#OFPENS = ,1,2, or 3 

and store response in ipen.

6. Send message to terminal:

TEXT WANTED?? l=yes, 0 = no 

and store in iftext

7. Multiply the character height texth by 1.5 and store 

in sfact.

8. Send message to terminal:

SKIP FILES? 

Call yesno. 

If yes, call skip. 

Otherwise, go to next step.

9. Call rdtape to read the tape. 

Ifjstat = 4, go to step 24. 

Ifjstat not = 0, go to step 25.

10. Call hex8.

11. Call rhhdr.

12. Call asflc to find the number temp in ibuff(1).

isubf - temp + 0.5.

Write the value of isubf using (16) format. 

If isubf = 9999, then go to step 29. 

If isubf is greater than 1000, then subtract 1000

from isubf. 

If isubf equals 1000, load isubf with 998.

13. Call erase to clear the screen.

14. Call asflc to find the number temp in ibuff(6), isf

= temp + 0.5. 

If the error code istat = 1, set isf = 1.

15. Call asflc to find number temp in ibuff(11).

If the error code is 1, then set not = 0; otherwise, 

set not = temp + 0.5.

16. Call asflc to find the number temp in ibuff(16). 

If the error code is 1, then set ispan = 0; otherwise, 

set ispan = temp + 0.5.

17. If /sfr?o is greater than 6, then set ie = 6; otherwise, set ie = isf no.

18. Call rdtape to read the tape.

19. Callckcrd.

If ibad = 1 (error code) go to 18.

20. CallhexS.

21. Call rdcrd to read the data card. 

If kstat = 1 go to 26.

22. If iftext is not equal to 1, call rwcon to format symbols only, iftext will be = 1 if text was wanted, 

otherwise it will be a 0.

23. Call rwcon to format the drawing file.

Continue steps 18 through 23 until jstat - 4.

24. Call msgot to print on the terminal:

END OF FILE REACHED? 

Go to step 27.

25. Message:

TAPE ERROR # (NM and the error code.) 

Go to step 27.

26. Message:

DATA ERROR

27. Call msgot to send message to the terminal: 

REWIND TAPE?

28. Call yesno.

If ians = 1 call rewin to rewind the tape.

29. Call msgot to send message to the terminal: 

PROGRAM FINISHED!!

TAPEDWG 

10THOENSEN76

SOURCE=<TAPEDWG:F> 

OBJECT=<TAPEDWG:R>

PURPOSE:

TO READ A GROUP OF CARD IMAGES FROM A 

TAPE CREATED ON A 32 BIT MACHINE 

AND CREATE A SYST 101 DWG FILE. 

HEADER CARD FOLLOWED BY DATA CARDS 

W/ 6 PTS PER CARD 12F6.3 FORMAT
APPENDIX C 97

C.

C.

C

C

C

C

C

C

C

C

C

C

C

C

REMARKS:

THIS PROGRAM HAS KNOWLEDGE OF FILE STRUCTURE.

WHEN RWCON READS A RECORD IT TRANSFERS 

THE DATA TO COMMON /LINBF/ LTYPE,LWIDE 

AND TO COMMON /SYMBF/ MIRSY,SKLSY

WHEN RWCON WRITES A RECORD IT TRANSFERS THE DATA 

FROM COMMON /MENU1/ KODE,MRFLG,SFACT,LNMOD,LNWID

THE CURRENT SYST 100 VALUES FOR LINE WIDTH 

AND TYPE ARE STORED IN COMMON /MENU1/

COMMON /BLK/X(30),Y(30),A(10),K(30),KP,ID(80)

COMMON /PNTR/KPT(3,2)

COMMON /MENU1/ KODE,MRFLG,SFACT,LNMOD,LNWID

COMMON /EXEC/ IEXEC(64),REXEC(64)

COMMON /DSKBF/ IDUM(3),LENG

COMMON /IDENT/ IDA(3)

COMMON /TAPE/ IBUF(40),ICRD(80)

COMMON /TPDW1/ XX(6),YY(6),IBLANK,ISF,ISF2,IBUFF(20)

COMMON /TPDW2/ LS(5 ) ,LSF(5),ISFNO,LSF2(5),LSPAN(5)

COMMON /FONT/ IFONT

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE

(K(2),K2) 

(K(4),KF) 

(K(11),KEY)

2) ,ISUBF)

3) ,NSYMB) 

(K(15),NCHAR) 

(IEXEC(31) , JUSTH) 

(IEXEC(32) , JUSTV)

(A(l) , ANGLE) 

(A(2) ,TEXTH) 

(IEXEC (19) ,LNMSV) 

(IDA(1),IFNO) 

(IDA(2) ,NOR) 

(IDA(3),NIF)

(IEXEC (20) , LNWSV)

DATA IBLANK /2H /

CALL SAVE(l)

KNT = 0

IBAD=0

ISTAT=0

JSTAT=0

KSTAT=0
98 GEOINDEX

LSTAT=0

MSTAT=0

MRFLG=0

SFACT=1

LNMOD=1

LNWID=0

IFONT=0

ANGLE=0

JUSTH=1

JUSTV=1

IDA(1)=0

IDA(2)=0

IDA(3)=0

CALL MSGOT("ITAPEDWG OVERLAY")

CALL NUMIN("j ITAPE DRIVE NO. (0 OR i)

MTUNIT=TEMP

PAUSE MOUNT TAPE PLEASE

",TEMP)

200 CALL NUMIN("|CHARACTER 

IF (TEXTH) 200,210,210

210 CALL NUMIN("|SYMBOL # < 

NSYMB-TEMP 

IF (NSYMB) 210,210,220

220 IF (NSYMB-200) 230,230 

230 CALL NUMIN("|# OF PENS= 

IPEN=TEMP

IF (IPEN .LT. 1) GO TO 

IF (IPEN .GT. 3) GO TO

HEIGHT=",TEXTH) 

'",TEMP)

210 

,1,2

230

230

OR 3",TEMP)

CALL NUMIN("|TEXT WANTED?? 1 =YES,0=NO",TEMP) 

IFTEXT=TEMP

SFACT=1.5*TEXTH

CALL MSGOT("|SKIP FILES?")

CALL YESNO(IANS)

IF(IANS .EQ. 1)CALL SKIP (MTUNIT , JSTAT )

IF(JSTAT .NE. 0)GO TO 6000

300 LNWID=LNWID+1

IF (LNWID.GT.IPEN) LNWID=1

READ HEADER CARD

IFNO=0 

ISFNO=0 

NOR = 0

CHECK FOR FULL DRAWING FILE

CALL MODLC(KPT(1,2),-3000,MSTAT) 

GO TO (800,7300,7300) ,MSTAT
APPENDIX C 99

800

1000

320

330

335

340

0,80,JSTAT)

CONTINUE

CALL FCKBK(LSTAT)

IF(LSTAT .NE. 0)GO TO 7000

DO 1000 1=1,40

IBUF(I)=IBLANK

CONTINUE

CALL RDTAPE(MTUNIT,IBUF,40,

IF(JSTAT .EQ. 4)GO TO 5000

IF(JSTAT .NE. 0)GO TO 6000

CALL CKCRD(IBAD)

IF(IBAD .EQ. 1)GO TO 800

CALL HEX8 

CALL RDHDR

NCHR1=5 

NCHR2=5 

NCHR3=5 

NCHR4=5

DO 320 1-1,5

IF (LS(I) .EQ. IBLANK) NCHR1=NCHR1-1

IF (LSF(I) .EQ. IBLANK) NCHR2=NCHR2-1

IF (LSF2(I).EQ. IBLANK) NCHR3=NCHR3-1

IF(LSPAN(I) .EQ. IBLANK)NCHR4=NCHR4-1

CONTINUE

J=5-NCHR1

DO 330 I=1,NCHR1

LS(I)=LS(I+J)/400K

IBUFF(I)=LS(I)

CONTINUE

WRITE(10,335) 

FORMAT(50I6)

(LS (I),I=1,NCHR1)

350

J=5-NCHR2

DO 340 I=1,NCHR2

LSF(I)=LSF(I+J)/400K

IBUFF(I+5)=LSF(I)

CONTINUE

IF (NCHR3.EQ.O) GO TO 352

J=5-NCHR3

DO 350 I=1,NCHR3

LSF2(I)=LSF2(I+J)/400K

IBUFF(I+10)=LSF2(I)

CONTINUE
100 GEOINDEX

C

352 IF (NCHR4 .EQ. 0) GO TO 354 

J=5-NCHR4 

DO 353 I=1,NCHR4 

LSPAN(I)=LSPAN(I+J)/400K 

IBUFF(I+15)=LSPAN(I)

353 CONTINUE 

C 

C

354 CALL ASFLC (IBUFF(1),NCHR1,TEMP,ISTAT)

ISUBF=TEMP+.5 

C

WRITE(10,20) ISUBF 

20 FORMAT(I6)

IF (ISUBF .EQ. 9999) GO TO 500 

C

C CLEAR SCREEN 

C

KNT=KNT+1

IF(KNT .NE. 26)GO TO 1100

KNT = 0

CALL ERASE 

1100 CONTINUE 

C

CALL ASFLC(IBUFF(6),NCHR2,TEMP,ISTAT)

ISF=TEMP+.5

IF(ISTAT .EQ. 1)ISF=1

CALL ASFLC (IBUFF(11),NCHR3,TEMP,ISTAT)

NOT-TEMP+.5

IF (ISTAT.EQ.l) NOT=0

CALL ASFLC(IBUFF(16),NCHR4,TEMP,ISTAT)

ISPAN=TEMP+.5

IF(ISTAT .EQ. 1)ISPAN=0

IE=ISFNO

IF(ISFNO .GE. 6)IE=6 

C

C READ FIRST DATA CARD 

C 

1200 CONTINUE

CALL FCKBK(LSTAT)

IF(LSTAT .NE. 0)GO TO 7000

DO 1500 1=1,40

IBUF(I)=IBLANK 

1500 CONTINUE

CALL RDTAPE(MTUNIT,IBUF,40,0,80,JSTAT)

IF(JSTAT .EQ. 4)GO TO 5000

IF(JSTAT .NE. 0)GO TO 6000 

C

CALL CKCRD(IBAD)

IF(IBAD .EQ. 1)GO TO 1200 

C

CALL HEX8 

C

CALL RDCRD(KSTAT)

IF(KSTAT .EQ. 1)GO TO 6500
APPENDIX C 101

C 

C C

IF (IFTEXT .NE. 1) GO TO 400 

C

X1=XX(1)

Y1=YY(1)

NCHAR=NCHR1

DO 360 I=1,NCHR1

ID (I)=LS (I) 

360 CONTINUE

KEY=8

KP=1

CALL RWCON(KF,2)

KEY=16

CALL RWCON(KF,2) 

C C

IF (ISF.EQ. 1 .AND.IFNO.EQ. 1) GO TO 375

NCHAR=NCHR2

DO 370 I=1,NCHR2

370 CONTINUE

KEY=16

CALL RWCON(KF,2) 

C 

C 

375 IF(ISPAN .EQ. 0)GO TO 380

NCHAR=NCHR4

DO 377 I=1,NCHR4

ID(I)=LSPAN(I) 

377 CONTINUE

KEY=16

CALL RWCON(KF,2) 

C C

380 IF (NOT.EQ.O) GO TO 400

NCHAR=NCHR3

DO 390 I=1,NCHR3

ID(I)=LSF2(I) 

390 CONTINUE

KEY=16

CALL RWCON(KF,2) 

C C

400 X1=XX(2)

Y1=YY(2) 

C

C SYMBOL NEEDED IF THIS IS SINGLE PT C

IF (ISFNO.GT.2) GO TO 410

KEY=7

KP = 1

CALL RWCON(KF,2)

GO TO 300
102 GEOINDEX

C

C WRITE PEN UP

C

410 KEY=1

KP=1

CALL RWCON(KF,2)

JJ = 3

GO TO 430 

C 

420 CONTINUE

CALL FCKBK(LSTAT)

IF(LSTAT .NE. 0)GO TO 7000

DO 2000 1=1,40

IBUF(I)=IBLANK 

2000 CONTINUE

CALL RDTAPE(MTUNIT,IBUF,40,0,80,JSTAT)

IF(JSTAT .EQ. 4)GO TO 5000

IF(JSTAT .NE. OJGO TO 6000 

C

CALL CKCRD(IBAD)

IF(IBAD .EQ. 1)GO TO 420 

C

CALL HEX8 

C

CALL RDCRD(KSTAT)

IF(KSTAT .EQ. 1)GO TO 6500 

C 

C 

C

C WRITE PEN DOWN 

C

430 KEY=6

KP=1

DO 440 I=JJ,IE

X1=XX(I)

Y1=YY(I)

CALL RWCON(KF,2) 

440 CONTINUE

JJ=1

IF (ISFNO-6) 300,300,450 

450 ISFNO=ISFNO-6

IE=ISFNO

IF (ISFNO.GE.6) IE=6

GO TO 420

C

C EOF FOUND

C

5000 CONTINUE

CALL MSGOT("|END OF FILE REACHED?")

GO TO 7000 

C

C TAPE ERROR 

C 

6000 CONTINUE

WRITE(10,1001)JSTAT
APPENDIX C 103

1001 FORMAT(IX,'TAPE ERROR #',!!)

GO TO 7000 

C

C DATA ERROR 

C 

6500 CONTINUE

WRITE(10,1002)

1002 FORMAT(IX,'DATA ERROR') 

C

C REWIND UNIT 0 

C 

7000 CONTINUE

CALL MSGOTC (REWIND TAPE?')

CALL YESNO(IANS)

IF(IANS .NE. 1)GO TO 7500

CALL REWIN(MTUNIT)

GO TO 7500 

7300 CONTINUE

CALL BELL

WRITE(10,1003)

1003 FORMAT(IX,'DRAWING FILE FULL|',2(/IX,'DO NOT REWIND TAPE||'),/1X 

\c,'

*SAVE DRAWING FILE,GET NEW DRAWING FILE AND RECALL TAPEDWG OVERLA \cY'

*)

7500 CONTINUE 

C

C DONE 

C

500 ISUBF=999

CALL MSGOT ("(PROGRAM FINISHED(|")

KEY=31

CALL RWCON(KF,2)

KP = 0

CALL OVRLY(1,IER)

CALL EXIT2

END

PROGRAM NAME: DWGDISK

Author: Lawrence Balcerak

Purpose of the program: dwgdisk reads a System 101

drawing file and writes an ASCII disk file containing

the header card and data cards for each feature

outline.

Data base: Geoindex 

Computer: Data General Nova 1220 

Operating system: System 101 

Calling sequence: dwgdisk 

Arguments: None 

Subroutines called: fclfl, fopfl, save, numin, msgot,

yesno, rwcon, asflc, fcnot, ovrly, exit2, flnam, fdffl,

xdmsg 

Common data referenced: /PUNCHI Most Bendix

subroutines read from or write to common blocks.

Read "System 100 Programmers manual" (S100PM)

for further information. 

Input files: bordNMdw, gridNMdw, statNMdw, counNMdw, redNM, blueNM, greenNM 

Output files: bordNM, gridNM, statNM, counNM,

redNM, blueNM, greenNM 

Arrays used: None 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Pause. Stops execution of program until a return is 

sent. Prints message: 

PAUSE FOR OPERATOR

2. Call fclfl (clears a file and releases slot 0).

3. Send message to terminal:

NAME OF DISK OUTPUT FILE = ??
104 GEOINDEX

4. Call f Inam to receive a file name from the keyboard 

and store in name, 

igood is the returned status code.

5. If igood = 1, go to step 6 (acceptable file name). 

If igood = 2, go to step 3 (file name too long). 

If igood = 3, go to step 78. Control d or cr on first 

character was entered.

6. Call fopfl. This opens the file name for writing and 

assigns it to file slot 0. istat is the monitor error 

code.

7. If istat is not equal to 0, go to step 9. At this point a 

nonzero value is an error.

8. Send message to terminal:

OLD FILE-OK???. 

Call yesno. If yes, go to step 15. If no, go to step 2.

9. If istat is not equal to octal 204, go to step 14. This 

is the status code for a new file.

10. Send message to terminal:

NEW FILE-OK??

Call yesno. If yes, go to step 11. If no, go to step 

2.

11. Call fdffi, which defines a file name name, istat is 

the monitor error code.

12. If istat is not equal to 0, go to step 14.

13. Call fopfl. This opens the file name for writing and 

assigns it to file slot 0. If there are no errors then 

istat = 0; go to step 15.

14. Call xdmsg(/sfaf). This prints a disk operating 

system error message based on istat. Go to step 2.

15. Send message to terminal:

!DO YOU WISH TO WRITE AN EOF FLAG

ON THIS FILE??.

If you must run this program several times, you 

will later concatenate the several files and will 

need an EOF flag only in the last file.

16. Call save(1). This saves critical constants from the 

systems common blocks that are parameters 

describing the drawing file. These constants will 

be needed at the end of the program to restore the 

operation to the table with the same parameters.

17. Set nif = 0. This variable on the header card indicates grid, county, and so forth.

18. Send message to terminal:

TYPE 2 DIGIT STATE NUMBER 

Call numin to receive number. 

Set nor = to returned number.

19. Send message to terminal:

IS THIS THE GRID BEING WRITTEN??

20. Call yesno. If yes, go to step 21. If no, go to step 22.

21. Set nif = 991 (indicates the grid). 

Go to step 25.

22. Send message to terminal:

IS THIS THE COUNTIES BEING 

WRITTEN??

23. Call yesno. If yes, got to step 24. If no, go to step 

25.

24. Set nif = 992 (indicates the counties).

25. Set lifno(i) = 0 for / = 1,2000.

26. Set kpt(kf,1) = 1. Set the read pointer for the drawing file to the first record. Steps 27-30 will read 

the drawing file until the first text position that 

occurs in the drawing file is read.

27. Set kp = 1. When reading a drawing file, rwcon 

uses x(kp) and y(kp).

28. Call rwcon (kf,l). kf (equivalent to /r(4)) is the active 

file. The 1 indicates a read.

29. If key = 31 (EOF), go to step 77.

Note: Several assumptions are made concerning the 

drawing file. Each outline begins with a text string 

identifying the feature number, subfeature number, 

span and second subfeature number, with a default of 

0 for any absent text. There can be any number of line 

segments that make up an outline.

30. If key is not equal to 8 (text position), go to step 27. 

Steps 31-39 read through the drawing file counting the number of points for each outline and 

counting the number of outlines that have the 

same feature number. This must be done before 

punching starts because the information is on the 

header card.

31. Set kount = 1. This is a count of the number of

points in an outline. The text position is the first

point. 

Set inum = 1. This is a count of the number of

outlines. 

Set numtext = 0. This is the count of how many

lines of text are in the outline being read.

32. Set kp = 1.

Call rwcon to read a record.

33. If key = 31 (EOF), go to step 37.

If key = 8 (text position), go to step 37.

If key = 16 (text string), go to step 34.

If key = I (pen up), or if key = 6 (pen down), or if

key = 7 (symbol position), add 1 to kount. 

Go to step 32.

34. Add 1 to numtext (one more text string found). 

If numtext is greater than 1, go to step 37. We are

interested in only the first text string at this time. 

Set ibuf(i) = /</(/). This contains the character string

just read.

35. Call asf Ic to find the number, temp, represented by

the text in ibuf(i).

If istat = I, go to step 32. An error code of 1 is 

returned for any abnormality.

36. Add 1 to the count of number of outlines that have 

same feature number as the new outline just 

started. Go to step 32.
APPENDIX C 105

37. Set iburp(inum) = kount. This is a count of the

number of points for each outline. 

Set kount = 1. Start count over. 

Add 1 to inum (sequence number of next outline).

38. If key = 31 (EOF), go to step 40. There are two 

ways to reach this step: key - 31 or key = 8.

39. The only way to reach this step was if key = 8 (text 

position), which starts a new outline. Go to step 

32. Steps 40-44 will read the drawing file until the 

first text position that occurs in the drawing file is 

read. These statements start reading the drawing 

file from the first record.

40. Set kpt(kf,1) = 1. This sets the read pointer for the 

drawing file to the first record.

41. Set inum = 1 (outline count).

42. Set kp = 1. Call rwcon to read a record.

43. If key = 31 (EOF), go to step 79. Then the program 

is almost finished.

44. If key is not equal to 8 (text position), go to step 42.

45. Set kount = 0. This is a counter for the number of 

text strings found for an outline. None is found 

yet.

Set knum = 2. This is a counter for the number of 

the point to be processed. One is already processed.

Set isfno = iburp(inum) (the number of points).

Add 1 to inum (sequence number of next outline).

Set iup = 1. This is the counter for the number of 

pen ups or symbol positions found in one outline. 

The first is treated differently from the rest.

Set isf = 1. This will be 1 unless changed in a text 

string.

Set not = 0.

Set /spa/? = 0 (default values).

Setxp(7) = x1.

Set yp(1) = y1. This is the text position.

46. For / = knum, 6: 

Set xp(/) = 0. 

Set yp(i) = 0.

47. If knum = 1, set knum = 0. This will be equal to 1 

when a card has just been punched and more 

points are needed to complete the outline. It then 

branches to the previous step, where it must be 1, 

but logic further along demands that it be 0.

48. Set kp = 1.

Call rwcon to read a record.

49. If key = 31 (EOF), go to step 72.

50. If key = 8 (text position), go to step 72. This is true 

for all outlines except the first outline.

51. If key = 16 (text string), go to step 55.

52. If key = 1 (pen up) or 7 (symbol position), go to step 

67.

53. If key = 6 (pen down), go to step 70.

54. Go to step 48.

55. Add 1 to kount. Another text string found for this 

outline.

56. If kount is greater than 4, go to step 48. kount 

should never be greater than 4, because there are 

only four possible pieces of information.

57. For / = 1, 5, set ibuf(i) = id(i). id(i) contains the text 

string from the record read in statement 48.

58. Call asf Ic to find the number, temp, represented by 

the text in ibuf(i).

59. If istat = 1, go to step 48. An error code of 1 is 

returned for any abnormality.

60. If kount = 1, go to step 66 (the first text string). 

If nil = 992, go to step 64. If this is the county file, 

isf represents a bordering county or other boundary.

61. If there is only one outline and temp is greater than 

0, set kount = 4.

This must be a second subfeature number, but 

there should not be four text strings. 

If there is only one outline and temp is less than 0, 

set kount = 3. This must be a span, but there 

should not be three text strings.

62. Set/ = kount -I. 

If / = 1, go to step 64. 

If / = 2, go to step 65. 

If / = 3, go to step 66.

63. Set isf - temp. To get to this step, one of three conditions existed:

this must have been the second text string with ifno greater than 1, or this is the counties, or temp 

= 0. Go to step 48.

64. Set /span = temp. This was the third text string, or 

second text string with temp less than 0. Go to 

step 48.

65. not = temp. This was the fourth text string, or 

temp greater than 0 and only one outline. Go to 

step 48.

66. iff = temp. This is the feature number, ifno 

= iifno(iif). This is the count of outlines with same 

feature number. Go to step 48.

67. If key = 1 (pen up) and iup is greater than 1, go to 

step 70. This is another line segment that must be 

concatenated to previous segments.

68. Add 1 to iup, which is a flag to show what position 

the next pen up has in the outline (used in previous 

step).

69. Setxp(2) = x1 

Setyp(2) = y1.

Program writes the header card to the disk file. 

Go to step 48.

70. Add 1 to knum, which is counter for next position. 

Setxp(knum) = x1. 

Set yp (knum) = y1.
106 GEOINDEX

71. If knum is less than 6, go to step 48.

Otherwise, go to next step. The card should have 

six points to be written.

72. If knum = 0, go to step 74. The last card written 

had six points on it and finished an outline.

73. Program writes xp(/) and yp(/) to the disk file.

74. If key = 31 (EOF), go to step 78. Then, the program 

is almost finished.

75. If key = 8 (text position), go to step 45. A new 

outline is to be processed; default values must be 

reset.

76. Set knum = 1.

Go to step 46. There are more points in this outline.

77. Program writes message to terminal:

NO TEXT IN FILE! 

Go to step 79.

78. Program writes message to terminal: 

IDONE!

79. If ieof = 1, go to step 80.

If ieof - 2, go to step 81. This is an indicator for 

whether or not an EOF flag is to be written. This 

was done in step 15.

80. Set Hf = 9999 (the EOF flag). Program writes a 

header card to the disk file.

81. Close file slot 0.

Call fcnot (" 7 ") several times to ring the bell. This 

produces an audible signal to the operator. Program writes message to terminal: 

PROGRAM FINISHED

Set kp = 0.

Call save(2) (restores critical constants).

Call overly, a routine that overlays user memory 

with selected main program (returns control to 

the table).

Call exit2 (overlays signoff for the system).

C DWGDISK 

WRITTEN 2MAR78 BALCERAK

SOURCE=<DWGDISK:F> 

OBJECT=<DWGDISK:R>

PURPOSE:

TO READ A SYSTEM 101 DRAWING FILE LOADED ON 

THE DRAWING TABLE-GET THE X,Y COORDINATES 

OF THE TEXT REFERENCES AND OF THE LINES 

AND WRITE TO DISK IN 12F6.3 FORMAT.

THE HEADER CARD FOR EACH OUTLINE WILL ALSO 

BE WRITTEN WITH ALL RELAVENT INFORMATION.

COMMON /BLK/ X(30),Y(30),A(10),K(30),KP,ID(80)

COMMON /PNTR/ KPT(3,2)

COMMON /LINBF/ LTYPE,LWIDE

COMMON /MENU1/ KODE,MRFLG,SFACT,LNMOD,LNWID

COMMON /EXEC/ IEXEC(64),REXEC(64)

COMMON /DSKBF/ IDUM(3),LENG

COMMON /IDENT/ IDA(3)

COMMON /PUNCH/ XP(6),YP(6),IBUF(5),IBURP(2000),NAME(10), 

$ IIFNO(2000)

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE

(K(2),K2) 

(K(4),KF) 

(K(ll),KEY) 

(K(15),NCHAR)
APPENDIX C 107

C 

C 

C 

C

1000

1010

1020

1030

C 

1040

1050

C

1 

\c)

C

10

PAUSE FOR OPERATOR

CALL FCLFL (0,IER)

CALL MSGOT ("|NAME OF DISK OUTPUT FILE=?? " )

CALL FLNAM (NAME,IGOOD)

GO TO (1020, 1010,500) ,IGOOD

CALL FOPFL (NAME , 0, 1 , ISTAT )

IF (ISTAT .NE. 0) GO TO 1030

CALL MSGOT ("|OLD-FILE. OK?? " )

CALL YESNO (IANS)

GO TO (1, 1000) ,IANS

IF (ISTAT .NE. 204K) GO TO 1050

CALL MSGOT (" | NEW-FILE. OK?? ")

CALL YESNO (IANS)

GO TO (1040, 1000) , IANS

CALL FDFFL (NAME, ISTAT)

IF (ISTAT .NE. 0) GO TO 1050

CALL FOPFL (NAME , 0 , 1 , IS TAT )

IF (ISTAT .EQ. 0) GO TO 1

CALL XDMSG (ISTAT)

GO TO 1000

CALL MSGOT ("|DO YOU WISH TO WRITE AN EOF FLAG ON THIS FILE?? " 

CALL YESNO (IEOF)

CALL SAVE(l)

NIF = 0

CALL NUMIN ("|TYPE 2 DIGIT STATE NUMBER ",TEMP)

NOR=TEMP

CALL MSGOT ("|IS THIS THE GRID BEING WRITTEN?? " )

CALL YESNO (ISTAT)

GO TO (2, 3), ISTAT

NIF=991

GO TO 5

CALL MSGOT ("|IS THIS THE COUNTIES BEING WRITTEN?? " )

CALL YESNO (ISTAT)

GO TO (4, 5), ISTAT

NIF=992

DO 6 1=1,2000

IIFNO(I)=0

CONTINUE

KPT(KF, 1)=1

START READING RECORDS AND WRITTING TO DISK

KP=1

CALL RWCON (KF, 1)

IF (KEY .EQ. 31) GO

IF (KEY .NE. 8) GO

KOUNT-1

TO 

TO

350

10
108 GEOINDEX

INUM=1

NUMTEXT=0 

20 KP=1

CALL RWCON (KF,1)

IF (KEY .EQ. 31) GO TO 30

IF (KEY .EQ. 16) GO TO 25

IF (KEY .EQ. 8) GO TO 30

IF ( (KEY .EQ. 1) .OR. (KEY .EQ. 6) .OR. (KEY .EQ. 7) ) 

* KOUNT=KOUNT+1

GO TO 20 

C

25 NUMTEXT=NUMTEXT+1

IF (NUMTEXT .GT. 1) GO TO 20

DO 27 1=1,5 

27 IBUF(I)=ID(I)

CALL ASFLC (IBUF,NCHAR,TEMP,ISTAT)

IF (ISTAT .EQ. 1) GO TO 10

IIF=TEMP+0.5 

C

30 IBURP(INUM)=KOUNT

KOUNT=1

INUM=INUM+1

IF (KEY .EQ. 31) GO TO 40

IIFNO(IIF)=IIFNO(IIF)+1

NUMTEXT=0

GO TO 20

C

C

40

C

C

50

KPT (KF,

INUM=1

KP=1

1)

CALL RWCON (KF,1)

IF (KEY .EQ. 31) GO TO 500

IF (KEY .NE. 8) GO TO 50 

55 KOUNT=0

KNUM=2

ISFNO=IBURP(INUM)

INUM=INUM+1

ISF=1

IUP=1

NOT = 0

ISPAN=0

XP(1)»X1

YP(1)=Y1 

60 DO 65 I=KNUM,6

XP(I)=0

YP(I)=0 

65 CONTINUE

IF (KNUM .EQ. 1) KNUM=0 

C 

C

70 KP=1

CALL RWCON (KF,1)
APPENDIX C 109

IF (KEY .EQ. 31) GO TO 140 

IF (KEY .EQ. 8) GO TO 140 

IF (KEY .EQ. 16) GO TO 80

IF ( (KEY .EQ. 1) .OR. (KEY .EQ. 7) ) GO TO 110 

IF (KEY .EQ. 6) GO TO 130 

GO TO 70 

C 

C

80 KOUNT=KOUNT+1

IF (KOUNT .GT. 4) GO TO 70 

DO 85 1=1,5 

85 IBUF(I)=ID(I)

CALL ASFLC (IBUF,NCHAR,TEMP,ISTAT) 

IF (ISTAT .EQ. 1) GO TO 70 

IF (KOUNT .EQ. 1) GO TO 105 

IF (NIF .EQ. 992) GO TO 90

IF( (IFNO .EQ. 1) .AND. (TEMP .GT. 0.0) ) KOUNT=4 

IF ( (IFNO .EQ. 1) .AND. (TEMP .LT. 0.0) ) KOUNT=3 

I=KOUNT-1

GO TO (90,95,100),1 

90 ISF=TEMP 

GO TO 70 

95 ISPAN=TEMP

GO TO 70 

100 NOT=TEMP 

GO TO 70 

105 IIF=TEMP+0.5

IFNO=IIFNO(IIF) 

GO TO 70 

C 

C

110 IF ( (KEY .EQ. 1) .AND. (IUP .GT. 1) ) GO TO 130 

IUP=IUP+1 

XP(2)=X1 

YP(2)=Y1

WRITE (0,120) IIF,IFNO,ISF,ISFNO,NOT,NOR,NIF,ISPAN 

120 FORMAT (IX,815)

GO TO 70 

C 

C

130 KNUM=KNUM+1 

XP(KNUM)=X1 

YP(KNUM)=Y1

IF (KNUM .LT. 6) GO TO 70 

140 IF (KNUM .EQ. 0) GO TO 160

WRITE (0,150) (XP(I),YP(I),1=1,6) 

150 FORMAT (1X.12F6.3) 

160 IF (KEY .EQ. 31) GO TO 500 

IF (KEY .EQ. 8) GO TO 55 

KNUM=1 

GO TO 60 

C

C DONE 

C 

350 CALL FCNOT ("|NO TEXT IN FILE|")
110 GEOINDEX

500 CALL FCNOT ( fl |DONE|")

GO TO (510,520),IEOF 

510 IIF=9999

WRITE (0,120) IIF,IFNO,ISF 

520 CALL FCLFL (0,IER)

CALL FCNOT (

CALL FCNOT (

CALL FCNOT (

KP = 0

CALL SAVE(2)

CALL OVRLY (1,IER)

CALL EXIT2

END

ISFNO,NOT,NOR,NIF,ISPAN

PROGRAM NAME: SELDISK

Author: Lawrence Balcerak

Purpose of the program: seldisk reads through an

ASCII disk file containing coordinate outlines and

places selected outlines into a drawing file. 

Data base: Geoindex 

Computer: Data General Nova 1220 

Operating system: System 101 

Calling sequence: seldisk 

Arguments: None 

Subroutines called: fclfl, fcnot, flnam, fopfl, msgot,

numin, ovrly, rwcon, save, xdmsg, asflc 

Common data referenced: /Punch/ Most Bendix

subroutines read from or write to common blocks.

Read "System 100 Programmers Manual" (SIOOPM)

for further information. 

Input files: None 

Output files: None 

Arrays used: None 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Call save(1) (saves critical constants from the 

systems common blocks that are parameters 

describing the drawing file). These will be needed 

at the end of the program to restore operation to 

the table with the same parameters.

2. Set mrflg = 0. mrflg is the mirror flag. 0 indicates

no mirroring.

Set sfact = 1. sfact is scale factor. 

Set Inmod = 1. Inmod is line type. 1 indicates a

solid line. 

Set In win = 0. In win is pen number (initial value,

which will be changed at a later time). 

Set ifont = 0 (system requirement). 

Set angle = 0 (angle of rotation for text). 

Set justh = 1. justh is horizontal text justification.

1 indicates that the text will be left justified starting at the text location.

Set justv = 1. justv is vertical text justification. 1 

indicates that the text will be above the text location.

3. Send message to terminal: 

SELDISK OVERLAY 

PAUSE TURN ON CARD READER 

and wait for the return to be pushed. This gives a 

chance to make sure that the card reader has been 

prepared correctly. 

Steps 4-6 open the card reader for use.

4. Call fclfl (clears a file and releases slot 0).

5. Call fopfl (opens the card reader for reading and

assigns it to slot 0).

If ier is equal to 0, go to step 7. Otherwise, go to 

step 6. ier is the monitor error code (See SIOOPM, 

p. 236).

6. Write message to terminal:

FOPFL ERROR 

and then go to step 72.

7. Call numin. This sends the message:

.'CHARACTER HEIGHT = 

to the terminal and waits for an answer, which it 

places in the real variable texth. This is usually 

0.14 inches.

8. If texth is less than 0, go back to step 7. The system 

will accept a zero height but not a negative height.

9. Call numin. Sends message:

ISYMBOL # =

and receives answer into temp. 

Set nsymb = temp. Change to an integer.

10. If nsymb is greater than 0, go to step 11.

Otherwise, go back to step 9. This must be a positive 

integer.

11. If nsymb is greater than 200, go back to step 9. The 

range of possible symbol numbers is 1-200.
APPENDIX C 111

12. Set sfact = 1.5 times texth. This is the symbol scale 

factor. Our standard symbol for single points (a 

small triangle) is constructed 1 inch high. We 

usually plot it at 0.21 inches.

13. Set icount = 1. Index counter for the array if He, 

which will contain the feature and subfeature 

numbers read from the T-file.

14. Read a feature and subfeature number with a format of (18,12) and place into ifile(icount,l) and 

ifile(icount,2).

15. If the feature number = -1, go to step 17. This is a 

flag for the end of the T-file.

16. Add 1 to icount (to read another card). 

Go to step 14.

17. Subtract 1 from icount. We don't want to count the

flag. 

Steps 18-26 open the coordinate outline file for reading.

18. Call fclfl (clears a file and releases slot 0).

19. Send message to terminal:

NAME OF COORDINATE OUTLINE FILE = 

?? 

and wait for an answer.

20. Call flnam to receive the file name, and place it in 

the array name, 

igood is the returned status code.

21. If igood = 1, go to step 22. An acceptable file name

has been read in.

If igood = 2, go back to step 19 (file name too long). 

If igood = 3, go to step 72. Control d or cr on first

character was entered.

22. Call fopfl. This opens the file name for reading and 

assigns it to slot 0. is tat is the monitor error code.

23. If istat is not equal to octal 204, go to step 25. This 

is the code for a new file. This will be the most 

common error.

24. Send message to terminal:

!NEW FILE TRY AGAIN!! 

Go to step 18.

25. If istat is equal to 0, go to step 27. This indicates an 

old file that has no problems in opening.

26. Call xdmsg(/sfaf). This prints a disk operating 

system error message based on istat. Go to step 

18 to try again.

27. Add 1 to Inwid. This is the pen number, which

changes whenever a new outline starts. 

If Inwid is greater than 3, then set Inwid equal to 1. 

Only three pens are on this plotter.

28. Read a header card. The feature, subfeature, second 

subfeature, and span are read in as characters. 

The rest are read as integers.

29. Set nchrl = 5. 

Set nchr2 = 5. 

Set nchr3 = 5.

Set nchr4 = 5. These are the character counts for 

each of the four strings read from the header 

cards.

30. Check each of the four character strings for blanks. 

Subtract 1 from the character count for each 

blank found.

31. Set J = 5 -nchrl. This is the number of blank 

characters.

32. In the character string, Is (feature number) divides 

each nonblank character by octal 400. This moves 

the bit pattern from the left half of the word to the 

right half.

Set the array ibuf starting at element 1 equal to the 

right justified nonblank characters.

33. Repeat steps 31 and 32 for the subfeature number, 

Isf, and store in ibuf starting at element 6.

34. Repeat steps 31 and 32 for the second subfeature 

number, Isf2, and store in ibuf starting at element 11.

35. Repeat steps 31 and 32 for the span, /span, and 

store in ibuf starting at element 16. In the last 

three steps, there is a possibility that the number 

of characters is 0 (a blank field on the card). This 

will be accounted for when the subroutine asflc is 

called for each number.

36. Call asflc to change the nchrl characters starting

at ibuf(1) to the real number temp. 

Set isubf = temp + 0.5. Change to an integer, but 

add 0.5 first to make sure the number is truncated 

correctly. This is the feature number as well as the 

subfile number.

37. If isubf is equal to 9999, go to step 72. This is the 

end-of-file flag, EOF, so the job is finished. The 

system does not recognize an end = option in a 

read statement, hence the need for the end-of-file 

flag.

If isubf is greater than 1,000, subtract 1,000 from 

isubf.

If isubf is equal to 1,000, set isubf = 998. More 

than 1,000 outlines are possible, but only 999 subfiles are.

38. Call asflc using the nchr2 characters starting at 

ibuf(6) to find isf the subfeature number, istat is 

the returned error code that is 0 for no errors and 

equal to 1 for an error. The possible errors are as 

follows: no characters, a nonnumeric character, 

more than one plus or minus sign or decimal point, 

a plus or a minus sign somewhere other than position number one.

39. If istat is equal to 1, set isf = 1. This will be the 

default value.

40. Call asflc using nchrS characters starting at 

ibuf(11) to find not, the second subfeature 

number.
112 GEOINDEX

41. If istat is equal to 1, set not = 0 (the default value).

42. Call asflc using nchr4 characters starting at 

ibuf(16) to find is pan, the span (should be 

negative or zero).

43. If istat is equal to 1, set ispan = 0 (the default 

value).

44. Go through the if He array to see if an entry matches 

the feature number, isubf, and the subfeature 

number, isf. 

If a match is found, go to step 47.

45. Read a data point record. Skip this outline.

46. Subtract 6 from isf no. Six data points are on each

record.

If there are more data point records for this outline, 

isf no is greater than 0, go to step 44. Otherwise, 

go to step 28 to read the next header card.

47. Set ie equal to the minimum of (6,isf no). There are 

a maximum of six points per record.

48. Read ie data points from the next record into xx and

yy.

49. Set x1 = xx(1}.

Set y1 = yy(1). This is the data point written to the 

drawing file when rwcon is called.

50. Set nchar = nchrl. This is the number of 

characters to be written as a text string when 

rwcon is called.

For /' = 1, nchrl, set id(i) = ls(i) (feature number). 

id is the array from which rwcon gets the text 

string.

51. Set key = 8 (the indicator that is a text position).

52. Set kp = 1. When writing a drawing file record,

rwcon uses x(kp) and y(kp).

Call rwcon(/r/,2). kf (equivalent to k(4)) is the active 

file. The 2 indicates a write.

53. Set key = 16 (text string indicator).

Call rwcon to write a record. This writes the text 

string record containing the feature number.

54. Write the feature number to the terminal. This 

leaves a record of what has been done to date, 

which may be needed if there is some sort of 

system failure.

55. If the subfeature number is not to be placed as text, 

go to step 57.

56. Set nchar = nchr2.

Set id(i) = lsf(i), for / = 1, nchr2.

Set key = 16.

Call rwcon to write a text string record.

57. If the span is not to be placed as text, go to step 59.

58. Set nchar = nchr4.

Set id(i) = lspan(i), for /' = 1, nchr4.

Set key = 16.

Call rwcon to write a text string record.

59. If the second subfeature number is not to be placed 

as text, go to 61.

60. Set nchar = nchr3.

Set id(i) = Isf2(i), for / = 1, nchrt.

Set key = 16.

Call rwcon to write a text string record.

61. Set x1 = xx(2).

Set y1 = yy(2). Process the second point.

62. If isfno is greater than 2, go to step 64. Greater 

than 2 indicates a line segment. If equal to 2, it 

would indicate a single point.

63. Set key = 7 (the indicator for a symbol). 

Set kp = 1.

Call rwcon to write a symbol record. 

Go to step 27 to start on the next outline.

64. Set key = I (the indicator for a pen up). 

Set kp = I.

Call rwcon to write a pen-up record. 

Set //' = 3. We have already processed the first 2

points. 

Go to step 66.

65. Read ie data points from the next record into xx and

yy.

66. Set key = 6 (the indicator for pen down). 

Set kp = I.

67. Do for / = //, ie. 

Setxl = yy(i). 

Set y1 = yy(i). 

Call rwcon to write a pen-down record.

68. Set //' = 1 (will start with first data point next time).

69. If there are no more data points for this outline, go 

to step 27 to start on the next.

70. Subtract 6 from isfno. This computes how many 

more points are left to complete the outline.

71. Set ie = minumum of (6,isfno). 

Go to step 64.

72. Set isubf = 999. Subfile 999 indicates that the 

whole drawing file is being referred to.

73. Set key = 31 (the indicator for an EOF). 

Call rwcon to write an EOF record. 

Call fclfl to clear the disk file and release slot 0.

74. Call fcnot (" 7 ") several times to ring the bell. This

produces an audible signal to the operator. 

Write to the terminal:

IPROGRAM FINISHED!! 

Set kp = 1. 

Call ovrly. This overlays user memory with selected

main program; it returns control to the table. 

Call exit2 (overlays signoff for the system).
APPENDIX C 113

SELDISK

WRITTEN 2MAR78 BALCERAK

SOURCE=<SELDISK:F> 

OBJECT=<SELDISK:R>

PURPOSE

TO READ A GROUP OF PTS FROM A DISK FILE 

AND CREATE A SYST 101 DWG FILE. THERE WILL 

BE A HEADER CARD FOLLOWED BY DATA CARDS 

WITH 6 PTS PER CARD IN 12F6.3 FORMAT. 

THE PROGRAM SELECTS ONLY CERTAIN FILES .

REMARKS:

THIS PROGRAM HAS KNOWLEDGE OF FILE STRUCTURE.

WHEN RWCON READS A RECORD IT TRANSFERS 

THE DATA TO COMMON /LINBF/ LTYPE,LWIDE 

AND TO COMMON /SYMBF/ MIRSY,SKLSY

WHEN RWCON WRITES A RECORD IT TRANSFERS THE DATA 

FROM COMMON /MENU1/ KODE,MRFLG,SFACT,LNMOD,LNWID

THE CURRENT SYST 100 VALUES FOR LINE WIDTH 

AND TYPE ARE STORED IN COMMON /MENU1/

COMMON /BLK/X(30),Y(30),A(10),K(30),KP,ID(80)

COMMON /PNTR/KPT(3,2)

COMMON /MENU1/ KODE,MRFLG,SFACT,LNMOD,LNWID

COMMON /EXEC/ IEXEC(64),REXEC(64)

COMMON /DSKBF/ IDUM(3),LENG

COMMON /PUNCH/ XX(6),YY(6)

COMMON /CRDWG/ LS(5), LSF(5 ) ,ISFNO,LSF2(5 ) ,LSPAN(5 ) ,NAME(10)

COMMON /CRDWG/ ISF,ISF2,IBLANK,IBUF(20),IFILE(1000,2)

COMMON /FONT/ IFONT

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE

(K(2),K2) 

(K(4),KF) 

(K(11),KEY) 

(K(12) ,ISUBF) 

(K(13) ,NSYMB) 

(K(15) ,NCHAR) 

(IEXEC(31) , JUSTH) 

(IEXEC(32) , JUSTV)

(A(l) , ANGLE) 

(A(2) ,TEXTH)
114 GEOINDEX

C

DATA IBLANK /2H / 

C 

C 

C 

C 

C

CALL SAVE(l)

MRFLG=0

SFACT=1

LNMOD=1

LNWID=0

IFONT=0

ANGLE=0.

JUSTH=1

JUSTV=1 

C

CALL MSGOT("ISELDISK OVERLAY") 

PAUSE TURN ON CARD READER 

CALL FCLFL(0,IER) 

CALL FOPFL("/CDR",0,0,IER)

IF (IER) 150,200,150 

150 CALL MSGOT("(FOPFL ERROR|")

GO TO 500 

C

200 CALL NUMIN("|CHARACTER HEIGHT=",TEXTH)

IF (TEXTH) 200,210,210 

210 CALL NUMIN("[SYMBOL # =",TEMP) 

NSYMB=TEMP

IF (NSYMB) 210,210,220 

220 IF (NSYMB-200) 230,230,210 

230 SFACT=1.5*TEXTH 

C

ICOUNT=1

240 READ (0,250) IFILE(ICOUNT,1),IFILE(ICOUNT,2) 

250 FORMAT (18,12,)

IF (IFILE(ICOUNT,1) .EQ. -1) GO TO 260 

ICOUNT=ICOUNT+1 

GO TO 240

260 ICOUNT=ICOUNT-1 

C

270 CALL FCLFL (0,IER)

280 CALL MSGOT ("|NAME OF COORDINATE OUTLINE FILE=?? ") 

CALL FLNAM (NAME,IGOOD) 

GO TO (290,280,500),IGOOD 

290 CALL FOPFL (NAME,0,0,IS TAT)

IF (ISTAT .NE. 204K) GO TO 295 

CALL MSGOT ("[NEW FILE TRY AGAIN|| ") 

GO TO 270

295 IF (ISTAT .EQ. 0) GO TO 300 

CALL XDMSG (ISTAT) 

GO TO 270 

C

300 LNWID=LNWID+1

IF (LNWID.GT.3) LNWID=1
APPENDIX C 115

c

C READ HEADER CARD 

C

305 READ (0,310) (LS(I),1=1,5),IFNO,(LSF(J),J = l,5), 

* ISFNO,(LSF2(M),M=1,5 ),NOR,NIF,(LSPAN(L),L=l,5) 

310 FORMAT (5A 1,1 5,5A1,I 5,5A1,215,5A1)

NCHR1=5

NCHR2=5

NCHR3=5

NCHR4=5 

C 

C

DO 320 1=1,5

IF (LS(I) .EQ. IBLANK) NCHR1=NCHR1-1

IF (LSF(I) .EQ. IBLANK) NCHR2=NCHR2-1

IF (LSF2(I).EQ. IBLANK) NCHR3=NCHR3-1

IF (LSPAN(I) .EQ. IBLANK) NCHR4=NCHR4-1 

320 CONTINUE 

C 

C

J=5-NCHR1

DO 330 I-1.NCHR1

LS(I)=LS(I+J)/400K

IBUF(I)=LS(I) 

330 CONTINUE 

C

J=5-NCHR2

DO 340 I=1,NCHR2

LSF(I)=LSF(H-J)/400K

IBUF(H-5)=LSF(I) 

340 CONTINUE

IF (NCHR3.EQ.O) GO TO 352 

C 

C

J=5-NCHR3

DO 350 I=1,NCHR3

LSF2(I)=LSF2(H-J)/400K

IBUF(H-10)=LSF2(I) 

350 CONTINUE 

C 

C

352 J=5-NCHR4

DO 353 I=1,NCHR4

LSPAN(I)=LSPAN(H-J)/400K

IBUF(H-15)=LSPAN(I)

353 CONTINUE

CALL ASFLC (IBUF(1),NCHR 1,TEMP,ISTAT) 

ISUBF=TEMP+.5

IF (ISUBF .EQ. 9999) GO TO 500

IF (ISUBF .GT. 1000) ISUBF=ISUBF-1000

IF (ISUBF .EQ. 1000) ISUBF=998
116 GEOINDEX

C

CALL ASFLC(IBUF(6),NCHR2,TEMP,ISTAT)

ISF=TEMP+.5

IF (ISTAT .EQ. 1) ISF=1

CALL ASFLC (IBUF(1 1),NCHR3,TEMP,ISTAT)

NOT=TEMP+.5

IF (ISTAT .EQ. 1) NOT=0

CALL ASFLC (IBUF( 1 6),NCHR4,TEMP,ISTAT)

ISPAN=TEMP+.5

IF (ISTAT .EQ. 1) ISPAN=0 

C

DO 1000 I-l.ICOUNT

IF (IFILE(I,1) .NE. ISUBF) GO TO 1000

IF (IFILE(I,2) .EQ. ISF) GO TO 1050 

1000 CONTINUE 

1010 READ (0,355) XX(1)

ISFNO=ISFNO-6

IF (ISFNO) 305,305,1010 

C 

1050 IE=ISFNO

IF(ISFNO .GE. 6)IE=6 

C

C READ FIRST DATA CARD 

C

READ (0,355) (XX(I),YY(I),I=1,IE) 

355 FORMAT(12F6.3)

X1=XX(1)

Y1=YY(1)

NCHAR=NCHR1

DO 360 I=1,NCHR1

ID (I)=LS (I) 

360 CONTINUE

KEY = 8

KP=1

CALL RWCON(KF,2)

KEY=16

CALL RWCON(KF,2) 

C

WRITE (10,365) ISUBF 

365 FORMAT (16) 

C

IF ( (ISF .EQ. 1) .AND. (IFNO .EQ. 1) ) GO TO 375

NCHAR=NCHR2

DO 370 I=1,NCHR2

ID (I)-LSF(I) 

370 CONTINUE

KEY=16

CALL RWCON(KF,2) 

C 

C 

375 IF (ISPAN .EQ. 0) GO TO 380

NCHAR=NCHR4

DO 377 I=1,NCHR4

ID(I)=LSPAN(I)
APPENDIX C

377 CONTINUE

KEY=16

CALL RWCON(KF,2) 

C 

C

380 IF (NOT .EQ.O) GO TO 400

NCHAR=NCHR3

DO 390 I=1,NCHR3

ID(I)=LSF2(I) 

390 CONTINUE

KEY=16

CALL RWCON(KF,2) 

C 

C

400 X1=XX(2)

Y1=YY(2) 

C

C SYMBOL NEEDED IF THIS IS SINGLE PT 

C

IF (ISFNO.GT.2) GO TO 410

KEY = 7

KP = 1

CALL RWCON(KF,2)

GO TO 300 

C

C WRITE PEN UP 

C

410 KEY=1

KP=1

CALL RWCON(KF,2)

JJ = 3

GO TO 430 

C

420 READ(0,355) (XX(I),YY(I),1=1,IE) 

C

C WRITE PEN DOWN 

C

430 KEY=6

KP = 1

DO 440 I=JJ,IE

X1=XX(I)

Y1=YY(I)

CALL RWCON(KF,2)

440 CONTINUE

IF (ISFNO-6) 300,300,450

450 ISFNO=ISFNO-6

IE=ISFNO

IF (ISFNO.GE.6) IE=6

GO TO 420 

C

C DONE 

C
118 GEOINDEX

500 ISUBF=999 

KEY=31

CALL RWCON(KF,2) 

CALL FCLFL(0,IER) 

CALL FCNOT ("<7>") 

CALL FCNOT ("<7>") 

CALL FCNOT ("<7>")

CALL MSGOT ("IPROGRAM FINISHED!!") 

KP = 0

CALL SAVE (2) 

CALL OVRLY(1,IER) 

CALL EXIT2 

END

PROGRAM NAME: DWGTAPE

Author: Lawrence Balcerak

Purpose of the program: dwgtape reads a System 101 

drawing file, writes to tape the binary representation 

of the header card and data cards for each feature 

outline. Options are to write all or only one of the 

feature numbers. Also either all or only the first data 

card for each outline can be written.

Data base: Geoindex

Computer: Data General Nova 1220

Operating system: System 101

Calling sequence: dwgtape

Arguments: None

Subroutines called: save, numin, msgot, yesno, 

rwcon, asflc, fcnot, ovrly, exit2, rdtape, wrtape, 

wreof

Common data referenced: /Punch/ Most Bendix 

subroutines read from or write to common blocks. 

Read "SYSTEM 100/101 Programmers Manual" 

(SC100PM) for further information.

Input files: None

Output files: None

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic: This program is designed to write the exact bit pattern of integers and real numbers used on 

an IBM/370. The tape will be read using a 20A4 format that preserves the bit pattern. The Bendix 

minicomputer has a four-byte real number, which is 

exactly the same as the IBM real number. However, 

the integer is only two bytes versus four for the IBM. 

Using a 12-element integer array, which is made 

equivalent to a 6-element real array, the program 

writes the integers in binary to the tape. When 

writing the header card, expand each integer to four 

bytes by writing alternate zeros.

1. Pause. Stops execution of program until a return is 

sent. Prints message:

TAPE UNIT NO. (0 OR 1)

2. Call save(1) (saves critical constant).

3. Call numin (sends message to terminal asking what 

feature number you want punched). This real 

number is then placed in temp. Use 9999 if you 

want all features.

4. Set ifnum = temp. Change to an integer.

5. Send message to terminal:

DO YOU WISH THE FIRST DATA CARD 

ONLY??

6. Call yesno to receive a yes or no, which then sets 

the variable /answer = l(yes) or 2(no). It will not 

accept any other answer.

7. Set nif = 0. This variable on the header card indicates grid, county, and so forth.

8. Send message to terminal:

TYPE 2 DIGIT STATE NUMBER 

Call numin to receive number.

9. Set nor = State number, which user types in.

10. Send message to terminal:

IS THIS THE GRID BEING PUNCHED??

11. Call yesno.

If yes, go to step 12. If no, go to step 13.

12. Set nif = 991 (indicates the grid). 

Go to step 16.

13. Send message to terminal:

IS THIS THE COUNTIES BEING 

PUNCHED??

14. Call yesno.

If yes, go to step 15. If no, go to step 16.

15. Set nif = 992 (indicates counties).

16. Set iifno(l) = 0 for / = 1,1500.

17. Send message to terminal:

SKIP FILES?? 

Call yesno to receive answer. 

If yes, go to step 18. If no, go to step 23.
APPENDIX C 119

18. Call numin. Send message: 

HOW MANY FILES ?? 

Receive answer and store in temp.

19. Set iskip = temp.

If iskip is less than 0, go to step 18.

If iskip = 0, go to step 23.

If iskip is greater than 0, go to step 20.

20. Do steps 21-22 for / = 1, iskip

21. Call rdtape to read the tape, jstat is the status 

return code.

22. If jstat = 4 (EOF), go to step 20 to read next file. 

If jstat does not = 0, go to step 84. 

Otherwise, go to step 21.

23. Set kpt(kf,1) = 1. Sets the read pointer for the 

drawing file to the first record. Steps 24-28 will 

read the drawing file until the first text position is 

read for the appropriate feature number.

24. Set kp = I. When reading a drawing file, rwcon 

uses x(kp) and y(kp).

25. Call rwcon(kf, 1). kf, equivalent to k(4), is the active 

file. The 1 indicates a read.

26. If key = 31 (EOF), go to step 83.

Note: Several assumptions are made about the drawing 

file. The subfile number is the same as the feature 

number. Each outline begins with a text string identifying the feature number, subfeature number, span 

and second subfeature number, with a default of 0 for 

any absent text. Any number of line segments can 

make up an outline.

27. If isubf, subfile number, is not equal to ifnum, and 

if ifnum is not equal to 9999, go to step 24. This 

searches for the appropriate feature number.

28. Set kount = I. This is a count of the number of 

points in an outline. The text position is the first 

point. 

Set inum = 1 (a count of the number of outlines).

29. Set iifno(isubf) = 1. This is the count of how many 

outlines that have the same feature number.

30. Set ftp =1.

Call rwcon to read a record.

31. If key = 31 (EOF), go to step 36.

32. If this is not an appropriate outline (check isubf), go 

to step 30.

33. If key = 8 (text position), go to step 36.

34. If key = I (pen up), or 

If key = 6 (pen down), or 

If key = 7 (symbol position), add 1 to kount.

35. Go step 30.

36. Set iburp(inum) = kount. This is a count of the

number of points for each outline. 

Set kount = I. Start count over. 

Add 1 to inum (sequence number of next outline).

37. If key = 31 (EOF), go to step 39. There are two 

ways to reach this step: key = 31 or key = 8.

38. Add 1 to the count of number of outlines that have 

same feature number as the new outline just 

started. This step can be reached only if key = 8 

(text position), which starts a new outline. Go to 

step 30.

Steps 39-43 will read the drawing file until the first text 

position is read for the appropriate feature number.

39. Set kpt(kf,l) = 1. Sets the read pointer for the 

drawing file to the first record.

40. Set inum = I (outline count).

41. Set kp = 1.

Call rwcon to read a record.

42. If key = 31 (EOF), go to step 85. (Program is finished.)

43. If this is not an appropriate outline (check isubf), 

go to step 41.

44. Set kount = 0. This is a counter for the number of 

text string found for an outline. None is found yet.

Set knum = 2. This is a counter for the number of 

the points to be processed. One is already processed.

Set Hf = isubf (feature number).

Set ifno = iifno(isubf). This is the number of 

outlines with same feature number.

Set isfno = iburp(inum) (the number of points).

Add 1 to inum. This is a sequence number of the 

next outline.

Set isf = 1. This will be 1 less changed in a text 

string.

Set iup = 1. This is a counter for the number of pen 

ups or symbol positions in one outline. The first is 

treated differently from the rest.

Set not = 0; set /span = 0 (default values).

Set xp(7) = x7; set yp(7) = y1. This is the text position.

45. For / = knum, 6, set xp(/) = 0; set yp(i) =0.

46. If knum = 1, set knum - 0. This will be equal to 1 

when a card image has just been written and more 

points are needed to complete the outline. It then 

branches to the previous step where it must be a 

1, but logic further along demands that it be 0.

47. Set kp = 1; call rwcon to read a record.

48. If key = 31 (EOF), go to step 76.

49. If this is not an appropriate outline (check isubf), go 

to step 47. More than one outline may have the 

same feature number.

50. If key = 8 (text position), go to step 76. This would 

be true when an outline other than the first comes 

up.

51. If key = 16 (text string), go to step 55.
120 GEOINDEX

52. If key = 1 (pen up) or 7 (symbol position), go to step 

68.

53. If key = 6 (pen down), go to step 74.

54. Go to step 47.

55. Add 1 to kount. Another text is string found for this 

outline.

56. If kount = 1, or kount is greater than 4, go to step 

47. If equal to 1, it is the feature number, which is 

the same as the subfile number. It should never be 

greater than 4.

57. For / = 1, 5, set ibuf(i) = id(i) (the text string).

58. Call asf Ic to find the number, temp, represented by 

the text in ibuf(i).

59. If istat = 1, go to step 47. An error code of 1 is 

returned for any abnormality.

60. If nif = 992, go to step 64. If this is the counties, isf 

represents a bordering county or other boundary.

61. If there is only one outline and temp is greater than 

0, set kount = 4. This must be a second subfeature number, but there may not be four text 

strings.

62. If there is only one outline and temp is less than 0, 

set kount = 3. This must be a span, but there may 

not be three text strings.

63. Set / = kount - 1. If / = 1, go to step 64. If / = 2, go 

to step 65. If / = 3, go to step 66.

64. Set isf = temp. This must have been the second 

text string with if no greater than 1, or this is the 

counties, or temp = 0. Go to step 47.

65. Set /spa/7 = temp. This was the third text string, or 

second text string with temp less than 0. Go to 

step 47.

66. Set not = temp. This was the fourth text string, or 

temp greater than 0 and only one outline. Go to 

step 47.

67. If key = 1 (pen up) and iup is greater than 1, go to 

step 74. If these two conditions are met, then this 

is another line segment that must be concatenated 

to previous segments.

68. Add 1 to iup. This is a flag to show what position the 

next pen up has in the outline; used in previous 

step.

69. Setxp(2) = x1; setyp(2) = y1.

70. Set iout(i) = /zero, for / = 1, 24.

71. Set iout(2) = iif (feature number).

Set iout(4) = if no (the number of outlines). 

Set iout(6) = isf (subfeature number).

Set iout(8) = isf no (number of points).

Set iout(10) = not (second subfeature number).

Set iout(12) = nor (State number).

Set iout(14) = nif (graticule identifier).

Set iout(16) = /spa/7 (span).

72. If /spa/7 is less than 0, set iout(15) = ineg (makes 

the whole word negative.

73. Call wrtape to write the header card to the tape. 

If istat (error code) not = 0, go to step 84. 

Otherwise, go to step 47.

74. Add 1 to knum (counter for next position). 

Set xp(knum) = x1; set yp(knum) = y1.

75. If knum is less than 6, go to step 47.

Otherwise, go to the next step. The card should 

have six points to be punched.

76. If knum = 0, go to step 80. Then, the last card 

punched had six points on it and finished an 

outline.

77. Set/7? = -l;set/= - 3 (to start counters used later

at the proper place in the arrays). 

Do steps 78-79 for / = 1, 12, 2.

78. Add 4 to /.

Set iout(l) = itemp(i).

Set iout(l + 1) = itemp(i + 1).

Add 4 to m.

Set iout(m) = jtemp(i).

Set iout(m + 1) = jtemp(i + 7).

79. Call wrtape to write a data card to the tape. 

If jstat (error code) not = 0, go to step 84.

80. If key = 31 (EOF), go to step 85. Program is almost 

finished.

81. If key = 8 (text position), go to step 44. A new 

outline is to be processed; default values must be 

reset.

82. Set knum = 1.

Go to step 45. More points are in this outline.

83. Write message to terminal:

NO TEXT IN FILE!! 

Go to step 85.

84. Write jstat (error code) to the terminal.

85. Write message to terminal:

!DONE!

Call wreof to write EOF on tape. 

Set kp = 0.

Call save(2) (restores critical constants). 

Call ovrly (overlays user memory with selected main

program). Here it returns control to table. 

Call exit2 (overlays signoff for the system).

DWGTAPE

WRITTEN 23NOV76 BALCERAK

SOURCE=<DWGTAPE:F> 

OBJECT=<DWGTAPE:R>
APPENDIX C 121

PURPOSE:

TO READ A SYSTEM 101 DRAWING FILE LOADED ON 

THE DRAWING TABLE-GET THE X,Y COORDINATES 

OF THE TEXT REFERENCES AND OF THE LINES 

AND WRITE TO TAPE IN 12F6.3 FORMAT. 

OPTIONS INCLUDE WRITING ALL OR ONLY ONE OF 

THE SUBFILES. ALSO, ONLY THE FIRST DATA 

CARD CAN BE WRITTEN OUT INSTEAD OF ALL.

THE HEADER CARD FOR EACH OUTLINE WILL ALSO 

BE WRITTEN WITH ALL RELAVENT INFORMATION.

COMMON /BLK/ X(30),Y(30),A(10),K(30),KP,ID(80)

COMMON /PNTR/ KPT(3,2)

COMMON /LINBF/ LTYPE,LWIDE

COMMON /MENU1/ KODE,MRFLG,SFACT,LNMOD,LNWID

COMMON /EXEC/ IEXEC(64),REXEC(64)

COMMON /DSKBF/ IDUM(3),LENG

COMMON /IDENT/ IDA(3)

COMMON /PUNCH/ XP(6),YP(6),IBUF(5),IBURP(1000),IFNUM,IANSWER, 

$ IIFNO(1500),INEG,IZERO

COMMON /UNIT/ MTUNIT

DIMENSION ITEMP(12),JTEMP(12)

EXTERNAL MT80

EQUIVALENCE (K(1),K1)

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

EQUIVALENCE

(K(2),K2) 

(K(4),KF) 

(K(11),KEY) 

(K(12),ISUBF) 

(K(15),NCHAR)

(IEXEC(19),LNMSV) 

(IEXEC(20),LNWSV) 

(XP(1),ITEMP(1)) 

(YP(1),JTEMP(l))

DATA INEG /177777K/ 

DATA IZERO /OOOOOOK/

CALL XIOIT(MTSO)

CALL SAVE(l)

CALL NUMIN("[TAPE UNIT NO

MTUNIT=TEMP

PAUSE MOUNT TAPE PLEASE

CALL NUMIN ("(SUBFILE # =

(0 OR 1)",TEMP)

TYPE 9999 FOR ALL",TEMP)
122 GEOINDEX

YOU 

(IANSWER)

IFNUM=IFIX(TEMP)

CALL MSGOT ("|DO

CALL YESNO

NIF = 0

CALL NUMIN

NOR=TEMP

CALL MSGOT

CALL YESNO

GO

WISH THE FIRST DATA CARD ONLY??")

("|TY E 2 DIGET STATE NUMBER ",TEMP)

THE GRID BEING PUNCHED?? ")

THE COUNTIES BEING PUNCHED?? ")

("|IS THIS 

(ISTAT) 

TO (2,3),ISTAT

2 NIF=991 

GO TO 5

3 CALL MSGOT ("|IS THIS 

CALL YESNO (ISTAT) 

GO TO (4,5),ISTAT

4 NIF=992

5 DO 6 1=1,1500 

IIFNO(I)=0

6 CONTINUE

CALL MSGOT (" SKIP FILES?? ") 

CALL YESNO (IT) 

GO TO (7, 12),IT

7 CALL NUMIN(" HOW MANY FILES?? ",TEMP) 

ISKIP=TEMP 

IF (ISKIP) 7,12,8

8 DO 11 1=1,ISKIP

9 CALL RDTAPE (MTUNIT,IBURP,1000,0,JACNT,JSTAT) 

IF (JSTAT .EQ. 4) GO TO 11 

IF (JSTAT .NE. 0) GO TO 12 

GO TO 9

11 CONTINUE

12 CONTINUE

KPT(KF,1)=1 

START READING RECORDS AND PUNCHING OUT CARDS

GO TO 350 

IFNUM) .AND 

GO TO 10

10 KP=1

CALL RWCON (KF, 1)

IF (KEY .EQ. 31)

IF ( (ISUBF .NE.

IF (KEY .NE. 8)

KOUNT=1

INUM=1

IIFNO(ISUBF)-! 

20 KP=1

CALL RWCON (KF, 1)

IF (KEY .EQ. 31) GO TO 30

IF ( (ISUBF .NE. IFNUM) .AND

IF (KEY .EQ. 8) GO TO 30

IF ( (KEY .EQ. 1) .OR. (KEY

(IFNUM .NE. 9999) ) GO TO 10

(IFNUM .NE. 9999) ) GO TO 20 

EQ. 6) .OR. (KEY .EQ. 7) )
APPENDIX C 123

* KOUNT=KOUNT+1

GO TO 20 

C 

C

30 IBURP(INUM)=KOUNT

KOUNT=1

INUM=INUM+1

IF (KEY .EQ. 31) GO TO 40

IIFNO(ISUBF)=IIFNO(ISUBF)+1

GO TO 20

C

C

40

C

C

50

KPT(KF,

INUM=1

KP = 1

1)

CALL RWCON (KF,1)

IF (KEY .EQ. 31) GO TO 500

IF ( (ISUBF .NE. IFNUM) .AND. (IFNUM .NE. 9999) ) GO TO 50

IF (KEY .NE. 8) GO TO 50 

55 KOUNT=0

KNUM=2

IIF=ISUBF

IFNO=IIFNO(ISUBF)

ISFNO=IBURP(INUM)

INUM=INUM+1

ISF=1

IUP«1

NOT = 0

ISPAN=0

XP(1)=X1

YP(1)=Y1 

60 DO 65 I=KNUM,6

XP(I)=0.

YP(I)=0. 

65 CONTINUE

IF (KNUM .EQ. 1) KNUM=0 

C 

C

70 KP=1

CALL RWCON (KF,1)

IF (KEY .EQ. 31) GO TO 140

IF ( (ISUBF .NE. IFNUM) .AND. (IFNUM .NE. 9999) ) GO TO 70

IF (KEY .EQ. 8) GO TO 140

IF (KEY .EQ. 16) GO TO 80

IF ( (KEY .EQ. 1) .OR. (KEY .EQ. 7) ) GO TO 110

IF (KEY .EQ. 6) GO TO 130

GO TO 70 

C 

C

80 KOUNT=KOUNT+1

IF ( (KOUNT .EQ. 1) .OR. (KOUNT .GT. 4) ) GO TO 70

DO 85 1=1,5
124 GEOINDEX

85

90

95

100

110

120

130

140

150

160

IBUF(I)=ID(I)

CALL ASFLC (IBUF,NCHAR,TEMP,ISTAT)

GO TO 70 

GO TO 90 

AND. (TEMP 

.AND. (TEMP

IF (ISTAT .EQ. 1)

IF (NIF .EQ. 992)

IF( (IFNO .EQ. 1) .AND. (TEMP .GT. 0.0) ) KOUNT=4

IF ( (IFNO .EQ. 1) .AND. (TEMP .LT. 0.0) ) KOUNT=3

I=KOUNT-1

GO TO (90,95,100),

ISF=TEMP

GO TO 70

ISPAN=TEMP

GO TO 70

NOT=TEMP

GO TO 70

IF ( (KEY .EQ. 1) .AND. (IUP .GT. 1) ) GO TO 130

IUP=IUP+1

XP(2)=X1

YP(2)=Y1

WRITE(22, 120)IIF,IFNO,ISF,ISFNO,NOT,NOR,NIF,ISPAN

FORMAT(1X,8I5)

GO TO 70

KNUM=KNUM+1 

XP(KNUM)=X1 

YP(KNUM)=Y1 

IF (KNUM .LT 

IF (KNUM .EQ

6) GO TO 70 

0) GO TO 160

WRITE(22,150) (XP(I),YP(I),1=1,6)

FORMAT(1X,12F6.3)

IF (KEY .EQ 

IF (KEY .EQ 

IF (IANSWER 

KNUM=1 

GO TO 60

DONE

31) GO TO 500

8) GO TO 55

EQ. 1) GO TO 50

350 CALL FCNOT ("|NO TEXT IN FILE|")

500 CALL FCNOT ("|DONE|")

CALL WREOF (MTUNIT,JSTAT)

KP = 0

CALL SAVE(2)

CALL OVRLY (1,IER)

CALL EXIT2

END
APPENDIX C 125

EXEC_COM NAME: VERSATEC.EC

Author: James Fisher

Purpose of the program: versatec.ec, written in Multics 

command language, reads the tape that was created 

on the Data General minicomputer and creates the 

Versatec border, grid, State, county, and coordinate 

files. If there is more than one coordinate file, the files 

must be combined on Multics by means of an editor, 

and then sort.vers.coor.ee must be run.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: ec versatec nnnnnn nof filel . . . 

filen

Arguments:

nnnnnn- Volume number of the tape 

nof-Number of files to be copied to disk 

filel . . . filen-Name of the files when copied to disk

Subroutines called: None

Common data referenced: None

Input files: User's tape

Output files: Files copied to disk

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. To execute this exec_com, the operator must type: 

ec versatec.ec, tape number, number of files, segl 

seg2. . . segN where segl, seg2, . . ., segN are the 

file names that are to be created, segl, seg2, . . ., 

segN must not exceed a total of 32 characters 

because of the value command used extensively in 

this exec_com. The value command returns a 

character string associated with a named item in a 

user symbol table segment. This enables administrative exec_com segments to reference 

variables.

2. The exec_com uses the tape_ibm command with 

density 800, record size 80, and ASCII character 

mode.

3. The first file is read from tape and written to disk 

under the name given by segl.

4. The number of file parameters is then checked 

against the number of files that have been written. 

When they are not equal, the next file is attached 

by the I/O command.

5. After the segment is attached, copy_file is used to 

write the segment to disk.

6. This process continues until the number of file 

parameters is equal to the number of files that have 

been written.

7. When the parameters are equal, the tape is renamed 

and the execution of the exec_com is ended.

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

use ec versatec.ec tape no no of files segl seg2. 

where segl seg2....segn must not exceed a total

& ************************************************************

&

&

& versatec.ec

&

&

&

&

&

&

&

&

&

&

&

&

&

&

&

&

&command_line off

&input_line off

&

value$set_seg value_seg

value$set file names [string

. .segn

of 32 char

funct ion:

This ec reads the tape that was created on the Bendix 

minicomputer and creates the Versatec border, grid, state

county, and coordinate files. If there is 

coordinate file, they must be combined on 

sort.vers.coor.ee must be run.

more than one 

Multics and then

&f 3]
126 GEOINDEX

value$set this_file_name &3

value$set increment 0

value$set tape_file_no 1

&if [equal &2 1] &then value$set all_or_none none

&else value$set all_or_none all

&

&label copy

io attach input tape_ibm_ &1 -nib -nb [value tape_file_no] -den 800 -f

\crnt fb -rec 80 -bk 80 -mode ascii -retain [value all_or_none]

io attach output record_stream_ -target vfile_ [value this_file_name]

copy_file -isw input -osw output

io detach (input output)

&

&if [equal [value tape_f ile_no] &2] &then &goto quit

value$set tape_file_no [plus [value tape_file_no] 1]

&if [equal [value tape_file_no] &2] &then value$set all_or_none none

value$set start_of_next_file_name [plus [length [value this__f ile_name]

\c] [value increment] 2]

value$set remnant [string [substr [string [value f ile__names ] ] [value s

\ctart_of__next_file_name] ]]

value*set nxtblnk [search [string [value remnant]] " "]

&if [equal [value nxtblnk] 0] &then value$set next_file_length [length

\c [value remnant]]

&else value$set next_file_length [minus [value nxtblnk] 1]

value$set next_file_name [substr [string [value remnant] ] 1 [value ne

\cxt_file_length]]

value$set increment [plus [value increment] [length [value this_file__n

\came]] 1]

value$set this_file_name [value next_file_name]

&goto copy

&

&label quit

truncate value_seg

&quit

PROGRAM NAME: INDEX^VERSATEC

Author: Lawrence Balcerak

Purpose of the program: index_versatec plots index 

maps using the Versatec plotter.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: index_versatec

Arguments: None

Subroutines called: io_call, ioa_$nnl, setup_versaplot (Multics software), plots, plot, newpen, letter, factor (Versaplot software), openf, rotate, 

legend, pattern, rdftur, srtdup, pltsel, closet

Common data referenced: size, end, istate, scale, 

Iparaml, in1, ipen, kpen, I word!

Input files: bordNM (fileW), gridNM (file11), statNM 

(file12), counNM (file13\ coorNM (file14), pverNM 

(file15)

Output files: Versatec plot

Arrays used: input 4(6) (used to read the six input files)

Called by: None

Error checking and reporting: None

Constants: in = 15, rsiz = 0.14, ipen = 4, rrsiz = 0.04,

kpen = 1 

Program logic:

1. Set fmt2 = (6h(a4,2h,i2,lh)). This is used to put the 

State number into fmtl. The format is those 

characters between the outermost parentheses.

2. Attach to the file init_vals. This file contains those 

changes to the default parameters to the Versaplot software needed for this plot. The file contains xmas - 50.0, which should be adequate for 

most of our plotting.

3. Send message to terminal:

TYPE IN TWO DIGIT STATE NUMBER 

and read istate.
APPENDIX C 127

4. If istate is less than 10, then fmt2

= (6h(a4,2h,lhO,il,lh)). 

Do step 5 for / = 10, 15.

5. Concatenate the State number to input(i) and place 

into name. Call openf with lunlt - i, name = 

name, mode = "si".

6. Call setup__versaplot. This activates the Versaplot 

software.

7. Call plots (0,0,0). This initializes the default 

parameters. If initials is attached, it reads this 

file and makes those changes.

8. Set in 1 = 10. This is the reference number for bordNM. 

Set size = 17.99, which is the width of the plotting

paper. 

Call rotate. 

Print value of scale. 

Call legend. 

Call pattern.

9. If deltay is less than 0.001, go to step 10. A value 

greater than 0.001 indicates that the plot is to be 

rotated and translated. 

Transform xsym, ysym, xlet, and ylet.

10. Call factor. Reset the scale to the value of scale.

11. Read inum(5) and iwords(5) from pverNM.

Set iangle = 0.

Find the starting aj-values (xsym and xlet) for the 

text string iword(5). The values for the use of both 

text plotting subroutines (symbol and letter) are 

given. The visible difference in determining which 

one to use is in the fonts for their letters.

12. If deltay is less than 0.001, go to step 13.

Transform xsym, ysym, and xlet, ylet.

Set iangle = 270.

Call plot (2.0,0.005,-3). This changes the software 

origin. Trying to plot y = 0 or x = 0 when the 

hardware origin is in effect has presented problems in the past. Also, at times the upper left x 

value is negative.

Go to step 14.

13. Call plot (2.0, 1.18, -3). Changes the origin to allow 

negative y values, which are needed to plot the 

legends at the bottom.

14. Plot the five text strings in iwords(i). The letter 

subroutine is the one presently used. The dot 

width for letters is set at 4 except for the date, 

where it is 3.

15. Read the parameter plotting values into inparm.

16. If inparm(1) is not equal to 1, go to next step. A 

value of 1 indicates that the neat outline is to be 

plotted. A value of 0 indicates do not plot.

Set in1 = 10, which is the reference number for the 

neat outline.

Call rdftur.

Rewind in1.

17. Repeat step 16 with inparm(23) and in1 = 11 (grid). 

Go to step 18 if no plot.

18. Repeat step 16 with inparm(45) and in 1 = 12

(State). 

Go to step 19 if no plot.

19. Repeat step 16 with inparm(67) and in1 = 13 (counties). 

Go to step 20 if no plot.

20. Repeat step 16 with inparm(111) and in 1 = 14

(coordinates outlines). 

Go to step 21 if no plot. 

Otherwise, go to step 22 after this is plotted.

21. If inparm(89) is not equal 1, go to next step. 

Set in1 = 14. 

Call srtdup(/m. 

Read in cards with the selected outlines, sort them

in ascending order, and remove duplications. 

Call \se\(inparm(89)). 

Plot the selected outlines. 

Rewind in1.

22. Call plot(0.,0.,999) (end of plot). 

Send message to terminal: 

FINISH PLOT

23. If inparm(133) is equal to 1, go to step 10. 

Otherwise go to step 24.

24. Call plot(0.,0.,-999). 

End all plotting.

25. Call setup_versaplot("-resef") (removes links to

Versatec software).

Call closef(i) for /' = 10, 15 (closes and detaches all 

files).

PROGRAM - INOEX.VERSATEC 

PLOT LAND USE ID'S

L.L. BALCERAK 

U. S. GEOLOGICAL SURVEY

common /rot/ size/end*xmax » ymax*ist a te

common /param/ sea le*de 11ay t rsiz *rrsiz

common /dex/ if t \ ino* isf/isfno^not*nor*nif t ispan*in1 t ipen/kpen
128 GEOINDEX

common /word/ xsym(5) t ysym(5)/inum(5)/numsta(72 ) / 

&xlet(5)/ylet(5),iscale(5)/height(5)

character input*4(6)/fmt1*10/fmt2*21/name*6/i*ords*53(5)

dimension inparm(133)

external io_call (descriptors)/ioa_$nnl (descriptors)/

Ssetup.versaplot (descriptors ) / letter (descriptors)

data input / "bord" ,"g r id"/" s t a t ","coun" ,"c oo r" , "pve r ff /

in=15

i pen = 4

kpen=1

rsi z=0.14

rrsi z=0.04

fmt2="(6h(a4,2h,i2,1h) )" 

c

call io_cal I ("a11ach"/"init_vaIs","vfi le_","init_va I s")

call ioa_$nnl (""/TYPE IN TWO-DIGIT STATE NUMBER: " >

read 10/ istate 

10 format (i2)

if (istate .It. 10) fmt2 = "(6h(a4/2h/1hO,i1/1h ) ) "

do 20 i=10/15

encode (fmt1/fmt2) istate

encode (name/fmtl) input(i-9)

call openf (i/name/"si ") 

20 continue

call setup_versaplot 

c

c SET ORIGIN ON PLOTTER 

c

call plots (U/0/0)

in1=10

size=17.99

call rotate

print /"scale="/scale

call legend (iwords)

call pattern

if (deltay .It. .001) go to 50

do 40 i=1/4

t emp = x sym(i)

xsym(i ) = ysym(i)

ysym(i)=deltay-temp

t emp = x let(i)

x let (i )=y let (i )

ylet (i ) = deltay-temp 

40 cont i nue 

50 call factor (scale) 

c

c BORDER INFORMATION 

c

read (in/60/end=180) inum(5)/iwords(5) 

60 format (i2/a53)

i ang le = 0

xsym(5)=(xmax-inum(5)*(height(5)+0.019))/2.

xlet (5)=(xmdx-inum(5)*(iscale(5)*(0.0625-0.0029))) 12.

if (deltay .It. .001) go to 70

i ang I e = 2 70
APPENDIX C 129

ysym(5) = del tdy-xsym(i>)

yLet (5)=deltay-xlet(5)

xsym(5)=-0.61

xlet(5)=-0.61

caLL plot (2.0,0.005,-3)

go to 80

70 call plot (2.0,1.18,-3) 

80 do 90 i=1/5

j=4

if (i .eq. 4) j=3

call newpen (j)

call letter (inum(i),iscale(i),iangle,xlet(i),ylet(i),iwords(i)) 

90 con t i nue 

c

c READ INPUT INFORMATION 

c

read (i n , 1 00,end=1 71)) inparm 

100 format (66i1/67i1) 

c

c CHECK FOR PLOT OR NO PLOT 

c ON EACH ITEM 

c

c NEAT OUTLINE 

c

if (inparm(1) .ne. 1) go to 110

in1=10

call rdftur (inparm(1))

rewind i n1 

c

c GRID 

c 

110 if (inparm(23) .ne. 1) go to 120

in1=11

call rdftur (inparm(23))

rewind i n1 

c

c STATE 

c 

120 if (inparm(45) .ne. 1) go to 130

in1=12

call rdftur (inparm(45))

rewind i n1 

c

c COUNTIES 

c 

130 if (inparm(67) .ne. 1) go to 140

in1=13

call rdftur (inparm(67))

rewind i n1 

c

c ALL FEATURES 

c 

140 if (inparm(111) .ne. 1) go to 150

in1=14

call rdftur (inparm(111))
130 GEOINDEX

C 

C 

C

150

160

c 

c 

c

170

180

190

rewind i n1 

go to 170

SELECTED FEATURES

if (inparm(89) .ne. 1) go to 170

in1=1A

Cdl I srt dup (in)

call pltsel (inparm(89))

rewind i n1

CHECK IF SOMETHING ELSE IS TO BE PLOTTED

call plot (O.,0.,999)

print *"finish plot"

if (inparm(133) .eq. 1) go to 50

call plot (J. ,0.,-999)

call setup.versaplot ("-reset")

do 190 i=10/15

call c losef(i )

c ont i nue

stop

end

SUBROUTINE NAME: LEGEND

Author: Lawrence Balcerak

Purpose of the program: legend initializes text strings

and beginning text positions for the index maps. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call legend (iwords) 

Arguments: iwords-Five text strings containing the

legends to be placed on the index maps 

Subroutines called: None 

Common data referenced: xmax, ymax, istate, xsym,

ysym, inum, numsta, xlet, ylet, iscale, height 

Input files: None 

Output files: None 

Arrays used:

iwords53(5)

nstate20(72)- Array in which to read the States 

Called by: index versa tec, index ca I com p 

Error checking and reporting: None 

Constants: None

Program logic:

1. Set numsta(i) = the number of letters in the State

name, where / represents the FIPS code. 

Set iwords(1) and iwords(2) 

Set nstate(i) = State names 

Set iwords(3) = nstate(istate)

2. Find year date.

Set iwords(4) = year date.

3. Set other variables: inum is the count of letters for 

each iword; height is the height of letters if using 

symbol to plot the legends; iscale is the height of 

letters if using subroutine letter to plot the 

legends; xsym, ysym are the starting x, y coordinates if using symbol; xlet, ylet are the starting 

x, y coordinates if using letter. 

Note: There are factors of 0.019 and -0.0029 for 

computing xsym and xlet. The factor for using 

symbol is to take into account the slight widening 

of the letter where line width is greater than 1. 

Where letter is used, the supposed width of a letter 

is slightly reduced, but no explanation is given in 

the manual.

subroutine legend (iwords) 

common /rot/ size*end*xmax^ymax*istate 

common /word/ xsym(5)*ysym(5)*inum(5)*numsta(72 ) * 

6 xlet(5),ylet(5),iscale(5),height(5) 

character iwords*53(5)*nstate*20(72)*idt*6*year*4

iwordsd>="UNITED STATES GEOLOGICAL SURVEY" 

iwords(2)="OEPARTMENT OF THE INTERIOR"
APPENDIX C 131

nstated) ="ALABAMA" 

n s t a t e(2 > = "ALASKA"

nstateU) ="ARIZONA" 

nstate(S) ="ARKANSAS" 

nstate(6) ="CALIFORNI A" 

nstate(7) ="CANAL ZONE" 

nstate(8) ="COLORADO" 

nstate(9) ="CONNECTI CUT" 

nstate(10)="DELAWARE" 

nstated1)="DISTRICT OF COLUMBIA 

nstdted 2) = "FLORIOA" 

nstated3) = "G£ORGI A"

nstated 5) = "HAWAII" 

nstate(16)="IDAHO" 

nstate(17)="ILLINOIS" 

nstated8> = " INDIAN A" 

nstate(19)="IOWA" 

nstate(20)="KANSAS" 

nstate(21>="KENTUCKY" 

nstate(22)="LOUISIANA" 

nstate(23)="MAINE" 

nstate(24)="MARYLAND" 

nstate(25)="MASSACHUSETTS" 

nstate(26)="MICHIGAN" 

nstate(27)="MINNESOTA" 

nstate(28)="MISSISSIPPI" 

nstate(29)="MISSOURI" 

nstate(30)="MONTANA" 

nstate(31)="NEBRASKA" 

nstate(32)="NEVADA" 

nstate(33)="NEW HAMPSHIRE" 

nstate(3A)="NEW JERSEY" 

nstate(35)="NEW MEXICO" 

nstate(36)="NEW YORK" 

nstate(37)="NORTH CAROLINA" 

nstate(33)="NORTH DAKOTA" 

nstate(39)="OHIO" 

nstate(40)="OKLAHOMA" 

nstate(41)="OREGON" 

nstate(42)="PENNSYLVANIA"

nstate(44)="RHODE ISLAND" 

nstate(45)="SOUTH CAROLINA" 

nstate(4o)="SOUTH DAKOTA" 

nstate(47)="TENNESSEE" 

nstate(46)="TEXAS" 

nstate(49)="UTAH" 

nstate(50)="VERMONT" 

nstate(51)="VIRGINIA" 

nstate(52)="VIRGIN ISLANDS" 

nstate(53)="WASHINGTON" 

nstate(54)="WEST VIRGINIA" 

nstate(55)="WISCONSIN" 

nstate(56)="WYOMING"
132 GEOINDEX

C

nstate(60)="AMERICAN SAMOA"

nstate(66)="GUAM"

nstate(72)="PUERTO RICO" 

c

iwords(3)=nstate(i state)

call pU .da te_ (i d t)

decode (idt*10) year 

10 format (a2)

encode (iwords(4) , 20) year 

20 format (2h19,a2) 

c

i num(1)=31

i num(2) = 26

inum(3) = numsta(i state)

i num(A) = 4 

c

neightd )=0.18

height(2)=0.18

height(3)=0.18

height(4)=0.14

height(5)=0.28 

c

iscale(1)=3

iscale(2)=3

iscale(3)=3

iscale(4)=3

iscale(5)=5 

c

xsymd ) = 0.25

ysym (1) = yma x + 0.35

xsym(2)=0.2b

ysym(2)=ymax+0.68

xsym(3)=xmax-inum(3)*(height(3)+0.019)-0,25

ysym(3)=ymax+0.68

xsym(4) = (xmax-inum(4)*(height(4)-«-0.019))/2.

ysym(4)=-1.17

ysym (5) = -0.61 

c

do 30 i=1,5

y I et (i) = ysym(i) 

30 cont i nue

x let (1 ) = xsym(1)

x let (2) = xsym(2)

xlet (3) = xmax-inum(3)*(iscale(3)*(0.0625-0.0029))-0.25

xlet(4)=(xmax-inurn(4)*(iscale(4)*(0.0625-0.0029)))/2.

re tu rn

end 

c 

c

block data

common /word/ xsym(5)*ysym(5) » inum<5)*numsta( 72 ) * 

& xlet(5),ylet(5),iscale(5),height(5)
APPENDIX C 133

data 

end

nums t a 

&

& 

&

/ 7/

20/ 

8/ 

8/ 

6/1 

8/ 

O/

6/ 

7/ 

9/

6/1 

2/

0/1

O/

o/

7/

5/ 

3/

O/ 

U/ 

O/

7/ 8/1 

O/ 6/ 

8/13/ 

10/10/ 

12/14/1 

13/ 9/ 

O/ O/

0/1 

5/ 

8/ 

8/1 

2/ 

7/ 

4/

O/ 

8/ 

9/1 

4/1 

9/ 

O/ 

O/

8/1 

7/

2/ 

5/

O/ 

O/

4, 

8/ 

4/ 

4/ 

0/1 

O/

8/ 

6/ 

7/ 

8/ 

7/ 

4/ 

O/ 0/1 1/

SUBROUTINE NAME: ROTATE

Author: Lawrence Balcerak

Purpose of the program: rotate checks bordNM to see if 

it will fit on plotting paper at full scale. If not, it computes a scale that produces the largest possible plot on 

the paper. The finished plot can be upright or rotated 

on its side.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call rotate

Arguments: None

Subroutines called: None

Common data referenced: size, end, xmax, ymax, 

scale, deltay, in1

Input files: bordNM

Output files: None

Arrays used: 

x(6)-x coordinate 

y(6)-y coordinate

Called by: index versatec, index calcomp

Error checking and reporting: None

Constants: None

Program logic:

1. Reads the header card (does not use).

2. Reads data points (always six points).

3. Finds maximum x value and y value and stores in 

xmax and ymax.

4. Set parameters (assume upright at full scale): end = 

xmax + 8.0. In Calcomp plotting, this is the 

amount to move in x to start a new plot; scale = 

1.0; deltay = 0.0. If plot is rotated, deltay is the 

amount of translation needed to bring plot back to 

plotting frame.

5. If ymax plus amount needed for legends at top and 

bottom is less than size (width of paper), go to 

step 10 (plot fits on paper).

6. If xmax is greater than size, go to step 8 (rotated 

plot too big to fit).

7. Rotated plot will fit at full scale. 

Set deltay = xmax 

Set end = ymax + 8.0 

Go to step 10.

8. Plot must be scaled. If plot would be larger rotated 

on side, go to step 9. Otherwise, compute scale in 

upright position. 

Go to step 10.

9. Compute scale in rotated position. 

Set deltay = xmax 

Set end = ymax + 8.0

10. Rewind data file.

Return to calling program.

10

20

30

subroutine rotate

common /rot/ size/end/xmax/ymax/istate

common /param/ sca le/de 11ay/rsiz/rrsiz

common /dex/ if/ifno/isf/isfno/not/nor/nif/ispan^in1/ipen/kpen

dimension x(6)/y(6)

read (in1/10) if

format (i5)

read (in1/20) ( x(i ) /y(i)/i = 1/6)

format (12fb.3)

xma x=x(2)

ymax=y(2)

do 30 i=3/6

if (x(i) .gt. xmax) xmax=x(i)

if (y(i) .gt. ymax) ymax=y(i)

c on t i nue
134 GEOINDEX

40

50

60

end= xma x + 8« 0

scale=1.0

del tay=0.0

if ((ymax + 2

if (xmax .gt.

de I t ay=xmdx

end=ymax+8. 0

go to 60

if (xmax .It.

seal e=size/(ymax

go to 60

scale=size/xmax-0.01

de 1 1 ay=xmax

end=ymax+8. 0

r ew i nd i n1

return

end

05) . I e . size) 

size) go to 40

go to 00

(yma x + 2 . 05) ) 

. 05) -0.01

go to 50

SUBROUTINE NAME: RDFTUR

Author: Lawrence Balcerak

Purpose of the program: rdftur reads a header card from

the file being plotted and branches to the designated

plotting subroutine. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call rdftur (infom) 

Arguments: infom-Array of 22 elements with plotting

parameters for the file being read 

Subroutines called: plotch, plotli, pllich 

Common data referenced: if, ifno, isf, isfno, not, nor,

nif, in1 

Input files: gridNM, statNM, counNM, coorNM

Output files: None

Arrays used: infom-Elements with plotting parameters for the file being read 

Called by: index_versatec, index_calcomp

Error checking and reporting: None 

Constants: None 

Program logic:

1. infom(2) can have values of 0, 1, or 2 (see plotting

parameter cards). 

Add 1 and store in item.

2. Read a header card from file in1. 

If EOF, return to calling program.

3. Call subroutine, which will plot according to the 

parameter stored in infom(2).

4. After return from plotting subroutine, go to step 2.

c 

c 

c

5

10

c 

c 

c

20

subroutine rdftur (infom)

DETERMINE WHAT IS TO BE PLOTTED FOR 

THE SPECIFIED FEATURE

common /dex/ if * ifno*isf * isfno*not/nor*nif * ispan/in1/ipen^kpen 

dimension infom(22) 

i t em = i nfom(2)+1

READ A FEATURE CARD

read (in1*1 U/>end = 80) if*ifno*isf f isfno^not*nor*nif f ispan

format (8i 5 )

go to (40*30*20)*item

CHARACTERS PLOTTED ONLY

call plotch (in fom) 

go to 5
APPENDIX C 135

C 

C 

C

30

C 

C 

C

40

30

LINES PLOTTED ONLY

call plotli (i nfom) 

go to 5

BOTH PLOTTED

call pi Ii ch (i nfom)

go to 5

return

encJ

SUBROUTINE NAME: PENCHG

Author: Lawrence Balcerak

Purpose of the program: penchg changes pen numbers

(Calcomp) or line widths (Versatec) in a sequence

predetermined by the plotting parameters. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call penchg (infom,ipen) 

Arguments:

infom- Array of 22 elements with plotting 

parameters for the file being read

ipen- Counter for member of infom to examine 

Subroutines called: newpen (Versaplot and Calcomp

software)

Common data referenced: None

Input files: None

Output files: None

Arrays used: infom(22)- Elements with plotting

parameters for the file being read 

Called by: plotch, plotli, pllich 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Set k = infom(ipen). k equals pen number (Calcomp) 

or line width (Versatec).

2. Call newpen(k)

3. Add 1 to ipen.

If ipen is equal to 13, set ipen = 4. 

Or, if infom(ipen) = 0, set ipen = 4.

4. Return.

subroutine penchg (infom/ipen) 

change pens

dimension infom(22)

k = i n f om ( i pe n )

call newpen(k)

i pen= i pen + 1

if Cipen .eq. 13) ipen=4

if (infom(ipen) .eq. 0) ipen=4

return

end

SUBROUTINE NAME: PLOTLI

Author: Lawrence Balcerak

Purpose of the program: plotli plots a coordinate outline

without accompanying text. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call plotli (infom) 

Arguments: infom-Array of 22 elements with plotting

parameters for the file being read

Subroutines called: plot, symbol (Versaplot), penchg 

Common data referenced: deltay, rs/z, Isfno, in1, ipen 

Input files: gridNM, statNM, counNM, coorNM 

Output files: None 

Arrays used:

xx(6)-x coordinate,

yy(6)-y coordinate

infom(22)- Elements with plotting parameters for

the file being read 

Called by: rdftur, pltsel
136 GEOINDEX

Error checking and reporting: None 

Constants: None 

Program logic:

1. Call penchg.

2. Set ie = minimum of (QJsfno).

3. Read the first coordinate data card into xx(/), yy(/). 

Set ang = 0.

4. If deltay is less then 0.001, go to step 4. A value 

greater than 0.001 indicates that the plot is to be 

rotated.

Rotate and translate the data points. 

Set ang = 270.0.

5. If isfno is greater than 2, go to step 6.

Otherwise, plot a centered symbol (#2) scaled to 1.5 

times the character height rsiz.

9.

10.

11.

Return.

Go to the first data point of outline with pen up.

Set k = 2. This is the position in xx, yy at which to

start plotting. The first point is the text position. 

Plot points k to ie with pen down. 

Subtract 6 from isfno. 

If isfno is greater then 0 (there are more points to

plot), go to step 9. 

Otherwise return. 

Set ie = minimum of (6,/sfrio). 

Read another data card into xx, yy. 

If deltay is less then 0.001, go to step 11. 

Otherwise, rotate and translate xx, yy. 

Set k = 1. 

Go to step 7.

20

30

c 

c 

c 

40

c 

c 

c 

50

subroutine plotli (infom) 

PLOT LINES ONLY

common /param/ sca Ie*de I1ay*rsiz*rrsiz

common /dex/ if f \ fno/isf/isfno^not*nor/nif/ispan^in1*ipen*kpen

dimension infom( 22 )*xx(6)*yy(6)

CHANGE PENS 

call penchg (infom^ipen)

READ THE FIRST COORDINATE CARD

i e= i s fno

if (is fno .gt . 6) i e = 6

read (in1*20/end=130 ) (xx (i ) *yy (i ) *i=1 , ie )

format (12f6.3)

ang=0.0

if (deltay .It. .001) go to 40

do 30 i=1,ie

temp = x x(i )

x x(i)=yy(i)

yy(i)=deltay-temp

cont i nue

ang=270.0

CHECK FOR A SINGLE POINT

if (isfno .ge. 3) go to 50

call symool (xx(2)*yy(2)*1.5*rsiz*2

jo to 13U

PLOT LINES 

call plot (xx(2),yy(2),3)
APPENDIX C 137

60

70 

c

C

c

80

90

100

110

120

13J

do 70 i=k,ie

calt plot (xx(i),yy(i),2)

cont inue

CHECK FOR MORE COORDINATES

i sfno=i sfno-6

if (isfno) 130,130,80

if (isfno -6) 90,90,100

i e= i s fno

read (in1,20,end=130)

if (dettay .It. .001)

do 110 i=1 ,ie

t emp = x x(i )

x x(i)=yy ( i)

yy(i)=de t ta y-temp

cont inue

k = 1

go to 60

return

end

(xx ( i ) ,yy ( i ) , 

go to 120

i e)

SUBROUTINE NAME: PLLICH

Author: Lawrence Balcerak

Purpose of the program: pllich plots both the feature

number and outline from a coordinate file. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call pllich (infom). 

Arguments: infom- Array of 22 elements with plotting

parameters for the file being read 

Subroutines called: number, symbol, plot (Versaplot),

penchg, shade

Common data referenced: deltay, rsiz, rrsiz, Idexl 

Input files: gridNM, statNM, counNM, coorNM 

Output files: None 

Arrays used:

xx(6) - x coordinate

yy(6)-y coordinate

infom(22)- Elements with plotting parameters for

the file being used 

Called by: rdfftur, pltsel 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Call penchg.

2. Set /e = minimum of (6,/sfr?o).

3. Read the first data card. 

Set ang = 0.

4. If deltay is less than 0.001, go to step 5. A value of 

deltay greater than 0.001 indicates that the plot is 

to be rotated.

Rotate and translate xx, yy. 

Set ang = 270.0.

5. If kpen is greater then 0, call newpen(3). kpen 

serves a dual function. For Calcomp plots, it has a 

value of-1. For Versatec plots, it has a value 

greater than 0. Also, in Versatec plots it serves as 

a counter for the number of the pattern last used.

6. Set ff = if.

Call number to plot the feature number.

7. If the subfeature number is not to be plotted, go to

next step. 

The subfeature numbers are not to be plotted on the

Versatec plots, so if kpen is greater then 0, go to

the next step. 

Set ff = isf. The starting coordinate for the

subfeature number must be offset to place it

directly under the feature number. 

If the plot is not rotated, subtract the letter size

rsiz and a small amount for a gap between lines

rrsiz from yy.

If the plot is rotated, subtract rsiz and rrsiz from xx. 

Call number.

8. Repeat previous step for the span.

9. Repeat previous step for the second subfeature 

number.

10. If isfno is greater then 2, go to step 11.

Otherwise, plot a centered symbol (#2) scaled to 1.5

times the character height rsiz. 

Return.

11. If this is the coordinate outline file being read (in 1 = 

14) and this is a Versatec plot (kpen greater than 

0), go to step 12.
138 GEOINDEX

Otherwise, go to step 13.

12. Call shade. 

Return.

13. Go to the first data point of outline with pen up. 

Set k = 2. This is the position in xx, yy at which to 

start plotting. The first point is the text position.

14. Plot points k to ie with pen down.

15. Subtract 6 from isfno.

If /S/A7O is greater than 0 (there are more points to

plot) go to step 16. 

Otherwise, return.

16. Set ie = minimum of (6,isfno). 

Read another data card into xx, yy.

17. If deltay is less than 0.001, go to step 18. 

Otherwise, rotate and translate xx, yy.

18. Set k = 1. 

Go to step 14.

10

20

c 

c 

c

30

subroutine pllich (infom)

PLOT BOTH LINES AND CHARECTERS

common /param/ sca Ie/de11ay/rsiz/rrsiz

common /dex/ if*ifno » isf * \ sfno/not*nor/nif*ispan*in1/ipen/kpen

dimension infom( 22 ) f xx(6) fyy (6)

CHANGE PENS 

call penchg (infom/ipen)

READ THE FIRST COORDINATE CARD

i e= i s f no

ifCisfno .gt. 6) i e = 6

read (in1/1U*end=230) (xx(i) *yy (i )*i=1 *ie)

format (12f6.3)

ang=O.G

if (deltay .It. .001) go to 30

do 20 i=1,ie

temp = x x(i)

x x(i)=yy(i)

yy(i)=deltay-temp

cont i nue

ang=270.G

PLOT FEATURE NUMBER

if (kpen .gt. 0) call newpen(3)

f f=i f

call number (xx(1)*yy(1)*rsiz*ff*ang*-1>

CHECK FOR SUBFEATURE NUMBER

c 

c 

c

if (ifno .eq. 1) go to 70

C ******THE FOLLOWING LINE IS INCLUDED TO ELIMINATE THE SUBFEATURE 

c ****** NUMBER IN VERSATEC PLOTS

i f (kpen .gt. 0) go to 70

if (deltay .gt. .001) go to 50

yy(1)=yy(1)-rsiz-rrsiz

go to 60

50 xx(1)=xx(1)-rsiz-rrsiz 

60 ff=isf

call number (xx(1)*yy(1)*rsiz*ffsang*-1)
APPENDIX C 139

C

C CHECK FOR SPAN

C

70 if(ispan.eq. 0) go to 100

if (deltay .yt. .001) go to 80

yy(1)=yy(1)-rsiz-rrsiz

go to 90

80 xx(1)=xx(1)-rsiz-rrsiz 

90 ff=ispan

call number (xx(1)/yy(1)/rsiz/ff/ang/-1) 

c

C CHECK FOR SECOND SUBFEATURE NUMBER 

c 

100 if (not .eq. 0) go to 130

if (kpen .gt. 0) go to 130

if (deltay .gt. .001) go to 110

yy(1)=yy(1)-rsiz-rrsiz

go to 120

110 xx(1)=xx(1)-rsiz-rrsiz 

120 ff=not

call number (xx(1) ,yy (1)/rsiz/ff/any/-1) 

c

C CHECK FOR A SINGLE POINT 

c 

13U if (isfno .ye. 3) go to 140

call symool (xx(2) /yy(2) f 1.5*rsiz/2/ang/-1)

return

140 if ((in1 .eq. 14) .and. (kpen .gt. 0)) go to 220 

c

C RESET PEN 

C

i pen = i pen-1

call penchg (infom/ipen) 

c

c PLOT LINES 

c

call plot (xx(2)/yy(2)/3)

k = 2 

150 Jo 160 i=k/ie

call plot (xx (i)/yy (i ) /2) 

160 cont i nue 

c

C CHECK FOR MORE COORDINATES 

c

i s f no= i s fno-6

if (isfno) 230/230/170 

170 if (isfno-6) 180/180/190 

180 i e= i s fno 

19U read (in1/1O/end = 230) ( xx(i )/yy(i)/i=1/ie)

if (deltay .It. .001) go to 21U

do 200 i=1/ie

temp = x x(i)

xx(i)=yy(i)

yy(i)=deIta y-temp 

20U con t i nue 

210 k=1
140 GEOINDEX

220

230

go to 150 

call shade 

return 

end

SUBROUTINE NAME: PLTSEL

Author: Lawrence Balcerak

Purpose of the program: pitsel reads through a file of

coordinates, identifies those that are to be plotted, and

branches to the appropriate plotting subroutine. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call pitsel (infom) 

Arguments: infom-Array of 22 elements with plotting

parameters for the file being read 

Subroutines called: plotch, plotli, pllich 

Common data referenced: ik, num, numsel, numsub, if,

isf, fsfno, in1 

Input files: coorNM 

Output files: None 

Arrays used: infom(22)- Elements with plotting

parameters for the file being read 

Called by: index_versatec, index__calcomp 

Error checking and reporting: If some features cannot

be located, a message appears on the screen: 

SOMETHING IS WRONG WITH THIS NUMBER

along with the number.

Constants: io = 0 sets the program for terminal output 

Program logic: 

1. Set io = 0 (terminal output).

Set item = infom(2) + 1. infom(2) has possible

values of 0, 1, or 2. 

Set Ik = 0. This is a counter for number of the outline

being plotted. 

Set kount = 0. This is a counter for number of times

file has been read.

2. Add 1 to ik.

3. If ik is less than or equal to num go to step 4.

Otherwise, return, num is the total number of 

outlines to be plotted.

4. Read a header card. If EOF, go to step 8.

5. If the feature and subfeature numbers of the header 

card just read match with the selected feature, go 

to step 7. Otherwise, go to step 6.

6. Read through to data points to reach the next header

card. 

Go to step 4.

7. Call the appropriate plotting subroutine as identified 

by item. 

Go to step 4.

8. Add 1 to kount. Rewind data file:

If kount is less than 2, go to step 4. Otherwise go to 

step 9.

9. Write to terminal giving error message about

unbeatable features. 

Set kount = 0 

Go to step 2.

10

20

30

50

wro

subroutine pitsel (infom)

PLOT ONLY SELECTED FEATURES

/sortu/ i k num/ num se I ( 1 50U ) /numsub ( 1 500 ) f numgo ( 1 500 )

i s f no / no t / no r /n i f * i span / i n 1 / i pen /kpen

if

common

common /dex/ i f f i f no / i s f 

dimension infom(22) 

io = 0

i t em= infom(2)+1 

i k = 0 

koun t = 0 

i k= i k + 1 

= 0

if (ik-num) 20/20/160 

read ( i n 1 ,3 0 / end = 1 40 ) 

format (8i5 )

if ((numsel(iK) .eq. if) .and. (numsub(ik) .eq. 

((numsel(ik) .eq. if) .and. (iwro .eq. 1)) go to 

read ( i n 1 /oU / end = 1 40 ) x

i f , i f no / i s f / i s f no *not / no r /ni f * i span

isf)) 

1 U 0

yo to 100
APPENDIX C 141

o) go to 20

(i nf om ) 

(i n fom ) 

130,150,160

60 format (f6 . 3 ) 

if (isfno .le. 

isfno=isfno"6 

jo to 50

100 jo to (130,120,110),itern 

110 call plotch (infom)

jo to 10 

120 call plot li

jo to 1J 

130 cal I pI Ii ch

jo to 10

140 if (ik-nurr.) 

150 Kount=kount+1

rewind i n1

if ((iwro . e q . 1) .and. 

if (iwro .eq. 1) 90 to 20

i f (kount .It. 2) go to 20 

write (io/155) numse I (ik)/numsuo(ik) 

155 format (1x/ "SOMETHING IS WRONG WITH 

iwro = 1 

isec = 1

K oun t = 0 

go to 20 

15 f kount = 0 

isec = 0 

iwro = 0 

jo to 10

160 return 

end

(isec .eq. 1)) go to 157

THIS NUMBER.",2(3x,i5) )

SUBROUTINE NAME: PLOTCH

Author: Lawrence Balcerak

Purpose of the program: plotch plots the feature

number of an outline and then reads through the data

points for that outline. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call plotch (infom) 

Arguments: infom-Array of 22 elements with plotting

parameters for the file being read 

Subroutines called: number (Versaplot), penchg 

Common data referenced: deltay, rsiz, rrsiz, if, if no, isf,

isfno, not, ispan, in1, ipen 

Input files: gridNM, statNM, counNM, coorNM 

Output files: None 

Arrays used: infom(22)- Elements with plotting

parameters for the file being read 

Called by: rdftur, pltsel 

Error checking and reporting: None 

Constants: None 

Program logic: 

1. Call penchg.

2. Read text position from first data card into xx and

yy3. Set // = // (the number to be plotted). 

Set ang = 0.0 (the angle at which to plot).

4. If deltay is less then 0.001, go to step 5. 

Otherwise, the plot is to be transformed. 

Set ang = 270.0. Rotate and translate xx, yy.

5. Call number to plot the feature number.

6. If subfeature number is not to be plotted, go to next

step.

Set // = isf. 

The starting coordinate for the subfeature number

must be offset to place it directly under the feature

number: 

If the plot is not rotated, subtract the letter size (rsiz)

and a small amount for a gap between lines (rrsiz)

from yy.

If the plot is rotated, subtract rsiz and rrsiz from xx. 

Call number.

7. Repeat previous step for the span.

8. Repeat previous step for the second subfeature 

number.

9. If there are more data points, read through them to

position the file at next header card. 

Return
142 GEOINDEX

subroutine plotch (infom) 

c

c PLOT CHARACTERS ONLY 

c

common /param/ s ca I e *de I 1 ay * r s i 2 * r r s i 2

common /dex/ i f , i f no * i s f * i s f no^not / no r ,n i f r i span* i n 1 , i pen * kpen

dimension infom(22) 

c

c C H A ,M G E P E N S 

c

call penchy (infom/ipen) 

c

c READ THE FIRST COORDINATE CARD 

c

read ( i n 1 ,1 U,end=1 20 ) xx^yy 

10 format (12f6.3) 

c

c PLOT THE FEATURE NUMBER 

c

f f = i f

ang=0. U

if (deltay .It. . 0 U 1 ) go to 2U

t emp = x x

x x = y y

yy = del tay-t emp

20 call number ( x x f yy * r s i 2 f f f * a ng*- 1 ) 

c

c CHECK FOR SUQFEATURE NUMdbR 

c

if ( i f no . eq . 1 ) go to 5U

if (deltay .gt. ,001)go to 30

yy=y y-rs i z~ r r s i 2

jo to 40

30 x x= x x- r s i 2- r r s i z 

AO f f = i sf

call numoer (xx*yy*rsiz*ff*ang*-1) 

c

C CHECK FOR SPAN 

c 

50 if (ispan .eq. 0) 90 to 80

if (deltay .yt. .001) yo to 60

y y=y y- PS i Z- r r S i 2

yo to 70

60 x x= x x- r s i 2- r r s i 2 

70 f f = i span

call number ( x x f y y * r s i 2 f f f f ang ,- 1 ) 

c

c CHECK FOR SECOND SUBFEATURE NUMBER 

c 

80 if (not .eq. 0) go to 110

if (deltay .yt. .001) go to 90

yy = yy~" r siz-rrsi2

yo to 100
APPENDIX C 143

90

103

c 

c 

c

11J

1 20

x x = x x-rs i z-r r s i z

f f = not

call number ( xx/yy/rsiz/ff/ang/-1)

MUST PROCESS OTHER COORDINATE CARDS

if (isfno .Le.6) go to 120

i s f no=i s fno-6

read (in1/1O/end=120) xx/yy

go to 110

return

end

SUBROUTINE NAME: SHADE

Author: Lawrence Balcerak

Purpose of the program: shade draws coordinate

outlines and shades them either as a sequential variety

of patterns or as a predetermined pattern. There are

presently 10 patterns. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call shade (xx,yy) 

Arguments: xx, yy— Pairs of coordinates from first card

image read in calling subroutine 

Subroutines called: newpen, plot, tone (Versaplot) 

Common data referenced: ik, numgo, deltay, kpen, in1,

isfno, ip1-ip10 

Input files: coorNM 

Output files: None 

Arrays used:

xx(6)- x coordinate

y/(6)- y coordinate

x(2000)~ Buffer area for as, coordinates

y(2000)— Buffer area for y coordinates 

Called by: pllich

Error checking and reporting: None 

Constants: None 

Program logic:

1. Add 1 to kpen. kpen is the counter by which the patterns rotate.

2. Set first five elements of x, y = to elements 2 through 

6 of xx, yy. The first coordinate pair of xx, yy is the 

text position.

3. Read rest of coordinates into x, y.

4. If deltay is less than 0.001, go to step 5. deltay has a

positive value if the plot is to be rotated and

translated. The first five elements of x, y have

already been transformed in the calling program.

Rotate and translate the remaining elements of x, y.

5. Set the line width to two dots. Thick outlines are 

more conspicuous.

6. Plot the outline. Go to the first point with pen up. Go 

to succeeding points with pen down.

7. Set line width to one dot for the shading to follow.

8. If numgo(ik) is greater than 0, then change the 

shading pattern to that number. Otherwise, set the 

pattern to kpen.

9. Shade the outline. 

Return.

10

subroutine shade (xx/yy)

common /sortd/ ik/num/numseI(1500)/numsub(1500)/numgo(1500)

common /param/ scaLe/deItay/rsiz/rrsiz

common /dex/ if/ifno/isf/isfno/not/nor/nif/ispan/in1/ipen/Kpen

common /pat/ i p1 (1 6) / i p2 (1 6) / i p3 ( A ) / i p4 ( A ) / i p5 ( 1 6) / i pt> (1 6 ) /

i ip7(16),ip8(16)/ip9(16)/ip10(16) 

dimension xx(6)/yy(6)/x(2JOO)/y(2000) 

K pen = k pen+1

if ( kpen .jt. 10) kpen=1 

do 10 i=1/5 

x ( i ) = x x (i +1 ) 

y(i )=yy(i +1 ) 

cont i nue 

number = i s fno-1 

if (number-5) 50/50/20
144 GEOINDEX

30

40

50

60

70

read (in1/30) ( x ( i ) / / ( i ) / i =6/numbe r )

format ( 1 2f 6 . 3)

if (deltay .It. .001) go to 50

Jo 40 i=6/number

t emp = x ( i )

x(i )=y (i )

y(i ) = del t ay -t emp

c on t i nue

call newpen ( 2)

cal I plot ( x(1 )/y( 1) /3)

do 60 i=1 /number

cal I plot (x (i )/y ( i ) /2)

con t i nue

call newpen ( 1 )

if (numgo(iK) .le. 0) 90

jo to

go to

to 7(J

(30/90/100/1 10/120/130/140/150/160/170) /numgoCi k) 

(80/9G/100/1 10/1 20/130/140/150/160/170) /kpen

80

90

1

1

1

1

1

1

1

1

1

OJ

10

2J

3J

40

50

60

70

80

ca

go

c a

90

c a

go

c a

90

c a

JO

c a

yo

ca

go

ca

go

c a

go

ca

C d

re

I

I

I

I

I

I

I

I

I

I

I

t

I

t

I

t

I

t

I

t

I

t

I

t

I

t

I

t

I

t

I

I

u

t

o

t

0

t

o

t

0

t

0

t

o

t

o

t

o

t

o

t

t

rn

one

160

one

1bJ

one

180

one

180

one

160

one

180

one

180

one

18J

one

180

one

one

(0.

(0.

( u.

(0.

(U.

(0.

( J.

(0.

(u.

(0.

(x/

/O

/o

/o

/o

/o

/o

/o

/u

/o

/o

y

./i p i

./ip2

./ip3

.,ip4

./ip5

./ip6

./ip7

./ip8

./ip9

./ip1

numbe

/-16)

/-16)

,-4)

/-4)

/-16)

/-16)

/-16)

/-16)

/-16)

0/-16)

r/1 )

end

SUBROUTINE NAME: SRTDUP

Author: Lawrence Balcerak

Purpose of the program: srtdup reads the selected 

feature numbers to be plotted, sorts them into ascending order, and removes all duplications.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call srtdup (in)

Arguments: in-File number of parameter file pverNM

Subroutines called: None

Common data referenced: num, numsel, numsub, 

numgo

Input files: pverNM

Output files: None

Arrays used:

numsel( 1500)-Reference numbers 

numsub(1500)-Reference subfeature numbers 

numgo( 1500) -Optional shading pattern numbers

Called by: index_versatec, index__calcomp

Error checking and reporting: None

Constants: None

Program logic:

1. Set num = 1. num counts the reference numbers as 

they are read in.

2. Read first:

numsel(1) (selected reference number).
APPENDIX C 145

numsub(1) (reference subfeature number). 

numgo(1) (optional shading pattern number). 

lfnumsel(1) = -1, return.

3. Read next line into /temp 7, itemp2, itemp3. 

If/temp 7 = -1, return.

4. If the number is a duplicate of some existing member,

go to step 3.

If the number should be inserted between two existing members at position k, go to step 6. 

Otherwise:

5. Add 1 to num.

Set:

numsel(num) = /temp 7

numsub(num) = itemp2

numgo(num) = itemp3 

Go to step 3.

6. Shift all members of the arrays from position k 

through num up one element. 

Set:

numsel(k) = /temp 7

numsub(k) = itemp2

numgo(k) = itemp3 

Add 1 to num. 

Go to step 3.

c

C

c 

30

50

60

subroutine srtdup (in)

READ I .M THE SELECTED FEATURE NUMBERS TO BE PLOTTED. 

SORT THEM IN AS C ENDE D I NG ORDER AND REMOVE 

ALL DUPLICATIONS

common /sortd/ i k t num* num se I ( 1 500 ) *nums ub ( 1 500 ) *numy o ( 1 500 )

num= 1

reau (in*20) nums e I ( 1 ) *n urns ub ( 1 ) *n umgo ( 1 )

format ( i 8 * i 2 * i <? )

if (numsel(1) .eg. -1) go to 9J

SORT AND REMOVE DUPLICATE CARDS AS EACH IS READ IN

read ( i n * <? 0 ) itemp1*itemp2*itemp3

if (itempl .eq. -1) 30 to 90

do 70 k = 1 , n u m

if ( (i tempi .eg. numsel(k)) .and. (i temp 2 .eq. numsub(k)) )

jo to 30

if (itempl . g t . numsel(k)) go to 70 

it (itemp1.lt. numsel(k)) go to 50 

if ( (iternp2 .It. numsuo(k)) .or. (i temp! .It. numsel(k)) )

go to 50 

k = k + 1

if (k .gt. num) go to 80 

go to 40 

I =num+ 1

Jo 6u j=k*num 

1 = 1-1

numsel( l*1)=numsel (L) 

numsub( L •»• 1 ) =numsub ( I ) 

numgo( L •*• 1 ) = numgo(l ) 

c on t i nue

numseL (n)=i tempi 

numsub(k)=i

70

80

num=num+ 1 

go to 30 

con t i nue 

num = num* 1
146 GEOINDEX

90

numsel (num)= i tempi

numsub(num)=i t emp2

nuingoCnum) 3 i t e m p 3

yo to 30

return

end

SUBROUTINE NAME: PATTERN

Author: Lawrence Balcerak

Purpose of the program: pattern sets the shading pattern variables to user-defined values. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call pattern 

Arguments: None 

Subroutines called: None 

Common data referenced: pat

Input files: None

Output files: None

Arrays used: ip1(16), ip2(16) ip3(4), ip4(4), ip5(16),

ip6(16), ip7(16), ipd(16), ip9(16), ip10(16) (shading

pattern arrays)

Called by: index_versatec, verplot 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Set all elements of the shading pattern arrays to 

those interger values that will give the bit patterns 

desired.

10

20 

c

subroutine pattern

common /pat/ i p1 ( 1 6) , i p2 ( 1 6 ) , i p3 ( 4 ) , i p4 ( 4 ) , i p5 ( 1 6) * i p6 ( 1 6 )

& ip7(l6),ip8(16),ip9(16),ip10C16) 

do 10 1=1,4 

ip3( i)=0 

ip4 ( i )=0 

cont i nue 

do 20 i=1,1o 

ip1 ( i )=0 

ip2( i )=0 

ip5( i)=0 

ip6( i)=0 

ip7(i )=0 

ip8( i)=0 

ip9( i)=0 

ip10( i )=0 

con t i nue

ip1 (5) = l6*ip1 (1 ) 

ip1(9)=8*16**6+2*l6**2 

ip1 (13) = 16* i1 (9)

i p 2 ( 8 ) = i p 1 ( 9 ) 

ip2(12)=ip1 (5) 

ip2( 1o)=ip1 C 1 )

ip3( 1 )=4*16**4+1 

ip4(3)=4*l6**8+2*16**6+16**A+8*16

ip5 ( 1 )=4*16**7

ip5 (2)=1b**8+16**7
APPENDIX C 147

ip5(4)=2*1b**8+8*16**6 

ip5(6)=ip5(2) 

ip5(7)=ip5( 1 ) 

ip5(9)=16**3 

ip5(10)=4*1&**3+4*16**2 

ip5(12)=8*16**3+2*16**2 

ip5(14)=ip5 (10) 

ip5(15)=ip5 (9)

ip6(1)=8M6**7+8*l6**6+4*16**5+4*16**4+2*16**3+2*16**2+16+1 

ip7 (4)=1o**4+8*16

ip7(12)=4*l6**8+2*1b**6 

ip7(16)=ip7(8)

ip8(1 )=ip6(1 ) 

ip8(9)=ip6( 1 )

ip9(2)=ip5(2)

ip9(4)=ip5(1 )

ip9(b)=ip5(2)

ip9(8)=4*l6**8+2*16**6+l6**4+8*16

ip9(10)=ip5 (10)

ip9(12)=ip5 (9)

ip9(14)=ip9 (10)

ip9(16)=ip9(8)

ip10(2)=ip5(9)

ip10(4)=16**4+5*l6**3+4*16**2+8*16

ip10(6)=ip10(2)

ip10(8) = 4*1b**7-H6**3

ip10(10)=ip5(7)

ip10(12)=5*16**8-«-5*16**7-»-2*16**6

ip10(14)=ip10(10)

ip10(l6)=ip10(8)

return 

end

EXEC_COM: SORT.VERS.COOR.EC

Author: Donald Hanson

Purpose of the program: sort.vers.coor.ee executes the

three programs written in the Multics command

language and system_sort that produces the sorted

coordinate file. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: ec sort.vers.coor NM 

Arguments: JVM-FIPS code 

Subroutines called: pgml.vers.exthdr, pgm2.vers.

sequent, pgmS.vers.merge 

Common data referenced: None

Input files: coorNM.unsort used on unit 10 (fileW)

Output files:

coorNM.unsort.hdr used on unit 12 (file12) 

coorNM.sequent used on unit 14 (file14) 

coorNM.sort.hdr used on unit 10 (1ile10] 

coorNM

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. To execute this exec com, the operator must type:

ec sort.vers.coor NM 

where NM is the State code.
148 GEOINDEX

2. A message will print that the first program has 

started executing. This program extracts the 

header records from the unsorted coordinate file.

3. The unsorted coordinate file (coorNM.unsort) is attached to fileW, and the unsorted header file is attached to file12.

4. The next step is the system sort, which sorts the 

header file by feature number and subfeature 

number. These are the first 10 characters of the 

header record.

5. A message will next appear that program 2 has been 

started. This program takes the unsorted coordinate file and converts it from a stream to a sequential file.

6. The stream coordinate file is attached to file13 and 

the sequential coordinate file is attached to file14.

7. When program 2 is completed, program 3 starts.

8. The third program merges the sorted header file 

and the unsorted coordinate file in to the sorted 

coordinate file.

9. The sorted header file is attached to fileW. The sequential coordinate file is attached to file13.

10. filel3 is opened with a mode of sequential update in 

order to allow records to be deleted after they 

have been written to filel2.

11. The sorted coordinate output file is attached to 

filel2.

12. At completion, all files are closed and a message 

appears: 

JOB FINISHED

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

sort.vers.coor.ee

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

jse: ec sort.vers.coor.ee nm 

where nm is state code

function:

this ec takes the unsorted coordinate file and produces 

a sorted coordinate file. The first program extracts the 

header records from the unsorted coordinate file. The header 

records are then sorted in sort_seg. The second program takes 

tne unsorted coordinate file and converts it from a stream 

to a sequential file. The third program merges the sorted 

header file and the unsorted coordinate file into the sorted 

coordinate file.

Sprint program 1 started

10 at

i o at

pgml .

i o de

i o de

£

£p r i n

£

so r t _

£

£p r i n

£

10 at

i o at

pgm2.

i o de

tdch filelU vfile_ coor£1.unsort 

tach f i I e 1 <? vfile_ coor £1 . unso r t . hdr 

vers.exthdr 

tach fi le1G 

tach fi Ie12

t sort started

seg coor£ 1.unsort.hdr -sm coor£1.sort . hdr -fl 1 1U

t program 2 started

tach file13 vfile. coor£1.unsort 

tach fiIe 14 vfile_ coor£1 . sequent 

vers.sequent 

tach f iIe13
APPENDIX C 149

io detach f i I e 1 4

&

i p r i n t program3 started

&

io attach filelO v f i I e _ coorii1.sort.hdr

io attach file13 vfile_ coor&1.sequent

i o open f i I e13 squ

io attach file12 vfiIe_ coor£1

pgm3.vers.merge

io detach filelO

io close fiIe1 3

io detach file13

io detach f i I e 1 2

iprint coorainate file merge is complete

&print JOD finished

SUBROUTINE NAME: PGM1.VERS.EXTHDR

Author: Donald Hanson

Purpose of the program: pgml.vers.exthdr extracts the 

header records from the files that were created on the 

Data General minicomputer. The input is the unsorted 

coordinate file created in versatec.ec and merged 

together in editor qedx. This program is the first program executed in sort.vers.coor.ee.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: pgml.vers.exthdr

Arguments: None

Subroutines called: close_files

Common data referenced: None

Input files: coorNM. unsort

Output files: coorNM.unsort.hdr

Arrays used:

da ta( 12)- Coordinates

/(#)- Header records 

Called by: sort.vers.coor.ee

Error checking and reporting: None 

Constants: None 

Program logic:

1. The input file is attached by the I/O switch to filelO.

2. The output file is attached by the I/O switch to file 12.

3. The input file consists of header and coordinate 

records not in order by feature number. The input 

file is read and the header records only are extracted and written to the output file. The output 

file consists of header records not in order by 

feature number.

4. The input file is read until the end of file is reached, 

at which time the STOP message appears.

c this is a program to extract the header records

c from the files that were created on the Bendix minicomputer

c written OHanson A/5/78

external cf(descriptors) 

dimension i (8 ) 

d i men si on dat a(12) 

print/"exthdr started" 

75 readCI 0/100/enj=300) i 

100 format(8i5)

write(12/150) i 

150 format(8i5,40x) 

170 read(10,200,end=300) data 

200 format (12f6.3) 

i (4) = i(4) - 6 

i f(i (A) .gt.0) go to 1 70 

go to 75

300 call cf("-all") 

s t op 

end
150 GEOINDEX

SUBROUTINE NAME: PGM2.VERS.SEQUENT

Author: Donald Hanson

Purpose of the program: pgm2.vers.sequent changes 

the unsorted coordinate records from stream to sequential, which is necessary because the position 

parameter in pgmS.vers.merge must operate on a sequential file. The input is the stream format unsorted 

coordinate file, and the output is the sequential format 

unsorted coordinate file. This program is the second 

program executed in sort.vers.coor.ee.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Arguments: None

Operating system: Multics

Calling sequence: pgm2.vers.sequent

Subroutines called: close_files

Common data referenced: None

Input files: coorNM.unsort

Output files: coorNM. sequent

Arrays used: 

ihead(8)- Header records

data(l2)- Coordinate records 

Called by: sort.vers.coor.ee

Error checking and reporting: None 

Constants: None 

Program logic:

1. The input file coorNM.unsort is attached by the I/O 

switch to file13.

2. The output file is attached by the I/O switch to file14.

3. The input file is read in a formatted stream mode, 

and the output file is written in an unformatted sequential mode.

4. The number of coordinate data points that follow 

each header card is contained in the fourth field of 

the header card.

5. As each data card is read, six is subtracted from the 

number of points because each record contains six 

pairs of coordinates.

6. When this number is no longer greater than zero, the 

next record is a header record.

7. This process is continued until the end of file is 

reached.

a program to change the unsorted coordinate 

from stream to sequential

c t h i s i s

c records

c

external cf(descriptors )

dimension ihe ad(fa) f ddta (1 2 )

75 read(13,100,end=300) ihead

wr i t e (14) i head 

240 read(13,250,end=300) data

wr i te (14) data

i head(4) = i headC 4) - 6

if(ihead(4).gt.0) goto 240

goto 75

10J format(8i5) 

250 format(12f6.3) 

300 call cf("-all">

stop 

en J

SUBROUTINE NAME: PGMS.VERS.MERGE

Author: Donald Hanson

Purpose of the program: pgmS.vers.merge merges the 

unsorted coordinate file and the sorted header file to 

form the sorted coordinate file. This file is then used 

for input to the index versatec programs. This program is the third program executed in sort.vers.- 

coor.ec.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: pgmS.vers.merge

Arguments: None

Subroutines called: io_call, close_files

Common data referenced: None

Catted by: sort.vers.coor.ee

Input files: coorNM.sort.hdr, coorNM.sequent

Output files: coorNM

Arrays used:

x(6)-x coordinate

y(6)-y coordinate

Error checking and reporting: None 

Constants: None
APPENDIX C 151

Program logic:

1. There are two input files. The first input file, 

coorNM.sort.hdr, is attached by the I/O switch to 

fileW.

2. The second input file, coorNM.sequent, is attached 

by the I/O switch to file13.

3. The output file is identified by the name coorNM 

and is attached by the I/O switch to file12.

4. The records from fileW and file13 are read. If 

feature number and subfeature number of fileW 

match those of file13, the records are written to 

file12.

5. The records in file13 that have been matched are 

then deleted from file13 by the delete—record

feature of io_call. By deleting these records that 

are no longer needed from the input file, total processing time is drastically reduced.

6. When the feature and subfeature numbers do not 

match between fileW and file13, file13 is advanced until a match is found.

7. When feature numbers cannot be matched file13 is 

positioned to the next header records by the 

char_skip feature of io_call.

8. After a match has been found and the records written 

to file12, file13 is positioned at the beginning of 

file, (EOF), by this feature of io_call. The cycle is 

then repeated until the end of file is reached.

the unsorted coordinate 

file for versatec

c this is a program to merge 

c file and the sorted header 

external i o ( desc r i pto r s ) 

external c f ( de sc r i pto r s ) 

integer skip

character*3 char_skip 

dimension x(6)/y(6)

75 read ( 1 O/ 1 00/end=3uG) i i f/ i f no/ i s f/ i s f no/not /nor / ni f / i span 

120 read(13*end=300) iif1/ifno1/isf1/isfno1/not1/nor1/nif1/ispan1 

i f ( i i f 1 . eq. i i f . and . i s f . eq. i s f 1 ) goto 220 

if (mod ( i sf no1 /6) . eq. U) goto 200 

skip = i fix ( float ( i sfnol )/6.0 + 1.U) 

goto 400

200 sk ip = isf no1/6 

409 en code ( cha r.sk i p/ 5UO) skip

call ioC'posi t ion" /"f i Ie1 3" ,"fwd"/ char.sk ip) 

goto 1 20 

220 w r ite(12/230) i i f/ i fno/isf/ isfnol /not/nor/ni f/i span

call io ("delete_record","f i Ie13") 

240 read(13/end = 300) ( x ( i ) /y ( i ) / i = 1 ,6 )

call io ("delete_record"/"f i Ie13")

write(12/250) (x(i)/y(i)/i=1,6)

isfnol = isfnol - 6

i f (i sfnol .gt .0) goto 240

call io ("posi tion"/"f i Ie13","bof")

goto 75

10J format(8i5) 

230 f o rmat (3i 5/40x ) 

250 format(12f 6.3) 

500 format(i3) 

300 call cf("-all")

stop 

end
152 GEOINDEX

PROGRAM NAME: MASTER

Author: Harold Johnson

Purpose of the program: master uses the numerical 

coordinate files for maps of the State and the 

reference outlines to calculate the areas in square 

kilometers, to calculate reasonable center-point coordinates for each area, to test the reasonableness of 

these center points, and to output a file of center 

points that may not be suitably located.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: master

Arguments: None

Subroutines called: arcntr_master, adjust—master, 

closer, ftnumber

Common data referenced: true, sk, ia

Input files:

areano used on unit 37 (file37) 

List of variables: it = true State area in square

miles.

Formats: (16)

Layout description: See areano. 

statNM used on unit 31 (file31) 

coorNM used on unit 32 (file32)

Output files: 

areaNM used on unit 33 (file33)

Format: (215, F8.1)

File created by: adjust—master

Layout description: Area is the summed areas of all

outlines having the same if. 

measNM used on unit 40 (file40) 

List of variables: if, isf, area 

Formats: (215, F8.1) 

File created by: master 

Layout description: Area is the area of the outline

with the corresponding if, isf. 

Arrays used: None 

Called by: None

Error checking and reporting: None 

Constants: None 

Program logic:

1. Input files are identified with Fortran numbers: 

statNM, coorNM, are coordinate files for plotting 

the State outlines; areano is a file of State areas. 

The user is prompted for only the FIPS code 

number ia and for the scale used in the maps from 

which statNM, and coorNM were derived. Scale is 

1 to sk.

2. areano is searched for the true area of this State.

3. arcntr_master is called to compute the areas of the 

outlines for this coorNM file, and areas are adjusted using the State areas.

4 . adjust—master is called to sum areas belonging to 

the same reference.

C ******* ,/| ASTER   

c ** ********

c ________

C

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c

* * *

MASTER ***************

THIS PROGRAM D

1. USING "ARC 

" S T A T N \A " /

2. READS THE 

RATION OF THES 

MULTIPLIES EVE

3. EACH MAP 0 

POINT IS CONST 

THE FILES "CNT

4. USING "CNT 

THEIR NEARNESS 

OF THE OUTLINE 

SIDE OF THE 80 

A FILE CALLED

5. FINALLY TH

SArtE "IF" NUMB

THE F 0 L L 0 WI 

FILE 5 = TO IN 

FILE 37 = LIST 

FILE 31 = "STA 

FILE 3^ = "COO

OES THE FOLLOWING:

NTR"/ MASTER CALCULATES THE STATE

TRUE STATE AREA FROM FILE "AREANO 

E TO GIVE A CORRECTION FACTOR "FA 

KY SUCCESSIVE AREA CALCULATION 

UTLINE IN "COORNM" IS THEN EXAMIN 

RUCTED ALONG WITH AN AREA. THESE 

RNM" AND "MEASnm", RESPECTIVELY 

EST" SUBROUTINE/ THESE CENTERS AR 

TO THE BOUNDARY OF THE OUTLINE W 

IS LARGE/ AND FOR THEIR POSITION 

JNDARY. CENTERS WHICH FAIL THE T 

"DOUBT" AND TO FILE 6. 

E SUBROUTINE "ADJUST" SUMS ALL AR 

tR. THE OUTPUT FILE IS "AREANM".

AREA FROM FILE

" AND FORMS THE 

CFOR" WHICH IS

ED AND A CENTER 

ARE WRITTEN TO

E CHECKED FOR 

HEN THE DIAMETER

INSIDE OR OUTEST ARE WRITTEN

EAS HAVING THE

NG INPUT FILES ARE REQUIRED: 

PUT AREA CODE AND MAP SCALE.

OF STATE CODES AND TRUE STATE 

TNM" 

RNM"

AREAS/ =ARfcANO"
APPENDIX C 153

c 

c 

c

c

c

c

c

c

c

c

FI

FI

F I

FI

F I

US

c

c UPDATED

c conv er t

c

c

c PROGRAM

c CENTERS

c IT ALSO

c

TH 

LE

LE

LE

LE

LE

JO

E.

AS

ed

TO

AR

E 

33

3A

15

AO

6

TE

0

to

C

E

SUMS

F 0 L L 0 W I 

= "ARE

.\IG OUTPUT FILE 

ANM" (SUMMED A

= "CNTRNM"

= "DOU

= "ME A

= MESSA

: vJHEN

F DtC.

mu I t i c

ALCULAT

INSIDE

AREAS

dT it

Snm"

GE

F

27

s

E

TH

Mil

S

IN

,

(C

s ARE REQUIRED:

REAS)

ENTER POIN

(DOUb

(A

TO

ISH

197

LL

TE

ED

6

May 7 /

AR

E

TH

EAS

OUT

TH

TFUL

AREA

RMINA

TS)

CENTER POINTS)

s e

L

/ CHANGE

H. J

1977

AND Ct

LI

E

OHM

by

MTE

f J E S AND

SAME IF.

Y SEPARATE IF/ ISF)

"ME A Snm" TO "ME A SNM" FOR FUTURE

SON

H J ohnson .

RS FOR OUTLINES/ DETERMINE WHEN

WHEN PROPERLY CENTERED.

common true/Sk/ia 

character f i I e * A / state*2/ outfile*6/ m o d e * A

write(o/880) 

<J 8 J formatC' THIS PRO 

" PRODUCE JEW FILES a 

"QTHERE WILL bE ERROR 

" PREVIOUS RUNS."/ 

" IF a r e a N M / m e a s N il 

" DELETE THESE FILES 

c

wr i t e ( 0/900) 

900 f o r ,-n d t ( " 0 E iJ T E R 

r ead(b/91J) state 

91 J f o r m a t ( a 2 )

decode(state/913) 

913 format(i2) 

write(6/91 A) 

91 A forrnat(" YOUR 

read(5 ,916) sk 

91 o for.iiat(f8.U> 

outfile = "areano" 

mooe = "si"

call ftnumber(37/ou 

fi Le = "coor" 

er>code(outtile/92U) s 

92U format("coor"/a2)

call io ("attach"/"

cal L io("open","fi

en code (outfiIe /922) s

92^ format("stat"/d^>

call ftnumoer(31/ou 

mode = "so" 

encode(outfi Ie/92A) s 

92A f ormat("area"/-a2)

call ftnumber(33/ou

GHAM USES THE FILES coorNM AND statNM TO"/

reaNM/ cntrNM^ measNM AND douDt."/

S IF THESE FILES ALREADY EXIST FROM "/

ALREADY EXIST/ HIT BREAK. "/ 

AND RUN MASTER AGAIN.")

IN THE 2-DIGIT CODE FOR THE STATE dEING STUDIED")

MAP HAS SCALE 1 TO WHAT - Fd.J -?")

tfi le/mode) 

tate

fiIe32"/"vfile."/outfiIe/"-append","-ssf")

Ie32","si")

tate

tfi le/mode)

tate

tfi le/mode)
154 GEOINDEX

mode =

encode

927 fo

cal I

out f i I

mode =

cal I

do 7 j

read(3

7 con t

93U fo

true =

c

rewind 

c

cal I

cal I

cal

cal

cal

c a I

c

c ix i 

c

encode 

952 fo 

c a I 

c

stop 

end

"sio "

(outfile/927) state 

rmat("n»eas"/a2)

ftnumoer(40/outfile/mode) 

e = "doubt"

"so "

ftnumber(15*outfi le/moae) 

j=1,ia 

?,93J)i t 

i nue 

rma t(i 6)

f loat(it) 

all arcntr master

40 

all ad j u st_ma st e r

closer(37)

cIose r(32 ) 

I close r(31 ) 

I closer(33) 

I closer(40) 

I closer (15)

SORT THE MEASNM FILE

(outfile,952) state

rmat("meas%a2)

I sort_se9(outfile,"-fl","1","1U")

SUBROUTINE NAME: ARCNTR_MASTER

Author: Harold Johnson

Purpose of the program: arcntr_master calculates the 

areas, corrected, of the outlines whose coordinates are 

contained in coorNM

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call arcntr_master

Arguments: None

Subroutines called: weighLmaster

Common data referenced: true, sk, ia

Input files:

statNM used on unit 31 (file31) 

coorNM used on unit 32 (file32)

Output files: measNM used on unit 40 (file40)

Arrays used: xx(6), yy(6)

Called by: master

Error checking and reporting: True State area is 

reported to the user, along with the area calculated for 

each part of the possibly multiconnected State boundary. An estimate is given for each of these closed

segments. The ratio of calculated to true State area is 

also given to the user. Where this differs markedly 

from 1, an error may have occurred. 

Constants: None

Program logic:

1. The first file processed is areaNM, the coordinate file 

for the State boundary. A header card is read, 

noting the total number of data points, isfno. The 

successive data cards are read, and a calculation is 

made. Area is incremented by the amount

((o?0 - #1X2/0 + 2/i))/2

for each segment in the coordinate file running 

from (o?0, i/0) to (xn, yn).

2. While the State coordinates are being processed, all 

areas are summed and used to give a factor, the 

ratio of the true State area to the State area 

calculated for this map projection; this ratio will be 

used in all successive calculations as a factor to 

modify those calculations.

3. The second file, coorNM, is now processed as in 1, 

and the calculated centers and areas are written to 

file measNM.
APPENDIX C 155

c ******* SUBROUTINE ARCNTR_MASTER *******

subroutine arentr_master

c ********** WEIGHTED AVERAGE CENTER AND AREA PROGRAM *********** 

c SUBROUTINE OF THE MAIN PROGRAM "MASTER", 

c UPDATED AS OF DEC. 27,1976 H. JOHNSON 

c converted to Multics May If 1977 D y H Johnson 

c

common true/sk/ia

dimension xx(6)/yy(6) 

c

c EQUATE 30 TO THE SOURCE FILE TAREA/ CONTAINING THE TRUE AREA IN 

c SQUARE MILES

wr i te(6/9799)true

9799 formatC' true area = M /f10.3) 

c EQUATE 31 TO THE STATE BOUNDARY FILE/ STAT-- 

c EQUATE 33 TO THE COORDINATE FILE/ COOR-- 

c EQUATE 40 TO THE TEMPORARY AREA FILE ARTEMP 

c EQUATE 34 TO THE NEW CENTER FILE/ CNTR— 

c

factor = 1.0 

i tem=25

sea Le = 645.16

901 formatd 2f 6.3) 

900 format(3i5) 

c

c FIRST/ COMPUTE THE STATE MAP AREA IN SQUARE KILOMETRES, 

c

in = 31

i oa rea = 6

i oc nt r = 6

n run=1

totdr=0.0

100 read(in/900/end=99) if/ifno/isf/isfno/not/nor/nif/ispan 

c

c WHEN ISFNO IS LESS THAN 4 WE DON'T HAVE A REGION AT ALL 

c

if(isfno.gt.3)go to 102

redd(in/901/end=99)(xx(i)/yy(i)/i=1/6> 

c

c IN THE CASE OF A SINGLE POINT/ CALL THAT POINT CNTR. 

c

i xc = xx(2)*1000. +.5

iyc=yy(2)*1000. +.5

i sfno=2

go to 100

102 continue 

c

c CALCULATE NCARDS/ THE NUMBER OF DATA CARDS ON THIS MAP 

c

nc a rds= i sf no/6

if(6*ncards .It. isfno) ncards=ncards+1 

c 

c

area=0.

xc = 0.
156 GEOINDEX

yc = 0.

dt = 0. 

c

c XC IS GOING TO BE THE X-COORDINATE OF THE CENTER 

c YC IS GOING TO 3E THE Y/COOROINATE OF THE CENTER 

c OT IS THE ACCUMULATED NORMED DISTANCE dETWEEN POINTS 

c

C READ IN THE FIRST DATA CARD 

C

read(in/901/end=99)(xx(i),yy(i)/i=1,6)

xstart=xx(2)

ys t ar t = yy(2)

ie = 6

i f (ncards .eq. 1) ie=isfno

do 20U j =3* i e

J1=j-1

area = area + (xx(j)-xx(j1))*(yy(j)+yy(j1))*0. 5

cat I weiyht_master(xx(j1)*yy (j1)*x x (j)/yy(j)*xc/yc*dt) 

20 J con t i nue

ifCncards .eq. 1) go to 500

xlast=xx(6)

y I a st=yy(6 ) 

c 

c

ifCncards .eq. 2) go to 400 

c

c READ IN THE MIDDLE CARDS, BETWEEN THE FIRST AND LAST, 

c

kI = nca rds-1

do 300 k=2,kl

read(in,901)(xx(i)/yy(i),i=1,6)

area=area+(xx(1)-xlast)*(yy(1)+ylast)*0.5

cat I weight_master(xlast*ylast*xx(1> *yy (1)*xc*yc*dt) 

do 301 j=2,6

j1=j-1

area = area + (xx(j)-xx(j1))*(yy(j)+yy(j1))*0.5

cat I weight_master(xx(j1)*yy(j1)*xx(j)/yy(j)^xc^yc^dt) 

301 con t i nue

xlast=xx(6)

ylast=yy(6) 

300 con t i nue 

AOO continue 

c

c NOW READ IN THE LAST CARD 

c

read(in,901)(xx(i),yy(i),i=1,6)

ie=isfno-6*(ncards-1 )

i f(i e .eq. 0 ) i e = 6

area=area+(xx(1)-xlast)*(yy(1)+ylast>*0.5

call weight_master(xlast*ylast*xx(1)*yy(1)*xc*yc*dt>

i f ( i e .eq. 1) go to 500

do A01 j=2,ie

J1=j-1

area = area + (xx(j)-xx(j1))*(yy(j)+yy(j1))*0.5

cat I weight_master(xx(j1)*yy(j1)*xx(j)*yy(j)*xc*yc*dt> 

401 continue
APPENDIX C 157

500

c

C WHEN

C

501

90:5

503

905

906

continue 

THE REGION IS NOT CLOSED/ WE MUST ADD THE LAST DATA POINT

test=(xx(ie)-xstart)**2 + ( yy(ie) -ys tart)**2

i f(test . It..01) go to 501

cat I weigh t_master(xx(ie)/yy(ie)/xstart/ystart/xc/yc/dt)

area=area+(xstart-xx(ie))*(ystart+yy(ie))*0.5

continue

if(nrun.gt.1)go to 503

f i s fno= i sf no-1

error=dt*.G01+.UOOOJ1*(fisfno>

error=error*scdle*((sk/1000000.)**2>

write(6/903)if/isf/error

formatC" THE AREA CALCULATION FOR IF =",i5/" ISF =",i5, 

" HAS ERROR BOUNDED 3Y",f10.3)

continue 

area=dds(drea*scale*fdctor*((sk/10UOOGO.)**2))

x c = x c /dt

yc=yc/dt 

i sf no=2

fo rmat(3 i 5 )

i x c = xc*1000.

i yc = yc*1000.

fo rmat(12x *2 i 6)

wr i t e ( ioared*9U7) i f/i sf/area

if(if .eq. 995)go to 550 

totar=totar * area

907 format (2i 5/f 6.1 )

550 i f ( i span . eq 0)go to 100

i span = - i span

i f 1 = i f -»• 1 

i one = 1

do 600 j=if1*ispan 

write(iodrea*9G7)j*ione*area 

600 con t i nue 

c ON THE STATE AREA RUN/ WE WANT 

c WHICH IS THE RATIO OF THE TRUE 

c

go to 100

99 ifCnrun .gt. 1)return 

c CHANGE TRUE TO SQUARE KILOMETRES

t rue = t rue*2 . 59 

wr i te(6/9898) true 

9898 format (f10.3)

factor=true/totar 

c NOW SET INPUTS TO READ THE COORDINATE

wri te(6/9899)f actor

formatC" FACTOR =",f10.3)

TO COMPUTE FACTOR/ 

TO CALCULATED AREAS.

AND COMPUTE RATIO.

FILES

9899 

c

*******

nrun=2 

totar=0.0

in=32

i oa rea = 4G

go to 100

end 

END ARCNTR.flASTER *******
158 GEOINDEX

SUBROUTINE NAME: WEIGHT_JVIASTER

Author: Harold Johnson

Purpose of the program: weight_master is used to 

modify the previously calculated center point by 

means of a weighted average of the midpoint of a new 

edge of the outline.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call weight__master (xl,yl,x2,y2,xc,- 

yc,td)

Arguments: 

x1, y1—Coordinates of one end of the new segment of

the outline

x2, y2—Coordinates of the other end 

xc, yc—Coordinates of the center point 

td—Sum of the squares of the lengths of the outline 

segments

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: arcntr_master

Error checking and reporting: None

Constants: None

Program logic:

1. The square of the length of the segment is calculated, 

z.

2. The average of the x coordinates of the segment is 

multiplied by z and added to xc.

3. The average of the y coordinates of the segment is 

multiplied by z and added to yc.

4. z is added to td. (In the calling program, after all 

calculations on an outline are completed, xc and yc 

are divided by td.)

c ******* SUBROUTINE WEIGHT_MASTER *******

subroutine weight_master(x1,y1,x2,y2,xc,yc/td) 

c SUBROUTINE USED IN MAIN PROGRAM "MASTER" 

c UPDATED AS OF DEC. 27, 1976 H. JOHNSON 

c

c converted to multics May 6/ 1977 H. Jonnson 

c

z=abs(x2-x1) + abs(y2-y1)

xc=xc + 0.5*(x2+x1)*z

yc = yc + G.5*(y2+y1)*z

td = td + z

return 

end 

c ******* END WEIGHT_MASTER *******

SUBROUTINE NAME: ADJUST_JVIASTER

Author: Harold Johnson

Purpose of the program: adjust_master is used to sum

the areas of all outlines having the same reference

number, if. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call adjust_master 

Arguments: None 

Subroutines called: None 

Common data referenced: None 

Input files:

measNM used on unit 40 (file40) 

List of variables: if, isf, area 

Formats: See master.

Layout description: See master. 

Output files: 

areaNM used on unit 33 (file33)

List of variables: if1, isfl, area 7

Formats: See master.

File located by: adjust—master

Layout description: See master. 

Arrays used: None 

Called by: master

Error checking and reporting: None 

Constants: inarea = 40; ioarea = 33 

Program logic:

1. The area file measNM is rewound.

2. Areas are successively read, and if two are from the 

same if, their areas are summed.

3. Each time a new if is found, the old area is written to 

areaNM.
APPENDIX C 159

SUBROUTINE AUJUST_MASTER ******* 

subroutine adjust_master

C SUBROUTINE USED IN MAIN PROGRAM "FASTER".

C UPDATED AS OF DEC. 27, 1976 H. JjHNSON

c

c converted to multics May 6* 1977 H. Jonnson

C ***ADJUST AREA FILES

C

C I,\l CASE OF SEVERAL OUTLINES WITH THE SAME IF* THIS PROGRAM

C SUMS UP THESE AREAS

C

i na red = 4U 

i oa rea = 33

c EQUATE 40 TO THE AREA SOURCE FILE ARTEMP 

c EQUATE 33 TO THE OUTPUT AREA FILE AREA-- 

c

90J 

2

format (2i5, f 8.1 )

read(inarea*900*end=99)if1*isf1*area1

if(if1 .eq. if) go to 3

write(ioarea*9UU) if/isf*area

i f =i f 1

area=area1

go to 2

a r ea = a r ea + a rea 1 

go to 2

c 

99 w r i t e ( i o«jrea *90U) i f t i sf / a rea 

return 

end 

c ******* END ADJUST_ rt ASTER *******

SUBROUTINE NAME: WORK.JMASTER

Author: Harold Johnson

Purpose of the program: work_master calls two functions that are used in computing the distance from the 

center point to the boundary and in counting how 

many times the horizontal ray to the right of the 

center crosses the boundary.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call work—master (xl,yl,x2,y2,xcen,- 

nx,dst)

Arguments: 

x7, y1-Coordinates of one end of a segment of the

boundary 

x2, y2- Coordinates of the other end of the segment

xce/7, yce/7-Coordinates of the center

nx-The number of times the boundary crosses the 

horizontal ray from the center point

c/sf-The minimum distance from the center point to

the boundary

Subroutines called: dist_master, ncross_master 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: None 

Called by: cntest_master 

Error checking and reporting: None 

Constants: None 

Program logic:

1. The two functions dist and ncross are called to 

possibly modify the values of nx and c/sf.
160 GEOINDEX

c ******* SUBROUTINE w/ORK_ MASTER *******

subroutine work_master (x1/y1/x2/y 2 /xcen/ycen / nx/dst) 

c

C SUBROUTINE USED IN .MAIN PROGRAM "MASTER" 

c UPDATED AS OF DEC. 27, 1976 H. JOHNSON 

c

c converted to multics May 6/ 1977 by H Johnson, 

c

dst=dist_mdster(x1/y1*x2/y<?/xcen/ycen/dst)

nx=ncross_master(x1/y1/x2/y2/xcen/ycen/nx)

return 

end 

c ******* E,MD WGRK_MASTER *******

FUNCTION NAME: DIST_JVIASTER

Author: Harold Johnson

Purpose of the program: dist_master computes the 

distance from the center to a segment whose endpoints are given. This distance is compared with a 

previously calculated minimum distance, and the 

minimum of the two is returned as the value of dist.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: dst = dist_jnaster (xl,yl,x2,y2,xO,yO,- 

dold)

Arguments:

x1, y1- Coordinates of one end of the segment 

x2, y2- Coordinates of the other end of the segment 

xO, yO- Coordinates of the center point 

c/o/c/-Previously calculated minimum distance

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: work__master

Error checking and reporting: None

Constants: None

Program logic:

1. The segment is tested to determine whether its 

length is zero; if it is zero, dst = c/o/c/.

2. The point is found on this one line through x1, y1 and 

x2, y2 that is closest to xO, yO.

3. When this point is outside the line segment, the 

nearest endpoint is used as the nearest point.

4. Distance from the center to the nearest point is computed and compared with c/o/c/. The smaller value 

is returned as the value.

******* SUBROUTIN 

funct ion

subroutine used i 

converted to mult

DOLD IS THE OLD M

BOUNDARY. DST =

HHICH RUNS FROM (

i test= ( ( x

i f(i test

i f(i test

t=(x1-xO

test = ( x2-

t=t/test

x t= t*x2 +

yt=t*y2+

d i s t.ma s

i f ( t .It

i f ( t .cjt

E DIST.MASTER *******

di st_master (x1 / y1 /x2/y2/x(J/yU/dold) 

n main program master, 

ics May 6 f 1977 by H Johnson.

INIMAL DISTANCE FROM (XU/YU) TO THE

DOLD OR THE DISTANCE FROM (XG/YU) TO THE SEGMENT

X1/Y1) TO (X2/Y2) - WHICHEVER IS SMALLER.

2-x1)**2+(y2-y1)**2>*1GOO.

.eg. 0) dist_master=doId

,eq. 0) go to 73 

)*(x1-x2) -Ky1-yO)*(y1-y2) 

x1)**2+(y2-y1)**2

(1.-t)*x1

(1.-t)*y1

ter = sqrt( (xt-x(J)**2+(yt-yO)**2)

. 0.)dist_master=sqrt((x1-xO)**2+(y1-yU)**2)

. 1.)dist.masterssqrt((x2-xO)**2+(y2-yO)**2)
APPENDIX C 161

73

C

ifCdold .It. dist_master) dist.master=dold 

con t i nue

return 

end 

C ******* END DIST_MASTER *******

FUNCTION NAME: NCROSS_JMASTER

Author: Harold Johnson

Purpose of the program: ncross_master determines 

whether or not the right horizontal ray from the 

center point crosses the line segment that has the 

given end points. If it does cross, nold is increased by 

1.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: nx = ncross_master (xl,yl,x2,y2,xO,- 

yO,nold)

Arguments:

x1, y1- Coordinates of one end of the segment 

y2, y2- Coordinates of the other end of the segment 

xO, yO- Coordinates of the center point 

nold- The number of crossings before this program

/?x-The number of crossings after calling this program (increases nold by 1 if a crossing occurs in this 

routine)

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: work_master

Error checking and reporting: None

Constants: None

Program logic:

1. If the segment is nearly horizontal, nx - nold.

2. The horizontal coordinate where the horizontal 

crosses the line through the points of the segment 

is calculated.

3. When this coordinate is less than xO, nx = nold.

4. Otherwise, nx = nold + 1.

******* NCRO$S_r1ASTtR *******

function ncross_master(x1/y1/x2/y2/xO/yU/nold) 

function used in main program master 

conv/erted to multics May 6* 1977 M Johnson.

N C R 0 S S 

SROSSES

*******

i o = c»

INCREASES NOLD BY 1 IF THE SEGMENT FROM (X1,Y1) 

THE RIGHT HORIZONTAL RAY FROM (XO,YO) .

ncross_master=nold

ifCabs(y1-y2) .It. .001) go to 7

t=(yO-y1)/Cy2-y1)

ifCt.lt.O. .or. t.gt.1. ) go to 7 

x = t *x2 + (1 .-t)*x1

i f(x .It. xO) go to 7

ncross_master=ncross_master+1

continue

return 

end 

END NCROSS.MASTER

TO (X2,Y2)

*******

SUBROUTINE NAME: CNTEST_JMASTER

Author: Harold Johnson

Purpose of the program: cntest_master tests whether 

the center points are actually within the map outlines. 

It measures their distance to the boundary of the 

outline and computes the diameter of the outline.

When the point lies outside the outline or is too close 

to the boundary of a region whose diameter is not 

small, error messages to this effect are sent to the 

operator, and the center is written to a file named 

doubt.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)
162 GEOINDEX

Operating system: Multics

Calling sequence: call cntest__master

Arguments: None

Subroutines called: work_master, dm_master

Common data referenced: None

Input files: None

Output files: None

Arrays used: xx(6), yy(6)

Called by: master

Error checking and reporting: When the boundary 

crosses the right horizontal ray from the center an 

even number of times, a message that the center does 

not lie inside the outline is sent to the operator. When 

the center is too close to the edge of a region, a 

message about this is sent to the operator. In each 

case, the center coordinates are placed in doubt.

Constants: None 

Program logic:

1. Center header card and coordinates are read. The 

center is shifted by 0.0001 in., so that it cannot lie 

exactly on a line.

2. Coordinate file is searched for the corresponding 

header card.

3. Coordinates are read and work_master and 

dm__master are called to compute successive 

minimal distances, maximal distance from the initial coordinate point of the outline (used as an 

approximation to the diameter), and number of 

crossings that the outline makes over the righthand ray from the center.

4. Indicated problems are reported to the user and written to doubt.

subroutine cnte st _mas ter

c SUBROUTINE USED IN PROGR AM~"M A ST E R" 

c UPDATED AS OF DEC. 11, 1976 H. JOHNSON 

c

c converted to muttics May 6* 1977 by H Johnson 

C$$$$S$$S$$$$$$$$CENTER TEST$$$$$$ $$$$$$$$$$$$$$$$$$$$$ 

c

c THIS PROGRAM TESTS WHETHER POINTS CALLED "CENTER POINTS" 

c ARE ACTUALLY INSIDE THEIR MAP OUTLINES. 

c

c IT ALSO COMPUTES THEIR DISTANCE TO THEIR MAP BOUNDARIES. 

c

dimension xx(6)*yy(6) 

c

io1=15

i 0=6

in1=34

wri te(6*VOu)

900 formatC" THE FOLLOWING CENTERS ARE IN DOUBT")

c

c EQUATE 52 TO THE FILE OF MAP OUTLINES* COOR —

c EQUATE 15 TO THE FILE DOUBT .

c EQUATE 34 TO THt FILE OF CENTERS* CNTR--

c

rewind 3<!

c IT IS ASSUMED THAT THE CENTER DATA AND MAP OUTLINE DATA 

c ARE IN THE SAME ORDER* AND THAT EACH CENTER BELONGS TO SOME 

c MAP OUTLINE* BUT IT SKIPS OVER MAP OUTLINES WHICH HAVE NO DENTER. 

c

1 read(in1*9Ui!*end=99)ifc*ifnoc*isfc*isfnoc*notc*norc*nifc 

9902 format (1x* 7i i>)

read(in1*9U1 )inut l*jnutt*xcen*ycen 

901 format(2i6*2f6.3) 

c

c ADD .OJ01 TO XCEN AND YCEN TO MAKE THEM DIFFERENT FROM 

C ANY DATA POINT.
APPENDIX C 163

C

xcen=xcen+.0001

ycen=ycen+.0001 

c

c READ THE DATA HEADER CARD 

2 read(in*902*end=99)if*ifno/isf*isfno/not*nor*nif

902 format(7i5)

nc a rds = i sf no/6

if(6*ncards .It. isfno) neards=ncards+1 

c 

c COMPARE NOMBERS. IF DIFFERE NT , SKIP THIS DATA

if((itc.eq.if).and.(isfc.eq.isf).and.(notc.eq.not)) go to 200

do 50 k = 1 » nc ards

read(in,903)(xx(i),yy(i),i=1,6)

903 format(12f6.3> 

50 continue

go to 2

20J continue 

c 

c

c IGNORE CENTER FILES FOR SINGLE POINT PLOTS, 

c

ifCisfno . a t . 2) go to 210

read(in,903)(xx(i),yy(i),i=1,6)

go to 1 

c

C NOW HEAD THE FIRST DATA CARD AMD BEGIN THE CALCOLATI ONS . 

C WE SKIP THE FIRST DATA POINT. IT LOCATES PRINTING FOR 

C THE ID ,JJM8tRS. 

C

210 dst=1UO.

Ji am = 0.0

nx =0

read(in ,903) (xx(i ),yy(i),i=1,6)

ie = 6

ifCisfno .It. 6) ie=isfno

xfi rst = xx(2)

yfirst=yy(2)

do 300 k = 3* i e

call work_master(xx(k-1)*yy(k-1)*xx(k)*yy(k)*xcen*ycen*nx*dst)

diam=dm_master(xx(k-1)*yy(k-1)*xfirst*yfirst*aidm) 

99J3 format(f6.3) 

300 continue

xlast=xx(6)

yldSt=yy(6)

if(ncards .eq. 1) go to 500

ifCncards .eq. 2) go to 400 

c

C NOW READ IN THE DATA CARDS BETWEEN THE FIRST AND LAST. 

C

n1=ncards-1

do 380 I=2*n1

read(in,903)(xx(i ),yy(i),i=1,6)

edit worx^masterCxLast^ylast^xxC^^yyCI)/xcen^ycen/nx^dst)

diam=dm_master(xlast/ylast*xfirst*yfirst/diam)
164 GEOINDEX

350

380

c

C NOW

c

400

xx(k-1),yy(k-1),xx(k),yy(k),xcen,ycen,nx,dst) 

(k-1 ),yy(k-1),xfi rst,yf i rs t,d i am)

401

c

50J

c

C WHE

C

c

c

c

50

c

60

c

c

c

c

c

c

c

c

NOW

1

*/H E

INS

WH

TH

do 350 k=2,6

caLL work_ma s ter(

di am = dm_master(xx

continue

xLast=xx(6)

yLast=yy(6)

con t i nue

READ IN THE LAST CARD

read(in,903) (xx(i 

i e= i s fno-6*(ncard 

caLL work_master( 

diam=dm_master(xL 

i f(i e .eq. 1 ) go 

do 401 k=2,ie 

caLL wor k_ma ster( 

di am=dm_master(xx 

con t i nue

continue 

•M THE REGION IS NOT CLO

test=(xx(ie)-xfirs 

if(test .L t . .01)

CdLL work_master(x 

diam=dm_master(xx

REPORT THE RESULTS 

c ont i nue 

nx=(-1)**nx

N NX = -1 THERE ARE AN ODD NUMBER OF CROSSINGS/ SO THE CENTER IS 

IDE THE REGION

),yy(i),i = 1,6)

s-1 )

xLast,yLast,xx(1),yy(1),xcen,ycen,nx,dst)

ast,yLast,xfirst,yfirst,diam)

to 500

xx(k-1),yy(k-1),xx(k),yy(k),xcen,ycen,nx,dst) 

(k-1 )/yy(k-1)/xfi rst/yfi rst/diam)

SED wt ADD THE LAST POINT TO CLOSE IT.

t)**2+(yy(ie)-yfirst) **2

go to 501

x(ie)/yy(ie)/xfirst/yfirst/xcen/ycen/nx/dst) 

(ie)/yy(ie)/xfirst/yfirst/diam)

EN NX=1 THERE ARE AN EV 

t CENTER IS OUTSIDE THE

EN NUMBER OF CROSSINGS,SO 

REGION

9991

write 

99S1 

i f (nx 

w r i't e 

9933 

70 i f 

write 

9935 

" is

and. (dst .gt. .09)) jo to 1 

) jo to 1

center is in doubt because :")

format(f6.3) 

if((nx .eq. -1) .

i f(diam .It. .3333 

(0,9981) 

format (*'0the fol Lowing

.eq. -1) go to 70 

(6,9983)

formatC* it does not Lie inside the ooundary.'*) 

(dst .gt. .09) go to 80 

(6,9985) di am,ds t 

formatC" the region has 

",f6.3," incnes from th

diameter If ,f6.3," ana the center "/ 

e bounda ry.")
APPENDIX C 165

80 write(io/905)i f/ifno/isf/isfno/not/nor/nif

905 format(1x/7i5)

vj r i te(io/90b)xcen/ycen

906 format(1x/2f6.3)

i oa red = 40 

i yc en = yc en*1000. 

i x c en=x cen*1000. 

i s fno=1

write(io1/902)if/ifno/isf/isfno/not/nor/nif 

write(io1/9u7)ixcen/iycen

907 format(12x,2i6)

go t o 1

99 return 

end

SUBROUTINE NAME: DM_MASTER

Author: Harold Johnson

Purpose of the program: dm_master is used to compute the diameter of an outline. It calculates the 

length on one segment and compares it with the 

previously calculated diameter.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: diam = dm_master (xl,yl,x2,y2,dold)

Arguments:

x1, y7-Coordinates for one endpoint of a segment 

x2, y2- Coordinates for the other endpoint 

do Id- Previously calculated maximum diameter

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: cntest_master

Error checking and reporting: None

Constants: None

Program logic:

1. diam is set to dold.

2. The distance between the endpoints is calculated and 

compared with dold.

3. If this distance is more than dold, diam is set to this 

distance.

******* SUBROUTINE DM.MASTER *******

function dm_mdster(x1/y1/x2/y2/dold) 

function used in main program master, 

converted to multics May 6 / 1977 H. Johnson

dm_mas t er = aold 

test=aos(x1-x2)+abs(y1-y2) 

ifCtest .gt. do Id)dm_master = test 

return 

end

******* END DM RASTER *******

FILE NAME: AREANO

Purpose of the file: areano is a list of true State areas. 

master calculates a State area and then reads areano 

to find the true area. The ratio of these is used as a 

correcting factor in the area calculations for the 

outlines of the State.

Format: The fcth record of areano contains the true 

area, format 16 (integer part), for the State with FIPS 

code number k. If no State has State code k, the 

record contains a zero.

Arguments: One integer occurs on each record, 16, and 

is the integral part of the true State area in square 

miles.

Referenced by: master
166 GEOINDEX 

areano

51609

586412 0

113909

53104

158693 0

104247

5009

2057

67

58560

58876

0

6450

83557

56400

36291

56290

82264

40395

48523

33215

10577

8257

58216

84068

47716

69686

147138

77227

110540

9304

7836

121666

49576

52586

70665

41222

69919

96981

45333

0

1214

31055

77047

42244

267339

84916

9609

40817

0

68192
APPENDIX C 167

24181

56154

97914

3435

PROGRAM NAME: STATE_OPTIMA

Author: Harold Johnson

Purpose of the program: state_optima reads through 

a strdNM file, finds the highest and lowest latitudes, 

leftmost and rightmost longitudes, and prints out this 

information.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: state_optima

Arguments: None

Subroutines called: open si.ec, optima, close.ec

Common data referenced: None

Input files: strdNM used on unit 60 (filedO)

Output files: Information is printed on the terminal.

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. Prompt:

TYPE THE FEDERAL STATE CODE 

NUMBER:

2. The user's response is read into state.

3. The word strd and the value of state are concatenated.

4. Call open_si.ec, which opens and attaches strdNM 

to file60 for stream input.

5. Call subroutine optima.

6. Call close.ec, which detaches and closes filedO.

7. End.

st a t e_opt i ma

Purpose: To read through a strdNM 

and lowest latitudes/ hleft and 

most loingitudes* and print out

Programmer; H Jonnso 

Jate: July 20* 1976

input file: strdNM 

output file: terminal 

external ec(descriptors ) * 

character file*6

dm s

wri te(6*91U) 

910 formatC" Type the 

read(3*920) state

file* find the highest

ri gh tt h i s info rma t i on.

Federal State Code number:")
168 GEOINDEX

920 format(a2)

encode(fi le/930) state 

9.50 format("strd%a2) 

c

cjll ec ("open_si"/"60"/file) 

c 

c

call optima

call ec ("c lose"/"60") 

c 

c 

end

SUBROUTINE NAME: OPTIMA

Author: Harold Johnson

Purpose of the program: optima reads through the radian coordinate files and determines the uppermost, 

lowermost, leftmost, and rightmost coordinates for 

each map boundary.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call optima

Arguments: None

Subroutines called: dms

Common data referenced: None

Input files: strdNM

Output files: Information is printed on the terminal.

Arrays used: x(3), y(3), x1(4), y1(4) 1x1(4), iy1(4), z(4), 

ideg(4), imin(4\ isec(4)

Called by: state__optima

Error checking and reporting: None

Constants: None

Program logic: 

1. The header record of the strdNM file is read.

2. Set ncards equal to isfno divided by 3.

3. Read the first record.

4. Ignore the first point because it is the location of the 

written // numbers.

5. Compare the points to find the rightmost, leftmost, 

topmost, and lowermost points.

6. Put the coordinates into integer format for packed 

writing.

7. Call function dms.

8. The following will be output on the screen:

STATE = nor, OUTLINE = //, SUB = Isf 

DEGREES, MINUTES, SECONDS

NORTH

MAXIMUM idegfl) iminfl) isecfl) 

SOUTH ideg(2) imin(2) isec(2) , WEST idegfS) iminfS) isec(3) 

EAST ideg(4) imin(4) isec(4)

9. This organization is as in the comxNM files: upper 

latitude, lower latitude, left longitude, and right 

longitude.

10. Return control to calling module.

determine the upper/ lower/ left/ and right most 

coordinates for each map boundary.

subroutine optima

c

c purpose: to redd through the radian coordinate files and

c

c

c

c

c input file number 60 is the standrd coordinate file.

c outpue file number 30 is a file of max/ mins.

c

double precision x/y/x1/y1/z

dimension x(3)/ y(3)/ x1U)/ y1(4)/ ix1U)/ iy1(A)

dimension z(4)/ idegCA)/ iminCA)/ isec(A)

c

10 read(60/910/end=10uO) if/ ifno/ isf* isfno/not/nor/nif

91J format(7i5)
APPENDIX C 169

C 

C

ncards = isfno/3

if(3*ncards .It. isfno) ncards = ncards + 1

c

read(60,920)(x(j),y(j),j=1,3) 

920 format(6f12.9) 

c

do 15 j = 1 , A 

x1Cj) = x(2) 

15 y1(j) = y(2)

c we d o n,' t start with the first point/ because it is 

c the Location of the written if numbers. 

JO = 2

17 do 80 j = jU, 3

if(x(j) ,eq. 0. .or. y(j) .eq. U.) go to 90 

c

c x1(1)/ y1(1) is the right-most point, 

i f(x1 ( 1 ) .ge. x(j)) go to 20 

x1(1) = x( j ) 

y1(1) = y(j) 

20 con t i nue 

c

c x 1 ( 2 ) / y1(2) is the left-most point, 

i f(x1(2) .le. x(j)) go to 30 

x1(2) = x(j) 

y1 (2) = y (j ) 

30 con t i nue 

c

c x1(3)/ y1(3) is the top-most point, 

i f(y1(3) .ge. y(j) ) go to 40 

y1(3) = y (j > 

x1(3) = x( j ) 

AO cont i nue 

c

c x1(A)/ y1(A) is the Lowest point, 

i f(y1 (A) .Le. y (3)) go to 80 

y1(A) = y (j ) 

x1(A) = x(j) 

80 cont i nue 

c

ncards = ncards - 1 

i f(ncards . 11. 1) go to 90 

re ad(60/920)(x(j),y(j),j=1,3> 

JO = 1 

go to 17 

c

90 isfno = 2 

c

c put the coordinates into integer format for packed 

c writing, 

c 

do 200 j = 1/A

ix1(j) = idintCxKj)*(10.0**9) + .5)
170 GEOINDEX

200 iy1(j) = idint (y1(j)*(10.0**9) + .5)

c

z(1) = y1(3)

z(2) = y1 (4)

z(3) = x1(1)

z(4) = x1(2)

do 106 k = 1 / A

z(k) = z(k)*180./3.1A1592653

call dms(z(k)/ijeg(k)/imin(k)/isec(k)) 

106 continue

write(6/9*»0) nor/ it/ isf 

9AO formatC' state = "/i5/"/ outline = "/

wr i te(6/950) 

950 format(1Ax/"degrees minutes seconds")

write(6/960) ideg(1)/itnin(1)/isec(1) 

960 formatC' north maximum M /i3/i8/i8)

write(6/970) ideg(2)/itnin(2)/isec(2) 

970 formatC' south M /i3/i8/i8)

write(6/980) ideg(3)/imin(3)/isec(3> 

980 formatC' west M /i3/i8/i8)

write(6/990) ideg(A)/imin(4)/isec(A) 

990 formatC1 east M /i3/i8/i8>

i5 sub =

c this organization is as in the comx

c upper latitude/ lower latitude/ Ift

c longitude.

c

930 format(Ad20.9)

c

yo to 10

c

1000 c ont i nue

return

files:

long i tude/ right

EXEC-COM NAME: OPEN_SI.EC

Author: Harold Johnson

Purpose of the program: open_si.ec attaches and opens

a file for stream input. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ec ("open_si","60",file) 

Arguments:

60—Unit number

file—Name strdNM

Subroutines catted: io_attach, io_open

Common data referenced: None

Input files: strdNM

Output files: None

Arrays used: None

Called by: state_optima

Error checking and reporting: None

Constants: None

Program logic:

1. Call io to attach file60 via vfile_ to strdNM.

2. Call io to open fileBO for stream input.

3. Return control to the calling module.

A c omman J_ I i ne off

io attach file&»1 vfile_

i o open f i I e£ 1 si

-append -ssf
APPENDIX C 171

EXEC_COM NAME: CLOSE.EC

Author: Harold Johnson

Purpose of the program: close.ec detaches and closes

the file.

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ec ("close","60") 

Arguments: 60—Unit number 

Subroutines called: io_detach, io_close

Common data referenced: None

Input files: strdNM

Output files: None

Arrays used: None

Called by: state_optima

Error checking and reporting: None

Constants: None

Program logic:

1. Call io to detach fileBO.

2. Call io to close fileBO.

3. Return control to calling module.

Acorn mandoline 

io close f i I e 

io Je t dc h f i I

off

PROGRAM NAME: ADDRAD

Author: Harold Johnson

Purpose of the program: addrad inserts the correct

values for the areas, the latitude and longitude coordinates for the centers and for the north, south, east,

and west boundaries of the outlines for each map

reference contained in strgNM files. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call addrad 

Arguments: None 

Subroutines called: ibound_addrad, srch20_addrad,

srch30_addrad, srch40_addrad, closer, ftnumber,

center__addrad, optima_addrad 

Common data referenced: None 

Input files:

strgNM used on unit 10 (fileW) 

Created by: concat

measNM used on unit 20 (file20) 

Created by: master

cordNM used on unit 60 (file60) 

Output files:

comxNM used on unit 30 (file3G) 

Created by: optima_addrad

ctrdNM used on unit 40 (file40) 

Created by: center_addrad

redyNM used on unit 50 (fileSO)

Created by: addrad 

Arrays used: iarea(8), iaunit(7), inlat(12), islat(12),

iwlong(12), ielong(12), iclat(12), iclong(12),

Called by: None

Error checking and reporting: In subroutines

Constants: None

Program logic:

1. The user is prompted for the 2-digit FIPS code of the 

State being processed.

2. Using this assoc will attach strgNM to Fortran 

fileW, measNM to file20, comxNM to file30, 

ctrdNM to file40, cordNM to file60, and redyNM 

to fileSO. comxNM is the north, south, east, and 

west latitude and longitude file; ctrdNM is the 

latitude and longitude file of center points; redyNM 

is the output file ready for final input to the 

GRASP system.

3. Center_addrad is called to compute a center point 

for each outline in cordNM and store these in 

ctrdNM.

4. Optima_addrad is called to determine the extreme 

north and south latitudes and east and west 

longitudes for each outline in cordNM.

5. A record from strgNM is read.

6. Subroutine ibound_addrad is called to determine 

the if and isf for the map outline of this reference 

data.

7. srch20_addrad is called to search file20 for the area 

of the corresponding outline. This is inserted in the 

record from strgNM.

8. srch30_addrad and srch40_addrad are called to 

locate data in comxNM and ctrdNM belonging to 

this outline. This is inserted in the same record.

9. The record is written to redyNM. Control returns to 

step 2.
172 GEOINDEX

C ******* ADDRAD *******

character f i I e * 4 , mode***/ state*2, outfile*6 

C PROGRAM ADDRAD

C UPDATED AS OF DEC. 17, 1976 H. JOHNSON

C THIS PROGRAM OPERATES ON THE FILES STRGNM CONTAINING THE OUTPUT 

C VECTORS OF THE CONCAT PROGRAM, BEFORE THEY ARE USED AS INPUT TO 

C THE CREATE PROGRAM. 

C

C $$$$$$iit$J$$$i$S$$i$$i$i$$$:l>$$$$j;$$$$$i$ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 

c

C

C WHAT THIS PROGRAM DOES IS TO INSERT CORRECT AREAS, LATITUDE AND

C LONGITUDE COORDINATES FOR THE CENTERS ,N,S,LAT ITUDES AND E,W,

c LONGITUDES OF THE BOUNDARIES.

C (IN REFNM ONLY ONE AREA,CENTER AND 30UNDARY IS GIVEN PER "IF")

C

C THE FOLLOWING FILES ARE REQUIRED FOR INPUT:

C FILE 10 = INPUT STRGNM WHICH WAS PRODUCED BY CONCAT.

c FILE 20 = AREA FILE PRODUCED BY "MASTER" PROGRAM, CALLED MEASNM.

C FILt 30 = N,S LATITUDE ;E,W LONGITUDE FILE CALLED COMXNM.

C FILE 40 = CENTER LONGITUDE-LONGITUDE FILE CTRDNM.

c THE OUTPUT FILE PRODUCED 8Y THIS PROGRAM FOR CREATE:

C FILE 50 = THE OUTPUT FILE REDYNM.

C

C

c THE FOLLOWING VALUES ARE THE STARTING POSITIONS FOR THE VALUES OF

c IdOU.MD, AREA, AUNIT, N LA T , SL A T , wLONG , EL ONG, C L AT , CLONG AS

c DETERMINED BY THE FILE CALLED "MATRIX".

c

c $$$$i$$ss$s$$$ii$$$$$$$s$$$i$$$$$$$$$$$$$$$$$$$*$$$$$$$$$$$$i$$$$$$$$$ 

dimension iarea(8),iaunit(7),inlat(12),islat(12),iwlong(12) 

dimension ielong(12)

dimension iclat(12),iclong(12),ifile(1211>

data nbound/1160/,narea/869/,naunit/S77/,nnlat/S#4/,nslat/d96/ 

data nwlong/90S/,nelong/920/,nclat/932/,nclong/944/,nrec/1211/

c

c NOTICE THE DIMENSION OF IFILE IS THE SAME AS NREC, WHICH MUST BE

c CHANGED IF NREC IS CHANGED.

c

data iaunit/"s","q","."," ","k","m","."/

c

write(6,910)

910 formatC' ENTER THE 2-DIGIT CODE FOR THE STATE BEING PROCESSED")

read ( 5,920) state

920 format(a2)

encodeCoutfile,925)state

925 f ormatC'st rg",a2) 

mode = "si "

call ftnumber(1J,outfile,mode) 

encodeCoutfile,926)state

926 format("cord",a2)

call ftnumoer(oO,outfiIe,mode) 

encode(outfile,927)state

927 format(".neds",a2)

cat I ftnumber(2J,outfile,mode)
APPENDIX C 173

encode(outfi Ie /930) state 

930 f o r .n a t ( " c o m x " / a 2) 

mode = "sio "

call ec ("open_sio"/"30"/outfile) 

encode(outfile/932)state 

932 format("ctrd"/a2)

cill ftnumber(40/outfile/mode) 

encode(outfile/93/)state 

937 formatC1 redy"/a2) 

mode = "so "

call ftnumber(50/outfile/mode) 

c

call center_addrad

c this routine computes a center point in radians for each 

c ou tIi ne. 

c

call op t i ma_add r<j a

c this routine computes the extreme north and south latitude for 

c each outline/ and the extreme east and west longitude, 

c

10 read(1U/940/end=100G)(ifile(j)/j=1/nrec) 

940 format(30a1) 

c 

c vJE H.*WE READ ONE RECORD OF LENGTH NREC FROM STRGNM.

call ioound_addrad(ifi le/nbound/if/isf/nrec)

c THIS ROUTINE "IbOUND" READS IFILE FROM NBOUND TO NbOUND+6 TO 

c DETERMINE THE "IF" AND "ISF" OF THE MAP OUTLINE WHICH IS THE OUTLI 

c E

c MAP FOR THIS REFERENCE/ IF ONE EXISTS. IF = 0 WHEN NONE EXISTS, 

c

if(if ,gt. u) go to 20

go to 100 

c 

20 call srch20_addrad(if/isf/iarea/ifIag2Q)

if(iflag20 ,eq. 1) go to 50

C THIS ROUTlNt SEARCHES FILE 20 TO LOCATE THE AREA OF THE OUTLINE 

c I

c HAVING THIS IF AND ISF. IAREA IS THE LEFT-JUSTIFIED/ DECODED AREA 

C FORMAT 6A1 . 

C

do 3U k=1/8

30 ifi I e(narea + k-1) = iarea(k) 

c 

C NEXT/ INSERT "S^.KM." IN IFiLE.

do 40 k=1/7

40 ifi I e(naunit + k-1) = iaunit(K) 

c 

50 call srch30_addrad(if/isf/inlat/islat/iwlong/ielong/iflag30)

if(iflaj30 ,eq. 1) go to 70

c THIS SEARCHES THROUGH FILE 30 FOR THE LAT I TUDE-LONG I TU0ES/ DECODES 

C THEM INTO A1 FORMAT, 

c

do 60 k=1 /12

ifi le(nnlat+k-1) = inlat(k)

ifi le(nslat+k-1) = islat(k)
174 GEOINDEX

60

c

70

c 

c 

c

80

c

100

ifi le(nwlong+k-1)=iwlong(K) 

i f i le(nelony+k-1 ) = i e I ony ( k )

call srch4U_addrad(if*isf*iclat*iclong*iflag40)

i f ( i f I a 3 4 0 .eg. 1) go to 100

THIS ROUTINE SEARCHES FILE 40 FOR THE LATITUDE-LONGITUDE 

CENTER.

6 U K = 1 * 1

OF THE

O 6 U K = *

ifi le(nclat+k-1)=icldt(k) 

i fi le(nc Ion g + k-1 ) = ic lony(k)

write(50,94u)(ifile(j),j=1/nrec) 

jo to 10

1000 call closer(lu) 

call c lose r ( 20) 

call c loser (3u) 

call c loser (40) 

end f i I e 50 

c this is supposed to put 

c otherwise be lost.

c

cal I

ca I I

c

S t Op

c lose r ( 50)

c lose r (60)

a final blank record which might

end

SUBROUTINE NAME: OPTIMA_J^DDRAD

Author: Harold Johnson

Purpose of the program: optima_addrad reads through 

the radian coordinate files and determines the uppermost, lowermost, leftmost, and rightmost coordinates 

for each map boundary.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call optima_addrad

Arguments: None

Subroutines called: None

Common data referenced: None

Input files: cordNMused on unit 60 (filedO)

Output files: file30- a file of maximums and minimums

Arrays used: x(3), y(3), x1(4), y1(4) 1x1(4), iy1(4)

Called by: addrad

Error checking and reporting: None

Constants: None

Program logic:

1. The header record of the coordinate file is read.

2. Set ncards equal to isfno divided by 3.

3. Read the first record.

4. Ignore the first point, because it is the location of the 

written if numbers.

5. Compare the points to find the rightmost, leftmost, 

uppermost, and lowermost points.

6. Put the coordinates into integer format for packed 

writing.

7. Write the upper latitude, lower latitude, left 

longitude, and right longitude to file30.

8. Continue steps 1 through 7 until the end of file is 

reached.

subroutine optima_addrao

c

c purpose: to read through the radian coordinate files and

determine the upper* lower* left* and right most 

coordinates for each map boundary.
APPENDIX C 175

c input file number 60 is the standrd coordinate file.

c outpue file number 30 is a file of max/ mins.

c

double precision x*y*x1*y1

dimension x(3)* y(3)* x1(4)* y1(4)s ix1(4)s iy1(4)

rewind 60

c

rewi nd 30

10 read(60*910*end=1000) if* ifno* isf* isfno*not*nor*nif

910 format(7i5)

c

c

ncards = i sfno/3

if(3*ncards .It. isfno) ncards = ncards + 1

c

read(60,92Q)(x(j),y(j),j=1,3) 

920 format(6f12.9) 

c

do 15 j = 1, 4 

x1 (j) = x(2) 

15 yK j) = y(2)

c we don't start with the first point* because it is 

c the location of the written if numbers. 

JO = 2

17 do 80 j = jO* 3

if(x(j) .eq. 0. .or. y(j> .eq. 0.) go to 90 

c

c x1(1)* y1(1) is the right-most point, 

i f (x1 (1 ) .ge. x( j)) go to 20 

x1(1) = x(j) 

yK1) = y(j) 

20 cont i nue 

c

c x1(2)* y1(2) is the left-most point, 

if (x1(2) .le. x( j)) go to 30 

x1 (2) = x(j) 

y1 (2) = y(j) 

30 continue 

c

c x1(3)* y1(3) is the top-most point, 

if (y1(3) .ge. y(j)) go to 40 

y1(3) = y(j) 

x1(3) = x(j) 

40 cont i nue 

c

c x1(4)* y1(4) is the lowest point, 

if (y1(4) .le. y(j)) go to 80 

y1 (4) = y( j ) 

x1 (4) = x(j ) 

80 cont i nue 

c

ncards = ncards - 1 

ifCncards .It. 1) go to 90 

read(60,920)(x(j),y(j),j=1,3) 

JO = 1
176 GEOINDEX

go to 17

c

90 isfno = 2

write(30/910) if/ifno/isf/isfno/not/nor/nif 

c

c put the coordinates into integer format for packed 

c writing, 

c 

do 200 j = 1/4

ix1(j) = idint<x1<j)*(10.0**9) + .5) 

200 iy1(j) = idint (y1<j>*<10.0**9) + .5) 

c

write (30/9 30) y1(3)/y1(4)/x1(1)/x1<2) 

c this organization is as in the comx files: 

c upper latitude/ lower latitude/ Ift longitude/ right 

c long i t ude. 

c

930 format(Ad20.9) 

c

go to 10 

c

1000 endfile 30 

rewind 30 

return 

end

SUBROUTINE NAME: IBOUND_ADDRAD

Author: Harold Johnson

Purpose of the program: ibound_addrad reads the

characters in the vector ifile to interpret the

associated // and isf as integers. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ibouncL_addrad (ifile,nbound,if,-

isf,nrec) 

Arguments:

if He-A vector of characters from one record of 

strgNM

nbound-The number of the element of ifile that 

preceeds the data containing if and isf characters

//-The identification number for the current

reference outline 

isf-The subidentification number for the current

reference outline 

nrec-The length of ifile 

Subroutines called: decoder_addrad 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: ifile(nrec), num(6) 

Called by: addrad

Error checking and reporting: None 

Constants: None 

Program logic:

1. The pertinent characters are read from ifile, and 

decoder_addrad is called to interpret them as integers. These are summed with suitable powers of 

10 to output the corresponding // and isf.

******* SUBROUTINE IdOUND_ADDRAD *******

subroutine ibound_dddrdd(ifile/noound/if/isf/nrec)

SUBROUTINE USED IN MAIN PROGRAM "ADDRAD"

UPDATED AS OF DEC. 27, 1*76 H. JOHNSON 

converted to Multics May 21, 1977 by H Johnson
APPENDIX C 177

10 

c

20 

c

c 

c 

25

30

c

c

dimension ifile(nrec)/num(6) 

data iblank/" "/

THE PURPOSE OF THIS ROUTINE IS TO READ CHARACTERS IN IFILE 

TO DETERMINE THE IF/.ISF OF THE BOUNDARY FOR THIS MAP 

THE CHARACTERS CONSIST OF 1-3 NUMERALS FOR "IF" FOLLOWED BY 2 

FOR "ISF".

WE FIRST READ THESE NUMBERS INTO A VECTOR NUM(K), STOPPING *HEN 

A BLANK IS ENCOUNTERED.

Jo 10 k=1/6

i blah = i f i le(nbound + k-1)

i f ( i f i le (nbound+k-1 ) .eq. iblank)go to 20

call decoder_addrad(ifile(nbound + k-1)/nurr»1)

num(k)=num1

i f (k .yt . 1 )go to 25

WHEN THE RECORD IS ENTIRELY BLANK WE RETURN 0 FOR IF AND ISF. 

i f = 0 

i sf = 0 

return

READ THE LAST T*0 NUMBERS INTO ISF: 

Kla s t = k-1 

i sf = 0

jo 30 j = 1 ,2

isf=isf+num(klast-j+1)*10**(j-1) 

con t i nue

READ THE FIRST NUMBERS INTO IF:

kI as t = kIast-2

i f = 0

do 50 j=1/klast 

50 if=if+num(klast-j+1)*10**(j-1)

return

end 

c ******* END IBOLKJD.ADDRAD *******

SUBROUTINE NAME: DECODER_J^DDRAD

Author: Harold Johnson

Purpose of the program: decoder_addrad is used to interpret integer characters and output them as integers.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call decoder_addrad (iblah,iy)

Arguments:

iblah- Integer character 

iy- Integer number

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: ino(10)

Called by: ibound_addrad

Error checking and reporting: When iblah is not the 

character for any single integer, a message to that effect is written to the user.

Constants: None

Program logic:

1. iblah is compared with each of the integer characters 

0 through 9 until a match is found.

2. If no match is found, a message is sent to the user 

along with the character in question.

3. If a match is found on the nth test, iy is equated to n 

-1.
178 GEOINDEX

subroutine decoder_addrad(iblah*iy)

c

c subroutine used in dddrad

c written by H Johnson August 22* 1977

c

di men s i on i no(10)

data i n o/"0" ," 1"/"2" ," 3" ," 4" ," 5" , "6"/"7" ," 8" ," 9"/

c

do 10 n = 1*10

if(iolah .eg. ino(n)) 90 to 20

10 cont i nue

write(6*910)i blah

910 formatC" there is no way to decode iblah = "*a1)

return

c

20 iy = n-1

return

end

SUBROUTINE NAME: SRCH20_J^DDRAD

Author: Harold Johnson

Purpose of the program: srch20_addrad searches 

through the file number 20, measNM, to find that 

record with an assigned if and isf. It returns the area 

written there in character form.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call srch20__addrad (if,isf,iarea,iflag20)

Arguments:

if-The reference number for an outline 

/s/-The subreference number for an outline 

/area-An 8-character vector giving the area for an

outline

iflag20-A flag that indicates by the value 1 that no 

area was found in measNM for this outline

Subroutines called: icoder_addrad

Common data referenced: None

Input files: measNM used on unit 20 (file20)

Output files: None

Arrays used: iarea(8)

Called by: addrad

Error checking and reporting: When no record in 

measNM can be located that has assigned if and isf, a 

message to that effect is sent to the operator.

Constants: None

Program logic:

1. A record from measNM is read, giving its value for 

if, isf, area.

2. When this record indicates that it is beyond the 

record we seek, file20 is rewound and control 

begins at step 1.

3. Reading begins again, and this time if a record is 

read that should be beyond the assigned if and isf, 

the error message is written and the subroutine 

returns.

4. When a match is found, the area value is decoded into 

character format, along with the decimal point, and 

left-justified into /area. iflag20 is set at 0.

c ******* SUBROUTINE SRCH 2 U_ADDRAD *******

subroutine srch2G_addrad(if*isf*iarea*ifla,j2U) 

c

c SUBROUTINE USED IN MAIN PROGRAM "ADDRAD" 

c UPDATED AS OF DtC. 27, 1976 H. JOHNSON 

c

c converted to Multics May 21* 1977 H Johnson 

c

C THIS ROUTINE SEARCHES THROUGH THE AREA FILE 20 TO LOCATE AN IF* IS 

c

C TO MATCH THE NUrtdERS GIVEN IN THE CALL, 

c
APPENDIX C 179

dimension iarea(8)

data idot/"."/,izero/"0"/,iblank/" "/ 

if Idg20 = 0

10 reao(20,VOO,end=45)if1,isf1,ared 

900 format(2i5,f6.1)

if(if1 .eq. if .and. isfl .eq. isf) go to

if(if1 . g t. if .or. (if1 .eq. if .and. isfl

oa c k spac e 20 

40 read(20,900,end=45)if1,isf1,ared

if(if .eq. if1 .and. isf . eq . isf1)go to 100

if(if1 .It. if .or. Cif1 .eq. if .and. isfl 

45 wri te(6,910) i f ,i sf 

910 formatC" THERE IS NO AREA WITH IF = ",i5,"

rewind 20

i f I ag20 = 1

return 

100 a rea = a rea + .1

do 105 k=0,6

f = d rea/10. **k

ifx=ifix((f-float(ifix(f)))*10.)

call icoder_addrad(ibI ah,ifx) 

105 i area(7-k)=iblah

iarea(&)=iarea(7)

iarea(7)=idot

100

• gt isf))rewind 20

.It. i sf))go to 40 

AND ISF = " , i 5 )

c NOW, LEFT-JUSTIFY

do 135 k=1,6

if(iarea(1) .rie. izero)go to

-JO 130 1 = 1,7 

130 iarea( I) = iarea( 1 + 1 )

i area(8) = i DIank 

135 continue 

140 continue

i f Iag20 = 0

return

end 

c ******* t M D SRCH20 ADDKAD *******

140

SUBROUTINE NAME: ICODER_ADDRAD

Author: Harold Johnson

Purpose of the program: icoder_addrad determines

what character corresponds to a given input integer. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call icoder_addrad (iblah,iy) 

Arguments:

//?/a/7-The output character that symbolizes the integer iy

/y-The input integer 

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: ino(10)

Called by: ibound_addrad, rconv_addrad, srch20_

addrad

Error checking and reporting: When iy is not an integer 

between 0 and 9, an error message is sent to the 

operator. 

Constants: None 

Program logic:

1. In a do loop, iy is compared with each integer from 0 

to 9. When a match is made, the correct character 

is placed in iblah.
180 GEOINDEX

subroutine icouer_addrdd(iblah,iy)

c

c subroutine used in aadrad

c written by n. Johnson May 21 * 1977

c

d i mens ion i no(10)

data ino/"0%"1", M ^%"3","4","5","b%"7",''8","9"/

c

do 10 n = 1 , 10

if(iy .eq. n-1) go to 10

10 con t i nue

c

wri te(6*910)i y

910 formatC' THtRE IS NO WAY TO ENCODE IY = ",i3)

return

c

20 iblah = ino(n)

return

end

SUBROUTINE NAME: SRCH30_ADDRAD

Author: Harold Johnson

Purpose of the program: srch30__addrad searches 

through file30 for a record that matches an assigned if 

and isf. It returns values in character format. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call srch30_addrad (if,isf,inlat,islat,-

iwlong,ielong,iflag30) 

Arguments:

if-Reference identification number 

/sf-Subidentification number 

in fat -Vector containing the characters of the latitude

of the most northerly point of the outline 

islat— Vector containing the characters of the latitude

of the most southerly point of outline 

iwlong- Vector containing the characters of the 

longitude of the most westerly point of the outline 

ielong- Vector containing the characters of the

longitude of the most easterly point of the outline 

/7/agr30-Flag indicating whether or not the search

was successful

Subroutines called: rconv_addrad, read2_addrad 

Common data referenced: None

Input files: comxNM used on unit 30 (file30)

Output files: None

Arrays used: inlat(12), islat(12), iwlong(12), ielong(12)

Called by: addrad

Error checking and reporting: When no match is found,

this is reported to the operator. 

Constants: None 

Program logic:

1. A record in file30 is read to determine an if1 and 

isfl.

2. If a match with the assigned if and isf is found, 

rconv_addrad is called to convert the data into 

degrees, minutes, and seconds in character form. 

Then control returns to the calling program.

3. If the read record in file30 seems to be farther along 

than the assigned if, isf indicated, file30 is rewound and step 1 is initiated, with a flag indicating 

that this has occurred. If that flag was already set, 

the error message is written to the operator that no 

record exists in file30 with the if, isf, and the 

routine ends.

4. A second record is read and compared with the 

assigned //, isf, and this is repeated until the expected position of that record is passed. Then the 

error message is written.

5. When no record is found, iflagSO is set to 1. Otherwise, it is set to 0.

******* SUBROUTINE SRCH30_ADDRAD *******

subroutine srch30 addrad(if/>isf/>inI at/>isI at/iwIong,ieIong,if 

Idg30)

SUBROUTINE USED IN THE MAIN PROGRAM "ADDRAD" 

UPDATED AS OF DEC. 27, 1976 H. JOHNSON
APPENDIX C 181

C

C

10

C 

C 

C

converted to Multics May 21/ 1977 H Johnson

THIS ROUTINE SEARCHES THE LATITUDE LONGITUDE FILE 30 FOR THE RECOR

HAVING IF AND ISF THE SAME AS THE ONES SUPPLIES 3Y THE CALLING 

PROGRAM. WHEN IT FINDS THEM IT READS THE NLAT/SLAT/WLONG/ELONG 

VALUES ON THE NEXT CARD/ ENCODES THEM TO INLAT/ISLAT/IWLONG/IELONG 

AND RETURNS.

dimension inlat(12)/i slat(12)/iwlong(12)/ielong(12) 

double precision uLat/sLat/w I ong/eLong

FIRST/ SEARCH FOR THE ASSIGNED IF AND ISF.

call read2_aadrad(if1/isf1/ulat/slat/wlong/elong/kflag)

ifCkflag .eq. 1) go to 45

THIS READS 2 CAKDS/ A HEADER CARD FOLLOWED BY COORDINATES. IT 

RETURNS THE IF AND ISF FROM THE HEADER CARD.

40

45

910

100 

c 

c 

c

i f

i f

c a

i f

i f

i f

wr

fo

Cif1 .eq. if .and.

(if1 .gt. if .or. (

U read2_addrad( if 1

(kflag .eq. 1) go t

(if .eq. if1 .and.

( i f 1 .It. if .or . (

i te(6/910) i f /i sf

rmat(" THERE IS NO

isf 1

i f 1

/isf

o 45

i sf

i f 1

COMX

.e

.eq

1/u

• eq

.eq

RE

Q

•

I

.

.

. i

if

at/

i s

if

CORD

sf

•

si

f 1

•

W

) go

and .

a t / w

) go

and .

ITH

to 100

isf 1

I ong/ e

to 100

isf 1

IF = "

.gt . i

I ong/k

.It . i

/i5/"

sf ) ) rew

f lag)

sf ))go

ISF = "

ind 30

to 40

/i5>

* * * *

rew i nd 30

i fIdg30 =

return

cont i nue 

AT 

0 

DEGREES/

cal I

cal I

cal I

cal I

i fIag30 =

return

end 

*** END SRCH30.ADDRAD

1

THIS POINT THE NUMBERS ULAT/SLAT/WLONG/ELONG MUST BE CONVERTED

MINUTES AND SECONDS AND ENCODED. 

rconv_dddrad(ulat/inlat) 

rconv_dddrad(slat/i slat) 

rconv_addrad(wlong/iwlong) 

rconv_addrad(elong/ielong) 

0

*******

SUBROUTINE NAME: RCONV_J^DDRAD

Author: Harold Johnson

Purpose of the program: rconv_addrad decodes a 

12-digit floating point number into characters and 

writes them to a vector, one character put in each element of the vector.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call rconv_addrad (radian,ifile)

Arguments:

radian-A floating point number to be decoded 

if He-A 12-element vector, which is to contain the 

decoded digits of radian as characters

Subroutines called: dms, icoder_addrad

Common data referenced: None

Input files: None

Output files: None
182 GEOINDEX

Arrays used: ifile(12)

Called by: srch30_addrad, srch40_addrad

Error checking and reporting: In subroutines

Constants: None

Program logic:

1. radian is converted to degrees.

2. dms is called to convert these degrees to degrees, 

minutes, and seconds, I format.

3. These integers are written into if lie one at a time, 

with blanks in place of leading zeros. icoder_addrad is used to convert single integers to 

characters.

c ******* SUBROUTINE RCONV.AOORAO *******

subroutine rconv_addrad(radian/i f ile) 

C SUBROUTINE USED IN MAIN PROGRAM "ADDRAD" 

C UPDATED AS OF DEC. 27, 1976 H. JOHNSON 

c converted to Multics May 21 / 1977 h. Johnson 

c

double precision radian/x/pi

dimension i f ile(12 )

data pi/3.141592653569793238A26A3383279/

data iblank/" "/

data izero/"0"/ 

c

C THIS ROUTINE CONVERTS THE RADIAN ANGLE "RADIAN" INTO DEGREES, 

C MINUTElS AND SECONDS/ PACKING THEM INTO THE ARRAY IFILE.

C 

C

x=dabs(radian*18U./pi)

call dms(x/ideg/imin/isec ) 

991 format(1x,3i7) 

do 10 j = 1/3 

iy = i deg/(10**(3-j))

call icoder_addrad(ib lah/iy) 

i f ile(j) = iblah 

i y = i y*(10**(3-j)) 

10 i deg = i deg - i y 

if(ifile(1) .ne. izero) go to 15 

i f i le( 1) = iblank

if(ifile(2) .ne. izero) go to 15 

i fi le(2) = iblank

if(ifile(3) .ne. izero) go to 15 

ifi le(3) = iblank 

15 continue 

c

do 20 j = 1, 2 

i y = i min/(10**(2-j))

call icoder_addrad(iblah/iy) 

i fi le(3 + j) = i blah 

iy = i y*(10**(2-j)) 

20 imin = imin -iy 

ifCifile(A) .ne. izero) go to 25 

if(ifile(5) .ne. izero) go to 25 

25 c ont i nue 

c

-do 30 j = 1/ 3 

i y = i sec/(10**(3-j))

call icoder_addrad(ibI ah/iy) 

i f i le(5 + j) = iblah
APPENDIX C 183

iy = iy*(10**(3-j) )

30 isec - isec - iy

if(ifile(6) «ne. izero) go

if(ifite(7) .ne. izero) go

if(ifile(8) .ne. izero) go

35 con t i nue

c

do 40 j = 9,12

40 i fi le(j) = iblank

995 format(1x,12a1)

return

end

c ******* END RCONV.ADDRAD

to 

to 

to

35

35

35

*******

SUBROUTINE NAME: DMS

Author: Harold Johnson

Purpose of the program: dms converts a doubleprecision degree number to three integers representing degrees (between 0 and 360), minutes, and 

seconds.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call dms (x,ideg,imin,isec)

Arguments:

x- A double-precision floating point value for degrees 

ideg- An integer representing the degrees in x 

imin— An integer representing the minutes in x

isec— An integer representing the seconds in x 

Subroutines called: None 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: None 

Called by: rconv_addrad, optima 

Error checking and reporting: None 

Program logic:

1. x is reduced modulo 360.

2. The integer part of x is taken for Ideg.

3. Ideg is subtracted from x, the result multiplied by 60, 

and its integer part is Imin.

4. imin is subtracted, the result is multiplied by 60, and 

its integer part becomes isec.

c ******* QMS FUNCTlOiJ *******

subroutine dms(x/ideg/imin,isec)

double precision x/y

y = 360.

x - dmod(x/y)

ideg = ifix(sngl(x))

x = x - dfloat(iaevj)

imin = ifix(sngI(60.*x))

x = x*60. -dfI oat(imin )

isec = ifix(sng I (oO.*x))

return

end

c ******* END DMS FUNCTION *******

SUBROUTINE NAME: READ2_ADDRAD

Author: Harold Johnson

Purpose of the program: read2_addrad is used to read

from the file comxNM the values for the latitudes and

longitudes and the values for if and isf. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call read2_addrad (ifl,isfl,ulat,slat,-

wlong, elong,kflag) 

Arguments:

if1—The if of the record from comxNM

isfl—The isf of the record

ulat—The northernmost latitude

slat—The southernmost latitude

wlong—The westernmost longitude
184 GEOINDEX

elong—The easternmost longitude

kflag—A flag to indicate that the end of comxNMhas

been sensed

Subroutines called: None 

Common data referenced: None 

Input files: comxNM used on unit 30 (file30) 

Output files: None

Arrays used: None 

Called by: srch30_addrad

Error checking and reporting: None 

Constants: None 

Program logic:

1. file30 is read according to its preassigned format. 

When the end of the file is sensed, kflag is set to 1.

******* SUBROUTINE RhAD2.ADD9 AD *******

subroutine read2_addr3d(if1/isf1/ulat*slat/wlong^elon9/kflag)

SUBROUTINE CALLED BY SRCH3J IN MAIN PROGRAM "ADDRAD"

UPDATED AS OF DEC. 27, 1976 H. JOH.MSON 

converted to multics May 21 , 1977 H Johnson

90J 

910

100

*******

double precision ulat/sldt/wlong/elong

read(3U,9GO,end=10u)if1,ifno,isf1

for mat(3 i 5)

read(30*910/end=100)ulat/slat/wlong/elong

format(4d2U.9)

k f I a g = J

return

kf tag = 1 

return 

end 

END READ2.ADDRAD *******

SUBROUTINE NAME: SRCH40_jU)DRAD

Author: Harold Johnson

Purpose of the program: srch40_addrad searches

through file40 for a record having an assigned /'/ and

Isf.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call srch40_addrad (if,isf,iclat,iclong,-

jflag) 

Arguments:

if—The assigned reference identification number

isf—The assigned reference subidentification number

id at—A 12-character vector containing characters 

that represent the latitude of the center point in 

degrees, minutes, and seconds

iclong—The 12-character vector of characters for the 

longitude of the center

jflag—A flag that, when set to 1, indicates that no

record in file40 was found to correspond to the 

given //, isf

Subroutines called: read40_addrad, dble, rconv_ 

addrad

Common data referenced: None

Input files: ctrdNMused on unit 40 (file40)

Output files: None

Arrays used: iclat(12), iclong(12)

Called by: addrad

Error checking and reporting: When no record is found

with the prescribed // and isf, a message is sent to the

operator. 

Constants: None 

Program logic:

1. Following the same logic stream as in srch20_ 

addrad, search the file for the record with the 

desired /'/ and isf values.

2. When found, the latitude and longitudes are made 

double precision, and rconv__addrad is called to 

convert them to vectors of characters.

******* SUBROUTINE SRCHAO.ADDRAD *******

subroutine srch40_addrad(if/isf/icldt/iclong/jflag) 

SUBROUTINE USED IN MAIN PROGRAM "ADDRAD" 

UPDATED AS OF DEC. 27, 1976 

H. JOHNSON
APPENDIX C 185

THIS ROUTINE SEARCHES FILE 4U FOR THE RECORD HAVING THE GIVEN IF, I

F

THE NEXT RECORD WILL CONTAIN THE LATITUDE/ LONGITUDE OF THE CENTER

POINT

dimension i c I at < 1 2 ) * i c long ( 1 2)

douole precision radian 

c 

c

j f lag = 0

c FIRST/ SEARCH FOR THE IF/ ISF IN THE CALLING PROGRAM. 

10 call rea d40_addrad ( i f 1 / i sf1 / c lat/ c long/ i f lag 1 ) 

i f ( i f I ag1 .eq. 1 ) go to 45

c THIS READ 2 CARDS. THE FIRST IS A HEADER CARD AND GIVES THE IF1/I 

c F1 

c THE SECOND IS A LATITUDE LONGITUDE CARD.

if(it1 .eq. if .and. isfl .eq. isf)go to 100

if(if1 .gt. if .or. (if1 .eq. if .and. isfl .gt. isf))rewind 40 

40 call read40_addr ad ( i f 1 f i sf 1 /c lat / c I ong/ i f I ag1 ) 

i f ( i f I dg! . eq . 1 ) go to 45

ifCif .eq. if1 .and. i s f . eq . i s f 1 ) go to 100

if(if1 .It. if .or. (if1 .eq. if .and. isfl .It. isf))go to 40 

45 wri te(6/?10) i f /i sf 

910

rewind 40

J f lag = 1

return

c

103 radian = dble(clat) 

call r conv_ addr ad ( rad i an/ i c I a t ) 

radi an = dble (c long) 

call r conv.addr ad ( rad i an/ i c long ) 

KCOMV CONVERTS "RADIAN" TO DEGREES/ MINUTES AND SECONDS AND ENCODE

C THE;1 AS CHARACTERS INTO ICLAT AND ICLONG. 

return 

end

c ******* END SRCH40_ ADDRAD *******

SUBROUTINE NAME: READ40_ADDRAD

Author: Harold Johnson

Purpose of the program: read40_addrad is used to read

from file40, ctrdNM. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call read40_addrad (ifl,isfl,clat,-

clong,iflagl) 

Arguments:

if 1-The if number of this outline

isfl -The isf number of this outline

c I at-The latitude of the center point of this outline

clong-The longitude of the center point 

iflagl -A flag to indicate the end of file40 has been 

sensed

Subroutines called: None

Common data referenced: None

Input files: CtrdNM used on unit 40 (file40)

Output files: None

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. file40 is read, two cards at a time, to determine the 

arguments, iflagl is set to 1 when the end of file is 

sensed.
186 GEOINDEX

c ******* rtEAD4U_ADDRAD *******

suoroutine read4u_addrdd(if1,isf1,clat,clong,iflag1) 

c SUBROUTINE CALLED BY SRCHAG IN MAIN PROGRAM "ADDRAD" 

c UPDATED AS OF DEC. 27, 1976 H. JOHNSON 

c

c converted to multics May 20, 1977 by H Johnson 

c

read(40,910,end=100)if1,ifno,isf1 

91U format(3i5)

read(40*92u,end=100)xu,y0,clong,clat 

923 format (4f12.9)

i f L ag = 0

return

10J if lag = 1 

return

end 

c ******* HMD READ40_ADDRAD *******

SUBROUTINE NAME: WEIGHT_ADDRAD

Author: Harold Johnson

Purpose of the program: weighL addrad calculates a 

weighted center for each edge of a polygon and adds 

to the cumulated weighted center and total length.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call weight_addrad (xl,yl,x2,y2,xc,- 

yc,td)

Arguments:

x1 -Longitude in radians of the first point 

y 1 -Latitude in radians of the first point 

x2- Longitude in radians of the second point 

y2- Latitude in radians of the second point 

xc- Longitude of weighted center

yc- Latitude of weighted center

td-Total length of curve 

Subroutines called: None 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: None 

Called by: center addrad 

Error checking and reporting: None 

Constants: None 

Program logic:

1. The value z = \x2 - x1 \ + \ y2 - y1 1 is 

calculated.

2. The value 0.5(x2 + x7)z is calculated and added to xc. 

The value 0.5(y2 + y1)z is calculated and added to 

yc.

3. z is added to td.

suurout ine weight_addrad(x1,y1,x2,y2/xc,yc,td) 

c

c ******* SUBROUTINE wEIGHT_ADDRAD ******* 

c

c Purpose: To calculate a weighted center for an added edge, 

c by adding to each coordinate the average coordinate 

c multiplied by the length of the segment, 

c

c Programmer: H Johnson 

c

c Date: July 18, 1978 

c

c converted to multics May 6, 1977 H. Johnson 

c

implicit double precision (a-z) 

c

z=abs(x2-x1) + abs(y2-y1) 

xc=xc + 0.5*(x2+x1)*z
APPENDIX C 187

yc = yc + U. 5*(y2+y 1 ) *z

td = td + z 

return 

end 

c ******* END WEIGHT.MASTER *******

SUBROUTINE NAME: CENTER_ADDRAD

Author: Harold Johnson

Purpose of the program: center addrad computes a

central point for each outline in cordNM and stores it

in a file named ctrdNM. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call center_addrad 

Arguments: None

Subroutines called: weight_addrad 

Common data referenced: None 

Input files: cordNM used on unit 60 (fileBO) 

Output files:

ctrdNM used on unit 40 (file40)

Created by: center_addrad 

Arrays used: None 

Called by: addrad

Error checking and reporting: None 

Constants: None

Program logic:

1. A header card is read from cordNM, and isfno, the 

number of coordinate pairs that follow, is used to 

compute the number of coordinate cards.

2. The first coordinate card is read. If only one point is 

in the outline, that is assigned the center point. 

Otherwise, beginning with the second and third 

points, a weighted center is computed according to 

the formulas described for weight_addrad.

3. The middle cards are read, and these computations 

are continued with each pair of coordinate points.

4. The last card is read, and the final calculations are 

xc = xcldt 

yc = ycldt

5. A header card is written to ctrdNM with isfno = 2.

6. A latitude-and-longitude card is written to ctrdNM 

with xc, yc.

7. Control goes to step 1 until the cordNM file is finished.

8. Endfile and rewind are executed on ctrdNM.

subroutine center_addrad 

c

c********** WEIGHTED AVERAGE CENTER *********** 

c Purpose: To compute a center for each outline in the 

c radian coordinate file cordNM ana put it in" the 

c file ctrdNM . 

c

c Programmer: H Jonnson 

c Date: July 1 &/ 1978 

c

c input file60: cordNM/ a file of radian coordinates* giving the 

c latitudes and longitudes/ format 3(2f12.9>) 

c

double precision xx/ yy/ xstart/ ystart/ xc/ yc/ dt/ xlast/ ylast 

c

common true/sk/ia

dimension xx(3)/yy(3) 

c 

c

c FIRST/ COMPUTE THE STATE MAP AREA IN SQUARE KILOMETRES, 

c

i n = 60

i ocnt r = 4u

100 read(in/9GU/end=100J) if/ifno/isf/isfno/not/nor/nif/ispan 

900 format(3i5) 

c
188 GEOINDEX

C WHEN ISFMO IS LESS THAN 4 WE DON'T HAVE A REGION AT ALL 

C

if(isfno.gt.3)go to 102

read(in,901*end=1000)(xx(i),yy(i),i=1/3) 

901 format(of 12.9) 

c 

c

C IN THE CASE OF A SINGLE POINT/ CALL THAT POINT CNTR. 

C

i xc = xx(2)*(10.**9) + .5

i yc=yy(2)*(10.**9) + . 5

i s fno = 2

wri te(iocntr,905)i f * i f no* i sf/i sfno,not*nor*ni f * i span

write(iocntr*908)ixc*iyc

go to 100

102 cont i nue 

c

C CALCULATE NCARDS, Trib NUMBER OF DATA CARDS ON THIS MAP 

C

ncards=i sfno/3

if(3*ncards .It, isfno) nc a rds = nc a ras + 1 

c 

c

x c = 0.

yc=0.

a t = 0 . 

c

C XC IS GOING TO BE THE X-COORDINATE OF THE CENTER 

c YC IS GOING TO BE THE Y/COORDINATE OF THE CENTER 

c DT IS THE ACCUMULATED NORMED DISTANCE BETWEEN POINTS 

c

C READ IN THE FIRST DATA CARD 

C

reaa(in,901*end=10uO)(xx(i),yy(i),i=1,3)

xstart=xx(2)

ystart=yy(2)

i e = 3

ifCncards .eq. 1) ie=isfno

do 200 j=3,ie

j1=j-1

call wei(jht_addrad(xxCj1)/yy(j1)/xxCj)/yy(j)/xc/yc/dt) 

20J cont i nue

if(ncards .eq. 1) go to 500

xlast=xx(3)

ylast=yy(3) 

c 

c

if(ncards .eq. 2) go to 400 

c

C READ IN THE MIDDLE CARDS/ BETWEEN THE FIRST AND LAST. 

C

Kl=ncards-1

ao 300 k=2,kl

read(in,901)(xx(i ),yy(i),i = 1,3)
APPENDIX C 189

301

call weight_addrad(xlast/ylast/xx(1)/yy(1)/xc/yc/dt)

do 301 j = 2,3 

j1=j-1

cal I weight_addrad(xx(j1) / y y (j1) / x x (j)/yy(j)/xc/yc/dt) 

con t i nue 

xlast=xx(3) 

y I as t = yy(3) 

continue 

continue

300

400

c

C NOW READ IN THE LAST CARD

c

read(in,901)(xx(i)/yy(i),i=1,3)

ie=isfno-3*(ncards-1)

ifCie .eq. 0) ie=3

call weight_addrad(xlast/ylast/xx(1)/yy(1)/xc*yc/dt)

i f(ie .eq. 1) go to 500

do 401 j=2/ie

call weight_addrad(xx(j1 )/yy(j1)/xx(j)/yy(j)/xc/yc/at) 

continue 

continue

401

500

c

C WHEN THE REGION IS NOT CLOSED/ WE MUST ADD THE LAST DATA POINT

c

t es t = (x x (i e ) -xs t a r t ) **2 * ( y y ( i e ) -y s t a r t ) * * 2

i f ( test . It . .01 ) go to 501

cal I weight_addrad(xx(ie)/yy(ie)/xstart/ystart/xc/yc/dt)

501 continue 

503 continue

xc=xc/dt

yc = yc/<?t 

i s f no = 2

wri te(iocntr/9G5) if/i f no/ i sf/i sfno/not/nor/ni f/ispan 

905 f o rma t (6i 5)

ixc= idint ( x c * 1 000000000 . -»-0 . 5 )

iyc= idint ( y c * 1 000000000 . + 0.5)

write(iocntr/908> ixc/iyc 

905 format (<?4x,2i 12)

go to 100

1000 endfile 40

rewind 40

return

end

SUBROUTINE NAME: FTNUMBER

Author: Harold Johnson

Purpose of the program: ftnumber is used to attach and

open a file on the Multics system. It allows for any file

mode.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics

Calling sequence: call ftnumber (iunit,name,mode) 

Arguments:

iunit- The Fortran number of a file being attached

name- The name of the segment being attached (This 

can have as many as six characters.)

mode- Type of file access method 

Subroutines called: The Fortran routine encode and the

system routine I/O
190 GEOINDEX

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: concat, master, addrad, out1_bigsta, out2_ bigsta

Error checking and reporting: None 

Constants: None

Program logic:

1. The assigned Fortran number iunit is inserted into 

the character string fname in the form fileNM, 

where NM is the number Iunit.

2. If the mode is not so, attachment is made using 

arguments -append and -ssf.

3. If the mode is so attachment is made.

c ******* SUBROUTINE F7NUMBER *******

subroutine ftnumber(i un i t/name/mode)

c

c PURPOSE: To automatically attach and open files in Fortran

c

c PROGRAMMED: H Johnson

c DATE: Sept 30* 1977

c

c iunit = fortran i/o number

c name = up to 6-character c name of a file.

c mode = "si","so"/ etc.

c

c modified from the program assoc of >udd>Grasp>RBowen>assoc

c by HJohnson May 20/ 1977.

c

character name*e>/fname*6/mode*4*fmt*1 2 

f m t = " ( 4 h f i I e / i 2 ) "

if (iunit .le. 9) fait = "(5hfi IeO/i1)" 

encode(fname/fmt) iunit 

if (mode . eq. "so") yo to 20

call io (" attach %fname/"vf iIe_"/name/"-append"/"-ssf" )

call io ("open"/fname/mode) 

return 

c 

20 call io ("attach"/fname/"vfile_"/name)

call io ("open"/fname/mode) 

return 

c 

end

EXEC-COM NAME: COVERT.EC

Author: P. A. Fulton

Purpose of the program: covert.ec, written in Multics

command language, reads the redyNM file and

creates a GRASP file for the State. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: ec covert NM state 

Arguments:

NM- FIPs code for the State

sfate-Name of the State 

Subroutines called: setmas, convert 

Common data referenced: None

Input files: dicn, mask, crfile, indxNM, redyNM, defn

Output files: indexO

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. Turn off the COMMAND LINE.

2. Attach the exec_com to setmas.

3. Execute setmas.

4. Upon completion of setmas, detach the files.

5. Attach the exec_com to convert.

6. The exec_com will pass the names of six 

files-dicn, mask, crfile, indxNM, redyNM, and 

defn to be read by convert.
APPENDIX C 191

7. Detach the files.

8. Attach the exec_com to ted, which is a text editor.

9. Read indexO and then read file15, which will 

append file 15 to indexO.

10. Write indexO.

11. Quit and exit from the text editor.

12. Detach the files.

13. Delete file15.

14. Quit the exec_com.

5 c omrnand_ I i ne off

&a tt ac h

se tmas

1 18

ye s

£det ach

Sattac h

corw er t

d i en

mask

c r f i I e

i ndx i 1

n

redy&1

n

de f n

reference map file for

& d e t a c h

£a 11 ac h

ted

r i nde xO

r fi Ie1 5

w i n a e x u

q

&det ach

dl file15

£qui t

FILE NAME: CRFILE

Purpose of the file: crfile is a control file for the GRASP 

programs. It enables GRASP to read the redyNM files 

correctly.

Format: The first record contains nacr and nrec, format 13, 15. The remaining records contain acronm, 

itype, and ifirst, format A9, II, 15.

Arguments: 

nacr— The number of acronyms to follow = remaining

number of records in crfile 

nrec- The total length of the strgNM and redyNM

records

acronm-The acronymns used in matrix 

itype- The type code used by GRASP 

///fSf-The position in the records of strgNM and

redyNM where this type of data begins 

Referenced by: The GRASP programs, which set up 

GRASP files.

crfile

38 1211

id

s ta te

author

year

title

1

3

6

1

6

1

5

25

205

209
192 GEOINDEX

county 

publish 

s er ies

emphasi 

area

aunit

nlat

slat

wlong 

elong 

clat

clong 

omaps 

avail

base

geology 

plate 

idstat

scale

idsub

ibound

ispan 

alsomap 

dumO

duml

dum2

dum3

dum4

dum5

dum6

dum7

dum8

dum9

6 

6 

6

6 

2

6

1

1

1

1 

1

1 

6 

6

3

3 

6 

1

1

1

1

1 

6 

1

1

1

1

1

1

1

1

1

1

449 

629 

689

809 

869

877

884

896

908 

920 

932

944 

956 

1016

1076

1106 

1118 

1 148

1 150

1158

1 160

1 166 

1172 

1202

1203

1204

1205

1206

1207

1208

1209

1210

1211

PROGRAM NAME: SETMAS

Author: P. A. Fulton

Purpose of the program: setmas creates the index file 

required by GRASP. This GRASP file is limited to 10 

entries. This program accepts a list of State FIPS 

codes and creates files containing a GRASP entry for 

each State.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: setmas

Arguments: None

Subroutines called: None

Common data referenced: None

Input files: indexO used on unit 11 (f/7e77XState codes 

entered interactively)

Output files: index, a subset of indexO, used on unit 12 

(file 12)

Arrays used: ir(9,2), ir1(80)

Called by: covert.ec, gr.ec, usmerg.ec

Error checking and reporting: System only 

Constants: None 

Program logic:

1. This program executes interactively. It begins by requesting the State codes: 

ENTER ONE DIGIT FOR NUMBER OF 

STATES TO QUERY AND FOLLOW BY LIST 

OF TWO DIGIT STATE CODES WITH 

BLANKS BETWEEN 

Reply: 3 02 16 39

This reply indicates 3 State entries are to be put into 

the output file index. These States are coded 02 

(Alaska), 16 (Idaho), and 39 (Ohio).

2. All I/O operations are handled internally by the program.

3. The program compares the codes input via the terminal to the codes in file indexO. When the codes 

match, a State entry in proper GRASP format is 

placed in the output file index, index is then used 

by GRASP.
/"indexO") 

'/"index")

APPENDIX C 193

setmas

character ir*1/ir1*1 

dimension ir(9/2)/ i r 1 ( o 0 )

call io ("attach","fiIe11"/"vfi le_

call io ("open"/"f He1 1"/"si")

call io ("attach","fiIe12"/"vfi le_

call io ("open"/"fiIe12"/"s io")

print/"enter one digit for numoer of states to query and follow" 

print/"oy list of two aigit state codes with blanks between" 

read (3/101) n/(ir(i/1)/ir(i/2)/i=1/n) 

101 format (i1/x/9(2a1 / x ) ) 

221 read (11/102/end=90 ) ir1 

102 format (80a1) 

do 220 i = 1/n

if ( i r ( i /1 ) .ne. i r 1 ( t>) ) 

if (ir(i/2) .ne. ir1(6)) 

write (12/ 102) i r 1 

220 continue

go to 221 

90 continue

end file 12

call io ("close"/"fiIe11")

call io ("close"/"fiIe12")

call io ("detach"/"fi Ie11")

calI io ("detach","fi Ie12") 

stop 

en d

go to 22U 

go to 22U

EXEC_COM NAME: GR.EC

Author: P. A. Fulton

Purpose of the program: gr.ec, written in Multics command language, sorts the State index file by scale and 

creates three files: tip for scales LE (less than) 

1:24,000, t2p for scales GT (greater than) 1:63,360, 

and t3p for scales BE (between) 1:24,001 and 1:63,360.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: ec gr NM

Arguments: NM- FIPS code for the State

Subroutines called: setmas, GRASP

Common data referenced: None

Input files: indexO

Output files: tip, t2p, t3p, t1, t2, t3, and output—file

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

gr.ec

&command_ I ine off

iat t ac h

fo

setmas

1 £1

Program logic:

1. Turn off the command line.

2. Attach the exec_com to the program setmas.

3. Designate the user output to a segment by the FO 

command.

4. Execute subroutine setmas.

5. The exec com supplies answers to queries in setmas.

6. The file is detached.

7. input—line is turned off.

8. Attach the exec_com to the program GRASP.

9. The exec_com contains responses to prompts in the 

GRASP program.

10. At the end of GRASP, the file is detached.

11. User output is directed to the console by the RO 

command.

12. The file called output^file is deleted.

13. The three files tip, t2p, and t3p are automatically 

dprinted.

14. Quit the exec_com.
194 GEOINDEX

ye s

& d e t a c h

& inpu t_ I i ne off

iatt ac h

gr asp

cond

scale le 24000

scale gt 63360

scale be 24001,63360

logi c

a

search

t1

li st 

t1 

50 

c

y 

tip

i bound

id

i dsub

logic

b

search

t2

list

t2

50

c

y

t2p

n

logic

c

search

t3

list

t3

50

c

y

t3p 

n

qui t 

no

aide t a c h

CO
APPENDIX C 195

dl out pjt_f i I e 

dp tip 

dp t <?p 

dp t3p 

&qui t

EXEC-COM NAME: INPLOT.EC

Author: P. A. Fulton

Purpose of the program: inplot.ec, written in Multics

command language, plots the three files created by

gr.ec-that is, tip, t2p, and t3p. It provides a visual

check of the integrity of the plot files. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: ec inplot NM state 

Arguments:

NM-FIPS code for the State

state- State name 

Subroutines called: pn16 

Common data referenced: None 

Input files: bordNM, coorNM, statNM, counNM,

gridNM

i np Lot .ec

^command. I i ne off 

stty -modes pLO 

& i nput _ I i nes off 

&a tt ach 

pn 1 o 

n

Output files: Plots on the Tektronix screen

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. command—line is turned off.

2. page_length is set to 0 to disable end-of-page checking.

3. &input_lines off disables the computer from accepting input from the terminal.

4. &attach attaches the arguments in the exec_com 

directly to pn16.

5. Response to prompts in pn16 are fulfilled within the 

exec_com.

6. &detach detaches the exec_com from pn16.

7. page^length is set to 114.

8. Quit.

tip

y

scale

1

0

1

0

c

n

y 

y

t2p

y

scale

1

0

1

U

c

1 :24GUU

I t 1 :63360
196 GEOINDEX

n

y 

y 

t3 P

y

scale between 1:24000/1:63360 4,2

1

0

1

0

c

n

y

n

count i es for &2

0

1

0

0

c

n

n

ye s

£det a c h

s11y -modes p111 A

Squi t

PROGRAM NAME: PN16

Author: P. A. Fulton

Purpose of the program: pn16 plots a State index map 

interactively on a Tektronix CRT screen. This is a 

two-step process. First, a GRASP retrieval is executed wherein a disk file is created that contains the 

links to the coordinate Geoindex files. This GRASP 

file is identifed as unit 13. However, the program is 

constructed so that the user has the option of plotting 

any combination of the input files.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: pn!6

Arguments: None

Subroutines catted: initt, anmode, erase, movabs, 

dwindo, swindo, movea, drawa, ancho, bell, 

hdcopy, vcursr, finitt (Tektronix routines), plod, 

pos, plo, ploc6, assoc

Common data referenced: x1, y1, x2, y2

Input files:

Input from terminal used on unit 5 (fileS) 

coorNM used on unit 10 (fileW) 

bordNM used on unit 11 (file11) 

GRASP file used on unit 13 (file13) 

statNM used on unit 14 (file14)

counNM used on unit 15 (file15) 

gridNM used on unit 16 (fileW) 

skod used on unit 17 (filelT) 

Superimposed file used on unit 20 (file20)

Output files: Output to terminal used on unit 6 (filed)

Arrays used: lead(20), xx(6), yy(6), mort(300), ista(6)

Called by: Can be executed by inplot.ec

Error checking and reporting: When the array size of 

300 entries for the input plot file (file13) is exceeded, 

the program returns the error message:

BUFFER EXCEEDED

When the number of x, y coordinates does not match 

the number given on the header card (isfno), the program returns the error message:

REC COUNT ERR

All error messages concerned with I/O handling are 

identified by system messages and system returns.

Constants: ingd = 10 and ing - 13 are file numbers; rsiz 

= 0.3 size in inches for numbers shown on plot; ichar 

= 43 character (+) for points plots.

Program logic:

1. The program prompts the user for all the specific input and output desired. The first phase requires 

the user to identify the single, specific State.

2. The program does all the file handling internally to 

relieve the user of all systems duties. However, all
APPENDIX C 197

the files listed above must be available because 

they are attached and opened here at the beginning of the program.

3. The program requests the input file (file13), which 

is to be plotted. If necessary, the program sorts 

the data into ascending order by keying on the id 

number.

4. The plot window is computed from the coordinates 

of the border files, bordNM.

5. The annotation and exact data files that are to be 

plotted are elicited from the user.

6. The actual plotting is initiated in the following 

order: border, State, county, grid, and the input 

file, which was created by GRASP (file13) and 

which is to be plotted. The program reads the 

value of ibound from this input file and assigns to 

it the variable name /map.

7. The program reads through the coorNM file. From 

the header cards, it obtains the identification and 

subidentification numbers, which it combines into 

the variable if and compares to /map.

8. When these numbers from the two different files 

match, the outline is plotted. First the identification number is plotted, its position determined by 

the first pair of x, y coordinates. Then the rest of 

the x, y coordinates are plotted to form the 

outline. The program uses the number of points 

(isfno) read from the header card to compute the 

end of a feature outline.

9. For very small areas, there is only one x, y coordinate pair for the outline, and the symbol ( + ) is 

plotted at that point.

10. After the entire input file (file13) has been plotted, 

the program tests to see whether another file 

should be superimposed. If so, it is plotted by 

subroutine ploc6. ploc6 plots this superimposed 

file similar to the way pn16 plots the coorNM file. 

The exception is that ploc6 plots the entire file 

that is to be superimposed but does not compare it 

to any other input file from GRASP.

11. After the plot is completed, the bell rings to alert 

the user to make hard copies of the plot and (or) to 

continue the execution of the program.

12. The next phase of the program permits the user to 

enlarge any part of the plot. The new plot window 

is defined by use of the crosshair cursor.

13. The program then loops back so that the appropriate annotation and files are used for the enlarged part of the plot. This enlargement cycle can be 

continued until the user is satisfied and decides to 

go on to the next part of the program.

14. The next part of the program enables the user to 

designate another input file from GRASP or simply to loop back through the program and plot any 

of the base sheet files. However, to plot another 

State, the program must be exited and reinitiated.

15. The final phase of the program closes the files. It 

then writes the message

GOOD

to the screen to indicate that the program terminated successfully.

pn16

program to plot map indices on tektronix

u. s. geological survey 

June 1977

5 i nput

6 output 

coor d 

bord 

f i le 

st at 

1 5 coun 

16 grid 

skod 

f i le

1 J 

1 1

13

14

17

i nput/output files 

from terminal

to terminal 

inate files

from grasp contains three items : ibound/id/idsub

- file with state names* numeric and alphabetic fips codes 

to superimposed same format as coor file
198 GEOINDEX 

C

c

common x1/y1/x2/y2

character skud*6/fname*8/fmt*12/ifi I e*8

dimension lead(20)/xx(6)/yy(6)/mort(300)/ista(6)

data jes/"y"//kop/"c"//ibnk/" "/

data skud/"skod "/ 

c

call ini tt(960) 

c 

c

ingd=10

rs i 2 = 0. 5

i c har = 4 3

i ng = 13 

c 

c assign files

call anmode

print/"need state codes (enter y for yes)"

read (5/130) i rep

if (irep .ne. jes) go to 383

fmt="(a8)"

encode (fname/fmt) skud

call assoc (17/fname/"si ")

do 381 i=U54

read (17/141) ista/ile/nmb

write (6/142) ista/ile/nmb 

142 format (1x/6a4/a2/5x/i2) 

141 format (6a4/a2/i2) 

381 continue

print/"type 1 ana hit return key when ready"

read/ready

cat I closer (17) 

383 call erase

call movabs (30/725)

call anmode

print/"enter state id number"

read(5/140) i st ate 

140 format (a4) 

c

fmt="(4hcoor/a4)"

encode (fname/fmt) istate

call assoc (10/fname/"si ")

fmt="(4hbord/a4)"

encode (fname/fmt) istate

call assoc (11/fname/"si ")

fmt="(4hstat/a4 )"

encode (fname/fmt) istate

call assoc (14/fname/"si ")

fmt="(4hcoun/a4)"

encode (fname/fmt) istate

call assoc (15/fname/"si ")

f mt = " (4hgrid/a4)"

encode (fname/fmt) istate

call assoc (l6/fname/"si ")
APPENDIX C 199

c

C

c request input file for plotting

c

380 con t i nue

call movabs (30/715)

call anmode

print/"if a coordinate file is to be plotted/ enter y"

read (5/130) icor

if (icor .ne. jes) go to 343

print/ "enter name of file to be plotted"

read (5/131 ) if i le 

131 forrnat(a8)

call assoc ( 1 3/ i f i le /" s i ") 

c

c eliminate duplicate id numbers 

c and sort id numbers into ascending order 

c

print/ "if input should be sorted reply with a y for yes

read (5/1 30) i r ep 

1 30 format ( a1 )

if (irep .ne. jes) go to 343 

c

rewind ing

i m= 0 

c

i m 1 = 0

339 read (ing/124/end=340) imap 

124 for-nat (i10)

i rn = i m + 1

mort( im)=imap

if (im .It. 300) go to 339

print/ "buffer exceeded" 

340 continue

call c loser (13)

do 338 i =1 / i m

I e s = mo r t ( i )

do 364 j = i / i m

if (les .le. mort(j)) go to 364

I e ss = mo r t ( j )

mor t ( j ) = le s

les = l es s 

364 continue

mort(i)=les 

338 continue 

c

rewind ing

cal I assoc (13/i f i le/"sio ")

i mapl =mor t ( 1 )

write (ing/124) imapl
200 GEOINDEX

do 363 i = 2 / i rn

i map=mo r t(i)

if (imap ,eq. imapl) go to 3o3

write (i ng/124) i map

i mapl = i map

363 continue

end file ing

rewind ing 

343 continue 

c

c set origin on plotter 

c

call pos(11/xx/yy)

x1=amin1(xx(2)/xx(3)/xx(4)/xx(5)/xx(6))

x2=amax1(xx(2)/xx(3)/xx(4)/xx(5)/xx(6))

y1=amin1(yy(2)/yy(3)/yy(4)/yy(5)/yy(6))

y2=amax1(yy(2)/yy(3)/yy(4)/yy(5)/yy(6))

dx= x2-x1

dy=y2-y1 

c

c use the bord file to compute the plot window 

c

call dwinao (0./dx/0./dy) 

553 x=(dx*780.)/dy

i x = x

ix1=1023-ix

if (dx .gt. dy) go to 550

call swindo (ix1/ix/O/780)

go to 551 

550 y=(dy*1023.)/dx

iy = y

if (iy .gt. 780) go to 552

call swindo (O/1023/O/iy)

^o to 551 

552 ix1=iy-780

i x=1023-i x1

call swindo (ix1/ix/O/780) 

551 continue 

c 

c

c border information 

c 

303 continue

call movabs(30/650)

call anmode 

302 print/"enter title for map"

read (5/122) lead 

122 format (20a4)

print/"to plot state enter 1"

read (5/160) i s t at 

160 format(i1)

print/"county plot-enter 1 for solid line/ 2 for dotted/ else 0"

read (5/160) i c oun

print/"to plot grid enter 1"
APPENDIX C 201

read (5/ 160) ig ri d

print/"to superimpose another file/enter 0 for no* "

print*"1 for lines only/ 2 for lines and characters"

read (5/160) i sup

if (isup .eq. 0) go to 304

print/"enter tile name"

read (5/131) if ile

call assoc (20/ifile/"si ") 

304 continue

call erase

call movabs (30/750)

call a n m o d e

write (6/123) lead 

123 format (1x/2Ja4) 

c

c drawneatline 

c

if (kk .e^. 0) go to 419

call movea(x1/y1)

call drawa (x2/y 1 )

call drawa ( x 2 / y <?)

call drawa (x1/y2 )

call drawa (x1/y1) 

c

c p I o t base map 

c

419 cont i nue 

c

call plo(11)

if (istat .ne. 1) go to 470

cal I plo(14) 

47J if (icoun .ne. 1) go to 476

call plo (15) 

476 if (icoun .ne. 2) go to 471

call plod (15) 

471 if (ijrid .ne. 1) go to 472

call plocod 6) 

c

472 if (icor .ne. jes) go to 89 

c

c plot coor file 

c

rewind i ng

rewind ingd 

c 

c

319 cont i nue

read (ing/124/end=89) imap

320 read (ingd/111/end=89) if/ifno/isf/isfno/if 1 /jstat/jgrat/jspan

i f = (i f*100)+isf 

111 format (8it>)

if (if-imap) 335/337/360 

c 

360 read (ing/124/end=89) imap

if (if-imap) 335/337/360
202 GEOINDEX

C

335 do 336 j=1/isfno/6

read (ingd/126) ( xx ( i )/yy(i ) / i=1/6)

336 continue

go to 320 

c

337 continue

c

c

i e= i s fno

if (isfno .ge. 6) i e = 6

read (ingd/126) ( x x ( i ) / y y ( i ) / i = 1 / i e) 

126 format (12f6.3) 

c

if (isfno .ge.3) go to 321 

c

if ((xx(1) .Le. x1) .or. (yy(1) .Le. y1)) go to 320

if ((xx(1) .-je. x2) .or. (yy(1) .ge. y2>) go to 320

call movea (xx(1)/yy(1))

c a I L anmode

write (6/137) if 

137 format (1 x/ i 5)

if (jspan .eq. U) go to 520

ry = yy(1 )-r s i z

call movea (xx(1)/ry)

call anmode

write (0/137) jspan 

520 call movea ( xx(2 ) / yy(2 ) )

call ancho(ichar)

if (i f1 .eq. 0) go to 320

r y= r y-r s i z

call movea (xx(1)/ry)

call anmode

write (6/137) i f1

go to 320 

c 

321 continue

if ((xx(1) .le. x1) .or. (yy(1) .le. y1)) go to 449

if ((xx(1) .ge. x2) .or. (yy(1) .ge. y2)) go to 449

call movea ( xx(1 ) / yy (1 ))

call anmode

write (6/137) if

if (jspan ,et|. 0) go to 521

ry = yy(1 )-rsi z

call movea (xx(1)/ry)

call anmode

write (6/137) jspan 

c 

521 i f (i f1 .eq. 0) go to 449

ry= ry-r siz

call movea (xx(1)/ry)

call anmode

write (6/137) if1
APPENDIX C 203

C

go to 449 

c 

c 

447 continue

call movea (xx(1 )/yy(1 ))

call anmode

write (6/137) if 

c 

449 cont i nue

call movea (xx(2 )/yy (2 )) 

c

do 341 k = 2/ i e

call drawa (xx(k ) / yy(k )) 

341 cont i nue 

c 

c 

537 is fno= i s fno-6

if (isfno) 320/320/345 

345 if (isfno-6) 322/322/333 

322 ie=isfno

333 read (ingd/126/end = 88) (xx(i)/yy(i)/i=1/ie ) 

c

do 342 k=1/ie

call drawa (xx(k )/yy(k )) 

342 cont i nue 

c

if (isfno-o) 32U/320/537 

c 

88 write (6/128) if / ifno/isf/isfno

128 format (1x/i 3/2 i2/i5) 

write (6/129)

129 format (1x/"rec count err")

go to 99 

c

c superimpose another file 

c 

89 cont i nue

if (isup-1) 305/505/506

505 call plo (20)

call closer (20) 

go to 305

506 call ploc6 (20)

call closer (20) 

c 

c

c copy and/or exit 

c

305 continue

call belI

call anmode

read (5/1 3D) i copy
204 GEOINDEX

452 

c 

c 

c

c 

c 

c 

c 

477

306

c 

99

307

106

if (icopy .ne 

call hdcopy 

cont i nue

kop) go to 452

selected portion of plot can be enlarged

call movabs(30*730)

call anmode

print*"for an enlargement of a part of this plot* type y"

read (5*130) i rep

kk=kk+1

if (irep .ne. jes) go to 477

call movabs (30*720)

call anmode

print*"position cursor at lower left of desired area* type c"

call vcursr(ichar*x 1 *y 1)

call movabs (30*710)

call anmode

print*"position cursor at upper right of desired area* type c

call vcursr(ichar*x2*y2)

call dwindo (x1 *x2*y1 *y2 )

call erase

go to 303

more data or exit

call movabs (30*710)

call anmode

print*"to plot another

read (5*13D) i rep

if (irep .ne. jes)

if (icor .ne. jes)

call closer (13)

cont i nue

call erase

go to 380

file enter y for yes

go to 99 

go to 306

cont i nue

call closer 

closer 

c loser 

closer 

closer

cal I 

cal I 

cal I 

cal I

(10) 

(11 )

(14)

(15)

(16)

if (icor .ne. jes) 

cal I closer (13) 

write (o*106) 

format (7h good) 

call finitt (0*0)

go to 307

stop 

end
APPENDIX C 205

SUBROUTINE NAME: POS

Author: P. A. Fulton

Purpose of the program: pos reads the bordNM data 

file, which consists of a header card and a card with six 

x, y coordinate pairs. bordNM is the neat line around 

the map plot, and it serves to define the plot window.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call pos (ingd,xx,yy)

Arguments: 

ingd- The unit number assigned to the bordNM file

(This is an input value to the subroutine.) 

xx-An array containing six elements (The x coordinates are stored in it and passed as output from 

the subroutine.) 

yy-An array dimensioned 6 (The y coordinates are

stored in it and passed as output from the 

subroutine.)

Subroutines called: None

Common data referenced: None

Input files: bordNM

Output files: None

Arrays used: xx(6), yy(6)

Called by: pn16

Error checking and reporting: None

Constants: None

Program logic:

1. The program picks up the device number via the 

argument and reads the header and data images; 

then, it passes the x, y coordinates to the calling 

routine via the arguments and returns. This 

subroutine only accesses the file. The file opening, 

closing, and all other manipulations are done in the 

calling routine.

SUBROUTINE POS(Ii\GD,XX,YY)

DIMENSION X X ( 0) / Y Y ( 6 )

iE = o

REWIND INGD

320 READ (1NGD,111,END=89) IF,IFNO,ISF,ISFNO,IF1 

111 FORMAT (5Ib)

READ ( I N G D , 1 2 6 > <XX(I),YY(I),I = 1,IE> 

126 FOR.4AT (12F6.3) 

69 RETURN

END

SUBROUTINE NAME: PLO

Author: P. A. Fulton

Purpose of the program: plo plots solid outlines and

points for spatial data files that are structured the

same as the coorNM files. These are bordNM,

gridNM, statNM, and counNM. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call plo (in) 

Arguments: in-The unit number assigned to the file to

be plotted

Subroutines called: Tektronix plot routines- movea, ancho, drawa

Common data referenced: None

Input files: bordNM, statNM, counNM, gridNM

Output files: None

Arrays used: xx(6), yy(6)

Called by: pn16

Error checking and reporting: None

Constants: ichar = 43, rsiz = 0.3

Program logic:

1. This subroutine only reads the file and plots the data.

The file opening and closing procedures are done in

the calling routine.

SUBROUTINE PLO(IN)

DIMENSION X X ( 0 ) / Y Y ( 6 >

ICHAR=43

RSIZ=J.3

KEWliylD IN

IPEM=U
206 GEOINDEX

C PLOT DATA FROM FIRST SOURCE

419 CONTINUE

420 READ (IN/1 11/END=319) I F / I FNO / I S F / I S FIMO / I F 1 

111 F 0 R W A T (513) 

132 FORMAT (1X/5I5)

IPEN=IPEN+1

IF (I PEN .GT. 4) IPEN=1

NL=NL+1

IE=ISFNO

IF (ISF.MO .tit. 0) IE = o 

READ (IN/ 12o) (XX(I)/YY(I)/I=1/IE) 

126 FORMAT (12F6.3) 

127 FORMAT (1X/12F6.3)

IF (ISFNO .GE. 3) GO TO 448 

CALL M 0 tf E A (XX(2)/YY(2)) 

CALL ANCHO(ICHAR) 

GO TO 420

443

441

437

445

422 

433 

C

CONTINUE

CALL MCVEA (XX(2)/YY(2))

DO 441 K=2/IE

CALL DRAWA (XX(K) /YY (K ) )

CONTINUE

ISFNO=I bFNO-6

IF (1SFNO) 419/419/445

IF (ISFNO-o) <*2 2/422/4 33

IE=1SFNC

READ (IN/ 126/END = 8o) (XX(I)/YY(I)/ 1=1/ I E )

DO 442 K=1/IE 

CALL DRAWA (XX(K) /YY (K)) 

442 CONTINUE

IF (ISFNO-6) 419/419/437

88 CONTINUE 

319 CONTINUE

R t TURN 

t ,M D

SUBROUTINE NAME: PLOD

Author: P. A. Fulton

Purpose of the program: plod plots points and dotted

outlines for spatial data files that are structured the

same as the coorNM files. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call plod (in) 

Arguments: in-The unit number assigned to the file to

be plotted

Subroutines called: Tektronix plot routines- move a, ancho, dasha

Common data referenced: None

Input files: counNM

Output files: None

Arrays used: xx(6), yy(6)

Called by: pn16

Error checking and reporting: None

Constants: ichar = 43, rsiz = 0.3

Program logic:

1. This subroutine only reads the file and plots the data.

The file opening and closing procedures are done in

the calling routine.
APPENDIX C 207

419

420

111

132

SU3ROUTINE P L 0 D(IN)

bl PENSION X X(6)/Y Y(6)

RSIZ=0.3

I C H A R = 4 3

REWIND IN

IPEN=0

PLOT DATA FROM FIRST SOURCE

CONTINUE

READ (IN/1 11*END=319) I F* I FNO* I SF / ISFNO/ I F1

FORMAT (515)

FORMAT (1X*5I5)

IPEN=1PEN+1

IF (IPEN .GT. 4) IPEM=1

•ML = iML-H

IE=1SFNO

IF (ISFNO .iiE. 0) IE=6

REAJ (IN* 126) (XX(I)*YY(I)*I=1*IE)

126 FORMAT (12F6.3)

127 FORMAT (1X*12F6.3)

IF (ISFNO .GE. 3) GO TO 448 

CALL ilOVEA (XX(2)*YY(2)) 

CALL ANCHO(ICHAR) 

GO TO 420

440 CONTINUE

CALL MOVE A (XX(2)*YY(2))

DO <*41 K = 2,IE

CALL DAS HA (XX(O*YY(K)*1)

441 CONTINUE

437 ISFNO=ISFNO-t»

IF (ISFNO) 419*419*445 

445 IF (ISFNO-6) 422*422*433 

422 IE=ISFNO 

433 READ (IN* 126*END = 88) ( XX ( I )*YY ( I )* I = 1 * I E)

DO 442 K=1 /IE

CALL DASHA ( XX(K ) *YY ( K ) * 1 ) 

442 CONTINUE

IF (ISFNO-6) 419*419*437

88 CONTINUE 

319 CONTINUE 

RETURN 

END

SUBROUTINE NAME: PLOC6

Author: P. A. Fulton

Purpose of the program: plocG plots solid outlines, 

points, and identification numbers for spatial data 

files that are structured the same as the coorNM files.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ploc6 (in)

Arguments: in- The unit number assigned to the file to 

be plotted
208 GEOINDEX

Subroutines called: Tektronix plot routines- movea, anmode, ancho, drawa

Common data referenced: x1, y1, x2, y2 

Input files: gridNM used on unit 16 (file16) 

Output files: None 

Arrays used: xx(6), yy(6)

Called by: pn16

Error checking and reporting: None

Constants: ichar - 43, rsiz = 0.3, ipen = 0

Program logic:

1. This subroutine only reads and plots the data. The

file opening and closing procedures are done in the

calling routine.

419

420

111

132

SUBROUTINE PLOC6 (IN)

DIMENSION XX(6),YY(6)

COMMON X1,Y1,X2,Y2

ICHAR=43

RSIZ=0.3

IPE.M = 0

REWIND IN

CONTINUE

HEAD (IN,111,END=319) IF,IFNO,ISF,ISFNO, I F1

FORMAT (515)

FORMAT (1X,5I5)

IPEN=IPEN+1

IF (IPEN ,GT. 4) IPEN=1

126

127

137

450

421

IE=ISFNO

IF (ISFNO .GE. 6) IE=6

READ (IN, 126) (XX(I),YY(I),I=1,IE)

FORMAT (12F6.3)

FORMAT (1X,12F6.3)

IF (ISFNO .GE. 3) GO TO 421

IF ((XX(1 )

IF (( IFNO

CALL MOVEA

CALL ANMODE

WRITE (6*137) IF

FORMAT (1X,I5)

RY=YY (1 )-RSIZ

CALL MOVEA (XX( 1 ) ,RY)

CALL ANMODE

WRITE (6*137) ISF

CALL MOVEA ( X X ( 2 )

CALL ANCHO(ICHAR)

GO TO 420

.GE. X2) .OR. (YY(1) 

EQ. 1) .AND. (ISF .EQ 

(XX(1),YY(1 ))

GE. Y2)) 

1 )) GO

GO TO 

TO 450

420

Y Y ( 2 ) )

CONTINUE

CALL MOVEA (XX(1),YY(1))

CALL ANMODE

WRITE (6*137) IF

CALL MOVEA (XX(2),YY(2))

CALL ANCHO(ICHAR)

GO TO 420

CONTINUE 

IF ((XX (1 ) .LE. X1) .OR. (YY(1) .LE. Y1)) GO TO 448
APPENDIX C

IF «XX(1) .GE. X2) .OR. (YY(1) .GE. Y2)) GO TO 448

IF ((IFNO .EQ. 1) .AND. (ISF .EQ. 1)> GO TO 446

CALL MOVEA (XX(1 )*YY(1 ))

CALL ANMODE

WRITE (6*137) IF

RY=YY(1)-RSIZ

CALL MOVEA (XX(1)*RY)

CALL ANMODE

WRITE (6*137) ISF

IF (IF1 .EQ. 0) GO TO 448

RY=RY-RSIZ

CALL MOVEA (XX(1 )*RY)

CALL ANMODE

WRITE (6*137) IF1

GO TO 448

446 CONTINUE

CALL MOVEA (XX(1 )*YY(1 )) 

CALL ANMODE 

WRITE (6*137) IF

CONTINUE

CALL MOVEA (XX(2)*YY(2 ) )

DO 441 K=2*IE

CALL DRAWA ( XX(K ) * YY (K ) )

CONTINUE

ISFNO=lSFNO-6 

IF (ISFNO) 419*419*445 

IF (ISFNO-6) 422*422*433 

IE=ISFNO

READ (IN* 126*END=86) ( XX(I)*YY(I)* 1 = 1 * IE ) 

DO 442 K=1*IE 

CALL DRAWA ( XX(K ) *YY(K ) ) 

442 CONTINUE

IF (ISFNO-6) 419*419*437

83 CONTINUE 

319 CONTINUE 

RETURN 

EiJD

209

448

441 

C 

437

445

422

433

SUBROUTINE NAME: ASSOC

Author: R. W. Bowen

Purpose of the program: assoc performs the I/O functions necessary to access a file. These functions are attach, open, close, and detach.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call assoc (iunit,name,mode)

Arguments:

iunit- Fortran I/O unit

name- Name of disk file data set (may be passed as a 

character string literal with 8 characters, or as a 

double precision variable, or as a character string 

variable)

mode-"si" for formatted input, "so" for formatted 

output, "sqi" for unformatted input, "sqo" for unformatted output, "di" for keyed input, "do" for keyed 

output
210 GEOINDEX

Subroutines called: io_call

Common data referenced: None

Input files: Any file needed by user

Output files: None

Arrays used: None

Called by: pn16

Error checking and reporting: None

Constants: None

Program logic:

1. This subroutine performs the I/O functions of attach 

and open on the file passed to it as the name 

parameter when called by the entry assoc. When 

called via the entry point, closer, the subroutine 

closes and detaches the name file.

subroutine assoc (iunit/name/mode)

i un i t= for t ran 

name = name of

i / o numbe r

disk file data set. May be passed as a character 

string literal with 8 characters or as a double precision 

variable or as a character string variable

mode= "si " for formatted input

"so " for formatted output

"sqi " for unformatted input

"sqo " for unformatted output

"di " for keyed input

"do " for keyed output

character name*8/fname*6/mode*4/fmt*12 

fmt = "(4hfi le,i2) "

if (iunit .le. 9) fmt="(5hfiIeO,i1)" 

encode (fname/fmt) iunit

call i o 

call i o 

return

( "attach",fname,"vfile_ 

("open",fname/mode)

/name/"-append")

entry c loser(iunit)

endf ile i un i t

fmt="(4hfiIe,i2) "

if (iunit .le. 9) fmt = "(5hfiIeO,i1 )

encode (fname/fmt) iunit

call io ("close"/fname)

call io ("detach"/fname)

return

end

PROGRAM NAME: BIGSTA

Author: Harold Johnson

Purpose of the program: bigsta compiles statistics on

the reference and coordinate files. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: bigsta 

Arguments: None 

Subroutines called: ftnumber, out1_bigsta,

out2_bigsta, bigcal__bigsta 

Common data referenced: ncd

Input files: coorNM, cordNM, statNM, strdNM, 

counNM, curdNM, cntrNM, ctrdNM, gridNM, 

refNM, areaNM, redyNM, measNM, bordNM

Output files: Listing

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. The user is asked for the FIPS for the State whose 

files are being processed.

2. This number is concatenated with coorNM and 

cordNM that are then passed to out_bigsta,
APPENDIX C 211

which calculates the number of records in these 

files, the number of header cards, the number of 

data points, and the sum of the perimeters for 

these outlines. These data are written to the user.

3. The number of header cards is used by bigsta to 

compute the number of cards in comxNM. This is 

written to the user.

4. The State code is concatenated with statNM and 

strdNM and passed to out1__bigsta, which makes 

the same calculations for these files, writing the 

results to the user.

5. The same steps are used to process counNM and 

curdNM.

6. The same steps are used to process cntrNM and 

ctrdNM.

7. bigcal_bigsta is called directly to process 

gridNM.

8. The State code is concatenated with refNM and 

passed to out2__bigsta, which counts the cards in 

the reference file.

9. The user is asked whether there are more files to 

be processed. If she names one, ou1t2__bigsta is 

called to count its cards.

10. When no more files are to be processed, the program gives a grand total of the number of cards in 

all these files.

c ******* BIGSTA *******

c

external f tnutnber ( descr ip tor s ) , closer

c

common ncd

character state*2, iblank*!, filename*6, mode*4, outfile* 

\c6, no*6

c PROGRAM UPDATED AS OF DEC. 27, 1976 H. JOHNSON 

c 

c converted to Multics May 23, 1977 by h Johnson

data no/"no "/ 

data iblank/" "/

c THIS PROGRAM COMPILES STATISTICS ON THE FOLLOWING FILES: 

c COOR,CORD,COMX,STAT,STRD,COUN,CURD,CNTR,CTRD,GRID,PARA,REF, 

c FOR A USER-DESIGNATED STATE. IT ALSO ALLOWS 

c THE USER TO SPECIFY OTHER DESIRED FILES. 

c

c NCD WILL BE THE TOTAL NUMBER OF CARDS IN ANY OF THESE FILES. 

c

write(6,900)

900 format(" TYPE THE 2-D1GIT STATE CODE FOR THE STATE", 

&" BEING STUDIED. HIT RETURN.") 

read(5,910)state 

910 format(a2)

c

ncd = 0

c THIS ENABLES THE OPERATOR TO SELECT THE STATE.

c

c THE FIRST FILE IS COOR, FROM WHICH CORD AND COMX

c CAN BE EVALUATED.

c

encode(outfile,912)state

912 format ( If coor",a2)

encode(filename,913)state

913 format("cord",a2)

mode = "si " 

c

nfile - 10

call outl_bigst a(outfile,filename,mode,nheadr,nfile)
212 GEOINDEX

c OUT1 USES OUTFILE FILE TO WRITE THE OUTPUT FOR THE 

c COORDINATE FILE AND ITS RADIAN ANALOGUE. NHEADR 

c IS THE NUMBER OF HEADER CARDS IN THE FILE, 

c NHEADR IS USED NEXT TO FIND THE SIZE OF COMX 

c

ncd=ncd+nheadr 

c

write(6,920)state,nheadr

920 format("OTHE FILE comx",a2," IS ON ",15," CARDS.") 

c

c NOW DO STAT AND STRD. 

10 nfile = nfile + 2

encode(outfile,923)state

923 format("stat",a2)

encode(filename,924)state

924 format("strd",a2)

call outl_bigsta(outfile,filename,mode,nheadr,nfile) 

c

c NOW DO COUN AND CURD. 

20 nfile=nfile+2

encode(outfile,925)state

925 format("coun",a2 )

encode(filename,926)state

926 format("curd",a2)

call out l__bi gsta(outfile,filename,mode, nheadr,nfile) 

c

c NOW DO CNTR AND CTRD. 

30 nfile=nfile+2

encode(outfile,927)state

927 format( M cntr",a2)

encode(filename,928)state

928 format("ctrd",a2)

call out l__bi gsta(outfile,filename,mode,nheadr,nfile) 

c 

c NOW DO GRID.

encode(outfile,929)state

929 format( M grid",a2) 

40 nfile=nfile+2

call f tnumb er(nfile,outfile,mode) 

call bigcal_bigst a(nfile,perim,ncards,nrads,npoint,nheadr,outfile)

write(6,930)outfile,ncards,npoint,nheadr,perim

930 format("OTHE FILE ",a6," IS ON ",i5," CARDS AND INVOLVES 

\c",

&i6," DATA POINTS"/" FOR ",i4,"MAP OUTLINES OF TOTAL ",

&"LENGTH ,",f!0.3," INCHES.") 

c

ncd = ncd+n cards 

c

c NOW COUNT THE CARDS IN THE REMAINING FILES, 

c

encode(outfile,932)state,iblank
APPENDIX C 213

932 format("ref",a2,a 1 ) 

43 nfile-nfile+2

call out 2_bigst a(outfile,nfile,mode) 

c THIS SUBROUTINE RUNS THROUGH THE FILE OUTFILE 

c AND COUNTS THE CARDS. IT THEN WRITES THE TOTAL. 

c

encode(outfile,939)state 

939 format("area",a2) 

nfile = nfile + 2

call out 2_bi gsta(outfile,nfile,mode) 

c 

encode(outfile,933)state

933 format("redy",a2) 

nfile = nfile + 2

call out 2_bi gsta(outfile,nfile,mode) 

c 

encode(outfile,934)state

934 format("meas",a2) 

nfile = nfile + 2

call out 2_bigst a(outfile,nfile,mode) 

c 

encode(outfile,935)state

935 format("bord",a2) 

nfile - nfile + 2

call out 2_bigst a(outfile,nfile,mode) 

c 

c 

c

c NOW ASK THE USER IF THERE ARE ANY OTHER CARD FILES 

c WHICH HE WOULD LIKE COUNTED. 

c

50 write(6,940) 

940 format("GIF THERE ARE MORE CARD FILES TO BE COUNTED",/

&",TYPE THE NAME OF ONE. OTHERWISE, TYPE ""no"" AND",

&" HIT RETURN")

read(5,950)outfile 

950 format(a6 )

if(outfile .eq. no) go to 100 

60 nflle-nfile+2

call out2_bigsta(outfile,nfile,mode) 

go to 50 

c

100 write(6,960)ncd

960 format("0****** THE TOTAL NUMBER OF CARDS IN THESE FILES 

\cIS",ilO) 

c 

do 120 k - 10, nfile, 2

call clos er(k) 

120 cont inue 

c

end 

c ******* END BIGSTA *******
214 GEOINDEX

SUBROUTINE NAME: OUTUIGSTA

Author: Harold Johnson

Purpose of the program: out1__bigsta associates Fortran numbers with two file names. It also calls 

bigcal_bigsta to perform calculations on these files. 

It reports the results by writing a message to the user.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call outl_bigsta (outfile,filename,- 

mode,nheadr,nfile)

Arguments: 

outfile-The name of a coordinate file, such as

coorNM, statNM, counNM, or cntrNM 

filename-The name of the radian file that corresponds to the coordinate file outfile

nheadr-The number of header cards in outfile

nfile -A Fortran file number 

Subroutines called: ftnumber, bigcal_bigsta 

Common data referenced: ncd 

Input files: None 

Output files: None 

Arrays used: None 

Called by: bigsta

Error checking and reporting: None 

Constants: None 

Program logic:

1. Assoc is called to associate nfile to outfile.

2. bigcal_bigsta is called to compute the total 

perimeter of the outlines in outfile, the number of 

cards in outfile, the number of cards in filename, 

and the number of header cards in outfile.

3. The results are reported to the user.

******* SUBROUTINE OUT1.BIGSTA *******

subroutine ou 11_bi gstaCoutfi le, f ilename,mode,nheadr,nfi Le)

character outfile*6, filename*6, mode*4

common ncd

c SUBROUTINE USED IN dIGSTA PROGRAM

c Converted to Multics May 24, 1977 by H Johnson

c

call ftnumberCnfi Le,outfile,mode) 

cal I bi gcal.bigstaCnfi le,perim,ncarcis,nrads,npoint,nheadr,outfi le)

wri te(6,9GO)outfi le,ncdrds,npoint,nheadr,perim

900

930

format("UTHE FILE ",a6," IS ON 

16," DATA POINTS "/" FOR ",i4," 

f10.3," INCHES.")

write(6,930)filename,nrads,npoint 

formatC'UTHE FILE ",a6," IS ON ",i5, 

16," DATA POINTS.")

",i5," CARDS 

MAP OUTLINES

AND INVOLVES ", 

OF TOTAL LENGTH ",

CARDS AND INVOLVES

c

1 10

*******

ncd=ncards+nrads+ncd

return 

end 

END OUT1_BIGSTA *******

SUBROUTINE NAME: OUT2_BIGSTA

Author: Harold Johnson

Purpose of the program: out2_bigsta is used to count

the records in a file. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call out2__bigsta (outfile,nfile,mode)

Arguments:

outfile- The name of a file

nfile- A fortran number that is to be associated with

outfile mode— Specifies input or output 

Subroutines called: ftnumber 

Common data referenced: ncd 

Input files: None 

Output files: None
APPENDIX C 215

Arrays used: None

Called by: bigsta

Error checking and reporting: Any read error is 

reported and control is returned to the calling program.

Constants: None 

Program logic:

1. Outfile is associated with the fortran number nfile.

2. Cards are successively read into (Al) format, one 

character per card, and counted.

c ******* SUBROUTINE OUT2_BIGSTA *******

SUD rout ine out2_bigsta(outfi le^nfi le^mode)

1

900

c 

100

910 

c

return

c

110 wr

920 fo

return

c

character outfile*6/ 

common ncd

mode *A

cat I ftnumberCnfi le^outfi le^mode)

kount = 0

read(nfile*900*end=100,err=110)a

fo rmat(a 1)

kount=kount+1

go to 1

cont i nue

write(6*91G)outfi le/kount 

formatC'OTHE FILE ",a6," IS

nc d = ncd + ko un t

ON ",i5," CARDS.")

ite(6*920> outfile 

rmatC'OTHERE SEEMS TO BE

end

AN ERROR IN THE FILE a6>

SUBROUTINE NAME: BIGCAL_BIGSTA

Author: Harold Johnson

Purpose of the program: bigcal_bigsta compiles 

statistics on the coordinate files and on their radian 

counterparts. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call bigcaLJngsta (nfile,perim,ncards,-

nrads,npoint,nheadr,outfile) 

Arguments:

nfile- A fortran file number 

perim- The total length in inches of the outlines in the

coordinate file with number nfile 

ncards- The total number of cards in nfile 

nrads-The total number of cards in the radian file

that corresponds to this coordinate file 

npoint-The total number of data points in the coordinate file or radian file

nheadr- The total number of header cards found in 

these files (which is used to tell the number of 

outlines)

Subroutines called: prim_bigsta, icards_bigsta, 

irads_bigsta

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: out1_bigsta, bigsta

Error checking and reporting: On a read error, control

returns to the calling program. 

Constants: None 

Program logic:

1. A record is read as a header card from nfile.

2. icards_bigsta is called to calculate the number of 

data cards that should follow for this header card.

3. irads_bigsta is called to calculate the number of 

data cards that should follow this header in the radian file.

4. ncards, nheadr, nrads, and npoint are updated.

5. prim_bigsta is called to calculate the length of the 

outline whose coordinate points follow, perim is updated.
216 GEOINDEX

c ******* SUBROUTINE dIGCAL.BIGSTA *******

subroutine bigcat_biysta(nfile,perim,ncards,nrads,npoint,nheadr,outfite) 

character outfile*6

SUBROUTINE USED IN MAIN PROGRAM "BIGSTA" 

UPDATED AS OF DEC. 27, 1976 H. JOHNSON

THIS SUBROUTINE COMPILES 

THE CORRESPONDING RADIAN

INITIATE

subroutine used in program bigsta. 

converted to multics May 23, 1977, H

pe r i m = U. 

nc ards = U 

nrads=0 

npo i nt = 0 

nh eadr = U

Johnson

c 

1 

900

read(nfile,900,end=10UO,err=1100)if,ifno,i s f , i sfno,not,nor,nif

fo rma t(7 i 5)

ic=icards_bigsta(isfno)

ncards=ncards+1+i c

ir = irads_bigsta(i sfno)

n rads = n rads + 1+i r

npoint=npoint+i sfno

nh eadr=nheadr+1

cat I prim_bigsta(nfi t e,i sfno,dist)

peri m = peri m + di st

d o to 1 

100U return 

c

1100 write(6,910)outf i te

910 formatC'UTHERE SEEMS TO BE AN ERROR IN FILE :",a6) 

return 

c 

c

end

FUNCTION NAME: IRADS_BIGSTA

Author: Harold Johnson

Purpose of the program: irads_bigsta calculates the

number of cards in a radian file that must be used to

contain isfno data points. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: ir = irads_bigsta (isfno) 

Arguments:

irads- The number of cards needed to hold isfno data 

points in a radian file

isfno—A certain number of data points 

Subroutines called: None 

Common data referenced: None 

Input files: None 

Output files: None 

Arrays used: None 

Called by: bigcal_bigsta 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Similar to icards_bigsta, except that only three 

data points can occur on radian coordinate files.
APPENDIX C

FUNCTION IRADS_6IGSTA ******* 

function irads.oigsta(isfno) 

i rads_bigsta=isfno/3

if(3*irads_bigsta .Lt. isfno)irads_bigsta=irads_bigsta+1 

return

217

*******

end 

END IRADS.BIGSTA *******

SUBROUTINE NAME: PRIM_BIGSTA

Author: Harold Johnson

Purpose of the program: prim_bigsta calculates the

length in inches of an outline in one of the coordinate

files (coorNM, statNM, counNM, gridNM). 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics

Calling sequence: call prim_bigsta (in,isfno,finch) 

Arguments:

in—A fortran file number

isfno— The number of data points on the next and 

following cards that describes an outline

finch—The length in inches of the outline described by

the data points 

Subroutines called: None 

Common data referenced: None

Input files: None

Output files: None

Arrays used: xx(6), yy(6)

Called by: bigcaL_bigsta

Error checking and reporting: None

Constants: None

Program logic:

1. First, the number of data cards that contain isfno 

points is calculated.

2. The first data card is read. If isfno is 2, control 

returns because the first data point is used to position characters that name the outline.

3. The length of the segments described by this first 

card is calculated.

4. If more cards remain in this outline file, they are read 

one by one, and their outlines are calculated and 

added to the running total.

910

******* SUBROUTINE PRIM_BIGSTA *******

subroutine prim_bigsta(in*isfno*finch)

subroutine used in main statistics program "bigsta 1 

converted to multics May 23* 1977 H Johnson.

dimension xx(6)*yy(6)

finch = 0.

ncard1 = i sfno/6

if(6*ncard1 .It. isfno) ncardl = ncardl

read(in/91U)(xx(i),yy(i),i =1*6)

format(12f6.3)

return

10

i I ast = is fno

if(isfno .eq. 2)

i last = 6

i f (isfno .11. 6)

do 10 k = 3/> ilast

finch=finch+sqrt((xx(k)-xx(k-1))**2+(yy(k)-yy(k-1))**2>

c ont i nue 

xI a s t = x x (6 ) 

ylast = yy(t>) 

if(ncard1 .eq. 1) return 

if (ncardl .eq. 2) go to 25 

n I =ncard1 - 1 

do 20 j=2/nl 

read(in,910)(xx(i),yy(i),i=1,6)
218 GEOINDEX

15

20

25

30

*******

finch=finch+sqrt((xx(1)-xtast)**2+(yy(1)-ytast)**2)

do 15 k = 2,6

finch = finch + sqrt((xx(k)-xx(k-1)>**2-Kyy(k)-yy(k-1>)**2>

cont i nue

x I ast = x x (6)

y t ast=yy (6)

con t i nue

read(in,91l»<xx(i>,yy(i>,i = 1,6>

ilast = isfno - (ncard1-1)*6

finch = finch + sqrt((xx(1)-xlast)**2«-(yy(1)-ytast>**2>

ifCilast .eq. 1) return

do 30 k = 2/ilast

finch=finch+sqrt((xx(k)-xx(k-1))**2+<yy(k)-yy<k-1>>**2)

cont i nue

return

end

END PRIH61GSTA ******

FUNCTION NAME: ICARDS_BIGSTA

Author: Harold Johnson

Purpose of the program: icards_bigsta is used to compute from the isfno number in a coordinate file the 

number of data cards that should follow in order to 

contain the indicated number of points.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: ic = icards_bigsta(isfno)

Arguments:

ic— The number of cards that are required to hold 

isfno data points

isfno-A certain number of data points

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: bigcal_bigsta

Error checking and reporting: None

Constants: None

Program logic:

1. A maximum of six data points are on each card, so 

icards_bigsta is isfno/Q unless 6 does not divide 

isfno, in which case one more card must be used.

******* FUNCTION ICARDS.BIGSTA ******* 

function i c ards.b i g s t a ( i sf no) 

i cards_bigsta=i sfno/6 

i f ( 6* i c a rd s_bi gs t a .It. i sf no) i car 

re turn

_b i gs t a = i c ards_bi gst a+1

*******

end 

END ICARDS.BIGSTA *******

EXEC_COM NAME: USMERG.EC

Author: P. A. Fulton

Purpose of the program: usmerg.ec, written in the 

Multics command language, takes as input a newly 

created indxNM file and appends it to the existing indxus. indxus is the GRASP file that contains all the 

States. The output file is named usall. At the end of 

the run it is dprinted for checking.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: ec usmerg NM 

Arguments: NM-FIPS code for the State 

Subroutines called: setmas, GRASP 

Common data referenced: None 

Input files: indxus, indxNM 

Output files: usall 

Arrays used: None 

Called by: None
APPENDIX C 219

Error checking and reporting: None 

Constants: None 

Program logic:

1. command^line is turned off.

2. Attach the exec_com to the program setmas.

3. The exec_com contains two responses to prompts in 

the program setmas.

4. When setmas is terminated, the program is detached 

from the exec_com.

5. The exec__com is attached to the program GRASP.

6. GRASP is executed. The exec_com contains responses 

to prompts made in GRASP.

7. Detach the files.

8. Quit.

&command_Iine off

& a tt a c h

se tmas

2 us o 1

yes

&det ach

&at tac h

grasp

i ndxus

append

us a I I

i ndx us

i ndxil

y

qui t

y

1/2

lidetach 

iqui t

PROGRAM NAME: STATE_TO_TAPE

Author: Harold Johnson

Purpose of the program: state_to_tape enables a

user to copy all the State files for one State onto a

backup tape, using IBM tape characteristics. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: state_to_tape 

Arguments: None 

Subroutines called: sts begin, heading_state_to_

tape, up_file_number, disk_to_tape_fb_-

retain.ec, disk_to_tape__vbs_retain.ec, list_-

statetape.ee, date_time 

Common data referenced: None 

Input files: bginNM, coorNM, cordNM, statNM,

strdNM, counNM, curdNM, gridNM, bordNM,

cntrNM, paraNM, redyNM 

Output files: None 

Arrays used: flle_name(12) 

Called by: None

Error checking and reporting: If the user has not sent a 

message to the operator to locate his tape, the program 

will abort.

Constants: None

Program logic:

1. The user is asked to type 1 if he sent a message to 

the operator to find his tape; otherwise, 0. The 

user's response is read into ians.

2. If ians does not equal 1, the program stops.

3. Prompt:

TYPE YOUR TAPE ID. 

The response is read into tape—number.

4. Prompt:

TYPE THE 2-DIGIT FEDERAL STATE 

NUMBER CODE FOR THIS STATE, USING 

FORMAT A2 

Response is read into state_number.

5. Prompt:

TYPE THE NAME OF THIS STATE. 

Response is read into state_name.

6. The user is asked which file number to use. The 

response is read into file—number.
220 GEOINDEX

7. Subroutine sts_begin is called to set up a temporary disk file that will contain a description of the 

records to be read into the bginNM file.

8. Subroutine heading_state_to_tape is called to 

set up file81 containing a description of the files 

being copied.

9. Call subroutine up_file_number.

10. Call disk_to_tape_fb_retain.ec.

11. Subroutines up_file_number and disk_to_- 

tape_vbs_retain.ec are called for the last three 

input files as they are recorded with the VBS tape 

option.

12. Call list_state_tape.ec, which prints out the tape 

label and the file name and numbers.

13. Call date_time.

14. End.

c PROGRAM state.to.tape

c

c PURPOSE: To enable a user to copy all the state files for one

c state onto a backup tape/ using IBM tape characteristics.

c

c PROGRAMMER: H Johnson

c DATE: Jan 13, 1978

c

character tape.nurober*6/ fi I e_name*4(12)/ fi I e_number*2

character state_number*2/ state_name*36* file*6 

c

data file_name/"bgin"/"coor"/"cord"/"stat"/"strd"/"coun"/"curd"/ 

"grid"/"bord"/"cntr"/" P ara"/"redy"/ 

c 

c

wri te(6/910)

91J forrnatC'OlF YOU HAVE SENT A MESSAGE TO SYS OP TO FIND YOUR"/ 

" TAPE/ TYPE 1; OTHERWISE/ TYPE 0")

read(5/915) ians 

915 format(i1)

ifCians .ne. 1) stop 

c

wri te(6/920) 

920 formatC'OTYPE YOUR TAPE 10:")

read(5/925) tape_number 

925 format(a6) 

c

wri te(6/927)

927 format("OTYPE THE 2-OIGIT FEDERAL STATE NUM8ER CODE"/ 

" FOR THIS STATE/ USING FORMAT A2"> 

read(5/928) state_number

928 format(a2) 

c

wri te(6/930) 

930 formatC'OTYPE THE NAME OF THIS STATE:")

read(5/935) state_name 

935 format(a36) 

c

write(6/940)

940 formatC'OTYPE THE FILE-NUMBER OF THE TAPE FILE JUST"/ 

" dEFORE THE PLACE WHERE YOU WANT TO BEGIN WRITING THIS STATE."/ 

"OIF YOU ArtE WRITING THE FIRST STATE ON THIS TAPE/ TYPE OO;"/ 

" IF ADDING TO A PREVIOUS STATE/ TYPE THE LAST FILE NUMBER;"/
APPENDIX C 221

" IF WRITING OVER A PREVIOUSLY WRITTEN VERSION/ TYPE THE FILE"/ 

" NUMBER JUST AHEAD OF THE PLACE WHERE YOU WANT TO BEGIN."/ 

"OPLEASE TYPE THIS NUMBER FORMAT A2:") 

C

read(5/945) file_number 

945 format(a2) 

c

C NOW SET UP A TEMPORARY DISK FILE WHICH WILL CONTAIN A 

c DESCRIPTION OF THESE RECORDS/ TO 3E READ INTO THE BGIN FILE, 

c

cal I sts_begin(state_number/state_name/file_number) 

C THIS SETS UP A FILE 81 CONTAINING A DESCRIPTION OF 

C THE FILES BEING COPIED, 

c

cat I heading_state_to_tape(state_number/tape_number) 

c

do 50 i=1/ 9

encode ( fi le/950) fi le.name(i )/ state_numoer 

950 format(a4/a2) 

c

call up_fiLe.number(fiIe_number) 

c

cal L ec ("disk_to_tape_fb_retain"/tape_number/fi le/fi le_number) 

c

50 con ti nue 

c

do 60 i=1O/ 12 

c 

encode(fiLe/950) fi le_name(i)/ state_number

call up_fiLe_number(fiLe_number) 

c

call ec (" disk .. to_ tape. vbs_ retain "/tape_number/fi le/fi L e_ number) 

c

60 cont i nue 

c

c THE LAST 3 FILES ARE RECORDED WITH THE VBS TAPE OPTION, 

c

call ec ("List_state_tape"/tape_number) 

c

call dat e_ t i me 

c 

c 

end

SUBROUTINE NAME: 

HEADING_STATE_TO_TAPE

Author: Harold Johnson

Purpose of the program: heading_state_to_tape

writes headings for the output of the state_to_tape

program. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call heading_state_to_tape 

(state,tape_number)

Arguments:

state-Two-digit FIPS State code 

tape_number- Six-position volume number

Subroutines called: None
222 GEOINDEX

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: state_to_tape

Error checking and reporting: None

Constants: None

Program logic:

1. Write to the terminal:

THE FOLLOWING DISK FILES FROM THE 

STATE WITH FEDERAL CODE NM HAVE 

BEEN STORED ON TAPE XXXXXX FOR 

BACK-UP:

2. Return control to state_to_tape.

c 

c 

c 

c 

c 

c

c 

wr

91 

c 

w r

92

"W 

«i

c 

c

re 

en

the name of this file is: heading_state_to_tape.fortran

subroutine heading_state_to_tape(state*tape_number) 

PURPOSE: TO WRITE HEADINGS FOR THE OUTPUT OF THE 

STATE-TO-TAPE PROGRAM.

programmer: H Johnson 

date: August 27, 1977

character state*2* tape_numoer*6

i te(6/-910)

0 formatC"0***************************************************")

i te(6*920)state,tape_number

0 forrnat("0"/.5X/."THE FOLLOWING DISK FILES FROM THE STATE "/- 

ITH FEDERAL CODE "/.a2/-/" HAVE BEEN STORED ON TAPE M /-a6/- 

FOR bACK-UP: M )

turn

d

SUBROUTINE NAME: UP_FILE_NUMBER

Author: Harold Johnson

Purpose of the program: up_file_number increments 

file^_number, given in character format, by 1 and 

returns the new value in character format.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call up_file__number (file_number)

Arguments: file—number- Numerical sequence on tape

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: state__to_tape, pull off

Error checking and reporting: None

Constants: None

Program logic:

1. Using the decode statement, the program reads if He 

from file—number and stores it into a format of

(12).

2. Add 1 to if He.

3. Using the encode statement, the program transmits

the value of if He to file^number. 

4 . Control is returned to the calling module.

c FILE NAME: up_fiIe_number.fortran

c

c PURPOSE: to increment a numoer* file.number* given in character format*

c by 1 and return the new value in character format.

c

c PROGRAMMERS Johnson

c DATE: August 27* 1977

c

subroutine up.file.number(fiIe_number)
APPENDIX C 223

character state*2/ tape_numDer*6/ fi le.numbe r*2 

9990 format("file.number = ",a4) 

c

decode(fi le_number/91 0)i file 

910 formatCi2) 

c

ifile = ifile + 1 

c

encode(file_number/91 0) ifile 

c

return 

end

SUBROUTINE NAME: STS_BEGIN

Author: Harold Johnson

Purpose of the program: sts_begin sets up a temporary disk file that will contain a description of the input records and will give the user the file number of 

each file written to tape.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call sts_begin (state, state_name,- 

file_number)

Arguments:

state -Two-digit FTPS code 

sfate_name-Name of the State 

file_number-Number of the tape file

Subroutines called: ftnumber, up_file__number

Common data referenced: None

Input files: None

Output files: File number: file81

Arrays used: None

Called by: state_to__tape

Error checking and reporting: None

Constants: None 

Program logic:

1. The file name bgin and the State code are concatenated by the encode statement to form 

bginNM.

2. Call ftnumber to open and attach file81 to bginNM 

for sequential input and output.

3. n = file^number + 1.

4. Prompt to file81:

THIS IS THE FIRST FILE FOR STATE 

NUMBER NM NAME STATE-NAME.

5. Prompt to file81:

BEGINNING IN TAPE FILE NUMBER n 

THE FOLLOWING STATE FILES ARE 

WRITTEN ON THIS TAPE!

6. Prompt to filed 1:

coorNM IS IN FILE NUMBER n. 

1. Add 1 to n.

8. Subroutine writes a message for the next file cordNM and repeats steps 7 and 8 until a message has 

been written for each input file.

9. Rewind 81.

10. Return control to state_to_tape.

suoroutine sts_begin(state/state_name/file.number) 

c

character state*2/ state_name*36/ file_name*6/ mode*4 

character n*2/ fi le_number *2 

c

encode(fi le_name/910) state 

910 f orfnat("bgin"/d2) 

c 

mode="so "

call ftnumber (6 1/fiIe_name/mode) 

c 

n = f i le_numbe r

call up_file_number(n) 

call up_fiIe_numDer(n) 

c

write (31/91 2 ) state/ state_name
224 GEOINDEX

912 format("This is the first file for state number "/a2/

" name "/a36)

c

wri te(81/92Q) n

920 formate"Beginning in tape file number "/a2/" the following state "/ 

"files are written on this tape:")

wri te(81/925) state/ n 

925 format("coor"/a2/" is in file number M /a2)

call up_fiIe_number(n) 

c

wr ite(81/935) state/ n 

935 format("cord"/a2/" is in file number M /a2)

call up_fi I e_number(n) 

c

write(81/940) state/ n 

940 format("stat"/a2/" is in file number "/a2)

call up_fiIe_number(n) 

c

write(81/9A5) state/ n 

945 f ormatC'st rd"/a2/" is' in file number M /a2)

call up_fiIe_number(n) 

c

write(81/950) sta te/ n 

950 formatC* coun"/a2/" is in file number M /a2)

call up_f i I e_nurnbe r ( n) 

c

write(81/955) state/ n 

955 format("curd"/a2/" is in file number "/a2)

call up_fiIe_numoer(n) 

c

wr i te(81/960) state/ n 

960 formatC'yr id"/a2/" is in file number "/a2)

call up_fiIe_number(n) 

c

wr i te(81/965) state/ n 

965 format("bord"/a2/" is in file number "/a2)

call up_fiIe_number(n) 

c

write(81/970) state/ n 

970 f ormatC'cnt r",a2/" is in file number If /a2)

call up_fiIe.number(n) 

c 

c

wri te(81/975) state/ n 

975 formatC* para "/a2/" is in file number M /a2)

call up.file_number(n) 

c

wri te(31/9oO) state/ n

980 format("redy"/a2/" is in file number "/a2) 

c 

endf i le 81

call c loser(81) 

c

return 

end
APPENDIX C 225

Subroutines called: None

Common data referenced: None

Input files: bginNM, coorNM, cordNM, statNM,

strdNM, counNM, curdNM, gridNM, bordNM 

Output files: Input files are put on tape. 

Arrays used: None 

Called by: state_to_tape 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Using the COPY_FILE command and the I/O 

module, tape_ibm, the program writes the file to 

tape with a fixed block format, record length of 80. 

It is written in the file number designated by 

file—number with the name designated by file.

2. Control is returned to the calling module.

disk-to-tape-fb-retain.ec

cpf -ids "record_stredm_ -target vfiIe_ £<?" -ods "tape_ibm_ £1 -nb £3

-nm £2 -fmt fb -rec 80 -btc 8000 -den 800 -cr -ret all -rg"

EXEC_COM NAME: 

DISR_TO_TAPE_FB_RETAIN.EC

Author: Harold Johnson

Purpose of the program: disk_to_tape_fb_retain.ec

writes files to tape using fixed block format. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ec ("disk to tape fh retain",-

tape_number,file,file_number) 

Arguments:

tape_number- Six-position volume number

file-Name of input file

—number- Number of the file on tape

EXEC_COM NAME: 

DISK_TO_TAPE_VBS_RETAIN.EC

Author: Harold Johnson

Purpose of the program: disk_to_tape_vbs_retain.ec

writes files to tape using spanned record format 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ec ("disk_to_tape_vbs_retain",

tape number,file,file__number) 

Arguments:

tape_number- Six-position volume number

file- Name of the input file

file_number- Number of the file on tape

disk-to-tape-vbs-retain.ec 

cpf -ids "record_stream_ -Length 

&1 -nb i.3 -nm £2 -fmt fb -rec 

all -ry"

Subroutines called: None

Common data referenced: None

Input files: cntrNM, paraNM, redyNM

Output files: The input files are written to tape.

Arrays used: None

Called by: state_to_tape

Error checking and reporting: None

Constants: None

Program logic:

1. Using the COPY_FILE command and the I/O 

module, tape_ibm, the program writes cntrNM, 

paraNM and redyNM to tape using the spanned 

record format. The input description specifies a 

record length of 100.

2. Control is returned to the calling module.

100 -taryet vfile. £2" -ods "tape_ibm_ 

100 -bk 8UOO -den 800 -cr -ret

EXEC_COM NAME: LIST_STATE_TAPE.EC

Author: Harold Johnson

Purpose of the program: list_state_tape.ec lists the

contents of the tape. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ec ("list_state_tape",

tape_number) 

Arguments: tape_number- Six-position volume

number

Subroutines called: None 

Common data referenced: None 

Input files: Tape used in state_to_tape module 

Output files: None 

Arrays used: None 

Catted by: state_to_tape, pull off 

Error checking and reporting: None 

Constants: None 

Program logic:

1. The command is LIST_TAPE_CONTENTS &1 

-LONG -IOM TAPE_IBM. The information
226 GEOINDEX

printed by this command is extracted from the tape 

labels.

2. The -long argument prints the file identifier (id), the 

file sequence number (number), the record format 

(format), the physical block size (blksize), the 

logical record length (Irecl), the encoding mode 

(mode), the file creation data (created), the file expiration date (expires), the file-set section number

(section), the file version number (version), the 

file generation number (generation), and the 

operating system that recorded the tape (system).

3. The -lorn argument invokes a system I/O module to 

attach and read the specified tape volume. The 

tape_ibm_ subroutine is specified in order to list 

OS standard labeled tapes.

4. Control is returned to the calling program.

I ist_tape_contents &1 -long -iom tape_ibm_

PROGRAM NAME: PULL_OFF

Author: Harold Johnson

Purpose of the program: pull_off enables the user to

pull off files from the Geoindex State files, and writes

the selected files to disk. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: pull_off 

Arguments: None 

Subroutines called: state_pull_off, separate_pull_-

off

Common data referenced: None 

Input files: User tape containing State files 

Output files: Files retrieved from the input tape 

Arrays used: None 

Called by: None

Error checking and reporting: None 

Constants: None

Program logic:

1. The user is informed that she must know the tape 

number, State number code, and file names, or she 

has the option of pulling off all the files for one 

State. If only selected files are to be pulled off, the 

user must know their file numbers on the tape, and 

the names and file numbers must be entered in 

ascending order according to the order on the tape.

2. Prompt:

NOW TYPE THE TAPE ID:

3. The user's response is read into tape_number.

4. Prompt:

IF YOU WANT THE ENTIRE SET OF FILES 

FOR A STATE, TYPE A 1; OTHERWISE, 

TYPE 0.

5. The users response is read into ians.

6. If ians is not equal to 1, go to step 8.

7. Call subroutine state__pull_off. Upon return, go to 

step 9.

8. Call subroutine separate—pull—off.

9. Stop.

c PROGRAM: pull. off

c

c PROGRAMMER: H Johnson

c DATE: Feoruary 14, 1978

c

c INPUT FILES: A user tape, containing state files.

c OUTPUT FILES: Whatever files were retrieved from the tape.

c

character t ape_number *32

wr i te(6,910) 

910 formatC" THIS 

11 BACK TO DISK."/ 

" *** WARNING: be

PROGRAM ENABLES YOU TO PULL OFF FILES FROM A TAPE"/

sure these files do not already exist"/ 

in your directory or in links to another directory!!!"/ "/

IT IS ASSUMED THAT THESE ARE FILES FROM OUR STATE FILES."/ 

YOU MUST KNOW THE TAPE NUMBER, STATE NUMBER CODE, AND FILE 

OR, YOU CAN PULL OFF ALL THE FILES FOR ONE STATE."/

NAMES"/
APPENDIX C 227

IF YOU WANT ONLY SOhE STATE FILES/ YOU MUST KNOW THEIR FILE NUMdER"/ 

11 ON THE TAPE. THEN YOU MUST ENTER THE NAMES AND NUMBERS IN "/

" INCREASING ORDER ACCORDING TO THE ORDER ON THE TAPE."/ 

»» ti /

" NOW TYPE THE TAPE ID :") 

c

read(5/920) tape.number 

920 format(a32) 

c

c NOW DETERMINE WHETHER OR NOT THE USER WANTS A WHOLE STATE. 

c

wri te(6/930)

930 format( M IF YOU WANT THE ENTIRE SET OF FILES FOR A STATE/"/ 

" TYPE A 1; OTHERWISE/ TYPE 0")

read(5/940) i ans 

9AO formatC i1)

if (ians .ne. 1) go to 20 

c

call state.pull_off(tape_number) 

go to 30 

c

20 call separate_pu I l_off(tape_number) 

c

30 cont i nue 

end

SUBROUTINE NAME: STATE_PULL_OFF

Author: Harold Johnson

Purpose of the program: state_pull_off determines

which States are to be retrieved from the tape and

then writes them to disk. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics

Calling sequence: call state_pull_off (tape_number) 

Arguments: tape_number-The six-position volume

number 

Subroutines called: tape__to_disk_fb_retain.ec,

tape_to_disk_vbs_retain.ec, up_file_number,

list state_tape.ec 

Common data referenced: None 

Input files: A user tape containing State files 

Output files: bginNM, coorNM, cordNM, statNM,

strdNM, counNM, curdNM, gridNM, bordNM,

cntrNM, paraNM, redyNM 

Arrays used: None 

Called by: pull_off 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Prompt:

TO RETRIEVE ALL THE FILES FOR ONE 

STATE, YOU MUST KNOW THE STATE

NUMBER CODE AND THE FILE NUMBER 

OF THE FIRST FILE FOR THE STATE AS 

IT OCCURS ON THE TAPE.

2. Prompt:

WHAT IS THE STATE NUMBER CODE? 

TYPE IT FORMAT 12.

3. Read the response into state.

4. Prompt:

NOW TYPE THE FIRST FILE NUMBER OF 

THE BGIN FILE FOR THIS STATE, FORMAT A2.

5. Read the response into file_number.

6. Using the encode statement, concatenate the name 

of the output file and the State code.

7. Call tape_to_disk_fb_retain.ec.

8. Call up_file_number subroutine.

9. Repeat steps 6-8 for the first nine output files.

10. Using the encode statement, concatenate the name 

of the file and the State number.

11. Call tape_to_disk_vbs_retain.ec.

12. Call subroutine up_file_number.

13. Repeat steps 10-12 for the last three output files.

14. Call lisLstate tape.ec to list the contents of the 

tape.

15. Return control to the calling program.
228 GEOINDEX

suuroutine state_pull_off(tape_number)

c

c SUBROUTINE USED IN pull.off

c PURPOSE: To determine what state's files are to be retrieved

c from a tape/ and then retrieve them.

c

character tape_numoer*32 r fiIe_number*2/ name*4(12) f fi I e*6/state*2 

data name/"bgin'^"coor"/"cord"/"stat"/"strd"/"coun"/"curd"/"grid"/ 

"bord"/"cntr"/"para"/"redy"/ 

c

wri te(6/910)

910 format(" TO RETRIEVE ALL THE FILES FOR ONE STATE/ YOU MUST"/ 

" KNOW THE STATE NUMBER CODE AND THE FILE NUMBER"/ 

" OF THE FIRST FILE FOR THE STATE AS IT OCCURS ON THE TAPE."/ 

"OWHAT IS THE STATE NUMBER CODE? TYPE IT FORMAT i2") 

c

read(5/920) state 

920 format(a2)

write(6/924)

924 formatC" NOW TYPE THE FIRST FILE NUMBER OF THE 8GIN FILE FOR"/ 

" THIS STATE/ FORMAT A2")

read(5/927) file_number 

927 format(a2) 

c

do 20 k = 1/ 9

encode(file/930) name(k)/ state 

930 format(a4/a2) 

c

cat I ec("tape_to_disk_fb_retain*'/tape_number/fi le/ f i le.number)

call up_fiIe_number(file_number) 

c

20 c ont i nue 

c

do 50 k = 10/12 

c

encode(file/930) name(k)/ state 

c 

c

ca I I ec ("tape_to_di sk_vbs_retain"/tape_number/file/file_number) 

c

call up_fiIe_number(file_number ) 

50 con t i nue 

c

call ec ("Iist_state_tape"/tape_numoer) 

c

call dat e_ t i me 

c

return 

end

SUBROUTINE NAME: SEPARATE_PULL_OFF Data base: Geoindex

Author: Harold Johnson Computer: Honeywell Series 60 (level 68)

Purpose of the program: separate_pull_of f determines Operating system: Multics

which State files are to be retrieved from tape and Calling sequence: call_separate_pull_off (tapethen writes them to the disk. number)
APPENDIX C 229

Arguments: tape^number- Six-position volume

number 

Subroutines called: tape_to_disk_fb_retain.ec,

tape_to_disk_vbs_retain.ec, list_state_tape.ec

Common data referenced: None

Input files: A user tape containing State files

Output files: Any one or more of the following: bginNM, 

coorNM, cordNM, statNM, strdNM, counNM, curdNM, gridNM, bordNM, cntrNM, paraNM, redyNM.

Arrays used: file_name 6(25), file_number 2(25)

Colled by: pulLoff

Error checking and reporting: None

Constants: None

Program logic:

1. Initialize k equal to 0.

2. k = k + 1.

3. Prompt:

TYPE THE NAME OF THE NEXT FILE YOU 

WANT:

4. Read the response into file_name(k).

5. Prompt:

TYPE THE FILE NUMBER OF THIS FILE, 

FORMAT A2

6. Read the user's response into file_number(k).

7. Prompt:

TO CONTINUE WITH MORE FILES, TYPE 

1, TO STOP, TYPE 0

8. Read user's response into ians.

9. If ians is equal to 1 go to step 2.

10. Using the decode statement, separate the file 

name from the State number.

11. If the file name is cntrNM, paraNM, or redyNM, go 

to step 14.

12. Call tape_to_disk_fb_retain.ec, which will write 

the files to disk using fixed block format.

13. Go to step 15.

14. Call tape_to_disk_vbs_retain.ec, which will 

write the files to disk using spanned record format.

15. Repeat steps 10-14 until all files have been written 

to disk.

16. Call list_state_tape.ec to list the contents of the 

tape.

17. Return control to the calling program.

subroutine separate_pull_o f f(tape_number) 

c

c PURPOSE: TO DETERMINE WHAT STATE FILES ARE TO BE RETRIEVED. 

C THEN RETRIEVE THEM, 

c 

c

character tape.numoer*32/ fi I e_name*6( 2 5)/ fi I e.number*2(25) 

c

character name*4/ number*2 

character i pa r a*4/i cntr*4/iredy*4

data icntr/"cntr"// ipara/"para"// iredy/"redy"/ 

c

k = u

10 k = k + 1 

c

wri te(6/910) 

910 formatC1 TYPE THE NAME OF THE NEXT FILE YOU WANT:")

read(5,92U) fiIe.name(k) 

920 format(a6)

wri te(6,930) 

930 fonnatC" TYPt THE FILE NUM3ER OF THIS FILE/ FORMAT A2")

read(5,940) fiLe_number(k) 

940 f o rma t(a2) 

c

wr i te(6/95u)

950 formatC' TO CONTINUE WITH MORE FILES/ TYPE 1/"/ 

" TO STOP/ TYPE U")

r ead(5/960 ) i an s 

960 formatCi1)

if (ians .eq. 1) go to 10
230 

c

GEOINDEX

do 50 j = 1 t k

C

decode(fiLe_name(j) t970 ) name* number 

970 format(a4,a2)

if (name .eq. icntr) go to 40

if (name .eq. ipara) go to 40

if (name .eq. iredy) go to 40 

c

cat I ec ("tape_to_disk_fb_retain"*tape_number,file_name(j) * f i Le. 

number(j))

go to 50 

c

40 call ec ("tape_to_disk_vbs_retain"/tape.number f fiIe_name(j) f fiIe_ 

number(j))

50 cont i nue 

c

call ec(" list _state_tape"*tape_ number) 

return 

end

EXEC_COM NAME: 

TAPE_TO_DISK_FB_RETAIN.EC

Author: Harold Johnson

Purpose of the program: tape_to_disk_fb_retain.ec

writes files to disk using fixed block format. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call ec ("tape_to_disk_fb__-

retain",tape number,file,file number) 

Arguments:

tape_number- Six-position volume number

///e-Name of the file

file_number-Number of the file on tape 

Subroutines called: None

Common data referenced: None

Input files: User's tape of the State files

Output files: Any one or all of the following: bginNM,

coorNM, cordNM, statNM, strdNM, counNM, curdNM, gridNM, and bordNM 

Arrays used: None

Called by: state_pull_off, separate_pull_off 

Error checking and reporting: None 

Constants: None 

Program logic:

1. Using the COPY_JFILE command and the I/O 

module, tape_ibm_, the program writes the 

selected file to disk, as determined by file and 

file—number.

2. Control is returned to the calling module.

tape-to-disk-fb-retain.ec

cpf -ods "record_stream_ -target vfile_ W* -ids "tape_ibm_ & 1 -nb S3

-nm &2 -fmt fb -rec 60 -ok 8JOO -den SOO -ret all "

EXEC_COM NAME: 

TAPE_TO_DISK_VBS_RETAIN.EC

Author: Harold Johnson

Purpose of the program: tape_to_disk_vbs_retain.ec

writes files to disk using spanned record format. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call ec ("tape_to_disk_vbs_

retain",tape_number,file,file_number) 

Arguments:

tape_number- Six-position volume number

file- Name of the input file

file_number- Number of the file on tape 

Subroutines called: None
APPENDIX C 231

Common data referenced: None

Input files: User^s tape of State files

Output files: cntrNM, paraNM, redyNM

Arrays used: None

Called by: state_pull_off, separate_pull_off

Error checking and reporting: None

Constants: None

Program logic:

1. Using the COPY_FILE command and the I/O 

module, tape_ibm_, program writes cntrNM, 

paraNM, and redyNM to disk if specified by file 

and file__number. The output description specifies, 

no new line.

2. Control is returned to the calling module.

tape-to-disk-vbs-retain.ec

copy.file -ids "tape.ibm_ il -nb S3 -nm &2 -fmt fb -rec 100 -bk 8000

-den 800 -ret all" -ods "record.stream, -nnl -taryet vfile_ fc>2"

PROGRAM NAME: BACKUP

Author: Harold Johnson

Purpose of the program: backup enables the user to 

dump various segments and (or) whole directories to a 

tape. They can have any file characteristic such as 

ASCII, binary, or whatever happens to be in the directory to be dumped.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: backup

Arguments: None

Subroutines called: backup.ec

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: None

Error checking and reporting: None

Constants: None

Program logic:

1. The program calls backup.ec.

c PROGRAM Dackup

c

c PURPOSE: TO ENAdLE A USER TO DUMP VARIOUS SEGMENTS AND WHOLE

c DIRECTORIES TO A TAPE

c

c PROGRAMMER: H Johnson

c DATE: Dec 29, 1977

c

call ec ("backup") 

c

c THIS IS THE EXEC COMMAND: 

c

c ba c k up1 

c io close f i le 1 U 

c io detach filelu 

c back up2 

c 

c 

end

EXEC_COM NAME: BACKUP.EC

Author: Harold Johnson

Purpose of the program: backup.ec calls two

routines and then closes and detaches the file. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68)

subOperating system: Multics

Calling sequence: call ec ("backup")

Arguments: None

Subroutines called: backup"!, backup2

Common data referenced: None

Input files: None
232 GEOINDEX

Output files: None

Arrays used: None

Called by: backup

Error checking and reporting: None

Constants: None

backup.ec

ba c kupl

io close f i I e 1 U

io detach filelO

backup?

Program logic:

1. This exec_com executes backup"!.

2. Control is then returned to the exec_com and fileW 

is closed and detached.

3. It then executes backup2.

EXEC_COM NAME: DUMP.EC

Author: Harold Johnson

Purpose of the program: dump.ec places segments or

directories, specified in backup*! , on tape. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics - 

Calling sequence: call ec ("dump","control.dump","hhj",-

tape) 

Arguments:

control.dump—Dump control file

hhj—Operator

tape—Tape number 

Subroutines called: None 

Common data referenced: None 

Input files: control.dump 

Output files:

*.dump.map

possibly an error file ending with .ef 

Arrays used: None

dump.ec

^attach

comp I e t e_dump

S3

&qu i t

Called by: backup2

Error checking and reporting: None

Constants: None

Program logic:

1. &ATTACH allows the arguments of the exec_com to 

be passed directly to complete_dump.

2. complete_dump requires a minimum of three 

arguments as in the command: complete_dump: 

control.dump, hhj-debug, where control.dump 

is the name of a control segment, hh] represents 

the author's initials, and -debug disables calls to 

highly privileged system subroutines normally 

used when complete—dump is used by the 

operators during the weeky system backup session. The argument tape is the volume identifier of 

the desired dump tape. One 2,400 ft. tape at 1,600 

bpi can hold approximatley 7,500 disk pages 

(records).

3. The segments or directories stored in control.dump 

are written to tape.

4. Quit.

-debug

SUBROUTINE NAME: BACKUP1

Author: Harold Johnson

Purpose of the program: backup"! allows a user to dump

various files and directories to a tape. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call backupl 

Arguments: None 

Subroutines called: None 

Common data referenced: None 

Input files: None

Output files: control.dump used on unit 10 (fileW) 

Arrays used: None

Called by: backup.ec

Error checking and reporting: The user will be asked 

whether he has sent a message to the operator to 

locate his tape. If the user answers with other than 1, 

the program will abort.

Constants: None

Program logic:

1. The user is asked whether a message was sent to 

locate his tape. If the user responds with 1, processing continues. Otherwise the program halts.

2. The program prints a message describing its purpose.

3. fileW is attached to control dump and opened for 

stream output.
APPENDIX C 233

4. The user is informed that segments or directories to 

be dumped must be absolute path names and in 

alphabetical order.

5. Prompt:

NOW TYPE IN THE ABSOLUTE PATH 

NAME OF THE NEXT SEGMENT OR 

DIRECTORY YOU WANT TO BACKUP. 

Type its absolute path name.

6. The user's response is read from the terminal and 

written to fileW.

7. Prompt:

IF YOU WANT TO DUMP MORE PATHS, 

TYPE 1; OTHERWISE, 0

8. The user's response is read into ians.

9. If ians is equal to 1, go to 5. 

10. Stop.

c PROGRAM oackupl

c

c PURPOSE: TO ALLOW A USER TO DUMP VARIOUS FILES AND DIRECTORIES TO

c A TAPE.

c

c PROGRAMMER: H Johnson

c DATE: Dec. 29, 1977

c

character pat h*60 

c

write(6,900)

900 formatC" DID YOU SEND A MESSAGE TO THE OPERATOR TO " 

"FIND YOUR TAPE?"/" IF YOU DID/ TYPE A 1 ")

read(5/920) ians 

i f(i ans .ne. 1) stop 

c

write(6/910)

910 format("OTHIS PRObRAM ENABLES YOU TO DUMP ONE OR MORE SEGMENTS"/ 

" TO YOUR TAPE. YOU CAN EVEN DUMP WHOLE DIRECTORIES. "/ 

" THE PROGRAM CREATES A FILE NAMEU 'CONTROL.DUMP 1 ") 

c

920 f o rma t < i 1 > 

c

call io ("attach","fiIe10"/"vfiIe_"*"contro I.aump") 

call io ("open","fi Ie10"/"so") 

c 

c

wr i te(6/945)

945 formatC'OYOU MUST TYPE IN ALL THE ABSOLUTE PATH NAMES OF"/ 

" THE SEGMENTS OR DIRECTORIES YOU WANT TO DUMP TO TAPE."/ 

"0*** THESE MUST BE ENTERED IN ALPHABETICAL ORDER !******") 

10 wri te(6/950)

950 formatC'O iMOW TYPE IN THE ABSOLUTE PATH NAME OF"/ 

" THE NEXT SEGMENT OR DIRECTORY YOU WANT TO BACKUP."/ 

"OTYPE ITS ABSOLUTE PATH NAME :")

read(5/960) path 

960 format(a60) 

c

wri te(6/970)

970 formatC'OlF YOU WANT TO DUMP MORE PATHS/ TYPE 1; OTHERWISE/ 0") 

read(5/920) i ans

wr i te(10/960) pat h 

i f(i ans .e^. 1) 90 to 10 

c 

c 

end
234 GEOINDEX

SUBROUTINE NAME: BACKUP2

Author: Harold Johnson

Purpose of the program: backup2 allows the user to

dump various files and directories to a tape. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call backup2 

Arguments: None 

Subroutines called: dump.ec 

Common data referenced: None 

Input files: None 

Output files: None

Arrays used: None

Called by: backup.ec

Error checking and reporting: None

Constants: None

Program logic:

1. Prompt:

TYPE YOUR TAPE NUMBER, FORMAT A6

2. The user's response is read into tape.

3. The program calls dump.ec.

4. The user receives a message that 1 or 2 message files 

have been added to her directory and will automatically be dprinted. These should be picked up 

and saved; any old dump.maps for this tape should 

be discarded because they are obsolete.

5. Stop.

PROGRAM backup^

PURPOSE: TO ALLOW A USER TO DUMP v/ARIOUS FILES AND DIRECTORIES TO 

A TAPE.

PROGRAMMER: H Johnson 

c b A T E : Dec. 29, 1977 

c

character t ape*6 

c 

c

wr i te(6/910) 

910 format("OTYPE 

c 

c

940 

c

YOUR TAPE NUMBER/ FORMAT A6")

read(5/940)tape 

format(a6)

call ec ("dump"

THIS IS THE EXEC 

ia11 ac h

/"control.dump","hhj"/tape) 

COM BEING CALLED:

c comp I ete_dump &1 £2 -debug

c S3

c &qui t

c

50 write(6,980)

980 formatC* OTHIS ROUTINE ADDS 1 OR 2 MESSAGE FILES TO "/

" YOUR DIRECTORY WHICH ARE AUTOMATICALLY DPRINTED."/

" THEY ARE VERY IMPORTANT AND SHOULD BE PICKED UP AND SAVED'

" IN A SAFE PLACE. "/

" THEY ARE THE DUMP.MAP AND POSSIBLE ERROR MESSAGE."/

"OSAVE THEM IN A SAFE PLACE. THROW AWAY ANY OLD DUMP.MAPS"/

" FOR THIS TAPE, SINCE THEY ARE COMPLETELY OBSOLETE.")

c

C

end
APPENDIX C 235

PROGRAM NAME: RESTORE

Author: Harold Johnson

Purpose of the program: restore allows the user to

restore files that she has previously dumped to tape

using complete^ dump or backup. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: restore 

Arguments: None 

Subroutines called: retrieve.ec 

Common data referenced: None 

Input files: User's backup tape 

Output files: control.retrieve used on unit 10 (fileW) 

Arrays used: None 

Called by: None 

Error checking and reporting: The user is asked whether

she sent a message to the operator asking her to locate

the tape. If the user responds with other than 1, the

program aborts. 

Constants: None 

Program logic:

1. fileW is attached and opened for sequential output.

2. Prompt:

DID YOU SEND A MESSAGE TO THE 

OPERATOR TO FIND YOUR BACKUP 

TAPE? IF YOU DID, TYPE A 1.

3. The program prints a message describing its purpose.

4. Prompt:

NOW TYPE THE ABSOLUTE PATH NAME 

OF THE NEXT SEGMENT OR DIRECTORY 

YOU WANT TO RESTORE WHICH IS ON 

YOUR BACKUP TAPE. USE ITS ABSOLUTE PATH NAME.

5. The response is read from the terminal and then 

written to fileW. You can request as many as 50 

absolute path names.

6. Prompt:

IF YOU WANT TO RESTORE MORE PATHS, 

TYPE 1; OTHERWISE 0

7. If ians is equal to 1, go to step 4.

8. Close and detach fileW.

9. Prompt:

TYPE THE NUMBER OF YOUR BACKUP 

TAPE, FORMAT A6 

Read the response into tape.

10. Call ec ("retrieve","control.retrieve",tape).

11. Message to the user:

THIS ROUTINE AUTOMATICALLY 

DPRINTS A 'RETRIEVE' MAP WHICH YOU 

SHOULD OBTAIN. CHECK THAT THE REQUESTED FILES ARE IN YOUR DIRECTORY.

12. Stop.

restore proy ram

PURPOSE: To allow a user to restore files which he has

previously dumped to a tape using compete_dump or backup

PROGRAMMER: H Johnson 

DATE: Jan 6/ 1978

character tape*6/ path*6U

cal I 

cal I

t o 

i o

("attach 

("open"/

/"f ilelO' 

fi lelO'V

/"vfile "/ 

so")

cont rol.retrieve")

MESSAGE 

YOU DID/

wri te(6/910)

910 formatC'ODID YOU SEND A 

" FIND YOUR BACKUP TAPE? IF

read(5/920) ians 

920 f o r m a t ( i 1 ) 

c

wri te(6/930)

930 format("OTHIS PROGRAM ENABLES 

" FILES FROM A BACKUP TAPE/ WHICH 

" OR backup. "/

"OYOU MUST KNOW THE COMPLETE PATH NAMES 

" TO RESTORE. *** THESE MUST BE TYPED

TO THE OPERATOR 

TYPE A 1")

TO"/

YOU TO RETRIEVE ONE OR MORE"/

WAS PROCESSED USING comp lete.dump"/

OF SEGMENTS YOU WANT"/ 

IN IN ALPHABETICAL ORDER ***'
236 GEOINDEX

10 wri te(6/940)

940 formatC'ONOW TYPE THE ABSOLUTE PATH NAME OF THE NEXT"/

" SEGMENT OR DIRECTORY YOU WANT TO RESTORE WHICH IS ON"/

" YOUR BACKUP TAPE."/

" USE ITS ABSOLUTE PATH NAME :")

read(5/950) path 

950 format(a6U) 

c

write (10/950) path 

c

wri teC6/970) 

970 formatC'OlF YOU WANT TO RESTORE MORE PATHS/ TYPE i; OTHERWISE/ 0")

read(5/920) ians 

i f C i ans . eq. 1) go to 10 

c

endfi Le 10

c THIS IS A MICKEY MOUSE STATEMENT TO GET A NL CHARACTER ON 

c THE END OF THE LAST RECORD, 

c

call io ("close"/"fiIe10")

call io ("detach","fiLe10") 

c

wri te(6/980)

980 formatC'OTYPE THE NUMBER OF YOUR BACKUP TAPE/ FORMAT A6") 

c

read(5/990) tape 

990 formdt(d6) 

c

call ec ("retrieve"/"controt.retrieve"/tape) 

c

c THIS IS THE FOLLOWING EXEC COMMAND: 

c

c Sattach

c retrieve &1 -debuy 

c &2 

c no

c dprint -dI &1.retrieve . map 

c igu i t 

c

wri te(6/991G)

9910 format("UTHIS ROUTINE AUTOMATICALLY DPRINTS A "RETRIEVE"/ 

" MAP 1 WHICH YOU SHOULD OBTAIN. CHECK THAT THE REQUESTED FILES"/ 

" ARE IN YOUR DIRECTORY.") 

c

stop 

end

EXEC_COM NAME: RETRIEVE.EC

Author: Harold Johnson

Purpose of the program: retrieve.ec consists of a Multics 

command that retrieves the path names given by the 

user from the tape specified by the user.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: ec ("retrieve","control.retrieve",tape)

Arguments:

control.retrieve-File of path names

tape— Tape number
APPENDIX C 237

Subroutines called: None

Common data referenced: None

Input files: control. retrieve

Output files: con trol. retrieve.map

Arrays used: None

Called by: restore

Error checking and reporting: None

Constants: None

Program logic:

1. The file is attached.

ret ri eve . ec

Sattach

retrieve &1 -debug

no

dprint -dl 

t

i1 . r e t r i ev e . map

2. The Multics command, retrieve, is executed.

3. The path names listed on the file control.retrieve are 

restored to the user's directory from the tape.

4. The retrieve command asks whether more tapes are 

to be reloaded, and the exec_com gives an 

automatic NO response.

5. The control.retrieve.map is automatically dprinted 

and deleted.

6. Quit.

PROGRAM NAME: VERPLOT

Author: Lawrence Balcerak

Purpose of the program: verplot generates the System 

Status Map for the Geoindex system. This program 

reads a file of commands and creates a Versatec plot 

file using the instructions from that file.

Data base: Geoindex

Computer: Honeywell series 60 (level 68)

Operating system: Multics

Calling sequence: verplot

Arguments: None

Subroutines called: change_origin, change—Symbol, 

change_width, closef, newpattern, openf, pattern, 

pattern_verplot, plotfile, plotlegend, plotoutline, 

scaleplot, cf, dprint, io_call, ioa_$nnl, plot, plots, 

setup_versaplot

Common data referenced: icom(80), in1

Input files: initials used on unit 15 (file15) (initial 

value file for the command file)

Output files: tempW used on unit 10 (fileW) (for 

messages)

Arrays used: iwhat(16,7)

Called by: None

Error checking and reporting: The program checks for 

invalid commands. Any invalid command causes an 

error message to be written along with the erroneous 

command line.

Constants: 

in1 = 15 (input reference number for the command

file)

in2 = 16 (input reference number for any plotting file 

used)

Program logic: 

1. Set initial values:

iwhat(16,7) (contains the names of the eight different kinds of commands in both uppercase and

lowercase) 

isym = 2 (the number of the default symbol to be

used for plotting single points) 

name = " " (blank space)

2. The program sends a message to the terminal:

WHAT IS THE NAME OF YOUR COMMAND 

FILE??

USE NO MORE THAN SIX CHARACTERS! 

Read the character string sent back into the 

variable name.

3. Call openf to attach and open the command file for 

input. Use in 1 as the reference number.

Call openf to attach and open tempW for output. 

Use reference number 10.

Call io_call to attach the initial values file to the 

name m/f_va/s.

4. Call setup_versatec. This links to the Versatec 

software.

5. Call pattern.

Call pattern_verplot.

These subroutines initialize the arrays for the 

13 shading patterns used.

6. Call plots to initialize the Versatec routines. 

Call plot to position the software origin.

7. Place blanks into the input line icom(80). 

Read a command line into icom(80). 

If EOF, go to step 27.

8. Find the semicolon in the input line and set // equal 

to this position.

If one is found, go to step 10. All commands must 

have a semicolon in the first eight positions.

9. The program prints the error message:

THIS LINE CANNOT BE IDENTIFIED AS A 

COMMAND.
238 GEOINDEX

along with the erroneous line. 

Go back to step 7 to read another command.

10. If // is equal to 1, 2, 3, or 4, go to step 9, because 

there are no commands with a semicolon in these 

positions.

Depending on the value of //, go to step 11 (// = 15), 

step 13 (// = 6), step 17 (// = 7), or step 23 (// - 8).

11. If the command is not PLOT or plot, go to step 9. 

This is the only four-letter command.

12. Call plotfile.

Go to step 7 to read another command line.

13. If the command is not SCALE or scale, go to step 

15.

14. Call scaleplot.

Go to step 7 to read another command line.

15. If the command is not REORG or reorg, go to step 

9.

16. Call change_origin.

Go to step 7 to read another command line.

17. If the command is not LEGEND or legend, go to 

step 19.

18. Call plot legend.

Go to step 7 to read another command line.

19. If the command is not SYMBOL or symbol, go to 

step 21.

20. Call change_symbol.

Go to step 7 to read another command line.

21. If the command is not LINWID or linwid, go to 

step 9.

22. Call change—width.

Go to step 7 to read another command line.

23. If the command is not OUTLINE or outline, go to 

step 25.

24. Call plotoutline.

Go to step 7 to read another command line.

25. If the command is not PATTERN or pattern, go to 

step 9.

26. Call newpattern.

Go to step 7 to read another command line.

27. The program sends a message to the terminal: 

PLOT FINISHED

28. Call plot (O.,0.,999) (frame finished).

Call plot (0.,0.,-999) (all plotting finished).

29. Call setup versaplot ("-reset") (unlinks from the 

Versatec software).

30. Call closef to close and detach from files in1 and 

fileW. 

Call io_call to detach the initial values file.

31. Dprint the message file with the delete option.

32. Call cf to close all files.

PROGRAM VERPLOT

common /

cnaracte

ex t erna L

data ( ( i

&/

^

&

&

4

&

£

&

&

&

£

S

&

&

&

&

coma nd/

r

i

&

&

wh

"S

"L

"0

"P

"S

"L

up

"R

"s

"L

"o

P

"s

"L

P

name*

o_c

cf

dp r

at (

ii ii

ii ii

ii ii

ii ii

ii ii /

ii ii f

it it

ii n

/

ii ii /

ii it

ii ii

/

ii ii

ii ii /

'

t

al

(d

i n

i /

C"

E"

U"

A"

Y"

I"

L"

E"

c"

e"

u"

a

y"

i "

L"

e

o

I

e

t

J

/

,

f

t

t

,

t

t

t

t

'

/

/

'

'

/

i com

/ fmt

(de

s c r i

(de

)/j =

"A"/

II r- It

II T It

II T II

" M " /

"N"/

"O"/

"O"/

"a"/

"g"/

" t "/

"m"/

"n"/

"o"/

o" /

(80)

*16/

sc r i

pt or

sc r i

1/7)

"L"/

"E"/

n i n

II -r It

"8"/

ii 1 1 n w /

II -r II

"R"/

"I "/

"e"/

"L"/

"b"/

"w"/

r " /

/ i

i c

Pt

s)

Pt

/ i

"E

"N

"I

"E

"0

"I

ii

"G

"e

"n

"i

e

"o

"i

"g

d(1 5)/ i sym/in1 /in2

om*1/iwhat*1 (16/7)/ini t*1

or s ) / i oa_$nn I (descriptor

/set up_ver sap lot (descrip

or s )

=1/16)

" f " "/" ",

"/"O"/" "/

It II .1 II II f- It / N / t /

It tl n It It »| It

/ L / /

II II r\ It II It

II II II II tl

It II II II It

tt II II II tt

"/"d"/" "/

"/"r"/"n"/

ii ii i n it ii

ii ii .j ii it ii

t f t

"/" "/" "/

s)/ 

tors) /

in1=15 

in2=16
APPENDIX C 239

caLL ioa.SnnL ("~/WHAT IS THE NAME OF YOUR COMMAND

caLL ioa_$nnL (""/USE NO MORE THEN SIX CHARACTERS!

read 10, name 

10 format (a6)

caLL openf (in1,name,"si ")

caLL openf (10,"temp10","so ")

caLL io_caLL (" attach"," initials ","vfile_

caLl setup_versapLot

caLL pattern

caLL pattern.verpLot

caLL pLots(0,0,0)

caLL pLot (2.0,0.005,-3)

FILE??")

)

V'init.vaLs")

25 do 30 i=1,80 

30 icom(i)=" "

read (in1,40,end=260) icom 

40 format (80a1)

do 50 L1=1,3

if (icom(LL) .eq. ";") go to 70 

50 continue 

55 write (10,60) icorn 

oO format (" THIS LINE CANNOT BE IDENTIFIED AS A COMMA NO.",/,1x,80a1)

go to 25 

70 go to (55,55,55,55,80,100,140,220),LI

80 do 90 i=1,4

90 if ((icom(i) ,ne. iwhat(7,i)) .and.

6 (icom(i) .ne. iwhat(15,i))) go to 55

caLL pLotfiLe

go to 25

100 do 110 i=1,5 

110 if ((icom(i) .ne. 

& (icom(i) .ne.

caLL scaLepLot

go to 25

120 do 130 i=1,5 

130 if ((icom(i) .ne. 

& (icom(i) .ne.

caLl change_origin

go to 25

iwhat(1,i)) 

iwhat(9,i)))

. and. 

go to 120

i wha t(3,i)) 

iwhat(16,i)))

and. 

go to 55

140 do 150 i=1,6 

150 if ((icom(i) .ne. 

& (i c om(i) ,n e.

caLL p Lot Legend

go to 25

160 do 170 i=1,6 

170 if ((i c om(i) .n e . 

& (i c om(i) .ne .

caLL change.symooL

go to 25 

200 do 210 1=1,6

iwhat(2,i)) .and.

iwhat(10,i))) go to 160

iwhat(5,i)) .and.

iwhat(13,i))) go to 200
240 GEOINDEX

210 if ((icom(i) .ne. iwhat(6/i)) .and.

& (icom(i) .ne. iwhat( 1 4 / i ) ) ) go to 55 

call change.width 

yo to 25

220

230

240

250

260

do 230 i=1/7

if ( (i com( i) .ne.

( i c om ( i ) .n e . 

call plot out Line 

yo to 25 

do 250 i=1,7 

if ( (i com( i) .ne.

(icom(i) .ne. 

call newpa 1 t e rn 

go to 25

i wha t(3/i )) .and.

iwhat (11,i))) go to 240

i wha t(4/i)) .and. 

iwhat(12/i))) go to 55

call ioa_$nnl (""/PLOT FINISHED")

call plot (0./0./999)

call plot (0./0./-999)

call setup_versaplot ("-reset")

call closef (i n 1 )

cal I c losef (10)

call io.call ("detach"/"init_vaIs")

call dprint ("-d I "/"templ0")

call cf ("-all")

stop

end

SUBROUTINE NAME: CHANGE_ORIGIN

Author: Lawrence Balcerak

Purpose of the program: change_origin identifies and 

evaluates the x and y distances for a change in the 

origin and moves the origin that distance.

Data base: Geoindex

Computer: Honeywell series 60 (level 68)

Operating system: Multics

Calling sequence: call change_origin

Arguments: None

Subroutines called: fincLnumber, plot

Common data referenced: icom(80), id(15)

Input files: None

Output files: tempW used on unit 10 (fileW) (for 

messages)

Arrays used: icom(80), id(15)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank keyword field, an error in a keyword, and an 

error in a data value. If any are found, an appropriate 

message is written to a file, which is dprinted at the 

end of the run.

Constants: None

Program logic:

1. Set initial values. The keywords for x and y are not 

necessarily both present. The default values for

both are 0. The first position to look for a keyword 

(ipi ace) is 7, because the command takes up 6 

spaces. The last nonblank character of the record 

is in position Hast, which is initialized to 81 to 

start.

2. Starting at the last position of the record (80), check 

in descending order for a nonblank character. If 

there is one, go to step 4.

3. The subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS 

and returns to the calling program.

4. Find the first nonblank character in this field and 

set i place equal to this position.

5. If ic = iplace to Hast, then find the end of the next

keyword by looking for a comma. 

Set ic equal to one less than the position of the comma or to Hast if none exists. This is the position of 

the last character in this field.

6. If the keyword is x= or X= go to step 11.

7. If the keyword is y= or Y= go to step 12.

8. The subroutine prints the error message:

THIS FIELD IS NOT RECOGNIZED AS A 

KEYWORD!! 

and the string involved.

9. Set iplace = ic + 2, which is the first possible position for the next keyword.
APPENDIX C 241

10. If there are more characters to check (compare the 

present position, iplace, with the last possible 

position, Hast), go to step 4. 

Otherwise, go to step 20.

11. Set the switch key equal to 1. 

Go to step 13.

12. Set the switch key equal to 2.

13. Add 2 to iplace. This is the first possible position for 

the data string.

14. Check for a nonexistent data string. If data string is 

nonexistent, go back to step 9.

15. Find the first nonblank character in this data string,

and if found go to step 16.

If the whole string is blank, set mum = 0, and go to 

step 19.

16. Set num equal to the number of characters in the

string. 

If num is greater than 15, go to step 18.

17. Place the character string in the array id.

Call find_number to translate the string into the

real number mum. 

If the error return code, istat, equals 0, go to step

19.

18. The subroutine prints the error message:

THIS STRING HAS AN UNRECOGNIZABLE 

CHARACTER

and the string involved. Then it returns to the calling program.

19. Depending upon the value of key, set xx (key = 1) or

yy (key = 2) equal to mum. 

Go back to step 10 to check for more data.

20. Call plot to change the origin.

21. The subroutine prints the message:

THE ORIGIN HAS BEEN MOVED BY X = nnn

Y = nnn 

Return

10

20

30

40

50

60

30

90

100

subroutine c han je_or i g i n

common /comand/ i com ( 80) 

character icom*1/id*1

xx = 0.

yy = o.

i p I ace = 7 

i last=81

i d ( 1 5 ) * i sym/ i n1 / i n2

FIND THE LAST NON-BLANK

do 10 i = i place/80

iIast = iI ast-1

i f (icom(ilast) .ne. " ")

write (10*20) i com

format (" THE FIELD CONTAINS

go to 240 

FIND THE FIRST NON-BLANK CHARACTER

do 40 m=iplace/i I ast

if (icom(m) .ne. " ") go to 50

m=i last

i pIace = m 

FIND THE LAST POSITION

do 60 ic = ipi ace /ilast

if (icom(ic) .eq. "/")

i c = iI as t

go to 80

i c = i c-1 

IDENTIFY THE KEYWORD

if (icom(ipiace + 1 ) .ne.

if ( (i com ( i p lac e ) .eq, 

& (icom(iplace) .eq

if (Cicom(ip I ace) .eq 

& (icom(iplace) .eq

CHARACTER OF THE RECORD

go to 30

ALL BLANKS"///1x/8Ga1 ) 

IN THIS FIELD

FOR THIS FIELD 

90 to 70

"="> go to 90

"X") .or. 

"x"» go to 1 10 

"Y") .or. 

"/">> go to 120

write (10/100) 

format (" THIS

(i com(i)/i=iplace/ic)

FIELD IS NOT RECOGNIZED AS A KEYWORD! !"///1x/74a1)
242 GEOINDEX

105

110

120

130

140

150

160

165

170

190

200

210

220

230

240

FIND THE FIRST POSTION IN THE NEXT FIELD

i pIace= i c + 2

if (ilast-iplace) 220,220,30

key = 1

go to 130

key = 2

i place= i place + 2

if (ic-iplace) 105,135,135 

FIND THE FIRST NON-BLANK CHARACTER FOR THIS DATA FIELD

do 140 num=ipi ace,ic

if (i com(num) .ne. ") go to 150

rnum=0.

go to 190

iplace=num

num = i c-iplace + 1

if (num .gt. 15) go to 165

1 = 0

do 160 i = i p I ac e,i c

i d( I) = i com(i)

call find_number (id,num,rnum,istat)

if ( i stat .eq. 0) go to 190

write (10,170) (icom(i),i=ipiace,ic)

format (" THIS STRING HAS AN UNRECOGNIZABLE

go to 240

go to (200,210),key 

x x = rnum 

go to 105 

yy = rnum 

go to 105

CHARACTER",/,1x,74a1)

call plot (xx,yy,-3) 

write (10,230) x x,yy 

format (" THE ORIGIN 

return 

end

HAS BEEN MOVED BY X=",f10.3,/,30x,"Y=",f10.3)

SUBROUTINE NAME: CHANGE_WIDTH

Author: Lawrence Balcerak

Purpose of the program: change—Width evaluates the

data string given and changes the line dot width to

that value. 

Data base: Geoindex 

Computer: Honeywell series 60 (level 68) 

Operating system: Multics 

Calling sequence: call change_width 

Arguments: None

Subroutines called: find—number, newpen 

Common data referenced: icom(80), id(15) 

Input files: None 

Output files: tempi0 used on unit 10 (fileW) (for

messages)

Arrays used: icom(80), id(15)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank data field and an error in a data value. If either 

are found, an appropriate message is written to a file, 

which is dprinted at the end of the run.

Constants: None

Program logic:

1. Starting at the last position of the record (80), check 

in descending order for a nonblank character. If 

there is one, go to step 3.

2. Subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS! 

and goes to step 7.

3. Find m, the first nonblank character in the field.

4. Set inum equal to the number of characters in the 

string. If inum is greater than 15, go to step 6.
APPENDIX C 243

5. Place the character string in the array id.

Call find_number to translate the string into the

real number mum. 

If the error return code, istat, equals 0, go to step 8.

6. Subroutine prints the error message:

THIS STRING HAS AN UNRECOGNIZABLE 

CHARACTER!!

7. Subroutine prints the message:

THE DEFAULT VALUE WILL BE USED!!

Set rnum - 1, which is the default line width.

8. Change the real number rnum to the integer Ms.

9. Call newpen to change the line width to Ms.

10. Subroutine prints the message:

THE LINE WIDTH HAS BEEN CHANGED

TO nn DOTS WIDE 

Return

subroutine chanye.width

common /comand/ icom(80)/id(15)/isym/in1/in2 

character icom*1/id*1

FIND THE LAST NON-BLANK CHARACTER ON THE RECORD

do 10 j=ti/60

num=83-j 

10 if (icom(num) .ne. " ") go to 30

write (10/20) icom 

20 format (" THE FIELD CONTAINS ALL BLANKS! "///1x/80aD

jo to 75

FIND THE FIRST NON-BLANK CHARACTER IN THE DATA FIELD 

30 do 40 m=8/num 

40 if (icom(m) .ne. " ") go to 50

m = nurn 

30 i num=num-m+1

if (inum .gt. 15) go to 75

1=0

do 60 i = m/num

1=01 

60 id(L) = i com(i)

call find.number (id/inum/rnum/istat)

if (istat .eq. 0) goto 90

write (10/70) (icom(i)/i=8/num)

70 format (" THIS STRING HAS AN UNRECOGNIZABLE CHARACTER* !" * I /1x/73a1 ) 

75 write (10/80) 

80 formdtC" THE DEFAULT VALUE WILL BE USED!!")

rnum=1 . 

90 i v i s=rnum+0.5

call newpen (i v i s )

write (10/100) i vi s 

100 format (" THE LINE WIDTH HAS CHANGED TO "/i2/" dots wide")

return

end

SUBROUTINE NAME: CHANGE_SYMBOL

Author: Lawrence Balcerak

Purpose of the program: change—Symbol evaluates the 

data string given and changes the number of the symbol (used in plotting all single points) to that value.

Data base: Geoindex

Computer: Honeywell series 60 (level 68)

Operating system: Multics 

Calling sequence: call change_symbol 

Arguments: None 

Subroutines called: find_number 

Common data referenced: icom(80), ld(15), isym 

Input files: None

Output files: tempi'0 used on unit 10 (fileW) (for 

messages)
244 GEOINDEX

Arrays used: icom(80), id(15)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank data field and an error in the data value. If 

either are found, an appropriate message is written to 

a file, which is dprinted at the end of the run.

Constants: None

Program logic:

1. Starting at the last position of the record (80), check 

in descending order for a nonblank character. If 

there is one, go to step 3.

2. Subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS! 

and goes to step 7.

3. Find ra, the first nonblank character in this field.

4. Set inum equal to the number of characters in the 

string. If inum is greater than 15, go to step 18.

5. Place the character string in the array Id.

Call find—number to translate the string into a real

number mum. 

If the error return code, istat, equals 0, go to step 8.

6. Subroutine prints the error message:

THIS STRING HAS AN UNRECOGNIZABLE 

CHARACTER!!

7. Subroutine prints the message:

THE DEFAULT VALUE WILL BE USED!! 

Set mum = 2, which is the number of the default 

symbol.

8. Change the real number mum to the integer isym.

9. Subroutine prints the message:

THE SYMBOL NUMBER HAS BEEN 

CHANGED TO nn

Return

subroutine chanye_symboI

common /comand/ icom(80)/id(15)/isyrn/in1/in2 

character icom*1/id*1

FIND THE LAST NO ,M -BLANK CHARACTER OF THE RECORD

do 10 j =o/<SU

num=38-j 

10 if (icom(num) .ne. " ") go to 30

write (10/20) icom 

20 format (" THE FIELD CONTAINS ALL BLANKS! " / / / 1 x /SO a1)

90 to 75

FIND THE FIRST NON-BLANK CHARACTER IN THE DATA FIELD 

30 do 40 m=8/num 

40 if (icom(m) .ne. " ") go to 50

m = n u m 

50 inum=num-m+1

if (inum .gt. 15) go to 75

1 = 0

do oO i =m/num

1=1+1 

00 i d( I)=i c om(i)

call find.number (id/inum/rnum/istat)

if (istat ,eq. 0) go to 90

write (10/70) ( icom(i ) /i=8/num)

70 format (" THIS STRING HAS AN UNRECOGNIZABLE CHARACTER!!"///1x/73d1) 

75 write (10/80) 

80 formatC' THE DEFAOLT VALUE WILL BE OSEDM")

rnum=2. 

90 i s ym=rnum + 0.5

if ((isym .It. J) .or. (isym .gt. 127) ) isym=2.

write (10/100) i sym 

100 format (" THE SYMBOL NUMBER HAS BEEN CHANGED TO M /i4)

re t jrn

end
APPENDIX C 245

SUBROUTINE NAME: SCALEPLOT

Author: Lawrence Balcerak

Purpose of the program: scaleplot evaluates the data 

string given and changes the scale to that value.

Data base: Geoindex

Computer: Honeywell series 60 (level 68)

Operating system: Multics

Calling sequence: call scaleplot

Arguments: None

Subroutines called: find_number, factor

Common data referenced: icom(80), id(15)

Input files: None

Output files: tempW used on unit 10 (fileW) (for 

messages)

Arrays used: icom(80), id(15)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank data field and an error in the data value. If 

either are found, an appropriate message is written to 

a file, which is dprinted at the end of the run.

Constants: None

Program logic:

1. Starting at the last position of the record (80), check 

in descending order for a nonblank character. If 

there is one, go to step 3.

2. Subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS! 

and goes to step 7.

3. Find m, the first nonblank character in the field.

4. Set inum equal to the number of characters in the 

string. If inum is greater than 15, go to step 6.

5. Place the character string in the array id.

Call find—number to translate the string into the

real number scale. 

If the error return code, istat, equals 0, go to step 8.

6. Subroutine prints the error message:

THIS STRING HAS AN UNRECOGNIZABLE 

CHARACTER!!

7. Subroutine prints the message:

THE DEFAULT VALUE WILL BE USED!! 

Set scale = 1.

8. Call factor to change the scale to the new value.

9. Subroutine prints the message:

SCALE CHANGED TO nnn 

Return

subroutine sccileplot

common /comand/ icom(80)/id(15)/isym/in1/in2 

chardcter icom*1 *id*1

c FIND THE LAST NON-BLANK CHARACTER OF THE RECORD

do 10 j=7/80

num=d7-j 

10 if (icom(num) .ne. " ") go to 30

write (10/20) icom 

20 format (" THE FIELD CONTAINS ALL BLANKS! "///1x/80aD

go to 75

c FIND THE FIRST NON-BLANK CHARACTER IN THE DATA FIELD 

30 do 40 m=7/num 

40 if (icom(m) .ne. " ") go to 50

m = num 

50 inurn = num-m+1

if (inum .gt. 15) go to 75

1=0

do 60 i =m/n urn

1 = 1 + 1 

60 i d(I) = i com(i)

call find_nurnber (id/inum/scale/istat)

if (istat .eq. 0) go to 90

write (10/70) (icom(i)/i=7/num)

70 format (" THIS STRING HAS AN UNRECOGNIZABLE CHARACTER! !"/// 1 x/74a 1 ) 

75 write (10/80) 

80 formatC' THE DEFAULT VALUE WILL BE USED!!")

sea Le = 1 .
246 GEOINDEX

91) call factor (scale)

write (10/100) scale 

100 format ( " SCALE CHANGED 

return 

end

TO ",f1G.3)

SUBROUTINE NAME: PATTERN_VERPLOT

Author: Lawrence Balcerak

Purpose of the program: pattern_verplot initializes

some of the shading pattern arrays used in verplot. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: pattern_verplot 

Arguments: None 

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: verplot

Error checking and reporting: None

Constants: None

Program logic:

1. The first three arrays are set to values whose bit patterns form the patterns needed. All other arrays 

are set to 0. These are used for the extra patterns 

that are defined by the user.

subroutine patter n_ verplot

common /userpat/

do 10 i=1,4 

ip13( i )=0 

1 0 cont i nue

do 20 i=1,16 

ip14(i )=0 

ip15( i)=0 

ip16(i)=0 

ip17(i)=0 

ip15(i )=0 

ip19( i )=0 

ip20(i)=0 

20 c ont i nue

ip11 ,ip12 ,ip13(4) * i p1 4 ( 1 6) si p1 5 (1 6) 

ip16(16),ip17(16),ip18(16),ip19(16),ip2G(16)

ip12 =

+2*16**6 +16**4 + 8*16

716

ip13(1)= 7*1b**d +11*16**6 -H3*16**4 +14 

& 1b*(l6**7 -H6**5 -H6**3 +1 6 +1 ) 

ip13(2)=ip12 

ip13(3)=ip13(2) 

ip13(4)=ip13(2)

return 

end
APPENDIX C 247

SUBROUTINE NAME: INTERPRET_DATA

Author: Lawrence Balcerak

Purpose of the program: interpret—data interprets 

numeric data strings on a record and returns the total 

number of data values on the record and the numeric 

value of each.

Data base: Geoindex

Computer: Honeywell series 60 (level 68)

Operating system: Multics

Calling sequence: call interpret—data (kind, 

numback, realval)

Arguments:

kind- Indicates type of data to be read on the cards 

numback- Number passed back to the calling program 

realval- The real value of the number

Subroutines called: find_number, find_octal_number

Common data referenced: icom(80), id(15)

Input files: None

Output files: None

Arrays used: realval(20)

Called by: newpattern

Error checking and reporting: The subroutine checks for 

blank data fields, empty data fields, data fields too 

long, and errors in a data field. If such data fields are 

found, the number for that field is set to 0 and the program continues.

Constants: None

Program logic:

1. Set initial values.

key = 1 (branching flag to show type of data); 1

indicates a real or integer value that is the

default. 

numback = 0 (the number of values returned to

calling program).

iplace = 1 (position to start processing). 

Hast = 81 (the last nonblank position of the

record).

2. If the data is in octal, kind = "0", set key = 2.

3. Starting at the last position of the record (80), check 

in descending order for a nonblank character. If 

there is one, go to step 5.

4. Set realval(1) = 0.

Return to calling program.

5. Find the first nonblank character in this field. 

Set iplace equal to this position.

6. Find the last position for this field. It will be just 

before the next comma or, if no commas are left, 

just before the last character, Hast.

7. Check for the possibility of two commas in succession, and if not found, go to step 8. Otherwise, go 

to step 15.

8. Set num equal to the number of characters in this 

field.

9. If num is greater than 15, go to step 15. This is an 

error and the default value will be used.

10. Place the character string in the array id.

11. If this is a real or integer number (key = 1), go to

step 12. 

If this is an octal number (key = 2), go to step 13.

12. Call find_number to translate the character string

into the real number rnum. 

Go to step 14.

13. Call f ind_octal_number to translate the character

string into the integer knum. 

Change the integer knum into the real number 

mum.

14. If the error return code, istat, is equal to 0, go to 

step 16. A nonzero value indicates some kind of 

error in translation.

15. Set rnum = 0, which is the default value when an 

error occurs.

16. Add 1 to numback, the number of data fields 

translated and also the index for the array 

realval. Store the number rnum in realval.

17. Set iplace = ic + 2, which is the next place past the 

comma (if there was one). If there is another data 

field, go to step 5 to continue.

Return.

subroutine i nte rp re t_cl at a ( k i nd/ numbac k / rea I va I)

common /comand/ icom(80) f id(15)/isym/in1/in2 

character icom*1,id*1 *kind*1 

dimension realval(20)

KIND INDICATES THE TYPE OF DATA TO 6E READ ON THE CARDS

DEFAULT VALUE=1 -EITHER INTEGER OR REAL 

key = 1 

numba c k = G 

i p I ace=1
248 GEOINDEX

c

c F

10

20

30

50

60

70

90

100

1 10

120

130

140

1 50

160

i last=81

if (kino .eq. "o") key=2

IND THE LAST NON-BLANK CHARACTER OF THE RECORD 

do 10 i = i p Lace/3C 

ilast = i last-1

if (icom(ilast) .ne. " ") go to 20 

reaIval(1)=0. 

return

FIND THE FIRST NON-BLANK CHARACTER IN THIS FIELD 

do 30 m=iplace/ilast 

if (icom(m) .ne. " ") go to 40 

m= i last 

i p I a c e = in

FIND THE LAST POSITION FOR THIS FIELD 

do 50 ic = ipLace/i I ast 

if (icom(ic) .eq. "/") go to 60 

i c = i Las t 

go to 70 

i c = i c-1 

if (ic-iplace) 140/90/90

njm = i c-i pIac e + 1

if (num .gt. 15) go to 140

1 = 0

do 100 i = i p I a ce / i c

i d(L) = i com(i)

go to (110/120)/key

call find_number ( i d/n urn/mum/i s t a t)

go to 130

call find_octal_number (id/num/knum/istat)

rnum= knum

if C i stat .eq. 0) go to 150

r n u iti = 0 .

numoack=numback+1

realval(numback)=rnum

i pIac e= i c + 2

if (ilast-iplace) 16U/160/20

return

end

SUBROUTINE NAME: NEWPATTERN

Author: Lawrence Balcerak

Purpose of the program: newpattern reads and interprets data values representing some shading pattern, 

which is then stored in an array and which can be accessed by the program at a later time.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call newpattern

Arguments: None

Subroutines called: find_number, interpret—data

Common data referenced: icom(80), id(15), in1] some entries in I pat/ and luserpatl, depending on the shading 

patterns used

Input files: Command statements used on unit 15 

(file15)

Output files: tempi0 used on unit 10 (fileW) (for 

messages)
APPENDIX C 249

Arrays used: keyword(10,7), new(112), newval(16), 

realval(20)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank data field, an invalid keyword, data value 

error, invalid reference number, wrong number of 

words, missing keyword, too many data values, and 

not enough data values. If any such errors are found, 

an appropriate error message is printed with, 

sometimes, the character string involved.

Constants: None

Program logic:

1. Set new(1) equivalent to ip14(1). This causes the 

array new to overlay some entries of the common 

block luserpatl and thereby enables the program 

to access these entries by just changing the index 

for the array.

2. Set initial values. keyword(10,7) contains the different keywords possible. There are five 

keywords, and each is in both uppercase and 

lowercase.

Set ir = 0. This is the flag for processing of the 

reference number keyword.

Set in = 0. This is the flag for processing of the 

number of data points keyword.

Set it = 0. This is the flag for processing of the type 

of data keyword.

Set key = 0. This is the branching switch.

Set iplace = 9. This is the first position that a 

keyword can start.

Set Hast = 81. This is the position of the last 

nonblank character of the record.

3. Starting at the last position of the record (80), check 

in descending order for a nonblank character. If 

there is one, go to step 5.

4. Subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS 

and returns to the calling program.

5. Find the first nonblank character in this field and 

set iplace equal to this position.

6. For Ic = iplace to Hast, find the end of the next

keyword by looking for a comma. 

Set ic equal to one less than the position of the comma or to Hast if no comma is found. This is the 

position of the last character in this field.

7. Search the field for the character " = ". If one is 

found, go to step 10. 

Any keyword must have this character.

8. Subroutine prints the error message:

PATTERN: THIS FIELD IS NOT RECOGNIZED AS A KEYWORD 

along with the erroneous field.

9. Set iplace = ic + 2, which is one position past the 

comma.

If there are more characters to examine, go to step 

5. Otherwise, go to step 33.

10. Set // equal to the count of characters including the

= of the keyword.

If // is greater than 8, go to step 8. No keyword 

has more than 8 characters.

11. If // is equal to 1, 2, 3, 4, or 6, go to step 8. There is

no such keyword. 

If // is equal to 5, go to step 12. 

If // is equal to 7, go to step 19. 

If // is equal to 8, go to step 21.

12. To reach this step, the keyword contains 5 

characters including the =. 

If the characters are not TYPE or type, there is an 

error, so go to step 8.

13. Add 5 to iplace, one character past the =.

Check for a comma immediately following the = or

for no more characters in the string. 

If either condition is found, go to step 9 to examine

the next field.

14. Check for a blank data field. If found, go to step 9 to 

look at the next field. Otherwise, set iplace equal 

to the first nonblank character and to go to next 

step.

15. If the characters are not INTEGER or integer, go to 

step 17.

16. Set it = 1 (flag for type keyword processed).

Set kind = "i". This indicates integer data when

calling interpret_data later. 

Go to step 9 to examine the next data field.

17. If the characters are not OCTAL or octal, go to 

step 8. This is an error message of some sort.

18. Set it = 1. This is the flag for type keyword processed.

Set kind = "0" (indicates octal data). 

Go to step 9 to examine the next field.

19. If the characters are not REFNUM or refnum, go to 

step 8. This is an error of some kind.

20. Set key = 1. This is the branching switch used later

to indicate the reference number. 

Add 7 to iplace (one postion past the =). 

Go to step 23 to interpret the number.

21. If the characters are not NUMWORD or numword, 

go to step 8. This is an error of some sort.

22. Set key = 2, which is the branching switch used

later to indicate the number of data points. 

Add 8 to iplace, which is one position past the =.

23. Check for a comma immediately following the = 

character or for no more characters in the string. 

If either condition is true, go to step 9 to examine 

the next field.

24. Check for a blank data field. If found, go to step 9 to 

examine the next data field. Otherwise, set iplace 

equal to the first nonblank character and go to 

next step.
250 GEOINDEX

25. Set num equal to the number of characters in the 

field. If num is greater than 15, go to step 27. The 

field is too large.

26. Place the characters in the array id.

Call find__numbers to evaluate the data. The

returned value is in mum. 

If the error return code, istat, equals 0, go to step

28. A nonzero value indicates an error of some

type when interpreting.

27. Subroutine prints the error message:

PATTERN: THIS STRING HAS AN UNRECOGNIZABLE CHARACTER 

along with the erroneous field. 

Go to step 9 to examine the next field.

28. Depending on the value of key, go to step 29, key = 

I, or step 31, key = 2.

29. Set numref = mum.

Set ir = 1. The flag indicates that the reference 

number has been processed. If the reference 

number, numref, is equal to 14 through 20, go to 

step 9 to examine the next field.

30. The reference number is invalid. The subroutine 

prints the error message:

PATTERN: THE REFERENCE NUMBER

MUST BE FROM 14 to 20 

and returns to the calling program.

31. Set num word = mum.

Set in = 1. The flag indicates the number of data

words that have been processed. 

If numword is equal to 1, 2, 4, 8, or 16, go to step 9

to examine the next field. These values are all

even divisors of 16.

32. The subroutine prints the error message:

PATTERN: THE NUMBER OF WORDS 

MUST BE 1,2,4,8 or 16

and returns to the calling program. Note: At this 

point all keywords have been evaluated.

33. If all keywords have been processed, go to step 35.

34. Subroutine prints the error message:

THIS PATTERN WILL NOT BE PROCESSED THERE IS SOME KEYWORD MISSING!! 

and returns to the calling program.

35. Set iplace = I, which is the index for newval 

(always indicates the next value).

36. Read a data record into /com. If EOF, go to step 41. 

Call interpret—data to evaluate all data fields on 

the new record.

37. If the number of values already processed plus the 

number just received from interpret—data is less 

than or equal to the total number of data values 

required, numword, go to to step 39.

38. The subroutine prints the error message:

PATTERN: THERE ARE TOO MANY DATA 

VALUES!! 

and returns to the calling program.

39. Place the returned values into the array newval using iplace as an index counter. Add numback to 

iplace. It is now equal to the total number of data 

values interpreted.

40. If there are more data values to be interpreted, go 

to step 36 to read another record. If there are too 

many data values, go to step 38. If the number of 

values interpreted equals numword, to to step 42.

41. Subroutine prints the error message:

PATTERN: EOF REACHED WHEN TRYING 

TO READ ANOTHER RECORD!!

42. Place the new data values stored in newval into the 

common block by placing them into new(iplace), 

where iplace now takes on values based on the 

reference number, numref. There must be 16 

values placed into new.

If numword is less than 16, repeat the sequence of 

values until 16 values have been exchanged.

43. Subroutine prints the message:

NEW PATTERN ASSIGNED TO 

REFERENCE NUMBER nn

44. Return.

subroutine newpattern

common /comand/ icom(ttO)/id(15)*isym * in1 * in2

common /pat/ ip1 (16)*ip2 (16)*ip3(4) /ip4(4) * ip5(l6)*

4 ip6(16),ip7(l6),ip8(16),ip9(16),ip1G(16)

common /userpat/ ip11 *ip12 *ip13(4) * ip14(16)*ip15(16) 

& ip16(l6),ip17(16),ip18(16),ip19(16),ip2G(16) 

character icom*1,id*1/keyword*1(10/7)^kind*1 

dimension newd12)*newvaL(16)*realval(20)

equivalence (new(1)*ip14(1 ) )

data ((keyword(i*j)*j=1*7)/i=1*10)

<S,/"R M ^"E"^"F M x"N"^"U"^"M"^" f%

V

'u' 'M'
APPENDIX C 251

fir

& 

&

Of

Of

6

&

&

11 1"

,, 0 ,i

"n"

11 1"

u ^ u

"o"

/"Y"/

/"N"/ 

/"C"/

/"e"/

/ "u" /

/"y"/

/"n" /

/"c "/

11 T " , 

"T",

" m " ^

P -

r"E"

r"A"

p"n"

p"w"

r "e "

r "e"

p"a "

/ / /"G". 

/"L",

/ "u"^

/ " o " t

' '

/"g"^

p

, " E "

r

' "m"

p " r "

P

P " e "

>

1* o "

/ r\ /

/"d"/

/ r /

/ /

in = 0 

i t = 0 

k e y = 0 

i p I dc e = 9 

i Iast=tf1 

c

c FIND THE LAST NON-BLANK CHARACTER OF THE RECORD 

do 10 i = i pi ace/80 

ilast = i Last-1 

1U if (icom(Uast) .ne. " ") go to 30

write (1 U * 2 0 ) i c o m 

20 format (" THE FIELD CONTAINS ALL BLANKS"///1x/80a 1 )

return 

c

c FIND THt FIRST NON-BLANK CHARACTER IN THIS FIELD 

30 ao 40 m=ip lace/i last 

40 if (icom(m) .ne. " ") 90 to 50

m= i last 

50 i pIac e = m 

c 

c FIND THE LAST POSITION FOR THIS FIELD

do 60 ic = ipIace/i I ast 

oO if (icom(ic) .eq. " / ") go to 70 

i c = iI a s t 

go to 80 

70 ic=ic-1 

c

c IDENTIFY THE KEYWORD 

80 do 90 I l=iplace/ic

90 if (icom(ll) .eq. "=") go to 120 

95 write (10/100) (icom(i> * i= ipIace/ ic ) 

100 format (" PATTERN: THIS FIELD IS NOT RECOGNIZED AS A KEYWORD"/

& //1x/73a1) 

1 10 iplace=i c + 2

if (i last-iplace) 340/340/30 

c 

120 I 1 = 1 l-iplace + 1

if (II .gt. 8) go to 95 

go to (95/95/95/95/130/95/200/220)/lI 

c

c FIND THE TYPE OF DATA 

130 do 140 i=1/4 

140 if ((icom(ipIace+i-1) .ne. keyword(3/i) ) .and.

6 (icom(ipIace+i-1) .ne. keyword (6 /i))) go to 95 

i pIac e= i plac e + 5 

if (i c-iplace) 110/145/145
252 GEOINDEX

145

150

160

1 70

1 SO 

190

200

210

220

230

do 150 k = i p I ac e/i c 

if (icom(k) . ne . " 

go to 110 

i pIace= k 

do 170 i=1,7 

if ((icom(ipIace+i-1) 

& (i com(i pIac e+ i-1 ) 

i t = 1

kind="i" 

go to 110

190 i=1,5 

((ic

) go to 160

.ne. keyword(4 / i)) .and. 

.ne. keyword(9/i))) go to 180

do 190 i=1/5

if ((icom(ipIace+i-1) .ne. keyword(5/i)) .and. 

& (icom(ipIace+i-1) .ne. keyword(1O/i))) go t 

i t = 1

kind="o" 

go to 110

FIMD THE REFERENCE NUMBER FOR THE NEW PATTERN

do 210 i=1/6

if ((icom(ipIace+i-1) .ne. 

i (icom(ipIace+i-1) .ne.

key = 1

i p L ace= i p I ace + 7

go to 240

o 95

keywo rd(1/i)) 

keyword(6/ i)))

.and. 

go to 95

FIND THE NUMBER OF DATA POINTS

do 230 i = 1/7

if ((icom(iplace + i-1) .ne. 

& (icom(ipIace+i-1) .ne.

key = 2

iplace=iplac e + 8

keyword(2 / i)) .and. 

keyword(7/i))) go to

240

250

260

270

2dO

290

300

310

320

i f 

do 

if

go

ipl

num 

i f 

1=0 

do 

1 = 1

cat 

i f 

wr i 

for

go

(ic-iplace) 110/250/250

260 k= i pIac e/ i c

(icom(k) .ne. " ") go to 270

to 1 10

ace = k

= i c-i p I ace + 1

(num .gt. 15) go to 290

280 i=iplace/ic

+ 1

I) = i com(i)

I find_number (id/num/rnum/istat)

(i stat .eq. 0) go to 310

te (10/300) (icom(i)/i=iplace/ic)

mat (" PATTERN: THIS STRING HAS AN

* //1x/73a1) 

to 1 10

UNRECOGNIZABLE CHARACTER"/

go to (320/330)/key

numref=rnum+0.5

i r=1

if ( (num re f .ge. 14)

wri te (10/325)

.and. (numref ,le. 20) ) go to 110
325

330

335

340

350

APPENDIX C 253

format (" PATTERN: THE REFERENCE NUMBER MUST BE FROM 14 TO 20") 

return

numword=rnum+G.5 

in = 1

if ((numword .eq. 1) .or. (numword .eq 

.or. (numword .eq. 8) .or. (numword .eq 

write (10/335)

format (" PATTERN: THE NUMBER OF WORDS MUST BE 1/2/4*8 OH 16") 

return

2) .or. (numword 

16) ) go to 110

eq. 4 )

if ((ir .eq. 1) .and. (in .eg. 1) .and. (it .eq.

write (10/350)

format (" THIS PATTERN WILL NOT BE PROCESSED"///

&" THERE IS SOME KEYWORD MISSING!!") 

return

1) ) go to 360

3oO i p I ace = 1

370 read (in1 / 380/end = 420) icom

380 format (80a1)

call interpret_data (kind/numback/reatvat)

if ( (ipIace+numback-1) ,Le. numword) go to 400

385 write (10/390)

39J format (" PATTERN: THERE ARE TOO MANY DATA VALUES!!") 

return

400 do 410 i=1/numDack

410 newval(iplace+i-1)=reatval(i)+0.5

iplace=iplace+numback

i f ( i p I a ce-1-nurn word) 370/440/385

420 write (10/43u)

430 format (" PATTERN: EOF REACHED WHEN TRYING TO READ ANOTHER

RECORD! ! ") 

stop

440 k=16/numword

iplace=(numref-14)*16+1

do 460 i =1/K

do 450 j=1/numword

new(iplace) = newv/al(j ) 

45J ipLace=ipIace+1 

4 oU continue

write (10/470) numref 

470 format (" NEW PATTERN ASSIGNED TO REFERENCE NUM6ER"/i3)

return

enu

SUBROUTINE NAME: PLOTOUTLINE

Author: Lawrence Balcerak

Purpose of the program: plotoutline reads and evaluates 

keywords describing how a list of data points immediately following should be plotted. It will then read 

and interpret the data points and plot them.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call plotoutline

Arguments: None

Subroutines called: find_number, interpret—data,

plot, set_shade, tone 

Common data referenced: icom(80), id(15), in1
254 GEOINDEX

Input files: Command statements used on unit 15 

(file15)

Output files: tempW used on unit 10 (fileW) (for 

messages)

Arrays used: keyword(6,6), jshade(16), xx(20), yy(20)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank data field, an invalid keyword, data value error, too many data values, end of file, and missing 

keyword. If any such errors are found, an appropriate 

error message is printed with, sometimes, the 

character string involved.

Constants: None

Program logic:

1. Set initial values. keyword(6,6) contains the different keywords possible. There are three 

keywords, each in both uppercase and lowercase.

Set noline = 0, which is the flag for the noline 

option.

Set numpoint = 0, which is the number of points 

in the outline being plotted. It will be evaluated 

later.

Set numref = 0, which is the reference number of 

the pattern for the shading option.

Set key = 0, which is the branching switch.

Set kind = "r", which indicates real number. It is 

used when calling interpret data.

Set iplace = 9, which is the first position of record 

that keywords can start.

Set Hast = 81, which is the position of the last 

nonblank character of the record.

Set the arrays xx and yy = 0.

2. Starting at the last position of the record (80), 

check in descending order for a nonblank 

character. If there is one, go to step 4.

3. Subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS 

and returns to the calling program.

4. Find the first nonblank position in this field and set 

iplace equal to this position.

5. For ic = iplace to Hast, find the end of the next

keyword by searching for a comma. 

Set ic equal to one less than the position of the 

comma or to Hast if no comma is found. This is the 

position of the last character in this field.

6. If the characters are not NPOINT or npoint, go to 

step 8.

7. Add 7 to iplace, the character position past the =.

Set key = 1. This is the branching switch used

later to indicate the number of points in the

outline. Go to step 14 to interpret the data value.

8. If the characters are not SHADE or shade, go to 

step 10.

9. Add 6 to iplace, which is the character position 

past the =.

Set key = 2. This is the branching switch used 

later to indicate the reference number of shading. 

Go to step 14 to interpret the data value.

10. If the characters are not NOLINE or noline, go to 

step 12.

11. Set noline = 1. This is the flag to indicate that the 

outline is not to be plotted. Go to step 13.

12. Subroutine prints the error message:

OUTLINE: THIS FIELD IS NOT RECOGNIZED AS A KEYWORD! 

and prints the erroneous field.

13. Add 2 to iplace. This is the position where the next 

keyword could start. If there are more characters 

to check, go to step 4.

14. If the comma immediately follows the =, go to step 

13.

15. Find the first nonblank character in this data field. 

If there is one, set num equal to this position and

go to step 16.

If only blanks are in the data field, then set mum 

= 0, and go to step 20.

16. Set iplace = num, which is the position of the first

nonblank character in this data field. 

Find num, which is the number of characters in the 

data field. If num is greater than 15, go to step 19. 

The field is too long.

17. Place the character string in the array id.

Call find number to find mum, which is the 

numerical equivalent of the string.

18. If the error return code, is tat, is equal to 0, go to 

step 20. A nonzero value indicates an error of 

some kind in translation.

19. Subroutine prints the error message:

OUTLINE: THIS STRING HAS AN UNRECOGNIZABLE CHARACTER 

along with the erroneous data field. 

Go to step 13 to examine the next data field, if any.

20. On the basis of the value of key, go to step 21 (key = 

1) or go to step 22 (key = 2).

21. Set numpoint = mum. This is the number of data

points. 

Go to step 13 to examine the next data field (if any).

22. Set numref = mum. This is the reference number

for the new pattern. 

Go to step 13 to examine the next data field (if any).

23. If numpoint is greater than 0, go to step 25. A zero 

value indicates that the npoint keyword was not 

present.

24. Subroutine prints the error message:

OUTLINE: THE NUMBER OF POINTS WAS 

NOT GIVEN! THE OUTLINE WILL NOT BE 

PLOTTED 

and returns to the calling program.

25. Set iplace = 1, which is index for realval. It always 

indicates the next value to use.
APPENDIX C 255

26. Read a data record into /com. If EOF, go to step 31. 

Call interpret—data to evaluate all data fields on 

the new record.

27. If the number of values already processed plus the 

number just received from interpret—data is less 

than or equal to the total number of data values 

required, numpoint, go to step 29.

28. Subroutine prints the error message:

OUTLINE: THERE ARE TOO MANY DATA 

VALUES!! 

and returns to the calling program.

29. Place the returned values into the arrays xx and yy 

using iplace as an index counter.

30. If there are more data values to be interpreted, go 

to step 26 to read another record. If there are too 

many data values to be interpreted, go to step 28. 

If the number of values interpreted equals numpoint, go to step 32.

31. Subroutine prints the error message:

OUTLINE: EOF REACHED WHEN TRYING 

TO READ ANOTHER DATA RECORD!!

along with a list of the arrays xx and yy. 

Return to the calling program.

32. If noline is equal to 1, go to step 35. The outline is 

not to be plotted.

33. Call plot to move with pen up to the first coordinate.

Call plot to move with pen down from point to point 

through the coordinate arrays.

34. Subroutine prints the message: 

OUTLINE PLOTTED

35. If numref is equal to 0, go to step 38. A zero value 

signifies no shading is to be done.

36. Call set_shade to place the 16 words that correspond to the shading pattern identified by the 

reference number, numref, into the array jshade.

37. Call tone to set the shading pattern to that contained in jshade. 

Call tone to shade the outline. 

Subroutine prints the message: 

OUTLINE SHADED

38. Return

10

20

30

subroutine p lot out I i ne

common /com and/ icom(80)/id(15)/isym/in1/in2 

character icom*1 /id*1/keyword*1 (6/6)/kind*1 

dimension jshade(16)/xx(20)/yy(20)/realval(20) 

data ((keyword(i/j)/j=1/6)/i=1/6)

V / *• tki •• " D •• "A " " T •• " M " " T "

6f / N/r/U/1/N/ I /

II H/A" '* A

& " n "/ " p" r " o" / " i " / "n " / " t " / 

& " s "/ "h "/ "a" /"d" / "e "/ " '*/

&

II n/o*l/i/n/e/ _ II II _ II II I It M • II II _ II I* A II / 

no I i ne = 0 

numpo i n t = 0 

numref =0 

key = 0 kind="r" 

i p I ace = 9 

i last=81 

do 5 i=1/20 

xx ( i ) =0. 

yy(i)=0.

FIND THE LAST NON-BLANK CHARACTER ON THE RECORD

do 10 i = i place/ 3U 

i last = i last-1 

i f (icom(i last) .ne. " M ) 

write ( 1 0/20) i com 

format (" THE FIELD CONTAINS 

return

go to 30

ALL BLANKS"///1x/80a1)

FIND THE FIRST NON-BLANK 

do 40 m = iplace/i I ast

CHARACTER IN THIS FIELD
256 GEOINDEX

40

50

60

70

30

90

100

110

120

140

150

160

170

180

190

195

if (icom(m) 

m = iLast 

i pIac e = m

.ne . ) go to 50

CHARACTER IN THIS FIELD 

go to 70

FIND THE LAST NON-BLANK 

do 60 ic = ipI ace ,iLast 

if (icom(ic) .eq. ",") 

i c = i t as t 

go to 80 

i c= i c-1

IDENTIFY THE KEYWORD

do 90 i=1,6

if ((icom(ipIace + i-1) .ne. keyword(1 * i)) 

«i ( i com (i p I ac e + i -1 ) .ne. key word ( 4 * i ) ) )

i p L ac e= i p L ace+7

key = 1

go to 170

. and. 

go to 100

do 110 i=1,5 

if ((i com(i plac e + i-1) 

(i com(i pIac e + i-1) 

i plac e= i pIac e+6

key = 2

go to 170

do 130 i=1,6 

if ((i com(ip L ac e + i-1) 

(icom(iplace+i-1) 

no L ine=1 

go to 160

.ne . keyword(2,i)) 

.ne. key word(5,i)))

. and. 

jo to 120

.ne . keyword(3,i)) 

.ne. keyword(6,i)))

.and. 

go to 140

write (10,150) (icom(i),i = ipiace, ic ) 

format (" OUTLINE: THIS FIELD IS NOT

& /,1x,73a1> 

i pIace= i c + 2 

if (i last-iptace) 260,260/30

FIND THE FIRST POSITION FOR THIS DATA FIELD 

if (ic-iptace) 160,180,180 

do 190 num=ipi ace,ic 

if (icom(num) .ne. " ") go to 195 

rnum=0. 

go to 230

i p L ace = num

num = i c-i p I ac e + 1

if (nutn .gt. 15) go to 210

1=0

do 200 i=iptace,ic

200 id(l) = i com(i )

call find_number (id,num,rnum,istat) 

if (istat .eq. 0) go to 230

210 write (10,220) (icom(i),i=ipi ace,ic)

RECOGNIZED AS A KEYWORD!",
APPENDIX C 257

220 format (" OUTLINE: THIS STRING HAS AN UNRECOGNIZABLE CHARACTER"/

& //1x/73a1 )

go to 160 

c

230 go to (240/250)/key 

240 numpoint=rnum+0.5

go to 160 

250 numref=rnum+0.5

go to 160 

c 

260 if (numpoint .gt. 0) go to 280

write (10/270)

270 format (" OUTLINE: THE NUMBER OF POINTS IS NOT GIVEN!"/// 

&" THE OUTLINE WILL NOT BE PLOTTED.")

return 

c

280 iplace=1

285 read (in1/290/end=340) icom 

290 format (80a1)

call interpret_data (kind/numback/reaLvaL)

if ( (numback + ipLace-1) .Le. (2*numpoint) ) go to 320 

330 write (10/310) 

310 format (" OUTLINE: THERE ARE TOO MANY DATA VALUES!!")

return 

c 

320 do 330 i=1/numback/2

xx(iplace)=realvaL(i )

yy(iplace)=realvaL(i+1 ) 

330 ip I ace=ipi ace + 1

if (iplace-1-numpoint) 285/360/300 

340 write (10/350) (xx(i)/yy(i)/i=1/20) 

350 format (" OUTLINE: EOF REACHED WHEN TRYING TO READ"///

&" ANOTHER DATA RECORD!!"///20(2f10.3))

return 

c 

360 if (noline .eq. 1) go to 380

call plot (xx(1)/yy(1)/3)

do 370 i=1/numpoint 

370 call plot (xx(i )/yy(i)/2)

write (10/375)

375 format (" OUTLINE PLOTTED") 

380 if (numref .eq. U) go to 390

call set.shade (numref/jshade)

call tone (0 . /O./jshade/-16)

call tone (xx/yy/numpoint/1)

write (10/385)

385 format (" OUTLINE SHADED") 

390 return

end
258 GEOINDEX

SUBROUTINE NAME: FIND_OCTAL_NUMBER

Author: Larry Balcerak

Purpose of the program: find_octal_number finds the 

numeric value of a string of ASCII characters that 

represent an octal number.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call fincL_octal_number (id,num,- 

knum,istat)

Arguments:

id -The array of characters to be changed to a number 

num-The number of characters to be changed 

knum-The integer number that is returned 

1st at-The error return code (0 = no error; 1 = some 

kind of error in translation.)

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used:

id( 15) -Contains the characters to be used 

karacterfd)-Contains all possible legitimate octal 

characters

Called by: interpret—data

Error checking and reporting: Checks for too many 

characters and invalid characters. Any error causes 

the error return code to be set to 1 and a return to the 

calling program.

Constants: None

Program logic: 

1. Set inital values:

islgn = 0 (flag for negation).

istat = 0 (the error return code).

knum = 0 (the returned integer number).

2. If num is greater than 12, go to step 3. If num is 

equal to 12, go to step 4. If num is less than 12, go 

to step 6.

3. There is an error-either an invalid character or too

many characters.

Set istat = 1 (indicates an error). Return to the calling program.

4. If the octal character is not equal to 4, 5, 6, or 7, go 

to step 6.

5. Set Islgn = 1. An octal character value of 4 or more 

indicates a negative value because it has a 1 in the 

leftmost bit.

Do steps 6 through 10 for each character in turn (j = 

l,num).

6. Set k = num -j (the exponent for the octal number 

that represents the number times 8 raised to the 

kth power).

7. Search the array karacter for a match. No match indicates an error; go to step 3. If there is a match, i 

is one more than the value of the character being 

examined.

8. If islgn is greater than 0, go to step 10.

9. Add the numeric value represented to knum. 

Go back to step 6 to examine the next character (if 

any).

10. This is a negative number and is stored in two's 

complement. The two's complement of an octal 

number n is (7 -n). Add the complementary value 

to knum. Go back to step 6 to examine the next 

character (if any).

11. If islgn is equal to 0, go to step 13.

12. This must be a negative number. Add 1 to knum

(two's complement). 

Change the sign of knum.

13. Return

subroutine f i nd_oc t a l_number ( i a,num,knum, i s t at ) 

character i d * 1 ( 1 5 ) ,k ar ac t e r*1 (8 ) 

data ( k a rac t er ( i ) , i =1 t 8)

/ " 0 " / " 1 " , " 2

" " " " " " " " " " " 3 " , " 4 7 " /

i stat = 0 

knum=0

if (num-12) 30,20,10

TOO MANY CHARACTERS FOR AN OCTAL NUMBER 

1U istat=1 

return
20

APPENDIX C

TWELVE CHARACTERS, CHECK FOR NEGITIVE NUMBER

if ( (id(1) .ne. "4") .and. (id(1) .ne. "5") .and. 

«. .and. (id(1) .ne. "7") ) go to 30

i s i gn = 1

30 do 70 j=1*num 

K = n u nu - j 

do 40 i=1*8 

40 if (id(j) .eq. kdracter(i)) yo to 50

UNKNOWN CHARACTER 

go to 10

50 if ( i s i j n .yt. 0) go to 60

knum=knum-Ki-1) *8**k

go to 7u

60 knum=knum+(8-i ) *8**k 

?Q cont i nue

if (isign .eq. J) go to 80

knum= knum + 1

knurt»=-knum 

80 return

end

259

(id(1) .ne. "6")

SUBROUTINE NAME: FIND_NUMBER

Author: Lawrence Balcerak

Purpose of the program: find_number finds the 

numeric value of a string of ASCII characters 

representing either a real or integer value.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call find_number (id,num,rnum,istat)

Arguments: 

/c/-The array of characters to be changed to a

number, each element containing one character 

num-The number of characters to be changed; maximum number of characters, 15 

mum-The real number that is returned 

is tat-The error return code: 0 = no error; 1 = some 

kind of error in translation

Subroutines called: None

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: change origin, change symbol, 

change width, interpret—data, newpattern, plotfile, plotlegend, plotoutline, scale

Error checking and reporting: The subroutine checks for 

invalid characters, too many signs ( + or -), and too 

many decimal points. Any error causes the error

return code to be set to 1 and a return to the calling

program. 

Constants: None 

Program logic:

1. Set intital values:

mum = 0 (the returned real number).

nsign = 0 (the number of sign characters).

isign = 0 (flag for negation).

idot = 0 (the number of decimal points).

is tat = 0 (the error return code).

if actor = 0 (the number of decimal places in the

final value).

Do steps 2 through 9 for i = 1, num. These steps 

identify the character and set appropriate flags, 

counters, and values.

2. Search through jascii for a character match. If 

there is a match, set key equal to the index 

number and go to step 3. Otherwise, this is an invalid character; go to step 15.

3. If key is greater than 10, go to step 5. This 

separates the numeric characters from the others.

4. Subtract 1 from key. key now has the value of the 

character.

Multiply mum by 10 and add key. This gives the 

value of one more digit to mum). 

Go to step 2 to examine the next character (if any).

5. Subtract 10 from key.

Go to step 4, 6, 7, or 8, depending on the value of 

key.
260 GEOINDEX

6. Set isign = 1, which is the flag for negative value.

7. Add 1 to nsign, the number of signs found. If nsign 

is greater than 1, go to step 15. Otherwise, go 

back to step 2 to examine the next character, if 

any.

8. Add 1 to idot, the number of decimal points found. 

If idot is greater than 1, go to step 15.

9. Set ifactor = num - /, which is the place for the 

decimal point in the final value. Go back to step 2 

to look at the next character, if any.

10. If ifactor equals 0, go to step 12. The decimal point 

does not have to be moved.

11. Move the decimal point in mum to the left by ifactor places.

12. If isign equals 0, go to step 14. Check for negation.

13. Change the sign of rnum.

14. Return to the calling program.

15. Set istat = 1, which indicates some kind of error in 

translating the data string.

16. Return.

subroutine find.number(id/num/rnum/i stat) 

character id*1(15 ) f jascii*1(14)

data (jascii(i),i=1,14) /"O", "1" /" 2" ,"3" /" 4","5" ,"6",

on-711 "R" "o" " " "—" •• 4.•• ** "y

rnum=0. 

ns i gn = 0 

i s i gn = 0 

idot=0 

i stat = 0 

ifactor=0

IDENTIFY THE CHARACTER 

ao 100 i =1/num 

do 30 key=1/14

30 if (id(i) .eq. jascii(key)) go to 40 

go to 130

40 if (key .gt. 10) go to 50 

45 key=key-1

rnum=rnum*10.+key

go to 100 

50 key=key-10

go to (45,60,70/fcO),key 

60 i s i gn = 1 

70 nsign=nsign+1

if (nsign .ge. 2) go to 130

go to 100 

30 idot=idot+1

if (idot .ge. 2) go to 130

i fa ct or=num-i 

100 cont i nue

if (ifactor .eq. 0) go to 110

rnum=rnum/(10.**i factor) 

110 if (isign .eq. 0) go to 120

rnum=-rnum 

120 return

ERROR FLAG 

130 i stat = 1

return

end
APPENDIX C 261

SUBROUTINE NAME: SET_SHADE

Author: Lawrence Balcerak

Purpose of the program: Given the reference number of 

a shading pattern, set_shade will return an array 

that will produce that pattern.

Data base: Geoindex

Computer: Honeywell series 60 (level 68)

Operating system: Multics

Calling sequence: call set_shade (numref,j shade)

Arguments:

numref-The reference number being processed 

/s/7ac/e(76)-The 16-word array containing values 

whose bit arrangement forms some pattern.

Subroutines called: None

Common data referenced: Some entry in I pat I or I userpat/ depending on the value of numref

Input files: None

Output files: None

Arrays used: new(118), kold(136)

Called by: set shade

Error checking and reporting: A check is made for 

numref to range from 1 to 20. Any value outside this 

range gives the default value of 1 for numref.

Constants: None

Program logic:

1. new(1) is set equivalent to ip11, and kold(1) is set 

equivalent to ipl(1).

This causes one array to overlay each entry in a 

common block and thereby enables the program to 

access the whole block by just changing the index 

for the array.

2. If numref is outside the range 1-20, set numref = 1, 

which is the default value.

3. If numref is greater than 10, go to step 8. If numref

has a value from 5 to 10, go to step 6. If numref 

has a value of 3 or 4, go to step 5.

4. To get here, numref must be equal to 1 or 2.

Compute the index for iplace. Set numword = 

16, which is the number of words in the sequence 

that completes one pattern. Go to step 7.

5. The reference number must be 3 or 4 to reach this

step. 

Compute iplace. Set numword = 4. Go to step 7.

6. The reference number must be 5 through 10 to reach

this step. 

Compute iplace. Set numword = 16.

7. Fill jshade with the pattern. If the pattern does not 

take 16 words, repeat the pattern until all 16 

words are given a value. The correct pattern is 

found in kold by using the index iplace as a starting point and reading numword words. Return to 

calling program.

8. If numref has a value from 14 to 20, go to step 11. If 

numref equals 13, go to step 10.

9. The reference number must be 11 or 12 to reach this

step. 

Compute iplace. Set numword = 1. Go to step 12.

10. The reference number must be 13 to reach this step. 

Set iplace = 3. Set numword = 4. Go to step 12.

11. The reference number must be 14 through 20 to

reach this step. 

Compute iplace. Set numword = 16.

12. Fill jshade with the pattern. If the pattern does not 

take 16 words, repeat the pattern until all 16 

words are given a value. The correct pattern is 

found in new by using the index iplace as a starting point and reading numword words. 

Return to the calling program.

suuroutine set_shade (numref/jshade)

common /pat/ ip1(16)/ip2(16)/ip3(4) * i p 4(4) / i p 5 (1 6 ) / 

S ip6(16),ip?(16),ip8(16),ip9(16),ip10(16)

common /userpat/ ip11 /ip12 /ip13(4) *ip14(16)sip15(16) 

& ip16(16),ip17(16),ip18(16),ip19(16),ip2U(16) 

dimension jshade(16)/new(118)/kold(136) 

equivalence (new(1)/ip11)/(kold(1)/ip1(1))

if ( (numref .It. 1)

i f (numref .jt. 10)

if (numref . g e. 5)

if (numref . g e. 3)

THE REFERENCE NUMBER

.or. (numref 

go to 60 

go to 20 

go to 10 

IS 1 OR 2.

gt. 20)) numref=1

10

iplace=(numref-1) * 1 6 +1 

numwo rd = 10 

go to 30

THE REFERENCE NUMBER IS 

iplace=(numref-3)

3 OR 4
262 GEOINDEX

numword=4 

90 to 30

THE REFERENCE NUMBER IS 5 

<>0 iplace= (numref-5) *16+41 

numword=16

3D k = 16/num wo rd 

1 = 0

00 50 i =1*k 

do 40 j =1^numword 

1 = 1 + 1

j shade( l) = koLd(i place) 

i pIace= i pIace + 1 

iplace=i place-numword 

continue 

return

THRU 10.

40

50

60 if (numref .ge. 14) go to SO

if (numref .eq. 13) go to 70 

THE REFERENCE NUMBER IS 11 OR 12

iplace=(numref-11) + 1

numword =1

go to 90 

THE REFERENCE NUMBER IS 13.

i pi ace = 3

numwo rd = 4

go to 90 

THE REFERENCE NUMBER IS 14 THRU 20

1 00

110

i pi ace= (numref- 1 4 ) *1 6+7 

numword= 1 6

K = 1 e>/ num wo rd

1 = 0

ao 110 i=1, k

do 100 j=1*numword

1=1 + 1

jshade( l)=new(iplace)

i p I ace= i pi ace + 1

iplace=iplace-numword

cont i nue

return

end

SUBROUTINE NAME: PLOTLEGEND

Author: Lawrence Balcerak

Purpose of the program: plotlegend reads a character

string and plots the string using parameters given by

the keywords of the command. 

Data base: Geoindex 

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call plotlegend

Arguments: None

Subroutines called: find_number, letter, newpen

Common data referenced: icom(80), id(15), in1

Input files: Command statements used on unit 15

(filelS) 

Output files: tempW used on unit 10 (file 10) (for

messages)

Arrays used: keyword(8,6), itext(60) 

Called by: verplot
APPENDIX C 263

Error checking and reporting: The subroutine checks for 

a blank data field, invalid keywords, data field too 

long, data-value error, and missing keyword. If any 

such errors are found, an appropriate error message is 

printed with, in certain circumstances, the character 

string involved.

Constants: None

Program logic:

1. Set initial values. keyword(8,6) contains the four

possible keywords.

Each of the four is in both uppercase and lowercase. 

Set iangle = 0. This is the default angle for plotting

the legend.

Set I width = 1. This is the default line width in dots. 

Set ix = 0. This is the flag to indicate that the

oj-coordinate has been processed. 

Set iy = 0. This is the flag to indicate that the

^/-coordinate has been processed. 

Set ih = 0. This is the flag to indicate that the

height has been processed. 

Set in = 0. This is the flag to indicate that the

number of characters has been processed. 

Set key = 0. This is the branching switch. 

Set iplace - 8. This is the first position that a

keyword can start. 

Set Hast = 81. This is the position of the last

nonblank character of the record.

2. Starting at the last position of the record, 80, check 

in descending order for a nonblank character. If 

there is one, go to step 4.

3. The subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS 

and returns to the calling program.

4. Find the first nonblank character in this field, and 

set iplace equal to this position.

5. For ic = iplace to Hast, find the end of the next

keyword by searching for a comma. 

Set ic equal to one less than the position of the 

comma or to Hast if no comma is found. This is the 

position of the last character in this field.

6. Search the field for the character =.

If one is found, go to step 9. Any keyword must 

have this character.

7. Subroutine prints the error message:

LEGEND: THIS FIELD IS NOT RECOGNIZED AS A KEYWORD 

along with the erroneous field.

8. Set iplace = ic + 2, one position past the comma. 

If there are more characters to examine, go to step 

4. Otherwise, go to step 35.

9. Set // equal to the count of characters including the 

= of the keyword.

If // is greater than 7, go to step 7. No keyword is 

greater than 8 characters.

10. If // is equal to 1, 3, 4, or 5, go to step 7. If // is equal 

to 2, go to step 11. If // is equal to 6, go to step 15. 

If // is equal to 7, go to step 19.

11. If the characters are X or x, go to step 12.

If the characters are Y or y, go to step 13. Otherwise, go to step 7.

12. Set key = 1. This is the branching switch for the x

coordinate. 

Set ix = 1. This is the flag to indicate processing of

the x coordinate. 

Go to step 14.

13. Set key = 2. This is the branching switch for the y

coordinate.

Set iy = 1. This is the flag to indicate processing of 

the y coordinate.

14. Add 2 to iplace, first position past the = character. 

Go to step 23 to find the data value.

15. If the characters are not equal to NCHAR or nchar, 

go to step 17.

16. Set in = 1. This is the flag to indicate processing of

the number of characters. 

Set key - 3. This is the branching switch for

number of characters.

Add 6 to iplace, first position past the = character. 

Go to step 23 to find the data value.

17. If the characters are not equal to ANGLE or angle, 

go to step 7.

18. Set key = 4. This is the branching switch for the

angle.

Add 6 to iplace, first position past the = character. 

Go to step 21 to find the data value.

19. If the characters are not equal to HEIGHT or 

height, go to step 21.

20. Set h = 1. This is the the flag to indicate processing

of the height. 

Set key = 5. This is the branching switch for the

height.

Add 7 to iplace, first position past the = character. 

Go to step 23 to find the data value.

21. If the characters are not equal to LWIDTH or 

Iwidth, go to step 7.

22. Set key = 6. This is the branching switch for the

line width. 

Add 7 to iplace, first position past the = character.

23. Check for a comma immediately following the =

character.

If there is one, go to step 8 to check for the next 

keyword.

24. Find the position of the first nonblank character in 

the data field.
264 GEOINDEX

If the field is all blank, go to step 8. Otherwise, set 

iplace equal to this position.

25. Compute num. This is the the number of characters

in this data field.

If num is greater than 15, go to step 27. The field is 

too long.

26. Place the characters in the array id.

Call find number to evaluate the data. The returned value is in rnumZ.

If the error return code, istat, is equal to 0, go to 

step 28. A nonzero value indicates an error of 

some type when interpreting.

27. Subroutine prints the error message:

LEGEND: THIS STRING HAS AN UNRECOGNIZABLE CHARACTER 

Go to step 8 to examine the next keyword, if any.

28. Depending on the value of key, go to:

step 29 (key = 1); step 30 (key = 2); step 31 (key 

= 3); step 32 (key = 4); step 33 (key = 5); step 

34 (key = 6).

29. Set xx = mum (the x coordinate). 

Go to step 8.

30. Set yy = mum (the y coordinate). 

Go to step 8.

31. Set nchar = mum (the number of characters in the 

legend).

Go to step 8.

32. Set iangle = mum (the angle of the legend). 

Go to step 8.

33. Set height = mum (the height of a character). 

Go to step 8.

34. Set I width = mum (the width of a line in dots). 

Go to step 8.

35. Read the next record, which contains the text to be 

plotted.

36. If the four keywords (x coordinate, y coordinate, 

height, and number of characters) were processed, go to step 38.

37. Subroutine prints the error message:

THIS LEGEND CANNOT BE PLOTTED! 

THERE IS SOME KEYWORD MISSING!! 

It prints the line of text involved and returns to 

the calling program.

38. Call newpen to set the line width (dots) to the new 

value.

39. Set /scale equal to the number of sixteenths in the

height. 

Call letter to plot the character string.

40. Subroutine prints the message: 

LEGEND PLOTTED

41. Return.

suoroutine pLotlegend

common /comand/ icom(8G)/id(15)/isyin*in1*in2 

character icom*1/id*1/keyword*1(8*6) 

dimension itext(2(j)

data ( (

&/

&

i

&

&

&

&

k

ii

if

ii

ii

ii

ii

ey wo

N"

A"

H"

L"

n

a

h"

I"

if

tf /

ii /

'"

'

/

ii

ii

ra( C"/

N"/

E"/

w",

c"/

n"/

e"/

w"/

i /

"H

"G

"I

"I

9 "i

"i

j > <

it i

ii i

if i

ii i

'

/

fi i

fi i

,j = 1

•A"/

•L"/

'G",

'D"/

*a"/

'g".

•d",

,6

"R

"E

"H

"T

e

"h

"t

)/i=1/8

fi if »i

if ii ii

"/"T"/

ii ii ii ii

' '

f f

II If 4. II

ii " h " /

)

i angIe = 0 

I w i d t h = 1 . 

i x = U 

i y = J 

ih = 0 

i n = G 

key = 0 

i p I ace = 8 

iIast=81

FIND THE LAST NON-BLANK CHARACTER OF THE RECORD
APPENDIX C 265

do 10 i = i pL a ce/60

i Last = i Last-1 

10 if (icom(Uast) .ne. " ") go to 30

write (10/20) i c om 

20 format (" THE FIELD CONTAINS ALL BLANKS"///1x/SOa 1 )

return 

c

C FIND THE FIRST NON-BLANK IN THIS FIELD 

30 do 40 m=ipLace/i last 

40 if (icom(m) .ne. " "> go to 50

m= i Last 

50 i p Lace = m 

C FIND THE LAST POSITION FOR THIS FIELD

do 6J ic=ipLace/iLast 

60 if (icom(ic) .eq. "/"> go to 70

i c= i L as t

yo to 80 

70 ic=ic-1

C IDENTIFY THE KEYWORD 

60 do 90 LL=ipLace/ic

90 if (icom(LL) .eq. "=") go to 120 

95 write (1U/1JO) (icom(i)/i=ipLace/ic)

100 format (" LEGEND: THIS FIELD is NOT RECOGNIZED AS A KEYWORD"/

& //1x/73a1 ) 

110 ipLace=i c+2 

k e y = 0

if (iLast-ipLace) 390/390/30 

c 

120 L L = lL-ipLace-H

i f (I I .gt . 7) go to 95 

go to (95/130/95/95/95/170/210)/ll 

C FIND THE X-VALUE OR THE Y-VALUE 

130 if ((icom(iplace) .eq. "X") .or.

a, (icom(iplace) .eq. "x")) go to 140

if ((icom(ipLace) .eq. "Y") .or. 

« (icom(ipLace) .eq. "y")) go to 150

90 to 95 

140 key=1 

ix = 1

go to 160 

150 key = 2

iy = 1 

1oO ipi ace = ipiace + 2

go to 250

c FIND THE ANGLE OR THE NUMBER OF CHARACTERS 

170 do 180 i=1/5 

180 if ((icom(ipLace + i-1) .ne. keyword(1/i)) .and.

ir (i com (i p L ac e + i -1 ) .ne. key word ( 5/i ) ) ) go to 190 

in=1 

key = 3

i p L ace= i p L ac e+6 

go to 250

190 do 200 i=1/5 

200 if ( (icom(ipLace+i-1) .ne. keyword(2/i)) .and.
266 GEOINDEX

6 (icom(ipIace+i-1) .ne. keyword(6*1))) go to 95

key = 4

i pIace= i p I ac e+6

go to ,250

c FIND THE HEIGHT OR THE LINE WIDTH 

210 do 220 i=1*6 

220 if ((icom(ipIace+i-1) .ne. keyword(3*i )) .and.

& (icom(ipLace + i-1) .ne. keyword(7 *i))) go to 230

ih = 1

key-=5

ip I ace=ipIace + 7

yo to 250 

230 do 240 i=1*6 

240 if ((icom(ipIace+i-1) .ne. keyword(4 *i) ) .and.

i (icom(ipLace+i-1) .ne. keyword(8*1))) go to 95

key = 6

i p L a c e = i p L a c e + 7

250 if (ic-iplace) 110*260*260

c FINi) THE FIRST NON-BLANK CHARACTER FOR THIS DATA FIELD 

260 do 270 num=ipLace*ic 

270 if (icom(num) .ne. " "> go to 280

yo to 110 

280 i p L ace = num

num= i c-i pIac e + 1

ifCnum ,gt. 15) go to 300

1 = 0

do 290 i = i p I ac e* i c

1=1+1 

290 id(L)=i com(i)

call find_numoer ( i d*num* mum* i s t at)

if (istat .eq. 0) go to 320 

300 write (10*310) (icom(i)*i=ipLace*ic)

310 format (" LEGEND: THIS STRING HAS AN UNRECOGNIZA3LE CHARACTER"* 

& /*5x*73a1)

go to 110 

c

320 go to (330*340*350*360*370*380)*key 

330 x x = rnum

go to 110 

340 yy= rnum

go to 110 

350 nchar=rnum+0.5

go to 110 

360 iangle=rnum+0.5

,go to 110 

370 heicjht = rnum

go to 110 

380 lwidth=rnum+0.5

go to 110 

c 

c

390 read (in 1 *395*end = 450) itext 

395 format (20a4)
APPENDIX C 267

if ( (ix .eq. 1) .and. (iy .eq.

& (in .eq. 1) ) yo to 430 

write (10/400)

400 format (" THIS LEGEND CANNOT BE 

& " THERE IS SOME KEYWORD 

write (10/420) itext 

420 format (1x/20a4) 

return

1) .and. (ih .eq. 1) .and

PLOTTED!"/// 

MISSING! !")

430 call newpen (Iwidth)

iscale=height*1o+0.5

call letter (nchar/isca I e/iang le/xx/yy/itext)

write (10/440)

440 format (" LEGEND PLOTTED") 

450 ret urn

end

SUBROUTINE NAME: PLOTFILE

Author: Lawrence Balcerak

Purpose of the program: plotfile reads the name of a file, 

opens that file, and plots it.

Data base: Geoindex

Computer: Honeywell 60 (series 68)

Operating system: Multics

Calling sequence: call plotfile

Arguments: None

Subroutines called: closef, fincLnumber, io_call, letter, plot, set_shade, symbol, tone

Common data referenced: icom(80), id(15), isym, in1, 

in2

Input files:

Command statements used on unit 15 (file15) 

File to be plotted used on unit 16 (file16)

Output files: tempW used on unit 10 (file10) (for 

messages)

Arrays used: keyword(18,9), ipat(20), ne(2), 

jwhat(200), xx(2000), yy(2000), kplotfield(8), 

jshade(16), kfield(8), char(S,5), text(5), iwhat (200,2)

Called by: verplot

Error checking and reporting: The subroutine checks for 

a blank data field, blank file name, file name too long, 

data field too long, invalid data character, invalid 

keyword, missing keyword, and end of file reached. If 

any such error is found, an appropriate error message 

is printed with, in certain circumstances, the 

character string involved.

Constants: None

Program logic:

1. Set initial values. keyword(18,9) contains the nine 

keywords possible. Each is in both uppercase and 

lowercase.

Set name equal to blanks. This will be the name of 

the file to be opened for plotting.

Set height = 0.14, which is the default height of 

each plotted character.

Set space = height divided by 5, which is the 

space between lines of character.

Set numpat = 0, which is the number of the pattern to use for shading.

Set noline = 0, which is the flag for the noline 

option.

Set noname = 0, which is the flag for the processing of the name keyword.

Set no select = 0, which is the flag for the select 

option.

Set noclear = 0, which is the flag for clearing the 

space around characters.

Set noshade = 0, which is the flag for the shade 

option.

Set nochar = 0, which is the flag for character 

plotting.

Set noselshade = 0, which is the flag for selecting 

shades.

Set item = 0, which is the index counter used to 

rotate through the different patterns.

Set i pi ace = 6, which is the first position that a 

keyword can be found.

Set Hast = 81, which is the position of the last 

nonblank character (initialized to one past the 

end of the record).

Set ipat(i) = i for / = 1,10, which is the default sequence of patterns to rotate through.

Set ipat(i) = 0 for / = 11, 20, which indicates that 

these patterns are not used in the rotation.

Set kplotfield(i) = 0 for / = 1,8, to indicate which
268 GEOINDEX

of the eight character fields from the header card 

are to be plotted and in what order.

2. Starting at the last position of the record (80), 

check in descending order for a nonblank 

character. 

If there is one, go to step 4.

3. Subroutine prints the error message:

THE FIELD CONTAINS ALL BLANKS 

and returns to the calling program.

4. Find the first nonblank character in this field and 

set iplace equal to this position.

5. For ic = iplace to Hast, find the end of the next

keyword field by searching for a comma. 

Set ic equal to one less than the position of the 

comma or to Hast if no comma is found. This is 

the position of the last character in this field.

6. If the characters in the keyword are not NAME or 

name, go to step 22.

7. Add 5 to iplace, the first position past the = 

character.

8. Set iplace equal to the first nonblank character in

the data field.

If the field is all blank, set iplace equal to ic, which 

is the last character in the field.

9. Compute m, the number of characters in the data

field. 

Compute k, the number of characters in the record

that lie before this data field. 

If m is greater than 0, go to step 11. A zero value

would occur with an all blank field or when a

comma immediately follows the = character.

10. Subroutine prints the error message:

NAME HAS NO CHARACTERS!! 

Go to step 18 to examine the next keyword, if any.

11. If m is less than or equal to 20, go to step 13.

12. Subroutine prints the error message:

NAME IS MORE THAN 20 CHARACTERS 

LONG!!

along with the erroneous field. 

Go to step 18 to examine the next keyword, if any.

13. Backspace the command file.

14. Compute fmtl, the format to be used in reading 

the name of the file. This format must skip 

spaces and read m characters from the record into name(k).

15. Read the file name from the record.

16. Call io call to attach and open the file for input. 

Use the value of in2 as the file number.

17. Set noname = 1. This is the flag to indicate that 

the file name has been processed.

18. Set iplace equal to ic + 2, the first position past 

the comma. This would be the first possible position for the next keyword.

19. If there are more characters in the record to check, 

go to step 4 to examine the next keyword.

20. If there is not another record containing 

keywords, go to step 80 to read the select record, 

if any.

21. Read the next record into icom(80).

If EOF, go to step 128. Set Hast = 81. Set iplace 

= 1. Go to step 2 to interpret this record.

22. If the characters in the keyword are not HEIGHT 

or height, go to step 31.

23. Add 7 to iplace, the first position past the = 

character.

24. If there are not any characters in this data field, go 

to step 18 to examine the next keyword, if any.

25. Find the first nonblank character in this data field 

and set iplace equal to this position. If the field 

is all blank, go to step 18 to examine the next 

keyword, if any.

26. Compute num, which is the number of characters

in the data field.

If num is less than or equal to 15, go to step 28 to 

interpret the data.

27. Subroutine prints the error message:

PLOT-HEIGHT: THIS FIELD HAS TOO 

MANY CHARACTERS 

along with the erroneous field. 

Go to step 18 to examine the next keyword, if any.

28. Place the string of characters into the array id. 

Call find_number to evaluate the data. The 

returned value is in mum.

29. If the return error code, istat, is not equal to 0, go 

to step 18 to examine the next keyword, if any. A 

nonzero value indicates an error of some type 

when translating.

30. Set height = mum.

Set space = height divided by 5. Go to step 18 to 

examine the next keyword, if any.

31. If the characters of the keyword are not PA TTERN 

or pattern, go to step 51.

32. Add 8 to iplace, which is the first position past the

= character.

Set kount = 0, the counter for the number of pattern reference number being interpreted.

33. If the data field has no length, a comma follows the 

=, go to next step. Otherwise, go to step 35.

34. The subroutine prints the error message:

PLOT-PATTERN: THE PATTERN COUNT 

HAS AN ERROR!! 

along with the erroneous field. 

Go to step 18 to examine the next keyword, if any.

35. Find num, the position of the first nonblank

character in this field. 

If there is a nonblank character, go to step 38.
APPENDIX C 269

36. If kount = 0, go to step 34. This indicates an allblank field for the count of numbers following.

37. The subroutine prints the error message:

PLOT-PATTERN: THE FIELD CONTAINS 

AN ERROR AND WILL BE SET TO THE 

DEFAULT VALUE 

along with the erroneous field. 

Go to step 46.

38. Set iplace = num, which is the first nonblank position of the data field.

39. Compute the number of characters in the data field

and store in num. 

If num is less than or equal to 15, go to step 41.

40. If kount is equal to 0, go to step 34. This should be

the pattern count.

Go to step 37. There is an error in a pattern 

reference number.

41. Place the character string into the array id.

Call find number to evaluate the data. The

returned value is in mum. 

If the return error code, istat, = 0, go to step 43. A

nonzero value indicates an error of some sort

during the interpretation.

42. If kount = 0, go to step 34. This is the pattern 

count that has an error. Otherwise, go to step 37.

43. If kount is greater than 0, go to step 45.

44. Set num pat = mum. This is the count of the pattern reference numbers that follow. 

Go to step 46.

45. Set ipat(kount) = mum. Store the pattern 

reference number just translated.

46. Add 1 to kount.

If kount is less than or equal to numpat, go to step 

48.

47. Zero out the rest of the ipat array.

Go to step 18 to examine the next keyword, if any.

48. There are more numbers to translate.

Set iplace = ic + 2, the first position past the 

comma (if there was one).

If /7asf is less than or equal to iplace, go to step 47 

because there are no more characters to interpret on this record.

If Hast is greater than iplace, there is an error in 

the command file because the plot option and 

value must be on the same record.

49. Set iplace equal to the first nonblank character of 

this data field. There must be at least one.

50. For ic = iplace to /7asf, find the end of this 

keyword by searching for a comma.

Set Ic equal to one less than the position of the 

comma or to Hast, if no comma is found. This is 

the position of the last character in this field.

Go to step 35 to interpret the next data field.

51. If the characters of the keyword are not TEXTFIELD or textfield, go to step 69.

52. Add 10 to iplace, first position past the =

character.

Set kount = 0, which is the counter for the number 

of text fields being interpreted.

53. If the data field has no length (a comma follows the 

=), go to the next step. Otherwise, go to step 55.

54. Subroutine prints the error message:

PLOT-TEXTFIELD: THE FIELD COUNT 

HAS AN ERROR!! 

along with the erroneous field. 

Go to step 18 to examine the next keyword, if any.

55. Search for the first nonblank character in this data 

field, and set num equal to this position. If such a 

character is found, go to step 58.

56. If kount equals 0, go to step 54. This would be an 

all-blank data field for the number of text fields 

count.

57. Subroutine prints the error message:

PLOT-TEXTFIELD: THIS FIELD CONTAINS AN ERROR AND WILL NOT BE 

PLOTTED!!

along with the erroneous field. 

Go to step 65 to examine the next number, if any.

58. Set iplace = num, the first nonblank character in

this field. 

Compute num, which is the number of characters

in the data field. 

If num is less than or equal to 15, go to step 60.

59. If kount = 0, go to step 54. Otherwise, go to step 

57.

60. Place the characters in the array id.

Call find_number to evaluate the data. The

returned value is in rnum. 

If the error return code, istat = 0, go to step 62. A

nonzero value indicates an error of some type.

61. If kount = 0, go to step 54. Otherwise, go to step 

57.

62. If kount is greater than 0, go to step 64.

63. Set num field = rnum, which is the count of textfield numbers that follow. 

Go to step 65.

64. Set num = rnum.

Set kplotfield(num) = kount. The array kplotfield contains numbers indicating the order in 

which the character fields from the header card 

will be plotted. If kplotfield(num) is blank or 

zero, there will be no plotting. If value is other 

than blank or zero, the text field will be plotted.

65. Add 1 to kount, which is the next sequence

number. 

If kount is less than or equal to numfield, go to
270 GEOINDEX

step 67. There are more numbers in this sequence to interpret.

66. Set nchar = 1, which is a flag indicating that the 

textfield option is to be used. In other words, 

there are character fields to be plotted. 

Go to step 18 to examine the next keyword, if any.

67. Set iplace = ic + 2, the first position past the

comma.

If there are no more characters left in this record, 

go to step 66.

68. Search the remainder of the string for a comma. 

Set ic equal to one less than the position of the

comma or to Hast if no comma is found. 

Go to step 55 to interpret this data field.

69. If the characters are not NOLINE or noline, go to 

step 71.

70. Set noline = 1. This is a flag to turn on the noline

option. 

Go to step 18 to examine the next keyword, if any.

71. If the characters are not SELECT or select, go to 

step 73.

72. Set noselect = 1. This is a flag to turn on the

select option. 

Go to step 18 to examine the next keyword, if any.

73. If the characters are not REFCLEAR or refclear, 

go to step 75.

74. Set noclear = 1. This is a flag to indicate the clearing of the area around reference number is to be 

done. 

Go to step 18 to examine the next keyword, if any.

75. If the characters are not SHADEALL or shadeall, 

go to step 77.

76. Set noshade = 1. This is a flag to turn on the

shading options for all outlines. 

Go to step 18 to examine the next keyword, if any.

77. If the characters are not SELSHADE or selshade, 

go to step 79.

78. Set noshade = 1.

Set noselshade = 1. These two flags will tell the 

program to shade only those outlines that have 

pattern reference numbers listed in the selected 

outlines.

Go to step 18 to examine the next keyword, if any.

79. The variable did not match any valid keyword. 

The subroutine prints the error message:

PLOT: THIS KEYWORD IS NOT VALID!! 

along with the erroneous field. 

Go to step 18 to examine the next keyword, if any. 

At this point in the program, all keywords have been 

read and evaluated. Next, the file of selected outlines 

is read and then plotted.

80. Set kount - 1. This is the counter for the number 

of feature numbers read in.

81. Read the next record from the command file as

characters. 

If EOF, go to step 128.

82. If these characters are END PLOT or end plot, 

this signifies the end of the information for plotting this file. 

Go to step 84.

83. Add 1 to kount.

Go to step 81 to read another record.

84. Subtract 1 from kount. The END FILE record is 

not to be used.

85. If noname = 1, go to step 87. A zero value indicates that the name keyword was not present 

or had an error in it.

86. The subroutine prints the error message:

PLOT: NO PLOT FILE??? 

and returns to the calling program.

87. Read a header card from the plot file. The eight 

fields are read here as a character string. This is 

needed for comparison with the select outline 

file. 

If the EOF reached, go to step 128.

88. Backspace the plot file.

89. Read the header card as separate characters. This 

is needed later in the program when plotting the 

characters.

90. Backspace the plot file.

91. Read isfno, the number of pairs of coordinate 

points.

92. Subtract 1 from isfno. The first position is a text 

position.

93. Read the x text position, the y text position, and 

the outline points.

94. Set isel = 0, which is a flag to indicate if outline is

in select file.

Set key = 0. If the outline is in the select file, key 

will take on the value of the pattern reference 

number given for that outline.

95. If kount equals 0, go to step 98. No outlines were 

listed in the select outline file.

96. If this outline is in the file of selected outlines go to

step 97. 

Otherwise, go to step 98.

97. Set isel = 1. This is a selected outline.

Set key = jwhat(i), which takes on the value of the 

pattern reference number listed.

98. If noselect = 1 and isel = 0, go to step 87 to read 

the points for another outline. This outline will 

not be plotted.

99. If isfno is greater than 1, go to step 101.

100. This is a single point that has some character plotted at that point.
APPENDIX C 271

Call symbol to plot the character. 

Go to step 118 to plot the text, if any.

101. If noline equals 1, go to step 103. This indicates 

that the outline will not be plotted.

102. Use the subroutine plot to plot the outline.

103. If noshade is not equal to 1, go to step 118. A 

value of 1 indicates that the outline is to be 

shaded.

104. If noselshade equals 1, and isel equals 0 or key 

equals 0, go to step 118. A value of 1 for 

noselshade indicates that the selective shading 

option is in effect, and the shading pattern used 

will be in the selective outline file. A value of 0 

for isel indicates that this outline is not in the 

selective file. A value of 0 for key indicates that a 

0 value was in the pattern location for this 

outline.

105. Set ne(1) = isfno; set ne(2) = 0.

This array contains the number of points in an 

outline(s) when using the subroutine tone for 

shading. If there is more than one outline, the 

subroutine will alternate the shading with blank 

areas, depending on the overlapping of the 

outlines. This will be used to clear areas around 

the text if needed. 

Set numarea = 1, one area to start with.

106. If noclear equals 0 or nochar equals 0, go to step 

114. Either the clearing option was not used or 

no characters are wanted.

107. Set numvert = 0; set numhorz = 0. These are 

counters for the number of characters that will 

be plotted both vertically and horizontally. Do 

steps 108-111 for / = 1, 8.

108. If kplotfield(i) equals 0, the tth field of the header 

card will not be plotted; skip to the next value of 

/.

109. Add 1 to numvert. There is one more line of text.

110. Set icheck = 5. A maximum of five characters is

in a field.

Check each character in this field. For each leading 

blank or zero, subtract 1 from icheck. All 

characters following nonzero characters are to 

be considered significant, even a blank.

111. Set numhorz equal to the maximum of icheck and 

numhorz. After checking all eight text fields, 

numhorz will hold the maximum number of 

characters in any line.

112. If numhorz equals 0, go to step 114. There are no 

lines of text to plot.

113. Set k = isfno + 1. This is the first index position

used to store the outline to be cleared. 

Compute the coordinates of the four corners of the 

rectangle to be cleared and store in xx and yy immediately after the main outline.

Set ne(2) = 4. Four points are in the cleared rectangle.

Set numarea = 2, two outlines.

114. Add 1 to item, item is used as an index counter to

rotate through all the different patterns used. 

If item is greater than numpat, set item = 1. The 

total number of patterns used is numpat.

115. If ipat(item) is less than or equal to 0 or if 

ipat(item) is greater than 20, go back to step 

114. These would be invalid reference numbers.

116. Set num = ipat(item). This is the reference 

number that comes from the sequence of patterns.

If key has a value that represents a valid reference 

number, set num = key. This reference number 

takes the place of the default value.

117. Call seLshade to get the pattern values for this

reference number.

Call tone to set the pattern. Call tone to shade the 

outline. It will also clear the text area if wanted.

118. If nochar equals 0, go back to step 87 to read the

next header card. 

Do steps 119-125 for / = 1, 8.

119. Search kplotfield(f) for a value equal to /. This will

give the next text field to plot. 

If there is a match, go to the next step. Otherwise, 

search for the next value of /.

120. Count the number of leading blanks in the 

character string, and set equal to num.

121. If there are all blanks or the numeric value of the 

field is 0, go back to step 119 to search for the 

next value of /.

122. Set n = 5 - num. This is the number of 

characters to be plotted. Store the characters to 

be plotted in itext.

123. Set posx = xpos. This is the x coordinate of the

first line of text.

Set iscale equal to the number of sixteens in the 

height.

124. For each character in turn, call letter to plot the

character.

Add the height of a letter and an interletter space 

to the x coordinate to locate the next character.

125. Subtract enough room from the y coordinate to 

correctly position the next line of text.

126. Go to step 87 to read the next header card.

127. Subroutine prints the error message:

PLOT: END OF FILE REACHED WHEN 

TRYING TO READ A DATA RECORD 

Go to step 129.

128. Subroutine prints the message: 

FINISHED PLOTTING

129. Call closet to close and detach the plot file. Return.
272 GEOINDEX

subroutine plotfile

common /comand/ i c om ( 80 ) / i d ( 1 5 ) / i sy m / i n 1 / i n2

character icom*1,id*1,keyword*1 (18/9)/ndme*20/fmt1*21/fmt2*21 /

& kfield*5(8)/name1*o/char*1 (6/5)/itext*1 (5)/iwhat*5(200/2) 

external io_call (descriptors) 

dimension ipat(20)/ne(2)/jwhat(200)/xx(2000)/yy(2000)/

6 kplotf i eld(8) ,j shaded 6)

Kt

fir )

i

6r

&

8*

i

6r

C,

&

&

&

&

*

&

Of 

&

?y wo

"H"

" p "

II T II

"M"

S

"R"

"S"

"S"

"n"

P

ti f. ii

ii ii

r

/

/

/

/

/

/

/

/

/

f

/

/

/

/

/

a v.

A

"E

"A

"E

"0

b

"E

"H

"E

a

e

a

"e

"e

> /

/

n

ii

ii /

ii /

/

ii

ii /

ii

/

/

/

ii /

'

ii

J t

1*1

"I

"T

"X

"L

L

"F

"A

"L

m

i

"x

"f

'J

/

ii

ii /

ii /

ii /

/

ii /

ii /

ii /

/

/

/

ii /

'

ii

= i /

"G"

ii j ii

II -r II

II r II

E '

ii /- ii

II pv II

"S"

•» e "

y

ii <. u

u .j u

•I _ n

y

/

/

/

/

/

/

/

/

/

/

/

/

f

'

/

) f

"H

"E

"F

"N

"L

"e

"H

e

"f

n

"L

i -

/

"/

ii

ii

"/

/

ii

ii

ii /

/

/

/

u

/

ii /

i /

"T

"R

"I

"E

1

"E

"A

"A

r

"i

e

"e

1 0

/

ii /

ii /

ii /

ii

f

ii /

ii

ii

/

/

t

ii

/

ii

>

ii

"N

"E

ii

"A

"L

ii p.

1 n

"e

"a

/

ii

ii

ii /

/

/

ii /

ii /

ii /

/

/

/

ii /

/

ii /

/

ii ii

ii ii

"L"/

„ „,

"R"/

"L"/

"E"/

/

/

/

" L " /

/

"r"/

/

ii ii /

ii ii

"D"/

„ » f

/

ii ii

ii ii /

ii ii

/

/

/

" ^i "

d /

/

ii ii /

hei yht = 0.1 4

space = he i ght / 5.

numpa t = 10

no L i ne = 0

noname=Q

no se L ec t = i)

noc Lea r = 0

noshade=U

nocha r = 0

no set shade = U

i t em = 0

i p L ace = 6

i Last = 81

do 10 i = 1 /10 

10 i pat ( i ) = i

do 20 i = 1 1 ,20 

20 ipat ( i ) =0

do 30 i=1/8 

30 kp.Lot f ie Ld(i ) =0 

c

c FIND rt-ib' LAST NON-BLANK CHARACTER ON THE RECORD 

35 do 40 i = i p Lace/60

i Last = i Last-1 

40 if (icom(ilast) .ne. " "> go to 60

write (10/50) icom 

50 format (" THE FIELD CONTAINS ALL BL ANKS" / / / 1 x /80a 1 )

return
APPENDIX C 273

C

C FIND THE FIRST NON-BLANK CHARACTER IN THIS FIELD 

60 do 70 m=ipIace,ilast 

70 if (icom(m) .ne. " ") go to 80

m= i last 

60 iplace=m 

C FIND THE LAST NON-BLANK CHARACTER IN THIS FIELD

do 90 ic=iplace,ilast

90 if (icom(ic) .eq. ",") go to 100 

i c = i L as t

100 

c 

c 

c 

c

1 10

120

130

135

go to 110 

i c = i c-1

IDENTIFY TH 

NAME OF PLO

do 120 i=

if ( ( i c om (

& ( i c om (

i p I ace= i p I

do 130 m=

if ( i com ( m

m=i c

ip 1 ace = m

E KEYWORD 

T FILE

1,4

i p lac e + i -1

i pi ac e + i -1

ace + 5

i p I ac e, i c

) .ne. " "

)

)

)

.ne

.ne

30

keyword(1,i)) .and. 

keywordC10,i))) go to 200

to 135

k= i piace-1

m= i c-k

i f (m .gt. 0) go to 145

write (10*140) 

140 format ("NAME HAS NO CHARACTERS!!")

go to 170 

145 if (,« . le. 20) go to 160

write (10*150) (icom(i)»i s K*m) 

150 format (" NAME IS MOKE THEN 20 CHARACTERS LONG!!",/,1x,80a1)

go to 170 

160 backspace in1

fmt2="(1h(,i2,3hx,a,i2,1h))"

if (m .It. 10) fmt2 = "(1h(,i2,3hx,a,i1*1h) )"

encode (fmt1,fmt2) k*m

read (in1*fmt1) name

fmt1="(4hfiIe,i2)"

if (in2 .le. 9) fmt1="(5hfiIeO,i1)"

encode (name1*f:nt1> in2

call io.call ("attach"*name1*"vfile_ "*name)

call io.call ("open'^name 1 ^"s i ")

noname=1 

c

c LOOK AT THE NEXT KEYWORD 

170 i pIace= i c + 2

if (i last-iplace) 180,180,60 

180 if (icom(ilast) .ne. ",") go to 790

read (in1,19u) icom 

190 format (80a1)

i last = 81
274 GEOINDEX

i p I ace=1 

90 to 35 

c

c HEIGHT OF THE CHARACTERS 

200 do 210 i=1/6 

210 if ((icom(ip I ace + i-1) .ne. key word(2/i ) ) .and.

S (i come iplace+i-1 ) .ne. keyword(11/i))) go to 260 

i pIace= i p I ace + 7 

c 

C CHECK FOR A VALID DATA WORD

if (ic-iplace) 170/220/220 

22U do 230 num=ipI ace/ic 

230 if (icom(num) .ne. " ") go to 240

go to 170 

240 i p I ac e = num

num= i c-i p I ac e + 1 

if (num ,le. 15) go to 260 

write (10/250) ( icom(i)/i = ipIace/ic ) 

250 format (" PLOT-HEIGHT: THIS FIELD HAS TOO MANY CHARACTERS"/

& //1x/70a1 ) 

go to 170 

260 1=0

do 270 i = i pIac e/i c 

1 = 1 + 1 

270 id(l) = i com(i)

call find_number (id/num/rnum/istat) 

if (istat .ne. U) go to 170 

height 3 rnum 

space=height/5. 

go to 170 

c

C PATTERN SEQUENCE FOR SHADING 

230 do 290 i=1/7 

290 if ( (icom(ip I ace + i-1) .ne. keyword(3/i) ) .and.

& (icomCiplcice-H-1) .ne. keyword(12/i))> go to 470 

iplace=iplac e + 8 

kount =0

if (ic-iplace) 300/320/320 

3JO write (10/310) (icom(i )/i = ipIace/ic ) 

310 formatC* PLOT-PATTERN: THE PATTERN COUNT HAS AN ERROR!!"/

& //1x/70a1 ) 

go to 170 

c

320 do 330 num=ipiace/ic 

330 if (icom(num) .ne. " ") go to 350

if (kount .eq. 0) go to 300 

335 write (10/340) (icom(i)/i = ip I ace/ic) 

340 format (" PLOT-PATTERN: THE FIELD CONTAINS AN ERROR AND WILL

& dE SET TO THE DEFAOLT VALOE"///1x/7Oa1) 

go to 400 

35u i pIac e = num

num = i c-iplace + 1

if (num .le. 15) go to 360
APPENDIX C 275

if (kount .eq. 0) go to 300

90 to 335 

c 

360 1=0

do 370 i = i pLac e r \ c

1 = 1+1 

370 id(L)=i com(i)

call find.number (i d/num/mum / i s t at)

if (istat .eq. 0) go to 360

if (kount .eg. 0) go to 300

go to 335 

380 if (kount .gt. 0) go to 390

numpa t = rnum+0.5

go to AGO

390 ipat(kount)=rnum+0.5 

400 kount=kount+1

if (kount .Le. numpat) go to 420 

405 do 410 i = kount/2'J 

410 ipat(i)=0

go to 170 

c

420 ip Lace=i c + 2

if (ilast .Le. iplace) go to 405

do 430 m=ipLace/iLast 

430 if (icom(m) .ne. " ") go to 440

m = i Last 

440 i pL ac e = m

do 450 ic = ipLace / iLast 

450 if (icom(ic) .eg. "/") go to 460

i c = i L as t

9o to 320 

460 i c = i c-1

go to 320 

c

C TbXT FIELDS TO Bt PLOTTED 

470 do 480 i=1/9 

4<iO if ( (i com ( i p L ac e + i -1 ) .ne. ke y wo rd ( 4 / i ) ) .and.

$ (icom(ipLace+i-1) .ne. Keyword(13/i))> go to 670

ipLace=ipLac e + 1U

kount=0

if (ic-ipLace) 490/510/510

490 write (10/500) (icom(i)/i=ipLace/ic) 

500 format (" PLOT-TEXTFIELD : THE FIELD COUNT HAS AN ERROR!!")

go to 170 

c

510 do 520 num=ipLace/ic 

520 if (icom(num) .ne. " ") go to 550

if (kount .eq. 0) go to 490 

530 write (10/540) (icom(i)/£=ipLace/ic)

540 format (" PLOT-TEXTFIELD:" THIS FIELD CONTAINS AN ERKOR AND 

& WILL NOT BE PLOTTED!!")

go to 600 

550 ipLace=num

num = i c-ip L ac e + 1
276 GEOINDEX

if Cnum .Le. 15) go to 560

if (Kount .eq. U) go to 490

go to 530 

c 

560 1=0

do 570 i=ipLace/ic

1 = 1 + 1 

570 id(L)=icom(i)

call find.number (id/nurn/rnum/istat )

if Cistat .eq. J) go to 580

if (kount .eq. 0) go to 490

go to 530 

530 if Ckount .gt. 0) go to 590

numfield=rnum+0.5

yo to 600 

590 num=rnum+Q.5

kplot fi e IdCnum)=kount 

600 kount=kount+1

if (kount .Le. numfield) go to 620 

610 noc ha r = 1

go to 170 

c 

620 i p I ace= i c + 2

if (ilast .le. iplace) jo to 610

do 630 m = ipi ace/i last 

630 if (icom(m) .ne. " ") go to 640

m= i Last 

640 i p L ac e = m

do 650 ic = ipLace / iLast 

650 if (icom(ic) .eq. "/") go to 660

i c= i L as t

go to 510 

6oO i c = i c-1

go to 510 

c

C MOLINE OPTION 

67u do 680 i = 1/o 

630 if (Cicom(ipLace+i-1) .ne. keyword(5/i)) .and.

i (icom(ipLace+i-1) .ne. keyword(14/i))) go to 690

no L i ne=1

go to 170 

c

C SELECT OPTION 

690 do 700 i=1,6 

700 if ((icom(ipLace + i-1) .ne. key wora(6/i)) .and.

<i ( i com C ip L ac e+ i-1 ) .ne. keyword(15,i))) go to 710

noseLect=1

go to 170 

c

C CLEArt REFERENCE NUMBER 

710 oo 720 1=1/6 

720 if ((icom(ipLace+i-1) .ne. keyword( It i)) .and.

^ (icom(ipLace +i-1) .ne. key word(1o/i))) go to 730
APPENDIX C 277

noc tear=1 

go to 170 

c

c SHADE ALL OPTION 

730 ao 740 i=1/8 

741) if ( (icom(ipIace + i-1 ) .ne. key wo rd ( S/ i ) ) .and.

& (icom(ipIace+i-1) .ne. keyword(17/i) ) ) go to 750 

noshade=1 

y o t o 1 7 0 

c

c SHADE SELECTIVELY OPTION 

750 do 760 i = 1/& 

760 if ((icom(ipIace + i-1 ) .ne. keyword ( 9/i) ) .and.

& ( i com( ip I ac e-H-1 ) .ne. keyword (1 8/i ))) yo to 770 

noshade=1 

nose Ishaoe = 1 

13 o to WO 

c

C NO MATCH FOR A KEYWORD 

7?0 write (10/760) (icom(i)/i=ipiace/ic) 

780 format (" PLOT: THIS KEYWORD IS NOT VALID!!")

^o to 170 

c

c READ SELECT RECORDS AND END PLOT KEYWORD 

790 kount=1

800 read (in1/&10) (iwhat(kount/i)/i=1/ 2 )/jwhat(kount) 

810 format (2a5/i5)

if (((iwhat(kount/I) .eg. "END P") .and. (iwhat(kount/2) ,eq. 

"LOT; ")) , 0 r.((iwhat(kount/1) .eq. "end p") .and. (iwhat(kount/ 2 ) 

,eq. "Lot; ")) 90 to 820 

k o u n t = k o u n t + 1 

go to 800 

c

c START TO PLOT THE FILE 

820 kount=kount-1

if (noname .eq. 1) go to 840 

write (10/830) 

830 format (" PLOT: NO PLOT FILE???")

ret jrn 

c

c READ IN DATA y/ALOES FOR AN OUTLINE 

840 read (in2/850/end = 1050) ( kfie I d(i)/i = 1/8) 

850 format (8a5) 

oackspace in2

read (in2/855) ( ( char(i/j ) /j = 1/5)/i = 1/8) 

855 format (8(5a1)) 

backspace in2 

read (in^/860) isfno 

860 forfeit (15x/i5) 

i s f no= i s f no-1

read (in2/870/end = 1030 ) xpos / ypos/(xx(i)/yy(i)/i=1/isfno ) 

870 format (12f6.3) 

c
278 GEOINDEX

C CHECK FOR A MATCH WITH THE SELECTED FEATURES 

i sel = 0 

key =G

if (kount .eq. 0) go to 900 

ao 830 i =1/kount

880 if ((kfieldd) .eq. iwhatCi/1)) .and. (kfield(3) .eq. iwhat(i/2))) 

is, jo to 390

jo to 9UO 

890 isel=1

key=jwhat(i) 

c 

c CHtCK IF THIS OOTLINE IS TO dt PLOTTED

900 if ((noselect .eq. 1) .and. (isel .eq. 0)) go to 840 

c 

c CHECK FOR SINGLE POINT

if (i sfno .gt . 1 ) goto 9o5

call symbol ( xx( 1 )/yy(1)/height/isym/0./-1) 

90 to 9o0 

c

c CHECK FOR THE NOLINE OPTION 

905 if (noline .eq. 1) go to 920 

call plot (xx(1 ) /yy(1) ,3) 

do 910 i =1/i s fno 

910 call plot CxxCi )/yy(i) ,2) 

c

C CHECK FOR SHADING 

920 if (noshade ,ne. 1) go to 960

if ((noselshade .eq. 1) .and.

i ((isel .eq. 0) .or. (key .eq. 0))) go to 960 

c

c CHECK FOR CLEARING THE REFERENCE AREA AROUND THE CHARACTERS 

ne(1)=isfno 

ne(2)=0 

numarea=1

if ((noclear .eq. 0) .or. (nochar .eq. 0)) go to 950 

numvert=0 

numho r z = u 

ao 940 1 = 1/8

if CkplotfieldCi) .eg. 0) go to 940 

numv/ert=numvert + 1 

i c hec k = 5 

do 930 j=1,5

if ((cnar(i,j) .ne. " ") .and. (chard,j) ,ne. "0")) go to 935 

930 icheck=icheck-1

935 if (icheck .gt. numhorz) numhorz=icheck 

940 continue

if (numhorz .eq. 0) go to 950

k= i s fno*1

x x(k)=x po s-0.04

xx(k+1)=xx(K)

xx(k-*-2)=xpos-*-numhorz*heiyht-*-0.02-*-space

xx ( K + 3) = xx ( k-*-2)

yy ( k)=ypos-0.04
APPENDIX C 279

yy ( k + 2 ) =yy ( k +1 )

yy(k+3)=y/(k)

ne(2)=4

nurnarea = 2 

c

C SHADE THE OUTLINE 

950 it em= i t em-*- 1

if (item . g t . numpat) item=1

if ((ipat(item) .le. 0) .or. (ipat(item) .gt. 20)) go to 950

nu(n = ipat(item)

if ((key .gt. 0) .and. (key .Le. 20)) num=key

call set_shdde (num,jshade)

call t one (0 . ,0. t j shade ,-1 6 )

call tone ( x x ,y y ,ne,numa r ea) 

c

C CHECK FOR CHARACTER PLOTTINb 

9&0 if (nochar .eq. 0) go to 840

do 1025 i=1,8

do 970 j = 1,8 

970 if (kplotf ield( j > .eq. i) go to 980

go to 1025 

980 num=0

do 990 k = 1,5

if (char(j,k) .ne. " ") go to 1000 

990 num=num+1 

1000 if (Cnum .eq. 0) .or. (kfield(j) .eq. " 0")) go to 1U25

n= b-num

i f (n .eq. 5 ) go to 1 01 5

do 1010 m = 1,n

1010 i t e x t ( m ) =cha r ( j ,m+num) 

1015 posx=xpos

iscale=height*16+0.5

do 1020 k = 1,n

call letter ( 1 / i s ca I e/ 0, posx t y pos* i t e x t ( k ) ) 

1020 posx = pos x + he i gh t •*• space

ypos=ypos-height -space 

1025 cont i nue

go to 8AO 

c

c END OF FILE REACHED 

1030 write (10,1040) 

1040 format ("PLOT: END OF FILE REACHED

& WHEN TRYING TO READ A DATA RECORD")

go to 1070

c

c ALL FINISHED

1050 write (10,1060) name

1060 format ("FINISHED PLOTTING ",a20)

1070 call closef (in2)

return

end
280 GEOINDEX

SUBROUTINE NAME: PATTERN

Author: Lawrence Balcerak

Purpose of the program: pattern sets the shading pattern variables to user-defined values. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call pattern 

Arguments: None 

Subroutines called: None 

Common data referenced: I pat I

Input files: None 

Output files: None

Arrays used: /p7(76), ip2(16), ip3(4), ip4(4), ip5(16)t 

ip6(16), ip7(16), ip8(16), ip9(16), ip10(16) (shading 

pattern arrays)

Called by: index_versatec, verplot 

Error checking and reporting: None 

Constants: None 

Program logic: 

1. Set all elements of the shading pattern arrays to

those integer values that will give the bit patterns

desired.

10

20 

c

subroutine pattern

common /pat/ ip1(16)/ip2(16)/ip3(4)/ip4(4)/ip5(l6)/ipo(l6)/

4 ip7(16)/ip3(16)/ip9<16)/ip10<16> 

do 10 1=1/4 

ip3< i >=0 

ip4( i )=0 

continue 

do 20 1=1/16 

ip1 (i )=0 

ip2( i )=J 

ip5( i )=0 

ip6(i )=0 

ip7( i )=0 

ip8( i)=0 

ip9( i )=0 

ip10(i )=0 

cont i nue

ip1 ( 1 )=4*16**4+1

ip1 (b) = 16*ip1 (1)

ip1 (9)=d*16**6+2*16**2

ip1 (13)=16*ip1 (9)

ip2(4)=ip1( 1 3) 

ip2(8)=ip1 (9) 

ip2(12)=ip1 (5) 

ip2(16)=ip1 (1 )

ip3( 1 )=4*16*

ip5( 1 )=4*16**7

ip5(2)=16**8+16**7

ip5(4)=2*16**8-«-8*16**6

ip5(6)=ip5(2)

ip5(/)=ip5( 1 )

ip5(9)=l6**3

ip5(12)=8*16**3+2*l6**2 

ip5(14)=ip5(10) 

ip5(15)=ip5 (9)
APPENDIX C 281

ip7(4)=16**4+8*16

ip7(8)=4*16**8+4*16**7+2*16**6+16**4+l6**3+8*16 

ip7(12)=4*16**8+2*16**6 

ip7(1b)=ip7(8)

ip3(1)=ip6(1) 

ip8(9)=ipb(1)

ip9(2)=ip5(2)

ip9(4)=ip5(1)

ip9(6)=ip5(2)

ip9(8)=4*l6**8+2*16**6+16**4+8*l6

ip9(10)=ip5(10)

ip9(12)=ip5(9)

ip9(14)=ip9(10)

ip9(16)=ip9(8)

ip10(2)=ip5(9)

ip10(4)=16**4+5*16**5+4*16**2+8*16

ip10(6)=ip10(2)

ip10(8)=4*1b**7-H6**3

ip10(10)=ip5(7)

ip10(12)=5*16**8+5*l6**7+2*16**b

ip10(14)=ip10(10)

ip10(16)=ip10(8)

return 

end

PROGRAM NAME: PIN90

Author: Pearl Porter

Purpose of the program: pin90 plots map indices interactively on the Tektronix terminal. The user has several 

options: plotting the entire United States, plotting as 

many as 10 individual States, plotting the grid file, 

plotting input files from GRASP, and getting an 

enlargement of a specific area.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: pin90

Arguments: None

Subroutines called: initt, anmode, erase, movabs, 

dwindo, swindo, movea, drawa, hdcopy, finitt (all 

Tektronix routines), io (Multics), grid, plocv, enlrg, 

indiv

Common data referenced: x1, y1 , x2, y2

Input files:

stat90 used on unit 14 (file14), file of x, y coordinates 

Files from GRASP used on unit 15 (file15), which plot

numbers, symbols, and outlines 

Grid file used on unit 16 (fileW), which is used to plot 

the grid on the map

Output files: None

Arrays used: None

Called by: None

Error checking and reporting: If program requests a

digit (1 or 2) from the user, it will loop until a number

(1 or 2) is typed in by the user. 

Constants: None 

Program logic:

1. Prompt:

NEED SYMBOL CODES? (ENTER Y FOR

YES)

If no symbol codes are needed, program goes to 

step 4.

2. The symbols and their corresponding numbers will 

be printed on the screen.

3. Prompt:

TAP 1 AND RETURN KEY WHEN READY

4. The screen will be erased.

5. Prompt:

ENTER SYMBOL NUMBER AND FILE TO

BE PLOTTED:

This refers to the input files from GRASP. As 

many as five files and symbols may be entered. 

They will be read into file15. Eight is the maximum number of characters for a file name.
282 GEOINDEX

6. In reference to the files just read, the user has three

options. 

Prompt:

FOR SYMBOL AND NUMBERS (WITH

PLOTTING), TYPE 1

FOR SYMBOL AND/OR OUTLINE (NO

NUMBERS), TYPE 2

FOR NUMBERS ONLY (NO SYMBOLS OR

PLOTTING), TYPE 3

7. Screen is erased.

8. Define screen and virtual window.

9. The user is prompted by a series of questions at this 

time because no communication can take place 

between computer and user after the plotting 

starts without destroying the screen. See steps 

10-14.

10. Prompt:

ENTER TITLE FOR MAP:

11. Prompt:

TO PLOT INDIVIDUAL STATES, ENTER 

1-FOR ENTIRE U.S. ENTER 2

12. Prompt:

TO PLOT COUNTIES ENTER 1 FOR SOLID 

LINE, 2 FOR DOTTED LINE, ELSE ZERO

13. Prompt:

TO PLOT GRID, ENTER 1

14. Prompt:

IF YOU WANT A HARD COPY UPON COMPLETION, TYPE C

15. If the user entered 1 in response to step 11, the program calls subroutine indiv. The program then 

goes to step 19.

16. If the user did not enter 1 or 2 for step 11, a 

message is printed on the screen: 

AT THE PRESENT TIME, THE FILE YOU

WISH DOES NOT EXIST PLEASE ENTER 1 

OR 2 FOR SECOND STATEMENT

Program returns to step 10. If 2 was entered, program goes to next step.

17. The program writes the title for the map, draws the 

borders, and uses Stat90, file14, to plot the 

States.

18. If 1 was entered in response to step 13, program 

calls grid subroutine and returns to next step.

19. If ///' = 0, program goes to 20 (///' = number of files

entered in step 5) 

If ///' is not equal to 0, read first file name into file 15

and call subroutine plocv. 

Continue this step until the number of files entered

in step 5 /// = number of files read into filel 5 ///'.

20. If C was entered in step 14 or 23, a hard copy will be

made automatically.

If nl = 1, go to step 26. If nl does = 1, this indicates 

an enlargement or individual plotting has already 

been completed or the option to do so has already 

occurred.

22. Prompt:

FOR AN ENLARGEMENT OF PART OF 

THIS PLOT, TYPE Y

23. Prompt:

FOR A HARD COPY AFTER ENLARGEMENT, TYPE C

24. nl = 1 indicates that an enlargement option has 

been found.

25. If Y was entered for step 22, call subroutine enlrg 

and upon return, go to step 19.

26. Detach and close files.

21

PIN90 *****

cPLOT MAP INDICES ON TETCTRONIX****

c U.S. Geological Survey

c Program name - pin90

c INPUT:

c stat90.pat = filelA

dimension lead(20),xx(6),yy(6)

dimension jsym(9),isymb(5)

external io (descriptors)

character filename*8(5)

common xl,yl,x2,y2 

c

data jes/"y"/,kop/"c"/,iblk/" "/

data jsym/35,36,37,38,42,43,45,79, 111/

data izero/00/
APPENDIX C 283

c

call initt(960) 

c 

c

ichar=43 

c 

c ASSIGN AND OPEN FILES

call io ("attach","file14","vfile_ ","stat 90.pat","-append")

call io ("open","filel4","si") 

c

call anmode

print ,"Need symbol codes? (enter y for yes) "

read (0,100)irep 

100 format (al)

if (irep .ne. jes)go to 250

do 200 i-1,9

istb = jsym(i)

ile - jsym(i)*2**27

c The above computation was made to shift the symbol to the leftmo 

\cst posit ion.

call anmode

write (0,150) istb,ile 

150 format (2x,i3,3x , a 1) 

200 continue

c Pause in execution so user can look at symbols and corresponding 

\c numbers•

print ,"Tap 1 and return key when ready"

read (0,600)iredy 

250 call erase 

c call movabs(30,725) 

c call anmode

c print ,"Enter state id number" 

c read(0,300) istate 

c300 format(aA) 

c 

c

c REQUEST INPUT FILE FOR PLOTTING 

c 

350 continue

kk = 0

iJJ-0 

1J1-0

call anmode

call movabs(30,725)

400 print ,"Enter symbol number and file to be plotted: " 

c iji will equal 1 more than the number of files read.

iji =* iji+1

read(0,450)isym,filename(iji) 

450 format (12,a8)

if (isym .eq. izero) go to 500

isymb(iji)=isym

go to 400 

c 

500 continue
284 GEOINDEX

C

call movabs(30,625)

call anmode 

c User is given an option as to what he wants on the map.

print ,"For symbol and numbers (with plotting), type I/ 

& For symbol and/or outline (no numbers), type 2/ 

& For numbers only (no symbols or plotting), type 3"

read (0,600) idee

call erase 

c

c SET ORGIN ON PLOTTER 

c

xl = .5

x2=23.

yl = l.

y2=16. 

c Define virtual window

call dwindo(xl,x2,y1,y2) 

c 

c Define Screen window

call swindo(0,1023,0,780) 

c 

550 nl=0

call movabs(30,750)

call anmode 

560 print ,"Enter title for map: "

read(0,570)lead 

570 format (20a4)

print ,"To plot individual states enter l--for entire U.S. en 

\cter 2"

read(0,600)istat

c print ,"To plot counties enter 1 for solid line,/ 

c 2 for dotted line, else zero " 

c read (0,600) icoun 

c print ,"To plot grid enter 1 " 

c read (0,600)igrid 

600 format (il)

print ,"lf you want a hard copy upon completion, type c "

read (0,100) icopy

call erase 

c If istat=l, user will choose up to 10 states to be plotted.

if (istat .eq. 1) go to 1300

call movabs(30,760)

call anmode 

c Lead contains title for map.

write (0,610)lead 

610 format (Ix,20a4) 

c

if (istat .ne. 2) go to 1400

c If istat=2, the entire U.S. will be plotted, 

c 

c 

c DRAW BORDER FOR MAP

call movea(xl,yl)
APPENDIX C 285

call drawa(x2,yl)

call drawa(x2,y2)

call drawa(xl,y2)

call drawa(xl,yl) 

c

c PLOT DATA FROM FIRST SOURCE, 

c

c Read header information.

700 read (14,750,end-1100)if,ifno,isf,isfno,if 1 

750 format (5i5) 

c ISFNO is the number of x-y coordinates.

ie=isfno

if (isfno .ge. 6) ie=6

call anmode 

c Read x-y coordinates.

read (14,800) (xx(i),yy(i),i= 1,ie) 

800 format (12f6.3) 

c 

825 call movea (xx(1),yy (1 ) )

do 850 k=l,ie

call drawa(xx(k),yy(k) ) 

850 cont inue

is fno=i sfno-6

if (isfno)700,700,900 

900 if (isfno-6)950,950,1000 

950 ie = isfno 

1000 read (14,800,end=1100) (xx(i),yy(i),i=1,ie)

do 1050 k-1, ie

call drawa(xx(k),yy(k))

c Draw until isfno(no. of coordinates) has been exhausted. 

1050 continue

if (isfno-6)700,700,850 

c 

c

c ATTENTION: When we get grid file, change end=1100 to end=1075 

c!075 if (igrid .ne. 1) go to 1100

c call io ("attach","f ile 16", "vfile_ll ,"grid90", "-append") 

c call io ( Il o P en","filel6","si 11 ) 

c 

c

c iji = number of files to be plotted. 

1100 if (iji .eq. 0) go to 1200 

c 

c PLOT MAIN FILE

1150 ijj = iJJ+1

if (ijj .eq. iji) go to 1200

isym = isymb(ijj)

call io ("attach","filel5", M vfile_",filename(ijj) /'-append")

call io ("open","filel5","si")

c.ill plocv(isym,nl,idec)

go to 1150 

c 

c
286 GEOINDEX

1200 if (icopy .ne. kop) go to 1250

call hdcopy

c If nl=l, the enlargement or individual plotting has already been 

\c completed. 

1250 if (nl .eq. 1) go to 1500

call movabs(30,730)

call anmode

print ,"For an enlargement of part of this plot, type y "

read (0,100)irep

print ,"For a hard copy after enlargement, type c "

read (0,100) icopy

nl = 1 

c Set ijj=0 as it has been incremented previously.

ijj = 0

if (irep .ne. jes) go to 1500

call enlrg(14)

go to 1100

c 

1300

c

c

c

1400

\c"

1500

c 

c

nl

0

call indiv(lead) 

go to 1100

print ,"At the present time, the file you wish does not exist

print ,"Please enter 1 or 2 for the second statement"

go to 560

call io ("close","file!4")

call io ("detach","filelA")

call io ("close","file!6")

call io ("detach","filel6")

call finitt(O.O)

end

SUBROUTINE NAME: ENLRG

Author: Pearl Porter

Purpose of the program: enlrg enlarges a part of the

plotting on the screen that the user defines by means

of the crosshair cursor. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Catting sequence: call enlrg 

Arguments: None 

Subroutines called: movabs, anmode, vcursr, dwindo,

swindo, erase, movea, drawa, ancho (all Tektronix

routines)

Common data referenced: x1, y1, x2, y2 

Input files: stat90 used on unit 14 (file14) 

Output files: None

Arrays used: xx(6), yy(6), ist(10)

Called by: pin90

Error checking and reporting: Located in program

pin90

Constants: None 

Program logic:

1. The virtual screen is redefined by means of a 

Tektronix plotting routine called vcursr. The user 

positions the cursor at the lower left of the desired 

area, and its screen coordinates are transmitted to 

the computer by typing C. Then the user positions 

the cursor at the upper right of the desired area 

and again types C.

2. The screen is automatically erased.

3. A border is drawn for the map.

4. file14 is again read, and the States within the limits 

of the specified virtual screen are plotted.
APPENDIX C 287

c * * *

c Thi

c

c

c

30

* SJdROUTI.ME ENLRG.FORTRAN ****

suo rou tine entry 

s routine enlarges a portion of the

jefined by the cross-hair cursors.

screen as

"//kop/"c"/

10

c Re 

20

dimension xx(6)/yy(6)/ista(10) 

common x1/y1/x2/y2 

data jes/"y"//iolk/" 

ichar = A3 

rewind 1 A

call movabs(30/oVO) 

call an mode

define grapnic area by 

write (0/20)

format("Position cursor at lower left 

call vcursr(ichar/x1/y1 ) 

call movabs(30/680) 

call a nmode 

write (0/30)

format("Position cursor at upper right of desired area/type c 

call vcursr(ichar/x2/y2) 

call dwindo(x1/x2/y1/y2) 

call swindo(0/1023/0/780)

using vcursr routine.

of desired area/ type c

call erase 

c 

c DRAW BORDER FOR MAP

call rnovea(x1/y1)

call d rawa(x2/y1 )

call drawa(x2/y2)

call or awa(x1/y 2)

call drawa(x1/y1) 

c

call anmode

c Read header information.

70 rear! ( 1 A/80/end = 1 60) i f / i f no/i sf / i sf no/i f 1 

80 format (5i5) 

c 

90 i e = i s fno

if (isfno . ge. 6) ie=6

call anmoae 

c Read x-y coordinates.

read (14,103) (xx(i)/yy(i)/i=1/ie) 

100 format (12f6.3)

if (isfno . g e. 3) go to 105

call movea(xx(2)/yy(2))

call ancho(ichar)

go to 70 

105 call movea(xx(1)/yy(1 ) )

do 110 k=1/ie

call drawa(xx(k)/yy(k)) 

110 cont i nue
288 GEOINDEX

120

130

c

140

150 

c

160

c

18U

i s fno= i s fno-6

if (isfno)70,70,120

i f (isfno-6)130,130,140

i e = i s fno 

Read x-y coordinates.

read (14,100,end=160) (xx(i),yy(i),i=1,ie)

do 150 k = 1,ie

call drawa(xx(k),yy(k ))

continue 

Continue drawing until isfno(no. of coordinates) has been exhausted

if (isfno-6)70,70,110

cont i nue

return 

end

SUBROUTINE NAME: INDIV

Author: Pearl Porter

Purpose of the program: indiv is called when 1-10 States 

are to be plotted. This routine negates plotting the entire United States. If will enlarge the maps of individual States as an option.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call indiv (lead)

Arguments: lead-Contains the title of the map

Subroutines called: movabs, anmode, erase, movea, 

drawa (all Tektronix routines), min_max

Common data referenced: None

Input files: statQO used on unit 14 (file14)

Output files: None

Arrays used: xx(6), yy(6), ista(10), lead(20)

Called by: pin90

Error checking and reporting: Located in pin90 

Constants: None 

Program logic:

1. An array ista is loaded with blanks.

2. The user is asked to type the corresponding 2-digit 

number for the States to be plotted (limit of 10 in 

ascending order).

3. The numbers are stored in Ista.

4. Call min_max subroutine to find the minimum and 

maximum range for the x and y coordinates.

5. The screen is erased.

6. The title of the map is written on the screen and the 

border is drawn.

7. file14 is read until ista(J) equals if no (found in header 

record). The coordinates are then plotted until 

isfno (number of x, y coordinates) has been exhausted. The program continues to read through 

the file until the end of file is reached or /sfa(/) 

equals blanks.

 SUBROUTIIME INDItf.FORTRAN** **

subroutine indiv(lead)

This routine is used when only 1-10 states are to oe plotted. 

The user requests up to 10 states by number and these are 

stored in an array called ista. In order to use the entire 

screen, min_max routine is called to redefine the virtual 

screen thus giving an enlargement of the states requested.

dimension xx(6),yy(6),ista(10),lead(20) 

data iblk/" "/,kop/"c"/

data izero/00/

nn3 = 993 

Load ista with blanks
APPENDIX C 289

10 do 20 j=1*1U

ista( j ) = iblk 

20 cont i nue 

c

CdLL movabs(30,690)

call anmode

wr i te (0,30)

30 format ("Give code number of each state to be plotted

Limit of 10 codes in ASCENDING order 

Must be a d digit number, 01-51")

read (0,40) (ista(j),j=1,10) 

AO format (10i2)

c The min_max routine will find the minimum and maximum coordinates 

c for the states requested and redefine the virtual window.

call min_max(ista,x1,x2,y1,y2)

call erase

call movabs(500,750)

call anmode 

c Lead is the title of the map to be plotted.

write (0,45) lead 

A5 format (1x,20aA) 

c 

c DRAW BORDER FOR MAP

call movea( x 1 ,y 1 )

call d rawa(x2,y 1 )

call d rawa(x2,y2 )

call drawa(x1,y2)

call drawa(x1,y1) 

c

50 do 160 j=1,10 

c Read header information.

60 read ( 1 A,70,end = 1 SO)if,ifno,isf,isfno,if1 

70 format (5i5) 

c

if (ista(j) .eq. izero) go to 180

if (ista(j) .ne. ifno) go to 60

if (if .ne. nn3) go to 60

c Check if=993 to insure information from header record is 

c being compared rather than erronously matching the 

c state number against the coordinates. 

80 i e = i s f no

if (isfno .ge. 6) ie=6 

c Read x-y coordinates.

read (1A,90) (xx (i),yy(i ) ,i = 1,ie) 

90 format (12f6.3)

if (isfno .ge. 3) go to 100

call movea(xx(2),yy(2))

go to 6U 

100 call movea(xx(1),yy(1))

do 110 k=1,ie

call drawa(xx(K ) ,yy(k )) 

110 continue

i s fno = i s fno-6

if (isfno)160,160,120
290 GEOINDEX

120 if (isfno-6)13U,130,140

130 i e = i s fno

140 read (14/90/end=160) (xx (i),yy(i)/i=1/ie)

do 150 k=1,ie

call d ra wa ( x x ( k )/yy (k )) 

150 cont i nue 

c Continue drawing ntil isfnoCno. of coordinates) has been exhausted,

if (isfno-o)160/160/110 

160 cont i nue 

c 

180 return

end

SUBROUTINE NAME: MIN_MAX

Author: Pearl Porter

Purpose of the program: min_max routine reads 

through the individual States requested for plotting 

and compares each x and y coordinate to find the 

minimum and the maximum x and y coordinates. The 

program then redefines the virtual window.

Data base: Geoindex

Computer: Honeywell Series 60 (level 68)

Operating system: Multics

Calling sequence: call min_max (ista,xl,x2,yl,y2)

Arguments: 

ista -Array containing the numbers of the States to

be plotted

x7-TJsed to return the minimum x coordinate 

x2 - Used to return the maximum x coordinate 

y/ -Used to return the minimum y coordinate 

y2-Used to return the maximum y coordinate

Subroutines called: dwindo (Tektronix routine)

Common data referenced: None

Input files: None

Output files: None

Arrays used: None

Called by: indiv

Error checking and reporting: Located in pin90

Constants: nn3

Program logic:

1. Load x7 with the maximum x coordinate and x2 with

the minimum x coordinate.

Load y1 with the maximum y coordinate and y2 with 

the minimum y coordinate.

2. Read through file14 until /sfa(/) equals if no.

3. Compare each x coordinate to x7 and x2.

If it is less than x1, load x7 with the value of the x

coordinate. 

If the x coordinate is greater than x2, load x2 with

the value of the x coordinate. 

The same logic applies to the y coordinate.

4. Compare each x and y coordinate until the number in 

/S/A7O (header record) has been exhausted.

5. If ista(J) is blank, go to next step. Otherwise, go to 

step 3.

6. Call dwindo (Tektronix routine) using new values 

from step 3 for x7, x2, y7, y2 to define the virtual 

window.

7. Return

****SUt3ROUTINE MIN.rtAX.FORTRAN 

subroutine min_max(ista/x1/x2/y1/y2)

This routine reads through the coordinates for the individual

states requested for plotting and compares each xx coordinate 

against x1 and x2 to find the minimum and maximum coor.

It does the same to the yy coordinates, 

the maximum and x2 and y2 are set to the 

compares are made.

dimension xx(6)/yy(6)/ista(10) 

data izero/00/

x1 and y1 are set to 

minimum before the
APPENDIX C 291

10 

20 

c

50 

c

60

70

c

110 

c 

120

nn3 = 993

x1 = 23.

x2 = .5

y1 = 16.

y2 = 1.

do 110 3=1/10

reaa (1 A/20/end=120) if / ifno/isf/isfno/if1

forma t(5i 5 ) 

If ista = O/ all the requested data has been read.

if (ista(j) ,eq. izero) go to 120

if (ista(j) .ne. ifno) go to 10

if (if .ne. nn3) go to 10 

Check if=993 to insure this record is a header record.

c 

30 

AO

c

c

c

ie = 6 

Read x-y c 

read (1 

format

Read

y 1

do

if

i f

i f

i f

each

-2 to

50 i

C x x (

( x x (

(yy (

(yy (

oord i na 

A/ AU/ en 

(12fo.3

XX

f

= 1

i)

i )

i)

i )

and

ind t

/ i e

.It.

• g t.

.It.

.gt.

tes 

d = 1

yy

he

x1

x2

y 1

y2

20 >

coor

mi

)

)

)

)

ni

x

x

y

y

(xx(

di na

mum

1 =

2 =

1 =

2 =

i)/

te

and

x x (

x x (

yy(

yy(

yy ( i ) / i =1 / i e)

and compare

ma x i mum.

i )

i )

i)

i)

x1-2 and

cont i nue

i sfno = i sfno-6

if (isfno)110/110/60

if (i sfno-6)70/70/30

i e = is fno

go to 30

cont i nue

Define virtual window from coordinates stored during min_max routine 

call dwindo(x1/x2/y1/y2) 

rewind 14 

return 

end

SUBROUTINE NAME: GRID

Author: Pearl Porter

Purpose of the program: grid will plot the grid file,

file16, on the map drawn by pin90 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call grid 

Arguments: None 

Subroutines called: movea, anmode, ancho, drawa (all

Tektronix routines)

Common data referenced: x1, y1, x2, y2

Input files: Grid file used on unit 16 (file16)

Output files: None

Arrays used: xx(6), yy(6)

Called by: pin90

Error checking and reporing: Located in program pin90

Constants: None

Program logic:

1. iskp is set to 9, and a count is kept so that only every 

10th record is plotted.

2. The header record and first set of coordinates are 

read.
292 GEOINDEX

3. If the first xx and yy coordinates are less than x7 or 

y1 or greater than x2 or y2, respectively, read the 

next set of coordinates (step 2)

4. If number of sets of coordinates is less than 3, write 

if, isf, and ichar.

Go to step 2.

5. Plot the coordinates until isfno (number of coordinates) has been exhausted.

6. Read the next header record, add 1 to j and continue 

until j equals iskp, which equals 9. Go to step 2.

c ** **SUBROUTINE GRID****

c THIS ROUTINE WILL PLOT THE GRID FILE

c It has been determined to plot only every 10th set

c of grid records since the Tektronix plot is so small*

subroutine grid 

c

dimension xx(6),yy(6)

common xl,yl,x2,y2 

c

iskp = 9

c Set iskp=9 so as to plot only every tenth record 

c of the grid file.

j = 0

ichar = 43

rsiz = 0.3

rewind 16 

c

c Read header information.

10 read(16,20,end = 270) if,ifno , isf,isfno,if 1 

20 format (5i5) 

c

ie = isfno

if (isfno »ge. 6) ie=6 

c Read x-y coordinates.

read(16,30) (xx(i),yy(i),i=l,ie) 

30 format (12f6.3)

if (isfno .ge. 3) go to 80 

c

c If coordinates are out of range, read next set of coordinat 

\ces .

if ((xx(l) .Ie. xl) .or. (yy(l) .Ie. yl)) go to 10

if ((xx(l) .ge. x2) .or. (yy(l) .ge. y2)) go to 10

if ((ifno .eq. 1) .and. (isf .eq. 1)) go to 60

call movea(xx(1),yy(1))

call anmode

c If there's less than 3 sets of coordinates, write if, isf a 

\cnd ichar.

write (0,40) if 

40 format (Ix,i5)

ry=yy(1)-rs iz

call movea(xx(1),ry)

call anmode

write (0,40) isf

call movea(xx(2),yy (2 ) )

call ancho(ichar)

go to 10
APPENDIX C 293

60 call movea(xx(1),yy(1))

call anmode

write (0,40) if

call movea(xx(2),yy(2))

call ancho(ichar)

go to 10 

c 

80 continue

if ((xx(l) .le. xl) .or. (yy(l) .le. yl)) go to 120

if ((xx(l) .ge. x2) .or. (yy(l) .ge. y2)) go to 120

if ((ifno .eq. 1) .and. (isf .eq. 1)) go to 100

call movea(xx(l),yy(1))

call anmode

write (0,40) if

ry m yy(l)-rsiz

call movea(xx(1),ry)

call anmode

write (0,40) isf

if (ifl .eq. 0) go to 120

ry » ry-rsiz

call movea(xx(1),ry)

call anmode

write (0,40) ifl

go to 120 

c 

100 continue

call movea(xx(l),yy(1))

call anmode

write (0,40) if 

c 

120 continue

call movea(xx(2),yy(2))

do 130 k-2,ie

call drawa(xx(k),yy(k)) 

130 continue 

c 

140 isfno«isfno-6

if (isfno)200,200,150 

150 if (isfno-6)160,160,170 

160 ie « isfno 

170 read (16,30,end»270) (xx(i),yy(i),1-1,ie)

do 180 k=l,ie

call drawa(xx(k),yy(k))

c Draw until isfno(no. of coordinates) has been exhausted. 

180 continue 

c

if (isfno-6)200,200,140 

c

200 j - j+1 

c J is the count of header records read.

read(16,20,end-270) if,ifno , isf,isfno,if 1 

210 ie - isfno

if (isfno .ge. 6) ie=6 

220 read(16,30) (xx(i),yy(i),i-1,ie)
294

c 

\c.

230 

c

250 

c

GEOINDEX 

Read through x-y coordinates until isfno has been exhausted

isfno = isfno-6

if (isfno)250,250,230

if (isfno-6)2 10,210,220

if (j .eq. iskp) go to 10

The above compare is made to determine when the 10th record 

\c is reached.

go to 200 

c 

270 continue

return

end

SUBROUTINE NAME: PLOCV

Author: Pearl Porter

Purpose of the program: plocv will plot the symbols,

numbers, and outline from the GRASP input files

(file15) depending on the value of idee, which was

supplied by the user. 

Data base: Geoindex

Computer: Honeywell Series 60 (level 68) 

Operating system: Multics 

Calling sequence: call plocv (ichar,nl,idec) 

Arguments:

ichar- Symbol designated by the user to be used with 

a specific GRASP input file

nl-Code specifying that this routine was called owing 

to an enlargement option

idee -Code used to determine which of three options 

will be used:

If idee = 1, symbol, number, and outline plotted 

If idee = 2, symbol or outline (with no numbers) 

If idee = 3, numbers only (no plotting or symbols) 

Subroutines called: movea, anmode, ancho, drawa (all

Tektronix routines), io (Multics) 

Common data referenced: x1, y1, x2, y2 

Input files: GRASP file 

Output files: None 

Arrays used: xx(6), yy(6) 

Called by: pin90

Error checking and reporting: Located in pin90 

Constants: None 

Program logic: 

The subroutine does the following:

1. rsiz is loaded with 0.3. Later in the program, rsiz 

will be subtracted from the y coordinate in order 

to print the isf below the if.

2. If nl is equal to 1, loads rsiz with 0.05. If this is an

enlargement of a section of the screen, the 

number to be subtracted has to be decreased to 

compensate for the change in the size of the 

screen.

3. Reads the header record.

4. Reads first x, y coordinate record.

5. If sets of coordinates are more than three, goes to 

18.

6. If the first #, y coordinates are not within the range 

of x1, y1, x2, and y2, goes to 3.

7. If if no = 1 and isf = 1, goes to 13.

8. If idee = 2, goes to 12.

9. Writes the //.

10. Subtracts rsiz from the y coordinate and uses this 

computed coordinate to write isf.

11. If idee = 3, goes to 3.

12. Plots the symbol. Goes to 3.

13. If idee = 2, goes to 17.

14. If nl does not equal 1, goes to 15.

Subtracts rsiz (either 0.3 or 0.05) from the first y 

coordinate.

Moves the cursor to the x and computed y coordinates. Goes to 16.

15. Moves cursor to position designated by x and y 

coordinates.

16. If idee = 3, write if. Goes to 3.

17. Plots symbol. Goes to 3.

18. If the first x, y coordinates are not within the range

of x1, y1, x2, and y2, goes to 20. 

If if no = 1 and isf = 1, goes to 19. 

Writes //, isf, and If1 on map. Goes to 20.

19. Writes if.

20. If idee = 3, there will be no plotting.

Otherwise, continues drawing until isfno (number 

of coordinates) has been exhausted. Goes to 3.

21. At EOF, closes and detaches file15.
APPENDIX C 295 

C ****SU3ROUTINE PLOCV ****

C

suoroutine plocv (ichar*n I* \ dec) 

c

dimension xx(6)*yy(6)

common x1*y1*x2*y2 

c

c If idee = 1* symbol* number and outline will be plotted, 

c If idee = 2* symbol or outline (with no numbers), 

c If idee = 5* numoers only (no plotting or symbols), 

c

rsiz=0.3

if (nl .eg. 1) rsiz = 0.050

rewind 15 

10 cont i nue

c Read header information.

20 read (15*30*end=160) if* ifno*isf * isfno*if1 

30 format (5i5) 

c

i e = i sfno

if (isfno .ge. 6) ie=6 

c Read x-y coordinates.

read (15*4U) ( xx(i)*yy(i)*i = 1 *i e) 

40 format (12f6.3) 

c

if (isfno .ge. 3) go to 70 

c

if ((xx(1) .le. xl) .or. (yy(1) .le. yD) 90 to 20

if ((xx(1) .ye. x2) .or. (yy(1) .ge. y2)) go to 20

if ((ifno .eq. 1) .and. (isf .eq. 1)) go to 60

if (idee .eq. 2) go to 55

call movea(xx(1)*yy(1 ))

call anmode 

c This routine writes if* isf and ichar.

write (0*50) if 

50 format (1 x*i 5)

ry = yy(1)-rsiz

call movea (xx(1)*ry)

call anmode

write (0*50) i sf

if (idee .eq. 3) go to 20 

55 call movea(xx(2)*yy(2 ))

call ancho(ichar)

go to 20 

c

60 cont i nue 

c This routine will write if and ichar depending on idee.

if (idee .eq. 2) go to 67

if (nl .ne. 1) go to 62

ry = yy(1 ) -r si z

call movea(xx(1)*ry)

go to 65

62 call movea(xx(1)*yy(1)) 

65 c d 11 a nmode
296 GEOINDEX

wri te(0/50) if

if (idee .eq. 3) go to 20 

67 call movea(xx(2 ) /yy( 2 ))

call ancho(ichar)

go to 20 

c

70 continue

if C(xx(1) .le. x1> .or. (yyd) .le. y1)) go to 90

if ((xx(1) .ge. x2) .or. (yyd) .ge. y2)) go to 90

if ((ifno .eq. 1) .and. (isf .eq. 1)) go to 80

if (idee .eq. 2) go to 90

call movea (xx(1)/yyd))

call anmode

c This routine will print out if/ isf and if1. 

write (0/50) if

ry = yy(1)-rsiz

call movea(xx(1)/ry)

call anmode

write (0/30) isf

if (i f1 .eq. 0) go to 90

ry = ry-rsiz

call movea(xx(1) t ry )

call a nmode

write (0/50) i f1

go to 90 

c 

80 cont i nue

if (idee .eq. 2) go to 90

call movea(xx(1)*yy(1 ))

call anmode

wri te (0/50) i f 

c 

90 continue

call movea(xx(2)*yy(2 ))

do 100 k=2/ie

if (idee .eq. 3) go to 100 

c If iaec = 3* Dypass any plotting.

call drawa(xx(k)/yy(k)) 

100 cont i nue 

c 

110 i sf no = i sfno-6

if (isfno) 10/10/120 

120 if (isfno-6) 130/130/140 

130 i e = i s fno 

c 

140 readd 5/40,end = 1 60) ( xx ( i ) ,y y ( i ) / i = 1 , i e )

do 150 k = 1 ,ie

if (idee .eq. 3) go to 150

call drawa(xx(k)*yy(k ) ) 

150 continue 

c

if (isfno-6) 10/10/110
APPENDIX D 297

160 continue

call io ("close","f Ue15"> 

call io ("detach","fi Ie15") 

return 

end

APPENDIX D. FORMATS AND NOTES 

FORMAT OF REFNM FILES

Item 

No.

1

2

3

4

5

6

7 

8

9

10

11

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

51

52

53

54

55

56

' Item name

Id _

State

Author 1 _

Author 2

Author 3

Year

Title 1

Title 2

Title 3

County 1 or region 1 _ .

County 2 or region 2

County 3 or region 3 _ _ .

County 4 or region 4 

County 5 or region 5 

Publisher

Scale 1

Scale 2

Scale 3

Scale 4

Scale 5

Series 1 _

Emphasis

Area of coverage

Unit for area of coverage

Extreme west longitude

Extreme east longitude

Center-point latitude _

Center-point longitude _

Boundary id _

Other map not included

Depositories _ _

Base _

Title 4 _

Geology or geochemistry

Plate 1 map plate name

Plate 2 map plate name _

Plate 3 map plate name

Plate 5 map plate name _

Idstat --State code

Idsubl

Id sub 2 _

Id sub 3

Id sub 4

Id sub 5

Bound 1

Bound 2 _

Bound 3 _ .

Bound 4 _ .

Bound 5 _ .

Spanl_

Sran2_ _

Character type

Integer-in automatic

do

do _

Integer

Embedded character string

do

do

do _ _

do

do _

Embedded character string

Integer

do _

do

do _ _

do _ —

Embedded character string

do

Real

Embedded character string

Integer DDDMMSS S1

do — —

do

do _ —

do _

do

Integer not used.

Embedded character string

do _ _ _

Embedded character string

do

do _

do

do

do _

do

Integer —

do _ _

do

do

do _

do _

do _ _

do _

do _

do _

do _

do _

Maximum 

field length

4

20

60

60

60

4

60

60

60

60

60

60

60

8

8

8

8

8

60

60

8

7

12

12

12

12

12

12

60

60

30

60

12

30

30

30

30

30

2

2

2

2

2

2

6

6

6

6

6

6

6
298 GEOINDEX

Item

No.

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

Item name

Span 3

Span 4

Span 5

Series 2

Scale 6

Scale 7

Scale 8

Scale 9

Scale 10

Plate 6

Plate 7

Plate 8

Plate 9

Plate 10

Id sub 6

Id sub 7 _

Id sub 8

Id sub 9 _

Id sub 10

Bound 6

Bound 7

Bound 8

Bound 9

Bound 10

Span 6

Span 7

Span 8

Span 9

Span 10

DumO

Flag for expansion. 

1 prototype. 

2 additional maps. 

Duml

Dum2

Dum3

Dum 4

Dum 5

Dum 6

Dum 7

Dum 8

Dum 9

Character type

do

do

do _

Embedded character string

do

do _

do

do

_ do

do

do

do

do

do

do

do

do

do

do

_ do _ .

'do

do

do

do

do

do

do

Integer

Integer

do

do

do

do

do

do

do

do

Maximum 

field length

6

6

6

60

8

8

8

8

8

30

30

30

30

30

2

I 2

2

2

2

6

6

6

6

6

6

6

6

6

6

30

1

1

1

1

1

1

1

1

1

1 A space and S indicate a decimal point followed by one digit.

FORMAT FOR REFERENCE FILE

Columns 1,2 Columns 3,4,5 Columns 6,7 Columns 8 to 67 

State Reference Item No. Data

No.

12 13 12 60 characters

maximum

NOTES FOR ENTERING CARD DATA

1. Do not put a comma after the year.

2. Item 12: All counties or regions [for Item 12] are typed in small letters.

3. Item 12: All counties or regions are typed on the same line and a 

comma and a space separates each. Counties or regions cannot 

exceed 60 characters. Continue on the next line, creating Item 

13.

4. Item 24 (emphasis) is always typed in lowercase. If there is more 

than one emphasis, add a comma and a space between each one.

5. Items 18-22, 61-65: Omit the period or semicolon after scale.

6. Omit the one digit and colon before the scale.

7. Omit commas between scales.

8. Title can be not more than 60 characters of data; together with the

numeric data (State, ref, item number), 67 characters is maximum number for any one line.

9. Item 38 (geology) is always in lowercase.

10. Items 3-5: Omit spaces between authors initials.

11. Item 17: Omit space between U. and S. in U.S. Geol. Survey.

12. Item 2 (the State name) always has first letter capitalized and the 

rest in lower case, as in Missouri.

13. Item 18-22, 62-65: Omit the (a), (b), (c), and so on, between scales.

14. Item 39-43, 66-70: The first letter in the name of the first plate is 

always capitalized, names of all other plates begin with small letters.

15. If there is no series (Item 23), place a period after name of 

publisher.

16. Do not underscore entered data.

17. Item 35: Type as shown in "Abbreviations for depositories." Use 

no more than 60 characters.

Abbreviations for depositories

USBM = U.S. Bureau of Mines 

BM&G = Bureau of Mines and Geology 

GS = Geological Survey 

WYGS = Wyoming Geological Survey