NBS

'Reference publications

NBSIR 84-3009

BUILDING PENETRATION PROJECT

NAT L INST. OF STAND & TECH

AlllQb aaBAEB

National Bureau of Standards

U.S. Department of Commerce

Boulder, Colorado 80303

September 1984

-QC

100

.U56

8^-3009

1984

IKAnOfJAt BUREAU

STANDARDS \UBRART

NBSIR 84-3009

BUILDING PENETRATION PROJECT

J.C. Wyss

W.J. Anson

R.D. Orr

Electromagnetic Fields Division

National Engineering Laboratory

National Bureau of Standards

U.S. Department of Commerce

Boulder, Colorado 80303

September 1984

Prepared for: Communications Electronics Engineering Installation Agency

Fort Huachuca, Arizona 08613

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

NATIONAL BUREAU OF STANDARDS, Ernest Ambler, Director
* 'Hitruy

if.''

'ftr':

.'•:5J k^IT-

/i . ,

<J'‘

••/‘-•H j ri

.

•a‘ I a

F

••i?«’/y .o.v';;

f'-'^ u¥^t5L

.'Iggs » “•

<, :»»"

ifK.:

^ M. r-"

*s:jit.V.«f^r.'i:')l V,’. iji|r>»/' _

M. .V;,

f 2“;, t..^.

I *.

',. 9*-

kSTii 'A

A &d

'\.r

,rf

.?

|V n

:’iii>y'J*\

Sv:

-j.. * Ik ._ Xj

^ ». '~J.

i- ^

..iv.*- v.-'f'rr ....•^•;'^-»f:i|4'. M

1ST r-

.•Jkv ,>.-.J
CONTENTS

Page

ACKNOWLEDGMENTS iv

1. INTRODUCTION 1 1.1 Background 1 1.2 The Approach 1 1.3 Outline 2

2. SEARCH FOR AND COMPUTATION OF ELECTROMAGNETIC PROPERTIES OF BUILDING MATERIALS 3 2.1 Introduction 3 2.2 The Literature Search 3 2.3 Computations 4 2.4 Uncertainty 10 2.5 Reflection Coefficient and Attenuation Data for Selected Building Materials 13

3. CALCULATION FOR BUILDING SHIELDING EFFECTIVENESS — THEORY 19 3.1 Introduction 19 3.2 Definition of Problem 19 3.3 Input Data Available 19 3.4 Approach 20 3.5 Input Resonances 23

4. COMPUTER PROGRAM DESCRIPTIONS 27 4.1 Introduction 27 4.2 General Description of the Field Calculation Program 27 4.3 General Description of the Data Entry Programs 28 4.4 Data Structures Used in the Programs 28

4.5 Description of Programs and Subroutines Used in Field Calculation 32

5. users' GUIDE TO COMPUTER PROGRAMS FOR DATA ENTRY AND COMPUTATION 37 5.1 Introduction 37 5.2 Data Preparation for Programs SWALLS, STYPES, AND SHOLES 38

5.3 How to Become a Remote-Site Time-Share User 40

5.4 The CDC 170/750 :Data Entry and Computation 41 5.4.1 Log-In Procedure 41 5.4.2 Procedure File MSTORE 41 5.4.3 Data File BxxxxxW (W for Walls) 42 5.4.4 Data File BxxxxxT (T for Types) 43

5.4.5 Data File BxxxxxH (H for Holes) 43

5.4.6 Data File BxxxxxF (F for Frequency) 44 5.4.7 Computation Program MASTER 44

6. EXPERIMENTAL DATA 58

6.1 Sierra and Seneca Falls Army Depots 58

6.2 Naval Training Equipment Center (NTEC) 59

7. COMPUTER RESULTS AND CONCLUSIONS 75 7.1 Comparison With Experimental Results 75 7.2 Recommendation for Further Work 76

8 . REFERENCES 85

9. APPENDICES 86

9.1 Test Plan for Building Attenuation Measurements 86

9.2 Listing of Computer Program SMATDB 9 9.3 Listing of Computer Program SHOLES 109 9.4 Listing of Computer Program SWALLS 1 i*; 9.5 Listing of Computer Program STYPES 161 9.6 Listing of Computer Program SFREQ 18' 9.7 Listing of Computer Program MASTER ^0 9.8 Blank Forms for Data Taking 3".
ACKNOWLEDGMENTS

We would like to thank E. M. Livingston for her excellent help in performing the library

searches that provided much of the data used in this project. Besides thanking J. E. Cruz and

G. R. Reeve for supervising and taking the experimental data, we would also like to thank the

staff at Fort Huachuca for their help in making the field measurements. Stephen Sheeran was very

helpful in writing some of the printout routines, in running some of the test cases, and in

graphing and drawing many of the figures. We also acknowledge the financial support from the

Communications Electronics Engineering Installation Agency, Fort Huachuca, that made this study

possible

.

IV
>> _ rf * *”' 1%

»>'*' - ’ '•:!^^y ^*

• I-: — ,/j *,i. i .« .

* .

' ' - /i "

i

- , I

' •<* i . i^Jtfoai4»

.1 < !»lU I I

^ — • ^ -

-

itSi^t

'iW '* i»*J .•: '•'

i4*i*»^ f <- • i

> ' '

• r ft I n ^

i|i»f .‘a^ *l3ft4 fjt

« «*

ll,. :»' *3>*^it.c «

;sj

. ' .-*'

^ I ri# ,«i'

'

• - It T. ^ 0nt -:"S

i >' -u i? ^ ^

•' :tv L, ' ./\|4 3^4S9<1^ '*0

I. ^

*-i J i

- =^.', . ti>

-vjS« i,;:.f ,:.-j.

3if>i .•• ^ '*• ' '''^’

‘ ‘-' r ,.;- . E ' 4**

>j :(7 •*4 M ' (it M KF-ai. -.7-^i'*''^!fc ^ ij ^ li-f >

- 7

^’-» > - =

c..

’HiMt<. <:f *i *. y. tt*

S!*-^ i - .,*.t*p life 1^4' iiji

<i :ftr ‘~\ t .-

,* l u% •4b.i

ifiSt

I**-*

«ff„ ’ /^2iMfe

. iktl £W* :

s ' 'i '})?,• <i

'-'** *

‘ ^ ^

1 ? v’W<4 , iro^;iOj . 'i6(?j'^'»'^'J'-''

t » r

-!. 56-‘*-.‘ ' r

ife:-^ t^*?f

:' * > ’^ * •'

-t"<^ *.'>. ^ ki *94 ji'?.*-i * •*' ’•'*

^'*'»'-'4> .! S)f-.« • .. -i - •

SMi(, -si - r -^.

» ,v ' ., i

• )

Vf*-' '. • •• - 4 -*- :»

" ^ » 43 ‘ i 4

:*^' v > * 1

- ‘ •

i

‘ if ' ' 7 .'# ®' _

Ll :“*-. Tjr^ ..• ’ ^ • .»f »k ?. . * H'pgl^tr...-.- •>. a'" '

-S'- 5i!!|^|ljw''« *a<4 I '-••' , •• ••

-;• . ISSJUj« '... -rt. » v .'* rr;

rii *'-'! - 4 .= a f Vi.il.

pif J r\i

•a US.

• •-

a.=*V- «•••:

" it fnat . i

*.- *

i0feiH^v .- ts-^

1“ I t (|P4 ^

4 ^
it penetrates the floor, ceiling, and each wall. The total radiant energy within a given room is then the

sum of the energies arriving there via the various room-to-room routes within the building. The ratio (in

dB) of this total radiant energy density to the energy density incident upon the building is the

attenuation, or shielding effectiveness, assigned to that room.

1 . 3 Outline

Chapter two reviev?s the search for electrical properties of common building materials, and the mathematical expressions used to compute wall attenuation from these properties. We list the several computer

data bases consulted, and note the key word groups that summoned the most useful references. Brief derivations of the computation expressions are given.

In chapter three v^e present the theory supporting our procedure for computing the attenuation of

electromagnetic signals by buildings. It is here that we discuss the assumptions in the formulation of

the problem, and limitations imposed by those assumptions.

Descriptions of the data entry programs, data files, and the computation program MASTER constitute

chapter four. This material documents the programs and will he of interest mainly to the person wishing

to know more about their workings. (User instructions are in the User's Guide, chapter five.)

Chapter five is a guide to the use of the programs. There are instructions on how to become a timeshare user, and how to organize data and enter it into the data files. Sample data tabulations are given;

also examples of computer printouts illustrating user-computer conversations during data entry.

In chapter six are the results of building attenuation measurements made by NBS at three Army installations. Graphs present the measured data (in dB) versus frequency, and show the effect of the direction

of incidence (i.e., location of the launching antenna) on the shielding effectiveness of the structures

evaluated. Building floor plans show measurement locations and the placement of launching antennas.

Conclusions and bibliography are chapters seven and eight, respectively. Appendix 9.1 details procedures for making building attenuation measurements and assigning estimated uncertainty. Appendices

9. 2-9.

7

contains the listings for the five data entry programs, and for the computation program MASTER.

Appendix 9.8 is a set of copyahle forms for tabulating data to be entered into the data files.

2
2. SEARCH FOR AND COMPUTATION OF ELECTR0MAGNT:TIC PROPERTIES OF BUILDING MATERIALS

2 . 1 Introduction

This chapter begins with a description of the literature search for data on the shielding effectiveness of building materials and of buildings themselves. The search was primarily a computer interrogation

of several large data bases, although we also perused locally available journals, handbooks, reports and

conference proceedings. This extensive search yielded only a few useful references, just one of which

furnished us with most of our experimental data on conventional building materials.

Our computations of reflection coefficient and attenuation are based on expressions derived in most

introductory texts on electromagnetic fields or electricity and magnetism. We briefly discuss these expressions and their use in obtaining the data in thirteen tables at the end of this chapter.

2.2 The Literature Search

To carry out the computer literature search, we relied on the expertise of Mrs. Victoria R. Schneller

of Library Services, Environmental Research Laboratories, National Oceanic and Atmospheric Administration,

Boulder, Colorado. The data bases consulted were:

• NTISearch, the computer search service of the National Technical Information Service (NTIS) of

the U.S. Dept, of Commerce; accesses all technical abstracts compiled by NTIS; 1964 - present.

• INSPEC (Information Service for Physics, Electrotechnology, and Control); comprises Physics

Abstracts, Electrical and Electronic Abstracts, and Computer and Control Abstracts; established

by the Institute of Electrical Engineers (England); 1969 - present.

• Smithsonian Scientific Information Exchange (SSIE); 1977 - present.

• COMPENDEX, a data base of the Engineering Index Annual, a yearly publication of engineering and

engineering-related abstracts; 1970 - present.

• NSA, the Standards and Specifications data base of the National Standards Association; current

standards

.

• SCISEARCH, the computer file of the Science Citation Index; 1974 - present.

• DTIC (Defense Technical Information Center); reports on research and development supported by

the Department of Defense; 1953-present.

In the search for data on attenuation of electromagnetic waves by building materials, typical kf_>

words used were: electrical conductivity, permittivity, building material, construction material,

radiofrequency, electromagnetic shielding.

3
The best report for experimental data on shielding effectiveness of building materials (Brennan, et

al. [4]) was obtained from the NTIS data base with the combined key words: electrical properties, electrical conductivity, permittivity, building materials, electromagnetic shielding, radiofrequency, construction. A companion paper (Garrett et al. [5]) was obtained using the same key words but omitting "construction." This selection of keywords retrieved papers on both the direct measurement of electromagnetic

attenuation and on measurement of electrical properties from which attenuation could be computed. The

DTIC data base search gave the Brennan [4] and Garrett [5] reports in response to the combined key words:

building, construction materials, dielectric properties, electrical properties, electrical conductivity.

Mrs. Schneller was adept at using different combinations of key words to make an interrogation more specific .

In our search for papers on the attenuation of electromagnetic (EM) waves by buildings (as opposed to

building materials), we used key word groups such as: EM field, EM radiation, EM wave absorption, attenuation, shielding, absorption, building, structure, and construction. One of the most useful papers on

building attenuation (Smith [3]) had been entered in the INSPEC data base with the key words: electromagnetic compatibility, electromagnetic fields, building, shielding, radiowave propagation. As our search

progressed, we found that there was very little data on radiofrequency attenuation by conventional building materials, or even on the electrical properties of such materials.

A computer search based on key words without such qualifiers as "electromagnetic" and "radiofrequency" produces references on the attenuation of nuclear as well as electromagnetic radiation. Many

papers retrieved by key words specific to "radiofrequency attenuation by buildings and building materials"

concerned structures hardened to electromagnetic interference by specialized construction methods and

exotic materials. Often these structures were simply shielded rooms or no more than screened enclosures.

Therefore, although our search was extensive, the data we use in our building attenuation computations has

come from just a few reports which are identified on the data table for each material.

2.3 Computations

The three types of materials for which we computed shielding properties are dielectrics, metal

sheets, and metal meshes. We discuss these computations in that order. All expressions and computed data

are in SI units.

Brennan [4] measured the real and imaginary parts of the complex permittivity of common building

materials as a function of frequency from 10 Hz to 1 GHz. (Because of the variable sensitivity of the

measurement apparatus as the lossiness of the materials varied, measurements often could not be made at

each of the intended frequencies.) From these permittivity values, we computed the power reflection coefficient and power attenuation (dB/cm) for each material in decade steps at frequencies from 10 kHz to 10

4
GHz. If data was not available at a desired frequency, we plotted the given data and then interpolated or

extrapolated to obtain the missing point. We now briefly discuss the relations used in our computations.

The electrical characteristics of a lossy, isotropic dielectric are given by its complex permittivity

(see any text, such as Johnk [6])

e = e' - j£" (2.1)

where the real part, e', contains information on the speed and wavelength of an EM wave in the dielectric

(e' corresponds to the permittivity e of a lossless dielectric). The imaginary term e" accounts for the

lossy nature of the dielectric and appears in expressions for the EM wave attenuation due to those losses.

1/2 Electromagnetic waves are transmitted through a dielectric (lossy or not) with the velocity v = (pe) '

, - 1/2 where p is the permeability of the medium. (The free space values are denoted po, £o> v = (po^o)

^

g S 3 X 10 m/s. Air can be considered free space.) In general, s' and £" are functions of the frequency

of the EM wave traversing the dielectric, as observed in Brennan's data.

Given two adjoining media of permittivities s^ and s^, a wave in medium 1, normally incident on medium 2, has a voltage reflection coefficient ([6], p. 373)

r = ^2

-

*1l

ri2 + Hi

’ = intrinsic wave impedance.

Because P

2 = Po for most building materials in this report, and because medium 1 is air, we can write

^ 1 “ 7^ r = , £ = £o/£n = relative permittivity, 1+4“ r 2

0

^ r

where medium 2 is the building. The power reflection coefficient is then

1 -

1 +

To determine if we must retain £^ in its complex form, we write

£ = (£0 - j£o) = £' - j£"

r £0 2 '’2 r r

( 2 . 2 )

= Ae'J® ; A = [(£p^ + (£p^]^/^ ; 6 = tan”^£^/£p,

and so

(£4^^^ = [(£p^ + ^

5
For the materials in this report that are low-loss dielectrics (e" << 1), we neglect and approximate

as the real quantity whose magnitude is This procedure incurs negligible error in the reflection

coefficient, the worst case being 2.5% (the 30 kHz s', e" values for moist clay brick) which introduces in

eq (2.2) a deviation from the true reflected power of only 0.1 dB. With the above approximation for

our expression for the power reflection coefficient is

(F)^ =

,1 + ^/Fy

(2.3)

As an EM wave traverses a lossy dielectric, it is attenuated; that is, the wave amplitude decreases

with distance. We represent this wave as

E^(z) = Eo e yz _ „

- Eo

-(a + j6)z _ p -Ofz -j6z

? = Eo e e

where the E-field vector is in the x direction, and the wave propagates along the positive z axis. The

exponential factor, Eo e , represents the wave -amplitude attenuation with distance; a is the attenuation

constant. The ratio of amplitudes at points z and z + £ is

Eo e az

Eo e -a(z + £)

a£

e

The attenuation of power density in the wave over the distance £ is the square of this ratio and is e

In decibels, this attenuation is

attenuation (dB) = 10 log e = 10 x 0.4342 In e = 8.684a£

and so

attenuation (dB/length) = 8.684a . (2.4)

For a wave of angular frequency U) in a dielectric of complex permittivity £' - j£" and permeability

p (= po For dielectrics considered here) we have (Johnk [6], p. 173)

a = [Vl + (£’’/£' )^ - 1]^^^ . (2.5)

Brennan has given his values of £*, e" as £'/£o ^od £"/£o (~ £^) which he calls dielectric constant ("relative permittivity," in Johnk) and dissipation factor (Johnk's dissipation factor is £"/£').

g Writing a in terms of these quantities (where c ~ 3 x 10 m/s)

6
^^0 I T 1 /0 27lf'\/£ J £~

2 1/2

a = — [Vi + [VI + (j^r - iv'^

VF V^c

1.48 X 10"® f V^-V [

J.

/ Vi + )2 . ijl/2 ( 2 . 6 )

In eq (2.5), the factor u) Vm£ = 2n/A; thus, the dimension of a is (length) In metric (S.I.) units, a

has the dimension (meter) \ and eq (2.4) will be in dB/m. For our purposes, a more reasonable dimension

is dB/cm, and so our values for attenuation were computed from the expression

attenuation (dB/cm) = 0.08684a , (2.7)

with a obtained from eq (2.6).

For metals and materials with significant conductivity, a, the complex permittivity is more

appropriately written

£ = £-!-.lu Following the discussion in Johnk ([6], ch. 3), the corresponding form for a is

a = M |/l + (-2)2 . i]l/2 ^ ^ ^ LU£

( 2 . 8 )

(2.9)

For metals a ~ 10^ mhos/m. Therefore, even at 10 GHz, (|jjj^)^

» 1> and a can be written

ui Vm£ I ^ - / lupa / “ ^ Hi " ^ 2 .-^~ r~

where is relative permeability, is conductivity relative to copper, and is the conductivity of

ubstituting po

=

a = 15.13 VfM~o“

copper. Substituting po = 4ti x 10 ^ farads/meter and = 5.80 x lO^ mhos/meter, we have

r r and so

attenuation (dB/dm) = 0.08684a = 1.314 -Jf\j o . r r (2.10)

This is the expression in Denny ([7], p. 5-6) for the attenuation of an EM wave traversing a metal sheet

1 cm thick. With eq (2.10) and values for p^ and from Table 5-2 in Denny, we computed attenuation

values for iron, copper, and aluminum sheets.

For a plane wave normally incident on a surface, the incident, reflected, and transmitted powers ar<

related as

P. = P + P_ , 1 r t

’

2 where P^ is the wave power density (w/cm ) just across the interface and before the wave traverses .iny r.f

the medium into which it has just passed. Then

7
1 2

and so

= 1 - (r^)^ (2.11)

where and P^ are the magnitudes of voltage reflection and transmission coefficients, and their squares

are power reflection and transmission coefficients. In Denny ([7], p. 5-5), the reflection loss in dB is

given as

R = - 10 log (P^)2 . (2.12)

For iron and copper, R values are tabulated in Campi ([8], p. 28), and presented graphically for iron,

2 copper, and aluminum in Denny (p. 5-15). Solving eq (2.12) for (P^,) , we have

(r^)^ = 10 -R/IO

and we write the power reflection coefficient as

(Pj.)^ = 1 - 10“^^^°

. (2.13)

In Denny [7] and Campi [8], the smallest value of R is 57 dB from 10 kHz to 10 GHz. Therefore, we set the

power reflection coefficient to unity over this frequency range for iron, copper and aluminum.

The attenuation of plane EM waves incident normally on metal wire meshes has been computed by Jakubec

and Ohta [9], and we give their attenuation values in Tables 2.9 and 2.10 for galvanized steel and copper

meshes. Jarva [10] has done some plane wave attenuation computations from the same equations and his

values are close to those of Jakubec and Ohta. Some measured attenuations quoted by Jarva support the

computed plane wave values. The theoretical expressions employed in both reports are identical, though

Jarva gives their derivations.

The mesh attenuation ("insertion loss" in Jarva) computed by Jakubec and Ohta is the same quantity as

R in eq (2.12). Using eq (2.13) and attenuation values in Tables 2.9 and 2.10 for R, we see that we are

justified in setting the mesh reflection coefficients to unity.

The attenuation and reflection coefficients of a reinforced concrete wall are almost totally due to

the reinforcing bars ("rebars") within the concrete. The low shielding effectiveness of concrete alone is

seen in our computations of attenuation and reflection coefficients from Brennan's permittivity data for

moist mortar (Table 2.2). ("Moist" means the mortar samples were exposed to a saturated atmosphere for

one day prior to measurement. Some samples were measured dry: they were baked at 140°F for about 20 hours

prior to measurement. However, the moist samples had electrical properties most similar to those of materials in field conditions.) There are many types of concrete reinforcing structures. In some cases,

parallel bars without cross members are used; the bars may be horizontal or vertical. When a mesh is

8
used, the vertical and horizontal bars may have the same spacing and the same bar diameters, or the vertical bars may be heavier and closer together. (Rebar diameters range from 0.95 cm to 6.4 cm.) Thicker

walls may have two reinforcing layers: a 20-cm thick concrete wall could have a rebar layer 5 cm in from

each face. Thus, knowing only that a concrete wall is reinforced, one cannot be sure of the reinforcing

configuration. We use a square mesh to illustrate how rebar shielding may vary with frequency.

The equations presented in references 7, 9, and 10 for the attenuation of plane EM waves by metal

screens are based on the transmission of evanescent modes through a waveguide below cutoff. However,

reinforcing meshes in concrete have such large openings that cutoff occurs at much lower frequencies, well

into the frequency range (10 kHz - 10 GHz) considered in this report. Therefore, we compute the power

reflection coefficient for rebar meshes using an equation developed by MacFarlane ([11], p. 1527) for the

voltage reflection coefficient for plane waves incident on an infinite parallel-wire grid, the plane of

polarization parallel to the grid. Hill and Wait [12] obtain the same expression in their analysis of the

scattering of a transient plane wave by a periodic grating. In both these treatments the scattering

structure is an infinite set of equally-spaced parallel wires; there are no cross members, unlike the

rebar mesh we are considering. However, Hill and Wait [13, 14] show that, for normal incidence, the

reflection coefficient obtained by MacFarlane [11] and by Hill and Wait [12] is applicable to scattering

from a mesh. For waves at normal incidence, the two crossed grids forming the mesh decouple and interact

with the waves as separate, independent parallel-wire grids, each responding only to the E-field component

along it. Thus, when the plane of polarization is aligned with one grid, the other has no interaction

with the waves and drops out of the analysis. For normal incidence, the mesh field equations obtained by

Hill and Wait [13, 14] yield the MacFarlane expression for the reflection coefficient of a parallel-wire

grid.

The decoupling of crossed grids of parallel wires is also shown by Kontorovich [15] and Astrakhan

[16], but only for the long-wavelength condition (d << A, d = separation distance between wires of a grid).

(Their results cannot be used for wavelengths equal to or less than d, as in our rebar computations.) The

analysis contains a term proportional to the electrical resistance between the grids at the points where

the wires of one grid are bonded to those of the other. The reflection coefficient for waves at normal

incidence does not depend on this term so the grids are, in effect, independent elements of the mesh. For

d << A, MacFarlane 's expression for the normal incidence reflection coefficient of a parallel-wire grid

reduces to the expression for a mesh [15, 16].

For wavelengths longer than the wire spacing, the power reflection coefficient obtained from MarFarlane for 0° angle-of-incidence is

9
1 ^ [F(^,0«) * in 5^)2

(2.14)

where d = wire spacing, a = wire radius. For ^

1 (d = wire spacing), F(^, 0®) is a real factor given

graphically in references 11 and 12. For short wavelengths (^ > 1), F becomes complex (F = F^ + j F^),

(2.15)

and values for F^ and F^ are also plotted [12]. The power reflection coefficient is then

ir I r 2d „ s2 ,2d.2 ft, , 1 d .2

We have used eqs (2.14) and (2.15) to compute the plane-wave power reflection coefficient for a square

rebar mesh.

Campi [8] discussed the shielding effectiveness of a rebar mesh having d = 35.6 cm and a = 2.2 cm.

We used these dimensions in computing rebar power reflection coefficients from eqs (2.14) and (2.15). The

definition of shielding effectiveness (SE) for any shielding material is ([7], p. 5-2)

P P SE = 10 log ^

= - 10 log :^ = - 10 log (r )^ = attenuation (dB)

2 ^1

where (Pp P2) = power density (without, with) the shield in place. Then we use eq (2.11) and compute the

rebar attenuation from the expression

attenuation (dB) = - 10 log (T^)^ = - 10 log (1 - (F^)^). (2.16)

We summarize our computation equations:

• Power reflection coefficient for a dielectric sheet: eq (2.3).

• Power attenuation within a dielectric sheet: eqs (2.6), (2.7).

• Power reflection coefficient for a metal sheet: eq (2.13).

• Power attenuation within a metal sheet: eq (2.10).

• Power reflection coefficient for a metal screen: eq (2.13), using eq (2.12).

• Power reflection coefficient for a rebar mesh: eqs (2.14), (2.15).

• Power attenuation (insertion loss) for a rebar mesh: eq (2.16).

2.4. Uncertainty

For the quantities we have computed (reflection coefficient, attenuation per unit length), we used

expressions derived for plane waves at normal incidence. Into these expressions we put measured values

for the real and imaginary parts of the complex permittivity. Thus, our computed quantities have uncertainties originating in the measured data we obtained in our literature search. (The reports from which

this data was obtained do not give measurement uncertainties.)

10
However, we must include additional uncertainties in our computed data to account for other factors

which influence reflection coefficients and attenuations. For example, although we have assumed normal

incidence, waves may be incident at angles from 0° to 90°. A concern? Yes. Fresnel's reflection equations tell us that the reflection coefficient depends on the angle of incidence and the orientation of the

plane of polarization with respect to the plane of incidence. The power in a reflected wave may also vary

with surface dampness. Another factor adding to the uncertainty in our data is the dependence of wood

permittivity on temperature and relative humidity [17], on the angle between the plane of incidence and

the wood grain [17], and on chemicals used in treating the wood [18]. There may be other less determinate factors contributing to deviations from our computed data, factors such as manufacturing differences,

age of materials, and surface weathering.

Because our computation equations were derived from plane-wave models, they contribute further to the

uncertainty of our computed data. As discussed in Denny ([7], section 5.3.2), the reflection coefficient

depends on the intrinsic impedance of the incident wave. Plane waves have an intrinsic impedance of about

377 fi, while waves in the near fields of loop and dipole antennas are not planar and have lower and higher

impedances, respectively. These three types of electromagnetic field are all different in their reflection

loss versus frequency curves. The reflection loss of high and low impedance fields also depends on the

distance of the reflecting surface from the source antenna. Thus, the reflection coefficients we have computed will differ from the true reflection coefficient when the incident wave is something other than plane.

The program MASTER computes only worst-case values for building attenuation and does not do an error

analysis. The latter would be of little use considering our lack of detailed information on radiation

environments and building structure and contents. However, to acknowledge the "unknowable" uncertainties

introduced into our data by the various factors we have discussed, we suggest the following broad uncertainty estimates for the quantities specified:

• 1% - the essentially infinite attenuations and unity reflection coefficients of metal sheets and

meshes. This small uncertainty indicates that these materials have a nearly constant effect

versus frequency and changing environment.

• 10% - the attenuations of the dielectric materials (e.g., glass, brick, wood). We have assigned

this higher uncertainty because these materials, nearly transparent up to microwave frequencies,

are the major reason why fields so easily penetrate conventional buildings. Variations in the

electrical properties of these materials will alter (though only slightly) the power density of

waves passing through them into building interiors.

‘ 100% - the reflection coefficients of the dielectric materials. This large uncertainty should

include most variations in reflection coefficient with angle of incidence, material properties,

and environmental conditions.

11
Note that these uncertainties are in the reflected and attenuated powers and not in the decibel per

centimeter values for attenuation.

When we compute the plane-wave shielding effectiveness of a layer of construction material in a wall,

the reflection coefficient of the material tells us how much incident power is turned back by the layer,

and the attenuation (dB/cm) tells us how much power is absorbed within the material of the layer. (By

"power," we mean power density in the wave, e.g.

,

W/cm .) Reflection occurs not only at the front, but

also at the back surface of the layer. Depending on the reflection coefficient and the attenuation, there

may be enough power in the back surface reflection that the succeeding multiple internal reflections within the layer must be considered in determining the net transmission through the layer and the net reflection from the layer. (In this regard, solid metal shields can be neglected. They have such high attenuation that little or no electromagnetic field reaches the back surface of the shield.) Common building

materials are dielectrics with very low attenuation and reflection coefficients, and much of the power in

the incident wave passes through such a material. Therefore, we must decide if it is sufficient to consider only the front surface reflection, or if the multiple internal reflections within a dielectric layer

should be taken into account.

At any instant, the internal reflections within a dielectric sheet produce an infinite series of

waves leaving the front and back surfaces of the sheet. The vector addition of the fields in these waves

gives the net reflected and transmitted wave. However, to simplify the treatment and still get an estimate of the reflected and transmitted power, we assume constructive interference between all the emerging

waves and so add their powers to obtain the total reflected and transmitted power. For low-loss dielectrics, we neglect attenuation within the material. This procedure gives the total reflected power

nv r

p = —=—p

r

1 + (p )2 0 .-

where P^ is the power density of the incident wave, and (F^)'^ is the power reflection coefficient. The

total transmitted power is

1 - (r p. = ——^ p . 1 + (rj 2 o

For our dielectric materials, (F^) << 1, and we can write

P = 2 (F [1 - (F )^] P

r

V I r o and

P_ = [1 - (F P . t

V

j Q

To first order in (F

r 12
(2.17)

p ^ 2 (r p

r r o

P, ^ [1 - 2(r )^] P

t

‘ ' r

^ O’ For a single surface (i.e., ignoring multiple reflections caused by a second surface), the reflected and

transmitted powers are obtained by inspection

P = (r )^ P

r r 0

p, = (1 - (r )^] P . t r 0

(2.18)

v2 . Even though the pairs of eqs (2.17) and (2.18) differ slightly in form, (F^) is so small that the effect

of a second surface on P^ is generally negligible; and, in both cases, P^ is so slightly different from P^

that, again, we ignore the effect of a second surface. Therefore, we consider only a single reflecting/

transmitting surface for each material in a building wall. Any error incurred by this assumption will be

covered by the 100% uncertainty we have assigned to the reflection coefficients for dielectric construction materials.

2.5 Reflection Coefficient and Attenuation Data for Selected Building Materials

The data in the following fourteen tables has been entered into the data file MATTER and is ready for

use in the building attenuation computations performed by the program MASTER. We preface the tables with

these comments:

• The null material (MOl) must be used as the "material" of an open doorway or an open, unscreened

window. As a formality whenever material MOl is needed, the user must enter into the data file

HOLES a material thickness T of 1 cm.

• Dry wall (wall board, sheet rock) is mainly plaster of Paris (material M03).

• The word "moist" (materials M02, M03, M06, M07) does not imply "soft", "fresh", or "uncured",

but only that material samples measured after 24 hours in a saturated atmosphere (as opposed to

samples baked dry) had electrical properties more similar to the same materials in field conditions .

• "Clay brick" (material M06) refers to the brick commonly used in homes and buildings.

• All common lumber and plywood have a very low reflection coefficient and attenuation (dB/cm).

Therefore, the material data tables contain only Douglas fir and fir plywood as representative

types to be used for any wood or plywood the user may encounter as building materials.

• Because the attenuation by a metal screen (materials M09, MIO, Mil) is actually an insertion

loss given in dB instead of dB/cm, the mesh thickness is not required. However, as a formality

to satisfy the computation program MASTER, the user must enter into the data file BxxxxxT a mesh

thickness T of 1 cm.

• The assigned uncertainties are in the transmitted and reflected powers, and must not be applied

to the attenuation in dB/cm.

13
Table 2.1: Null Material (Mat'l. No. MOl) (Thickness T = 1 cm)

Frequency

10

10

10

10

10

10

10

4

5

6

7

8

910

(Hz) Attenuation (dB/cm)

0

0

0

0

0

0

0

Power reflection coefficient

0

0

0

0

0

0

0

Material: Fictitious; a formality, required by the program MASTER, used

to represent the "material" of passageways, open doorways,

and open, unscreened windows.

Table 2.2: Moist Mortar (Mat'l. No. M02)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ CM <N X 10-6 0.23

10^ 7.54 X O

1 ON 0.17

10^ 3.55 X 10-6 0.16

10^ o X 10-^ 0.13

10« 1.89 X 1—» O

1 0.10

10^ 1.12 X 10-^ 0.055

10^° 0.13* 0 . 03*

Material: Moist mortar; 6.5 gal. H.,0/94 lb. sack of cement; Portland, cement-aggregate ratio: 1/3.

Data Source: Brennan [4].

Assigned Uncertainty: Attenuation, 10%; reflection coefficient. 100%.

*Extrapolated

.

Table 2.3: Plaster of Paris (Mat'l. No. M03)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^^ 2.98 X o

1 0.063

10^ 4.41 X 10-^ 0.059

106 1.50 X 10-6 0.084

10^ 2.58 X 10-6 0.076

10« 4.84 X 10-^ 0.063

10^ 7.6 X

1 O 0.007

O

o 7.6 X lO"^* 0.007*

Material

:

Moist plaster of Paris (main component of dry wall)

.

Data Source:

Assigned Uncertainty:

Brennan [4]

.

Attenuation, 10%; reflection coefficient. 100%.

“'Extrapolated.

14
Table 2.4: Douglas Fir (Mat'l. No. M04)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 4.28 X 10"^ 0.047

10^ 2.59 X lo"^ 0.041

10^ 4.35 X io‘^ 0.063

10^ 1.10 X lo"^ 0.050

io8 1.98 X lo"^ 0.025

10^ <N o X O

CM 0.019

lO^O 0 . 22* 0.014*

MaterialDouglas fir. Data Source: Brennan [4]

.

Assigned Uncertainty: Attenuation, 10%; reflection coefficient, 100%.

*Extrapolated.

Table 2.5: Fir Plywood (Mat'l. No. M05)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 1.15 X lo"^ 0.068

10^ 6.77 X lo"^ 0.048

10^ 8.31 X io‘^ 0.074

10^ 1.24 X io“^ 0.036

10^ 2.15 X 10"^ 0.014

10^ 2.6 X lo'^ 0.013

o o 0 . 30* 0.010*

Material:

Data Source:

Assigned Uncertainty:

Fir plywood.

Brennan [4]

.

Attenuation, 10%; reflection coefficient, 100%.

*Extrapolated.

Table 2.6: Clay Brick (Mat'l. No. M06)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

lo"^ 2.20 X 10-' 0.13

10^ 1.02 X io“^ 0.072

10^ 1.4 X

-U

10 * 0.051*

10^ 2.5 X 10‘3* 0.029*

o

OO 5.72 X

1 CO o 0.014

10^ 5.72 X lO”^ 0.014

O

o 5.7 X 10"3* 0.014*

Material: Moist clay brick.

Data Source: Brennan [4].

Assigned Uncertainty: Attenuation, 10%; reflection coefficient, 100%.

*Interpolated or extrapolated.

15
Table 2.7: Cinder Block (Mat'l. No. M07)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 1.74 X lo"^ 0.17

10^ 8.30 X lo“^ 0.14

10^ 3.85 X lo"^ 0.13

10^ 2.82 X

10“'^ 0.055

10« 5.71 X 10"^ 0.013

10^ 5.71 X lo"^ 0.013

10^® 0.57* 0.013*

Material

Data Source:

Assigned Uncertainty:

Moist cinder block (Featherlite)

.

Brennan [4]

.

Attenuation, 10%; reflection coefficient, 100%.

^Extrapolated.

Frequency (Hz)

Table 2.8: Glass (Mat'l.

Attenuation (dB/cm)

No. MOB)

Power reflection coefficient

10^ 1.36 X io“® 0.20

10^ 2.28 X lo"^ 0.18

10^ 2.88 X 10“^ 0.19

10^ 3.95 X 10"^ 0.19

10«

g o o X o 0.15

10^ 5.04 X io“® 0.082

lolO 7.1 X lo"^* 0.015*

Material

Glass (t3rpe not specified). We assume "window glass'

Data Source:

Assigned Uncertainty:

because the Brennan report concerns only building

materials

.

Brennan [4]

.

: Attenuation, 10%; reflection coefficient, 100%.

*Extrapolated.

Table 2.9: Steel Mesh (Mat'l. No. M09) (Thickness T = 1 cm)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 141.0* 1.0

10^ 132.0* 1.0

10^ 114.0 1.0

10^ 94.1 1.0

10® 44.0* 1.0

10^ 54.1 1.0

lo'o 34.0* 1.0

Material: Galvanized steel mesh (24 x 24). Data Source: Jakubec and Ohta [9].

Assigned Uncertainty: Attenuation, 1%; reflection coefficient, 1%.

*lnterpolated or extrapolated.

16
Table 2.10: Copper Mesh (Mat'l. No. MIO) (Thickness T = 1 cm)

Attenuation (dB/cm) Power reflection coefficient

10^ 106.0* 1.0

10^ 110.0* 1.0

10^ 104.2 1.0

10^ 88.0 1.0

10® 68 . 0* 1.0

10^ 48.4 1.0

lo'O 28 . 0* 1.0

Material

Copper mesh (20 x 20). Data Source: Jakubec and Ohta [9].

Assigned Uncertainty: Attenuation, 1%; reflection coefficient, 1%.

*Interpolated or extrapolated.

Table 2.11: Reinforcing Bar Mesh (Mat'l. No. Mil) (Thickness T = 1 cm)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 1000.0* 1.0

10^ 1000.0* 1.0

10^ 1000.0* 1.0

10^ 1000.0* 1.0

10® 12.2 0.94

10^ 0.22 0.05

lolo 0 0

MaterialReinforcing bar square mesh;; 35.6 cm on centers; bar

diameter =4.3 cm. Data Source: Hill and Wait [12]; MacFarlane [11].

Assigned Uncertainty: Attenuation, 1%; reflection coefficient, 1%.

*To represent infinite attenuation as computed from unity power reflection

coefficient.

Table 2.12: Iron Sheet (Mat'l . No. M12)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ +3

1.71 X 10 1.0

10^ 5.42 X lo"^® 1.0

10^ 1.43 X lo'^^ 1.0

10^ 3.83 X lo'^^ 1.0

10® 5.42 X lo'^'^ 1.0

10^ 1.21 X lo"^® 1.0

o

O 5.42 X lo"^^ 1.0

Material

Iron sheet.

Data Source: Denny [7]; Campi [8].

Assigned Uncertainty: Attenuation, 1%; reflection coefficient, 1%.

17
Table 2.13: Aluminum Sheet (Mat'l. No. M13)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 1.03 X 10"2 1.0

10^ 3.24 X 10"2 1.0

10^ 1.03 X lO"^^ 1.0

10^ 3.24 X lo'^^ 1.0

10« 1.03 X lO*""^ 1.0

10^ 3.24 X lO-"^ 1.0

iqIO 1.03 X lo"^^ 1.0

Material

Data Source:

Assigned Uncertainty:

Aluminum sheet.

Denny [7]; Campi [8].

Attenuation, 1%; reflection coefficient, l7o.

Table 2.14: Copper Sheet (Mat'l. No. M14)

Frequency (Hz) Attenuation (dB/cm) Power reflection coefficient

10^ 1.31 X 10"2 1.0

10^ 4. 16 X

10-^2 1.0

10^ 1.31 X lO'^® 1.0

10^ 4. 16 X lO"^® 1.0

10® 1.31 X

10^"^ 1.0

10^ 4 . 16 X lO'^'^ 1.0

o

o 1.31 X lo"^® 1.0

Material: Copper sheet. Data Source: Denny [7]; Campi [8].

Assigned Uncertainty: Attenuation, 1%; reflection coefficient, 1%.

18
3. CALCULATION FOR BUILDING SHIELDING EFFECTIVENESS -- THEORY

3 . 1 Introduction

This chapter discusses the theoretical basis for the calculation of building shielding effectiveness.

After this introduction, there are four sections which consider a definition of the problem, the input

data that will be used in the calculation, the actual mathematical approach used to calculate building

shielding effectiveness, and window and door resonances.

3.2 Definition of Problem

The purpose of this project is to calculate how well a building shields from external electromagnetic

interference. Automated on a computer, this calculation is to provide a worst case estimate of the electromagnetic power level appearing in a room of a building given the physical construction and dimensions

of the building and given a known external incident field strength. The estimate must be useful over a

wide frequency range (10 kHz - 10 GHz) and must be general enough so that it can be used effectively on

several hundred differently constructed buildings.

3.3 Input Data Available

In any given calculation of electromagnetic shielding effectiveness, it is always desirable to have

sufficient, high quality data to make the calculation yield a precision result. For example, the best

data possible would be to actually measure a given building for electromagnetic shielding effectiveness

using external antennas to launch a known field and calibrated antennas to measure the field inside of the

building. The calculation would then be trivial — the ratio of the launched field versus the measured

internal field would be calculated directly. In fact such measurements have been performed and have

yielded excellent results. Such field measurements made during this project are detailed in Chapter 6 of

this report.

Direct measurements of electromagnetic shielding effectiveness, although highly effective in characterizing a building, have the disadvantage of being time consuming and expensive. A typical field measurement of one building at one site can take three or four engineers from three to five days to complete.

When three to five hundred buildings are contemplated, it clearly becomes difficult to obtain actual field

data in an efficient manner. Another approach is to take "less expensive" data that can be used in a

model that will give an estimate of the shielding effectiveness. This estimate may not be as accurate a.s

actual field data, but it may give sufficient accuracy to make a cost effective analysis of a building.

This section describes the data that will be used in the estimation of building measurements.

19
For a particular calculation for a given building, the input data is restricted to the actual physical construction details of the building. The input data include: 1) building construction materials; 2)

the dimensions of the building; and, 3) the construction practices involved in erecting the building.

These three categories of data are to be obtained either from building drawings which were used in the

original construction and which have been properly updated with modifications, or by actual physical

measurements on the building itself. Although it will be less accurate than direct EMI measurements, the

estimate of EM shielding effectiveness based on the physical construction of the building should be sufficiently accurate to determine the suitability of most buildings for electromagnetic shielding. In the

few cases where the calculated estimate is perhaps ambiguous, actual EMI measurements could be performed.

A test plan for field measurements of EMI for these marginal cases is presented in the appendix. Details

and methods for gathering the actual physical data and putting it into a form usable in the present computer model will be presented in Chapter 5, "User's guide to the computer programs."

3.4 Approach

To estimate the electromagnetic shielding ability of a building, the following approach is taken.

The energy entering the building from external sources is calculated for each room by considering the

direct penetration through all the walls, windows and doors. The energy in each room can then go to the

other rooms through internal walls and doors, as well as going back outside. As the energy continues to

flow through each room, the power in each room reaches a steady state condition corresponding to a balance

between the energy flowing in and out. To calculate the steady state power level, it is necessary to

first consider a model that will describe the flow of the electromagnetic energy through the building.

The assumptions in this model listed in figure 3.1, and graphically shown in figure 3.2, must also be

considered

.

The first assumption is that the input electromagnetic radiation will consist of plane waves with

normal incidence on a particular external wall. The calculation will be repeated five times corresponding

to the four horizontal incidence directions (i.e.. North, South, East and West) and the one vertical direction (i.e., from above). The sixth direction, from below or through the ground will be ignored.

The first assumption is used to calculate the power entering a room through an external wall from the

3 outside. If the energy density of the incident field is represented by P with units of joules/m , the

energy, Ejj^, entering a room in one second will be

Ejjj = tPcA (3.1)

where t is the transmission coefficient/unit length of the external wall and c is the speed of the electromagnetic radiation (the speed of light). The term A represents the area of the external wall. If the

room has a door in the wall, eq (3.1) becomes

20
= tjPcAj + t2PcA2 (3.2)

where ^nd A

2 represent the transmission coefficient and area of the door.

The second assumption is that there will be no refraction by the building of the incident plane wave,

and the incoming energy will only enter those walls which are normal to the incoming radiation. This

effect can also be considered a shadowing effect.

The third assumption deals with multiple layers on a wall. It states that the composite transmission

coefficient of a multi-layered wall will be represented as the product of the individual transmission

coefficients of the layers or

t = nt. (3.3) composite 1

where the t^'s represent the transmission coefficient of the layers. This is really a simplification that

ignores internal reflections in the walls and the related interference effects.

The fourth assumption considers how the energy in a room scatters and flows to the other rooms. This

assumption states that the energy in a room will be isotropically scattered in all directions. Hence, in

a cubic room where the four walls, the floors and ceilings all have the same area, one sixth of the room's

energy would hit each of the six surfaces equally.

To find the transmission of energy from one room to another, consider figure 3.3, a building with two

3 rooms. The first room has an energy density N, (J/m ). From assumption four, this energy is isotropically scattered in all directions equally. The fraction, F, of the energy scattered against the

internal wall will be

F = (3.4)

1 , total

where A^ is the internal wall area, and A^ total total area of the walls, floor, and ceiling in

room 1. The energy that is transmitted per second from room 1 to room 2 will be

E, = t N, c F A

1,2 1 w

(3.5)

where the subscripts on E represent flow from room 1 to room 2. Substituting for F yields

A .,2 E, „ = t N, c 1,2 •

Note that the energy flowing from room 2 to room 1 will be

. 2

(3.6)

^2,1 ^ ^2 A

(3.7)

2 ,t

which differs from eq (3.6) because the room 2 energy density, N

2

, is different and the total area of

room 2, A

2 is different. Using eqs (3.1) and (3.6) the energy transmitted between the outside to th21
rooms, and from room to room, can be described. We must now consider absorption and reflection for the

walls, which brings us to the fifth assumption.

The fifth assumption states that wall reflections will be ignored unless the frequency of the

radiation is near a resonance of the room. Outside of resonance, any radiation hitting a wall that is not

transmitted will be absorbed or

D = 1 - t (3.8)

where D is the absorption coefficient and t is the transmission coefficient. When the frequency is near a

room resonance then reflections will be accounted for and

D = 1 - t - r (3.9)

where r now represents the reflection coefficient.

The frequency range of a room resonance will be between and where

and

1'2

high

3 + / 3 y + / 3

where A, B, and C represent the three dimensions of the room with B and C being the longest. Experience

indicates that modes above 3, 3, 3 do not contribute significantly to resonance fields in a room.

Therefore, these higher order modes are ignored in this model.

Note that in resonance, eq (3.9) reduces the absorption coefficient and hence reduces the effective

energy loss from the room. This is equivalent to reflecting it back into the room.

The energy losses in a room can now be found by replacing t in eq (3.7) with D from either eq (3.8)

or (3.9) and obtaining

L

1,2 D N, (3.10)

where L represents the energy lost from the room.

The sixth assumption states that in a calculation of the steady state energy distribution within a

structure, the E or H field is computed by assuming free space impedance. To calculate the steady state

energy in a room, we first write down an equation which represents the change in energy with respect to

time or

^^1^1 = G - L (3.11)

dt

22
where Vj is the volume of the room and G represents the sum of all the energy gains into the room as

represented by either eqs (3.2), (3.6) or (3.7). Note that a room can gain energy from the outside

(eq (3.2)) and from other rooms (eqs (3.6) or (3.7)). In eq (3.11), L represents the energy lost from a

room and is taken from eq (3.6) for energy transmitted out or eq (3.10) for energy absorbed in a wall.

Note that for M rooms, there will be M eq (3.11)'s.

For the steady state condition eq (3.11) will equal zero. Hence there will be M eq (3.11)'s equal to

zero. Since the M eq (3.11)'s have only M unknowns (the M energy levels in each room) there will be a

unique solution which gives the M energy levels in the rooms.

3.5 Input Resonances

Room resonances have already been considered by adding the reflection coefficients of a wall in

eq (3.9). An additional input resonance is also considered for windows or doors in the following manner.

If a window or door has a metal frame, then the transmission coefficient for the window is increased by 20

dB if the incoming frequency is near a window resonance. The frequency range for a window resonance

will be defined as lying between and ^high

F = — low 2B

F = -

^high 2

where A and B are the smallest and largest dimensions of the windows. Note that resonances above mode 3,3

are ignored.

23
1. Plane wave incident on surface(s) of structure. Use

attenuation of wall material(s) to calculate transmission.

2. Ignore external refraction by building.

3. Disregard multiple internal reflections within wall(s).

4. Energy reaching inside of structure is scattered

isotropically. Energy leaves structure through all

available surfaces.

5. Reflections within room from walls, celling, etc., are

only considered if frequency is near room resonance(s).

Only first three resonant modes are considered.

Input coupling resonances are also considered for

metal door and window frames by increasing

transmission by 20 dB near resonant frequency.

6. Steady state energy distribution within structure

allows E or H field to be computed (free space

impedance assumed).

FIGURE 3.1 ASSUMPTIONS USED IN MODEL.
I

I

I

FIGURE 3.2 ENERGY FLOW ANALYSIS.

25
E2.I

ROOM 01 ROOM 02

Ni N 2

Aw=AREA of wall

FIGURE 3.3 ENERGY FLOW BETWEEN TWO ROOMS.

26
4. COMPUTER PROGRAM DESCRIPTIONS

4 . 1 Introduction

This chapter provides a description of the computer programs used in the calculation of electromagnetic shielding effectiveness of buildings. The presentation is aimed at the programmer level. The

intention is to provide information about the programming methods used in the present calculations. Information on how to use the programs is provided in Chapter 5, entitled, "User's guide to each of the

programs." This chapter, besides the introduction, has four additional sections which describe the field

calculation program, the data entry programs, the data structures used in the programs, and, finally, a

more detailed description of the programs and their subroutines listed in alphabetical order. This last

section also highlights those variables which are important to the understanding of the programs.

The project's purpose is to calculate the maximum electromagnetic field possible in each room of a

building from a plane wave impinging directly upon the walls of the building given the dimensions of the

building and the materials used in its construction. The program accesses permanent data files which

describe the dimensions and material of each layer of each wall, door, and window of the building. These

data files are created for each building using separate programs. The program also accesses a previously

stored data file which contains the attenuation and reflection coefficients of different construction

materials. This data is then used to calculate a transmission coefficient and an absorption coefficient

for each wall considering the properties of each layer and each opening. Using these coefficients an

energy flow into each room from the outside and from the other rooms is calculated. The energy flowing

back out of the building is also then calculated. A steady state energy balance is then assumed for all

the rooms, and from this steady state assumption, the energy level in each room is calculated.

4.2 General Description of the Field Calculation Program

A procedure file FIELD gets the main program from mass storage and runs it. The main program MASTER

sets up the common blocks and then calls each of the subroutines. Five subroutines (LMATTER, LFREQ,

LWALL, LTYPE, and LHOLE) load data from permanent storage into arrays which are accessed by the program

when the data is needed for computation. The subroutine LTDB calculates the attenuation and area of each

type opening, layer by layer, and loads it into the TDB array.

The CFACTOR subroutine calculates transmission factors of each wall and loads them into the ROOM

array. These transmission factors determine the transmission between each room and its adjacent volume,

which may be another room or the exterior of the building. The calculation is performed for each materia!

layer of each wall and of each opening in the wall. Note: in this discussion "wall" also means floor .ind

ceiling. These calculations are done sequentially and accumulated as the data for each layer of eah

opening is accessed in the data files.

27
The DFACTOR subroutine calculates the absorption factor of each wall and loads them into the DDABS

array. In this calculation the absorption is taken as one minus the transmission and minus the reflection. The reflection coefficient is included if a resonance condition is met.

The subroutine ECALC is used to calculate the steady state energy in the rooms. It starts by calling

the subroutine SETUP which takes the transmission coefficients from the ROOM arrays and combines them with

the absorption coefficients in the DDABS array to produce the proper relationships for energy flow between

the rooms and the outside. These linear relationships are put into the THAT array. The subroutine ECALC

then calculates the steady state energy balance in the rooms using the subroutine DETERM. The subroutines

RESOND and RESONW calculate resonance conditions for apertures and rooms.

Several subroutines with a "P" prefix print results or file contents. For example, PHOLE, PTYPE,

PWALL print the data contained in the data files and the corresponding arrays.

4.3 General Description of the Data Entry Programs

There are five data entry programs: three to store data describing buildings, one to store

frequencies, and one to store properties of construction. The three which store the building data are

SWALLS, STYPES, and SHOLES; the material properties are stored by SMATDB. The frequencies are stored

using SFREQ. These are source code files; the user will only see the equivalent procedure files HSTORE,

WSTORE, TSTORE, FSTORE and MSTORE which call and run the compiled binary equivalents of these source

files

.

All three building description programs use the same interactive format. Each asks the user for a

building identifier which can be as many as five characters long. That building identifier is used to

create the names for the permanent data files needed for each building. For example, if the building

identifier were "A125" then three permanent files would be named and created: "BA125T", "BA125W",

"BA125F", and "BA125H". The suffixes "T", "W", "F", and "H" refer to "Type" data, "Wall" data,

"Frequency" data and "Hole" data, respectively.

The material data storage program, also interactive, stores attenuation and reflection coefficient

data for different frequencies in a permanent file called MATTER. This program will only be used for

adding new construction materials to the material data base.

4.4 Data Structures Used in the Programs

Arrays and Variables:

The following gives a brief description of the variables used in the common blocks.

Hole Variables

HMAX: maximum size of hole array. Initially set at 35.

28
HOLE (1-HMAX, 1-4): Array containing room and aperture ID.

HOLE (x,l): "Direction" part of room identification.

HOLE (x,2): "From room" part of room identification.

HOLE (x,3): "To room" part of room identification.

HOLE (x,4): "Aperture ID".

HTOT: A numeric variable containing the total number of lines in the "hole" data file.

HERR: A numeric variable used to indicate a file handling error and used in the WARNING and

ERROR subroutines to trigger a message to the operator.

Type Variables

TMAX: Maximum size of TYPE and TDIM arrays. Initially set at 35.

TYPE (1-TMAX, 1-4): Character array containing dimensions and material of each layer of

each type of door or window.

TYPE (x,l): Identification of type, e.g., "WA" meaning window "A" and "DB" meaning door B.

TYPE (x,2): Material of layer, e.g., "M03" meaning Material #3.

TYPE (x,3): Material of the frame, e.g., "M05" meaning Material #5.

TDIM (1-TMAX, 1-4): Numeric array containing dimensions of each door or window. Used in

parallel with TYPE array.

TDIM (x,l): Height of opening in meters.

TDIM (x,2): Width of opening in meters.

TDIM (x,3): Thickness of layer in centimeters.

TDIM (x,4): Distance of opening above floor in meters.

TDBl (1-TMAX): Character array containing opening identification. Used in parallel with

TDB2 array.

TDBl (x) : Opening identification, e.g., "WA".

TDB2 (1-TMAX, 1-2): Numeric array containing attenuation and area of opening. Used in

parallel with TDBl array.

TDB2 (x,l): Attenuation of opening.

TDB2 (x,2): Area of opening in square meters.

TTOT: A numeric variable containing the number of lines in the "Type" data files.

TDBTOT: A numeric variable representing the total number of lines in the TDBl and TDB2

data arrays.

TERR: A numeric variable used to indicate an error and used in the WARNING and ERROR subroutines to trigger a message to the operator.

29
Material Variables

MAT (1-100): Contains material identifiers such as "M01", "M02", ..."M99".

MATDESC (1-100): Contains description of each material. (70 characters each).

MFREQ (1-100, 1-7) real array: Contains 7 frequencies at which the property data

exists

.

MATTEN (1-100, 1-7): Contains 7 attenuation values for each material.

QA (1-100): Contains a quality factor for each material.

MRCOEF (1-100, 1-7): Contains 7 reflection coefficients for each material.

QR (1-100): Contains a reflection coefficient quality factor for each material.

Room Variables

DDABS (1-RMAX + 6, 1-RMAX + 6): This numeric array contains the absorption coefficients of

the walls in each room.

ENERGY (1-RMAX): This numeric array contains the results of the energy balance calculations

and contains the energy in each room.

POWER (1-6): This numeric array contains the power entering the building from each of the

six outside directions: North, East, South, West, Top, Bottom.

RAREA (1-RMAX): Array containing surface area of each room.

RMAX: This numeric variable sets the maximum number of rooms that the program can handle.

Initially set for 20 for simplicity of the display subroutine when printing on 80

col limn paper.

ROOM (1-RMAX + 6, 1-RMAX + 6): This numeric array is used for the transmission factors

between room and room, and between room and the outside

world.

TMAT (1-RMAX + 6, 1-RMAX + 6): This numeric array is the matrix that contains the linear

relationships of energy flow between the rooms. It is a

combination of information from the ROOM array and the DDABS

array, and is created using the subroutine SETUP.

Wall Variables

WMAX: Maximum size of wall arrays. Initially set to 75.

WALL (1-WMAX, 1-4): Character array containing wall identifiers and material identification.

WALL (x,l): Direction—one of three wall identifiers.

WALL (x,2): From room—one of three wall identifiers.

Wall (x,3): To room—one of three wall identifiers.

WDIM (1-WMAX, 1-3): Numeric array containing wall dimensions.

30
WDIM (x,l): Height in meters.

WDIM (x,2): Width in meters.

WDIM (x,3): Layer thickness in centimeters.

WTOT: A numeric variable containing the number of lines in the Wall data files.

WERR: A numeric variable used to indicate a file handling error and used in the WARNING and

ERROR subroutines to trigger a message to the operator.

Miscellaneous Variables

BLDG: This character variable contains the building identifier. It is combined with other

strings to identify the various data files associated with that building.

DREFL: This variable contains the reflection coefficient for a wall. If the frequency is

not near a room resonance, DREFL is set to zero.

DREFLW: This variable is used to calculate window input resonances. If the frequency is

near a window resonance then DREFLW is set to 20 dB. Otherwise, DREFLW is zero.

FMAX: Maximum number of frequency values in FREQA array. Initially set at 50.

FREQ: Frequency in hertz.

FREQA (1-FMAX): A numeric array containing frequencies for calculations.

AFLAG: A number between 0 and 100 which determines how much of the quality factor is applied to the attenuation value.

RFLAG: A number between 0 and 100 which determines how much of the quality factor is applied to the reflection coefficient value.

Labeled Common Blocks:

This section lists variables transmitted by each labeled common block along with the subroutines

using the block.

INITILC: BLDG

Common to MASTER, CFACTOR, LHOLE, LTDB, LTYPE, LWALL, PROOM, PPWR, PTMAT, DFACTOR, PDDABS,

PPWR2, SPWR, RESONW, RESOND, LFREQ

INITILN: FREQ, QUALITY, AFLAG, RFLAG, FREQA (FMAX), FERR, FTOT

Common to MASTER, CFACTOR, LHOLE, LTDB, LTYPE, LWALL, PROOM, PPWR, RESOND, RESONW, PPWR2

,

PDDABS, PTMAT, DFACTOR, SPWR, LFREQ

HOLEC: HOLE (HMAX, 4)

Common to MASTER, CFACTOR, LHOLE, DFACTOR, PHOLE

HOLEN: HTOT, HERR

Common to MASTER, CFACTOR, LHOLE, DFACTOR, PHOLE

31
MATC: MAT (MMAX) , MATDESC (MMAX)

Common to MASTER, ATTEN, LMATTER, RCOEF, RESONW

MAT: TMAT (RMAX, RMAX) , ENERGY (RMAX) , POWER (6), FTIME, SWR (RMAX, 6), IDIR

Common to MASTER, SETUP, ECAIC, PPWR, PTMAT, PPWR2, SPWR, PDDABS

MATN: MATTER (MMAX, 7), MRCOEF (MMAX, 7), QA (MMAX), QR (MMAX), MFREQ (MMAX, 7), MERR, MTOT

Common to MASTER, ATTEN, LMATTER, RCOEF, RESONW

ROOMD: DDABS (RMAX + 6, RMAX +6), DREFL, DREFLW

Common to MASTER, CFACTOR, SETUP, DFACTOR, LDDABS, IDDABS, RESOND, RESONW

ROOMN: ROOM (RMAX + 6, RMAX + 6), NROOMS, RAREA (RMAX)

Common to MASTER, CFACTOR, LRAREA, LROOM, PROOM, SETUP, ECALC, PPWR, PTMAT, IDDABS,

DFACTOR, LDDABS, PPWR2, SPWR, RESOND, RESONW, PDDABS

TYPEC: TYPE (TMAX,3), TDBl (TMAX)

Common to MASTER, CFACTOR, LTDB, LTYPE, PTDB, PTYPE, SRCHTDB, DFACTOR, RESOND

TYPEN: TDIM (TMAX, 4), TTOT, TDB2 (TMAX, 2), TDBTOT, TERR

Common to MASTER, CFACTOR, LTDB, LTYPE, PTDB, PTYPE, SRCHTDB, DFACTOR, RESOND

WALLC: WALL (WMAX, 4)

Common to MASTER, CFACTOR, LRAREA, LWALL, PWALL, DFACTOR, RESONW

WALLN: WDIM (WMAX, 3), WTOT, WERR

Common to MASTER, CFACTOR, LRAREA, LWALL, PWALL, DFACTOR, RESONW

4.5 Description of Programs and Subroutines Used in Field Calculation (Listed Alphabetically)

Important variables (not including those passed by common blocks) are listed after each routine.

Subroutines with arguments are listed with the arguments in parentheses.

‘-^ FUNCTION ATTEN (ID, FREQ, AFLAC) : This real function returns the material attenuation for a specified

frequency and for a specified quality. It obtains the attenuation values from the MATTEN array and

interpolates according to the frequency.

ID: Material identification such as "M01".

“ SUBROUTINE CFACTOR : This subroutine calculates the attenuation of each wall and each opening in each

wall, layer by layer, and then calculates transmission factors for each wall.

DREFLW: This value is 20 dB near a window frequency resonance.

WATTEN: Wall attenuation.

OATTEN: Opening attenuation, whether the opening is a door or window.

LATTEN: Layer attenuation.

MATTEN: Material attenuation.

32
MATT: Material identifier such as "M01".

ID: Identifier of opening.

WALL: Wall array containing Wall identification and Material identification.

^FUNCTION DETERM (ARRAY, NORDER) : This real function calculates the determinant of a matrix.

ARRAY (1-RMAX + 6, 1-RMAX + 6): This real array represents the input matrix. It is destroyed during the calculation.

NORDER This real variable represents the order of the input matrix.

" SUBROUTINE DFACTOR : This subroutine calculates the attenuation of each wall and each opening in each

wall, layer by layer, and then calculates the absorption factor for each wall.

DREFL: Wall reflection coefficient.

WATTEN: Wall attenuation.

OATTEN: Opening attenuation, whether the opening is a door or a window.

LATTEN: Layer attenuation.

MATTEN: Material attenuation.

ID: Identifier of opening.

WALL: Wall array containing Wall identification and Material identification.

^SUBROUTINE ECALC : This subroutine calculates the energy balance in the rooms. It calls subroutines SETUP

and DETERM.

PVECTOR (1-RMAX): This real array contains the values representing the initial power levels

injected into each room from the outside field.

^' SUBROUTINE ERROR (lERR) : This subroutine returns an error message when called with an error number as

argument. It also stops the program. The error numbers and error messages are

listed below:

lERR MESSAGE

1 Materials data base is empty

2 Frequency is out of range

3 This material is not in data base

4 Denominator is zero

5 File handling error

" FUNCTION GETLEN (STRING) : This integer function returns the number of characters in a character string

when given the character string as an argument.

^' SUBROUTINE IDDABS : This subroutine initializes the DDABS array.

^' SUBROUTINE LDDABS : This subroutine loads the DDABS array.

33
“ SUBROUTINE LFREQ : This subroutine loads the array FREQA from the permanent file "BxxxxxP", where "xxxxx

represents the building identifier.

‘^ SUBROUTINE LHOLE : This subroutine loads the material data base from permanent storage into the HOLE array

for access by the program.

“ SUBROUTINE LRAREA : This subroutine calculates the surface area of each room and inserts it into the RAREA

array.

“ SUBROUTINE LMATTER : This subroutine loads the material data base from permanent storage into arrays for

access by the program.

“ SUBROUTINE LROOM (TS, TS2, FROM, TO) : This subroutine loads the transmission coefficients TS and TS2 into

the appropriate room location in the ROOM array.

''^ SUBROUTINE LTDB : This subroutine calculates the attenuation and area of each type opening, layer by layer

and loads it into the TDB array (T3^e Data Base).

^' SUBROUTINE LTYPE : This subroutine loads arrays TYPE and TDIM with data from permanent file "BxxxxxT",

where "xxxxx" is the building identifier.

“ SUBROUTINE LWALL : This subroutine loads arrays WALL and WDIM with data from permanent file "BxxxxxW",

where "xxxxx" is the building identifier.

“ PROGRAM MASTER : This program is the control section which calls each of the subroutines. The program

reads in wall, window and door data; calculates transmission coefficients of each wall; stores the

transmission coefficients in the ROOM matrix; and calculates the maximum field in each room on a

normalized basis. It is called by the user with procedure file FIELD.

^' SUBROUTINE PDDABS : This subroutine prints the ROOM matrix.

^SUBROUTINE PTDB : This subroutine prints the array TDBl and TDB2 giving the area and attenuation of each

door and window type.

“ SUBROUTINE PHOLE : This subroutine prints the contents of the HOLE array giving the wall location of the

doors and windows.

“ SUBROUTINE PPWR : This subroutine prints the contents of the ENERGY array and represents the energy values

in the rooms

.

^' SUBROUTINE PPWR2: A second version of PPWR which allows a more efficient format. It uses the output from

the subroutine SPWR stored in the array SWR.

’'^ SUBROUTINE PROOM : This subroutine prints the ROOM array giving the transmission factor of each wall.

’^‘' SUBROUTINE PTMAT : This subroutine prints the contents of the TMAT array. It can be used for debugging

the program.

34
*SUBROUTINE PTYPE: This subroutine prints the contents of the arrays TYPE and TDIM giving the parameters

of each door and window type.

*SUBROUTINE PWALL : This subroutine prints the contents of the WALL and WDIM arrays.

*SUBROUTINE RESOND (ID) : This subroutine calculates the range of frequencies that correspond to a

resonance condition for a window or door with a metal frame. If the frequency of the incoming

radiation is in the range of the resonance then DREFLW is set to 20 dB. This is used in the CFACTOR

subroutine to increase the transmission through a window by 20 dB if resonance occurs.

DREFLW: This is the return variable. (Used in common block ROOMD.)

FLOW: This is the lower frequency bound for resonance.

FHIGH: This is the upper frequency bound for resonance.

ID: This is the identification label for the window.

^SUBROUTINE RESONW (FROM, MATID) : This subroutine calculates the frequency range that corresponds to a

resonance condition in a room. If a wall has a reflection coefficient greater than 0.80 and the

frequency corresponds to resonance for the room, then DREFL is set to the reflection coefficient of

the wall under question. Otherwise DREFL is set to zero.

DREFL: This is the return variable. (Used in common block ROOMD.)

FLOW: This is the lower frequency bound for resonance.

FHIGH: This is the upper frequency bound for resonance.

FROM: This identifies the room being calculated.

MATID: This represents the material identification label for the wall being calculated.

^FUNCTION RCOEF (MATID, FREQ, RFLAG) : This function returns the material reflection coefficient for a

specified frequency and for a specified quality.

^SUBROUTINE SETUP : This subroutine loads the TMAT array.

^SUBROUTINE SPWR : This subroutine saves the energy values as they are calculated so that they can be

formatted neatly when printed.

^SUBROUTINE SRCHTDB (ID, PATTEN, OAREA) : This subroutine searches the TDB array given the ID label of a

door or window and returns the attenuation and area of that door or window.

^FUNCTION VAL (String) : This function when given a number expressed as a character string returns the

number expressed as an integer.

35
^’^ SUBROUTINE WARNING (lERR) : This subroutine returns an error message when called with a warning number as

argument. The warning number and message follows:

lERR MESSAGE

1 HOLE data file does not exist for this bldg.

2 File handling problem on HOLE data file.

3 MATTER file does not exist for this bldg.

4 File handling problem on MATTER data file.

5 TYPE data file does not exist for this bldg.

6 File handling problem on TYPE file.

7 WALL data file does not exist for this bldg.

8 File handling problem on WALL file.

9 Height and width of room missing.

10 Length of room missing.

11 Frequency file does not exist for this building.

12 File handling problem with FREQ file.

36
5. USERS' GUIDE TO COMPUTER PROGRAMS FOR DATA ENTRY AND COMPUTATION

5.1 Introduction

The programs discussed in this chapter have been written for use on the Control Data Corporation

Cyber 750 computer at the Boulder, Colorado Laboratories of the U.S. Department of Commerce. Though the

programs contain checks and tests to help assure their correct use, we urge each user to read this guide

carefully and to enter data (e.g., window and door types and locations) in the exact form and sequence

which we specify. The checks and tests make the programs somewhat "user-friendly" but not entirely foolproof (no offense intended).

When an electromagnetic wave is normally incident on an outside wall of a building, we compute the

power attenuation of the wave as it penetrates the building by a procedure comprising the data files

BxxxxxF, MATTER, BxxxxxW, BxxxxxT, and BxxxxxH, and the program MASTER.

• BxxxxxF: a file containing the frequencies to be used in the calculation. The suffix "F"

stands for Frequency. The "xxxxx" in the name represents the identification name of a

building, e.g., B90023F would be the frequency data file for building number 90023. This

convention is used for all the other data files.

• MATTER: a file containing our computed reflection coefficients and attenuation values for

building materials. Users will have direct interaction with this file only if they wish to

change data or enter additional data for a material already in the file, or if they wish to

enter data for an additional material.

• BxxxxxW: the user enters data on the location, size, and composition of walls in the building

to be evaluated. The suffix "W" stands for Walls data.

• BxxxxxT: for each door and window type, the user enters material, size, and a two-character

identification. The suffix "T" stands for Types data.

• BxxxxxH: in this file, the user specifies which doors and windows are located in each wall,

identifying the door and window types by their two-character codes. The suffix "H" stands for

Holes data.

• MASTER: this program computes the power attenuation when an electromagnetic field, incident on

an exterior wall, penetrates into any room of a building. MASTER consults the files MATTER,

BxxxxxW, BxxxxxT, and BxxxxxH to obtain the material and building data necessary for the computation. It uses the file BxxxxxF to determine which frequencies to use.

All programs are written in FORTRAN V for use on the CDC 750 computer.

37
5.2 Data Preparation for Programs SWALLS, STYPES, and SHOLES

The sequence ending in an attenuation computation begins with the user drawing a plan of the building to be analyzed. This plan helps the user derive the specifications for walls, doors, and windows

which are then entered into the data files BxxxxxW, BxxxxxT, and BxxxxxH.

At this point we discuss typical steps in reducing the floor plan in figure 5.1 to a set of

specifications acceptable to MASTER. The procedures we illustrate with this simple example can be used

in the same manner for more complex structures. The only restriction on shape is that the floor plan be

rectangular or composed of adjoining rectangles. The same restriction applies to room shapes. Examine

the building thoroughly to include all features (walls, doors, windows) that determine its shielding

characteristics

.

The building plan must be labeled as follows (see the example in fig. 5.1):

1. Dl, D2, D3, D4 denote the exterior regions, or "directions", around the building. These regions must be labeled in order to specify from which direction the radiation is coming. If

necessary, D5 and D6 can be the regions above and below the building, or above and below a room

(e.g., a second-floor room).

2. The directions LR (left-to-right) and FB (front-to-back) specify which walls are parallel to

each other. This information is useful if two parallel walls (of the same room) have high

reflection coefficients, because the region between them may contain the intensified fields of

standing waves produced by reflections between the walls. The program MASTER computes the

highest and lowest frequencies at which these resonances may occur.

3. Label the rooms 01, 02, 03 . . ..

4. Determine the window and door types in the building; label these WA, WB, ..., and DA, DB, ...,

respectively, at their locations on the floor plan.

To prepare data for entry into the file BxxxxxW, the user should make a data sheet to specify the

size, orientation, and composition of the walls. A suggested format is shown in figure 5.2:

1. The number of each line of data is given in the "LINE#" column. When changing or entering a

line of data, the user employs the line number. Note that the line numbers are shown in Figure

5.1, also.

2. The column "DIRECTION" specifies the direction to which the wall in a given line is perpendicular. This direction must be the same as that defined by the "FROM" and "TO" columns.

3. Note that lines 1, 2, 3 specify the material layers in the wall between region D4 and room 01,

and that these layers are encountered in that sequence in going from D4 to 01. The material

layers in a wall must be entered in the file in the correct sequence corresponding to the

direction given by the "FROM" and "TO" columns

.

38
4. The wall "HEIGHT" (meters), "LENGTH" (meters), and "THICKNESS" of material layer (centimeters)

are entered in their respective columns.

5. The material identification number of each layer is entered in the "MATERIAL" column according

to the material data tables in chapter 2.

We strongly advise that the user employ some means of marking the building plan as each wall is entered

into the BxxxxxW data table. When the table is complete and all walls are so marked (e.g., a pencil

check; a colored highlight), the user will know that none have been omitted (or perhaps entered twice).

It can also be helpful to put the data table line numbers onto the drawing as they are entered into the

table. In figure 5.1, these line numbers are shown at the intersections of the walls with the

cross-sections (dashed lines) through the building.

To tabulate the types of doors (D) and windows (W) indicated in figure 5.1, we suggest the format in

figure 5.3. From left to right, the columns specify doors and windows as follows:

1. Line numbers (the "LINE" column) are used in adding, deleting, and displaying data.

2. The floor plan in figure 5.1 has door types DA, DB, DC, and window types WA, WB.

3. A door or window has a height of H meters and a width of W meters, where H and W are the inside

dimensions of a door frame and a window sash (the frame in which the glass is set).

4. "DISTANCE ABOVE FLOOR" is the distance in meters from the floor to the bottom edge of the glass

or screen in a window.

5. In the next two columns, the "LAYER MATERIAL" (door or window) and its "THICKNESS" (in cm) are

specified for each door and window. Notice that doors and windows may contain more than one

material: window type WA has galvanized mesh screen (material M09) and window glass (M08). The

user may also encounter storm windows, windows with thermopane (double-layer) glass, storm

doors, and screen doors.

6. "FRAME MATERIAL"; obtain identification (e.g., M04) for the frame material from the material

data tables.

In the specification of walls and the openings in them, all that remains now is to prepare data for

BxxxxxH, the holes file which tells MASTER where the doors and windows are located. A suitable format

for tabulating this data is given in figure 5.4. As before, a wall is identified by specifying 1) the

two regions between which the wall is located and 2) the. direction to which the wall is perpendicular

(this orients the wall with respect to left-right or front-back directions). Because the wall "from D4

to 01" has two types of openings, it is listed twice (lines 3 and 4).

We again urge users to prepare their data for entry into the computer files by using the tabular

formats we have suggested (figures 5.2, 5.3, 5.4). This procedure will reduce careless errors in transcribing building specifications from the floor plan to files BxxxxxW, BxxxxxT, and BxxxxxH.

39
5.3 How to Become a Remote-Site Time-Share User

Having prepared a floor plan and building data tables, the user must now enter this data into the

files BxxxxxF, BxxxxxW, BxxxxxT, and BxxxxxH. Before we present details of how this is done, we describe

how one becomes an off-site time-share user of the Control Data Corporation (CDC) 170/750 computer system

at the Boulder Laboratories of the U.S. Department of Commerce.

To establish a relationship with the computer, call User Services: (303) 497-5849 or (303) 497-5850

(on FTS, 303 is a direct dial area code). When first contacting the Computer Services Division through

User Services, prospective users must furnish 1) their name, organization name, and telephone number, and

2) the name and telephone number of an "authority contact" (i.e., a project leader, supervisor, etc.).

User Services will then provide a user number and an initial password. When a billing account is established and the way is cleared for use of the computer, the user changes the initial password to another

one which is then secure, known only to the user.

A password (4-7 alphanumeric characters) must be changed every three months, otherwise the computer

will assign a new one known only to the computer. The user will then be unable to get on line without

first going through User Services to submit a new password. At each log-in for about ten days prior to

the expiration of a password, the computer reminds the user to enter a new one- A password is changed by

the command

PASSWOR, OLDPSWD, NEWPSWD

in which the user supplies the old password (OLDPSWD) and then the new password (NEWPSWD)

.

To obtain an account number for computer charges, the user's purchasing department should send a

purchase order to

Ms. Beverly Armstrong

NOAA/ERL, R-E52

U.S. Department of Commerce

325 Broadway

Boulder, Colorado 80303.

Ms. Armstrong can be reached on (303) 497-5842 (FTS direct dial).

Dan Smith (303-497-5846) or Ron Buxton (303-497-5845) can advise which direct-dial extension to use

to match the baud rate on the user's terminal.

40
5.4 The CDC 170/750: Data Entry and Computation

5.4.1 Log-In Procedure

Once the user is on-line, the initial conversation with the computer will be as shown in figure 5.5.

In reply to the first three requests, the user enters: family name, user number, and password. If no

family name is required, press the CR key (CR = carriage return). When typed, the user number does not

appear on the printout. The password is typed over the blackened area. After the word "CHARGE:", the

user enters

CHARGE, Z1234567,Z

(or a similar form specified by User Services) where "1234567" represents the user's account number. As

seen in this printout, entering the word BYE disconnects the user from the computer.

5.4.2 Procedure File MSTORE

The file MATTER contains all the attenuation and reflection data in the tables in chapter 2. To add

or change data, one uses the procedure file MSTORE (M for material), and obtains it with the BEGIN command

BEGIN, MSTORE

Figure 5.6 illustrates how the user enters building material data by means of MSTORE, which first asks if

the user wants to (1) create a new data base, or (2) add to the existing data base. The user makes the

choice by typing 1 or 2 after the question mark. (Note that whenever MSTORE awaits a user reply, it

types a question mark as a prompt to the user.) If a data base is already present in the MATTER file and

the user chooses to create a new data base, typing 1 ERASES THE EXISTING BASE. Before making this choice,

the user must be certain this is indeed what is wanted. Also, one must take care not to inadvertently

type the numeral 1 when 2 is intended.

The entry of material description and data is complete when the user has responded to the six

prompts. (NOTE: a character string must be typed within single quotes; e.g., 'MOIST CLAY BRICK', 'M15'.)

MSTORE then presents the choice of (1) adding data for another material, (2) changing data in the base,

(3) displaying the data for material in the base, (4) canceling (aborting) the data set just entered, or

(5) quitting the data-entry procedure. The choice (5) enters the new data into the file MATTER.

Figure 5.7 shows the user how to use MSTORE to change data already in MATTER. After the material

identification M05 is entered, MSTORE prints all specifications for M05, and the user then enters the

line number of the data to be changed. The procedure to change the attenuation quality percent from 100

to 10 is then self-evident. After all changes have been made and the user has entered 99 to leave the

"change" mode, the complete revised data for M05 is presented. Entering 5 (the "quit" option)

41
disconnects the user from MSTORE and enters the revised data into the file MATTER. To reestablish

contact with the procedure file MSTORE, the user must again enter BEGIN, MSTORE.

The entire data entry for a material can be deleted simply by using the "change" option to replace

the material identification in line 1 (e.g., M05) with a blank. Enter two consecutive single quotes as

the changed material ID; the absence of information between them is the blank.

5.4.3 Data File BxxxxxW (W for Walls)

In the file BxxxxxW, the user stores the location, dimensions, and composition of each wall in each

building to be analyzed. Every building thus specified in BxxxxxW must be identified by a string of no

more than five alphanumeric characters represented by xxxxx here. Building identification is the first

information requested as the user begins entering or changing data in the BxxxxxW file.

Manipulating data in BxxxxxW is done through the procedure file WSTORE; that is, WSTORE is the procedure file by which the user creates and/or alters the data file BxxxxxW. Contact with BxxxxxW is

therefore initiated by the command

BEGIN, WSTORE

Figure 5.8(a) illustrates the format for entering data, via WSTORE, into the file BxxxxxW. First, the

user enters an identification number assigned to the building whose walls are to be documented. This

identification number replaces the "xxxxx" in the file name forming a unique name. Then comes the payoff

for care taken in tabulating wall data (fig. 5.2), for WSTORE now requests this data in the left-to-right

order of the tabulation. Note that when data has been entered for a wall layer, entering another layer

for that wall requires only "thickness of layer" and "material ID" (directional data, height, and width

are the same for all layers in a given wall). If the user discontinues data entry, WSTORE presents the

seven options at the top of figure 5.8(b).

Option 1: a line can be displayed as shown in figure 5.8(b). Entering the number "0" instead of a

line number allows the user to leave the display mode.

Option 2: options 2 and 5 are similar in that they both involve adding data lines to an existing

file. While 5 is only for adding a data line at the end of the file, option 2 allows the user to

insert a data line between two other lines (fig. 5.8(c)). When this is done, the inserted line must

be part of a wall already represented in the file (otherwise, option 5 would be used). For this

reason, the user must be sure that the directions, height, and width of the inserted line match

those of one (or perhaps both) of the adjacent lines (depending on whether one or both of the adjacent lines belong to the door/window of the inserted line). If the user enters the data incorrectly

and the line does not match at least one of its neighbors, WSTORE will emphatically point out the

error. This error message is shown at the bottom of figure 5.8(c). Note that the faulty line has

42
not been accepted (i.e., not entered into the BxxxxxW files); the user must again choose option 2

and enter the corrected data.

Option 3: this option allows the user to delete a line of data (fig. 5.8(d)). The procedure is

self-explanatory. Revised data can be entered using option 2 or 5, whichever is appropriate.

Option 4: displays all data for this building so far entered into BxxxxxW.

Option 5: adds a line of data at the end of an existing file. If the added line is another layer

in the last wall in the file, the user is asked only for layer thickness and material ID. If the

added line is the first layer of a new wall in the file, the format for entering the data is the

same as in option 2 (fig. 5.8(c)). Neither choice within option 5 requires matching the entered

data with that in an adjacent line.

Options 6 and 7: option 6 (fig. 5.8(d)) stores new data in file BxxxxxW, or replaces existing data

in BxxxxxW with a revised version of that data. If the user does not wish to store the new or revised data just entered, option 7 can be used to cancel that data and leave the BxxxxxW file unchanged.

5.4.4 Data File BxxxxxT (T for Types)

In this file the user stores data from the table of door and window types and specifications

(fig. 5.3). The procedure for entering this data is TSTORE, and the procedures for data entry, the

cautionary comments, and the error messages are almost identical to those employed in the procedure

WSTORE. Therefore, familiarity with WSTORE is sufficient warmup for using the procedure TSTORE to enter

data into the file BxxxxxT. Figure 5.9 illustrates the format for data entry using TSTORE; the similarity with WSTORE is obvious.

Because doors and windows may have layers (e.g., storm doors, storm windows, screens), an insertline-into-f ile option is again one of seven data-handling choices available. As in WSTORE, an inserted

line of data represents an additional layer of a door or window already in the file. Therefore, the

identifier (e.g., DE, WC), frame material, height, width, and distance above floor in the inserted line

must match those specifications in one or both of the adjacent lines. If not, the error message and the

procedure for changing the incorrect line of data are the same as in WSTORE.

The user gains access to TSTORE with the command

BEGIN, TSTORE.

Building identification is required before data entry begins.

5.4.5 Data File BxxxxxH (H for Holes)

The user stores in the file BxxxxxH the types and locations of all doors and windows in the building

to be analyzed; location is given by specifying the wall containing each door and window. This data

43
should have been previously tabulated as in figure 5.4, and is now to be entered into the data file

BxxxxxH by means of the procedure HSTORE. Again, the summons is

BEGIN, HSTORE

and building identification is required to initiate data entry (fig. 5.10).

Though not necessary, it may be a bookkeeping convenience to enter together the data for all doors

and windows in a given wall. If option 2 ("insert line into file") is employed for this purpose, the

user will be pleased to know that HSTORE does not require matching between inserted and adjacent lines.

Therefore, HSTORE, while very similar to MSTORE, WSTORE, and TSTORE, is also simpler and will present no

difficulties to a user familiar with the other three data entry programs.

5.4.6 Data File BxxxxxF (F for Frequency)

The user stores in the file BxxxxxF the frequencies required for the calculation using the procedure

file FSTORE. The program is begun by the command,

BEGIN, FSTORE.

If no BxxxxxF file is created, the program MASTER will use a set of default frequencies in the

calculation.

5.4.7 Computation Program MASTER

The program MASTER obtains building data from the files MATTER, BxxxxxW, BxxxxxT, and BxxxxxH, and

computes the attenuation (in dB) for each room; that is, the attenuation of externally incident radiation

as it penetrates into each room of the building. The user must be sure these files contain all the

necessary data before consulting MASTER. When the files are ready, the user activates MASTER by entering

BEGIN, FIELD.

The procedure file FIELD summons MASTER, the data files, and the subroutines required by MASTER for its

data handling operations. The only information that FIELD asks of the user is the identification code of

the building to be analyzed. When the user enters this building identification, the computation begins.

For each of the five directions from which radiation may be incident on the building (e.g., north,

east, south, west, above), MASTER computes all room attenuations for the frequencies given in the data

file BxxxxxF. If the frequency file is missing, MASTER will use the seven default frequencies given in

the material data tables. The printed output begins with a listing of the data files BxxxxxW, BxxxxxH,

and BxxxxxT (fig. 5.11a); then the attenuation values are given (fig. 5.11b) by frequency, direction, and

room. The data in figure 5.11 a,b are for the sample building whose wall, door, and window specifications were obtained from figure 5.1. Actual results based on field measurements are shown in chapter 7.

44
DIRECTION Dl

FB FB

DIRECTION D3

FLOOR PLAN OF SAMPLE BUILDING

NOTES:

WINDOW DATA

WA 1.2 m (H) X 0.91 m (W), plywood frame, 1 cm glass

with 0.61 cm thick 24x24 galvanized steel mesh

WB 1.2 m (H) X 1.5 m (W), aluminum frame, 1 cm glass

with 0.61 cm thick 24x24 galvanized steel mesh

DOORS

DA 2.10 m (H) x 0.91 m (W) plywood door, 5.1 cm thick

with wood frame

DB 2.10 m (H) x 1.20 m (W) plywood door 5.1 cm thick

with wood frame

DC 2.10 m (H) X 2.10 m (W) plywood door 1.3 cm thick

with aluminum frame

WALLS

All heights are 2.44 m.

FLOOR

Cement 1.30 cm thick.

CEILING

Wood (Fir) 130 cm

Figure 5.1 Layout of sample building used for illustrating data input.

45
1

z3

45

i

1

89 10

1

1

1213

1415

1617

1819

20

21

ECTION FROM TO HEIGHT WIDTH THICKNESS MATERIAL

LR D4 01 2 . 44 4 .57 1 .30 M05

LR D4 01 2 . 44 4 . 57 1 . 30 M06

LR D4 01 2 . 44 4 .57 1 . 30 MO 4 LR 01 02 2 . 44 1 . 22 1 . 30 M06

LR 02 D2 2 .44 1 . 22 20 .30 MO 7 LR 02 D2 2 . 44 1 . 22 1 .30 M06

LR 01 03 2 , 44 3 . 35 1 .30 MO 6 LR 03 D2 2 . 44 3 . 35 20 .30 M07

LR 03 D2 2 . 44 3 . 35 1 .30 MO 6 FB D3 01 2 . 00 3 . 66 1 . 30 MO 6 FB 01 D1 2 . 44 3 . 66 1 .30 MO 6 FB D3 03 2 . 44 3 . 66 1 .30 M06

FB 03 02 2 . 44 3 . 66 1 .30 M05

FB 03 02 2 . 44 3 . 66 1 .30 M06

FB 02 D1 2 . 44 3 .66 1 .30 MO 6 UD D5 01 4 .57 3 . 66 1 . 30 M04

UD 01 D6 4 . 57 3 .66 1 .30 MO 2 UD D5 02 1 .22 3 . 66 1 . 30 M04

UD 02 D6 1 . 22 3 .66 1 .30 MO 2 UD D5 03 3 . 35 3.66 1 .30 MO 4 UD 03 D6 3 35 3 .66 1 .30 MO 2

5.2. Example of wall data tabulation for walls in figure 5.1.

46
LINE ID HEIGHT WIDTH DISTANCE THICKNESS LAYER FRAME

(METERS) (METERS) ABOVE FLOOR (CM) MATERIAL MATERIAL

1 DA 2.10 . 91 0 . 00 5.10 MO 5 M05

2 DB 2.10 1 . 20 0 . 00 5.10 M05 MO 5

3 DC 2.10 2 . 10 0 . 00 1 . 30 MO 5 Ml 3

4 UA 1 . 20 .91 . 61 1 . 00 M08 M05

5 WA 1 . 20 . 91 .61 .61 MO 9 M05

6 VB 1 . 20 1 .50 .91 1 . 00 M08 Ml 3

7 WB 1 . 20 1 . 50 .91 .61 M09 Ml 3

Figure 5.3. Format for preparing door and window specifications for entry into file BxxxxxT.

LINE « DIRECTION FROM TO ID

1 LR 03 D2 UB

2 FB D3 03 DB

3 LR D4 01 WA

4 LR D4 01 DA

5 LR 01 02 DC

6 LR 01 03 DC

7 FB 01 D1 WA

8 FB 02 D1 WB

9 LR 02 D2 WA

Figure 5.4. Format for preparing door and window location data for entry into file BxxxxxH (sample data

from figure 5.1).

83/09/M. M.M.30 NOAA/MASC 170/750 83/06/26. NOS 1.4 531/552.40

FAMILY

;

USER NUMBER;

PASSWORD

XXXX2XX2

TERMINAL: 220, TTY RECOVER/ CHARGE; CHARGE , Z72 33 4 91 ,2 /BYE

WYSS LOG OFF 14 . 14.49.

UYSS SRU 1 .002 UNTS.

Figure 5.5. The log-in procedure

47
/BEGIN, MSTORE

.

(1) CREATE NEW DATABASE (2) ADD TO EXISTING DATA BASE

? 2 (1) NEXT DATA ENTRY <2> CHANGE (3) DISPLAY (4) ABORT (5) QUIT

? 1

MATERIAL ID? (E.G. M05 OR M12)

? 'MIS’ INDEX; 15 ENTER ONE LINE DESCRIPTION OF MATERIAL

? 'MOIST CLAY BRICK' ENTER 7 ATTENUATION VALUES FROM LOW TO HIGH FREQ

? 0000022,. 0000102,. 00014,. 0025,. 00572,. 00572,. 0057 ENTER ATTENUATION QUALITY PERCENT

? 10 . ENTER 7 REFLECTION COEFFS FROM LOW TO HIGH FREQ

? . 1 3 ,. 07 2 ,. 05 1 , . 02 9 , . 0 1 4 , . 0 1 4 ,

. 0 1 4 ENTER REFLECTION COEFICIENT QUALITY PERCENT

? 100 .

(1) NEXT DATA ENTRY (2) CHANGE (3) DISPLAY (4) ABORT (5) QUIT

? 5

REVERT. MSTORE COMPLETED.

/

Figure 5.6. Entering building material data into the file MATTER.

48
/BEGIN, MSTORE

(1) CREATE NEW DATABASE (2) ADD TO EXISTING DATA BASE

’ 2 (1) NEXT DATA ENTRY (2) CHANGE (3) DISPLAY (4) ABORT (5) QUIT

’ 2

ENTER MATERIAL I D OF GROUP TO BE CHANGED

» 'M05'

LINE 1 MATERIAL ID M04 LINE 2 DESCRIPTION

FIR PLYWOOD

LINE 3: FREQUENCIES

10000 . 100000 . 1000000 . 10000000 . 100000000 . 1000000000 .

1 EflO

LINE 4: ATTENUATIONS

OOOOOllS .00000677 .00000831 .000124 .00215 .026 .3 LINE 5 ATTENUATION QUALITY PERCENT

100 . LINE 6. REFLECTION COEFFICIENTS

06B 048 .074 036 .014 .013 . 01 LINE 7. REFLECTION QUALITY PERCENT

1 00

ENTER NUMBER OF LINE TO BE CHANGED (99 TO END CHANGES)

? 5 ENTER NEW ATTENUATION QUALITY PERCENT

? 10 .

ENTER NUMBER OF LINE TO BE CHANGED (99 TO END CHANGES)

? 99

HOS

FIR PLYWOOD

10000 . 100000 . 1000000 . 10000000 . 100000000 . 1000000000 .

1 E+10

.00000115 .00000677 .00000831 .000124 .00215 .026 .3 10 . .068 .048 .074 .036 .014 .013 .01 100 .

(1) NEXT DATA ENTRY (2) CHANGE (3) DISPLAY (4) ABORT (5) QUIT

? 5

REVERT. MSTORE COMPLETED.

/

Figure 5.7. Changing building material data in the file MATTER by means of the procedure file MSTORE.

49
/BEGIN, USTORE

.

ENTER BUILDING IDENTIFICATION (E.G. *101')

(NO MORE THAN 5 ALPHANUMERIC CHARACTERS)

» '701 •

WILL THIS BE

(1) A MODIFICATION OF AN EXISTING FILE?

(2) A NEW FILE? ENTER A NUMBER ! !

!

? 2

BEGIN ENTERING DATA

ENTER DIRECTION (E. G. ' LR '

)

? 'LR'

ENTER "FROM" (EG. '02' OR 'Dl')

? 'D4 '

ENTER "TO" (E.G. '02' OR 'Dl'

)

?

' 01 '

ENTER HEIGHT, METERS

? 2.44

ENTER WIDTH, METERS

? 4.57

ENTER THICKNESS OF LAYER, CENTIMETERS

? 1.30

ENTER "MATERIAL ID" (EG. 'MOl')

? 'MOS'

DO YOU WANT TO ENTER MORE DATA?(1) YES (2) NO ENTER A NUMBER ! !

!

? 1

IS THIS THE FIRST LAYER OF A WALL (1) YES (2) NO ENTER "0" TO ESCAPE "DATA ENTRY" MODE

ENTER A NUMBER!

I

? 2

ENTER THICKNESS OF LAYER, CENTIMETERS

? 1.30

ENTER "MATERIAL ID" (E.G. 'MOl')

? 'M06'

DO YOU WANT TO ENTER MORE DATA?(1) YES (2) NO ENTER A NUMBER I I I

? 2

DATA ENTRY DISCONTINUED

Figure 5.8(a)

.

Procedure file WSTORE is used to enter wall data into file BxxxxxW. Data is entered in

the sequence of columns in figure 5.2.

50
CHOOSE

(1 ) DISPLAY LINE OF DATA (4) DISPLAY ALL LINES

(2) INSERT LINE INTO FILE (5) APPEND LINES OF DATA

(3) DELETE LINE

ENTER A NUMBER ! ! !

(6) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA

» 1

SPECIFY THE NUMBER OF THE LINE TO BE DISPLAYED

( ENTER "0" TO ESCAPE DISPLAY MODE )

' 1

LINE I DIRECTION

1 LR FROM

D4 TO01 HEIGHT2 . 44 WIDTH4 .57 THICKNESS1 .30 MATERIAL

MO 5

CHOOSE

(1) DISPLAY LINE OF DATA (4) DISPLAY ALL LINES

(2) INSERT LINE INTO FILE (5) APPEND LINES OF DATA

(3) DELETE LINE

ENTER A NUMBER I ! !

(6) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA

» 6

DOUBLE CHECK ! ! ! DO YOU YOU WANT TO STORE THIS DATA AND END PROG

NOTE: STORING THIS DATA WILL WIPE OUT ANY OLD FILE

OF THE SAME NAME ! !

!

ENTER A NUMBER: (1) YES (2) NO

? 1

DATA HAS BEEN STORED AND PROGRAM TERMINATED

REVERT. WSTORE COMPLETED.

/

Figure 5.8(b). (Continued from figure 5.8(a)) How the display mode allows the user to examine a line

of data.

51
/BEGIN, WSTORE

.

ENTER BUILDING IDENTIFICATION (E.G, '101')

(NO MORE THAN 5 ALPHANUMERIC CHARACTERS)

? '701'

WILL THIS BE

(1) A MODIFICATON OF AN EXISTING FILE?

(2) A NEW FILE? ENTER A NUMBER ! !

!

? 1

CHOOSE

(1) DISPLAY LINE OF DATA

(2) INSERT LINE INTO FILE

(3) DELETE LINE

ENTER A NUMBER ! !

!

? 2

SPECIFY NUMBER OF LINE BEFORE WHICH A NEW LINE IS TO BE INSERTED

( ENTER "0" TO ESCAPE "INSERTION" MODE )

? 2

ENTER DIRECTION (E. G. ' LR ' )

? 'LR'

ENTER "FROM" (E.G. '02' OR 'Dl')

?

' 06 '

ENTER "TO" (E.G. '02' OR 'Dl')

?

' 05 '

ENTER HEIGHT, METERS

? 2.44

ENTER WIDTH, METERS

? 2.0

ENTER THICKNESS OF LAYER, CENTIMETERS

? 2.0

ENTER "MATERIAL ID" (EG. 'MOl')

? 'MOl'

(4) DISPLAY ALL LINES

(5) APPEND LINES OF DATA

(6) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA

YOUR DATA WAS NOT ACCEPTED ! !

!

YOUR DATA MUST REPRESENT A LAYER IN AN EXISTING WALL

I.E. THE DIRECTION, FROM, TO, HEIGHT, AND WIDTH

PARAMETERS MUST MATCH THE WALL JUST BEFORE

OR JUST AFTER YOUR SPECIFIED INSERTION POINT

THE FOLLOWING DISPLAYS

THE LINE BEFORE YOUR LINE,

YOUR LINE, AND THE LINE AFTER

LINE • DIRECTION FROM TO HEIGHT WIDTH THICKNESS MATERIAL

1 LR D4 01 2 .44 4.57 1 .30 MOS

LINE t DIRECTION FROM TO HEIGHT WIDTH THICKNESS MATERIAL

2 LR 06 05 2 . 44 2 .00 2 . 00 MOl LINE t DIRECTION FROM TO HEIGHT WIDTH THICKNESS MATERIAL

3 LR D4 01 2 . 44 4 .57 1 .30 NO 6

Figure 5.8(c). The WSTORE sequence for inserting data into the file BxxxxxW. Note error message when an incorrect line is inserted.

52
CHOOSE

U) DISPLAY LINE OF DATA (4) DISPLAY ALL LINES

(2> INSERT LINE INTO FILE (5) APPEND LINES OF DATA

(3) DELETE LINE (i) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA

ENTER A NUMBER ! !

!

’ 3

SPECIFY THE NUMBER OF THE LINE TO BE DELETED

(ENTER "0“ TO ESCAPE DELETION MODE)

’ 1

DOUBLE CHECK ! !

!

DO YOU WANT TO DELETE THE FOLLOWING LINE?:

LINE • DIRECTION FROM TO HEIGHT WIDTH THICKNESS MATERIAL

1 LR D4 01 2.44 4.57 1 .30 ENTER (1) YES OR

1

(2) NO

LINE • 1 DELETED

CHOOSE

(1 ) DISPLAY LINE OF DATA (4) DISPLAY ALL LINES

(2) INSERT LINE INTO FILE (5) APPEND LINES OF DATA

(3 ) DELETE LINE (&) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA

ENTER A NUMBER ! ! !

? 6

DOUBLE CHECK ! !

!

DO YOU YOU WANT TO STORE THIS DATA AND END PROG

NOTE: STORING THIS DATA WILL WIPE OUT ANY OLD FILE

OF THE SAME NAME ! !

!

ENTER A NUMBER: (1) YES (2) NO

? 1

DATA HAS BEEN STORED AND PROGRAM TERMINATED

REVERT. WSTORE COMPLETED.

/

Figure 5.8(d). WSTORE: how to delete data (option 3), and use of option 6 to store entered data and

terminate WSTORE.

53
/BEGIN, TSTORE

ENTER BUILDING IDENTIFICATION (E . G . TOl')

(NO MORE THAN 5 ALPHANUMERIC CHARACTERS)

? 701

701 (-ERROR IN COL. 4, RETYPE RECORD FROM THIS FIELD

? '701'

WILL THIS BE

(1) A MODIFICATION OF AN EXISTING FILE?

(2) A NEW FILE? ENTER A NUMBER !!!

? 2

BEGIN ENTERING DATA

ENTER TD' (E G. ’WA‘ OR 'DE'>

? ’WA'

ENTER HEIGHT, METERS

? 2

ENTER WIDTH, METERS

? .98

ENTER DISTANCE ABOVE FLOOR, METERS

? 1

ENTER THICKNESS OF LAYER, CENTIMETERS

? A

ENTER "MATERIAL ID OF LAYER" (E.G. 'MOl')

? 'M05‘

ENTER "MATERIAL ID OF FRAME" (E.G. 'MOl')

? 'M08' DO YOU WANT TO ENTER MORE DATA?(1) YES (2) NO

ENTER A NUMBEER !!!

? 1

IS THIS THE FIRST LAYER OF A DOOR OR WINDOW? (1) YES (2) NO

ENTER "0" TO ESCAPE "DATA ENTRY" MODE

ENTER A NUMBER!!

? 2

ENTER THICKNESS OF LAYER, CENTIMETERS

? 1

ENTER "MATERIAL ID OF LAYER" (E.G. 'MOl')

? 'M04' DO YOU WANT TO ENTER MORE DATA?(1) YES (2) NO

ENTER A NUMBEER !!! ? 2DATA ENTRY DISCONTINUED

CHOOSE

(1) DISPLAY LINE OF DATA (4) DISPLAY ALL LINES

(2) INSERT LINE INTO FILE (5) APPEND LINES OF DATA

(3) DELETE LINE (6) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA

ENTER A NUMBER !!!

Figure 5.9. The proce(iure TSTORE enters data on door and window types into file BxxxxxT.

54
/BEGIN, H3T0RE

ENTER BUILDING IDENTIFICATION (E.G. '101')

(NO MORE THAN 5 ALPHANUMERIC CHARACTERS)

’ • 70 I

•

WILL THIS BE (1) A MODIFICATION OF AN EXISTING FILE?

( 2 ) A NEW FILE? ENTER A NUMBER ! !

!

’ 2

BEGIN ENTERING DATA

ENTER DIRECTION <E G. ’ LR '

)

’ ' LR '

ENTER "FROM" (E.G. ‘02' OR 'Dl')

’ ‘D2 '

ENTER "TO" (EC. ‘02‘ OR 'Dl '

>

?

' 03 '

ENTER HOLE 'ID' (E.G. ' WA ' OR 'DA')

? 'WB

DO YOU WANT TO ENTER MORE DATA?(1) YES (2) NO ENTER A NUMBER ! !

!

? 1

ENTER DIRECTION (E G . ‘ LR ' )

? 'TB

DIRECTION MUST BE 'LR' OR • fb ' OR ' UD

TRY AGAIN! I

!

ENTER DIRECTION (E . G . ' LR '

)

? -fB'

ENTER "FROM" (E.G. '02' OR 'Dl')

? 'D3 '

ENTER "TO" (EG. '02' OR 'Dl')

?

' 03 '

ENTER HOLE 'ID' (E.G. 'WA' OR 'DA')

? 'DB'

DO YOU WANT TO ENTER MORE DATA?(1) YES (2) NO ENTER A NUMBER ! I

!

? 2

DATA ENTRY DISCONTINUED

CHOOSE

( 1

)

DISPLAY LINE OF DATA (4) DISPLAY ALL LINES

(2) INSERT LINE INTO FILE (5) APPEND LINES OF DATA

(3) DELETE LINE (6) STORE DATA AND EXIT PROGRAM

(7) EXIT PROGRAM WITHOUT STORING DATA ENTER A NUMBER I I !

? 4

LINE t DIRECTION FROM TO ID

1 LR D2 03 WB

2 FB D3 03 DB

re 5. 10. Procedure HSTORE enters into file BxxxxxH the types and locations of doors and windows

55
/BEGIN, FIELD ENTER BUILDING IDENTIFICATION (EG. '101')

(NO MORE THAN 5 ALPHANUMERIC CHARACTERS)

7 ' 701 ' BUILDING IDENTIFICATION ENTERED AS '701' ENTER NUMBER OF ROOMS IN BUILDING

> 3

WALL IDENTIFICATION WALL PARAMETERS

DIR FROM TO MATERIAL HEIGHT WIDTH THICKNESS

LR D4 01 M05 2 . 44 4 . 57 1 . 30 LR D4 01 M06 2 , 44 4 , 57 1 .30 LR D4 01 MO 4 2 . 44 4 . 57 1 . 30 LR 01 02 MO 6 2 .44 1 . 22 1 .30 LR 02 D2 M07 2 . 44 1 . 22 20 .30 LR 02 D2 M06 2 ,, 44 1 ,. 22 1 .30 LR 01 03 MO 6 2 . 44 3 . 35 1 . 30 LR 03 D2 M07 2 . 44 3 ., 35 20 .30 LR 03 D2 M06 2 ,. 44 3 ,, 35 1 . 30 FB D3 01 M06 2 , 00 3 .. &(, 1 .30

FB 01 D1 M0& 2 . 44 3 ,. 66 1 .30 FB D3 03 M06 2 . 44 3 . 66 1 .30 FB 03 02 M05 2 ,

. 44 3 . 66 1 . 30 FB 03 02 MO 6 2 . 44 3 . 66 1 .30 FB 02 D1 MOi 2 .. 44 3 . 66 1 . 30 UD D5 01 M04 4 . 57 3 . 66 1 .30 UD 01 D6 M02 4 . 57 3 . 66 1 . 30 UD D5 02 M04 1 . 22 3 . 66 1 ,.30 UD 02 D& M02 1 . 22 3 . 66 1 ,. 30 UD D5 03 M04 3 . 35 3 . 66 1 ,.30 UD 03 D6 MO 2 3 . 35 3 . 66 1 . 30

DOOR AND WINDOW LOCATIONS

Ik**************************

WALL IDENTIFICATION

ID DIRECTION FROM TO

WB LR 03 D2 DB FB D3 03 WA LR D4 01 DA LR D4 0 1 DC LR 01 02 DC LR 01 03 WA FB 01 D1 WB FB 02 D1 WA LR 02 D2

DOOR AND WINDOW PARAMETERS

* Ht * t ***************************************************

ID MATERIAL FRAME HEIGHT WIDTH LAYER DISTANCE

MATERIAL THICKNESS ABOVE FLR

= = = = II II II u II li II H H ====x==x= S S S X s s 3 S X B X X X :========== II II II II II II II II II II DA M05 M05 2.10 . ?1 5.10 0 . 00 DB M05 MO 5 2 . 10 1 . 20 5 . 10 0 . 00 DC M05 M13 2.10 2.10 1 . 30 0.00

WA MOB M05 1 . 20 . 91 1 . 00 .61 WA M09 M05 1 . 20 .91 . 61 . 6 1 WB MOB Ml 3 1 . 20 1 . 50 1 . 00 .91 WB MO? M13 1 .20 1 . SO .61 .91

S S = B II II H li n If H II It H H II 11 U It ======= II 11 II II II U II II II It ==========

Figure 5.11(a). An output of the program MASTER giving room attenuation (in dB) vs. frequency and

direction of the incident radiation for building shown in figure 5.1.

56
ATTENUATION AT A FREQUENCY OF l.OOOE+06 HZ

*niit*li*1itli»»*litt*tliii******1t*****ttttt***1it**'k*1(**li*iit1(1(1i*1i*1i**li**lili1i*li***

A DIRECTIONS A ROOMS A 1 2 3 4 5

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

1 A - . 96 -11.21 -1.34 - . 41 2.23 *

2

A 1.13 -2 . 92 -5 . 32 -12.28 .89 *

3

A -3 . 84 - . 51 .65 -11.80 2.70 * **tt**1ili1i1iK**ii*1i1i*»iit1Hi******1i1t**it*********t**1t*1i******t****it*1tt****t****

ATTENUATION AT A FREQUENCY OF l.OOOE+07 HZ

* A

* ROOMS * DIRECTIONS

2 3 4

*

5

* ******* I A 1 A - . 97 -11.22 -1.35 - . 41 2.23 A

A 2A 1.13 -2 . 93 -5 . 32 -12.28 . 89 A

A 3

A -3 .87 - . 52 . 65 -11.00 2 . 70 A

* *

ATTENUATION AT A FREQUENCY OF l.OOOE+08 HZ *************************************************************************

* * DIRECTIONS *

» ROOMS * 1 2 3 4 5

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

A 1 A - .37 -3 . 52 - . 42 -2 . 09 2.83 A

A 2 A -2 .92 -6.51 -4 . 03 -5 . 75 - . 45 A

A 3A -1.98 -3 . 33 - . 78 -3 . 75 2 . 07 A

ATTENUATION AT A FREQUENCY OF l.OOOE+09 HZ *************************************************************************

* * DIRECTIONS *

» ROOMS * 1 2 3 4 5 * *************************************************************************

A 1 A - . 97 -12.41 -1.36 - . 49 2 . 20 A

A 2A 1.12 -4.11 -5 . 40 -12.40 . 84 A A 3 A -3 .92 -1.69 . 60 -11.91 2.66 A *************************************************************************

ATTENUATION AT A FREQUENCY OF l.OOOE+10 HZ ************************************************************************

* ROOMS * DIRECTIONS

2 3 4 5 ***********************************************************************

1 A -1 .02 -23.00 -1 . 42 -1.24 1 . 90

2

A 1 . 07 -14 45 -6.10 -13.56 . 41

3 A -4 .30 -12.02 .21 -13.00 2 . 30

REVERT. FIELD COMPLETED.

/

Figure 5.11(b). Continuation of figure 5.11(a).

57
6. EXPERIMENTAL DATA

This chapter comprises reports on building attenuation measurements made by NBS at the Seneca Falls

Army Depot, the Sierra Army Depot, and the Naval Training Equipment Center.

6.1 Sierra and Seneca Falls Army Depots

Equipment and personnel were assembled to make measurements of electromagnetic attenuation of three

buildings at two sites selected by the Army. These sites were the Sierra Army Depot in Herlong, California, and the Seneca Army Depot in Seneca Falls, New York. The measurements were made according to the

Draft Test Plan shown in Appendix 9.1, and are briefly described here. The test plan was modified for

each test site by the engineers in charge to conform to any time constraints and to any constraints

imposed by the physical layout of the structures. For example, the frequency range was reduced from

180 kHz - 18 GHz to 200 kHz - 10 GHz because it was decided that the additional expense involved was not

justified by the present needs of the Army. Although the draft test plan recommends four physical group

measurements, on the judgment of the engineers in charge, three (or in some cases, two) groups were assumed sufficient to determine the shielding effectiveness of the buildings.

The measurements were conducted over the frequency range of 200 kHz through 10 GHz. The building

(No. 672) measured at the Sierra Army Depot was constructed of concrete with a metal barrier inside the

wall. Two buildings were measured at the Seneca Falls Army Depot. One (No. 816) was a concrete building

with one meter of dirt covering the side of the building and massive steel doors on the ends. The second

building (No. 819) was constructed with cement blocks and metal doors for access.

The technique for all the measurements was as follows: a transmitting antenna was placed 30 meters

from the building with the transmitted energy being directed perpendicular to the wall of the building.

To get a base unattenuated signal the receiving system measured the transmitted signal outside the building at the designated frequency. The same receiving system was then used inside the building to measure

the signal attenuation of the building. This signal attenuation (signal inside divided by signal outside,

in dB) was measured on a predetermined distance grid within the building. Wherever possible, a \/4 (onequarter wavelength) offset measurement was made to detect the possibilities of building resonance effects.

The receiving system used to measure these building attenuations was the isotropic antenna system developed at the National Bureau of Standards.

The attenuation measurements are summarized in tables 6.1 - 6.4 and are plotted in figures 6.1, 6.2,

6.2 and 6.4. The dimensions and physical layouts of the buildings are shown in figures 6.5, 6.6 and 6.7.

The tables list the locations, the frequencies of the test, the mean values of attenuation measured, and

58
uncertainties of the measurement (one standard deviation) shown in parentheses. Computation of the standard deviation is treated in Appendix 9.1.

6.2 Naval Training Equipment Center (NTEC)

Measurements were made of electromagnetic attenuation of three shelters connected together as a

training module. The test site was located at NTEC in Orlando, Florida. The measurements were made according to the test plan shown in Appendix 9.1 and are briefly described here. The test plan was modified

at the test site by the engineers in charge to conform to any constraints imposed by time or by the physical layout of the test areas.

The measurements were conducted over the frequency range of 35 MHz up to 18 GHz. As shown in figure 6.8, two ground level transmitter locations (labeled 1 and 2) were used. A third location, with the

transmitter placed on the roof of an adjacent building, was used to simulate transmissions from above.

The following procedure was used for all measurements. The transmitter was placed at one of the locations

and was set to operate at the desired frequency and power level listed in the test plan. The receiving

antenna was then placed 5 meters outside the building to measure a reference field strength. The receiving antenna was then placed inside Room 1 at the various locations shown in the test plan for the particular frequency. The attenuation (in dB) was then calculated as the measured field strength inside divided

by the measured reference field strength outside. In all cases, the receiver electronics were located in

Room 2 and were connected to the antennas with electrical cables.

The measured data is shown in tables 6.5 - 6.7 listed by location. The attenuation data is listed as

"average", "high", and "low" values for each data point. The first label represents the average of all

the data for that location, polarization, frequency, and type of field (magnetic or electric), while the

other labels represent the highest and lowest value recorded.

Figures 6.9 - 6.12 show plots of the data where the circles represent electric field attenuation,

while the squares represent magnetic field attenuation. The high and low values listed in the tables are

shown as horizontal bars above and below each circle or square. When it would be overlapped by the size

of the circle or square, the horizontal bar is not shown.

59
Table 6.1. EM Attenuation of Building No. 672 at Sierra Army Depot

Frequency Building Attenuation*, dB

Mz Electric: Field Magnetic Field

0.2 36 (2) 24 (3) 4 34 (5) 33 (2) 14 27 (4)

28 33 (4)

50 39 (6)

140 37 (5)

200 27 (4)

401 22 (4)

751 29 (3)

998 28 (3)

1008 27 (4)

2000 26 (5)

4008 39 (5)

8007 34 (3)

*Uncertainties representing one standard deviation are shown in parentheses.

Table 6.2. EM Attenuation of Building No. 816, End Wall at Seneca Falls, New York

Frequency Building Attenuation*, dB

MHz Electric Field Magnetic Field

0.2 46 (6) 33 (14)

4 54 (7)

15 57 (7)

30 51 (8)

50 33 (7)

100 44 (5)

200 44 (5)

400 48 (13)

750 50 (6)

1000 45 (7)

2000 45 (7)

4000 42 (5)

8000 55 (8)

*Uncertainties representing one standard deviation are shown in parentheses.

Table 6.3. EM Attenuation of Building No. 816, Side Wall at Seneca Falls, New York

Frequency Building Attenuation*, dB MHz Electric Field Magnetic Field

0.2 56 (2) 50 (9) 4 49 (2)

15 53 (4)

30 62 (4)

50 60 (5)

100 56 (7)

500 65 (12)

1000 63 (7)

8000 > 83t

10,000 > 83t

*Uncertainties representing one standard deviation are shown in parentheses.

tNo measurable signal levels with available equipment.

60
Table 6.4. EM Attenuation of Building No. 819, End Wall at Seneca Falls, New York

Frequency Building Attenuation*, dB MHz Electric Field Magnetic Field

0.2 21 (3) 24 (4)

4 18 (7) 16 (5)

15 16 (2)

30 19 (4)

50 4 (4)

100 10 (7)

200 13 (7)

500 13 (4)

750 14 (3)

1000 23 (4)

4000 24 (4)

8000 34 (18)

10,000 35 (3)

*Uncertainties representing one standard deviation are shown in parentheses.

Table 6.5. Attenuation measured with launch antenna at location 1, NTEC

Vertical Polarization Horizontal Polarization

Frequency Electric Field Magnetic Field Electric Field

GHz Attenuation (dB) Attenuation (dB) Attenuation (dB)

Average High Low Average High Low Average High Low

0.0035 -34 -43 -25 -38 -43 -34

0.007 -23 -29 -18 -27 -33 -21

0.014 -42 -42 -41 -45 -46 -44

0.028 -43 -49 -37 -43 -46 -40

0.054 -26 -26 -26

0.088 -17 -18 -15

0.14 -15 -16 -13 -16 -18 -14

0.20 -19 -21 -16 -13 -15 -11 0.40 -23 -25 -18 -10 -15 - 5 0.75 -20 -23 -19 -31 -31 -30

1.0 -10 -16 - 0 -10 -13 - 7 2.0 - 7 - 8 - 5 - 7 - 8 - 4 8.0 -37 -38 -35 -23 -26 -20

12.0

18.0 -11 -11 -11 -13 -15 -12

61
Table 6.6. Attenuation measured with launch antenna at location 2, NTEC

Vertical Polarization Horizontal Polarization

Frequency Electric Field Magnetic Field Electric Field

GHz Attenuation (dB) Attenuation (dB) Attenuation (dB)

Average High Low Average High Low Average High Low

0.0035 -22.5 -25 -20 -21 -21 -20

0.007 -30 -40 -21 -20 -20 -19

0.014 -27 -28 -26 -25 -27 -23

0.028 -28 -33 -22 -26 -34 -18

0.054 -32 -39 -25

0.088 -13 -17 -10

0.14 - 6 - 8 - 1 -13 -14 -11

0.20 - 7 -10 - 5 -17 -19 -14

0.40 -12 -14 -10 - 7 -11 - 4 0.75 -13 -16 -11 -18 -20 -16

1.0 -22 -24 -21 -20 -26 -17

2.0 -31 -34 -27 -22 -26 -19

8.0 -17 -17 -16 -19 -20 -18

12.0 -13 -24 - 1 -15 -21 - 9 18.0

Table 6.7, Attenuation measured with launch antenna at location 3 (roof), NTEC

Vertical Polarization Horizontal Polarization

Frequency Electric Field Electric Field

GHz Attenuation (dB) Attenuation (dB)

Average High Low Average High Low

8.0 -20 -22 -18 -20 -22 -17

62
» I Ml LJJlJlJlI.

0.1 1.0 10 100

FREQUENCY, MHz

1 I mill 1 I I ililJ

1,000 10,000

Figure 6.1. Electromagnetic attenuation versus frequency of Building No. 672 at Sierra Army

Depot. Electric field attenuation (open circles) was measured from 0.2 - 10,000 MHz while magnetic field (boxes) was measured at 0.2 and 4 MHz. Error bars represent

one standard deviation. See figure 6.5 for locations of transmitter and receivers.

63
01

0.1 1.0

1 1 I Hill I I I I Mill 1 I I Mini 1111 i.nil 10 100 1,000 10,000

Frequency, MHz

Figure 6.2. Electromagnetic attenuation versus frequency for Building No. 816 at Seneca Falls. The

data are plotted as figure 6.1. For this scan, the transmitter was located at the "End

Wall" as shown in figure 6.6.

64
0L_

0.1

I » I mil Mil I I I I mil

1.0 10 100

Frequency, MHz

I I I I ml

1,000

1 ,1 mil

10,000

Figure 6.3. Electromagnetic attenuation versus frequency for Building No. 816 at Seneca Falls. The

data are plotted as in figure 6.1. For this scan, the transmitter was located at the "Side

Wall" as shown in figure 6.6. Magnetic field attenuation was measured at 0.2 MHz, only.

65
Frequency, MHz

Figure 6.4. Electromagnetic attenuation versus frequency for Building No. 819 at Seneca Falls.

The data are plotted the same as in figure 6.1. The transmitter and receiver

locations are shown in figure 6.7. Magnetic field attenuation was measured at 0.2 and 4 MHz.

66
67 m

Figure 6.

o Reference Field

X Inside Field

SIERRA ARMY DEPOT,

BUILDING 672

Transmitter

5. Physical layout of Building No. 672 at Sierra Army Depot. The transmitter is located

30 meters from the building and is shown as a square box. Outside reference fields wc-re measured 15 meters from the building at the locations marked with open circles. One row and one column of inside measurements were made at the locations marked by two dashed . with x's. Measurements are made at one meter intervals along the dashed line.

67
at End Wall

Figure 6.6. Physical layout of Building No. 816 at Seneca Falls. For this site, two sets of data were taken with the transmitter located at the two boxes marked on the drawing. Reference,

outside measurements were taken at the locations marked with open circles while inside

measurements were taken along the dashed line. For the end wall transmitter location,

inside measurements were taken at the locations marked with x's; while the side wall trans- mitter measurements are marked with closed circles. Measurements are made at one meter

intervals along the dashed lines.

68
Figure 6.7. Physical layout of Building No. 819 at Seneca Falls. The transmitter is located at the

solid box marked on the drawing, while the outside reference points are shown as open circles. The inside measurement points are located along the dashed lines with the x's marked. Measurements are made at one meter intervals along the dashed lines.

69
TRANSMITTER LOCATION 1 —HD

DOOR

Figure 6.8.

30 METERS

•AIR

O

CONDITIONER

30 METERS

TRANSMITTER

LOCATION 2 -

OUTSIDE

O MEASUREMENT

LOCATIONS

INSIDE

MEASUREMENT

LOCATIONS

Building layout of training module at NTEC. The physical arrangement of the three attached

buildings are shown along with the two transmitter locations (boxes). Air conditioning

units are labeled "A.C.". A rubber shroud or gasket is used to attach the rooms together.

70
FREQUENCY. GHz

Figure 6.9. Building attenuation versus frequency of training module at NTEC. This graph shows the

data for transmitter location 1 with vertical polarization launched. The circles represent

average electric field attenuation, while the average magnetic field attenuation is shown

as a square. The limit bars represent the highest and lowest attenuation observed at each

frequency.

71
Figure 6.10. Building attenuation versus frequency of training module at NTEC. This graph shows the

data for transmitter location 1 with horizontal polarization launched. The circles re- present the average electric field attenuation, while the limit bars represent the highest

and lowest attenuations observed at each frequency.

72
FREQUENCY, GHz

Figure 6.11. Building attenuation versus frequency of training module at NTEC. This graph shows the

data for transmitter location 2 with vertical polarization launched. The circles represent

average electric field attenuation, while the average magnetic field attenuation is shown

as a square. The limit bars represent the highest and lowest attenuations observed at each

frequency.

73
FREQUENCY. GHz

Figure 6.12. Building attenuation versus frequency of training module at NTEC. This graph shows the

data for transmitter location 2 with horizontal polarization launched. The circles re- present the average electric field attenuation, while the limit bars represent the highest

and lowest attenuation observed at each frequency.

74
7. COMPUTER RESULTS AND CONCLUSIONS

7.1 Comparison With Experimental Results

To test the validity of the computer calculation of building attenuation, the program was run for a

building that had been measured experimentally for electromagnetic shielding effectiveness. The structure chosen for comparison was the training module located at the Naval Training Equipment Center (NTEC)

in Orlando, Florida. The experimental measurements of shielding effectiveness are already described in

Section 6.2 of this report.

To input data into the computer program, the training module floor plan shown in figure 6.8, wa

redrawn, as shown in figure 7.1, to show the details of the walls, windows, and doors, based on observations made at the measurement site. Some assumptions and compromises were also made so that the building

could be properly modelled by the computer. Looking at figure 6.8, the main questions were; 1) how to

account for the rubber gaskets between the modules. The first question was solved by considering the

open space between the modules as a fourth room, or room 4 as shown on figure 7.1. The walls were taken

as M01 ("NULL MATERIAL") and windows of material M01 with a metal frame (M12 (STEEL)) were added on the

three ends of the room. The "T" shape of ROOM 04 was created by using two rectangular shaped volumes and

giving them the same name. For example, look at the last two data entry lines of the first table in

figure 7.2(a) and notice that room 4 has two ceiling sections, one with dimensions 6.10 x 1.22 m and the

second with 6.10 x 0.15 m. The three windows, DA, DB and DB, shown in the figure were added so that the

input resonance condition described in Section 3.5 would be taken into account.

The air conditioners (question 2) were considered closed doors in the model ("DC" on the diagram).

The rubber gaskets (question 3) were modelled by ignoring them. They should have no shielding effectiveness for electromagnetic radiation.

When the experimental measurements were made on the shelter, some of the exterior doors were left

open to provide ventilation for the equipment from the hot and humid conditions. Those doors, marked

"DO" in figure 7.1, are modelled as "open" for the computer program so that the calculations can be

properly compared with the experimental results. (Experimentally it was found that opening the doors had

less than a 2 dB effect on the measurements. Since equipment failure was experienced with the doors

closed, and since the experimental uncertainty was typically greater than 2 dB, the engineers in charge

of the measurement made the decision to leave those doors open.)

The computer print-out for the calculation is shown in figure 7.2 (a-d). The first three tables

list the wall data file B204W, the hole data file B204H, and hole types data file B204T. The next

thirteen tables list the attenuation of each room (1-4) for each direction of input (1-5) for frequencies

in the range of 1.0 MHz to 10 GHz. In figures 7. 3-7. 6, the experimental data (open circles and squares)

75
is compared to the calculated data (closed triangles) where transmitter location 1 corresponds to computer direction Dl, and transmitter location 2 corresponds to computer direction D2. Since experimental

measurements were made only for room 1, the calculated data is displayed for just room 1.

By symmetry, a field projected from direction D3 should yield identical results with a field projected from Dl. This is evident in the attenuation tables of figure 7.2 (a-d) where the column

corresponding to D3 is identical with the results shown in the first column, Dl. The fourth column, D4,

is -60 dB at all frequencies and for all rooms. This is caused by the fact that the wall facing direction D4 has no openings which will allow penetration. Since that wall "shadows" all the other rooms, and

since the computer model does not include external diffraction around corners, all of the rooms will have

a -60 dB attenuation factor for direction D4. In figure 7.7, the room and door resonances of the test

structure are shown. In the 0.1 GHz range the room resonance and door resonance for door "DO" dominate

and drop the attenuation factor to zero. (Where the computer model calculated gain for a room, the atten

nation factor was taken to be zero.) This effect was equally strong for both directions Dl and D2 and

can be seen in figures 7.3 and 7.4. At around 1.0 GHz, the dominant resonant effect is due to door "DB".

Since this door is only illuminated from direction Dl, the calculated attenuation at 1.0 GHz is reduced

for direction Dl (fig. 7.3) but not for direction D2 (fig. 7.4). This is in good agreement with the

corresponding experimental measurements for those directions.

Overall, the fit between the calculated and experimental results are in good agreement. Given just

the calculated data, it would be possible to estimate the shielding effectiveness of the training modules

7.2 Recommendation for Further Work

One area in the model that could use further development is in the resonance calculations. The

present approach essentially turns the resonances "on" or "off" and does not use any sophisticated techniques to properly weight the resonant effects. It should be possible to incorporate more advanced

resonant models into the program. That task should be addressed in future work.

76
DIRECTION D1

Figure 7.1. Building layout of training modules used for comparison of calculated versus experimental

data. Notice that the air gap between the modules is considered "Room 04" for the

computer model.

77
ENTER BUILDING IDENTIFICATION (E.G. 'lOl')

(NO MORE THAN 5 ALPHANUMERIC CHARACTERS)

? '204' BUILDING IDENTIFICATION ENTERED AS '204' ENTER NUMBER OF ROOMS IN BUILDING

i WALL IDENTIFICATION WALL PARAMETERS i *** A ************** A********************************** 1 DIR FROM TO MATERIAL HEIGHT WIDTH THICKNESS

1 LR D4 02 M12 2 . 44 6.10 .20 j LR 02 04 M12 2 . 44 6 . 10 .20 LR 04 01 M12 2 . 44 2 .44 .20

} LR 01 D2 M12 2 . 44 2 . 44 . 20 ! LR 04 D2 MOl 2 . 44 1 . 22 .20 LR 04 03 M12 2 .44 2 . 44 • LR 03 D2 M12 2 . 44 2 . 44 . 20 i FB D3 02 M12 2 .44 2 . 44 . 20 FB 02 D1 Ml 2 2 . 44 2 . 44 .20 ; FB D3 04 MOl 2 . 44 . 15 . 20 1 FB 04 D1 MOl 2 . 44 .15 .20 1 FB D3 03 M12 2 .44 6.10 . 20 j FB 03 04 M12 2 . 44 6.10 .20 FB 04 01 M12 2.44 6.10 . 20 1 FB 01 D1 M12 2 . 44 6.10 .20 { UD D5 01 M12 6.10 2 .44 . 20 ! UD D5 02 M12 6.10 2 . 44 .20 i UD D5 03 M12 6.10 2 . 44 . 20 UD D5 04 MOl 6 . 10 1 .22 1.00

UD D5 04 MOl 6.10 . 15 1 . 00 1 UD 01 D6 M12 6 . 10 2 . 44 .20 UD 02 D6 M12 6.10 2 . 44 . 20 .

1 UD 03 D6 M12 6 . 10 2 . 44 .20 UD 04 D6 MOl 6.10 1 . 22 1 . 00 j UD 04 D6 MOl 6 . 10 . 15 1.00

DOOR AND WINDOW LOCATIONS

AAAAAAAAAAAAAAAAAAAAAAAAAAA

WALL IDENTIFICATION

ID DIRECTION FROM TO

DC LR D4 02 DO LR 02 04 DO LR 04 01 DC LR 01 D2 WC LR 02 04 DA LR 04 D2 DO LR 02 04 DO LR 04 03 DO LR 03 D2 DC FB D3 03 DO FB D3 02 DO FB 02 D1 DE FB D3 04 DB FB 04 D1 DC FB 01 D1

Figure 7.2(a). Computer print-out of calculations of electromagnetic shielding effectiveness for building

shown in figure 7.1.

78
DOOR AND WINDOW PARAMETERS

ID MATERIAL FRAME MATERIALHEIGHT WIDTH LAYER THICKNESSDISTANCE

ABOVE FLR

DA MOl M12 2 44 1 . 22 . 20 0 . 00

DB MO 1 Ml 2 2 . 44 . 15 .20 0 . 00 DC M12 M12 1 . 76 1 . 22 . 20 0 . 00 DO MO 1 M12 1 . 76 1 . 22 . 20 0 . 00 WC M12 M12 . 61 . 46 .20 0 . 00 VA MIO M12 1 . 76 1 . 22 . 20 0 . 00

ATTENUATION AT A FREQUENCY OF l.OOOE+06 HZ

ROOMS

1Z

34

• * * * I « I

1

-32.42

-6 . 96 -35.71

-12.73

i********lk**«*******A***lt lk** *4t*«It**4(*t*A 13DIRECTIONS

4 5 I*******************************************

-23 . 59 -23.31

-7 . 4B -3.91

-32 . 42 -6 . 96 -35.71

-12.73

-60.00

-60 . 00 -60 .00 -60 . 00

-28.73

-28 .45 -32.03

-9 . 05

ATTENUATION AT A FREQUENCY OF 2.000E+06 HZ

**

t DIRECTIONS * ROOMS * 1 2 3 4 5

ft tt*«ft**«*t«A**««**«*******«A**t*A*««*«*«**«**********

1 * -32 . 42 -23 . 59 -32 . 42 -60 .00 -28.73 ft

2

* -6 . 96 -23 . 31 -6 . 96 -60 . 00 -28 .45 ft

3

» -35 . 71 -7 . 48 -35.71 -60 . 00 -32.03 ft

4

» -12 . 73 -3 . 91 -12.73 -60 . 00 -9 .05 ft

ATTENUATION AT A FREQUENCY OF 5.000E+06 HZ

* ROOMS

«**«**«

*

«t

«

1

-32 . 42

-6 . 96 -35.71

-12.73

DIRECTIONS

-23 .59 -23.31

-7 . 48 -3.91

-32.42

-6 .96 -35.71

-12.73

-60.00

-60.00

-60.00

-60 . 00

-28.73

-28.45

-32.03

-9 .05 ************************************************************************

ATTENUATION AT A FREQUENCY OF l.OOOE+07 HZ

* * DIRECTIONS

» ROOMS * 1 2 3 4 5

» 1 * -32.42 -23.59 -32.42 -60.00 -28.73

* 2 * -6.96 -23.31 -6.96 -60.00 -28.45

* 3

* -35.71 -7.48 -35.71 -60.00 -32.03

* 4

* -12.73 -3.91 -12.73 -60.00 -9.05

********t*5t«K******«*****************t*************t*******lt**«********«

Figure 7.2(b). Computer print-out of calculations of electromagnetic shielding effectiveness for building

shown in figure 7.1.

79
ATTENUATION AT A FREQUENCY OF 2.000E+07 HZ

* *

* ROOMS * DIRECTIONS

**********t***t***t**t1t*t***1l1l1Ht1i1i*1,*t**1l*1tt1l1lt**1l**1l*1(**1l*t*************

t 1ft -32.42 -23 . 59 -32 . 42 -60 . 00 -28.73 ft t 2 ft -6 . 96 -23.31 -6 . 96 -60 . 00 -28 . 45 ft * 3

ft -35.71 -7 . 48 -35.71 -60 . 00 -32.03 ft t 4

ft -12.73 -3.91 -12 . 73 -60 . 00 -9 . 05 ft ****************«r***«*****«***«*****«********lt******lt*****************«*t

ATTENUATION AT A FREQUENCY OF 5.000E+07 HZ A***********!************************************************************

* * DIRECTIONS

* ROOMS » 1 2 3 4 5 D******************************************************************)*****

ft 1ft -32.42 -23 . 59 -32 . 42 -60 . 00 -28.73

ft 2 ft -6 . 96 -23.31 -6 . 96 -60 . 00 -28 . 45

ft 3ft -35.71 -7 . 48 -35.71 -60.00 -32.03

ft 4

ft -12.73 -3.91 -12.73 -60 . 00 -9 . 05

ATTENUATION AT A FREQUENCY OF l.OOOE+08 HZ

*****t***lit**liltli1it*t*littt**1i1it1i***tii*tt**t1(1tt*t*t***t***ttlt***tt*lt**li*t*

* * DIRECTIONS

* ROOMS * I 2 3 4 5 «***A««««*******A«***t***ft****A*«**t1kft**ft*«*****ft*ttAft****«««**«*«ft«***t

ft 1ft 5 . 65 10.41 5 . 65 -60.00 -15.70

ft 2ft 9 . 40 7.51 9 . 40 1 o o O -18.60

ft 3ft 2 . 08 12.18 2 . 08 -60.00 -19.27

ft 4 ft 6 . 84 11.60 6 . 84 -60 . 00 -14.51

**A*«t«*ftAt«***« ««** ««*****t*ft*****«****t*tt***t««ftft«t«******«**«ilrft**

ATTENUATION AT A FREQUENCY OF 2.000E+08 HZ

t*ktt*****ftkt*ftA***ft*A*A*Aft*ftft**A*ftlk*****ftft**A*ft***ft*A******«A**1t****lt*A

* * DIRECTIONS

* ROOMS » 1 2 3 4 5 tt****tt**ttttttt*t*ttttttt*tt*ttttittt**t**t*tt**ttt*t*t*ttt***ii*t***t*t

» 1

ft 5 . 65 10.41 5 .65 -60 .00 -15.70

» to ft 9 . 40 7 . 51 9 . 40 -60 . 00 O 1 eo

* 3

ft 2 . 08 12.18 2 . 08 -60 .00 -19.27

* 4 ft 6 . 84 11.60 6 . 84 -60 . 00 -14.51

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft

ATTENUATION AT A FREQUENCY OF 5 . OOOE-t-08 HZ *****************t**«*«******************«**<t*t*««*««t********«*«*******t

ft ft DIRECTIONS ft

* ROOMS ft 1 2 3 4 5

ft

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft * 1

ft -10.11 21.00 -10.11 -60.00 -26.14 ft

» 2

ft -5.49 21.78 -5 . 49 -60 . 00 -26 .92 ft

* 3

ft -14.39 -7 . 39 -14.39 -60 .00 -30.42 ft

* 4

ft 8 .51 -2 . 37 8.51 -60 . 00 -7.51 ft ftktkAt*******************************************************************

Figure 7.2(c). Computer print-out of calculations of electromagnetic shielding effectiveness for building

shown in figure 7.1.

80
ATTENUATION AT A FREQUENCY OF l.OOOE+09 HZ

t DIRECTIONS

ROOMS • 1 2 3 4 5

*

1 • -10 11 -21.00 -10.11 -60.00 -26.14 *

2

» -5 . 49 -21.78 -5 . 49 -60 . 00 -26.92 *

3

» -14.39 -7.39 -14.39 -60 . 00 -30.42 *

4

• 8.51 -2 . 37 8.51 -60.00 -7.51 *

ATTENUATION AT A FREQUENCY OF 2.000E+09 HZ **«*»****«*«*««*«****««*t*************t**********«**«*«**t************k*

• • DIRECTIONS

• ROOMS * 1 2 3 4 5 tkktkkkkkkkkkktkkkkkkkkktkkkkkkkkk**************************************

t 1 t -10.11 -21.00 -10.11 -60 . 00 to

• 2t -5 . 49 -21.78 -5 . 49 -60 . 00 -26 .92

t 3ft -14.39 -7 . 39 -14.39 -60 . 00 -30.42

t 4

ft 8.51 -2 . 37 8 . 51 -60 . 00 -7.51

**t«*«t**kktkt*«t*k*****«*t**tt***k*k*«*kk**k***tk*k**k***k*k*kk**k*kkk**

ATTENUATION AT A FREQUENCY OF 5.000E+09 HZ *«******t**««*«««**********t*****k******t****************«k***«****t*«**t

* » DIRECTIONS *

• ROOMS » 1 2 3 4 5

» ««*«*****«***********t*********«*********«********«t******«***«***k**«*«*

-32 . 42 -6 . 96 -35.71

-12.73

-23 . 59 -23.31

-7 . 48 -3.91

-32 . 42 -6 . 96 -35.71

-12.73

-60 .00 -60 . 00 -60.00

-60 . 00

-28.73

-28 . 45 -32.03

-9 .05 «**kk«*t*********k******lt*kkkkk**k**k*k*kk*kkltk***««*k*«***k*k«**kk*kk**k

ATTENUATION AT A FREQUENCY OF l.OOOE+10 HZ ktktkktkkkkkkkkkkkkttkkkkkkkkkkkkkkkkkkkkkt*****************************

* «

» ROOMS » DIRECTIONS

2 3 4 5 k***********************************************************************

ft 1ft -32 . 42 -23 . 59 -32 . 42 -60 .00 -28.73

ft 2ft -6 . 96 -23.31 -6 .96 -60 . 00 -28 . 45

ft 3ft -35.71 -7 . 48 -35.71 -60 .00 -32.03

ft 4 ft -12.73 -3.91 -12.73 -60 . 00 -9 . 05 kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk

Figure 7.2(d). Computer print-out of calculations of electromagnetic shielding effectiveness for building

shown in figure 7.1.

81
ATTENUATION,

dB

ATTENUATION,

dB

.001 .01 .1 1 10 100

FREQUENCY, GHz

FIGURE 7.3 TRANSMITTER LOCATION 1, VERTICAL POLARIZATION DATA

Ui ^

I .001 .01 .1 1 10 100

FREQUENCY, GHz

FIGURE 7.4 TRANSMITTER LOCATION 2, VERTICAL POLARIZATION DATA

82
.001 .01 .1 1 10

FREQUENCY, GHz

FIGURE 7.5 TRANSMITTER LOCATION 1, HORIZONTAL POLARIZATION DATA

83
FREQUENCY, GHz

FIGURE 7.7 TEST STRUCTURE ROOM AND DOOR RESONANCES

84
8. REFERENCES

jl) Cox, D. C.; Murray, R. R.; Norris, A. W. Measurements of 800 MHz radio transmission into buildings

with metallic walls. To be published in Bell System Technical Journal.

(2) Rice, L. P. Radio transmission into buildings on 35 and 150 MHz. Bell System Technical Journal 38: 197-210; 1959 January.

(3| Smith, A. A., Jr. Attenuation of electric and magnetic fields by buildings. IEEE Trans. Electromag. Compat. EMC-20(3): 411-418; 1978 August.

(4] Brennan, C. M. ; Lambert, C. C.; Conner, C. G. ; Roberts, G. F.; Flannery, W. T. EM shielding of

building materials. Electro-Mechanics Co., Austin, Texas. Rome Air Development Center final report

RADC-TR-67-446; 1968 February. 183 p. (AD-667-546).

(5| Garrett, K. S.; Flannery, W. T.; Osburn, J. D. ; Brennan, C. M. ; Flory, R. K. A study of the shielding effectiveness of building materials. Electro-Mechanics Co., Austin, Texas. Rome Air Development Center final report RADC-TR-66-178; 1966 May. 382 p. (AD-485-027/7ST)

.

[6] Johnk, Carl T.A. Engineering electromagnetic fields and waves. New York: John Wiley and Sons;

1975. 655 p.

[7] Denny, H. W. ; Holland, L. D.; Robinette, S. L. ; Woody, J. A. Grounding, bonding, and shielding

practices and procedures for electronic equipments and facilities. Vol. I: Fundamental considerations. Engineering Experiment Station, Georgia Institute of Technology. Federal Aviation Administration final report FAA-RD-75-215 ; 1975 December. 399 p. (AD-A022-332)

.

[8] Campi, M. Survey and review of building shielding to electromagnetic waves from EMP. Harry Diamond

Laboratories, Adelphi, Md. Final report HDL-TM-78-23; 1978 November. 109 p. (AD-B034-726L)

.

[9] Jakubec, L. G. ; Ohta, H. H. Proposed specifications for electromagnetic shielding of enclosures and

buildings. Genistron, Incorporated, Los Angeles, CA. Phase I final report to U.S. Naval Civil

Engineering Laboratory on contract NBy-32220; 1963 July. (AD-417-699).

[10] Jarva, W. Shielding efficiency calculation methods for screening, waveguide ventilation panels, and

other perforated electromagnetic shields. Proc. of the Seventh Conf. on Radio Interference Reduction and Electronic Compatibility. 1961 November; Armour Research Foundation of 111. Inst, of Technology, and Professional Group on Radio Frequency Interference of the Inst, of Radio Engineers.

[11] MacFarlane, G. G. Surface impedance of an infinite parallel-wire grid at oblique angles of incidence. Proc. lEE 93(IIIA): 1523-1527; 1946.

[12] Hill, D. A.; Wait, J. R. Scattering of a transient plane wave by a periodic grating. Radio Sci.

1_1(6): 1003-1009; 1971 November.

[13] Hill, D. A.; Wait, J. R. Electromagnetic scattering of an arbitrary plane wave by two nonintersecting perpendicular wire grids. Can. J. Phys. 52(3): 227-237; 1974.

[14] Hill, D. A.; Wait, J. R. Electromagnetic scattering of an arbitrary plane wave by a wire mesh with

bonded junctions. Can. J. Phys. 54(4) : 353-361; 1976.

[15] Kontorovich, M. I.; Petrun'kin, V. Yu.; Yesephkina, N. A.; Astrakhan, M. I. The coefficient of

reflection of a plane electromagnetic wave from a plane wire mesh. Radio Eng. Elect. Phys. J_: 222-231; 1962.

[16] Astrakhan, M. I. Reflecting and screening properties of plane wire grids. Radio Engineering.

^(1): 76-83; 1968.

[17] James, W. L. Dielectric properties of wood and hardboard: variation with temperature, frequency,

moisture content, and grain orientation. USDA Forest Service, Forest Products Laboratory, Madison,

Wise. USDA Forest Service Research Paper FPL 245; 1975. 32 p. (AD-A015-654)

.

[18] Johnson, M. K. Dielectric constant and loss tangent determination for various dielectric materials

to be used at the Trestle site. Braddock, Dunn, and McDonald, Inc., Albuquerque, New Mexico. Pre- pared for U.S. Air Force Trestle program. Report BDM/A-83-74-TR; 1974 July 4. 88 p. (AD-B008-

055L).

85
APPENDIX 9.1

TEST PLAN

BUILDING ATTENUATION MEASUREMENTS

A.l Purpose

This plan outlines a method for measuring the attenuation of buildings over all or part of the frequency range covered in this report: 10 kHz - 10 GHz. In order to compare measured attenuation data with

computed data (generated by the computer program developed for this report), the building must be square

or rectangular, or made up of adjoining squares or rectangles; and the test signals must be perpendicularly incident on the building walls.

A. 2 Frequency Coverage

Apart from limitations imposed by the availability of portable sources and launching antennas, the

choice of measurement frequencies may be determined by factors such as

• regions of low attenuation in the computed data.

• the frequencies of strong ambient signals.

• frequencies at which a given device is known to have highest susceptibility.

If there are not worrisome frequencies, the project engineer can make the choice of measurement frequencies over the 10 kHz - 10 GHz range.

Table A-1 lists the frequencies at which an NBS team made building attenuation measurements on an

Army installation. Other columns in the table indicate distance increments between locations on the

measurement grid, the type of field to be measured and the type to be launched, and the electric field

polarization. A measurement grid is shown in figure A.l for a single-room building or for a single room

within a building, though the size, shape, and construction of a particular building may permit it to be

characterized by many fewer measurement locations (see section A. 3).

A. 3 Number and location of measurements

A. 3.1 For a free-standing, rectangular building with a single room, a field will be launched perpendicular to all four faces of the building in turn. Where many rooms exist, only some of which are of interest, or the general building geometry dictates, some of the four faces may not be used.

A. 3.2 The exact pattern of measurement location is determined by the frequency and is adaptive. (Ref.

figure A.l).

86
Table A.l. Tabulation of the frequencies and signal properties

for a set of electromagnetic field attenuation measurements.

Frequency A, Meters^, ^ Type of Measurement Field Launched Polarization^

180 kHz 8 E & H Primarily H Ve

3.5 MHz 8 E & H E X H

7 MHz 4 E E X H

14 MHz 4 E E X H

28 MHz 2 E E X H

54 MHz 2 E E X H

140 MHz 1* E E X H

200 MHz 1* E E X H

400 MHz 1* E E X H

750 MHz 1* E E X H

1000 MHz 1* E E X H Circula

2000 MHz 1* E E X H

4000 MHz 1* E E X H

8000 MHz 1* E E X H

12000 MHz 1* E E X H

18000 MHz 1* E E X H

Kotes

* Actual position will be varied

± 1/4 meter to achieve highest reading. A is spacing of locations for sequence 3 and above.

Circular polarization will be used above 1 GHz if adequate signals

are received inside building.

If signal levels are too low a high gain horizontally polarized launching

antenna will be used.

A. 3. 2.1 First, the incident field is measured 5 meters from the face of the building at three locations

as indicated.

A. 3. 2. 2 Next, a 1 meter by 1 meter grid is established in the area to be measured

inside the front wall is measured every meter to within 2 meters of the side walls

sequence A.

A. 3. 2. 3 The highest reading is noted and a line of points A meters apart (see Table A.l), perpendicular

to the first line is measured, until a total-field measurement is obtained which is equal to or less than

the lowest reading obtained in sequence A. This will be called sequence B. Note, however, if this line

of measurements is within ± 3 meters of the center line of the building, this sequence may be eliminated.

A. 3. 2. 4 A line of points A meters apart is now measured along the center line of the building to the

center of the room. This is called sequence C.

A. 3. 2. 5 If no other faces of the building are to be excited which are perpendicular to the first face,

then a last sequence D across the middle of the room will be taken at spacings of A meters.

A line, two meters

This will be called

87
A. 3. 2. 6 If L/A or W/A £ 5, (where L & W are dimensions of the room being measured) then at least 5 measurement points will be taken in sequences B, C, and D. The nearest full meter value for A will be chosen

which will result in at least 5 measurement points within the room's dimensions.

A. 3. 2. 7 All readings will be taken at a height of 1.5 meters except those at 140 MHz when a second set

will be taken at a height of 1 meter.

A. 3. 2. 8 Data will be recorded for the X, Y, and Z orthogonal components, plus the equivalent vector sum.

A. 3. 3 In buildings with a large door opening, data will also be taken with the door open at the frequency where the vertical dimension of the opening is A/2, and at 7 MHz, 400 MHz, and 4 GHz.

Again, we emphasize that the test plan may be modified for each test site by the engineers in charge

to conform to any constraints imposed by time or the physical layout of the structure. Although the test

plan recommends that measurements be grouped in four locations (fig. A.l), the engineers in charge may

decide that three (or in some cases, two) groups are sufficient to determine the shielding effectiveness

of the buildings.

A. 4 Data Presentation

Attenuation measurements can be summarized in tables and also plotted. The table for each building,

room, and transmitter location can list the frequencies of the test, the mean values of attenuation measured, and uncertainties of the measurement (one standard deviation) shown in parentheses. The mean value

of attenuation is determined^ by averaging all grid point measurements in a particular building or room,

for a particular frequency for each transmitter location:

X = i I X. N 1

where X is the sample mean, N is the number of grid points measured, and x^ represents the individual

attenuations at each measured grid point. The standard deviation is defined as the square root of the

sample variance:

a =

where

s2 = ^I(x.-X)2

and where CT is the standard deviation, s^ is the sample variance, and x^ and X are already defined. The

graphs show the mean attenuation at each measurement frequency, with the one-standard-deviation limits as

error bars.

88
f

SOURCE

•L'

Figure

[-*— w/4 — W/4—0“*^W/4

^OUTSIDE POINTS 5m

20 19 18 17 16 15 14 13 12 11 10

21 29

22 30

^23 31

24 32

QUENCE'B'25 33

26 34

27 35

28 36

37

38

39

40

41

/ w

I^ SEQUENCE *A'

SEQUENCE 'C'

4344 45 46 47 48 49 50 51 52 42 53 54 55 56 57 58 59 60 61

^/SEQUENCE 'D'

TYPICAL MEASUREMENT LOCATIONS

FOR FREQ. > 100 MHz

SCALE: HH = 1 METER

'W'

..1 Typical measurement locations for frequencies greater than 100 MHz

89
Appendix 9.2 Listing of Computer Program SMATDB

90
FTN 3 U552 83/12/24. 09.48.08 PAGE 1 PROGRAM SMATDB 74/175 OPT=0

1 PROGRAM SMATDB SMATDB 1

2 C*» INPUT MATERIAL ATTENUATION AND REFLECTION COEFFICIENT INTO SMATDB 2

3 C*« ARRAYS AND THEN STORE DATA IN A PERMANENT FILE* SMATDB 3

4 ** SMATDB 4 3 *****t«**«*»*«*«******«it********«*«********«*********«*««*****«*****«*tt*c OMM 1

4 »»• COMMON FOR DATABASE OF MATERIAL PROPERTIES ***COMM 2

7 «<t*<i****)i «** ***it*ft**********it********iik*****«i*tk******itit*A******it*)t* * COMM 3 8 INTEGER MMAX COMM 4 V PARAMETER (MMAX=100) COMM 5 10 COMMON /MATN/ MATTENIMMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), QR(MMAX), COMM 4 11 $ MFREQ(MMAX, 7) , MERR , MTOT COMM 7 12 COMMON /MATC/MAT(MMAX) ,MATDESC(MMAX) COMM 8 13 INTEGER MTOT, MERR COMM 9 14 REAL MATTEN, MRCOEF, MFREQ, QA , OR COMM 10

15 CHARACTER » 3 MAT COMM 11 18 CHARACTER * 70 MATDESC COMM 12

17 t«*«t«ft*t*ftftt***«********«ft**ft*«**««*ft**«*«**««***«*ftft«t*****««**««t*ftt * * COMM 13 18 ft«*«*««**1tll«**««***********«***«««***ft*ft***«*ft*ft«**ft*«*ft*«*1McA**t**«ftft * * COMM 14

19 INTEGER R,C, COMMAND SMATDB 8 20 CHARACTER * 3 MATID SMATDB 7 21 c» INITIALIZE ARRAYS SMATDB 8 22 DATA MAT / 100 *

'

' / SMATDB 9 23 DATA MATDESC / 100 * ' ' / SMATDB 10 24 DATA MFREQ / 700 * 0.0 / SMATDB 1

1

25 DATA MATTEN / 700 * 0.0 / SMATDB 12 28 DATA QA / 100 * 0.0 / SMATDB 13 27 DATA MRCOEF / 700 * 0.0 / SMATDB 14 28 DATA QR / 100 * 0.0 / SMATDB 15 29 C» ENTER COMMANDS SMATDB 18 30 PRINT * ,

' ( 1

)

CREATE NEW DATABASE (2) ADD TO EXISTING DATA ', SMATDB 17 31 Z 'BASE' SMATDB 18 32 READ *, COMMAND SMATDB 19 33 IF (COMMAND . EQ . 2) THEN SMATDB 20 34 CALL LMATTER SMATDB 21 35 IF (MERR .NE. 0) CALL ERROR! 5) SMATDB 22

38 END IF SMATDB 23

37 10 PRINT*, '(1) NEXT DATA ENTRY (2) CHANGE (3> DISPLAY (4) ABORT' , SMATDB 24 38 S

' (5) QUIT' SMATDB 25

39 READ *, COMMAND SMATDB 28 40 PRINT * SMATDB 27

41 IF (COMMAND .EQ. 1> THEN SMATDB 28 42 CALL NEXT SMATDB 29 43 ELSE IF (COMMAND .EQ. 2 ) THEN SMATDB 30 44 CALL CHANGE SMATDB 31 45 ELSE IF (COMMAND .EQ. 3 ) THEN SMATDB 32 48 CALL DISPLAY SMATDB 33

47 ELSE IF (COMMAND . EQ . 4 ) THEN SMATDB 34 48 PRINT* SMATDB 35

49 PRINT* , 'PROGRAM ABORTED AT YOUR REQEST' SMATDB 38 SO PRINT* SMATDB 37

51 STOP SMATDB 38 52 ELSE IF (COMMAND .EQ. 5 > THEN SMATDB 39 S3 CALL QUIT SMATDB 40 54 STOP SMATDB 41 55 END IF SMATDB 42 58 GOTO 10 SMATDB 43 57 END SMATDB 44

91
FTN 5.1+552 83/12/24, 09.40.06 PAGE 2 PROGRAM SMATDB 74/175 OPT=0

-VARIABLE MAP--(LO=A)

NAME--- ADDRESS- -BLOCK--- --PROPERTIES TYPE- ---SIZE

C NONE UNUSED/»S* INTEGER

COMMAND 157B INTEGER MAT OB /MATC/ CHAR*

3

100 MATDESC 36B /MATC/ CHAR*70 100 MAT ID NONE UNUSED/»S» CHAR*

3

MATTEN OB /MATN/ REAL 700 MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700

MRCOEF 1 274B /MATN/ REAL 700

MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 100 OR 2734B /MATN/ REAL 100

R NONE UNUSED/»S* INTEGER

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE- VALUE

MMAX INTEGER 100

-PROCEDURES--(LO=A)

-NAME TYPE ARGS --CLASS -NAME --TYPE ARGS--- ---CLASS

CHANGE 0 SUBROUTINE LMATTER 0 SUBROUTINE

DISPLAY 0 SUBROUTINE NEXT 0 SUBROUTINE

ERROR 1 SUBROUTINE QUIT 0 SUBROUTINE

-STATEMENT LABELS-- (LO=A)

-LABEL-ADDRESS PROPERTIES-- --DEF

10 24B 37

-ENTRY POINTS--(LO=A)

-NAME ADDRESS--ARGS

SMATDB 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 160B = 112 CM LABELLED COMMON LENGTH 5730B = 3032

CM STORAGE USED 61000B = 25088

COMPILE TIME 0.081 SECONDS

92
1 5 U 552 83 / 1 2 / 24 . 09 .48.06 PACE 3 IROUTI NE NE XT 74/175 OPT=0

1 SMATDB 45

2 SUBROUTINE NEXT SMATDB 46

3

* t * t « * 1 1 * 1 1 * 1 1 * * * t * t * * * 1 1 1 1 1 * * * t * t * * t * * * t It * 1 1 * * * * 1 1 1 * 1 1 * 1 1 1 1 1 * * * * t * 1 1 * * * conn 1

4

* « « COMMON FOR DATABASE OF MATERIAL PROPERTIES *»*COMM 2 5

* « * II « ****************************************************************** *C0MM 3

i INTEGER MMAX COMM 4

7 PARAMETER (MMAX=100) COMM 5 8 COMMON /MATN/ MATTENIMMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), QRIMMAX), COMM 6 9 $ MFREQ(MMAX,7) , MERR, MTOT COMM 7 10 COMMON /MATC/MAT(MMAX) .MATDESC (MMAX

)

COMM 8 11 INTEGER MTOT, MERR COMM 9 12 REAL MATTEN, MRCOEF, MFREQ, QA , OR COMM 10

13 CHARACTER * 3 MAT COMM 1

1

14 CHARACTER * 70 MATDESC COMM 12

IS ft « * « It ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft* ft *ft COMM 13 U ft ft ft ft ft ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft* ft ft COMM 14

17 INTEGER R,C, VAL, INDEX SMATDB 48 18 CHARACTER * 3 MATID SMATDB 49

19 LOGICAL ENTERED SMATDB 50 20 10 PRINT *, ‘MATERIAL I.D.? (EG. ‘‘MOS'- OR ‘'M12'')' SMATDB 51

21 READ *, MATID SMATDB 52 22 IF (MATID(1:1) .NE. 'M' ) THEN SMATDB 53

23 PRINT *, ‘FIRST CHARACTER MUST BE AN M. TRY AGAIN‘ SMATDB 54 24 GOTO 10 SMATDB 55

2S END IF SMATDB 56 26 C* CHECK IF THIS MATERIAL IS ALREADY ENTERED SMATDB 57

27 ENTERED = .FALSE. SMATDB 58 28 DO 20 R=1,MMAX SMATDB 59

29 IF (MAT(R) .EQ. MATID) THEN SMATDB 60 30 ENTERED = TRUE. SMATDB 61

31 INDEX = R SMATDB 62 32 END IF SMATDB 63

33 20 CONTINUE SMATDB 64 34 C* ENTER NEW DATA IF MATERIAL NOT ALREADY ENTERED SMATDB 65

35 IF (ENTERED) THEN SMATDB 66 36 PRINT *, ‘MATERIAL ‘, MATID, ‘ ALREADY ENTERED‘ SMATDB 67

37 ELSE SMATDB 68

38 INDEX = VAL ( MATID(2:3) ) SMATDB 69

39 PRINT », ‘ INDEX: ‘ , INDEX SMATDB 70 40 MAT (INDEX) = MATID SMATDB 71

41 PRINT *, ‘ENTER ONE LINE DESCRIPTION OF MATERIAL

SMATDB 72 42 READ », MATDESC (INDEX) SMATDB 73

43 PRINT *, ‘ENTER 7 ATTENUATION VALUES FROM LOW TO HIGH FREQ‘ SMATDB 74 44 READ *, (MATTEN(INDEX,C) , C=l,7) SMATDB 75

4S PRINT *. ‘ENTER ATTENUATION QUALITY PERCENT‘ SMATDB 76 46 READ *, QA (INDEX) SMATDB 77

47 PRINT *, ‘ENTER 7 REFLECTION COEFFS FROM LOW TO HIGH FREQ‘ SMATDB 78 48 READ *, (MRCOEF( INDEX, C) , C=l,7) SMATDB 79

49 PRINT *, ‘ENTER REFLECTION COEFICIENT QUALITY PERCENT‘ SMATDB 80 SO READ », QR (INDEX) SMATDB 81 SI PRINT » SMATDB 82 S2 END IF SMATDB 83

S3 RETURN SMATDB 84 54 END SMATDB 85

—VARIABLE MAP--(LO=A)

-NAME---ADDRESS--BLOCK PROPERTIES TYPE SIZE

C 357B INTEGER

ENTERED 362B LOGICAL

INDEX 360B INTEGER

NAT OB /MATC/ CHAR*3 100 MATDESC 36B /MATC/ CHAR»70 100

93
FTN 5.1+552 83/12/24. 09.48.06 PAGE 4 SUBROUTINE NEXT 74/175 OPT=0

MAT ID 361B CHAR»3

MATTEN OB /MATN/ REAL 700 MERR 4374B /NATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700 MRCOEF 1274B /MATN/ REAL 700 MTOT 4375B /MATN/ INTEGER

QA 2S70B /MATN/ REAL 100 OR 2734B /MATN/ REAL 1 00 R 3S6B INTEGER

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

MMAX INTEGER 100

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

VAL INTEGER 1 FUNCTION

-STATEMENT LABELS-- ( LO=A

)

-LABEL- ADDRESS PROPERTIES DEF

10 SB 20 20 INACTIVE DO-TERM 33

-ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS---

NEYT 4B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

3i6B = 246

5730B :: 3032

61000B = 25088

0,117 SECONDS

94
FTN 3 U5S2 83/12/24. 09.48.06 PAGE S SUBROUTINE DISPLAY 74/175 OPT=0

1 SMATDB 86

2 SMATDB 87

3 SUBROUTINE DISPLAY SMATDB 88

4 ttt******************************************************************* * * COMM 1 5

« « « COMMON FOR DATABASE OF MATERIAL PROPERTIES ***COMM 2 6 COMM 3 7 INTEGER HMAY COMM 4

8 PARAMETER (MMAX=100) COMM 5 9 COMMON /MATN/ MATTENI MMAX , 7 ) , MRCOEF <MMAX , 7 ) , QA(MMAX), QR(MMAX), COMM 6 10 $ MFREQ(MMAX,7) , MERR , MTOT COMM 7 11 COMMON /MATC/MAT(MMAX) , HATDESC (MMAX

)

COMM 8 12 INTEGER MTOT, HERR COMM 9 13 REAL HATTEN, MRCOEF, MFREQ, QA , OR COMM 10 14 CHARACTER * 3 MAT COMM 11 15 CHARACTER » 70 HATDESC COMM 12

16 t******!*************************************************************** * COMM 13

17 * COMM 14 18 INTEGER R,C, COMMAND SMATDB 90

19 CHARACTER » 3 MATID SMATDB 91 20 LOGICAL FOUND SMATDB 92

21 PRINT *, '<1) ALL MATERIALS OR (2) ONE MATERIAL- SMATDB 93 22 READ *, COMMAND SMATDB 94 23 PRINT * SMATDB 95 24 IF (COMMAND .EQ. 1) THEN SMATDB 96

25 PRINT » SMATDB 97 26 DO 10 R = l.MMAX SMATDB 98

27 MATID = MAT(R) SMATDB 99

28 IF (MATIDd : 1) .EQ. 'M' ) THEN SMATDB 100

29 PRINT * , MAT(R) SMATDB 101

30 PRINT * , MATDESC (R) SMATDB 102

31 PRINT*, 'FREQUENCY; ' , (MFREQ ( R , C ) , C= 1 , 7

)

SMATDB 103

32 PRINT * , 'ATTENUATION: ' , (MATTEN(R , C ) , C=l,7) SMATDB 104

33 PRINT *, 'ATTENUATION QUALITY PERCENT: ',QA(R) SMATDB 105

34 PRINT * , 'REFLECTION: ' , (MRCOEF (R , C > , C=l,7) SMATDB 106

35 PRINT *, 'REFLECTION COEF QUALITY PERCENT: ',QR(R) SMATDB 107

36 PRINT * SMATDB 108

37 END IF SMATDB 109

38 10 CONTINUE SMATDB 1 10 39 ELSE IF (COMMAND . EQ . 2 ) THEN SMATDB 111

40 PRINT *, 'SPECIFY ID OF MATERIAL TO BE PRINTED (E.Q. M05)' SMATDB 112

41 READ *, MATID SMATDB 113

42 FOUND = .FALSE. SMATDB 114

43 DO 20 R = 1,MMAX SMATDB 115

44 IF (MAT(R) .EQ. MATID) THEN SMATDB 1 16 45 PRINT *, MAT(R) SMATDB 117

46 PRINT *, MATDESC(R) SMATDB 118

47 PRINT*, 'FREQUENCY: ' , (MFREQ( R , C ) , C= 1 , 7

)

SMATDB 119

48 PRINT *, 'ATTENUATION: ' , (MATTEN(R , C ) , C=l,7) SMATDB 120

49 PRINT *, 'ATTENUATION QUALITY PERCENT: ',QA(R) SMATDB 121 SO PRINT *, 'REFLECTION; ', (MRCOEF (R , C ) , C=l,7) SMATDB 122

51 PRINT *, 'REFLECTION QUALITY PERCENT: ',QR(R> SMATDB 123

52 FOUND = .TRUE. SMATDB 124

53 END IF SMATDB 125

54 20 CONTINUE SMATDB 126

55 END IF SMATDB 127

56 IF (.NOT. FOUND) THEN SMATDB 128

57 PRINT *, 'MATERIAL ', MATID, ' NOT FOUND' SMATDB 129

58 END IF SMATDB 1 30 59 PRINT * SMATDB 131 60 RETURN SMATDB 132

61 END SMATDB 133

95
FTN 5.1+552 83/12/24. 09.48.06 PAGE 6 SUBROUTINE DISPLAY 74/175 OPT=0

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

c 51 IB INTEGER

COMMAND 512B INTEGER

FOUND 514B LOGICAL MAT OB /MATC/ CHAR*3 100 MATDESC 36B /MATC/ CHAR*70 100 MAT ID 513B CHAR*3

MATTEN OB /MATN/ REAL 700 MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700 MRCOEF 1274B /MATN/ REAL 700

MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 100 QR 2734B /MATN/ REAL 100

R 510B INTEGER

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

MMAX INTEGER 100

-STATEMENT LABELS-- ( LO=A)

-LABEL-ADDRESS PROPERTIES DEP

10 INACTIVE DO-TERM 38 20 INACTIVE DO-TERM 54

-ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS- --

DISPLAY 4B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

S25B = 341 5730B = 3032

61000B = 25088

0.172 SECONDS

96
83 / 1 2 / 24 . 09.48.06 PAGE

74/175 OPT=0

FTN 5 U552 7 FUNCTION VAL

1 SMATDB 134

2 SMATDB 135

3 INTEGER FUNCTION VAL(STRING) SMATDB 136

4 C*» RETURNS THE INTEGER VALUE OF A STRING. SMATDB 137

5 INTEGER NUMBER, X , L , EXP , D I G IT , GETLEN SMATDB 138

6 CHARACTER * (*) STRING SMATDB 139

7 L = GETLEN(STRING) SMATDB 140

8 NUMBER = 0 SMATDB 141

9 DO 10 X = L, 1 ,-l SMATDB 142

10 EXP = L - X SMATDB 143

1

1

DIGIT = ICHAR(STRING(X: X) ) - 16 SMATDB 144

12 NUMBER = NUMBER + D IG IT* 1 0

* * EXP SMATDB 145

13 10 CONTINUE SMATDB 146

1 4 VAL = NUMBER SMATDB 147

15 RETURN SMATDB 148

1 6 END SMATDB 149

VARIABLE MAP--(LO=A)

NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

DIGIT 76B INTEGER

EXP 75B INTEGER

L 74B INTEGER

NUMBER 72B INTEGER

STRING 1 DUMMY -ARG CHAR* ( *) VAL 71B INTEGER

X 73B INTEGER

-PROCEDURES --(LO=A)

-NAME TYPE --ARGS--- ---CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERN 13

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

VAL 6B 1

-STATISTICS--

PROGRAN-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

102B = 66 61000B = 25088

0.041 SECONDS

97
FTN 5.1+552 83/12/24. 09.48.06 PAGE 8 FUNCTION GETLEN 74/175 OPT=0

1 SMATDB 150

2 SMATDB 151

3 INTEGER FUNCTION GETLEN (STRING) SMATDB 152

4 C SMATDB 153

5 C DETERMINE LENGTH OF STRING EXCLUDING ANY BLANK PADDING SMATDB 154

6 C SMATDB 155

7 C SMATDB 156

8 C ARGUMENT DEFINITIONS -- SMATDB 157

9 C INPUT ARGUMENTS SMATDB 158

10 C STRING - STRING WHOSE LENGTH IS TO BE DETERMINED SMATDB 159

11 C SMATDB 160

12 CHARACTER * (*) STRING SMATDB 161

13 C SMATDB 162

14 C FUNCTION PARAMETERS SMATDB 163

15 CHARACTER » 1 BLANK SMATDB 164

16 PARAMETER (BLANK =

‘ ') SMATDB 165

17 C SMATDB 166

18 C LOCAL VARIABLES SMATDB 167

19 INTEGER NEXT SMATDB 168

20 C SMATDB 169

21 C START WITH THE LAST CHARACTER AND FIND THE FIRST NON-BLANK SMATDB 170

22 DO 10 NEXT = LEN(STRING) , 1 ,-l SMATDB 171

23 IF (STRING(NEXT ; NEXT) .NE. BLANK) THEN SMATDB 172

24 GETLEN = NEXT SMATDB 173

25 RETURN SMATDB 174

26 END IF SMATDB 1 75 27 10 CONTINUE SMATDB 176

28 C SMATDB 177

29 C ALL CHARACTERS ARE BLANKS SMATDB 178

30 GETLEN = 0 SMATDB 179

31 C SMATDB 180

32 RETURN SMATDB 181

33 END SMATDB 182

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

GETLEN 63B INTEGER

NEXT 64B INTEGER

STRING 1 DUMMY-ARG CHAR*(*)

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

BLANK CHAR*1 ' '

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

LEN INTEGER 1 INTRINSIC

-STATEMENT LABELS--(LO=A)

-LABEL-ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 27

FTN 5.1+552 83/12/24. 09.48.06 PAGE 9 FUNCTION GETLEN 74/175 OPT=0

--ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS

GETLEN 6B 1

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

70B = 56 61000B = 25088

0.038 SECONDS

98
FTN 5 U5 5 2 SUBROUTINE QUIT

63 / 1 2 / 2 4 . 09.48 .06 PACE

74/175 OPT=0

10

1

2

3

4 « * *

5

* » »

(

* « «

7

SMATDB

SMATDB

SUBROUTINE QUIT SMATDB

*«****ii******i«i****«*«***«***«**tr**«**«*****tk*«*«)t********«t»t«******* * * COMM

COMMON FOR DATABASE OF MATERIAL PROPERTIES »**COMM

* COMM

INTEGER MMAX PARAMETER (MMAX=100)

COMM

COMM

183

1 84 185

1

2

3

45

10 i MFREQ(MMAX,7) , MERR, MTOT COMM 7

1

1

COMMON /HATC/ MAT (MMAX) , MATDESC (MMAX

)

COMM 8 12 INTEGER MTOT, MERR COMM 9 13 REAL MATTEN, MRCOEF, MFREQ, QA , QR COMM 10

1 4 CHARACTER * 3 MAT COMM 11 15 CHARACTER * 70 MATDESC COMM 12 U *t*t*«t**t*«t**t*ft*Aik**«*ft****ft*«**«**ft««*««*««*««*««*ft***jkft**t««**ft**«*c OMM 13

17 t******«**«***1tA«««*««*««*«***«*«*«A$t*ft«1l[*ft*K**ftt*****ft*««««*««ft***llt** * * COMM 14 18 INTEGER R,C SMATDB 1 87

19 CHARACTER * 3 MATID SMATDB 188

20 LOGICAL FOUND SMATDB 189

21 OPEN (UNIT =6,FILE=‘MATTER’ ,FORM=*FORMATTED'

,

SMATDB 190

22 Z ACCESS= SEQUENTIAL , STATUS= 'NEW

)

SMATDB 191

23 REWIND (6) SMATDB 192

24 DO 10 R=1 ,MMAX SMATDB 193

25 MATID = MAT(R) SMATDB 194

26 IF (MATID(1:1> . EQ . 'M' ) THEN SMATDB 1 95 27 WRITE (6,100) MAT(R) SMATDB 196

26 WRITE (6,200) MATDESC (R) SMATDB 1 97

29 WRITE (6,400) lE+4, lE+5 ,lE+6, lE+7, lE+8, lE+9, lE+10 SMATDB 198

30 WRITE (6,400) (MATTEN(R,C) ,C=1 ,7) SMATDB 1 99

31 WRITE (6,400) QA(R) SMATDB 200

32 WRITE ( 6,400 ) (MRCOEF(R,C) ,C=1 ,7) SMATDB 201

33 WRITE (6,400) QR(R) SMATDB 202

34 END IF SMATDB 203

35 10 CONTINUE SMATDB 204

36 ENDFILE (6) SMATDB 205

37 CALL PF ( 'REPLACE* ,0, 'MATTER'

)

SMATDB 206

38 CLOSE (6, STATUS = 'DELETE') SMATDB 207

39 100 FORMAT (A3) SMATDB 208

40 200 FORMAT (A70) SMATDB 209

41 400 FORMAT (7(1X, E9.3)) SMATDB 210

42 RETURN SMATDB 2 1

1

43 END SMATDB 212

VARIABLE MAP-- o it NAME---ADDRESS --BLOCK --PROPERTIES TYPE ---SIZE

C 270B INTEGER

FOUND NONE UNUSED/*S* LOGICAL

MAT OB /MATC/ CHAR»3 100 MATDESC 36B /MATC/ CHAR*70 100 MATID 271B CHAR*3

MATTEN OB /MATN/ REAL 700 MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700

MRCOEF 1 274B /MATN/ REAL 700 MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 1 00 QR 2734B /MATN/ REAL 100

R 267B INTEGER

99
FTN 5 . 1 + 552

SUBROUTINE QUIT

83/ 12/24 . 09.48.06 FACE 74/175 OPT=0

11

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE -VALUE

MMAX INTEGER 100

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

PF 3 SUBROUTINE

-STATEMENT LABELS-- ( LO=A) -LABEL- ADDRESS--- --PROPERTIES -DEF

10 INACTIVE DO-TERM 35 100 164B FORMAT 39 200 166B FORMAT 40 400 170B FORMAT 41

-ENTRY POINTS--(LO=A)

-NAME-- -ADDRESS-- ARCS---

QUIT 5B 0

-I/O UN1TS--(L0=A>

-NAME PROPERTIESTAPE6 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 277B = 191 CM LABELLED COMMON LENGTH 5730B = 3032

CM STORAGE USED 61000B = 25088

COMPILE TIME 0.101 SECONDS

100
FTN 5 I *552

SUBROUTINE CHANCE

83/12/24 09.48.08 PAGE

74/175 OPT=0

12

1 SMATDB 2 13

2 SMATDB 2 14

3 SMATDB 215

4 SMATDB 2 18

5 SUBROUTINE CHANGE SMATDB 217

6 t*«(«**««*t«*«(***t««**t**********it*t*«*****«*««*t«**« «** t*****« COMH 1

7 ttn COMMON POR DATABASE OF MATERIAL PROPERTIES ** *COMM 2

8 * COMM 3

9 INTEGER MMAX COMM 4 10 PARAMETER (MMAX=100) COMM 5

1

1

COMMON /MATN/ MATTENI MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), QRIMMAI), COMM 8 12 $ MFREQIMMAX ,7) , MERR, MTOT COMM 7 13 COMMON /MATC/MATIMMAX) .MATDESC (MMAX

)

COMM 8 14 INTEGER MTOT, MERR COMM 9 IS REAL MATTEN, MRCOEF, MFREQ, QA , QR COMM 10 U CHARACTER * 3 MAT COMM 11 17 CHARACTER * 70 MATDESC COMM 12

18 tttKt<ittttt*t*t**tttftftt**«ttt*t****tt**t«*t**ttAA*ft***tt**t«*tt*t**tttt * COMM 13

19 ***«««t«««*tlk«*«**ftt*«**«ft«*«*«**A««***«««*ft«t«*«*«*1t*«ft*ik***«*ik*«1t*«* « *COMM 14 20 INTEGER R,C, COMMAND, VAL, INDEX SMATDB 2 19

21 CHARACTER * 3 MATID SMATDB 220

22 LOGICAL FOUND SMATDB 221

23 PRINT *, 'ENTER MATERIAL I.D. OF GROUP TO BE CHANGED' SMATDB 222

24 READ », MATID SMATDB 223

25 FOUND = .FALSE. SMATDB 224

28 DO 20 R = 1 ,MMAX SMATDB 225

27 IF (MAT(R) .EQ. MATID) THEN SMATDB 228

28 PRINT * SMATDB 227

29 PRINT *, 'LINE 1: MATERIAL ID ' SMATDB 228

30 PRINT *, NAT (R) SMATDB 229

31 PRINT *, 'LINE 2; DESCRIPTION' SMATDB 230

32 PRINT *, MATDESC (R) SMATDB 231

33 PRINT *, 'LINE 3: FREQUENCIES' SMATDB 232

34 PRINT », (MFREQ (R,C), C=l,7> SMATDB 233

35 PRINT *, 'LINE 4: ATTENUATIONS' SMATDB 234

38 PRINT », (MATTEN (R,C), C=l,7) SMATDB 235

37 PRINT *, 'LINE 5: ATTENUATION QUALITY PERCENT' SMATDB 238

38 PRINT *, QA (R) SMATDB 237

39 PRINT *, 'LINE 8: REFLECTION COEFFICIENTS' SMATDB 238

40 PRINT *, (MRCOEF (R,C), C=l,7> SMATDB 239

41 PRINT *, 'LINE 7: REFLECTION QUALITY PERCENT' SMATDB 240

42 PRINT *, QR (R) SMATDB 241

43 FOUND = .TRUE. SMATDB 242

44 INDEX = R SMATDB 243

45 END IF SMATDB 244

48 20 CONTINUE SMATDB 245

47 IF (.NOT. FOUND) THEN SMATDB 248

48 PRINT *, 'MATERIAL ', MATID, ' NOT FOUND' SMATDB 247

49 RETURN SMATDB 248

50 END IF SMATDB 249

51 30 PRINT * SMATDB 250

52 PRINT *, 'ENTER NUMBER OF LINE TO BE CHANGED', SMATDB 251

53 Z ' (99 TO END CHANGES)' SMATDB 252

54 READ *, COMMAND SMATDB 253

55 IF (COMMAND . EQ . 1) THEN SMATDB 254

58 PRINT » , ' ENTER NEW I.D.' SMATDB 255

57 MAT (INDEX) =

' SMATDB 258

58 READ », MATID SMATDB 257

59 R = VAL ( MATID(2 : 3) ) SMATDB 258

80 MAT (R) = MATID SMATDB 259

81 MATDESC (R) = MATDESC (INDEX) SMATDB 280

82 MFREQ (R,l) = MFREQ ( INDEX, 1) SMATDB 281

83 MFREQ (R,2) = MFREQ (INDEX, 2) SMATDB 282

84 MFREQ (R,3) = MFREQ (INDEX, 3) SMATDB 283

101
FTN 5.1+552 83/12/24. 09.48.06 PAGE 13 SUBROUTINE CHANGE 74/175 OPT=0

65 MFREQ (R,4) = MFREQ (INDEX, 4) SMATDB 264

66 MFREQ (R,5) = MFREQ (INDEX, 5) SMATDB 265

67 MFREQ <R,6) = MFREQ (INDEX, 6) SMATDB 266

68 MFREQ <R,7) = MFREQ (INDEX, 7) SMATDB 267

69 MATTEN (R,l) = MATTEN (INDEX, 1) SMATDB 268

70 MATTEN (R,2) = MATTEN (INDEX, 2) SMATDB 269

71 MATTEN (R,3) = MATTEN (INDEX, 3) SMATDB 270

72 MATTEN (R,4) = MATTEN (INDEX, 4) SMATDB 271

73 MATTEN (R,5) = MATTEN (INDEX, 5) SMATDB 272

74 MATTEN (R,6) = MATTEN (INDEX, 6) SMATDB 273

75 MATTEN (R,7) = MATTEN (INDEX, 7) SMATDB 274

76 QA (R) = QA ( INDEX) SMATDB 275

77 MRCOEF (R,l) = MRCOEF (INDEX, 1) SMATDB 276

78 MRCOEF (R,2) = MRCOEF (INDEX, 2) SMATDB 277

79 MRCOEF (R,3) 3 MRCOEF (INDEX, 3) SMATDB 278

80 MRCOEF <R,4) = MRCOEF (INDEX, 4) SMATDB 279

81 MRCOEF (R,5) = MRCOEF (INDEX, 5) SMATDB 280

82 MRCOEF (R,6) = MRCOEF (INDEX, 6) SMATDB 281

83 MRCOEF (R,7) = MRCOEF (INDEX, 7) SMATDB 282

84 QR <R) = QR ( INDEX) SMATDB 283

85 INDEX = R SMATDB 284

86 ELSE IF ( COMMAND .EQ. 2 ) THEN SMATDB 285

87 PRINT *, ‘ENTER NEW ONE LINE DESCRIPTION OF MATERIAL' SMATDB 286

88 READ *, MATDESC (INDEX) SMATDB 287

89 ELSE IF ( COMMAND .EQ. 3 ) THEN SMATDB 288

90 PRINT *, ‘ENTER NEW SET OF 7 FREQUENCIES' SMATDB 289

91 READ *, (MFREQ (INDEX, C), Csl,7) SMATDB 290

92 ELSE IF ( COMMAND .EQ. 4 ) THEN SMATDB 291

93 PRINT », ‘ENTER NEW SET OF 7 ATTENUATIONS' SMATDB 292

94 READ *, (MATTEN ( INDEX, C), C»l,7) SMATDB 293

95 ELSE IF ( COMMAND .EQ. 5 > THEN SMATDB 294

96 PRINT *, ‘ENTER NEW ATTENUATION QUALITY PERCENT' SMATDB 295

97 READ *, QA (INDEX) SMATDB 296

98 ELSE IF ( COMMAND .EQ. 6 ) THEN SMATDB 297

99 PRINT *, ‘ENTER NEW SET OF 7 REFLECTION COEFFICIENTS’ SMATDB 298

100 READ *, (MRCOEF (INDEX, C), C=1 ,7) SMATDB 299

101 ELSE IF ( COMMAND EQ. 7 ) THEN SMATDB 300 102 PRINT *, ‘ENTER NEW REFLECTION QUALITY PERCENT' SMATDB 301 103 READ *, QR (INDEX) SMATDB 302 104 ELSE IF ( COMMAND EQ. 99 ) THEN SMATDB 303

105 GOTO 40 SMATDB 304

106 END IF SMATDB 305

107 GOTO 30 SMATDB 306

108 C SMATDB 307

109 40 PRINT * SMATDB 308 no PRINT *, MAT (INDEX) SMATDB 309

111 PRINT *, MATDESC (INDEX) SMATDB 310

112 PRINT », (MFREQ (INDEX, C), C»1 ,7) SMATDB 311 113 PRINT *, (MATTEN ( INDEX, C) , C=l,7) SMATDB 312

114 PRINT *, QA (INDEX) SMATDB 313

115 PRINT », (MRCOEF (INDEX, C) , C»l,7) SMATDB 314 116 PRINT *, QR (INDEX) SMATDB 315

117 PRINT • SMATDB 316 118 RETURN SMATDB 317

119 END SMATDB 318

102
14 FTN 5.1+552 83/12/24. 09.48.04 PAGE

SUBROUTINE CHANCE 74/175 OPT=0

--VARIABLE MAP--(LO=A)

NAME--- ADDRESS- -BLOCK--- --PROPERTIES TYPE --SIZE

C 1 137B INTEGER

COMMAND 1 HOB INTEGER

FOUND 1 143B LOGICAL

INDEX 1141B INTEGER

MAT OB /MATC/ CHAR*

3

100 MATDESC 34B /MATC/ CHAR*70 100 MAT ID 1142B CHAR*

3

MATTEN OB /MATN/ REAL 700 MERR 437 4B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700

MRCOEF 1 27 4B /MATN/ REAL 700

MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 100 OR 2734B /MATN/ REAL 100

R 1 134B INTEGER

--SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE--- VALUE

MMAX INTEGER 100

--PROCEDURES--(LO=A)

-NAME-- TYPE ARCS -CLASS

VAL INTEGER 1 FUNCTION

-STATEMENT LABELS- -(LO=A) -LABEL- ADDRESS -PROPERTIES--- -DEF

20 INACTIVE DO-TERM 44

30 20 4B 51 40 477B 109

--ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS---

CHANGE SB 0

--STATISTICS--

PROGRAM-UNIT LENGTH 1140B = 424

CM LABELLED COMMON LENGTH S730B = 3032 CM STORAGE USED 43000B s 24112

COMPILE TIME 0 .318 SECONDS

103
FTN 5.1+552 83/12/24. 0?.48.06 PAGE

SUBROUTINE LMATTER 74/175 OPT=0

15

1 SUBROUTINE LMATTER LMATTER 1 2 t 1 1 1 !

1 M !1 1 1 1 1 1 M 1 1 1

1 1 1 1 1 1 1 1 M M 1 M M 1 1 1 1 1 1 1 1 1 M M 1 1 1 1 M 1 1 1 1 1 1 1 1 1 1 I 1 1 1 M LMATTER 2

3 * 1 I!

! ! '.LMATTER 3

4 t !

1

! THIS SUBROUTINE LOADS THE MATERIAL DATABASE INTO ARRAYS FOR ! !

!

LMATTER 4 5 * ! ! ! FURTHER PROGRAM USE. ! !

'. LMATTER 5 4

t ! ! 1

! !

!

LMATTER 6

7 * 1 1 1 M 1 M M 1 1 1 1 1 t 1 II 1 1 1 1 II t 1 1 1

1 M M M 1 M 1 1 1 II 1 1 M 1 1 i 1 1 M 1 1 1 1 II 1 1 1

1 1 1 1 1 M LMATTER 7 8 ** Hr ** «r ************** *************************** k  A **  It * *************** LMATTER 8 9 ***********************************«********************************«***(;;qK)i{ 1 10 *** COMMON FOR DATABASE OF MATERIAL PROPERTIES ***COMM 2 11 *********************************************************************** * COMM 3 12 INTEGER MMAX COMM 4 13 PARAMETER (MMAX=100) COMM 5 14 COMMON /NATN/ MATTENIMMAX ,

7

) , MRCOEF (MMAX ,

7

) , QA(MMAX), QR(NMAX), COMM 6 15 $ MFREQ(MMAX,7) , MERR, MTOT COMM 7 U COMMON /MATC/ MAT (MMAX) .MATDESC (MMAX ) COMM 8 17 INTEGER MTOT, MERR COMM 9 18 REAL MATTEN, MRCOEF, MFREQ, QA , OR COMM 10 19 CHARACTER * 3 MAT COMM 11 20 CHARACTER * 70 MATDESC COMM 12 21 A********************************************************************* * * COMM 13 22 ************************************************************************COMM 14 23 ************************************************** LMATTER 10 24 * DECLARATION OF VARIABLES LMATTER 11 25 «*«ft*****««ftft*«*ft****At**lk***A«**«*«ftft******««*«t« LMATTER 12 26 INTEGER R, C, VAL LMATTER 13 27 CHARACTER * 3 MATID LMATTER 14 28 LMATTER 15 29 A GET FILE LMATTER 16 30 ************************************************** LMATTER 17 31 MERR = 0 LMATTER 18 32 CALL PF ( 'GET' ,0, 'MATTER' , 'RC , MERR) LMATTER 19 33 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LMATTER 20

34 A FILE ERROR CHECK LMATTER 21 35 A*AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LMATTER 22 36 IF ( MERR .EQ. 0 ) THEN LMATTER 23

37 999 CONTINUE LMATTER 24 38 ELSE IF ( MERR .EQ. 2 > THEN LMATTER 25 39 CALL WARNING (3) LMATTER 26 40 RETURN LMATTER 27

41 ELSE LMATTER 28

42 CALL WARNING (4) LMATTER 29

43 RETURN LMATTER 30 44 END IF LMATTER 31 45 A*AA*AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LMATTER 32 46 A OPEN FILE LMATTER 33 47 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LMATTER 34 48 OPEN (UNIT = 3, F ILE=' MATTER ' ,FORM=' FORMATTED ' , LMATTER 35 49 5 STATUS = 'OLD', ACCESS = 'SEQUENTIAL') LMATTER 36 SO REWIND (3) LMATTER 37

51 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LMATTER 38

52 A INITIALIZE ARRAYS LMATTER 39 S3 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LMATTER 40 54 DATA NAT / 100 *

'

' / LMATTER 41 55 DATA MATDESC / 100 *

'

' / LMATTER 42 56 DATA MFREQ / 700 » 0.0 / LMATTER 43 57 DATA MATTEN / 700 * 0.0 / LMATTER 44 58 DATA QA / 100 * 0.0 / LMATTER 45 59 DATA MRCOEF / 700 » 0 . 0 / LMATTER 46 60 DATA OR / 100 * 0.0 / LMATTER 47

61 ************************************************** LMATTER 48

62 A READ IN THE MATERIAL FILE LMATTER 49

63 ************************************************** LMATTER 50 64 10 READ (3, 1000,END=20) MATID LMATTER 51

104
rXN 5 W552 83/12/24. 09 48.06 PAGE 16 SUBROUTINE LMATTER 74/175 OPT=0

65 R = VAL(MATID( 2 : 3)

)

LMATTER 52 66 MAT (R) = MAT ID LMATTER 53

67 READ (3,2000,END=20) MATDESC (R) LMATTER 54

68 READ (3,4000,END=20) (MFREQ(R,C) ,C=1 ,7) LMATTER 55

69 READ ( 3 , 4000 , END=20

)

(MATTEN(R,C) ,C=1, 7) LMATTER 56 70 READ (3 , 4000 ,END=20) QA (R) LMATTER 57

71 READ (3,4000,END=20) (MRCOEF(R,C) ,C=1,7) LMATTER 58 72 READ (3,400Q,END=20) OR (R) LMATTER 59

73 GOTO 10 LMATTER 60 74 20 CONTINUE LMATTER 61 75 1000 FORMAT (A3) LMATTER 62

76 2000 FORMAT (A70) LMATTER 63

77 40 00 FORMAT (7(1X,E9.3)) LMATTER 64

78 ttttttttttttttttttttttt LMATTER 65 79 • CLOSE FILE LMATTER 66

80 LMATTER 67

81 CLOSE (3, STATUS = 'DELETE') LMATTER 68

82 RETURN LMATTER 69

83 END LMATTER 70

:able map --(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

C 32 76 INTEGER

MAT OB /MATC/ CHAR*3 100 MATDESC 36B /MATC/ CHAR»70 1 00 MAT ID 330B CHAR*3

MATTEN OB /MATN/ REAL 700 MERR 4 3 7 4B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700

MRCOEF 1 27 4B /MATN/ REAL 700

MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 100 QR 2734B /MATN/ REAL 1 00 R 326B INTEGER

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

MMAX INTEGER lOQ

-PROCEDURES--(LO=A)

-NAME TYPE ---ARCS CLASS

PF 5 SUBROUTINE

VAL INTEGER 1 FUNCTION

WARNING 1 SUBROUTINE

-STATEMENT LABELS-- ( LO=A) -LABEL- ADDRESS PROPERTIES DEF -LABEL-ADDRESS PROPERTIES DEF

1 0 3 6B 64 1000 20 2B FORMAT 75 20 160B 74 2000 204B FORMAT 76 999 »NO REFS* 37 40 00 206B FORMAT 77

105
FTN 5.1+55Z 83/12/24. 09.48.06 PAGE 17 SUBROUTINE LMATTER 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS

LMATTER 5B 0

-I/O UNITS--(LO=A)

-NAME PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

336B = 222 S730B = 3032

61000B - 25088

0.127 SECONDS

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

106
fTN 5 U552 83/12/24 09.48 06 PAGE 18 SUBROUTINE WARNING 74/175 OPT=0

1 SUBROUTINE WARNING(ERR) WARNING 1

2 INTEGER ERR, ERRM WARNING 2

3 CHARACTERM5 MESSAGE(20) WARNING 3 4 DATA MESSAGE! l)/'"HOLE" DATA FILE DOES NOT EXIST FOR THIS BLDG • / WARNING 4

5 DATA MESSAGE! 2) /'FILE HANDLING PROBLEM ON "HOLE- DATA FILE ' / WARNING 5 6 DATA MESSAGE! 3) /'"MATTER" FILE DOES NOT EXIST FOR THIS BLDG '/ WARNING 6 7 DATA MESSAGE! 4) /'FILE HANDLING PROBLEM ON "MATTER FILE ' / WARNING 7

8 DATA MESSAGE! 5)/ '"TYPE" DATA FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING 8

9 DATA MESSAGE! 6)/ 'FILE HANDLING PROBLEM ON "TYPE" FILE ' / WARNING 9 10 DATA MESSAGE! 7)/ '"WALL" DATA FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 10

11 DATA MESSAGE! 8) /'FILE HANDLING PROBLEM ON "WALL" FILE ' / WARNING 1

1

12 DATA MESSAGE! 9)/ 'HEIGHT AND WIDTH OF ROOM MISSING ' / WARNING 12

13 DATA MESSAGE! 10) /' LENGTH OF ROOM IS HISSING / WARNING 13

1 4 DATA MESSAGE! 11 )/' FREQ FILE DOES :NOT EXIST FOR THIS BLDG ' / WARNING 14

IS DATA MESSAGE! 12) /' FILE HANDLING PROBLEM WITH FREQ FILE ' / WARNING 15

1 6 DATA MESSAGE! 13) / 'WARNING CODE IS OUT OF RANGE • / WARNING 16 17 DATA MES5AGE!14)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 17

18 DATA MESSAGE! IS )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 18

19 DATA MESSAGE!16)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 19 20 DATA MESSAGE! 17 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 20

21 DATA MESSAGE!18)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 21 22 DATA MESSAGE! 19 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 22

23 DATA MESSAGE!20)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 23 24 ERRM= 12 WARNING 24

2S I ERR = ERR WARNING 25

26 IF(ERR.GT.ERRM) IERR=20 WARNING 26

27 WRITE! 6 , 20) WARNING 27 28 WRITE(6,10) ERR, MESSAGE! lERR) WARNING 28 29 VRITE!6 , 20

)

WARNING 29

30 10 FORMAT!' ***WARNING NUMBER = ',15 ,' ** ',A45) WARNING 30

31 20 FORMAT!' ') WARNING 31 32 RETURN WARNING 32

33 END WARNING 33

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK- -PROPERTIES TYPE SIZE

ERR ERRM

lERR

MESSAGE

1 DUMMY-ARG

60B

213B

61B

INTEGER

INTEGER

INTEGER

CHAR*45 20

-STATEMENT LABELS-- ( LO=A

)

•LABEL- ADDRESS PROPERTIES DEF

10

20 34B42B

FORMAT

FORMAT

-ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS---

VARNING SB

3031 FTN 5 . U552 83 / 12/24 . 09 , 48 . 06 PACE

SUBROUTINE WARNING 74 /175 OPT.>0 — I/O UNITS--!LO = A) -NAME PROPERTIES---

TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH 216 B > 142 CM STORAGE USED 61 000 B . 2501 COMPILE TIME 0 063 SECONDS

19

107
FTN 5 . 1+552

SUBROUTINE ERROR

83/12/24. 09.48.06 PACE

74/175 OPT=0

20

1 SUBROUTINE ERROR! lERR) ERROR 1 2 CHARACTER* 45 MESSAGE!20) ERROR 2

3 DATA MESSAGE! 1 ) / 'MATERIALS DATAL BASE IS EMPTY ' / ERROR 3 4 DATA MESSAGE! 2)1 ' FREQUENCY IS OUT OF :RANGE ' / ERROR 4 5 DATA MESSAGE! 3) / 'THIS MATERIAL IS NOT IN DATA BASE ' / ERROR 5

6 DATA MESSAGE! 4) / 'DENOMINATOR IS1 ZERO ' / ERROR 6 7 DATA MESSAGE! 5) / ' FILE HANDLING ERROR ' / ERROR 7

8 DATA MESSAGE! 6) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 8 9 DATA MESSAGE! 7) /'ERROR CODE IS OUT OF RANGE ' / ERROR 9 10 DATA MESSAGE! 8) / 'ERROR CODE IS OUT OF RANGE * / ERROR 10

11 DATA MESSAGE! 9) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 11 12 DATA MESSAGE! 10) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 12

13 DATA MESSAGE! 11 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 13 14 DATA MESSAGE! 12) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 14 15 DATA MESSAGE! 13)/ 'ERROR CODE IS OUT OF RANGE ' / ERROR 15 16 DATA MESSAGE! 14) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 16

17 DATA MESSAGE! IS) /'ERROR CODE IS OUT OF RANGE ' / ERROR 17 18 DATA MESSAGE! 16) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 18

19 DATA MESSAGE! 17 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 19 20 DATA MESSAGE! 18) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 20

21 DATA MESSAGE! 19 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 21 22 DATA MESSAGE!20) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 22 23 IERRM=5 ERROR 23 24 IFCIERR.GT. lERRM) IERR=20 ERROR 24

25 WRITE(6,10) lERR, MESSAGE! lERR) ERROR 25 26 10 FORMAT!* »**ERROR NUMBER ,15, * tut ' ,A45) ERROR 26 27 CALL PMDSTOP ERROR 27 28 STOP ' ERROR' ERROR 28

29 END ERROR 29

-VARIABLE MAP--(LOrA)

-NAME---ADDRESS--BLOCK PROPERTIES- TYPE SIZE

I ERR 1 DUMMY -ARG INTEGER

lERRM 210B INTEGER

MESSAGE 56B CHAR* 45 20

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

PMDSTOP 0 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

-LABEL-ADDRESS PROPERTIES DEF

10 36B FORMAT 26 FTN 5.1+552 83/12/24. 09.48.06 PAGE 21 SUBROUTINE ERROR 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS--

ERROR SB 1

— I/O UNITS--(LO = A) -NAME PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

213B = 139 61000B = 25088

0.056 SECONDS

108
Appendix 9.3 Listing of Computer Program SHOLES

109
FTN 5.1+552 83/12/24. 09.11.45 PAGE 1 PROGRAM SH0LE5 74/175 OPT=0

1 PROGRAM SHOLES ( INPUT, TAPEUINPUT) SHOLES 1 2

* SHOLES 2 3 *THIS INTERACTIVE PROGRAM INPUTS THE DATA DESCRIBING EACH HOLE SHOLES 3 4 *IN THE BUILDING AND STORES IT. THE FILE NAME IS CREATED BY SHOLES 4 5 "ATTACHING "B" TO THE FRONT OF AND "H" TO THE BACK OF THE BUILDING SHOLES 5

8 ‘IDENTIFICATION. THE BUILDING IDENTIFICATION CAN BE NO MORE SHOLES 8 7 ‘THAN 5 ALPHANUMERIC CHARACTERS. SHOLES 7

8 SHOLES 8 9 10

11

1 2 1314

15U

1718

1920

2122

2324

2528

2728

29

30

3132

33

34

3538

3738

3940

4142

4344

45

48

47

484950

5152

5354

55

585758

5980

8182

8384

*** COMMON FOR INITIAL PARAMETERS

***fkiitiktt*lt*tt«i**** + *itltik*lk**** + «li* + ik***k + lt***«i)ii*t)«****tt*lt****««**it

INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX

5 FTOT

COMMON /INITILC/ BLDG CHARACTER * 5 BLDG

REAL FREQ, AFLAG, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

*t*****1i*****1itii tt1i** t*tt1itt****iitt1tii*t***t**tt**1i*******1i

ltlt*i*A****tt4i1tA<i*4l**i***** + 1tlt1i*iiilt + fi*it***ilr*lt + ** + lt******lttt<i**<i)t**ik* *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF VALLS

tt**t*»**ltt*fk****1t**lit****t1i*1i***1tt**1tt****t*t1t1i1(tt*t*1(**fktit

******** » *COMF

*»»COMF

******  COMF

COMF COMF

), FERR, COMF COMF

COMF COMF

COMF COMF ** ******* *C0MF ******** * *COMF

********«*COMR

***COMR

**********COMR

INTEGER RMAX COMR PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOM(RMAX + 8, RMAX 8), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR REAL ROOM COMR *********************************************************************** * COMR *********************************************************************** *^Ql^J^ *********************************************************************** * COMH

*** COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS ***COMH ************************************************************************ COMH

INTEGER HMAX COMH

PARAMETER (HMAX = 35) COMH

COMMON /HOLEN/ HTOT , HERR COMH

COMMON /HOLEC/ HOLE(HMAX,4) COMH

INTEGER HTOT, HERR COMH

CHARACTER * 3 HOLE COMH

* DESCRIPTION OF ARRAYS COMH

* ROOM IDENTIFICATION APERTURE ID COMH

* COMH

* DIRECTION FROM ROOM TO ROOM COMH

* COMH

* HOLE(X,l) HOLE(X,2) HOLE(X,3) HOLE(X,4) COMH

* A3 A3 A3 A3 COMH *********************************************************************** *COMH ********************************************************************** * * COMH

INTEGER GETLEN, QUIT, ABORT, ANSWER, OLDFILE ,N,Y1 ,Y2 , LINE SHOLES

INTEGER lERR SHOLES

CHARACTER * 7 PFN SHOLES

* SHOLES

* INITIALIZATION SHOLES

QUIT = 0 SHOLES

HTOT = 0 SHOLES

ABORT = 0 SHOLES

100 PRINT* SHOLES

PRINT *, 'ENTER BUILDING IDENTIFICATION (E.G. ''101'')' SHOLES PRINT ‘ (NO MORE THAN 5 ALPHANUMERIC CHARACTERS)' SHOLES

REWIND 1 SHOLES

READ(1,*,END=100) BLDG SHOLES

1

2

3

4

5

8

7

8

9 10

111213

1

2

3

45

87

8

9 10

1

2

3

45

8

7

9 10

1112

13

14

1518

1718

1920

12

13

1415

181718

1920

2122

2324 110
fTN 5 1+552 83/12/24 09.11,45 PAGE 2 PROGRAM SHOLES 74/175 OPT=0

65 SHOLES 25 66 IF ( GETLEN(BLDC) . GT 5 ) THEN SHOLES 2 6 67 GO TO 100 SHOLES 27

68 END IF SHOLES 28

69 PFN = ’B' II BLDG( 1 ;GETLEN(BLDG) ) II 'H' SHOLES 29

70 t SHOLES 30

71 LOAD DATA FROM EXISTING FILE IF NECESSARY SHOLES 31 72 200 PRINT* SHOLES 32

73 PRINT* , 'WILL THIS BE

SHOLES 33 74 PRINT*,' (1) A MODIFICATION OF AN EXISTING FILE?' SHOLES 34

75 PRINT* ,

' ( 2 ) A NEW FILE?

SHOLES 35 76 PRINT* ENTER A NUMBER !!!' SHOLES 36

77 REWIND 1 SHOLES 37 78 READCl ,*,END=200) OLDFILE SHOLES 38

79 IF ( ( OLDFILE .NE. 1 ) AND. ( OLDFILE .NE. 2 ) ) THEN SHOLES 39 80 GOTO 200 SHOLES 40

81 ELSE IF ( OLDFILE .EQ. 1 ) THEN SHOLES 41 82 « SHOLES 4 2 83 CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME SHOLES 43 84 I ERR = 0 SHOLES 44

85 CALL PF ( 'GET' ,0,PFN(1 :GETLEN(PFN) > , 'RC' , lERR) SHOLES 45 86 IF ( lERR EQ. 2 ) THEN SHOLES 46 87 PRINT* SHOLES 47

88 PRINT *, 'FILE ' ,PFN, ' NOT FOUND' SHOLES 48

89 PRINT*, 'PROGRAM ABORTED!! ! SHOLES 49 90 PRINT* SHOLES 50

91 PRINT*, 'FIND CORRECT BUILDING IDENTIFIER AND RESTART ', SHOLES 51 92 + 'PROGRAM' SHOLES 52

93 PRINT* SHOLES 53

94 STOP SHOLES 54

95 It SHOLES 55

96 ELSE SHOLES 56

97 CALL LHOLE SHOLES 57

98 IF (HERR NE. 0) CALL ERROR(5) SHOLES 58

99 END IF SHOLES 59 100 ELSE IF ( OLDFILE EQ. 2 ) THEN SHOLES 60

10 1 * SHOLES 6 1

1 02 lit * ft CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME SHOLES 62 103 lERR = 0 SHOLES 63 104 CALL PF ( 'GET' ,0 , PFN(1 ;GETLEN(PFN1 )

, 'RC '

, lERR) SHOLES 64 105 IF ( lERR .EQ. 0 ) THEN SHOLES 65 106 PRINT* SHOLES 66 107 PRINT*, 'DATA FILE ALREADY EXISTS FOR BUILDING ',BLDG SHOLES 67 108 PRINT* SHOLES 68 109 PRINT*, 'IF YOU ENTER DATA AND STORE IT, YOU WILL WRITE ', SHOLES 69

1 10 + 'OVER THE OLD FILE. ' SHOLES 70 111 250 PRINT* SHOLES 71

1 12 PRINT*, 'YOU MAY EITHER (1) ABORT OR (2) CONTINUE.' SHOLES 72 113 PRINT* ,' INDICATE YOUR CHOICE BY ENTERING A NUMBER.' SHOLES 73

1 14 REWIND 1 SHOLES 74 115 READ( 1

, *,END=250) ANSWER SHOLES 75

1 16 IF ( ANSWER .EQ. 1 ) THEN SHOLES 76 117 PRINT* SHOLES 77

1 18 PRINT* ,' PROGRAM HAS BEEN ABORTED, AT YOUR REQUEST' SHOLES 78 119 PRINT* SHOLES 79 120 STOP SHOLES 80

12 1 ELSE IF ( ANSWER . EQ . 2 > THEN SHOLES 8 1 122 CONTINUE SHOLES 82 TRIVIAL* CONTINUE WITH NO STATEMENT LABEL -- IGNORED

1 23 ELSE SHOLES 83 124 GOTO 250 SHOLES 84 125 END IF SHOLES 85 126 ELSE IF ( lERR . EQ . 2 > THEN SHOLES 86 127 * SHOLES 87

111
83/12/24. 09.11.45 PAGE 74/175 OPT=0

FTN 5.1+552 3 PROGRAM SHOLES

128 UK t NO DATA FILE ALREADY EXISTS FOR THIS BUILDING AND DATA ENTRY SHOLES 88 129 A « * CAN CONTINUE SHOLES 89 130 CONTINUE SHOLES 90 TRIVIAL*

131 CONTINUE WITH NO STATEMENT LABEL -- IGNOREDELSE SHOLES 91 132 * SHOLES 92 133 t ** PERMANENT FILE ERROR SHOLES 93

1 34 PRINT* SHOLES 94 135 PRINT* , ’PROGRAM ABORTED !!!' SHOLES 95

1 38 PRINT*,' SOME PERMANENT FILE ERROR HAS OCCURRED.' SHOLES 98 137 PRINT*,' DOUBLE CHECK YOUR BUILDING IDENTIFICATION SHOLES 97

1 38 + 'AND TRY AGAIN' SHOLES 98 139 STOP SHOLES 99 140 END IF SHOLES 1 00

14 1 A SHOLES 101 142 PRINT* SHOLES 102 143 PRINT*, ' BEGIN ENTERING DATA

SHOLES 103

1 44 300 HTOT = HTOT + 1 SHOLES 104

145 IF ( HTOT .EQ. 1) THEN SHOLES 105 148 CALL DATAIN( 1 ,HTOT) SHOLES 108 147 ELSE SHOLES 107 148 CALL DATA IN <0,HTOT) SHOLES 1 08 149 END IF SHOLES 109 150 400 PRINT* SHOLES 110

151 PRINT*, 'DO YOU WANT TO ENTER MORE DATA?', SHOLES 1 1

1

152 + ' <1) YES (2) NO' SHOLES 1 12 153 PRINT*, ' ENTER A NUMBER !!!' SHOLES 113 154 REWIND 1 SHOLES 114 155 READd , *, END = 400 ) ANSWER SHOLES 115 158 IF ( (ANSWER .NE. 1) .AND. (ANSWER NE. 2) ) THEN SHOLES 118 157 GOTO 400 SHOLES 117 158 ELSE IF ( ANSWER .EQ. 1) THEN SHOLES 118 159 GOTO 300 SHOLES 119 180 ELSE IF ( ANSWER EQ. 2 ) THEN SHOLES 120

18 1 PRINT* SHOLES 121 182 PRINT*, 'DATA ENTRY DISCONTINUED' SHOLES 122 183 END IF SHOLES 123 184 END IF SHOLES 124

185 A SHOLES 125 188 A * « MANIPULATE DATA SHOLES 128 187 CALL MANIP (QUIT, ABORT) SHOLES 127 188 A SHOLES 128

189 AAA TERMINATE PROGRAM, STORING DATA IF NECESSARY SHOLES 129 170 IF ( QUIT .EQ. 1 ) THEN SHOLES 1 30

17 1 OPEN(UNIT=8 , FILE=PFN( 1 :GETLEN(PFN) ) , FORM= ' FORMATTED '

,

SHOLES 131 172 + ACCESS='SEQUENTIAL' , STATUS= ' NEW '

)

SHOLES 132 173 500 FORMAT (1X,4( 1X,A3)) SHOLES 133 174 DO 800 N = 1 ,HTOT SHOLES 134

175 WRITE ( 8 , 500 ) (HOLE(N, Y1 ) , Yl=l,4) SHOLES 135 178 600 CONTINUE SHOLES 1 38 177 ENDFILE(8) SHOLES 137 178 CALL PF ( 'REPLACE' ,0,PFN(1 :GETLEN(PFN) >> SHOLES 1 38 WARNING*

179 NUMBER OF ARGUMENTS IN REFERENCE TO _PF IS NOT CONSISTENT

CLOSE(8,STATUS='DELETE’

>

SHOLES 139 180 PRINT* SHOLES 140 181 PRINT*, 'DATA HAS BEEN STORED AND PROGRAM TERMINATED' SHOLES 141 182 END IF SHOLES 142 183 IF( ABORT EQ. 1 ) THEN SHOLES 1 43 184 PRINT* SHOLES 144 IBS PRINT*, 'PROGRAM HAS BEEN ABORTED' SHOLES 1 45 188 PRINT*,' NO DATA HAS BEEN STORED !!!' SHOLES 148 187 END IF SHOLES 1 47 188 STOP SHOLES 148 189 END SHOLES 149

112
83/12/24. 09.11.45 PAGE 74/175 OPT=0

FTN 5 1»552 4 PROGRAM SHOLES

-V.^RUBLE MAP-- (LO=A) -NAME ADDRESS --BLOCK -PROPERTIES TYPE ---SIZE

ABORT 1 05 4B INTEGER

AFLAC 2B / INITILN/ REAL ANSWER 1 05 5B INTEGER

BLDC OB / INITILC/ CHAR*5

FERR 6 8B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREGA 4B / INITILN/ REAL 50 FTOT 47B / INITILN/ INTEGER

HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR*3 140 HTOT OB /HOLEN/ INTEGER

lERR 1 06 1 B INTEGER

LINE NONE UNUSED/*S* INTEGER

N 1 0 5 7B INTEGER

NROOMS 1 2 4 4B /ROOMN/ INTEGER

OLDFI LE 1 056B INTEGER

PFN 1 0 6 2B CHAR*7

QUALITY IB / INITILN/ INTEGER

QUIT 1 05 3B INTEGER

RAREA 1 2 45B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 676

Y1 1 060B INTEGER

Y2 NONE UNUSED/ *S* INTEGER

-SYMBOLIC CONSTANTS--/ LO=A) -NAME TYPE VALUE

FMAX INTEGER 50 HMAX INTEGER 35 RMAX INTEGER 20

-PROCEDURES--(LO=A)

NAME --TYPE ---ARCS--- ---CLASS -NAME ---TYPE ARCS -- ---CLASS

DATAIN 2 SUBROUTINE LHOLE 0 SUBROUTINE

ERROR 1 SUBROUTINE MANIP 2 SUBROUTINE

GETLEN INTEGER 1 FUNCTION PF 5 SUBROUTINE

STATEMENT LABELS- -( LO=A

)

LABEL- ADDRESS------PROPERTIES DEF

100 2 IB 60 200 47B 72 250 166B 1 1 1 300 2 44B 144

-LABEL -ADDRESS --PROPERTIES- ---DEF

400 25 6B 1 50 500 6 0 6B FORMAT 173 600 INACTIVE DO-TERM 1 7 6

-ENTRY POINTS--(LO=A>

-NAME- --ADDRESS --ARCS

SHOLES 14B 0

113
FTN 5.1+552 83/12/24, 09.11.45 PAGE 5 PROGRAM SHOLES 74/175 OPT=0

-I/O UNITS--(LO=A)

-NAME--- PROPERTIES

TAPEl FMT/SEQ

TAPE6 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 1045B = 565 CM LABELLED COMMON LENGTH 1436B = 798 CM STORAGE USED

COMPILE TIME

63000B = 26112

0.270 SECONDS

2 TRIVIAL ERRORS IN SHOLES

1 WARNING ERROR IN SHOLES

114
fTN 5 I *552

SUBROUTINE DATAIN

83/12/24 09.1145 PACE 6 74/175 OPT=0

1

2

3

4

5

6

7

8

9 10

1 1 12

1314

15

1 6 1718

1920

2122

2324

25

2627

2829

30

3132

33

34

3536

3738

3940

4142

4344

45

464748

4950

5152

5354

5556

5758

59

60

6162

63

64

SUBROUTINE DATAIN ( INSERT , L I NE

)

SHOLES

***t*COMR

COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

•««»«»*»»»»»»»«»»*»**»«*»»***»»*****»**»t »** ****************»**« COMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOMIRMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

** ***<i »** «***«**************lt***lt*1t<I***tt*)t*iliili*«<i1t**<i**lt*««r*****it**QQI>fi^

»»»»**»»«»*»*****»**»*»***«»»**»***<i*************»******»**********»** COMH

» COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS ***COMH

*<**«**«*****«********« «i** *****«r««*«;*it****lt*****«**»***«««4it)****« * COMH

INTEGER HMAX PARAMETER (HMAX = 35)

COMMON /HOLEN/ HTOT , HERR COMMON /HOLEC/ HOLE(HMAX,4)

INTEGER HTOT, HERR CHARACTER * 3 HOLE

DESCRIPTION OF ARRAYS

ROOM IDENTIFICATION APERTURE ID

DIRECTION FROM ROOM TO ROOM

HOLE(X, 1) A3 HOLE (X , 2

)

A3 HOLE(X, 3) A3 HOLE (X , 4) A3 tmiiitittttt*******

t* *t INTEGER ANSWER , LOK , DOK ,NOK , CETLEN , VAL

,

CHARACTER *3 D I R , FROM , TO , ID 200 PRINT*

PRINT*, 'ENTER DIRECTION (E. G. ' ' LR '

' ) REWIND 1 READd , * , END = 2 0 0 ) DIR

IF ((DIR ,NE. 'LR')

+ .AND. (DIR .NE. ' FB ‘

)

+ .AND. (DIR NE. ’ UD ' ) ) THEN

PRINT*, 'DIRECTION MUST BE '

' LR 'OR PRINT* , 'TRY AGAIN! I I

' GOTO 200 END IF HOLE(LINE, 1) = DIR

INSERT, LINE ,V

FB OR " UD '

300 ENTER "FROM" (E.C.PRINT*

PRINT*

REWIND 1 READd ,*,END = 3Q0) FROM

LOK = 0 DOK = 0 NOK = 0 IF (GETLEN(FROM)

LOK = 1 END IF

IF (FROMdd) .EQ

V = VAL(FROM(2

IF ( (V . GE . 1 ) DOK = 1 END IF END IF

IF (dCHAR(FROMd; D)

.AND. ( ICHAR(FROM(l

02 OR • 'D1

EQ. 2) THEN

'D'

2 ) ) .AND.

) THEN

(V LE. 6) ) THEN

. 5 0

1

3

4

5

6

7

8

9 10

1

2

3

GE .

1 ) )

1 6 )

• LE. 25)

COMH 4 COMH 5 COMH 6 COMH 7 COMH 3 COMH 9 COMH 10 COMH 11 COMH 12 COMH 1 3 COMH 14 COMH 15 COMH 1 6 COMH 17 COMH 18

1920 SHOLES 153 SHOLES 154 SHOLES 1 55 SHOLES 156 SHOLES 1 57 SHOLES 158 SHOLES 159 SHOLES 160 SHOLES 1 61 SHOLES 162 SHOLES 163 SHOLES 164 SHOLES 165 SHOLES 166 SHOLES 167 SHOLES 168 SHOLES 169 SHOLES 170 SHOLES 171 SHOLES 172 SHOLES 1 73 SHOLES 174 SHOLES 1 75 SHOLES 176 SHOLES 1 77 SHOLES 178 SHOLES 1 79 SHOLES 1 80 SHOLES 181 SHOLES 182 SHOLES 183 SHOLES 184 SHOLES 1 85

115
FTN 5.1+552 83/12/24. 09.11.45 PACE SUBROUTINE DATAIN 74/175 OPT=0

7

85 + .AND. ( ICHAR( FROM( 2 : 2) ) . GE . 18) SHOLES 188

88 + .AND. (ICHAR(FROM(2;2)) .LE. 25) SHOLES 187

87 + AND. (GETLEN(FROM) . EQ . 2)) THEN SHOLES 188

88 V = VAUFROM) SHOLES 189

89 IF ((V .GE. 1) .AND. (V .LE. RMAX)) THEN SHOLES 190

70 NOK = 1 SHOLES 191

71 END IF SHOLES 192

72 END IF SHOLES 193

73 IF ((LOK EQ. 1) .AND. ((DOK .EQ. 1 ) .OR. (NOK .EQ. 1))) THEN SHOLES 194

74 HOLE (LINE, 2) = FROM SHOLES 1 95

75 ELSE SHOLES 198

78 PRINT* SHOLES 1 97 77 PRINT*, 'INCORRECT ENTRY. TRY AGAIN!!' SHOLES 198

78 GOTO 300 SHOLES 1 99

79 END IF SHOLES 200

80 * SHOLES 201

81 400 PRINT* SHOLES 202

82 PRINT*, 'ENTER "TO" (E.G. ''02'' OR ''Dl'')' SHOLES 203

83 REWIND 1 SHOLES 204

84 READ(1,*,END=400) TO SHOLES 205

85 LOK = 0 SHOLES 208

88 DOK = 0 SHOLES 207

87 NOK = 0 SHOLES 208

88 IF (GETLEN(TO) EQ. 2) THEN SHOLES 209

89 LOK = 1 SHOLES 2 1 0 90 END IF SHOLES 2 11 91 IF (TO(l ; 1) .EQ. 'D'

)

THEN SHOLES 212

92 V = VAL(TO(2 : 2 )

)

SHOLES 2 13 93 IF ((V .GE. 1) .AND. (V .LE. 8)) THEN SHOLES 214

94 DOK = 1 SHOLES 2 1 5 95 END IF SHOLES 2 18 98 END IF SHOLES 2 17 97 IF (( ICHAR(TO(l ; 1) ) . GE . 18) SHOLES 218

98 + AND. ( ICHAR(TO( 1 : 1 ) ) .LE. 25) SHOLES 2 19 99 + .AND. ( ICHAR(TO(2 ; 2) ) . GE . 18) SHOLES 220

1 00 + .AND. ( ICHAR(TO(2 : 2 ) ) .LE. 25) SHOLES 221

10 1 + .AND. (GETLEN(TO) . EQ . 2)) THEN SHOLES 222 102 V = VAL (TO) SHOLES 223

103 IF ((V .GE. 1) .AND. (V .LE. RMAX)) THEN SHOLES 224

104 NOK = 1 SHOLES 225

105 END IF SHOLES 228 108 END IF SHOLES 227

107 IF ((LOK .EQ. 1) .AND. ((DOK . EQ . 1) .OR. (NOK .EQ. 1))) THEN SHOLES 228 108 HOLE (LINE ,3) = TO SHOLES 229

109 ELSE SHOLES 230

110 PRINT* SHOLES 231 111 PRINT*, 'INCORRECT ENTRY. TRY AGAIN!!' SHOLES 232

112 GOTO 400 SHOLES 233

113 END IF SHOLES 234

1 14 IF(FROM .EQ. TO) THEN SHOLES 235

115 PRINT* SHOLES 238 118 PRINT*, 'INCORRECT ENTRY!!' SHOLES 237

117 PRINT*, '"FROM" CANNOT EQUAL "TO"' SHOLES 238 118 PRINT*, 'CHECK YOUR DATA AND REENTER "FROM" AND " TO" ' SHOLES 239

119 PRINT* SHOLES 240 120 GOTO 300 SHOLES 241

12 1 END IF SHOLES 242

122 IF ((FROM(l;l) . EQ . 'D' ) .AND. (TO(l:l) . EQ

.

'D' )) THEN SHOLES 2 ^ i 123 PRINT* SHOLES 244

124 PRINT*, 'INCORRECT ENTRY!!' SHOLES 245

125 PRINT*, '"FROM" AND "TO" CANNOT BOTH CONTAIN "D" ' SHOLES 248

128 PRINT*, ' CHECK YOUR DATA AND REENTER "FROM" AND "TO"' SHOLES 247

127 PRINT* SHOLES 248 128 GOTO 300 SHOLES 249

116
riN 5 U5 5 2 SUBROUTINE DATAIN

03/ 12/24 . 09.11,45 PAGE 74/175 OPT=08

129 END IF SHOLES 250

1 30 ft SHOLES 2 51

13 1 500 PRINT* SHOLES 252

132 PRINT*, 'ENTER HOLE •

' ID • ' (E.G. 'WA' OR 'DA' ' )

SHOLES z S 3 133 REWIND 1 SHOLES 254

134 READ ( 1

, * , END=500

)

ID SHOLES 2 55 135 IF (( ( ID( 1 ; 1) ,EQ. ‘D ) .OR. ( ID(1:1) .EQ. 'U' )) SHOLES 256

1 36 + AND. ( ICHARCID (2:2)) .LE. 58 ) SHOLES 257

137 + AND, ( ICHARCID (2:2)) .GE. 33 )) THEN SHOLES 250

1 38 HOLE(LINE,4) = ID SHOLES 259

139 ELSE SHOLES 2o0

1 40 GOTO 500 SHOLES 261

14 1 END IF SHOLES 262

1 42 ft SHOLES 2 63 143 RETURN SHOLES 264

144 END SHOLES 265

VARIABLE MAP-- (LO=A)

NAME---ADDRESS --BLOCK -PROPERTIES TYPE

ANSWER NONE UNUSED/OS* INTEGER

DIR 7 2 7B CHAR*3

DOK 7 2 4B INTEGER

FROM 730B CHAR*3

HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR*3

HTOT OB /HOLEN/ INTEGER

ID 732B CHAR*3

INSERT 1 DUMMY-ARG UNUSED INTEGER

LINE 2 DUMMY-ARG INTEGER

LOK 7 2 3B INTEGER

NOK 7 2 5B INTEGER

NROOMS 1 244B /ROOMN/ INTEGER RAREA 1 2 45B /ROOHN/ REAL ROOM OB /ROOMN/ REAL

TO 731B CHAR*3

V 726B INTEGER

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

HMAX INTEGER 35 RMAX INTEGER 20

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

VAL INTEGER 1 FUNCTION

-STATEMENT LABELS-- ( LO=A

)

BEL- ADDRESS------PROPERTIES DEF

200 7B 34 300 46B 47 400 203B 81 500 402B 131

117
FTN 5.1+552 83/12/24. 09.11.45 PAGE 9 SUBROUTINE DATAIN 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME-- -ADDRESS-- ARCS

DATAIN 5B 2

-I /O UNITS--(LO=A)

-NAME PROPERTIES

TAPEl FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

735B = 477 1345B = 741 61000B = 25068

0.257 SECONDS

118
FTN 5 I 552

SUBROUTINE MANIP 83/12/24. 09.11.45 PACE 74/175 OPT=0

10

1 SUBROUTINE MANIP (QUIT, ABORT)

2 ••«>iik*(i<i***««*«lt*ik**iit**lk***«ft*«:lt****tl«i********«**«**«**<i*4i*lt«iii<k*****i

3 COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS

INTEGER HMAX PARAMETER (HMAX = 35)

COMMON /HOLEN/ HTOT , HERR COMMON /HOLEC/ HOLE(HMAX,4)

INTEGER HTOT, HERR CHARACTER * 3 HOLE

4

5

6

7

89 10

1

1

• 12 » 13 •

1 4

» 15 * U » 17 » 18 * 19 *

22 INTEGER ABORT , ANSWER , DOK , FLAG 1 , LOK ,N ,NOK , OK , OKI ,OK2 , QUIT, INSERT

23 INTEGER TEMP , V , X , Y , COMMAND

24 CHARACTER * 3 DIR, FROM, TO

25 *

DESCRIPTION OF ARRAYS

ROOM IDENTIFICATION APERTURE ID

DIRECTION FROM ROOM TO ROOM

HOLE(X, 1) A3 HOLE (X , 2

)

A3 HOLE(X, 3) A3 HOLE(X,4)

A3

28 10 FLAGl = 0 27 PRINT*

28 PRINT*

,

'CHOOSE'

29 PRINT*

,

' ( 1 ) 30 PRINT*

,

' (2)

31 PRINT*

,

' (3)

32 + ' PROGRAM

33 PRINT*

,

1 34 + ' STORING

35 PRINT*

,

'ENTER A 38 PRINT*

37 REWIND 1 38 READd , * ,END=10)

DISPLAY LINE OF DATA INSERT LINE INTO FILE DELETE LINE

DATA' NUMBER

(4) DISPLAY ALL LINES'

(5) APPEND LINES OF DATA'

(6) STORE DATA AND EXIT '

(7) EXIT PROGRAM WITHOUT

39 * 40 *-

41 **

42 -

43

44 * 45 ** 48

4748

49 * 50 **

5152 10

5354

5558

57 * 58 **

5980

8182

8384

* DISPLAY LINE ***

IF ( COMMAND . EQ . 1 ) THEN

* INDICATE EMPTY DATA FILE

IF ( HTOT .EQ. 0 ) THEN

PRINT*

PRINT*, 'DATA FILE IS EMPTY M!'

* ENTER NUMBER OF LINE TO BE DISPLAYED

ELSE

0 PRINT*

PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DISPLAYED

PRINT*, ' ( ENTER "0" TO ESCAPE DISPLAY MODE )' REWIND 1 READd ,*,END = 100) N

* CHECK VALIDITY OF LINE NUMBER

IF ( (N .GT. HTOT) .OR. (N . LT . 0) ) THEN

PRINT*

PRINT*

,

PRINT*,

GOTO 100

INCORRECT NUMBER !!!!!! TRY AGAIN !!! -OR- ENTER "0" TO ESCAPE FROM ' "DISPLAY" MODE'

3HOLES 2 8 8 »COMH 1 ‘COMH ; *COMH 5 COMH 4 COMH 5 COMH 8 COMH 7 COMH 8 COMH 9 COMH 1C COMH 1 1 COMH 1 2 COMH 13 COMH ! 4 COMH 15 COMH 1 8 COMH 17 COMH 18 'COMH 19 'COMH 20 SHOLES 288

SHOLES 289 SHOLES 270 SHOLES 27 1 SHOLES 2 72 SHOLES 273 SHOLES 274 SHOLES 275 SHOLES 278 SHOLES 277 SHOLES 278 SHOLES 279

SHOLES 280

SHOLES 281 SHOLES 282

SHOLES 283

SHOLES 284

SHOLES 285

SHOLES 288 SHOLES 287 SHOLES 2 88 SHOLES 289 SHOLES 2 90 SHOLES 291 SHOLES 292

SHOLES 293

SHOLES 294

SHOLES 295 SHOLES 298 SHOLES 297

SHOLES 298

SHOLES 299

SHOLES 300

SHOLES 301 SHOLES 302

SHOLES 303 SHOLES 304 SHOLES 305 SHOLES 308 SHOLES 307 SHOLES 308 SHOLES 309

SHOLES 3 10

119
FTN 5 . 1+552

SUBROUTINE MANIP

83/12/24

74/175

09.11

OPT = 0

45 PACE 1

1

66 tut ABORT 'DISPLAY' MODE SHOLES

67 ELSE IF ( N .EQ. 0 ) THEN SHOLES

68 PRINT* SHOLES

69 PRINT*, ' "DISPLAY" MODE ABORTED !!!' SHOLES

70 t SHOLES

71 tt it DISPLAY LINE OF DATA SHOLES

72 ELSE IF ( (N .GT. 0) .AND. <N .LE. HTOT) ) THEN SHOLES

73 PRINT* SHOLES

74 CALL DISPLAY! N, COMMAND) SHOLES

75 t SHOLES

76 END IF SHOLES

77 END IF SHOLES

78 END IF SHOLES

79 * SHOLES

80 t SHOLES

81 tt it INSERT LINE *»* SHOLES

82 t SHOLES

83 IF ( COMMAND EQ. 2 ) THEN SHOLES

84 * SHOLES

85 ttt INDICATE EMPTY DATA FILE SHOLES

86 IF ( HTOT .EQ. 0 ) THEN SHOLES

87 PRINT* SHOLES

88 PRINT*, 'DATA FILE IS EMPTY !!!' SHOLES

89 t SHOLES

90 ttt REQUEST NUMBER OF LINE BEFORE WHICH INSERTION IS TO BE MADE SHOLES

91 ELSE SHOLES

92 200 PRINT* SHOLES

93 PRINT*, 'SPECIFY NUMBER OF LINE BEFORE WHICH A NEW LINE IS ' , SHOLES

94 + 'TO BE INSERTED' SHOLES

95 PRINT*, ' ( ENTER "0" TO ESCAPE "INSERTION" MODE )

' SHOLES

96 REWIND 1 SHOLES

97 READ! 1

, * , END=200) N SHOLES

98 * SHOLES

99 ttt CHECK FOR VALID LINE NUMBER SHOLES

1 00 IF ! ! N .LT. 0 ) .OR. ! N .GT. HTOT ) ) THEN SHOLES

101 PRINT* SHOLES

102 PRINT*, 'INCORRECT LINE NUMBER !'.!' SHOLES

103 PRINT*, ' TRY AGAIN !!! -OR- ENTER "0" TO ESCAPE'

,

SHOLES

104 + '"INSERTION" MODE' SHOLES

105 GOTO 200 SHOLES

106 t SHOLES

107 ttt ABORT INSERTION MODE SHOLES

1 08 ELSE IF ! N .EQ. 0 ) THEN SHOLES

109 PRINT* SHOLES

1 10 PRINT*, ' "INSERTION" MODE ABORTED' SHOLES

11 1 t SHOLES

112 t tt MAKE ROOM FOR NEW LINE OF DATA SHOLES

113 ELSE IF ! !N .GT. 0) AND. !N LE. HTOT) ) THEN SHOLES

114 DO 230 X = HTOT,N,-l SHOLES

115 DO 210 Y = 1,4 SHOLES

116 HOLE!X+l , Y) = HOLE!X ,Y) SHOLES

117 210 CONTINUE SHOLES

118 230 CONTINUE SHOLES

119 t SHOLES

1 20 ttt ENTER DATA FOR NEW LINE SHOLES

12 1 HTOT = HTOT + 1 SHOLES

122 CALL DATAIN ! 1 ,N) SHOLES

123 t SHOLES

124 PRINT* SHOLES

125 PRINT*, 'THE FOLLOWING LINE HAS BEEN ADDED AS LINE ' , N SHOLES

126 CALL DISPLAY! N, COMMAND) SHOLES

127 END IF SHOLES

128 END IF SHOLES

3 1 1

3 12

3 1 3

3 14 315

3 U

317

3 18 319 320

321

322 323

324

325 326

327

328

329 330

331 332

333

334

335

3 36 337 338

339

340

341 342 343

344

345

3 46 347

348

349

350

351

352 353

354 355

356

357 358

359

360

36 1 362

363

364

365

366

367

368 369

370

371 372

373 374

120
FTN i 1.552

SUBROUTINE MAN I

P

83/ 12 / 24 . 0 9.1 1.4 5 PACE 74/175 OPT=0

12

129

1 30

13 1

t END IF SKOLES

SHOLES

3HOLES

j / J 376

3 7 7 132 t • R DELETE LINE SHO L 1

5

5 78 133 SHOLES 379

134 IF ( COMMAND EQ . 3 ) THEN SHOLES 3 80 135 a SHOLES 331

1 36 a a a INDICATE EMPTY DATA FILE SHOLES 382

137 IF ( HTOT EQ. 0 ) THEN SHOLES 383

1 38 PRINT* SHOLES 3 84 139 PRINT*, 'DATA FILE IS EMPTY ! ! ! SHOLES 385

1 40 a SKOLES 5 86

14 1 a a a READ NUMBER OF LINE TO BE DELETED SHOLES 3 87

1 42 ELSE SHOLES 3 98

14 3 300 PRINT* SHOLES 389

1 44 PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DELETED

SHOLES 3 9C 145 PRINT*, ' (ENTER "0" TO ESCAPE DELETION MODE)

SHOLES ? 1

1 46 REWIND 1 SHO L Z S 39Z

147 READ(1,*,END=300) N SHOLES 393

1 48 a SHOLES 3 94 149 a a a CHECK VALIDITY OF LINE NUMBER SHOLES 395

150 IF ( (N .GT. HTOT ) .OR. ( N . LT. 0 ) ) THEN SHOLES 396

15 1 PRINT* SHOLES 397

152 PRINT*, ' INCORRECT NUMBER i I \

* SHOLES 398

15 3 PRINT* ,

' TRY ACAIN ! !

!

- OR- ENTER "0” TO ESCAPE FROM' , SHOLES 399

154 + '"DELETE" MODE' SHOLES 4 00 155 COTO 300 SKOLES 401

1 56 a SHOLES 401

157 a a a ABORT 'DELETE' MODE SHOLES 403

1 58 ELSE IF ( N .EQ. 0 ) THEN SHOLES 4 04 159 PRINT*, ' "DELETE" MODE ABORTED' SHOLES 405

160 a SHOLES 406

16 1 a a a DOUBLE CHECK CHOICE OF LINE TO BE DELETED SHOLES 407

162 ELSE IF (( N .GT. 0 ) .AND. ( N . LE . HTOT )

)

THEN SHOLES 406

16 3 PRINT* SHOLES 409

164 PRINT* , 'DOUBLE CHECK ! !!

' SHOLES 4 10 165 PRINT*, ' DO YOU WANT TO DELETE THE FOLLOWING LINE? ;

SHOLES 4 1 1 166 CALL DISPLAY! N, COMMAND) SHOLES 4 12 167 305 PRINT*, ' ENTER (1) YES OR (2) NO' SHOLES 4 13 168 REWIND 1 SHOLES 4 14 169 READ( 1

,

* , END=305) ANSWER SHOLES 4 15 170 a SHOLES 4 16 17 1 a a a DELETE LINE SHOLES 417

172 IF ( ANSWER EQ. 1 ) THEN SHOLES 4 18 173 DO 330 X = N, HTOT - 1 SHOLES 4 1 9 174 DO 310 Y = 1,4 SHOLES 420

175 HOLE(X,Y) = HOLE(X+l,Y) SHOLES 421 176 310 CONTINUE SHOLES 422

177 330 CONTINUE SHOLES 423 178 HTOT = HTOT - 1 SHOLES 4 24 179 PRINT* SHOLES 425

1 BO PRINT*, 'LINE t ',N,' DELETED' SHOLES 426

18 1 END IF SHOLES 427

1 82 a SHOLES 428

183 END IF SHOLES 47 9 184 END IF SHOLES 4 30 185 END IF SHOLES 431 186 a SHOLES 4 32 187 a SHOLES 433 188 a a a DISPLAY ALL DATA *** SHOLES 4 34 189 a SHOLES 435 190 IF ( COMMAND .EQ. 4 ) THEN SHOLES 4 36

19 1 a SHOLES 437

192 t** INDICATE EMPTY DATA FILE SHOLES 4 38

121
5.1+552 83 / 1 2 / 24. 09. 1 1 .45 PAGE 13 lOUTINE MANIP 74/175 OPT=0

193 IF ( HTOT EQ. 0 ) THEN SHOLES 439

194 PRINT* SHOLES 4 40 195 PRINT*, -DATA FILE IS EMPTY !!!' SHOLES 44 1

1 94 t SHOLES 442

197 * * * DISPLAY DATA SHOLES 443

198 ELSE SHOLES 444

199 PRINT* SHOLES 445 200 CALL DISPLAY! N, COMMAND) SHOLES 444

20 1 * SHOLES 447 202 END IF SHOLES 448 203 END IF SHOLES 449 204 * SHOLES 450

205 t SHOLES 451 204 * * * ADD DATA *** SHOLES 452 207 * SHOLES 453

208 IF ( COMMAND . EQ . 5 ) THEN SHOLES 454 209 A SHOLES 455

2 10 AAA ENTER DATA SHOLES 454

21 1 500 HTOT = HTOT + 1 SHOLES 457

2 12 CALL DATA IN (O.HTOT) SHOLES 458

213 510 PRINT* SHOLES 459

2 14 PRINT*. 'DO YOU WANT TO ENTER MORE DATA? ! 1) YES !2) NO ' SHOLES 440 215 PRINT*, ENTER A NUMBER !!!‘ SHOLES 441

2 14 REWIND 1 SHOLES 442 217 READ! 1

, * , END=510) ANSWER SHOLES 443

2 18 A SHOLES 4 44 219 AAA CHECK VALIDITY OF NUMBER SHOLES 445 220 IF ! ! ANSWER .NE. 1 ) AND. ! ANSWER • NE . 2 ) ) THEN SHOLES 4 66

22 1 GOTO 510 SHOLES 447 222 A SHOLES 448 223 AAA ENTER MORE DATA SHOLES 449 224 ELSE IF ! ANSWER . EQ . 1 ) THEN SHOLES 470

225 GOTO 500 SHOLES 471 224 A SHOLES 472 227 AAA DISCONTINUE DATA ENTRY SHOLES 473 228 ELSE IF ! ANSWER EQ. 2 ) THEN SHOLES 4 74 229 PRINT* SHOLES 475 230 PRINT*, 'DATA ENTRY DISCONTINUED' SHOLES 474

231 A SHOLES 477 232 END IF SHOLES 478

233 END IF SHOLES 479 234 A SHOLES 480 235 A SHOLES 481 234 AAA STORE DATA AND PROGRAM *** SHOLES 482 237 A _ . _ SHOLES 483 238 IF ! COMMAND .EQ. 4 ) THEN SHOLES 484

239 400 PRINT* SHOLES 485 240 PRINT* , 'DOUBLE CHECK ! ! !

' SHOLES 484

24 1 PRINT*, ' DO YOU YOU WANT TO STORE THIS DATA AND END PROG ' SHOLES 487 242 PRINT*, ' NOTE. STORING THIS DATA WILL WIPE OUT ANY OLD FILE SHOLES 488 243 PRINT*, ' OF THE SAME NAME !!!' SHOLES 489 244 PRINT*, ' ENTER A NUMBER; !1) YES ! 2) NO ' SHOLES 490

245 REWIND 1 SHOLES 491 244 READ!1 ,*,END=400) ANSWER SHOLES 492 247 A SHOLES 493 248 AAA SET FLAG FOR STORING DATA IN THE MAIN PROGRAM SHOLES 494

249 IF ! ANSWER . EQ . 1 ) THEN SHOLES 495 250 QUIT = 1 SHOLES 4 94 25 1 RETURN SHOLES 497 252 A SHOLES 498

253 AAA ABORT 'STORING' MODE SHOLES 499 254 ELSE IF ! ANSWER .EQ. 2 ) THEN SHOLES 500

255 PRINT* SHOLES SOI 254 PRINT*, "STORING" MODE DISCONT INUED' SHOLES 502

122
FTN 5 U5I2 83/12/24 09.11.45 PAGE 14 SUBROUTINE MANIP 74/175 OPT=0

257 • SHOLES 503

258 «•* CHECK VALIDITY OF ANSWER SHOLES 5 04 259 ELSE IF ( ( ANSWER .NE. 1 ) .AND. ( ANSWER NE. 2 ) ) THEN SHOLES 505

280 GOTO 800 SHOLES 5 06

28 1 % SHOLES 507

282 END IF SHOLES 5 08 283 END IF SHOLES 509

284 % SHOLES 5 10 Qwnr 5 1 1 288 *»» END PROGRAM WITHOUT STORING DATA *** SHOLES 5 12 ^11 Q14HT PQ 5 13 288 IF ( COMMAND . EQ . 7 ) THEN SHOLES 5 14 289 700 PRINT* SHOLES 515 270 PRINT* ,

' DOUBLE CHECK ! ! !

' SHOLES 5 16 27 1 PRINT*, ' DO YOU WANT TO END THIS PROGRAM SHOLES 5 1 7 111 + 'WITHOUT STORING DATA?' SHOLES 5 18 273 PRINT*, ' ENTER A NUMBER: (1) YES (2) NO' SHOLES 5 1 9 274 REWIND 1 SHOLES 520

275 READ(1,*,END=700) ANSWER SHOLES 521 278 SHOLES 5 22 in *** SET FLAG FOR ABORTING PROGRAM IN THE MAIN PROGRAM SHOLES 523

278 IF ( ANSWER EQ. 1 ) THEN SHOLES 524

279 ABORT = 1 SHOLES 525 280 RETURN SHOLES 526

28 1

ft SHOLES 527

282 *** ABORT 'STORING' MODE SHOLES 5 28 263 ELSE IF ( ANSWER . EQ . 2 ) THEN SHOLES 529

284 PRINT* SHOLES 530

285 PRINT*, ' "ABORTION" MODE DISCONTINUED' SHOLES 531 288 ft SHOLES 532

287 *** CHECK VALIDITY OF ANSWER SHOLES 533

288 ELSE IF ( ( ANSWER .NE. 1 ) .AND. ( ANSWER . NE . 2 ) ) THEN SHOLES 534

289 GOTO 700 SHOLES 535

290 ft SHOLES 5 38

29 1 END IF SHOLES 537

292 END IF SHOLES 538

293 ft SHOLES 539

2 94 cunT r

c

540

295 *** LOOP TO BEGINNING OF 'MANIP' SUBROUTINE SHOLES 541 298 ft - SHOLES 542

297 GOTO 10 SHOLES 543

298 ft SHOLES 544

299 RETURN SHOLES 545

TRIVIAL* NO PATH TO THIS STATEMENT

300 END SHOLES 548

-VARIABLE MAP-- o II -NAME ADDRESS --BLOCK -PROPERTIES TYPE

ABORT 2 DUMMY -ARG INTEGER

ANSWER 1 400B INTEGER

COMMAND 1 405B INTEGER

DIR NONE UNUSED/ *S* CHAR*3

DOK NONE UNUSED/*S» INTEGER

FLAGl 1401B INTEGER

FROM NONE UNUSED/ *S* CHAR*3

HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR*3

HTOT OB /HOLEN/ INTEGER

INSERT NONE UNUSED/ *S* INTEGER

LOK NONE UNUSED/*S* INTEGER

N 1 402B INTEGER

NOK NONE UNUSED/*S* INTEGER

123
FTN 5.1+552 83/12/24. 09.11.45 PACE 15 SUBROUTINE MANIP 74/175 OPT=0

OK NONE UNUSED/*S* INTECER

OKI NONE UNUSED/*S* INTEGER

OK2 NONE UNUSED/*S* INTEGER

QUIT 1 DUMMY-ARC INTEGER TEMP NONE UNUSED/ *S* INTEGER

TO NONE UNUSED/*S» CHAR*3

V NONE UNUSED/ *S* INTEGER

X 1 403B INTEGER

Y 1 404B INTEGER

SYMBOLIC CONSTANTS--! LO=A) NAME TYPE VALUE

HMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME --TYPE ARCS ---CLASS

DATAIN 2 SUBROUTINE

DISPLAY 2 SUBROUTINE

-STATEMENT LABELS- -( LO=A

)

LABEL- ADDRESS --PROPERTIES- ---DEF -LABEL -ADDRESS --PROPERTIES- ---DEF

10 7B 26 3 10 INACTIVE DO-TERM 1 76 100 50B 52 330 INACTIVE DO-TERM 177 200 133B 92 500 43 7B 211 210 INACTIVE DO-TERM 117 510 44 3B 213

230 INACTIVE DO-TERM 118 600 S04B 239 300 263B 143 700 55 6B 269 305 332B 167

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS-- ARCS

MANIP 5B 2

-I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPEl FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 141 4B = 780 CM LABELLED COMMON LENGTH 54B = 44 CM STORAGE USED 63000B = 26112

COMPILE TIME 0.388 SECONDS

1 TRIVIAL ERROR IN MANIP

124
FTH 5 1+552 83/12/24. 09,11.45 PAGE u

SUBROUTINE DISPLAY 74/175 OPT=0

1

2

3

45

6

7

8

9

1 0

1 1 12

13

1 4 15

1617

IS1920

2122

23

24

2526

2728

2930

313233

34

35

SUBROUTINE DISPLAY (LINE, COMMAND) 3HOLES

*•" COMMON FOR DATABASE OF LOCATIONS OF DOORS AND VINDOUS ***COMH

INTEGER HMAX COMH

PARAMETER (HMAX = 35) COMH

COMMON /HOLEN/ HTOT , HERR COMH

COMMON /HOLEC/ HOLE (HMAX, 4) COMH

INTEGER HTOT, HERR COMH

CHARACTER * 3 HOLE COMH

* ================================================== COMH

» DESCRIPTION OF ARRAYS COMH

* ================================================== COMH

* ROOM IDENTIFICATION APERTURE ID COMH

« - COMH

» DIRECTION FROM ROOM TO ROOM COMH

» COMH

* HOLE(X,l) HOLE(X,2) HOLE(E,3) HOLE(X,4) COMH

* A3 A3 A3 A3 COMH

*rt*««*****« «<r«** *****«ii>***t********«*iii*<i*ii(iiMii*******A**************«ikCOMH

INTEGER LINE, COMMAND, N SHOLES

1000 FORMAT (8(3X,A)) SHOLES

2 0 0 0 FORMAT ( 4X , I 3 , 8X , A3 , 7 X , A3 , 3X , A3 , 2X , A3 ) SHOLES

PRINT 10 00, 'LINE # ' ,

' D IRECTI ON ' ,

' FROM ’ ,' TO ' ,' ID ' SHOLES

IF ( COMMAND .EQ, 4 ) THEN SHOLES

DO 10 N = l,HTOT SHOLES

PRINT 2000, N,HOLE(N, 1) ,HOLE(N, 2) ,HOLE(N,3) ,HOLE(N,4) SHOLES

10 CONTINUE SHOLES

ELSE SHOLES

PRINT 2000, LINE,HOLE(LINE,l) ,HOLE(LINE,2) ,HOLE(LINE,3) , SHOLES

+ HOLE(LINE,4) SHOLES

END IF SHOLES

RETURN SHOLES

END SHOLES

5 47

1

2

3

4

5

6

/

8

9

1 0

1 1 12

1 3 14

1516

17

18

1920

5 49 550

551 552

553

554

555

556

557 558

559

560

561 562

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

COMMAND 2 DUMMY -ARG INTEGER HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR*3 1 40 HTOT OB /HOLEN/ INTEGER

LINE 1 DUMMY -ARG INTEGER N 20 4B INTEGER

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

HMAX INTEGER 35

-STATEMENT LABELS- -( LO= A

)

LABEL- ADDRESS --PROPERTIES--- -DEF

1 0 INACTIVE DO-TERM 29 1000 123B FORMAT 23

20 00 125B FORMAT 24

FTN 5.1+552 83/12/24. 09.11 45 PAGE 17 SUBROUTINE DISPLAY 74/175 OPT=0

--ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS- --

DISPLAY 5B 2

--STATISTICS--

PROGRAM-UNIT LENGTH 2108 1 36 CM LABELLED COMMON LENGTH 54B > 44 CM STORAGE USED 610008 > 25088

COMPILE TIME 0 0 61 SECONDS

125
83/ 12 /24 . 09.1 1.45 PAGE 74/175 OPT=0

FTN 5.1+552 18 FUNCTION VAL

1 INTEGER FUNCTION VAL(STRING) SHOLES 563

2 c** RETURNS THE INTEGER VALUE OF A STRING. SHOLES 5 64

3 INTEGER NUMBER, X , L , EXP , D I GIT , GETLEN SHOLES 565

4 CHARACTER * <*) STRING SHOLES 5 66

5 L = GETLEN(STRING) SHOLES 567

6 NUMBER = 0 SHOLES 568

7 DO 10 X = L, 1

, -1 SHOLES 569

8 EXP = L - X SHOLES 570

9 DIGIT = ICHAR(STRING(X; X) ) - 16 SHOLES 571

10 NUMBER = NUMBER + D IG 1T« 1 0 * *EXP SHOLES 5 72

1

1

10 CONTINUE SHOLES 573

12 VAL = NUMBER SHOLES 574

13 RETURN SHOLES 575

14 END SHOLES 5 76

-VARIABLE MAP--(LO=A)

-NAME ADDRESS --BLOCK PROPERTIES TYPE

DIGIT 76B INTEGER

EXP 75B INTEGER

L 74B INTEGER

NUMBER 72B INTEGER

STRING 1 DUMMY-ARG CHAR* < *) VAL 71B INTEGER

X 73B INTEGER

-PROCEDURES --(LO=A) -NAME- TYPE --ARGS--- ---CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS- -( LO=A

)

-LABEL-ADDRESS PROPERTI ES DEF

10 INACTIVE DO-TERM 11

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARCS- --

VAL 6B 1

-STATISTICS--

PROCRAM-UNIT LENGTH 102B = 86 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.039 SECONDS

126
fTN 5 l»552 83/12/24. 09.11.45 PAGE 19 FUNCTION CETLEN 74/175 OPT=0

1 INTEGER FUNCTION GETLEN (STRING) SHOLES 577

2 C SHOLES 5 78

3 C DETERMINE LENGTH OF STRING EXCLUDING ANY BLANK PADDING SHOLES 5 79

4 C SHOLES 5 80

5 C SHOLES 581

6 C ARGUMENT DEFINITIONS -- SHOLES 5 82

7 C READ ARGUMENTS SHOLES 583

8 C STRING - STRING WHOSE LENGTH IS TO BE DETERMINED SHOLES 5 84

9 C SHOLES 585

10 CHARACTER * (») STRING SHOLES 5 86

1 1 C SHOLES 587

12 C FUNCTION PARAMETERS SHOLES 5 88

13 CHARACTER » 1 BLANK SHOLES 589

1 4 PARAMETER (BLANK =

' ‘

)

SHOLES 5 90

IS C SHOLES 591

16 C LOCAL VARIABLES SHOLES 592

17 INTEGER NEXT SHOLES 5 93

18 C SHOLES 5 94

19 C START WITH THE LAST CHARACTER AND FIND THE FIRST NON-BLANK SHOLES 595

20 DO 10 NEXT = LEN(STRING) , 1

, -1 SHOLES 596

21 IF (STRING (NfeXT ; NEXT) .NE. BLANK) THEN SHOLES 597

22 GETLEN = NEXT SHOLES 598

23 RETURN SHOLES 599

24 END IF SHOLES 600

25 10 CONTINUE SHOLES 601

26 C SHOLES 602

27 C ALL CHARACTERS ARE BLANKS SHOLES 603

28 GETLEN = 0 SHOLES 6 04

29 C SHOLES 605

30 RETURN SHOLES 6 06

31 END SHOLES 607

VARIABLE MAP--(LO=A)

NAME ADDRESS- -BLOCK PROPERTIES TYPE ---SIZE

CETLEN 63B INTEGER

NEXT 64B INTEGER

STRING 1 DUMMY-ARG CHARM *)

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

BLANK CHAR*1 ' '

-PROCEDURES--(LO=A)

-NAME TYPE ARCS -CLASS

LEN INTEGER 1 INTRINSIC

-STATEMENT LABELS-- (LO=A)

-LABEL-ADDRESS PROPERTIES--- -DEF

10 INACTIVE DO-TERM 25

FTN 5.1+552 83/12/24

FUNCTION GETLEN 74/175

. 09.11.45 PACE OPT = 0

20

--ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARCS---

GETLEN 8B 1

--STATISTICS--

PROGRAM-UNIT LENGTH 70B > 36 CM STORAGE USED 61000B > 25088

COMPILE TIME 0.037 SECONDS

127
FTN 5 . 1+552

SUBROUTINE LHOLE

83/12/24. 09.11.45 PAGE 74/175 OPT=0

21

1 SUBROUTINE LHOLE LHOLE

2 * !!!! M !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! I! !!!!!!!!!!! M ! LHOLE

3 * ! ! ! ! ! ! LHOLE

4 *!!! LOAD THE CONTENTS OF THE "HOLE" FILE INTO THE "HOLE" ARRAY MILHOLE

5 * ! !

!

M ! LHOLE

6 *!!!!!!!!!!!!!!!!!!!!! I ! I ! I !!! M !!!!!!!!!!!!! M !!!!!! M !!!!!!!!!!!!! M !! L HO L E

7 )ii«*******«« «** *«****« «** ****«**«***««««**««***********«ik**«**«**C0MH

8 *** COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS ***COMH

10 INTEGER HMAX COMH

11 PARAMETER (HMAX = 35) COMH

12 COMMON /HOLEN/ HTOT, HERR COMH

13 COMMON /HOLEC/ HOLE (HMAX, 4) COMH

14 INTEGER HTOT, HERR COMH

15 CHARACTER * 3 HOLE COMH

U * ================================================== COMH

17 * DESCRIPTION OF ARRAYS COMH

18 * ================================================== COMH

19 * ROOM IDENTIFICATION APERTURE ID COMH

20 * COMH

21 * DIRECTION FROM ROOM TO ROOM COMH

22 * - COMH

23 * HOLE(X,l) HOLE(X,2) HOLE(X,3) HOLE(X,4) COMH

24 * A3 A3 A3 A3 COMH

2i *lt**«*******4r**ti**A<l*|li*****1k*«AttD****[**A)k i** *«*********lk**A********** COMH

27 «******llr******«*ik*******************************«************lt*tk**ik*****COMF

28 * A * COMMON FOR INITIAL PARAMETERS ***COMF

29 A* *ft**ft*ft**ft*****ft*******ft**ft**ft ft** *****ft ft** ftft*ft*ft***ft*ft**ft*ft ft COM

F

30 INTEGER FMAX COMF

31 PARAMETER (FMAX = 50) COMF

32 COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF

33 $ ftot COMF

34 COMMON /INITILC/ BLDG COMF

35 CHARACTER * 5 BLDG COMF

36 REAL FREQ, AFLAC, RFLAG, FREQA COMF

37 INTEGER QUALITY, FERR, FTOT COMF

38

39 ft* *« 40 INTEGER CETLEN, R, C LHOLE

41 CHARACTER * 7 PFN LHOLE

42 PFN = 'B‘ II BLDG( 1 :GETLEN(BLDG) ) II 'H' LHOLE

43 HERR = 0 LHOLE

44 CALL PF ( 'GET' , 0 ,PFN( 1 :GETLEN(PFN) )

, ‘RC‘ ,HERR) LHOLE

45 IF ( HERR .EQ. 0 ) THEN LHOLE

46 OPEN (UNIT=3, FILE=PFN, FORM= ' FORMATTED '

,

LHOLE

47 5 STATUS= 'OLD' , ACCESS= ' SEQUENTIAL '

)

LHOLE

48 1000 FORMAT ( IX , 4( IX , A3 ) > LHOLE

49 HTOT = 0 LHOLE

50 DO 10 R = 1 ,HMAX LHOLE

51 READ (3,1000 , END=20) (HOLE(R, C) ,C:nl , 4) LHOLE

52 HTOT = HTOT + 1 LHOLE

53 10 CONTINUE LHOLE

54 20 CONTINUE LHOLE

55 C LOSE ( 3, STATUS= 'DELETE'

)

LHOLE

56 ELSE IF ( HERR EQ. 2 ) THEN LHOLE

57 CALL WARNING ( 1

)

LHOLE

58 ELSE LHOLE

59 CALL WARNING (2) LHOLE

60 END IF LHOLE

61 RETURN LHOLE

62 END LHOLE
fXN 5 u:5:

SUBROUTINE LHOLE

8 3 / 1 2 / 2 4 , 0 9.1 1.45 PAGE 74/175 OPT=0

22

-VARIABLE NAP--(LO=A)

-NAME--- ADDRESS --BLOCK PROPERTIES TYPE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C 2 1 4B INTEGER

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B /INITILN/ REAL

FTOT 67B / INITILN/ INTEGER

HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR»3

HTOT OB /HOLEN/ INTEGER

PFN 215B CHAR*

7

QUALITY IB /INITILN/ INTEGER

R 2 1 3B INTEGER

RFLAG 3B / INITILN/ REAL

-SYMBOLIC CONSTANTS--! LO=A> -NAME TYPE VALUE

FMAX INTEGER 50 HMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME TYPE

GETLEN INTEGER

PFWARNING

ARCS CLASS

1 FUNCTION

5 SUBROUTINE

1 SUBROUTINE

-STATEMENT LABELS--! LO=A) -LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 53 20 73B 54 1000 130B FORMAT 48

-ENTRY POINTS--!LO=A)

-NAME ADDRESS- -ARCS- --

LHOLE 5B 0

-I/O UNITS--!LO=A)

-NAME PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 2 2 2B = 148 CM LABELLED COMMON LENGTH 145B = 1 01 CM STORAGE USED UOOOB = 25088

COMPILE TIME 0 .088 SECONDS

SIZE

50

1 40

129
FTN 5.1+552

SUBROUTINE ERROR

83 / 12 / 24 . 09.1 1.45 PAGE

74/175 OPT=0

23

1 SUBROUTINE ERROR(IERR) ERROR 1 2 CHARACTER* 45 MESSAGE!20) ERROR 2

3 DATA MESSAGE

!

1 ) / 'MATERIALS DATA BASE IS EMPTY ' / ERROR 3

4 DATA MESSAGE! 2 )

/

' FREQUENCY IS OUT OF 1RANGE ' / ERROR 4

5 DATA MESSAGE

!

3) / 'THIS MATERIAL IS NOT IN DATA BASE ' / ERROR 5

8 DATA MESSAGE! 4 )/ 'DENOMINATOR IS ZERO ' / ERROR 8 7 DATA MESSAGE

!

S ) /

' FILE HANDLING ERROR ' / ERROR 7

8 DATA MESSAGE! 8) /

‘ ERROR CODE IS OUT OF RANGE ' / ERROR 8 9 DATA MESSAGE! 7 ) /

' ERROR CODE IS OUT OF RANGE / ERROR 9 10 DATA MESSAGE! 8) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 10

11 DATA MESSAGE! 9 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 1

1

12 DATA MESSAGE! 10) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 12

13 DATA MESSAGE! 11)/ 'ERROR CODE IS OUT OF RANGE ' / ERROR 13 14 DATA MESSAGE! 12) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 14

15 DATA MESSAGE! 13) /' ERROR CODE IS OUT OF RANGE ' / ERROR 15 18 DATA MESSAGE! 14) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 18 17 DATA MESSAGE! 15 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 17

18 DATA MESSAGE! 18) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 18 19 DATA MESSAGE! 17 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 1 9 20 DATA MESSAGE! 18) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 20

21 DATA MESSAGE! 19 ) /' ERROR CODE IS OUT OF RANGE ' / ERROR 21 22 DATA MESSAGE!20) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 22 23 IERRM=5 ERROR 23 24 IF(IERR.GT.IERRM) IERR=20 ERROR 24

25 VRITE(8,10) lERR, MESSAGE! lERR) ERROR 25 28 10 FORMAT!' ***ERROR NUMBER _ 1 , 15 ,

* * * * ' ,A45) ERROR 28 27 CALL PMDSTOP ERROR 27 28 STOP ' ERROR

ERROR 28 29 END ERROR 29

-VARIABLE MAP--!LO=A)

-NAME- --ADDRESS- -BLOCK PROPERTIES TYPE SIZE

lERR 1 DUMMY-ARG INTEGER

lERRM 210B INTEGER

MESSAGE 58B CHAR*45 20

--PROCEDURES--(LO=A>

-NAME TYPE ARCS CLASS

PMDSTOP 0 SUBROUTINE

--STATEMENT LABELS-- ( LO=A

)

-LAB EL- ADDRESS PROPERTIES DEF

10 38B FORMAT 28

--ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS---

ERROR 5B 1

FTN 5.1+552 83/12/24. 09.11.45 PAGE 24 SUBROUTINE ERROR 74/175 OPT=0

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE8 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH 213B = 139 CM STORAGE USED 81000B = 25088

COMPILE TIME 0.055 SECONDS

130
FTN 5 1*552 83/12/24 09 11 45 PAGE 25 SUBROUTINE WARNING 74/175 OPTxO

1 SUBROUTINE WARNING(ERR) WARNING i

2 INTEGER ERR, ERRM WARNING

3 CHARACTER»45 MESSAGE(20) WARNING 3

4 DATA MESSAGE! l)/'"HOLE- DATA FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 4 5 DATA MESSAGE! 2)/ 'FILE HANDLING PROBLEM ON "HOLE" DATA FILE ' / WARNING C

6 DATA MESSAGE! 3) /'"MATTER" FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING 6

7 DATA MESSAGE! 4)/ 'FILE HANDLING PROBLEM ON "MATTER FILE ' / WARNING 7

8 DATA MESSAGE! 5)/ '"TYPE" DATA FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING B 9 DATA MESSAGE! 6) /'FILE HANDLING PROBLEM ON "TYPE" FILE ' / WARNING 9

1 0 DATA MESSAGE! 7)/ '"WALL" DATA FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING 10

1 1 DATA MESSAGE! 8) /'FILE HANDLING PROBLEM ON "WALL" FILE ' / WARNING 1

1

1 2 DATA MESSAGE! 9)/ 'HEIGHT AND WIDTH OF ROOM MISSING ' / WARNING 12

13 DATA MESSAGE ! 10 )/' LENGTH OF ROOM IS MISSING ' / WARNING 13

1 4 DATA MESSAGE! 11 )/' FREQ FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 14

15 DATA MESSAGE! 12 )/' FILE HANDLING PROBLEM WITH FREQ FI LE ' / WARNING 15

1 6 DATA MESSAGE! 13)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 16 17 DATA MESSAGE! 14) / 'WARNING CODE IS OUT OF RANGE ' / WARNING 17 18 DATA MESSAGE! 15 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 18

19 DATA MESSAGE ! 16 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 19 20 DATA MESSAGE! 17 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 20

21 DATA MESSAGE! 18) / 'WARNING CODE IS OUT OF RANGE ' / WARNING 21 22 DATA MESSAGE! 19 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 22 23 DATA MESSAGE!20)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 23

24 ERRM= 12 WARNING 24

25 I ERR = ERR WARNING 25 26 IF (ERR . GT . ERRM) IERR=20 WARNING 26 27 WRITE(6, 20) WARNING 27 28 WRITE(6,10) ERR .MESSAGE! lERR) WARNING 28

29 WRITE (6,20) WARNING 29 30 10 FORMAT!' ***WARNING NUMBER = ',15,' **» ',A45) WARNING 30

31 20 FORMAT! • ') WARNING 31

32 RETURN WARNING 32

33 END WARNING 33

-VARIABLE MAP--(LO=A)

-NAME- --ADDRESS- -BLOCK PROPERTIES TYPE SIZE

ERR 1 DUMMY -ARG ERRM 60B

lERR 213B

MESSAGE 61B

INTEGER

INTEGER

INTEGER

CHAR*45 20

-STATEMENT LABELS-- ( LO=A) -LAB EL -ADDRESS PROPERTIES DEF

10 34B FORMAT 30 20 42B FORMAT 31

-ENTRY POINTS--(LO=A>

-NAME ADDRESS- -ARGS

FTN 5.1+552 83/12/24. 09.11.45 PAGE 26 SUBROUTINE WARNING 74/175 OPT=0

--I/O UNITS--(LO=A)

-NAME PROPERTIES

WARNING 5B TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

216B r 142 61000B X 2S08B

0.057 SECONDS

131
Appendix 9.4 Listing of Computer Program SWALLS

]32
FIN 5 1*552 83/12/24 11.29.46 PAGE 1 PROGRAM SUALLS 74/175 OPT=0

1 PROGRAM SWALLS ( INPUT, TAPE 1 =INPUT) 5VALLS

2 • SVALL3

3 "THIS INTERACTIVE PROGRAM INPUTS THE DATA DESCRIBING EACH VALL SVALLS

4 »IN THE BUILDING AND STORES IT. THE FILE NAME IS CREATED BY SUALLS

5 ‘ATTACHING "B" TO THE FRONT OF AND "W" TO THE BACK OF THE BUILDING SUALLS

6 ‘IDENTIFICATION. THE BUILDING IDENTIFICATION CAN BE NO MORE SUALLS

7 ‘THAN 5 ALPHANUMERIC CHARACTERS. SUALLS

8 SUALLS

10 “‘ COMMON FOR INITIAL PARAMETERS “*COMF

12 INTEGER FMAX COMF

13 PARAMETER (FMAX = 50) COMF

14 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF

15 $ FTOT COMF

16 COMMON /INITILC/ BLDG COMF

17 CHARACTER * 5 BLDG COMF

18 REAL FREQ, AFLAG, RFLAG, FREQA COMF

19 INTEGER QUALITY, FERR, FTOT COMF

23 “* COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF UALLS *“COMR

25 INTEGER RMAX COMR

26 PARAMETER (RMAX = 20) COMR

27 COMMON /ROOMN/ ROOMIRMAX + 6, RMAX + 6), NROOMS, RAREA(RMAX) COMR

28 INTEGER NROOMS COMR

29 REAL ROOM COMR

31 t***ii*****tii***tii*************ii*t***t**it*****i(*ttt**t***iit*****t**ii*t** ‘COMR

32 *COMU

33 *“ COMMON FOR DATABASE OF VALL PARAMETERS “*COMU

35 INTEGER UMAX COMU

36 PARAMETER (UMAX = 75) COMU

37 COMMON /WALLN/ WD IMIVMAX , 3 ) , UTOT, UERR COMU

38 COMMON /WALLC/ VALL (UMAX, 4) COMU

39 INTEGER VTOT,VERR COMU

40 REAL VDIM COMU

41 CHARACTER *3 VALL COMU

42 * ================================= COMU

43 “ DESCRIPTION OF ARRAYS COMU

44 » ================================= COMV

45 * WALL IDENTIFICATION COMV

44 ‘ COMV

47 * DIRECTION FROM TO COMV

48 * ROOM ROOM COMV

49 * COMV

50 ‘ VALL(X,1) VALL(X,2) UALL(X,3) COMV

51 * A3 A3 A3 COMV

52 ‘ ========================================================= COMV

53 * WALL PARAMETERS COMV

54 ‘ COMV

55 * MATERIAL HEIGHT VIDTH LAYER THICKNESS COMV

54 * COMU

57 * VALL(X,4) VDIM<X,1) VDIM(X,2) VDIM(X,3) COMV

58 * A3 FB.2 F8.2 F8.2 COMV

59 COMV

61 INTEGER GETLEN , QU IT , ABORT , ANSWER , OLDF I LE , N, Y 1 , Y2 , L I NE SVALLS

62 INTEGER lERR SWALLS

63 CHARACTER * 7 PFN SVALLS

64 * SWALLS

133
FTN 5.1+552 83/12/24. 11.29.46 PAGE 2 PROGRAM SUALLS 74/175 OPT=0

65 * INITIALIZATION SWALLS

66 QUIT = 0 SWALLS

67 WTOT = 0 SWALLS

68 ABORT = 0 SWALLS

69 100 PRINT* SWALLS

70 PRINT *, 'ENTER BUILDING IDENTIFICATION (E.G. ''lOl'')' SWALLS

71 PRINT *, ' (NO MORE THAN 5 ALPHANUMERIC CHARACTERS)' SWALLS

72 REWIND 1 SWALLS

73 READ(1,*,END=100) BLDG SWALLS

74 SWALLS

75 IP ( GETLEN(BLDG) . GT . 5 ) THEN SWALLS

76 GO TO 100 SWALLS

77 END IF SWALLS

78 PFN = 'B' 11 BLDGCl :GETLEN(BLDG) ) II 'W SWALLS

79 t SWALLS

80 Dr LOAD DATA FROM EXISTING FILE IF NECESSARY SWALLS

81 200 PRINT* SWALLS

82 PRINT*, 'WILL THIS BE' SWALLS

83 PRINT*,' (1) A MODIFICATION OF AN EXISTING FILE?' SWALLS

84 PRINT* ,

' ( 2) A NEW FILE?

SWALLS

85 PRINT*, 'ENTER A NUMBER !!!' SWALLS

86 REWIND 1 SWALLS

87 READ(1,*,END=200) OLDFILE SWALLS

88 IF ( ( OLDFILE .NE. 1 ) .AND. ( OLDFILE . NE . 2 ) ) THEN SWALLS

89 GOTO 200 SWALLS

90 ELSE IF ( OLDFILE . EQ . 1 ) THEN SWALLS

91 t SWALLS

92 ttt CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME SWALLS

93 I ERR = 0 SWALLS

94 CALL PF < 'GET' ,0,PFN(1 ;GETLEN(PFN) )

,

'RC , lERR) SWALLS

95 IF ( lERR .EQ. 2 ) THEN SWALLS

96 PRINT* SWALLS

97 PRINT *, 'FILE ',PFN, ' NOT FOUND' SWALLS

98 PRINT*, ' PROGRAM ABORTED! !!

SWALLS

99 PRINT* SWALLS

100 PRINT*, 'FIND CORRECT BUILDING IDENTIFIER AND RESTART ', SWALLS

101 + 'PROGRAM' SWALLS

1 02 PRINT* SWALLS

103 STOP SWALLS

104 * SWALLS

105 ELSE SWALLS

1 06 CALL LUALL SWALLS

107 IF (WERR .NE. 0) CALL ERROR(5) SWALLS

1 08 END IF SWALLS

109 ELSE IF ( OLDFILE . EQ . 2 ) THEN SWALLS

1 10 * SWALLS

111 nnt CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME SWALLS

1 12 lERR = 0 SWALLS

113 CALL PF (GET' , 0, PFN( 1 :GETLEN(PFN> )

, 'RC ' , lERR) SWALLS

114 IF ( lERR .EQ. 0 ) THEN SWALLS

115 PRINT* SWALLS

116 PRINT*, 'DATA FILE ALREADY EXISTS FOR BUILDING ',BLDG SWALLS

117 PRINT* SWALLS

1 18 PRINT*, 'IF YOU ENTER DATA AND STORE IT, YOU WILL WRITE ', SWALLS

119 + 'OVER THE OLD FILE .

' SWALLS

1 20 250 PRINT* SWALLS

12 1 PRINT*, 'YOU MAY EITHER (1) ABORT OR (2) CONTINUE.' SWALLS

1 22 PRINT* ,' INDICATE YOUR CHOICE BY ENTERING A NUMBER.' SWALLS

123 REWIND 1 SWALLS

124 READ( 1

, * ,END=250> ANSWER SWALLS

125 PRINT* SWALLS

1 26 PRINT*, ' PROGRAM HAS BEEN ABORTED, PER YOUR REQUEST' SWALLS

127 PRINT* SWALLS

1 28 IF ( ANSWER .EQ. 1 ) THEN SWALLS

U

1718

1920

2122

2324

25

26

27

28

2930

3132

3334

3536

37

38

39

40

4142

43

44

4546

4748

4950

5152

5354

5556

57

58

59

60

6162

6364

65

66

67

68

6970

7172

7374

7576

7778

79

134
3

c « 552 83/12/24, 11.29.46 PAGE 3 PROGRAM SUALLS 74/175 OPT=0

129 STOP 3WAL L S 80

1 30 ELSE IF ( ANSWER , EQ . 2 ) THEN SWALLS 81

13 1 9 0 9 0 CONTINUE SWALLS 82

1 32 ELSE SWALLS 83 133 GOTO 250 SWALLS 84

1 34 END IF SWALLS 35 135 ELSE IF ( lERR .EQ. 2 ) THEN SWALLS 36

1 3& t SWALLS 87 137 ft NO DATA FILE EXISTS FOR THIS BUILDING AND DATA ENTRY SWALLS 88

1 3B ft CAN CONTINUE SWALLS 89 139 ft SWALLS 90

1 40 9 0 9 1 CONTINUE SWALLS 91

14 1 ELSE SWALLS 92

1 42 ft SWALLS 93 143 ft ‘‘PERMANENT FILE ERROR SWALLS 94

1 44 ft SWALLS 95 145 PRINT‘ SWALLS 96

1 46 PRINT‘ PROGRAM ABORTED !!!' SWALLS 97 147 PRINT‘,‘ SOME PERMANENT FILE ERROR HAS OCCURRED' SWALLS 98

1 48 PRINT*,' DOUBLE CHECK YOUR BUILDING IDENTIFICATION ', SWALLS 99 149 + 'AND TRY AGAIN' SWALLS 100

150 STOP SWALLS 101

15 1 END IF SWALLS 102 152 PRINT* SWALLS 1 03 153 PRINT*, ' BEGIN ENTERING DATA' SWALLS 104 154 ftft*ftftft*ft**fttft**ftftftft***ft*ft*ft***ft*ft*ftft*ft*ftftllt*ftftAft*ftftftftftftftftft*ftft** SWALLS 1 05 155 ft CHECK TO SEE IF THERE IS ENOUGH ARRAY SPACE SWALLS 106

1 56 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft SWALLS 1 07 157 300 IFIVTOT.GE WMAX) THEN SWALLS 108 158 WTOT = WMAX SWALLS 1 09 159 PRINT *, 'DATA ENTRY ABORTED.' SWALLS 1 10 160 PRINT *, 'MAXIMUM NUMBER OF DATA LINES IN FILE WOULD' SWALLS 1 11 16 1 PRINT *, ' HAVE BEEN EXCEEDED. NO MORE THAN ',WMAX SWALLS 1 12 162 PRINT *, ' DATA LINES ARE ALLOWED.' SWALLS 1 13 163 PRINT *, ' TO INCREASE THE MAXIMUM NUMBER OF ENTRIES ALLOWED,' SWALLS 114 164 PRINT *, CHANGE THE PARAMETER "WMAX" IN EACH COMMON OF' SWALLS 1 15 165 PRINT *, ' EVERY SUBROUTINE (THERE ARE FOUR PLACES).' SWALLS 116 166 PRINT *, ' THEN RECOMPILE THE PROGRAM.' SWALLS 1 17 167 GOTO 45 0 SWALLS 118 168 END IF SWALLS 1 19 169 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft SWALLS 120

1 70 VTOT = WTOT + 1 SWALLS 121

171 IF ( WTOT .EQ. 1) THEN SWALLS 122

1 72 CALL DATA IN( 1 , WTOT) SWALLS 1 23 173 ELSE SWALLS 124

1 74 CALL DATAIN (0,WTOT) SWALLS 1 25 175 END IF SWALLS 126 176 400 PRINT* SWALLS 1 27 177 PRINT*, 'DO YOU WANT TO ENTER MORE DATA?', SWALLS 128 178 + ' ( 1 ) YES (2) NO' SWALLS 1 29 179 PRINT*, ' ENTER A NUMBER !!!' SWALLS 1 30

1 80 REWIND 1 SWALLS 1 31 18 1 READ( 1, *,END=400) ANSWER SWALLS 132 182 IF ( (ANSWER .NE. 1) .AND. (ANSWER .NE. 2) ) THEN SWALLS 1 33 183 GOTO 400 SWALLS 134 184 ELSE IF ( ANSWER .EQ. 1) THEN SWALLS 1 35 185 GOTO 300 SWALLS 136 186 ELSE IF ( ANSWER .EQ. 2 ) THEN SWALLS 1 37 187 PRINT* SWALLS 138 188 PRINT*, 'DATA ENTRY DISCONTINUED' SWALLS 1 39 189 END IF SWALLS 140 190 END IF SWALLS 1 41 19 1

ft SWALLS 1 42 192 ft ft ft MANIPULATE DATA SWALLS 1 43

135
FTN 5,1+552 63/\2l2^. 11.29.46 PAGE 4 PROGRAM SWALLS 74/175 OPT=0

193 450 CALL MANIP (QUIT, ABORT) SWALLS 144 194 * SWALLS 1 45 195 tt (t * TERMINATE PROGRAM, STORING DATA IF NECESSARY SWALLS 146 196 IF ( QUIT .EQ. 1 ) THEN SWALLS 1 47 197 OPEN(UNIT=6 , FILE=PFN( 1 ; GETLEN( PFN) ) , FORM= ' FORMATTED '

,

SWALLS 148 198 + ACCESS='SEQUENTIAL' , STATUS* ' NEW '

>

SWALLS 1 49 199 500 FORMAT ( IX, 4( IX , A3 ) , 3( IX, F8 . 2) ) SWALLS 150 200 DO 600 N = 1 ,WTOT SWALLS 151

20 1 WRITE ( 6 , 500 ) <WALL(N,Y1 ), Y 1 =1 , 4 ) , ( WD IM( N, Y2 ) , Y2 = l,3) SWALLS 152 202 600 CONTINUE SWALLS 1 53 203 ENDFILE(6) SWALLS 154 204

WARNING*

CALL PF ( 'REPLACE' ,0,PFN(1 :GETLEN(PFN) )

)

NUMBER OF ARGUMENTS IN REFERENCE TO _PF IS NOT CONSISTENT

SWALLS 1 55

205 CLOSE(6,STATUS='DELETE'

)

SWALLS 1 56 206 PRINT* SWALLS 157 207 PRINT*, 'DATA HAS BEEN STORED AND PROGRAM TERMINATED' SWALLS 1 58 208 END IF SWALLS 159 209 IF( ABORT EQ. 1 ) THEN SWALLS 1 68 210 PRINT* SWALLS 161 211 PRINT*, 'PROGRAM HAS BEEN ABORTED' SWALLS 1 62 212 PRINT*,' NO DATA HAS BEEN STORED !!!' SWALLS 163 213 END IF SWALLS 1 64 214 STOP SWALLS 165

2 15 END SWALLS 1 66

--VARIABLE MAP--(LO=A)

NAME--- ADDRESS- -BLOCK -PROPERTIES TYPE ---SIZE

ABORT 1216B INTEGER

AFLAG 2B 1 INITILN/ REAL ANSWER 1217B INTEGER

BLDG OB / INITILC/ CHAR*5

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER

I ERR 1 224B INTEGER

LINE NONE UNUSED/*S* INTEGER

N 122 IB INTEGER

NROOMS 1244B /ROOMN/ INTEGER

OLDFILE 1 220B INTEGER PFN 1 225B CHAR*7

QUALITY IB / INITILN/ INTEGER

QUIT 1215B INTEGER RAREA 1 245B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 676

WALL OB /WALLC/ CHAR*3 300

WDIM OB /WALLN/ REAL 225

WERR 34ZB /WALLN/ INTEGER

WTOT 34 IB /WALLN/ INTEGER

Y1 1 222B INTEGER

Y2 1 22 3B INTEGER

--SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

PMAX INTEGER 50 RMAX INTEGER 20 WMAX INTEGER 75

136
FTN J U552 83/12/24. 11.29.46 PAGE 5 PROGRAM SUALLS 74/175 OPT=0

-PROCEDURES--(LO=A)

-NAME TYPE - --ARGS CLASS -NAME ---TYPE ARG3--- CLASS

DATAIN 2 SUBROUTINE LWALL 0 SUBROUTINE

ERROR 1 SUBROUTINE MAN IP 2 SUBROUTINE

CETLEN INTEGER 1 FUNCTION PF 5 SUBROUTINE

-STATEMENT LABELS--! L0=A) -LABEL- ADDRESS-- PROPERTIES- ---DEF

100 2 IB 69 200 47B 81 250 166B 120 300 246B 157 400 30 6B 176

-ENTRY POINTS--! LO = A) -NAME-- -ADDRESS- -ARCS

SWALLS 14B 0

-I 10 UNITS--(L0=A)

-NAME--- PROPERTIESTAPEl FMT/SEQ

TAPE6 AUX/FMT/SEQ

-LABEL -ADDRESS --PROPERTIES--- -DEF

450 344B 1 93 500 714B FORMAT 199 600 INACTIVE DO-TERM 202

9090 »NO REFS* 131 9091 *NO REFS* 1 40

-STATISTICS--

PROGRAM-UNIT LENGTH 1231B = 665

CM LABELLED COMMON LENGTH 205 7B = 1071 CM STORAGE USED 63000B = 2611

COMPILE TIME 0.317 SECONDS

1 WARNING ERROR IN SWALLS

137
FTN 5.U552 S3mi2A. 11.Z9.46 PAGE 6 SUBROUTINE DATAIN 74/175 OPT=0

1

2

3

45

6

78

9 10

1112

1314

1516

1718

1920

2122

2324

2526

2728

2930

3132

3334

35

36

37

3839

40

4142

4344

4546

4748

4950

5152

53

54

5556

5758

59

60

6162

6364

SUBROUTINE DATAIN ( INSERT , L INE ) SWALLS

***it «** **«ik***«**ikit***)t««i A** *lt***<i***«*****«***«***<Mt********** *COMR

*** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

**iit**«4ninli «:** *«***»*«*il[*«*«i«******«*«******«*«***lt««t******<t*lt*ilt«[*«***COMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR COMMON /ROOMN/ ROOM(RMAX + 6, RMAX + 6), NHOOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

***ii***ii**ii*ii*ii*iiii*tt**t**t**t**iitt*ii*ii**ii*t**tiitttt*****tt***ttt***tit * * COMR

*iiiit****1i*1i**1i****1i*1i*t**t1it*t1l*1i**t***fkt****ttt*1i*t1tt*t*t1c**1t*1(****1t * * COMR

*** COMMON FOR DATABASE OF WALL PARAMETERS ***COMW

INTEGER WMAX COMW

PARAMETER (WMAX = 75) COMW

COMMON /WALLN/ WD IM ( WMAX , 3 ) , WTOT , WERR COMW

COMMON /WALLC/ WALL (WMAX, 4) COMW

INTEGER WTOT, WERR COMW

REAL WDIM COMW

CHARACTER *3 WALL COMW

* ================================= COMW

** DESCRIPTION OF ARRAYS COMW

* ================================= COMW

* WALL IDENTIFICATION COMW

* - COMW

* DIRECTION FROM TO COMW

* ROOM ROOM COMW

* COMW

* WALL(X,1) WALL (X, 2) WALL (X, 3) COMW

* A3 A3 A3 COMW

* ========================================================= COMW

* WALL PARAMETERS COMW

* COMW

* MATERIAL HEIGHT WIDTH LAYER THICKNESS COMW

* COMW

* WALL(X,4) WDIM(X,1) WDIM(X,2) WDIM(X,3) COMW

» A3 FB.2 F8.2 F8.2 COMW

**lit**ii*tli*li*lit*litli*t*tl(tli**iiiili*liii*li*it**iit**ii***t*****1i*1iiilitini******lit * * COMW

<i)k*tir*4l*fi*lt*4i*ltA<i*tllt****4t***k***«Mtiiifttt filtktt** <i)t*<ilt**A*)k***rlt******A*Alt* Ik COMW

INTEGER ANSWER, LOK,DOK,NOK,GETLEN,VAL, INSERT, LINE ,V SWALLS

CHARACTER *3 D IR , FROM , TO , MAT SWALLS

99 IF ( INSERT .EQ. 1 ) THEN SWALLS

ANSWER = 1 SWALLS

INSERT = 1 SWALLS

ELSE SWALLS

100 PRINT* SWALLS

PRINT*, 'IS THIS THE FIRST LAYER OF A WALL (1) YES (2) NO' SWALLS

PRINT*, ENTER "0" TO ESCAPE "DATA ENTRY" MODE' SWALLS

PRINT*, ' ENTER A NUMBER!!' SWALLS

REWIND 1 SWALLS

READ( 1

, * ,END=100) ANSWER SWALLS

END IF SWALLS

* SWALLS

IF (ANSWER .EQ. 0) THEN SWALLS

WTOT = WTOT - 1 SWALLS

PRINT* SWALLS

PRINT*, 'DATA ENTRY MODE ABORTED' SWALLS

END IF SWALLS

IF ((ANSWER NE. 2) SWALLS

+ .AND. (ANSWER .NE. 1) SWALLS

+ .AND. (ANSWER . NE . 0)) THEN SWALLS

PRINT* SWALLS

PRINT*, ' INCORRECT NUMBER! !

' SWALLS

167

1

2

3

4

5

6

7

8

9 10

1

2

3

4

5

6

7

8

9 10

1112

1

3

14

1516

1718

1920

2122

2324

25

26

2728

29 170

171 172

1 73 174

1 75 176

1 77 178

1 79 180

181 182

1 83 184

1 85 186

1 87 188

1 89 190

191 192

1 93

138
rTN 5 U552

SUBROUTINE OATAIN

83/12/24. 11.29.44 PAGE

74/175 OPT=0

7

45 PRINT*, ' TRY AGAIN!! -OR- ENTER "0" TO ESCAPE DATA ENTRY MODE'SWALLS 194

44 GOTO 99 SWALLS i 9 5 47 END IF SWALLS 194

46 IF (ANSWER EQ. 1) THEN SWALLS 1 97

49 20 0 PRINT* SWALLS 198

70 PRINT*, 'ENTER DIRECTION (E. G. ’’LR'')' SWALLS 1 99

71 REWIND 1 SWALLS 200

72 READ(1,*,END=200) DIR SWALLS 2 01 73 IF ((DIR .NE. 'LR') SWALLS 202

74 + .AND. (DIR .NE. ' FB '

)

SWALLS 2 03

75 + AND . (DIR .NE . ' UD ' )

)

THEN SWALLS 204

74 PRINT*, 'DIRECTION MUST BE '' LR '

' OR '' FB ' ' OR ' ' UD' '

SWALLS 2 05 77 PRINT* , 'TRY AGAIN! !

!

SWALLS 206

78 GOTO 200 SWALLS 2 07

79 END IF SWALLS 208

SO WALL(LINE,1) = DIR SWALLS 209

81 t SWALLS 2 1 0 82 300 PRINT* SWALLS 2 11 83 PRINT*, 'ENTER "FROM" (E.G. ''02'' OR ''Dl'')' SWALLS 2 1 2 84 REWIND 1 SWALLS 2 13 85 READ( 1

, *, END=300) FROM SWALLS 2 1 4 84 LOK = 0 SWALLS 2 15 87 DOK = 0 SWALLS 214

88 NOK = 0 SWALLS 2 17 89 IF (GETLEN(FROM) . EQ . 2) THEN SWALLS 2 1 8 90 LOK = 1 SWALLS 2 19 91 END IF SWALLS 220

92 IF ( FROM( 1:1) . EQ. 'D' ) THEN SWALLS 221

93 V = VAL(FROM(2 : 2) ) SWALLS 222

94 IF ((V .GE. I) .AND. (V .LE. 4>) THEN SWALLS 223

95 DOK = 1 SWALLS 224

94 END IF SWALLS 2 25

97 END IF SWALLS 224

98 IF ( ( ICHAR(FROM(

1

: 1 ) ) . GE . 14) SWALLS 227

99 + .AND. ( ICHAR(FROM(

1

: 1 ) ) .LE. 25) SWALLS 228

1 00 f AND. ( ICHAR (FROM(2 ; 2) ) . GE . 14) SWALLS 2 29

10 1 + .AND. ( ICHAR(FROM(2 : 2) ) . LE . 25) SWALLS 230

1 02 + .AND. (GETLEN(FROM) . EQ . 2)) THEN SWALLS 2 31 103 V = VAL(FROM) SWALLS 232

104 IF ((V GE. 1) AND. (V . LE

.

RMAX)) THEN SWALLS 2 33 105 NOK = 1 SWALLS 234

104 END IF SWALLS 2 35 107 END IF SWALLS 234

108 IF ((LOK .EQ. 1) .AND. ((DOK . EQ . 1 ) OR. (NOK . EQ. 1))) THEN SWALLS 237

109 WALL(LINE,2) = FROM SWALLS 238 no ELSE SWALLS 2 39

11 1 PRINT* SWALLS 240

1 12 PRINT*, 'INCORRECT ENTRY. TRY AGAIN!!' SWALLS 241 113 GOTO 300 SWALLS 242

114 END IF SWALLS 2 43 115 * SWALLS 244

114 400 PRINT* SWALLS 2 45 117 PRINT*, 'ENTER "TO" (E.G. ''02'' OR ''Dl'')' SWALLS 244

1 18 REWIND 1 SWALLS 2 47 119 READ( 1

, * , END=400 ) TO SWALLS 248

1 20 LOK = 0 SWALLS 2 49

12 1 DOK = 0 SWALLS 250

122 NOK = 0 SWALLS 2 51 123 IF (GETLEN(TO) . EQ

.

2) THEN SWALLS 252

1 24 LOK = 1 SWALLS 253

125 END IF SWALLS 254

124 IF (TO(

1

: 1 ) . EQ. 'D ' ) THEN SWALLS 255

127 V = VAL(TO(

2

; 2) ) SWALLS 254 128 IF ((V .GE. 1) AND. (V . LE

.

4)) THEN SWALLS 257

139
FTN 5.1+552 83/12/24. 11.29.46 PAGE 8 SUBROUTINE DATAIN 74/175 OPT=0

129 DOK = 1 SWALLS 258

1 30 END IF SWALLS 259

131 END IF SWALLS 260

132 IF ( ( ICHARITOd ; 1 ) ) GE. 16) SWALLS 261 133 + .AND. ( ICHAR(TO( 1 : 1) ) . LE

.

25) SWALLS 262

1 34 + .AND. <ICHAR(TO(2:2)) .GE. 16) SWALLS 263

135 + AND. ( ICHAR(TO(2 : 2) ) . LE

.

25) SWALLS 264

136 + .AND. (GETLEN(TO) .EQ. 2)) THEN SWALLS 265 137 V = VAL (TO) SWALLS 266

1 38 IF <(V .GE. 1) .AND. (V LE. RMAX)) THEN SWALLS 267

139 NOK = 1 SWALLS 268 140 END IF SWALLS 269

14 1 END IF SWALLS 270

1 42 IF ((LOK .EQ. 1) AND. ((DOK . EQ. 1) .OR. (NOK .EQ. 1))) THEN SWALLS 271 143 WALL (LINE, 3) = TO SWALLS 272 144 ELSE SWALLS 273

145 PRINT* SWALLS 274

146 PRINT*, ‘INCORRECT ENTRY. TRY AGAIN!!' SWALLS 275

147 GOTO 400 SWALLS 276

148 END IF SWALLS 277

149 IF (FROM .EQ. TO) THEN SWALLS 278 150 PRINT* SWALLS 279

15 1 PRINT*, 'INCORRECT ENTRY!!' SWALLS 280

152 PRINT*, ‘"FROM" CANNOT EQUAL "TO" ' SWALLS 281 153 PRINT*, 'CHECK YOUR DATA AND REENTER "FROM" AND "TO"' SWALLS 282

154 PRINT* SWALLS 283

155 GOTO 300 SWALLS 284

156 END IF SWALLS 285

157 IF ((FROM(l:l) .EQ. 'D' ) .AND . (TOd : 1 ) . EQ. 'D' ) ) THEN SWALLS 286 158 PRINT* SWALLS 287

159 PRINT*, ' INCORRECT ENTRY! !

SWALLS 288

160 PRINT*, ‘"FROM" AND "TO" CANNOT BOTH CONTAIN "D"

SWALLS 289

16 1 PRINT*, ‘ CHECK YOUR DATA AND REENTER "FROM" AND "TO"' SWALLS 290

162 PRINT* SWALLS 291 163 GOTO 300 SWALLS 292 164 END IF SWALLS 293

165 * SWALLS 294

166 440 PRINT* SWALLS 295

167 PRINT*, 'ENTER HEIGHT, METERS' SWALLS 296 168 REWIND 1 SWALLS 297

169 READ(1,*,END=440) WDIM(LINE,1) SWALLS 298

170 * SWALLS 299

17 1 460 PRINT* SWALLS 300

172 PRINT*, 'ENTER WIDTH, METERS' SWALLS 301 173 REWIND 1 SWALLS 302

174 READ(1,*,END=460) WDIM(LINE,2) SWALLS 303

175 * SWALLS 304

176 480 PRINT* SWALLS 305

177 PRINT*, 'ENTER THICKNESS OF LAYER, CENTIMETERS' SWALLS 306 178 REWIND 1 SWALLS 307

179 READ( 1

, * , END=480 ) WDIM(LINE,3) SWALLS 308 180 * SWALLS 309

18 1 500 PRINT* SWALLS 310

182 PRINT*, 'ENTER "MATERIAL ID" (E.G. ''MOl'')' SWALLS 311 183 REWIND 1 SWALLS 312 184 READd ,*,END = 500 ) MAT SWALLS 3 13 185 IF ( (GETLEN(MAT) . EQ. 3) SWALLS 314

186 + AND. (MAT(1:1) . EQ . 'M') SWALLS 3 15 187 + .AND. (ICHAR(MAT(2:2) ) .GE. 16) SWALLS 316

188 + .AND. ( ICHAR(MAT(2 : 2 ) ) LE. 25) SWALLS 317 189 + AND. ( ICHAR(MAT(3 : 3) ) .GE. 16 ) SWALLS 318

1 90 + .AND. ( ICHAR(MAT(3 : 3 ) ) . LE

.

25)) THEN SWALLS 319

19 1 WALL(LINE,4) = NAT SWALLS 320

192 ELSE SWALLS 321

140
rxN 5 i»55:

SUBROUTINE DATAIN

8 3 / 1 2 / 2 4 . 1 1.2 9.46 PAGE

74/175 OPT=0

9

193 PRINT* SVALLS 322

194 PRINT*, 'INCORRECT ENTRY! I TRY AGAIN' SWALLS 3 23 195 GOTO 500 SWALLS 324

196 END IF SWALLS 3 25 197 END IF SWALLS 326

1 98 • SWALLS 3 27 199 IF (ANSWER .EQ.2) THEN SWALLS 323

200 580 PRINT* SWALLS 329

20 1 PRINT*, 'ENTER THICKNESS OF LAYER, CENTIMETERS' SWALLS 330

202 REWIND 1 SWALLS 3 31 203 READ( 1

, * , END=580 ) WDIMCLINE ,3) SWALLS 332

204 t SWALLS 3 33 205 600 PRINT* SWALLS 334

206 PRINT*, 'ENTER "MATERIAL ID II (E .G. ' 'MOl ' ) SWALLS 3 3; 207 REWIND 1 SWALLS 336 208 READ(1,*,END=600) MAT SWALLS 3 37 209 IF ( (GETLEN(MAT) .EQ. 3) SWALLS 338

2 10 AND. (MAT(1;1) .EQ. 'M' ) SWALLS 339

211 .AND. (ICHAR(MAT(2;2) ) . GE . 16) SWALLS 340

2 12 AND. ( ICHAR(MAT(2 ; 2) ) . LE . 25) SWALLS 341 213 + AND. ( ICHAR(MAT( 3 : 3) ) . GE . 16) SWALLS 342

2 14 .AND. ( ICHAR(MAT(3 ; 3) ) . LE . 25)) THEN SWALLS 3 43 215 WALL (LINE, 4) = MAT SWALLS 344

2 1 6 ELSE SWALLS 3 45 217 PRINT* SWALLS 3 46

2 18 PRINT*, 'INCORRECT ENTRY! ! TRY AGAIN' SWALLS S’?? 219 GOTO 600 SWALLS 343

220 END IF SWALLS 3 49 22 1 VALL(LINE,3) = VALL(LINE-1, 3) SWALLS 350 222 VALL(LINE,2) = WALL(LINE-1, 2) SWALLS 3 51 223 VALL(LINE,n = VALL(LINE-1, 1) SWALLS 352

224 WDIM(LINE,1) = VDIM(LINE-1, 1

)

SWALLS 353

225 VDIM(LINE,2) = WDIM(LINE-1, 2) SWALLS 354

226 END IF SWALLS 355 227 RETURN SWALLS 356 228 END SWALLS 3 57

VARIABLE MAP-- (LO=A)

•NAME ADDRESS --BLOCK PROPERTIES TYPE - ---SIZE

ANSWER 1 43 4B INTEGER

DIR 1441B CHAR*3

DOK 1 43 6B INTEGER

FROM 1 44 2B CHAR*3

INSERT 1 DUMMY-ARG INTEGER

LINE 2 DUMMY-ARG INTEGER

LOK 143SB INTEGER

MAT 1 444B CHAR*

3

NOK 1 43 7B INTEGER

NROOMS 1 2 4 4B /ROOMN/ INTEGER RAREA 1 245B /ROOMN/ REAL 20 ROOM OB /ROOMN/ REAL 676 TO 1 44 3B CHAR»3

V 1 440B INTEGER

WALL 06 /WALLC/ CHAR»3 300

WDIM OB /WALLN/ REAL 225 WERR 34 26 /WALLN/ INTEGER

WTOT 34 IB /WALLN/ INTEGER

141
fTN 5 . 1+S52

SUBROUTINi; DATA IN 83/12/24. 11,29.46 PAGE74/175 OPT=0

10

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

RMAX INTEGER 20 WMAX INTEGER 75

-PROCEDURES--(LO=A)

-NAME TYPE- ARGS CLASS

CETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

VAL INTEGER 1 FUNCTION

-STATEMENT LABELS-- ( LO=A

)

-LABEL- ADDRESS-- ---PROPERTIES--- -DEF -LABEL -ADDRESS------PROPERTIES DEF

99 7B 43 460 477B 171 100 16B 47 480 513B 176 200 70B 6 9 500 52 7B 181 300 127B 32 580 615B 200 400 264B 116 600 63 IB 205

440 463B 166

-ENTRY POINTS--! LO = A) -NAME-- -ADDRESS- -ARGS---

DATA IN SB 2

-I/O UNITS--(LO=A)

-NAME--- PROPERTIES

TAPEl FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 1 4 4 7B = 807 CM LABELLED COMMON LENGTH 1 76 6B = 10 14 CM STORAGE USED 63000B = 26112

COMPILE TIME 0 4 36 SECONDS

142
FTN 5 l«552

SUBROUTINE MANIP

83/12/24 11.29.46 PAGE

74/175 OPT=0

1 1

1

2

3

4

5

67

B

9

1 0 111213

14

15

16

17

18

1920

2122

2324

2526

2728

29

30

3132

3334

SUBROUTINE MANIP (QUIT, ABORT) SUALLS

tMtttittit»tii»ii*ttiii*iiiiii**tiitt**ii*ttit*t*t*tt*tli*****itt*tt********t*ii**tt*t * COKU

••• COMMON FOR DATABASE OF WALL PARAMETERS **»COMV

• •*«**t(ii*******«i«*«*ii****« »t)k** ***)t »** *«*****«« «t** ***)i*** <m<COMU INTEGER UMAX

PARAMETER (UMAX = 75)

COMMON /WALLN/ WD IM ( WMAX , 3 ) , WTOT, VERR

COMMON /WALLC/ WALL (WMAX, 4) INTEGER WTOT.WERR

REAL WDIM

CHARACTER *3 WALL

» DESCRIPTION OF ARRAYS

WALL IDENTIFICATION

DIRECTION FROM

ROOM

TOROOM

WALL (X , 1

)

A3

WALL(X,2)

A3 WALL(X,3)A3

WALL PARAMETERS

MATER lAL HEIGHT WIDTH LAYER THICKNESS

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

WALL(X,4) WDIM(X,1) WDIM(X,2) WDIM(X,3)

A3 F8 . 2 F8 . 2 F8 . 2 **«*tlt**ilM)*tlK***A***ilMt***)t***1i*4t*<i**f(lt**ltAlt*1t*ikIkt*ltA*A******lt*1kA*lt)k**lt* COMW

* * * * It * * t t * * t h t * 1 1 1 * * t * t * * * t* It * * 1 1 1 1 1 * * t It * * It * * t * * 1 1 * * * t * h h h * 1 1 1 * 1 1 1 1 1 * t * My

INTEGER ABORT,ANSWER,DOK, FLAGl , LOK , N, NOK , OK , OK 1 , OK2 , QU IT , INSERT SWALLS

INTEGER TEMP, V,X,Y, COMMAND SWALLS

CHARACTER * 3 DIR, FROM, TO, MAT SWALLS

SWALLS

358

1

2

3

4

5

9 10

1112

13

1 4 1516

17

18

1?20

2122

23

24

2526

2728

29 360

3 61 362

363

35 10 FLAGl = 0 SWALLS : 44 36 PRINT* SWALLS 365

37 PRINT*, 'CHOOSE' SWALLS 366

38 PRINT*, ' (1) DISPLAY LINE OF DATA (4) DISPL.AY ALL LINES' SWALLS 367

39 PRINT*, ' (2) INSERT LINE INTO FILE (5 ) APPEND LINES OF DATA' SWALLS 368

40 PRINT*, ' (3) DELETE LINE ( 6 ) STORE DATA AND EXIT '

,

SWALLS 369

41 + 'PROGRAM' SWALLS 370

42 PRINT*, ' (7) EXIT PROGRAM WITHOUT ' , SWALLS 3 71 43 ' STORING DATA

SWALLS 372

44 PRINT*, 'ENTER A NUMBER !!!' SWALLS 373

45 PRINT* SWALLS 374

46 REWIND 1 SWALLS 3 75

47 READ(1,*,END=10) COMMAND SWALLS 376

48 t SWALLS 3 77

49 t SWALLS 378

SO *** DISPLAY LINE *** SWALLS 3 79

51 t SWALLS 380

52 IF ( COMMAND . EQ . 1 ) THEN SWALLS 381

53 t SWALLS 382

54 *** INDICATE EMPTY DATA FILE SWALLS 383

55 IF ( WTOT ,EQ. 0 ) THEN SWALLS 354

56 PRINT* SWALLS 385

57 PRINT*, 'DATA FILE IS EMPTY !!!' SWALLS 386

58 * SWALLS 3 87 59 *** ENTER NUMBER OF LINE TO BE DISPLAYED SWALLS 388

60 ELSE SWALLS 3 89

61 100 PRINT* SWALLS 390

62 PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DISPLAYED' SWALLS 391

6364 PRINT*

,

REWIND 1

( ENTER "0" TO ESCAPE DISPLAY MODE ) SWALLS

SWALLS

392

393

143
FTN 5 , 1+552 12 SUBROUTINE MANIP

53ti2IZi

.

11.29.46 PAGE

74/175 OPT=0

65 READ(1,*,END=100) N SWALLS 394

66 SWALLS 3 95 67 tt * CHECK VALIDITY OF LINE NUMBER SWALLS 396

68 IP ( (N GT. WTOT) .OR. (N .LT. 0) ) THEN SWALLS 3 97 69 PRINT* SWALLS 398

70 PRINT*, ‘ INCORRECT NUMBER !!!!!! TRY AGAIN !!!' SWALLS 3 99

71 PRINT*, ' -OR- ENTER "0" TO ESCAPE FROM SWALLS 400

72 +

‘ "DISPLAY" MODE

SWALLS 401

73 GOTO 100 SWALLS 402

74 * SWALLS 4 03 75 * ABORT ‘DISPLAY’ MODE SWALLS 404

76 ELSE IF ( N EQ. 0 ) THEN SWALLS 4 05 77 PRINT* SWALLS 406

78 PRINT*, ' "DISPLAY" MODE ABORTED !!!' SWALLS 4 07

79 t SWALLS 408

80 K tt DISPLAY LINE OF DATA SWALLS 4 0?

81 ELSE IF ( (N GT. 0) AND. (N LE. WTOT) ) THEN SWALLS 410

82 PRINT* SWALLS 4 11 83 CALL DISPLAY! N, COMMAND) SWALLS 412

84 A SWALLS 4 13 85 END IF SWALLS 414

86 END IF SWALLS 4 15 87 END IF SWALLS 416

88 * SWALLS 4 17 89 * SWALLS 418

90 * A fc INSERT LINE *** SWALLS 4 19 91 t SWALLS 420

92 IF ( COMMAND . EQ . 2 ) THEN SWALLS 421

93 SWALLS 422

94 CHECK TO SEE IF THERE IS ENOUGH ARRAY SPACE SWALLS 423

95 SWALLS 424

96 IF(VTOT. GE .VMAX) THEN SWALLS 4 25 97 WTOT = WMAX SWALLS 426

98 PRINT *, 'DATA ENTRY ABORTED.' SWALLS 4 27

99 PRINT *, 'MAXIMUM NUMBER OF DATA LINES IN FILE WOULD' SWALLS 428

100 PRINT *, ' HAVE BEEN EXCEEDED NO MORE THAN ',WMAX SWALLS 4 29

10 1 PRINT *, ' DATA LINES ARE ALLOWED.' SWALLS 430

102 PRINT *, ' TO INCREASE THE MAXIMUM NUMBER OF ENTRIES ALLOWED,' SWALLS 4 31 103 PRINT *, ' CHANGE THE PARAMETER "WMAX" IN EACH COMMON OF' SWALLS 432

104 PRINT *, ' EVERY SUBROUTINE (THERE ARE FOUR PLACES).' SWALLS 433

105 PRINT *, ' THEN RECOMPILE THE PROGRAM.' SWALLS 434

106 GOTO 10 SWALLS 4 35 107 END IF SWALLS 436

108 AA*****A***AAAA**tAAAA***AA*tAAAAA*tA*AtA*t***A*AAftAfttAA**AAA* SWALLS 4 37 109 * SWALLS 438

110 * ** INDICATE EMPTY DATA FILE SWALLS 439

11 1 IF ( WTOT .EQ. 0 ) THEN SWALLS 440

1 12 PRINT* SWALLS 441 113 PRINT*, 'DATA FILE IS EMPTY !!!' SWALLS 442

1 14 t SWALLS 4 43 115 AAA REQUEST NUMBER OF LINE BEFORE WHICH INSERTION IS TO BE MADE SWALLS 444

1 16 ELSE SWALLS 4 45 117 200 PRINT* SWALLS 446 118 PRINT*, 'SPECIFY NUMBER OF LINE BEFORE WHICH A NEW LINE IS '

, SWALLS 4 47 119 + 'TO BE INSERTED' SWALLS 448

1 20 PRINT*, ' ( ENTER "0" TO ESCAPE "INSERTION" MODE )' SWALLS 4 49

12 1 REWIND 1 SWALLS 450

1 22 READ(1,*,END=200) N SWALLS 451 123 A SWALLS 452

1 24 AAA CHECK FOR VALID LINE NUMBER SWALLS 453

125 IF ( ( N .LT. 0 ) .OR. ( N . GT . WTOT ) ) THEN SWALLS 454

126 PRINT* SWALLS 455

127 PRINT*, ' INCORRECT NUMBER !!!' SWALLS 456

128 PRINT*, ' TRY AGAIN !!! -OR- ENTER "0" TO ESCAPE', SWALLS 457

144
rXN 5 U5 52 83 / 1 2 / 24. 1 1 ,29.46 PAGE 13 SUBROUTINE MANIP 74/175 OPT=0

129 + '"INSERTION" MODE' SWALLS 458

1 30 GOTO 200 SWALLS 4 5?

13 1 t SWALLS 460

1 32 « t « ABORT INSERTION MODE SWALLS 461 133 ELSE IF ( N ,EQ. 0 ) THEN SWALLS 462

1 34 PRINT* SWALLS 4 63 135 PRINT*, ' “INSERTION" MODE ABORTED' SWALLS 464

1 3& t SWALLS 4 65 137 At* MAKE ROOM FOR NEW LINE OF DATA SWALLS 466

1 3S ELSE IF ( (N .GT. 0) .AND. (N .LE. WTOT) ) THEN SWALLS 467

139 DO 230 X = WTOT, N, -1 SWALLS 468

1 40 DO 210 Y = 1,4 SWALLS 4 69

14 1 WALL(X+1,Y) = WALL(X,Y) SWALLS 470

142 2 10 CONTINUE SWALLS 4 71 143 DO 220 Y = 1,3 SWALLS 472

144 WDIM(X+1 , Y) = WDIMCX ,Y) SWALLS 4 73 145 220 CONTINUE SWALLS 474

146 230 CONTINUE SWALLS 475

147 A SWALLS 476

1 48 AAA ENTER DATA FOR NEW LINE SWALLS 4 77 149 WTOT = WTOT + 1 SWALLS 47 8 ISO CALL DATAIN (1,N) SWALLS 4 79

15 1 A SWALLS 480

152 AAA INITIALIZE FLAGS SWALLS 4 81 153 OKI = 0 SWALLS 482

154 OK2 = 0 SWALLS 483

155 OK = 0 SWALLS 434

1 56 A SWALLS 4 85 157 AAA TEST VALIDITY OF DATA SWALLS 486

1 58 A SWALLS 487

159 **»TEST IF NEW LAYER BELONGS TO THE NEXT WALL SWALLS 488

160 IF ( ( WALLIN, 1) ,EQ. WALL(N+1,1) ) SWALLS 489

16 1 + AND. ( WALLIN, 2) . EQ . WALLIN+1,2) ) SWALLS 490

1 62 + .AND. I WALLIN, 3) EQ. WALLIN+1,3) ) ) THEN SWALLS 4 91 163 IF I I WDIMIN,!) EQ. WDIMIN+1,1) > SWALLS 492

164 + AND. I WDIMIN, 2) .EQ. WDIMIN+1,2) ) ) THEN SWALLS 493

165 OKI = 1 SWALLS 494

166 END IF SWALLS 4 95 167 END IF SWALLS 496

1 68 A SWALLS 4 97 169 AAA TEST IF NEW LAYER BELONGS TO PREVIOUS WALL SWALLS 4 98

1 70 IF I N .GT, 1 ) THEN SWALLS 4 99

17 1 IF I I WALLIN,!) .EQ. WALLIN-1,1) ) SWALLS 500

1 72 + AND. I WALLIN, 2) .EQ. WALLIN-1,2) ) SWALLS 5 01 173 + .AND. I WALLIN, 3) . EQ , WALLIN-1,3) ) ) THEN SWALLS 502

174 IF I I WDIMIN,!) .EQ. WDIMIN-1,1) ) SWALLS 503

175 + AND. I WDIMIN, 2) .EQ. WDIMIN-1,2) ) ) THEN SWALLS 504

1 76 OK2 = 1 SWALLS 505

177 END IF SWALLS 506

178 END IF SWALLS 507

179 END IF SWALLS 508

1 80 A SWALLS 509

18 1 IF I I OKI .EQ. 1 ) .OR. I OK2 . EQ . 1 ) ) THEN SWALLS 510

182 OK = 1 SWALLS 5 1

1

183 END IF SWALLS 5 1 2

1 84 A SWALLS 5 13 185 IF I OK .EQ. 1 ) THEN SWALLS 5 1 4 186 PRINT* SWALLS 5 15 187 PRINT*, 'THE FOLLOWING LINE HAS BEEN ADDED AS LINE ' , N SWALLS 5 1 6 188 CALL DISPLAY! N, COMMAND) SWALLS 5 17 189 A SWALLS 518

190 AAA REJECT DATA IF DATA DOESN'T MATCH PREVIOUS OR NEXT LAYER SWALLS 5 19 19 1 ELSE IF I OK .EQ. 0 ) THEN SWALLS 520

1 92 PRINT* SWALLS 5 21

145
FTN 5 1+552

SUBROUTINE MAN IP 83/12/24. 11 .29,46 PAGE 74/175 OPT=0

14

1 93 PRINT*, 'YOUR DATA WAS NOT ACCEPTED !!!' SWALLS 522

194 PRINT*, YOUR DATA MUST REPRESENT A LAYER 1 SWALLS 5 23 195 + ' IN AN EXISTING WALL' SWALLS 524

196 PRINT*, ' I.E. THE DIRECTION, FROM, TO, HE ICHT, AND '

,

SWALLS 5 25 197 + 'WIDTH' SWALLS 526

1 98 PRINT*, ' PARAMETERS MUST MATCH THE WALL JUST ', SWALLS 5 27 199 + 'BEFORE' SWALLS 528 200 PRINT*, ' OR JUST AFTER YOUR SPECIFIED INSERTION ' , SWALLS 529

20 1 + 'POINT' SWALLS 530 202 PRINT* SWALLS 5 31 203 PRINT*, 'THE FOLLOWING DISPLAYS' SWALLS 532 204 IF ( N GT. 1 ) PRINT*, 'THE LINE BEFORE YOUR LINE,

SWALLS 5 33 205 PRINT*, 'YOUR LINE, AND THE LINE AFTER' SWALLS 534

206 PRINT* SWALLS 5 35 207 * SWALLS 536 208 A A * DISPLAY LINES OF DATA SWALLS 5 37 209 IF ( N GT. 1 ) CALL DISPLAY ( N- 1 , COMMAND ) SWALLS 538

2 10 CALL DISPLAY( N, COMMAND) SWALLS 5 39

21 1 CALL DISPLAY ( N+ 1 , COMMAND) SWALLS 540

2 12 A SWALLS 5 41 213 AAA REMOVE THE LINE OF INCORRECTLY ENTERED DATA SWALLS 542 214 DO 270 X = N,WTOT SWALLS 5 43 215 DO 250 Y = 1 ,

4

SWALLS 544

2 16 WALL (X , Y) = WALL (X+1 , Y) SWALLS 5 45 217 250 CONTINUE SWALLS 546

2 18 DO 260 Y = 1 ,

3

SWALLS 5 47 219 WDIM(X,Y) = WDIM(X+1,Y) SWALLS 548 220 260 CONTINUE SWALLS 5 49

22 1 270 CONTINUE SWALLS 550 222 WTOT = WTOT - 1 SWALLS 551 223 END IF SWALLS 552 224 END IF SWALLS 553 225 END IF SWALLS 554

226 END IF SWALLS 5 55 227 A SWALLS 556 228 A SWALLS 557 229 AAA DELETE LINE *** SWALLS 558 230 A SWALLS 55?

23 1 IF ( COMMAND EQ. 3 ) THEN SWALLS 560 232 A SWALLS 561 233 AAA INDICATE EMPTY DATA FILE SWALLS 562 234 IF ( WTOT .EQ. 0 ) THEN SWALLS 563

235 PRINT* SWALLS 564

236 PRINT*, 'DATA FILE IS EMPTY !!!' SWALLS 5 65 237 A SWALLS 566 238 A AA READ NUMBER OF LINE TO BE DELETED SWALLS 5 67 239 ELSE SWALLS 568 240 300 PRINT* SWALLS 5 69 24 1 PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DELETED' SWALLS 570 242 PRINT*, ' (ENTER "0" TO ESCAPE DELETION MODE)' SWALLS 571 243 REWIND 1 SWALLS 572

2 44 READ( 1

, * ,END=300) N SWALLS 5 73

24 5 A SWALLS 574 246 AAA CHECK VALIDITY OF LINE NUMBER SWALLS 575 247 IF ( (N ,GT. WTOT ) .OR. ( N . LT . 0 ) ) THEN SWALLS 576 248 PRINT* SWALLS 5 77 249 PRINT*, ' INCORRECT NUMBER !!!' SWALLS 578 250 PRINT*, ' TRY AGAIN !!! -OR- ENTER "0" TO ESCAPE FROM' , SWALLS 5 79 25 1 + '"DELETE" MODE' SWALLS 580 252 GOTO 300 SWALLS 581 253 A SWALLS 582 254 AAA ABORT 'DELETE' MODE SWALLS 583 255 ELSE IF ( N .EQ. 0 ) THEN SWALLS 584 256 PRINT*, ' "DELETE" MODE ABORTED' SWALLS 585

146
TTN 5 U5 52 SUBROUTINE NANIP

83/12/24. 11 .29.46 PAGE

74/175 OPT=0

15

257 t SWALL3 5 8 6 258 ft « t DOUBLE CHECK CHOICE OP LINE TO BE DELETED SWALLS 5 87

25 9 ELSE IF (( N .GT. 0 ) AND. ( N . LE

.

WTOT )) THEN SWALLS 588

260 PRINT* SWALLS 5 89

26 1 PRINT* , 'DOUBLE CHECK ! !

!

SWALLS 590

262 PRINT*, DO YOU WANT TO DELETE THE FOLLOWING LINE? :SWALLS 5 91 263 CALL DISPLAY! N, COMMAND) SWALLS 592

2 64 305 PRINT*, ' ENTER (1) YES OR (2) NO' SWALLS 5 93 265 REWIND 1 SWALLS 594

266 READ! 1

, * ,END=305) ANSWER SWALLS 5 95 267 ft SWALLS 596

268 ft ft ft DELETE LINE SWALLS 5 97 269 IF ! ANSWER . EQ . 1 ) THEN SWALLS 598

270 DO 330 X = N, WTOT - 1 SWALLS 5 9? 27 1 DO 310 Y = 1,4 SWALLS 600 272 WALL !X , Y) = WALL!X + 1 , Y) SWALLS 6 01 273 3 10 CONTINUE SWALLS 602

2 74 DO 320 Y = 1,3 SWALLS 603

275 WDIM!X, Y) = WDIM! X+1 ,Y) SWALLS 604

276 320 CONTINUE SWALLS 605

27 7 330 CONTINUE SWALLS 606 278 WTOT = WTOT - 1 SWALLS 607

27 9 PRINT* SWALLS 608

280 PRINT*, 'LINE # ',N,' DELETED' SWALLS 6 09

28 1 END IF SWALLS 6 1 0 282 ft SWALLS 6 11 283 END IF SWALLS 612

284 END IF SWALLS 6 13 285 END IF SWALLS 6 1 4 286 ft SWALLS 6 15 287 ft - SWALLS 616 288 ft ft ft DISPLAY ALL DATA *** SWALLS 6 17 289 ft - SWALLS 6 1 8 290 IF ! COMMAND . EQ . 4 ) THEN SWALLS 6 19 29 1

ft SWALLS 620

292 ft ft ft INDICATE EMPTY DATA FILE SWALLS 6 21 293 IF ! WTOT .EQ. 0 ) THEN SWALLS 622

294 PRINT* SWALLS 6 23 295 PRINT*, 'DATA FILE IS EMPTY !!!' SWALLS 624

296 ft SWALLS 6 25 297 ft ft ft DISPLAY DATA SWALLS 626 298 ELSE SWALLS 6 27 299 PRINT* SWALLS 628

300 CALL DISPLAY! N, COMMAND) SWALLS 6 29

30 1

ft SWALLS 630

302 END IF SWALLS 6 31 303 END IF SWALLS 632

304 ft SWALLS 6 33 305 ft - SWALLS 634

306 ft ft ft ADD DATA *** SWALLS 6 35 307 ft - SWALLS 636

308 IF ! COMMAND . EQ . 5 ) THEN SWALLS 6 37 309 ft SWALLS 638

3 10 ft ft ft ENTER DATA SWALLS 6 39

31 1 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft SWALLS 6 40

3 12 ft CHECK TO SEE IF THERE IS ENOUGH ARRAY SPACE SWALLS 6 41 31 3 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft SWALLS 642 314 500 IF!WTOT. GE ,WMAX) THEN SWALLS 6 43

31 5 WTOT = WMAX SWALLS 644

316 PRINT *, 'DATA ENTRY ABORTED.' SWALLS 6 45

31 7 PRINT *, 'MAXIMUM NUMBER OF DATA LINES IN FILE WOULD' SWALLS 646

3 18 PRINT *, ' HAVE BEEN EXCEEDED. NO MORE THAN ' ,WMAX SWALLS 6 47

31 9 PRINT *, ' DATA LINES ARE ALLOWED.' SWALLS 648 320 PRINT *, ' TO INCREASE THE MAXIMUM NUMBER OF ENTRIES ALLOWED,

SWALLS 6 49

147
FTN 5 . 1+552

SUBROUTINE MANIP

83/12/24. 1 1 .29.46 PAGE 74/175 OPT=0

16

321 PRINT *, ' CHANGE THE PARAMETER "VmAX" IN EACH COMMON OF' SWALLS 650 322 PRINT *, ' EVERY SUBROUTINE (THERE ARE FOUR PLACES). ' SWALLS 6 51 323 PRINT *, ' THEN RECOMPILE THE PROGRAM.' SWALLS 652 324 GOTO 10 SWALLS 6 53 325 END IF SWALLS 654

326 SWALLS 655

327 WTOT = WTOT + 1 SWALLS 656 328 CALL DATAIN (0,WTOT) SWALLS 657

32 9 510 PRINT* SWALLS 658

3 30 PRINT*, 'DO YOU WANT TO ENTER MORE DATA? (1) YES ( 2 ) NO

SWALLS 6 5 9 33 1 PRINT*, ' ENTER A NUMBER !!!' SWALLS 660 332 REWIND 1 SWALLS 6 61 333 READ( 1

, *,END=5 10) ANSWER SWALLS 662 334 t SWALLS 6 63 335 *** CHECK VALIDITY OF NUMBER SWALLS 664 336 IF ( ( ANSWER NE. 1 ) .AND. ( ANSWER NE. 2 ) ) THEN SWALLS 6 65 337 GOTO 510 SWALLS 666 338 * SWALLS 6 67 339 *** ENTER MORE DATA SWALLS 668

3 40 ELSE IF ( ANSWER .EQ. 1 ) THEN SWALLS 6 69

34 1 GOTO 500 SWALLS 670 342 * SWALLS 6 71 343 »** DISCONTINUE DATA ENTRY SWALLS 672 344 ELSE IF ( ANSWER .EQ. 2 ) THEN SWALLS 6 73 345 PRINT* SWALLS 674 346 PRINT*, 'DATA ENTRY DISCONTINUED' SWALLS 6 75 34 7 He SWALLS 676

348 END IF SWALLS 6 77 349 END IF SWALLS 678

350 « SWALLS 6 79

35 1 * SWALLS 680

352 *** STORE DATA AND PROGRAM *** SWALLS 681

35 3 SWALLS 682 354 IF < COMMAND . EQ . 6 ) THEN SWALLS 683

35 5 600 PRINT* SWALLS 684 356 PRINT* , 'DOUBLE CHECK ! ! !

' SWALLS 685 357 PRINT*, ' DO YOU YOU WANT TO STORE THIS DATA AND END PROG' SWALLS 686 358 PRINT*, ' NOTE; STORING THIS DATA WILL WIPE OUT ANY OLD FILE SWALLS 6 87

35 9 PRINT*, ' OF THE SAME NAME !!!' SWALLS 688 360 PRINT*, ' ENTER A NUMBER: (1) YES (2) NO' SWALLS 6 89

36 1 REWIND 1 SWALLS 690 362 READCl ,*,END=600) ANSWER SWALLS 6 91 36 3 * SWALLS 692 364 *** SET FLAG FOR STORING DATA IN THE MAIN PROGRAM SWALLS 6 93 365 IF ( ANSWER .EQ. 1 ) THEN SWALLS 694 366 QUIT = 1 SWALLS 6 95

36 7 RETURN SWALLS 696 368 « SWALLS 697

369 *** ABORT 'STORING' MODE SWALLS 698 370 ELSE IF ( ANSWER EQ. 2 ) THEN SWALLS 699

37 1 PRINT* SWALLS 700 372 PRINT*, ' "STORING" MODE DISCONTINUED' SWALLS 701 373 * SWALLS 702 374 *** CHECK VALIDITY OF ANSWER SWALLS 703 375 ELSE IF ( ( ANSWER .NE. 1 ) AND. < ANSWER .NE. 2 ) ) THEN SWALLS 704 376 GOTO 600 SWALLS 705 377 * SWALLS 706 378 END IF SWALLS 707 379 END IF SWALLS 708 380 * SWALLS 709

PVAl 7 1 0 382 *** END PROGRAM WITHOUT STORING DATA *** SWALLS 7 11 RVAT 7 1 2 384 IF ( COMMAND . EQ . 7 ) THEN SWALLS 7 13

148
FTN 5 U552

SUBROUTINE MANIP 83/12/24 11.29.48 PAGE 17 74/175 OPT=0

3 85 700 PRINT* SWALLS 7 386 PRINT* , 'DOUBLE CHECK ! ! !

' SWALL3 7 387 PRINT*, • DO YOU WANT TO END THIS PROGRAM SWALLS 7 388 + 'WITHOUT STORING DATA?' SWALLS 7 389 PRINT*, ' ENTER A NUMBER: (1) YES <2) NO' SWALLS 7 390 REWIND 1 SWALLS 7 39 1 READ! 1, *,END=700) ANSWER SWALLS 7 392 t SWALLS 7 39 3 *** SET FLAG FOR ABORTING PROGRAM IN THE MAIN PROGRAM SWALLS 7 394 IF ( ANSWER EQ. 1 ) THEN SWALLS 7 395 ABORT = 1 SWALLS 7 396 RETURN SWALLS 7 397 « SWALLS 7 398 *** ABORT 'STORING' MODE SWALLS 7 399 ELSE IF ( ANSWER , EQ . 2 ) THEN SWALLS 7 400 PRINT* SWALLS 7 40 1 PRINT*, ' "ABORTION" MODE DISCONTINUED' SWALLS 7 402 * SWALLS 7 403 *** CHECK VALIDITY OF ANSWER SWALLS 7 404 ELSE IF ( ( ANSWER .NE. 1 ) .AND. ( ANSWER . NE . 2 ) ) THEN SWALLS 7 405 GOTO 700 SWALLS 7 406 * SWALLS 7 40 7 END IF SWALLS 7 408 END IF SWALLS 7 409 A SWALLS 7

4 10 « - SWALLS 7 41 1 *** LOOP TO BEGINNING OF 'MANIP' SUBROUTINE SWALLS 7

4 12 - SWALLS 7 413 GOTO 10 SWALLS 7

4 14 A SWALLS 7 41 5 END SWALLS 7

VARIABLE MAP-- (LO=A)

NAME---ADDRESS --BLOCK -PROPERTIES TYPE

ABORT 2 DUMMY-ARG INTEGER

ANSWER 222 7B INTEGER

COMMAND 223 7B INTEGER

DIR NONE UNUSED/*S* CHAR*3

DOK NONE UNUSED/*S* INTEGER

FLAGl 2230B INTEGER

FROM NONE UNUSED/*S* CHAR*3

INSERT NONE UNUSED/*S* INTEGER

LOK NONE UNUSED/*S* INTEGER

MAT NONE UNUSED/*S* CHAR*3

N 223 IB INTEGER

NOK NONE UNUSED/*S* INTEGER

OK 223 2B INTEGER

OKI 2233B INTEGER

OK2 223 4B INTEGER

QUIT 1 DUMMY-ARG INTEGER

TEMP NONE UNUSED/*S* INTEGER

TO NONE UNUSED/*S* CHAR*3

V NONE UNUSED/*S* INTEGER

WALL OB /WALLC/ CHAR*3

WDIM OB /WALLN/ REAL WERR 34 2B /WALLN/ INTEGER

VTOT 34 IB /WALLN/ INTEGER

X 2235B INTEGER

Y 223 6B INTEGER

' 1 4 15 'U

17 '18

19 '20

21 '22 23

'24 2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

149
FTN 5.1 + 5 52 6 3 / 1 2 / 2 <1 . 11.29.46 PAGE 18 SUBROUTINE MANIP 74/175 OPT=0

-SYMBOLIC CONSTANTS--(LO=A>

-NAME TYPE VALUE

WMAX INTEGER 75

-PROCEDURES-- ( LO=A) -NAME TYPE ARGS CLASS

DATA IN 2 SUBROUTINE

DISPLAY 2 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

LABEL- ADDRESS --PROPERTIES- ---DEF -LABEL- ADDRESS --PROPERTIES--

10 7B 35 300 61 IB 100 SOB 61 305 66 0B 200 16 IB 1 1 7 310 INACTIVE DO-TERM

210 INACTIVE DO-TERM 142 320 INACTIVE DO-TERM

220 INACTIVE DO-TERM 145 330 INACTIVE DO-TERM

230 INACTIVE DO-TERM 146 500 1003B

250 INACTIVE DO-TERM 217 510 1 035B

260 INACTIVE DO-TERM 220 600 1 0 7 6B 270 INACTIVE DO-TERM 221 700 1 150B

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARGS

MANIP 5B 2

-I 10 UNITS--(LO = A) -NAME--- PROPERTIES

TAPEl PMT/SEQ

-STATISTICS--

PROCRAM-UNIT LENGTH 2253B = 1195 CM LABELLED COMMON LENGTH 47 5B = 317 CM STORAGE USED 6S000B = 27136

COMPILE TIME 0.625 SECONDS

•DEF

240

264

273

276 277

314

329

355

385

150
TTN : :»552 83/12/24 11.29.46 PAGE 19 SUBROUTINE DISPLAY 74/175 OPT=0

1 SUBROUTINE DISPLAY (LINE, COMMAND) SVALL5

3 •*» COMMON FOR DATABASE OF WALL PARAMETERS ***COMV

5 INTEGER UMAX COMV

6 PARAMETER (WMAX = 75) COMV

7 COMMON /WALLN/ WD IM< WMAX , 3 ) , VTOT, WERR COMU

8 COMMON /WALLC/ WALL (WMAX, 4) COMW

9 INTEGER WTOT.WERR COMW

10 REAL WDIM COMW

11 CHARACTER *3 WALL COMW

12 * ================================= COMW

13 •» DESCRIPTION OF ARRAYS COMU

14 * ================================= COMW

15 * WALL IDENTIFICATION COMU

U » COMW

17 * DIRECTION FROM TO COMW

18 * ROOM ROOM COMU

19 » COMW

20 * WALL(X,1) UALL(X,2) WALL(X,3) COMW

21 * A3 A3 A3 COMU

22 * ========================================================= COMV

23 * WALL PARAMETERS COMU

29 » COMW

25 « MATERIAL HEIGHT WIDTH LAYER THICKNESS COMU

26 * - COMW

27 * WALL(X,4) VDIM(X,1) VDIM(X,2) WDIM(X,3) COMU

28 * A3 F8.2 F8 . 2 F8 . 2 COMW

31 INTEGER LINE, COMMAND, N SVALLS

32 1000 FORMAT (8(3X,A)) SWALLS

33 20 00 FORMAT ( 4 X , I 3 , 8X , A3 , 7X , A3 , 3X , A3 , 2 X , F6 . 2 , 2X , F6 . 2 , 5X , F 6 . 2 , 7X , A3 ) SWALLS

34 PRINT 1 000, 'LINE # ' , ’ D I RECTI ON ' , ' FROM ' ,

' TO ' ,' HE I GHT ' , SWALLS

35 + 'WIDTH' , 'THICKNESS' , 'MATERIAL ' SVALLS

36 IF ( COMMAND . EQ 4 ) THEN SWALLS

37 DO 10 N = l,WTOT SWALLS

38 PRINT 2000, N , WALL ( N , 1 )

, WALL ( N , 2 ) , WALL (N , 3 ) , WD IM (N , 1 ) , SVALLS

39 + WDIM(N, 2) ,WDIM(N, 3) ,WALL(N, 4) SVALLS

40 10 CONTINUE SWALLS

41 ELSE SVALLS

42 PRINT 2000, L INE , WALL ( L I NE , 1 )

, WALL ( L I NE , 2 ) , WALL ( L I NE , 3 ) , SVALLS

43 + WDIM(LINE, 1) ,WDIM(LINE,2) ,WDIM(LINE,3) , WALL(LINE,4) SWALLS

44 END IF SWALLS

45 RETURN SWALLS

46 END SWALLS

745

4

5

6

7

8

9

1 0

1 1

1 2

1 3

1 4

1 C

1 6 17

1 8 1920

21

n »»

i. u 23

24

2526

2728

2 9

7 47

7 48 749 750

75 1 752

753

754

755

756 757

758 759

760

761 762

VARIABLE MAP-- o II > NAME---ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

COMMAND 2 DUMMY -ARG INTEGER

LINE 1 DUMMY-ARG INTEGER

N 2 4 4B INTEGER WALL OB /WALLC/ CHAR*3 300

WDIM OB /WALLN/ REAL 225

WERR 342B /WALLN/ INTEGER

VTOT 341B /WALLN/ INTEGER

151
FTN S, 1+552 83/12/24. 11 20 SUBROUTINE DISPLAY 74/175 OPT

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE

WMAX INTEGER

-STATEMENT LABELS-- ( LO=A

)

-LAB EL- ADDRESS PROPERTIES--

10 INACTIVE DO-TERM

1000 150B FORMAT

2000 152B FORMAT

-ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS---

DISPLAY 5B 2

-STATISTICS--

PROCRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED 6 COMPILE TIME 0

.29.46 PACE

:0

VALUE

75

-DEF

4032

33

250B = 168 475B = 317 OOOB = 25088

085 SECONDS

152
FTN 5 U552 83/12/24. 11.29.46 PAGE 21 FUNCTION VAL 74/175 OPT=0

1 INTEGER FUNCTION VAL(STRING) SUALLS 76

2 C»* RETURNS THE INTEGER VALUE OF A STRING. SWALLS 76

3 INTEGER NUMBER, X , L , EXP , D I G IT , GETLEN SUALLS 76

4 CHARACTER » (*) STRING SUALLS 7 6 5 L = GETLEN(STRING) SUALLS 76

6 NUMBER = 0 SUALLS 76

7 DO 10 X = L, 1 ,-l SUALLS 76

8 EXP = L - X SUALLS 77

9 DIGIT = ICHAR(STRING(X: X) ) - 16 SUALLS 77

10 NUMBER = NUMBER + D I G IT* 1 0

* »EXP SUALLS 77

11 10 CONTINUE SUALLS 77

12 VAL = NUMBER SUALLS 77

13 RETURN SUALLS 77

14 END SUALLS 77

-VARIABLE MAP--(LO=A)

-NAME-- -ADDRESS-- BLOCK PROPERTIES -TYPE

DIGIT 76B INTEGER

EXP 75B INTEGER

L 74B INTEGER

NUMBER 72B INTEGER

STRING 1 DUMMY-ARG CHAR* ( *) VAL 71B INTEGER

X 73B INTEGER

-PROCEDURES--(LO= A) -NAME-- TYPE-- ARGS --CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS --(LO=A)

-LABEL-,ADDRESS--- --PROPERTIES-- --DEF

10 INACTIVE DO-TERM 11

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARCS

VAL 6B 1

-STATISTICS--

PROGRAM-UNIT LENGTH 102B = 66 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.039 SECONDS

,3

i4

,5

6.7

8

.9

0

'1

2

'3

4

5

6

153
FTN 5.1+ 5 52 03/12/28. 11,29.84 PAGE 22 FUNCTION GETLEN 78/175 OPT=0

1 INTEGER FUNCTION GETLEN (STRING) SUALLS n

2 c SUALLS 7

3 c DETERMINE LENGTH OF STRING EXCLUDING ANY BLANK PADDING SUALLS 7

8 c SUALLS 7 5 c SUALLS 7

4 c ARGUMENT DEFINITIONS -- SUALLS 7

7 c READ ARGUMENTS SUALLS 7

e c STRING - STRING WHOSE LENGTH IS TO BE DETERMINED SUALLS 7

9 c SUALLS 7 10 CHARACTER * (*) STRING SUALLS 7 11 c SUALLS 7 12 c FUNCTION PARAMETERS SUALLS 7 13 CHARACTER * 1 BLANK SUALLS 7 18 PARAMETER (BLANK =

'

'

)

SUALLS 7 15 c SUALLS 7 14 c LOCAL VARIABLES SUALLS 7 17 INTEGER NEXT SUALLS 7 18 c SUALLS 7 19 c START WITH THE LAST CHARACTER AND FIND THE FIRST NON-BLANK SUALLS n 20 DO 10 NEXT = LEN(STRING) , 1

, -1 SUALLS 7 21 IF (STRING(NEXT : NEXT) .NE. BLANK) THEN SUALLS 7 22 GETLEN = NEXT SUALLS 7 23 RETURN SUALLS 7 28 END IF SUALLS 8 25 10 CONTINUE SUALLS 8 24 c SUALLS 8 27 c ALL CHARACTERS ARE BLANKS SUALLS 8 28 GETLEN = 0 SUALLS 8 29 c SUALLS 8 30 RETURN SUALLS 8 31 END SUALLS 8

-VARIABLE MAP--(LO=A)

-NAME- --ADDRESS- -BLOCK PROPERTIES TYPE- SIZE

GETLEN 63B INTEGER NEXT 64B INTEGER

STRING 1 DUMMY-ARG CHAR*<*)

-SYMBOLIC CONSTANTS--( LO=A) -NAME TYPE-- --VALUE

BLANK CHAR*1 ' '

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

LEN INTEGER 1 INTRINSIC

-STATEMENT LABE LS- - ( L0= A

)

-LABEL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 25

7879

80

81

8283

8835

84

37

8889

90

9 1 92

93

9895

9497

9899

00

0 1 0203

0805

0407

154
rXN 5 1*552 83/12/24. 11.29.4 23 FUNCTION CETLEN 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS-- ARCS- --

CETLEN AB 1

-STATISTICS--

PROCRAM-UNIT LENGTH 70B

CM STORAGE USED AlOOOB

COMPILE TIME 0.037

& PAGE

= 56

= 25088

SECONDS

155
FTN 5 . 1+5S2

SUBROUTINE LWALL BSmiZA. 1 1 .29.46 PAGE

74/175 OPT=0

24

1

2 * ! ! 3 * ! ! 4 * ! ! 5 * ! !

6 * ! ! 7

SUBROUTINE LWALL LWALL M ! M ! ! ! ! I !! ! ! ! ! ! j ! ! ! ! f j ! ! j j j ! ! I

! ! ! !

I I

! j jj ! ! ! ! j { ! I j j !

I

j ! j I

j j j ! ! j M j j ^ ^

! ! ! LWALL

LOAD THE CONTENTS OF THE PILE 'WALLS' INTO ARRAYS WALL AND WDIM. LWALL

! ! ! LWALL

! N !!!!!!!!!!!!!!!!!!!!!! M !! M !! I j j ! j ! j !!! j ! j j !!! j !! I I

j j ! I! j !! j I M I I,

9 10

1112

1314

1516

17

18

1920

2122

23

24

25

26

2728

29

30

3132

33

34

35

36

37

*** COMMON FOR DATABASE OF WALL PARAMETERS

INTEGER WMAX PARAMETER (WMAX = 75)

COMMON /WALLN/ WDIM(WMAX,3)

COMMON /WALLC/ WALL (WMAX, 4) INTEGER WTOT,WERR

REAL WDIM

CHARACTER *3 WALL

* DESCRIPTION OF ARRAYS

WALL IDENTIFICATION

WTOT, WERR

DIRECTION FROM

ROOM

TOROOM

WALL(X,1)

A3

WALL(X,2)

A3 WALL (X, 3) A3

WALL PARAMETERS

MATERIAL HEIGHT WIDTH LAYER THICKNESS

***COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

WALL (X, 4) WDIM(X, 1) WDIMCX, 2) WDIM( X, 3) A3 F8.2 F8.2 F8.2

*«**« ft « **«***««* A ft *««***« A * ft t ««** ft * 1 1 ft ******** ft *«*« ft «« ft t ««* )t * ft «**«« CONV

ftftft ftftftftft ftftftftftftftftftftftftft ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftCONF

1

23

45

67

12

3

4

5

6

78

9 10

1

1

12

13

14

15

16

1718

1920

2122

23

24

252627

28

29

1 38 »* COMMON FOR INITIAL PARAMETERS ***COMF 2 39 ft Aft ft** Aft ftftft ftftftft Aft Aft ftftftftft Aft* ftftftftftftft ftftft ftftftftft ftftft ftftftftft Aft ftftftft Aft ftftftftftftftftftftftftftCOMF 3 40 INTEGER FMAX COMF 4 41 PARAMETER (FMAX = 50) COMF 5 42 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF 6 43 5 FTOT COMF 7 44 COMMON /INITILC/ BLDG COMF 8 45 CHARACTER * 5 BLDG COMF 9 46 REAL FREQ, AFLAG, RFLAG, FREQA COMF 10 47 INTEGER QUALITY, FERR, FTOT COMF 11 48 ««« ************************************** ******************************* COMP 12 49 *************************** ********** t ******  ««** ** *«*«**«**««*«***** COMP 13 SO ************************************************** LWALL 10

51 ft DECLARATION OF VARIABLES LWALL 11 52 ************************************************** LWALL 12 S3 INTEGER GETLEN, R, C LWALL 13 54 CHARACTER * 7 NAME, PFN LWALL 14 55 ************************************************** LWALL 15 56 ft LWALL 16 57 ************************************************** LWALL 17 58 NAME = 'B' / /BLDGd ;GETLEN(BLDG)) // 'W' LWALL 18 59 PFN = NAME (1 :GETLEN(NAME)

)

LWALL 19 60 WERR = 0 LWALL 20

61 CALL PF ( 'GET' ,0,PFN( 1 :GETLEN(PFN) ), 'RC , WERR) LWALL 21 62 IF ( WERR .EQ. 0 ) THEN LWALL 22 63 OPEN (UNIT=3, FILEoPFN, FORM= ' FORMATTED '

,

LWALL 23

64 $ STATUSn'OLD' , ACCESS= ' SEQUENTIAL '

)

LWALL 24

156
FTN 5 U552

SUBROUTINE LVALL

83 / 1 2 / 2 4. 1 1 .29.46 PACE

74/175 OPT=0

25

65 1000 FORMAT ( IX, 4( IX , A3 ) , 3( IX. F8 . 2)

)

LWALL 25

66 WTOT = 0 LWALL 26

67 DO 10 R = l.WMAX LWALL 27

66 READ (3 , 1000 ,END=20) <WALL(R,C) ,C=1,4),(VDIM(R,C),C=1,3) LWALL 28

69 WTOT = WTOT + 1 LWALL 29

70 10 CONTINUE LWALL 30

71 20 CONTINUE LWALL 31 72 CLOSE ( 3 , STATUS= ' DELETE '

)

LWALL 32

73 ELSE IF ( WERR EQ. 2 ) THEN LWALL 33 74 CALL WARNING (7) LWALL 34 75 ELSE LWALL 35

76 CALL WARNING (8) LWALL 36

77 END IF LWALL 37 78 RETURN LWALL 38

79 END LWALL 39

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*

5

C 2S5B INTEGER

FERR 666 / INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER

NAME 256B CHAR*7

PFN 257B CHAR*7

QUALITY IB / INITILN/ INTEGER

R 254B INTEGER

RFLAC 3B / INITILN/ REAL WALL OB /WALLC/ CHAR*3 300

WDIM OB /WALLN/ REAL 225 WERR 342B /WALLN/ INTEGER

WTOT 341B /WALLN/ INTEGER

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

FMAX INTEGER 50 WMAX INTEGER 75

-PROCEDURES --(LO=A)

-NAME TYPE --ARCS--- ---CLASS

GETLEN INTEGER 1 FUNCTION

PF 5 SUBROUTINE

WARNING 1 SUBROUTINE

-STATEMENT LABELS--! LO=A) -LABEL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM

20 117B

1000 155B FORMAT

70

7165

157
FTN 5.1+552 83/12/24. 11.29.46 PAGE 26 SUBROUTINE LWALL 74/175 OPT=0

-ENTRY POINTS--! LO=A) -NAME ADDRESS-- ARCS

LWALL 5B 0

-I/O UNITS--(LO=A)

-NAME PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

PROCRAM-UNIT LENGTH 265B = 181 CM LABELLED COMMON LENGTH 566B = 374 CM STORAGE USED 63000B = 26112

COMPILE TIME 0.105 SECONDS

158
riN 5 U552 83/12/24. 11.29.48 PAGE 27 SUBROUTINE WARNING 74/175 OPT=0

SUBROUTINE WARNING(ERR)

INTEGER ERR, ERRM CHARACTER*45 MESSAGE(20)

WARNING

WARNING

WARNING

4 DATA MESSAGE! 1)/'"H0LE" DATA FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING n 5 DATA MESSAGE! 2) /'FILE HANDLING PROBLEM ON "HOLE" DATA FILE ' / WARNING 5 6 DATA MESSAGE! 3) /'"MATTER" FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING 6 7 DATA MESSAGE! 4)/'FILE HANDLING PROBLEM ON "MATTER FILE ' / WARNING 7

8 DATA MESSAGE! 5)/ '"TYPE" DATA FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING 8

9 DATA MESSAGE! 6) /'FILE HANDLING PROBLEM ON "TYPE" FILE ' / WARNING 9

1 0 DATA MESSAGE! 7)/ '"WALL" DATA FILE DOES NOT EXIST FOR THIS BLDG '

/

WARNING 10

1 1 DATA MESSAGE! 8) /'FILE HANDLING PROBLEM ON “WALL" FILE ' / WARNING 1 1

1 2 DATA MESSAGE! 9)/ 'HEIGHT AND WIDTH OF ROOM MISSING ' / WARNING 1 2 13 DATA MESSAGE! 10 )/' LENGTH OF ROOM IS MISSING ' / WARNING 1 3

1 4 DATA MESSAGE! 11 )/ 'FREQ FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 1 4 15 DATA MESSAGE! 12 )/ ‘ FILE HANDLING PROBLEM WITH FREQ FILE ' / WARNING 1 5

1 6 DATA MESSAGE! 13 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 16

17 DATA MESSAGE! 14) / 'WARNING CODE IS OUT OF RANGE ' / WARNING 1 7

1 8 DATA MESSAGE! 15 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 18

19 DATA MESSAGE! 16 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 19 20 DATA MESSAGE! 17 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 2 0 21 DATA MESSAGE!18)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 2 1 22 DATA MESSAGE! 19 )/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 22 23 DATA MESSAGE!20)/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 23 24 ERRM=:12 WARNING 24

25 lERR = ERR WARNING 25 26 IF(ERR.GT.ERRM) IERR=20 WARNING 26

27 WRITE (6, 20) WARNING 27 28 WRITE(6,10) ERR, MESSAGE! lERR) WARNING 28 29 WRITE(6,20) WARNING 29

30 10 FORMAT!' ***WARNING NUMBER = ',15,' *** ' , A45

)

WARNING 30

31 20 FORMAT!' ') WARNING 31 32 RETURN WARNING 32

33 END WARNING 33

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

ERR 1 DUMMY-ARG

ERRM 60B

lERR 21 3B MESSAGE 61B

INTEGER

INTEGER

INTEGER

CHAR*45 20

-STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 34B FORMAT 30 20 42B FORMAT 31 FTN 5.1+552 83/12/24. 11 29.46 PACE 20 SUBROUTINE WARNING 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARGS---

WARNING 5B 1

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

FROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

21 6B < 142 61000B ^ 25088

0.060 SECONDS

159
FTN 5 1+552 83/12/24 11 .29,46 PAGE 29 SUBROUTINE ERROR 74/175 OPT = 0

1 SUBROUTINE CRROR(IERR) ERROR .

7 CHARACTER*45 MESSAGE(20) ERROR 2

3 DATA MESSAGE! 1)/ ' MATERIALS DATA, EASE IS EMPTY ' / ERROR .3

4 DATA MESSAGE! 2)1 ' FREQUENCY IS OUT 1DF RANGE ' / ERROR 4

5 DATA MESSAGE! 3)/ 'THIS MATERIAL IS 1NOT IN DATA EASE ' / ERROR 5

6 DATA MESSAGE! 4)/ 'DENOMINATOR IS ZERO ' / ERROR

7 DATA MESSAGE! 5)/ FILE HANDL ING ERROR ' / ERROR 7 e DATA MESSAGE! 6)1 ' ERROR CODE IS OUT OF RANGE ' / ERROR e 7 DATA MESSAGE! 7)1 ' ERROR CODE IS OUT OF RANGE ' / ERROR 9

1 0 DATA MESSAGE! 8)/ ' ERROR CODE IS OUT OF RANGE '

;

ERRCR C 11 DATA MESSAGE! 9)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 1 1

1 L DATA MESSAGE! 10 ) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 1 2 13 DATA MESSAGE! 1 1 )

/

' ERROR CODE IS OUT OF RANGE ' / ERROR 13

1 4 DATA MESSAGE ! 12)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 1 4 15 DATA MESSAGE ! 1 3 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 1 5

1 6 DATA MESSAGE! 14) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 16 17 DATA MESSAGE ! 15 )

/

' ERROR CODE IS OUT OF RANGE ' / ERROR 17

1 8 DATA MESSAGE! 16)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 18 19 DATA MESSAGE ! 17 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 1 9 20 DATA MESSAGE! 18)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 2G

21 DATA MESSAGE! 19 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR : 1 22 DATA MESSAGE! 20 )

/

' ERROR CODE IS OUT OF RANGE ' / ERROR 22 23 IERRM=5 ERROR 23 24 IF( lERR GT. lERRM) IERR = 20 ERROR 24

2 5 URITE(6,10) lERR, MESSAGE ! lERR) ERROR 25 26 10 FORMAT!' *** ERROR NUMBER =

'

, 15 ,

‘ * * * ' ,A45) ERROR 2 27 CALL PMDSTOP ERROR 2 ? 28 STOP ' ERROR

ERROR 28 29 END ERROR 2?

-VARIABLE MAP--!LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

lERR 1 DUMMY-ARC INTEGER

lERRM 210B INTEGER

MESSAGE 56B CHAR* 45 20

-PROCEDURES--(LO=A)

-NAME TYPE --ARCS CLASS

PMDSTOP 0 SUBROUTINE

-STATEMENT LABELS-- ( LO=A) -LAE EL -ADDRESS PROPERTIES DEE

10 36B FORMAT 26

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARCS

ERROR 5B 1

FTN 5.1+552 83/12/24. 11.29 46 PAGE 30 SUBROUTINE ERROR 74/175 OPT=0

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAFE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH 213B = 139 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.056 SECONDS

160
Appendix 9.5 Listing of Computer Program STYPES

161
FTN 5 1+552 83/12/24. 10 34.12 PAGE 1 PROGRAM 3TYPES 74/175 OPT=0

1 PROGRAM STYPE3 ( INPUT , TAPE 1 = I NPUT) STYPES

2 * STYPES

3 *THI3 INTERACTIVE PROGRAM INPUTS THE DATA DESCRIBING EACH TYPE STYPES

4 *IN THE BUILDING AND STORES IT. THE FILE NAME IS CREATED BY STYPES

5 ‘ATTACHING "B" TO THE FRONT OF AND "W" TO THE BACK OF THE BUILDING STYPES

4 ‘IDENTIFICATION. THE BUILDING IDENTIFICATION CAN BE NO MORE STYPES

7 ‘THAN 5 ALPHANUMERIC CHARACTERS. STYPES

8 STYPES

9 ******»********************A*********************<t*******»*******!i(******coj'ij'

10

*** COMMON FOR INITIAL PARAMETERS ***COMF

I \ 1 1 * t t It t 1 1 1 1 1 * 1 1 t * it * 1 1 * It h 1 1 1 1 1 1 1 1 * * i( It 1 1 1 h * 1 1 1 1 1 1 * 1 1 1 1 1 1 1 1 1 1( * * 1 1 1 M 1 t H t t * Q 12 INTEGER FMAX COMF

13 PARAMETER (FMAX = 50) COMF

14 COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF

15 $ FTOT COMF

14 COMMON /INITILC/ BLDG COMF

17 CHARACTER ‘ 5 BLDG COMF

18 REAL FREQ, AFLAC, RFLAG, FREQA COMF

17 INTEGER QUALITY, FERR, FTOT COMF

20 1 1 it 1 1 1 it It h t * t It it t It It It 1 1 h 1 1 It It It t it t It t it t It t * It 1 1 1 1 t tit t it t it 1 1 1 it it it t 1 1 It it t It t It it t k t it t It t 21 t * 1 1 it 1 1 1 1 1 1

1

1 1 1

1

1 1 1 1 1 1

1

1 * 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 * 1 1 1 1 1 1 * 1 1 1 1 1 1

1

1 1 1 1 1

1

t * 1

1

23 *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

24 t t t t t t t t t 1

1

t t t t t t t t t t t t 1

1

1

1

t t t t t t t t t 1

1

t t t t t t t t t 1

1

t t t t t t t t t t t t t t 1

1

1

1

t t t t t 25 INTEGER RMAX COMR

24 PARAMETER (RMAX = 20) COMR

27 COMMON /ROOMN/ ROOM(RMAX + 4, RMAX + 4), NROOMS, RAREA(RMAX) COMR

28 INTEGER NROOMS COMR

29 REAL ROOM COMR

30 tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt COMR

31 ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt *C0MR

32 ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt * COMT

33 *“ COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS “‘COMT

34 *tit*ii*****iiii*i(*iit*iit*ii*iii(tt***t*ii**iiiit*ii**t*****t ii** *ii*t***ttt***ii*iic OMT

35 INTEGER TMAX COMT

34 PARAMETER (TMAX=35) COMT

37 COMMON /TYPEN/TDIM(TMAX , 4) ,TTOT,TDB2 (TMAX , 2 ) ,TDBTOT,TERR COMT

38 COMMON /TYPEC/TYPE(TMAX,3) ,TDB1(TMAX) COMT

39 INTEGER TTOT , TDETOT , TERR COMT

40 REAL TDIM,TDB2 COMT

41 CHARACTER * 3 TYPE,TDB1 COMT

42 ‘================================================= COMT

43 * DESCRIPTION OF ARRAYS COMT

44 ‘================================3================ COMT

45 * ID MATERIAL FRAME MATERIAL COMT

46 * COMT

47 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT

48 ‘ A3 A3 A3 COMT

49 ‘3==33======3333=3=3=333=3=3===3==3=============3= COMT

50 ‘ HEIGHT WIDTH LAYER DISTANCE COMT

51 * THICKNESS ABOVE FLOOR COMT

52 * COMT

53 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT

54 * F8 . 2 F8 . 2 F8 . 2 F8 . 2 COMT

55 «======3======================3=3======33=3======= COMT

54 * ID ATTENUATION AREA COMT

57 * COMT

58 * TDBKX) TDB2(X,1) TDB2(X,2) COMT

59 * A3 E9.3 E9 3 COMT

60 *********(t***********‘**‘‘**‘‘‘“‘*‘“‘‘““““““‘““*““‘“““*“ COMT

42 INTEGER GETL EN , QU IT , ABORT , ANSWER , OLDF I LE , N , Y 1 , Y2 , L I NE STYPES

43 INTEGER lERR STYPES

44 CHARACTER ‘ 7 PFN STYPES
FTN 5 U552 83/12/24. 10.36.12 PACE 2 PROGRAM STYPES 74/175 OPT=0

65 t STYPES 15 66 • INITIALIZATION STYPES 1 6 67 QUIT = 0 STYPES 17 68 TTOT = 0 STYPES 18 69 ABORT = 0 STYPES 19 70 100 PRINT* STYPES 20

71 PRINT », 'ENTER BUILDING IDENTIFICATION (E.G. ''101'')' STYPES 2 1 72 PRINT *, • (NO MORE THAN 5 ALPHANUMERIC CHARACTERS)' STYPES 22

73 REWIND 1 STYPES 23

74 READd ,* ,END=100) BLDG STYPES 24

75 STYPES 25 76 IF ( GETLEN(BLDG) GT. 5 ) THEN STYPES 26 77 CO TO 100 STYPES 27 78 END IF STYPES 28

79 PFN = 'B' II BLDG(1:GETLEN(BLDG) ) II 'T' STYPES 29

80 « STYPES 30

81 t * « LOAD DATA ID EXISTING FILE IF NECESSARY STYPES 31 82 200 PRINT* STYPES 32 83 PRINT* , 'WILL THIS BE ' STYPES 33 84 PRINT*,' (1) A MODIFICATION OF AN EXISTING FILE?' STYPES 34

85 PRINT*, ' (2) A NEW FILE?

STYPES 35 86 PRINT* ,' ENTER A NUMBER !!!' STYPES 36

87 REWIND 1 STYPES 37 88 READ( 1

, * ,END=200) OLDFILE STYPES 38

89 IF ( ( OLDFILE .NE. 1 ) .AND. ( OLDFILE .NE. 2 ) ) THEN STYPES 39

90 GOTO 200 STYPES 40

91 ELSE IF ( OLDFILE . EQ . 1 ) THEN STYPES 41 92 t STYPES 42

93 tt * CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME STYPES 43

94 I ERR = 0 STYPES 44 95 CALL PF ( 'GET' ,0,PFN(1 ;GETLEN(PFN) ) , 'RC , lERR) STYPES 45 96 IF ( I ERR .EQ. 2 ) THEN STYPES 46

97 PRINT* STYPES 47 98 PRINT *, 'FILE ' ,PFN, ' NOT FOUND' STYPES 48 99 PRINT*, 'PROGRAM ABORTED! !!

STYPES 49 100 PRINT* STYPES 50

10 1 PRINT*, 'FIND CORRECT BUILDING IDENTIFIER AND RESTART ', STYPES 51 102 + 'PROGRAM' STYPES 52 103 PRINT* STYPES 53 104 STOP STYPES 54 105 t STYPES 55 106 ELSE STYPES 56 107 CALL LTYPE STYPES 57 108 IF (TERR NE. 0) CALL ERROR(5) STYPES 58 109 END IF STYPES 59 no ELSE IF ( OLDFILE .EQ. 2 ) THEN STYPES 60

11 1 n STYPES 61 112 •ktt CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME STYPES 62 113 I ERR = 0 STYPES 63 114 CALL PF ( 'GET' ,0 ,PFN(1 :GETLEN(PFN) )

, 'RC ' , lERR) STYPES 64 115 IF ( lERR EQ. 0 ) THEN STYPES 65

1 16 PRINT* STYPES 66 117 PRINT*, 'DATA FILE ALREADY EXISTS FOR BUILDING ',BLDG STYPES 67

1 18 PRINT* STYPES 68 119 PRINT*, 'IF YOU ENTER DATA AND STORE IT, YOU WILL WRITE ', STYPES 69 120 + 'OVER THE OLD FILE .

' STYPES 70

12 1 250 PRINT* STYPES 71

1 22 PRINT*, 'YOU MAY EITHER (1) ABORT OR (2) CONTINUE.' STYPES 72 123 PRINT* ,' INDICATE YOUR CHOICE BY ENTERING A NUMBER.' STYPES 73 124 REWIND 1 STYPES 74 125 READd, *,END = 250 ) ANSWER STYPES 75 126 PRINT* STYPES 76 127 PRINT*, 'PROGRAM HAS BEEN ABORTED, PER YOUR REQUEST' STYPES 77 128 PRINT* STYPES 71

163
FTK 5.U5 5 2. iZlllIZti. 10. 3d. 12 PAGE 3 PROGRAM STYPES 74/175 OPT=Q

129 IF ( ANSWER EQ. 1 ) THEN STYF ES

1 30 STOP STYPES

13 1 ELSE IF ( ANSWER .EQ. 2 ) THEN STYPES

1 32 255 CONTINUE STYPES

133 ELSE STYFES

134 GOTO 250 STYPES

135 END IF STYPES

136 ELSE IF ( lERR EQ. 2 ) THEN STYPES

137 A STYPES

1 38 A NO DATA FILE EXISTS FOR THIS BUILDING AND DATA ENTRY STYPES

139 A CAN CONTINUE STYPES

1 40 A STYPES

14 1 260 CONTINUE STYFES

1 42 ELSE STYPES

14 3

A STYFES

1 44 A **PERMANENT FILE ERROR STYPES

14 5

A STYFES

146 PRINT* STYPES

14 7 PRINT* PROGRAM ABORTED !!!’ STYPES

148 PRINT*,' SOME PERMANENT PILE ERROR HAS OCCURRED' STYPES

14 9 PRINT*,' DOUBLE CHECK YOUR BUILDING IDENTIFICATION ', STYPES

150 + •AND TRY AGAIN' STYPES

15 1 STOP STYPES

152 END IF STYPES

15 3 PRINT* STYFES

154 PRINT*, ' BEGIN ENTERING DATA' STYPES

155 300 TTOT = TTOT + 1 STYPES

156 IF ( TTOT EQ. 1) THEN STYPES

15 7 CALL DATAINI 1 , TTOT) STYPES

1 58 ELSE STYPES

15 9 CALL DATAIN (0 ,TTOT) STYPES

160 END IF STYPES

16 1 400 PRINT* STYPES

162 PRINT*, 'DO YOU WANT TO ENTER MORE DATA?', STYPES

163 +

' ( 1) YES C 2 ) NO

STYPES

164 PRINT*, • ENTER A NUMBEER !!!' STYFES

165 REWIND 1 STYPES

166 READd ,*,END = 4 0 0 ) ANSWER STYPES

167 IF ( (ANSWER NE. 1) AND. (ANSWER NE. 2) ) THEN STYFES

168 GOTO 400 STYPES

16 9 ELSE IF ( ANSWER ,EQ. 1) THEN STYPES

170 GOTO 300 STYPES

17 1 ELSE IF ( ANSWER .EQ. 2 ) THEN STYFES

172 PRINT* STYPES

173 PRINT*, 'DATA ENTRY DISCONTINUED' STYPES

174 END IF STYPES

175 END IF STYPES

176 A STYPES

17 7 AAA MANIPULATE DATA STYPES

178 CALL MANIP (QUIT, ABORT) STYPES

17 9

A STYPES

180 AAA TERMINATE PROGRAM, STORING DATA IF NECESSARY STYPES

18 1 IF ( QUIT ,EQ. 1 ) THEN STYPES

182 OPEN(UNIT = 6 , F ILE = PFN( 1 : GETL EN ( PFN ) )

, FORM= ' FORMATTED ' , STYPES

183 + ACCESS= ' SEQUENTIAL '

, 5TATUS= 'NEW'

)

STYPES

184 500 FORMAT ( IX , 3 ( IX , A3 ) , 4( IX , F8 . 2 )

)

STYPES

185 DO 6 0 0 N -- l,TTOT STYPES

186 WRITE ( 6 ,5 0 0 ) (TYPE (N, Y1 ) , Y 1 = 1 , 3 ) , ( TD IM ( N , Y2 ) , Y2 = l,4) STYPES

187 600 CONTINUE STYPES

188 ENDFILE(6) STYPES

189 CALL PF (' REPLACE ', 0 , PFN( 1 : CETLEN( PFN) )

)

STYFES

WARNING* NUMBER OF ARGUMENTS IN REFERENCE TO _PF IS NOT CONSISTENT

190 C LOSE ( 6, STATUS=' DELETE'

)

STYPES

191 PRINT* STYPES

7 ? 8D

3 1 8283

34

35

8 i

3 7 8 8 89

9 0

9 1 9 2 93

94

9 5 9697

9899 100

101

1 02 103

1 0 4 105 106

107 108

109

1 10

1 1 1

1 12 113

1 14 115

1 16 117

1 18 119

1 20 121 122

123 124

125

126

127

12 8 129

1 30 131

1 32 133

1 34 135

1 36 137

138

139

140

141

164
83 / 1 2 / 2 4 . 1 0 .36 .12 PAGE

74/175 OPT=0

FTN 5 1»552 4 PROGRAM STYPES

192 PRINT*, 'DATA HAS BEEN STORED AND PROGRAM TERMINATED' STYPES 142 193 END IF STYPES 1 43

19 4 IF( ABORT EQ. 1 ) THEN STYPES 144 195 PRINT* STYPES 145

196 PRINT*, 'PROGRAM HAS BEEN ABORTED' STYPES 146 197 PRINT*,' NO DATA HAS BEEN STORED !!!' STYPES 1 47 198 END IF STYPES 148 199 STOP STYPES 14? 200 END STYPES 150

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

ABORT 1 077B INTEGER

AFLAC 2B / INITILN/ REAL ANSWER 1 lOOB INTEGER

BLDG OB / INITILC/ CHAR*5

FERR 6 6B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER

lERR 1 105B INTEGER

LINE NONE UNUSED/*S* INTEGER

N 1 102B INTEGER

NROOMS 1 2 4 4B /ROOMN/ INTEGER

OLDFILE 1 10 IB INTEGER

PFN 1 1 06B CHAR*7

QUALITY IB / INITILN/ INTEGER

QUIT 1 076E INTEGER

RAREA 1 245B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM 06 /ROOMN/ REAL 676

TDBTOT 323B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 32 4B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER TYPE OB /TYPEC/ CHAR*3 105

Y1 1 103B INTEGER

Y2 1104B INTEGER

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE- VALUE

FMAX INTEGER 50 RMAX INTEGER 20 TMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS -NAME TYPE ARCS CLASS

DATAIN 2 SUBROUTINE LTYPE ERROR 1 SUBROUTINE MAN IP GETLEN INTEGER 1 FUNCTION PF

0 SUBROUTINE

2 SUBROUTINE

5 SUBROUTINE

165
F7K 5.1+552 83/12/24. 10.36.12 PAGE 5 PROGRAM STYPES 7il\7% OPT=0

-STATEMENT LABELS- -( LO= A

)

-LABEL- ADDRESS --PROPERTIES DEF -LABEL -ADDRESS --PROPERTIES- ---DEF

100 2 IB 70 300 24 6B 1 55 200 47B 82 400 26 0B 161 250 166B 121 500 62 6B FORMAT 1 84 255 *NO REFS* 132 600 INACTIVE DO-TERM 187 260 *NO REFS* 141

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

STYPES 14B 0

-I IQ UNITS--(LO=A)

-NAME--- PROPERTIESTAPEl FMT/SEQ

TAPE6 AUX/FMT/SEQ

-STATISTICS--

FROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

11 12B = 586

1 76 IB = 1009 63000B = 26112

0.287 SECONDS

1 WARNING ERROR IN STYPES

166
TTN 3 I *5 5

2

SUBROUTINE DATAIN

83/12/24 . 10 .36 .12 PAGE

74/175 OPT=0

6

1

2

3

45

6

7

S9 10

1

1

12

13

1 4 15

1 6 1716

19 20

2122

23

24

2526

27

28

29

30

3132

33

34

35

36

37

383940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

SUBROUTINE DATAIN ( I NSERT , L I NE ) STYFES

**» COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

INTEGER RMAX COMR

PARAMETER <RMAX = 20) COMR

COMMON /ROOMN/ ROOMIRMAX + 6, RMAX + 6), NROOMS, RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

*******«««**«««i**«*«Mt**it*****it«***)t*******«******«««*ii[««*«*«A*«it*x**«** * COMR

*»* COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT

*****ltt***t*tt*t****t1iltt**t***t**1Hi**1i**1i*1i***t**'k*t1i*k*1i****1iii***t***»* COMT

INTEGER TMAX PARAMETER (TMAX=35)

COMMON /TYPEN/TDIM(TMAX, 4) , TTOT , TDB2 (TMAX , 2 ) ,TDBTOT,TERR

COMMON /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX)

INTEGER TTOT, TDBTOT, TERR

REAL TDIM,TDB2

CHARACTER * 3 TYPE.TDBl

DESCRIPTION OF ARRAYS

ID MATERIAL FRAME MATERIAL

TYPE(X, 1) A3

TYPE(X, 2) A3 TYPE(X, 3) A3

HEIGHT WIDTH LAYER THICKNESS

DISTANCE

ABOVE FLOOR

TDIM( X, 1

)

F8 . 2 TDIM( X, 2) F6 .2 TDIM( X, 3) F8 .2 TDIM( X, 4) F8 . 2

ID ATTENUATION AREA

TDBl (X) A3 TDB2 (X , 1

)

E9 . 3 TDB2 (X , 2 ) E9 . 3

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

* t * k * t * * t * * k * * t * * * * * * t * * * * 1 1 k t * * * * t * k * 1 1 1 * * * 1 1 * * * * * k t k t * » * kk * * t * t * t * t * * QO'nj

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk * CQNT

INTEGER ANSWER, LOK, DOK, NOK ,GETLEN,VAL, INSERT , L I NE ,

V

REAL H,W,T, ABOVE

CHARACTER *3 D IR , ID ,MAT , FHAT

99 IF ( INSERT . EQ . 1 ) THEN

ANSWER = 1 INSERT = 1 ELSE

100 PRINT*

PRINT*, 'IS THIS THE FIRST LAYER OF A DOOR OR WINDOW?',

+ ' (1) YES (2) NO' PRINT*, ' ENTER "0" TO ESCAPE "DATA ENTRY" MODE'

PRINT*, ' ENTER A NUMBER!!'

REWIND 1 READ(1,*,END=100) ANSWER

END IF

* IF (ANSWER ,EQ. 0) THEN TTOT = TTOT - 1 PRINT*

PRINT*, 'DATA ENTRY MODE ABORTED'

END IF

IF ((ANSWER .NE. 2)

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

151

1

2

3

4

5

6

7

8

9 10

1

2

3

4

5

6

7

8

9 10

1

1

12

13

14

1516

17

18

1920

2122

23

2425

26

2728

29

30 154

155

1 56 157

1 58 159

1 60

1 6 1

1 62 163

1 64 165

166

167 166 U9

1 70 171

1 72 173

1 74 175

1 76

167
FTN 5.1+552

SUBROUTINE DATA IN

03 / 12 /24 . 10.36,12 PAGE 74/175 OPT=0

7

6 j .AND. (ANSUER .NE. 1) STYFE3 177

66 + AND (ANSWER .NE, 0)) THEN STY FES i 7 0 67 PRINT* STYPES 179

68 PRINT*, ' INCORRECT NUMBER !!

STYPES 1 80

69 PRINT*, ' TRY AGAIN!! -OR- ENTER "0" TO ESCAPE DATA ENTRY MODE ' STYPES 1 8 1 70 GOTO 99 STYPES 182

71 END IF STYPES 183

72 it STYPES 1 8 4 73 A STYPES 185

74 IF ( ANSUER .EQ. 1 ) THEN STYPES 1 86 75 3 00 PRINT* STYPES 187

76 PRINT*, 'ENTER "ID'' (EG. '

' UA '

' OR ''DE'')' STYPES 1 8 5 77 REWIND 1 STYFES 189

78 READ( 1

, * ,END=300) ID STYPES i 90 79 IF ( ( ( ICHAR( ID( 1 ; 1 ) ) . EQ . 55) STYPES 1 9 1 80 + OR. ( ICHAR< ID( 1 : 1 ) ) .EQ. 36)) STYPES 1 92

81 + AND. ( ICHAR(ID(2 ; 2) ) . GE . 33) STYFES 193

82 + AND. ( ICHARC ID (2 : 2 ) ) .LE. 58) STYPES 1 94 83 + AND. (GETLEN(ID) . EQ , 2)) THEN STYPES 195

84 TYPE(EINE,1) = ID STYPES 1 96 85 ELSE STYPES 197

86 PRINT* STYPES 1 98 87 PRINT*, 'INCORRECT ENTRY. TRY AGAIN!!' STYFES 199

88 GOTO 300 STYPES 2 00

89 END IF STYPES 20 1 90 * STYPES 2 02

91 440 PRINT* STYPES 203

92 PRINT*, 'ENTER HEIGHT, METERS' STYPES 204

93 REWIND 1 STYPES 205

94 READ( 1

, * ,END=440) TDIM(LINE,1) STYPES 2 06

95 t STYFES 20 7 96 460 PRINT* STYPES 208

97 PRINT*, 'ENTER WIDTH, METERS' STYPES 209

98 REWIND 1 STYPES 2 10 99 READ( 1

, * , END=460 ) TDIM(LINE,2) STYPES 2 1 1 100 * STYPES 2 12

10 1 470 PRINT* STYPES 213 102 PRINT*, 'ENTER DISTANCE ABOVE FLOOR, METERS' STYPES 2 14 103 REWIND 1 STYPES 215

104 READ( 1

, * ,END=470) TDIM(LINE,4) STYPES 2 16 105 * STYPES 217

106 480 PRINT* STYPES 2 1 8 107 PRINT*, 'ENTER THICKNESS OF LAYER, CENTIMETERS' STYPES 219

108 REWIND 1 STYPES 220

109 READ ( 1

, * , END=480 ) TDIM(LINE,3) STYPES 221

1 10 * STYPES 222

11 1 500 PRINT* STYPES 223

112 PRINT*, 'ENTER "MATERIAL ID OF LAYER" (E.G. ''MOl'') ' STYPES 224

113 REWIND 1 STYPES 225 114 READ( 1

, * ,END=500) MAT STYPES 226

115 IF ( ( GETLEN(MAT) . EQ 3

)

STYPES 227

1 16 + .AND. (MAT(1:1) . EQ . 'M') STYPES 228 117 + .AND. ( ICHAR(MAT( 2 : 2) ) . GE 16) STYPES 2 29

1 18 + .AND. ( ICHAR(MAT( 2 : 2 ) ) . LE . 25) STYPES 2:-o

1 1 9 + .AND. ( ICHAR(MAT( 3 ; 3 ) ) . GE . 16) STYPES 23 1 120 + AND. ( ICHAR(MAT(3 ; 3 ) ) .LE. 25)) THEN STYPES 2 32

12 1 TYPE(LINE,2) = MAT STYPES 233

122 ELSE STYPES 2 34 123 PRINT* STYPES 235 124 PRINT*, 'INCORRECT ENTRY!! TRY AGAIN' STYPES 2 36 125 GOTO 500 STYPES 237

126 END IF STYPES 2 38 127 * STYPES 239

128 5 10 PRINT* STYPES 240

168
rXN 5 1*352

SUBROUTINE DATAIN

83/12/24 10.36.12 PAGE

74/175 OPT=0

8

1 29 PRINT*, 'ENTER "MATERIAL ID OF FRAME" (E.G. '

' MO 1' '

)

STYPES 241 130 REWIND 1 STYPES 2 42

13 1 READ( 1

, * , END=51 0) FMAT STYPES 243

132 IF ( (GETLEN(FMAT) . EQ. 3) STYPES 2 44 133 AND. (FMAT(1;1) .EQ. 'M') STYPES 245

1 34 •f AND. ( ICHAR(FMAT(2 : 2) ) .GE . 16

)

STYPES 2 46 135 AND. ( ICHAR(FMAT(2 ; 2) ) . LE . 25 ) STYPES 247

1 36 4> AND. ( ICHAR(FMAT(3 : 3) ) .GE . 16

)

STYPES 2 48 137 •f AND ( ICHAR(FMAT< 3 : 3) ) . LE . 25)) THEN STYPES 249

1 38 TYPE(LINE,3) = FMAT STYPES 250

139 ELSE STYPES 251 140 PRINT* STYPES 2 52

14 1 PRINT*, 'INCORRECT ENTRY!! TRY AGAIN' STYPES 253

142 GOTO 510 STYPES 2 54 143 END IF STYPES 255

144 END IF STYPES 256

145 t STYPES 257

1 46 t STYPES 2 58 147 t STYPES 259

148 IF (ANSWER .EQ.2) THEN STYPES 260

14 9 580 PRINT* STYPES 261 ISO PRINT*, 'ENTER THICKNESS OF LAYER, CENTIMETERS' STYPES 2 62

15 1 REWIND 1 STYPES 263

152 READ( 1

, * ,END=580) TDIM(LINE,3) STYPES 264

15 3

* STYPES 265

154 600 PRINT* STYPES 2 66 155 PRINT*, 'ENTER "MATERIAL ID OF LAYER" (E.G. '

' MO 1' ' )

' STYPES 267

156 REWIND 1 STYPES 268

157 READ( 1

, * , END = 6 0 0 ) MAT STYPES 269

158 IF ( (GETLEN(MAT) EQ. 3) STYPES 2 70 159 -f AND. (MAT( 1:1) EQ. 'M' ) STYPES 27 1 160 + .AND. ( ICHAR(MAT(2 : 2 ) ) . GE

.

16 ) STYPES 2 72

16 1 + AND. ( ICHAR(MAT( 2 : 2) ) . LE

.

25 ) STYPES 273

162 + .AND. ( ICHAR(MAT(3 : 3 ) ) . GE

.

16) STYPES 2 74 163 + AND. ( ICHAR(MAT(3 ; 3) ) . LE

.

25)) THEN STYPES 275

164 TYPE (LINE ,2) = MAT STYPES 2 76 165 ELSE STYPES 277

166 PRINT* STYPES 2 78 167 PRINT*, 'INCORRECT ENTRY!! TRY AGAIN' STYPES 279

168 GOTO 600 STYPES 2 80 169 END IF STYPES 281 170 TYPE(LINE,3) = TYPE ( L INE - 1 , 3

)

STYPES 282

17 1 TYPE(LINE,1) = TYPE(LINE-1 , 1) STYPES 283

172 TDIM(LINE,n = TDIM(LINE-1 , 1

)

STYPES 2 84 173 TDIM(LINE,2) = TD IM ( LI NE - 1 , 2

)

STYPES 285

174 TDIK(LINE,4) = TD IM ( L I NE - 1 , 4

)

STYPES 2 86 175 END IF STYPES 287

176 RETURN STYPES 2 88 177 END STYPES 289

--VARIABLE MAP--(LOrA)

-NAME- --ADDRESS- -BLOCK- -PROPERTIES TYPE ---SIZE

ABOVE NONE UNUSED/*S* REAL ANSWER 1 0 7 6B INTEGER

DIR NONE UNUSED/*S* CHAR*3

DOK NONE UNUSED/*S* INTEGER

FMAT 1 lOlB CHAR*3

H NONE UNUSED/ *S* REAL

ID 1 07 7B CHAR*3

INSERT 1 DUMMY-ARG INTEGER

LINE 2 DUMMY-ARG INTEGER

LOK NONE UNUSED/ *S* INTEGER

169
PTN 5 1+552 83/12/24 10.36.12 PAGE 9 SUBROUTINE DATAIN 74/175 OPT = 0

MAT 1 1 OOB CHAR*3

NOK NONE UNUSED/ *S* INTEGER

NROOMS 1244B /ROOMN/ INTEGER RAREA 1245B /ROOMN/ REAL 20 ROOM OB /ROOMN/ REAL 676 T NONE UNUSED/*S* REAL TDBTOT 32 3B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*

3

35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 324B /TYPEN/ INTEGER

TTOT 21 4B /TYPEN/ INTEGER TYPE OB /TYPEC/ CHAR*3 105

V NONE UNUSED/ *S* INTEGER

VAL NONE UNUSED/ *S* INTEGER

U NONE UNUSED/ *S» REAL

-SYMBOLIC C0NSTANT5--(L0=A)

-NAME -TYPE VALUE

RMAX INTEGER 20 TMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME--- ---TYPE- --ARGS--- ---CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS--! L0=A) -LABEL- ADDRESS------PROPERTIES DEF -LABEL -ADDRESS------PROPERTIES DEF

99 7B 45 480 21 3B 1 06 100 16B 49 500 22 7B 1 1 1 300 70B 75 5 10 31 IB 1 28 440 147B 91 580 37 7B 149 460 163B 96 6 00 41 3B 1 54 470 177B 101

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS- -ARCS- --

DATAIN 5B 2

-I/O UNITS--(LO=A)

-NAME--- PROPERTIES

TAPEl FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

1104B = 580

U70B = 952

63000B = 26112

0.328 SECONDS

170
FTN 5 U552

SUBROUTINE MANIP

83 / 12 / 24 . 10 .36 .12 PAGE

74/175 OPT=0

10

1

2

3

45

6

7

8

9

1 0

1 1 12

13

14

15

16

17

18

1920

2122

23

24

2526

27

28

29

SUBROUTINE MANIP (QUIT, ABORT)

ttt»tttt**ttt*ii**tt*t**»*tt***ttttii**t*****t**t*t***t*t**t*t**t*t****

*•» COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS

»t*»*t*t*tt*t*ttt**tttt*t*tttttt*t*t*tt*tt*tt*t*tt*t*tt****tt***tt*t*t

INTEGER TMAX PARAMETER (TMAX=35)

COMMON /TYPEN/TDIM(TMAX , 4) ,TT0T,TDB2 (TMAX , 2 ) ,TDBTOT,TERR

COMMON /TYPEC/TYPE(TMAX,3) ,TDB1(TMAX)

INTEGER TTOT,TDBTOT,TERR

REAL TDIM,TDB2

CHARACTER * 3 TYPE,TDB1

DESCRIPTION OF ARRAYS

ID MATERIAL FRAME MATERIAL

TYPE(X, 1) A3 TYPE(X, 2) A3 TYPE(X, 3) A3

HEIGHT WIDTH LAYER THICKNESS

DISTANCE

ABOVE FLOOR

TD I M ( X , 1

)

F8 . 2 TDIM( X, 2) F8 .2 TDIM( X, 3) FB .2 TDIM( X, 4) F8 . 2

ID ATTENUATION AREA

TDBKX)

A3 TDB2 (X, 1

)

E9 . 3 TDB2(X,2)

E9 . 3

3TYPES

***COMT

**»COMT

***COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

290

1

2

3

4

e

6

7

8

9 10

1

1

1213

14

15

16

17

18

1920

212223

24

2526

2728

30 2?

31 t*AtAtAAt*ftft*A**A*t*A**A***t A** tA*A]kA*AA*****ltAAiltt**1t*A***tA***«A** * COMT 30 32 INTEGER ABORT, ANSWER, DOK , FL AG 1 , LOK ,N , NOK , OK , OK 1 ,OK2 , QUIT, INSERT STYPES 2 92 33 INTEGER TEMP ,V, X,Y, COMMAND STYPES 293

34 * STYPES 294

35 10 FLAGl = 0 STYPES 295

36 PRINT* STYPES 296

37 PRINT*

,

'CHOOSESTYPES 297

38 PRINT*

,

' (I) DISPLAY LINE OF DATA (4) DISPLAY ALL LINES' STYPES 2 98

39 PRINT*

,

' (2) INSERT LINE INTO FILE (5) APPEND LINES OF DATA' STYPES 299

40 PRINT*

,

' (3) DELETE LINE (6) STORE DATA AND EXIT ', STYPES 300

41 + ' PROGRAM' STYPES 301

42 PRINT*

,

' (7) EXIT PROGRAM WITHOUT ' STYPES 302

43 + 'STORING DATA' STYPES 303

44 PRINT*

,

' ENTER A NUMBER ! !

!

STYPES 304

45 PRINT* STYPES 305

46 REWIND 1 STYPES 3 06

47 READ( 1

,

*,END=10) COMMAND STYPES 307

48 * STYPES 308

49 * STYPES 309

50 tut DISPLAY LINE *** STYPES 3 10 51 t STYPES 311

52 IF ( COMMAND . EQ . 1 ) THEN STYPES 3 12 53 t STYPES 3 1 3 54 tut INDICATE EMPTY DATA FILE STYPES 3 1 4 55 IF ( TTOT .EQ. 0 ) THEN STYPES 315

56 PRINT* STYPES 3 1 6 57 PRINT*, 'DATA FILE IS EMPTY !!!' STYPES 317

58 t STYPES 3 18 59 t** ENTER NUMBER OF LINE TO BE DISPLAYED STYPES 3 1 9 60 ELSE STYPES 320

61 100 PRINT* STYPES 32 1 62 PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DISPLAYED' STYPES 322

63 PRINT*, ' ( ENTER "0" TO ESCAPE DISPLAY MODE )' STYPES 323

64 REWIND 1 STYPES 324

171
FTN 5.1+552 83/12/24. 10.36.12 PAGE SUBROUTINE MANIP 74/175 OPT=0

1

1

65 READ( 1

, »,END=100) N STYPES 325

66 t STYPES 326

67 tt n CHECK VALIDITY OF LINE NUMBER STYPES 327

68 IF ( (N GT. TTOT) OR. (N .LT . 0) ) THEN STYPES 328

69 PRINT* STYPES 329

70 PRINT*, ' INCORRECT NUMBER !! ! ! !

!

TRY AGAIN ! ! !

' STYPES 3 :-3 71 PRINT*, • -OR- ENTER "0" TO ESCAPE ID 1 STYPES 331

72 + '"DISPLAY" MODE' STYPES 332

73 GOTO 100 STYPES 333

74 t STYPES 334

75 t** ABORT 'DISPLAY' MODE STYPES 335

76 ELSE IF ( N .EQ. 0 ) THEN STYPES 336

77 PRINT* STYPES 337

78 PRINT*, ' "DISPLAY" MODE ABORTED ! !

!

STYPES 3 38 79 t STYPES 339

80 ttt DISPLAY LINE OF DATA STYPES 3 40

81 ELSE IF ( (N .GT. 0) .AND. <N ,LE. TTOT) ) THEN STYPES 341

82 PRINT* STYPES 342

83 CALL DISPLAY! N, COMMAND) STYPES 343

84 t STYPES 344

85 END IF STYPES 345

86 END IF STYPES 346

87 END IF STYPES 347

88 t STYPES 3 48 89 t STYPES 349

90 * * * INSERT LINE *** STYPES 3 50

91 % STYPES 351

92 IF ( COMMAND .EQ. 2 ) THEN STYPES 352

93 t STYPES 353

94 * * * INDICATE EMPTY DATA FILE STYPES 354

95 IF ( TTOT .EQ. 0 ) THEN STYPES 355

96 PRINT* STYPES 356

97 PRINT*, 'DATA FILE IS EMPTY !! !

' STYPES 357

98 t STYPES 358

99 t * A REQUEST NUMBER OF LINE BEFORE WHICH INSERTION IS TO EE; MADE STYPES 359

1 00 ELSE STYPES 360

10 1 200 PRINT* STYPES 36 1 102 PRINT*, 'SPECIFY NUMBER OF LINE BEFORE WHICH A NEW LINE IS ' , STYPES 362

103 + 'TO BE INSERTED' STYPES 363

104 PRINT*, ' ( ENTER "0" TO ESCAPE “INSERTION" MODE )

STYPES 364

105 REWIND 1 STYPES 365

106 READd ,*,END = 2 0 0 ) N STYPES 3 66 107 A STYPES 367 108 AAA CHECK FOR VALID LINE NUMBER STYPES 368

109 IF ( ( N .LT. 0 ) .OR. ( N .GT . TTOT ) ) THEN STYPES 369 no PRINT* STYPES 3 70

11 1 PRINT*, ' INCORRECT NUMBER !! 1

' STYPES 371 112 PRINT*, ' TRY AGAIN ! !

!

-OR- ENTER "0" TO ESCAPE'

,

STYPES 372

113 + '"INSERTION" MODE' STYPES 373

114 GOTO 200 STYPES 374

115 A STYPES 375

1 16 AAA ABORT INSERTION MODE STYPES 376

117 ELSE IF ( N EQ. 0 ) THEN STYPES 377

118 PRINT* STYPES 3 78 119 PRINT*, ' "INSERTION" MODE ABORTED' STYPES 379

1 20 A STYPES 380

121 AAA MAKE ROOM FOR NEW LINE OF DATA STYPES 381

1 22 ELSE IF ( <N GT. 0) AND. (N .LE. TTOT) ) THEN STYPES 382

123 DO 230 X = TTOT, N, -1 STYPES 383

124 DO 210 Y = 1,3 STYPES 384

125 TYPE(X+1,Y) = TYPE(X,Y) STYPES 385

126 210 CONTINUE STYPES 386 127 DO 220 Y = 1,4 STYPES 387

128 TDIM(X+1 , Y) = TDIMIX ,Y) STYPES 388

172
rXN 5 I *15

2

SUBROUTINE MANIP 83/12/24 . 10 .36.12 PAGE

74/175 OPT=0

12

12V 220 CONTINUE STYFES 389

1 30 230 CONTINUE 5TYPES 3 90

13 1 • STYPES 391

1 32 t «

t

ENTER DATA FOR NEW LINE STYPES 3 92 133 TTOT = TTOT + 1 STYPES 393

134 CALL DATAIN (1,N) STYPES 394

135 STYPES 395

136 tut INITIALIZE FLAGS STYPES 3 96 137 OKI = 0 STYPES 397

138 OK2 = 0 STYPES 3 98 139 OK = 0 STYPES 399

1 40 t STYPES 400

14 1 * ft t TEST VALIDITY OF DATA STYPES 401

142 ft STYPES 4 02 143 »**TEST IF NEW LAYER BELONGS TO THE NEXT TYPE STYPES 403

144 IF ( ( TYPE(N,1) .EQ. TYPE(N+1,1) ) STYPES 4 04 145 + .AND. ( TYPE(N,3) EQ. TYPE(N+1,3) ) ) THEN STYPES 405

146 IF ( ( TDIM(N,1) .EQ. TDIM(N+1,1) ) STYPES 4 06 147 + AND. ( TDIM(N,2) .EQ. TDIM<N+1,2) ) STYPES 407

148 + .AND. ( TDIM(N,4) .EQ. TDIM(N+1,4) ) ) THEN STYPES 408

149 OKI = 1 STYPES 409

ISO END IF STYPES 4 10

15 1 END IF STYPES 4 1 1

1 52 ft STYPES 4 12 153 ft ft ft TEST IF NEW LAYER BELONGS TO PREVIOUS TYPE STYPES 413

154 IF ( N GT. 1 ) THEN STYPES 4 14 155 IF ( ( TYPE(N,1) .EQ. TYPE(N-1,1) ) STYPES 4 1 5 156 + AND. ( TYPE(N,3) .EQ. TYPE(N-1,3) > ) THEN STYPES 4 16 157 IF ( ( TDIK(N,1> .EQ. TDIM(N-1,1) ) STYPES 417

158 + AND. ( TDIM(N,2) EQ. TDIM(N-1,2) ) STYPES 4 18 159 + .AND. ( TDIM(N,4) EQ. TDIM(N-1,4) ) ) THEN STYPES 4 1 9

1 60 OK2 = 1 STYPES 420

16 1 END IF STYPES 421 162 END IF STYPES 4 22 163 END IF STYPES 423

164 ft STYPES 4 24 165 IF ( ( OKI .EQ. 1 ) OR. ( OK2 . EQ . 1 ) ) THEN STYPES 425

166 OK = 1 STYPES 426

167 END IF STYPES 427

168 ft STYPES 426

169 IF ( OK EQ. 1 ) THEN STYPES 429 170 PRINT* STYPES 4 30

17 1 PRINT*, ‘THE FOLLOWING LINE HAS BEEN ADDED AS LINE ' / N STYPES 431 172 CALL DISPLAY! N, COMMAND) STYPES 4 32 173 ft STYPES 433

174 ft ft* REJECT DATA IF DATA DOESN'T MATCH PREVIOUS OR NEXT LAYER STYPES 4 34 175 ELSE IF ( OK EQ. 0 ) THEN STYPES 435

176 PRINT* STYPES 4 36 177 PRINT*, ‘YOUR DATA WAS NOT ACCEPTED !!!' STYPES 437

178 PRINT*, ‘YOUR DATA MUST REPRESENT A LAYER ', STYPES 4 38 179 -f ‘IN AN EXISTING DOOR OR WINDOW' STYPES 439

180 PRINT*, ' I.E. THE ID, FRAME MATERIAL, HEIGHT, ', STYPES 4 40

18 1 + 'WIDTH, AND DISTANCE ABOVE FLOOR' STYPES 44 1 182 PRINT*, ' PARAMETERS MUST MATCH THE DOOR OR ' , STYPES 4 42 183 + 'WINDOW JUST BEFORE' STYPES 443

184 PRINT*, ' OR JUST AFTER YOUR SPECIFIED INSERTION '

, STYPES 4 44 185 + ' POINT' STYPES 445

186 PRINT* STYPES 4 46 187 PRINT*, 'THE FOLLOWING DISPLAYS' STYPES 4 47 188 IF ( N GT. 1 ) PRINT*, 'THE LINE BEFORE YOUR LINE,' STYPES 4 48 189 PRINT*, 'YOUR LINE, AND THE LINE AFTER' STYPES 449

190 PRINT* STYPES 4 50

19 1

ft STYPES 45 1 192 ft ft* DISPLAY LINES OF DATA STYPES 452

173
FTN 5 . 1+552

SUBROUTINE MANIP

03/12/24. 10.36.12 PAGE 74/175 OPT=0

13

193 IF ( N GT. 1 ) CALL DISPLAY ! N- 1, COMMAND ) STYPES 453 194 CALL DISPLAY! N, COMMAND) STYPES 454

195 CALL DISPLAY ( N+ 1 , COMMAND) STYPES 455

196 A STYPES 456

197 * ** REMOVE THE LINE OF INCORRECTLY ENTERED DATA STYPES 457 198 DO 270 X = N.TTOT STYPES 458

199 DO 25 0 Y = 1 ,

3

STYPES 459 200 TYPE (X , Y) = TYPE(X + 1 ,Y) STYPES 4 60

20 1 250 CONTINUE STYPES 46 1 202 DO 2 6 0 y = 1 ,4 STYPES 462

20 3 TDIM(X, Y) = TDIM! X+1,Y) STYPES 463 204 260 CONTINUE STYPES 4 64 205 270 CONTINUE STYPES 465 206 TTOT = TTOT - 1 STYPES 4 66 207 END IF STYPES 467 208 END IF STYPES 4 68 20 9 END IF STYPES 469

2 10 END IF STYPES 4 70

21 1 t STYPES 471

2 12 t STYPES 472 213 A A * DELETE LINE *** STYPES 473

2 14 A STYPES 4 74 215 IF ( COMMAND .EQ. 3 ) THEN STYPES 475

2 16 A STYPES 4 76 217 AAA INDICATE EMPTY DATA FILE STYPES 477

2 18 IF ( TTOT EQ. 0 ) THEN STYPES 4 78 219 PRINT* STYPES 479 220 PRINT*, 'DATA FILE IS EMPTY '!!' STYPES 480

22 1 A STYPES 48 1 222 A AA READ NUMBER OF LINE TO BE DELETED STYPES 482

223 ELSE STYPES 483 224 300 PRINT* STYPES 4 84 225 PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DELETED' STYPES 485 226 PRINT*, ' (ENTER "0" TO ESCAPE DELETION MODE) ' STYPES 486 227 REWIND 1 STYPES 487

2 28 READ( 1

, * ,END=300) N STYPES 4 88 229 A STYPES 489 230 AAA CHECK VALIDITY OF LINE NUMBER . STYPES 4 90 23 1 IF ( (N GT. TTOT ) .OR. ( N .LT. 0 ) ) THEN STYPES 491 232 PRINT* STYPES 4 92 233 PRINT*, ' INCORRECT NUMBER !!!' STYPES 493 234 PRINT*, ' TRY AGAIN ! ! ! -OR - ENTER "0" TO ESCAPE ID ' , STYPES 494 235 + '"DELETE" MODE' STYPES 495 236 GOTO 300 STYPES 4 96 237 A STYPES 497 238 AAA ABORT 'DELETE' MODE STYPES 4 9 8 239 ELSE IF ( N EQ. 0 ) THEN STYPES 499 240 PRINT*, ' "DELETE" MODE ABORTED' STYPES 5 00

24 1 A STYPES 501 242 AAA DOUBLE CHECK CHOICE OF LINE TO BE DELETED STYPES 5 02 243 ELSE IF (( N GT. 0 ) AND. ( N . LE. TTOT )

)

THEN STYPES 503 244 PRINT* STYPES 5 04 245 PRINT* , 'DOUBLE CHECK ! !

!

STYPES 505 246 PRINT*, ' DO YOU WANT TO DELETE THE FOLLOWING LINE? ;

STYPES 506

247 CALL DISPLAY! N, COMMAND) STYPES 507 248 305 PRINT*, ' ENTER !1) YES OR !2) NO ' STYPES 508 249 REWIND 1 STYPES 509 250 READ! 1

, * ,END=305) ANSWER STYPES 5 10 25 1 A STYPES 511 252 AAA DELETE LINE STYPES 5 12 253 IF ! ANSWER . EQ . 1 ) THEN STYPES 5 1 3 254 DO 330 X = N, TTOT - 1 STYPES 5 14 255 DO 310 Y = 1,3 STYPES 515

256 TYPE !X ,¥) = TYPE!X + l ,Y) STYPES 5 16

174
rTN 5 U552 83/12/24. 10 36.12 PAGE 14 SUBROUTINE MANIP 74/175 OPT=0

257 3 1 0 CONTINUE STYPES 5 17 256 DO 320 Y = 1,4 STYPES 5 IB 259 TDIM( X, Y) = TDIM( X+ 1 , Y) STYPES 5 1 9 260 320 CONTINUE STYPES 5 20

26 1 330 CONTINUE STYPES 52 1 262 TTOT = TTOT - 1 STYPES 5 22

26 3 PRINT* STYPES 523

264 PRINT*, 'LINE # ’,N,' DELETED' STYPES 5 24 265 END IF STYPES 525

2 66 t STYPES 526

26 7 END IF STYPES 527

268 END IF STYPES 528

269 END IF STYPES 529

270 t STYPES 5 30

27 1 t •- STYPES 53 1 272 tut DISPLAY ALL DATA *** STYPES 5 32 273 * _

.

STYPES 533

274 IF ( COMMAND EQ. 4 ) THEN STYPES 5 34 275 « STYPES 535 276 * « Ik INDICATE EMPTY DATA FILE STYPES 5 36 277 IF ( TTOT .EQ. 0 ) THEN STYPES 537

278 PRINT* STYPES 5 36 279 PRINT*, 'DATA FILE IS EMPTY !!!' STYPES 539

280 Ik STYPES 5 40

28 1 t * ft DISPLAY DATA STYPES 541 282 ELSE STYPES 5 42 283 PRINT* STYPES 543

284 CALL DISPLAY! N, COMMAND) STYPES 5 44 285 Ik STYPES 545

286 END IF STYPES 5 46 287 END IF STYPES 547

286 A STYPES 5 48 289 » - STYPES 549

290 A * * ADD DATA *** STYPES 550

29 1 A - STYPES 551 292 IF ( COMMAND . EQ . 5 ) THEN STYPES 5 52 293 A STYPES 553

294 AAA ENTER DATA STYPES 554

295 500 TTOT = TTOT + 1 STYPES 555 296 A STYPES 5 56 297 CALL DATA IN (0 , TTOT

)

STYPES 557

298 510 PRINT* STYPES 558

299 PRINT*, 'DO YOU WANT TO ENTER MORE DATA? (1) YES (2) NO' STYPES 559

300 PRINT*, ' ENTER A NUMBER !!!' STYPES 5 60

30 1 REWIND 1 STYPES 561 302 READ(1,*,END=510) ANSWER STYPES 5 62 303 A STYPES 563

304 AAA CHECK VALIDITY OF NUMBER STYPES 5 64 305 A STYPES 565

306 AAA ENTER MORE DATA STYPES 5 66 307 IF ( ANSWER EQ. 1 ) THEN STYPES 567

308 GOTO 500 STYPES 568

309 A STYPES 569

310 AAA DISCONTINUE DATA ENTRY STYPES " 70

31 1 ELSE IF ( ANSWER . EQ . 2 ) THEN STYPES 57 1 3 12 PRINT* STYPES 5 72 313 PRINT*, 'DATA ENTRY DISCONTINUED' STYPES 573

3 14 A STYPES 5 74 315 AAA INVALID ENTRY STYPES 575

3 16 ELSE STYPES 5 76 317 GOTO 510 STYPES 577

3 18 END IF STYPES 5 71

31 9 END IF STYPES 579

320 A STYPES 580

175
FTN 5.1+552 03/12/24, 10.36.12 PAGE 15 SUBROUTINE MAMIP 74/175 OPT=0

321

322 323

*

* * *

* STORE DATA AND PROGRAM ***

ST':(FES STYPE3

53 1

5 31 583 324 IF ( COMMAND ,EQ. 6 ) THEN STYPES 5 84 325 600 PRINT* STYPES 585

326 PRINT* ,

' DOUBLE CHECK IN' STYPES 5 86 327 PRINT*, ' DO YOU YOU WANT TO STORE THIS DATA AND END PROG’ STYPES 587 328 PRINT*, ' NOTE STORING THIS DATA WILL WIPE OUT ANY OLD FILE ' STYPES 5 68 329 PRINT*, ' OF THE SAME NAME !!!' STYPES 589 330 PRINT*, ' ENTER A NUMBER: (1) YES (2> NO’ STYPES 5 93

33 1 REWIND 1 STYPES 591

3 32 READd , * , END = 60 0) ANSWER STYPES 5 92 333 * STYPES 593

3 34 AAA SET FLAG FOR STORING DATA IN THE MAIN PROGRAM STYPES 5 94 335 IF ( ANSWER EQ. 1 ) THEN STYPES 595

336 QUIT = 1 STYPES 5 96 337 RETURN STYPES 597

3 38 A STYPES 5 96 339 AAA ABORT 'STORING' MODE STYPES 599 340 ELSE IF ( ANSWER ,EQ. 2 ) THEN STYPES 600

34 1 PRINT* STYPES 601 342 PRINT*, ' "STORING" MODE DISCONTINUED STYPES 6 02 343 A STYPES 603 344 AAA CHECK VALIDITY OF ANSWER STYPES 6 04 345 ELSE IF ( ( ANSWER ,NE. 1 ) AND. ( ANSWER NE. 2 ) ) THEN STYPES 6 05 346 GOTO 600 STYPES t C 6 34 7

A STYPES 607 348 END IF STYPES 6 3 8 349 END IF STYPES 6 0 9 350 A STYPES 6 10 35 1 A STYPES 6 11 352 AAA END PROGRAM WITHOUT STORING DATA *** STYPES 6 12 35 3

A __ STYPES 613 354 IF ( COMMAND EQ. 7 ) THEN STYPES 6 14 355 700 PRINT* STYPES 615

356 PRINT* , ’DOUBLE CHECK ! !

!

STYPES 6 16 357 PRINT*, ' DO YOU WANT TO END THIS PROGRAM ', STYPES 617 358 + ’WITHOUT STORING DATA?’ STYPES 6 18 359 PRINT*, ’ ENTER A NUMBER: (1) YES < 2 ) NO ' STYPES 619 360 REWIND 1 STYPES 6 20

36 1 READ( 1

, * , END=700) ANSWER STYPES 621 362 A STYPES 622

36 3 AAA SET FLAG FOR ABORTING PROGRAM IN THE MAIN PROGRAM STYPES 623 364 IF ( ANSWER .EQ. 1 ) THEN STYPES 624 365 ABORT = 1 STYPES 625 366 RETURN STYPES 6 2.6 36 7

A STYPES 627 368 AAA ABORT ’STORING' MODE STYPES 6 28 369 ELSE IF ( ANSWER . EQ . 2 ) THEN STYPES 629

3 70 PRINT* STYPES 6 30

37 1 PRINT*, ' "ABORTION" MODE DISCONTINUED’ STYPES 631 372 A STYPES 6 32 37 3 AAA CHECK VALIDITY OF ANSWER STYPES 633 374 ELSE IF ( ( ANSWER . NE . 1 ) .AND ( ANSWER .NE. 2 ) ) THEN STYPES 6 34 375 GOTO 700 STYPES 635 376 A STYPES 6 36 377 END IF STYPES 637

3 78 END IF STYPES 6 38 379 A STYPES 639 5TYPFS 6 40

38 1 AAA LOOP TO BEGINNING OF ’MANIP’ SUBROUTINE STYPES 641

O

0

U

Q ?

6 STYPFr?^ 6 42 38 3 GOTO 10 STYPES 643

384 A STYPES 6 44

176
rTN 5 U5 52 SUBROUTINE MANIP

83/12/24. 10.36.12 PAGE

74/175 OPT=0

16

385 RETURN STYPES 6 45 TRIVIAL* NO 386 PATH TO THIS STATEMENT

END STYPES 646

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK -PROPERTIES TYPE ---SIZE

ABORT 2 DUMMY-ARG INTEGER

ANSWER 20 30B INTEGER

COMMAND 20 40B INTEGER

DOK NONE UNUSED/ *S* INTEGER

FLAGl 203 IB INTEGER

INSERT NONE UNUSED/*S» INTEGER

LOK NONE UNUSED/ *S* INTEGER

N 2032B INTEGER

NOK NONE UNUSED/ *S* INTEGER

OK 2 033B INTEGER

OKI 2034B INTEGER

OK 2 20 35B INTEGER

QUIT 1 DUMMY -ARG INTEGER

TDBTOT 3 2 3B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TEMP NONE UNUSED/ *S* INTEGER

TERR 32 4B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3 1 05 V NONE UNUSED/ *S* INTEGER

X 2036B INTEGER

Y 2037B INTEGER

--SYMBOLIC CONSTANTS-

-NAME TYPE

-( LO=A> VALUE

TMAX INTEGER 35

--PROCEDURES--(LO=A)

-NAME TYPE ---ARGS--- ---CLASS

DATA IN 2 SUBROUTINE

DISPLAY 2 SUBROUTINE

--STATEMENT LABELS--! LO=A) LABEL- ADDRESS --PROPERTIES- ---DEE -LABEL- ADDRESS --PROPERTIES- ---DEF

10 7B 35 300 5 4 7B 224

100 50B 61 305 61 6B 248

200 133B 101 3 10 INACTIVE DO-TERM 257

210 INACTIVE DO-TERM 126 320 INACTIVE DO-TERM 260

220 INACTIVE DO-TERM 129 330 INACTIVE DO-TERM 261 230 INACTIVE DO-TERM 130 500 74 IB 295

250 INACTIVE DO-TERM 201 5 10 74 5B 2 98 260 INACTIVE DO-TERM 204 600 lOOlB 325

270 INACTIVE DO-TERM 205 700 1 05 3B 355

177
rTN 5.1+552 83/12/24, 10.36.12 PAGE 17 SUBROUTINE MANIP 74/175 OPT=0

-ENTRY PO INTS--( LO=A) -NAME --- ADDRESS-- ARCS- --

MANIF 5B 2

-I 10 UNITS--(LO = A) -NAME PROPERTIES

TAPEl FMT/SEQ

-STAT1STIC3--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

20 54B

37 7B 63000B

1068

255

26112

0.553 SECONDS

1 TRIVIAL ERROR IN MANIP

178
FTN 5 U552 83/12/24. 10.36.12 PAGE 18 SUBROUTINE DISPLAY 74/175 OPT=0

1

23

45

67

8

9

1 0 1112

13

1 4 15

1617

181920

212223

24

25

2627

28

29

30

3132

33

34

3536

3738

3940

4142

43

44

4546

4748

4950

SUBROUTINE DISPLAY (LINE, COMMAND) STYPES

t ttnttttttiiiiiiiii util *iiii tut tt *******%** ****ttttt*tt*t***t***t*tttt** lit **t***COf{J

•** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT

titttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt * *COMT

INTEGER TMAX PARAMETER (TMAX=35)

COMMON /TYPEN/TDIM(TMAX , 4) ,TTOT ,TDB2 (TMAX , 2 ) ,TDBTOT,TERR

COMMON /TYPEC/TYPE(TMAX ,3) ,TDB1(TMAX)

INTEGER TTOT,TDBTOT,TERR

REAL TDIM,TDB2

CHARACTER * 3 TYPE.TDBl

DESCRIPTION OF ARRAYS

ID MATERIAL FRAME MATERIAL

TYPE(X, 1) A3 TYPE(X, 2) A3 TYPE(X, 3) A3

HEIGHT WIDTH LAYER

THICKNESS

DISTANCE

ABOVE FLOOR

TD I M ( X , 1

)

F8 . 2 TDIM( X, 2) F8 . 2 TDIM( X, 3) F8 . 2 TDIM( X, 4) F8 . 2

ID ATTENUATION AREA

TDBKX)

A3 TDB2 (X, 1 ) E9 . 3 TDB2(X,2)E9 . 3

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt <( COMT

ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt

INTEGER LINE, COMMAND, N

10 00 FORMAT ( 1 X , A5 , 2X , A 2 , 2X , A8 , 2X , A8 , 2X , A 1 1 , 2X , A9 , 2 X , A8 , 2X , AB

)

20 00 FORMAT ( 2X , I 3 , 3X , A2 , 3X , F6 . 2 , 4X , F6 . 2 , 4X , F6 . 2 , 7X , F6 . 2 , 6 X , A3

,

+ 7X,A3) PRINT 1000, 'LINE' ,’ ID' , 'HEIGHT ', 'WIDTH ', 'DISTANCE

' ,

' FRAME

' (METERS) ', 'ABOVE FLOOR',

lAL '

, 'MATERIAL

, 1) ,TDIM(LINE, 1) ,TDIM(LINE,2)

,

INE, 3) ,TYPE(LINE,2) , TYPE (LINE,

3

, 1) ,TDIM(LINE, 1) ,TDIM(LINE,2)

,

INE, 3) , TYPE (LINE, 2) , TYPE (LINE,

3

END IF RETURN

END

10

+ 'THICKNESS ',' LAYER

PRINT 10 00 ,

' ' ,

'

' ,

' (METERS) ' , + ' (CM) ' , 'MATER

IF ( COMMAND . EQ . 4 ) THEN

DO 10 LINE = l,TTOT

PRINT 2000, LINE,TYPE(LINE

+ TDIM( LINE ,4) ,TDIM(

L

CONTINUE

ELSE

PRINT 2000, LINE,T¥PE(LINE

+ TDIM( LINE , 4) ,TDIM(

L

***d*COMT

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

STYPES

) STYPES

STYPES

STYPES

STYPES

) STYPES

STYPES

STYPES

STYPES

647

1

2

3

4

5

6

7

8

9 10

1

1

12

1314

1516

17

18

1920

2122

23

24

25

26

2728

29

30

6 49 650

6 51 652

6 53 654

6 55

6 5 6 657

658

659

660

6 61 662

6 63 664

6 65 666

6 67

VARIABLE MAP-- (LO=A)

•NAME ADDRESS -BLOCK -PROPERTIES TYPE ---SIZE

COMMAND 2 DUMMY-ARG INTEGER

LINE 1 DUMMY-ARG INTEGER

N NONE UNUSED/ *S* INTEGER

TDBTOT 323B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 32 4B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER

179
FTN 5,!t552 83/12/24. 10.36.12 PAGE 19 SUBROUTINE DISPLAY 74/175 OPT=0

TYPE OB /TYPEC/ CHAR*3 105

--SYMBOLIC CONSTANTS-- ( LO=A) -NAME TYPE VALUE

TMAX INTEGER 35

--STATEMENT L A BE L S- - ( LO = A

)

-LAB EL -ADDRESS PROPERTI ES DEP

10 INACTIVE DO-TERM 44 1000 163B FORMAT 33 2000 171B FORMAT 34

--ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARGS

DISPLAY 5B 2

--STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

254B = 172

37 7B = 255

61000B = 25088

0 100 SECONDS

180
rXN 5 U552 83/12/24. 10.36.12 PAGE 20 FUNCTION VAL 74/175 OPT=0

1 INTEGER FUNCTION VAL(STRING) STYPES 66

2 C** RETURNS THE INTEGER VALUE OF A STRING. STYPES 6 6

3 INTEGER NUMBER, X , L , EX P , D IG IT , GETLEN STYPES 67

4 CHARACTER » (*) STRING STYPES 6 7

5 L = GETLEN( STRING) STYPES 67

6 NUMBER = 0 STYPES 6 7

7 DO 10 X = L, 1 , -1 STYPES 67

8 EXP = L - X STYPES 6 7

9 DIGIT = ICHAR(STHING(X; X) ) - 16 STYPES 67

10 NUMBER = NUMBER + D I G IT* 1 0 * * EXP STYPES 6 7

1

1

10 CONTINUE STYPES 67

12 VAL = NUMBER STYPES 6 7 13 RETURN STYPES 68

14 END STYPES 6 8

-VARIABLE MAP--(LO=A)

-NAME-- -ADDRESS-- BLOCK - -PROPERTIES -TYPE

DIGIT 76B INTEGER

EXP 75B INTEGER

L 74B INTEGER

NUMBER 72B INTEGER

STRING 1 DUMMY-ARG CHAR* ( *) VAL 71B INTEGER

X 73B INTEGER

-PROCEDURES--(LO= A) -NAME-- TYPE-- ARGS CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS --( LO=A) -LABEL- ADDRESS -- --PROPERTI ES DEF

1 0 INACTIVE DO-TERM 11

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

VAL 6B 1

-STATIST1CS--

PROGRAM-UNIT LENGTH 102B = 66 CM STORAGE USED 6 lOOOB = 25088

COMPILE TIME 0.041 SECONDS

8

9

0

1

2

3

4

5

6

7

8

9

0

1

181
33/12/24. 10.33.12 PAGE 74/175 OPT=0

PTN 5 . 1+552 21 FUNCTION GETLEN

1 INTEGER FUNCTION GETLEN /STRING) STYPES 682

2 C STYPES t 83

3 C DETERMINE LENGTH OF STRING EXCLUDING ANY BLANK PADDING STYFES 6 84

4 C STYPES 6 85

5 C STYFES 686

6 C ARGUMENT DEFINITIONS -- STYPES 6 87

7 C READ ARGUMENTS STYPES 683

8 C STRING - STRING WHOSE LENGTH IS TO BE DETERMINED STYFES 6 89

9 C STYPES 690

1 0 CHARACTER * /*) STRING STYPES 6 91

1 1 C STYPES 692

12 C FUNCTION PARAMETERS STYPES 6 93

13 CHARACTER » 1 BLANK STYPES 694

1 4 PARAMETER /BLANK =

'

‘

)

STYPES 6 95

15 C STYPES 696

16 C LOCAL VARIABLES STYPES 6 97

17 INTEGER NEXT STYFES 698

18 C STYPES 6 99 IV C START WITH THE LAST CHARACTER AND FIND THE FIRST NON-BLANK STYPES 700

20 DO 10 NEXT = LEN/ STRING) , 1

, -1 STYPES 7 01 21 IF /STRING/NEXT : NEXT) . NE . BLANK) THEN STYPES 702

22 GETLEN = NEXT STYPES 703

23 RETURN STYPES 704

24 END IF STYPES 7 05

25 10 CONTINUE STYPES 706

26 C STYPES 7 07

27 C ALL CHARACTERS ARE BLANKS STYPES 708

28 GETLEN = 0 STYPES 7 09

29 C STYPES 710

30 RETURN STYPES 7 11 31 END

VARIABLE MAP--/LO=A)

NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

GETLEN 63B INTEGER

NEXT 64B INTEGER

STRING 1 DUMMY-ARG CHAR*/*)

STYPES 7 1 2

-SYMBOLIC CONSTANTS--/ LO=A) -NAME TYPE- VALUE

BLANK CHAR*1 ' '

-PROCEDURES-- ( LO=A) -NAME TYPE ARCS CLASS

LEN INTEGER 1 INTRINSIC

-STATEMENT L ABE LS- - ( LO = A

)

-LAB EL -ADDRESS PROPERTI ES DEF

10 INACTIVE DO-TERM 25

FTN 5.1+552 83/12/24. 10.36.12 PAGE 22 FUNCTION GETLEN 74/175 OPT=0

--ENTRY POINTS--/ L0=A) -NAME ADDRESS--ARGS

GETLEN 6B 1

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

70B = 56 61000B = 25088

0.041 SECONDS

182
FTN 5 U552 83/12/24. 10.36.12 PAGE 23 SUBROUTINE LTYPE 74/175 OPT=0

1 SUBROUTINE LTYPE LTYPE 1

2 *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LTYPE 2

3 » ! ! ! ! ! ! LTYPE 3

4 »!!! LOAD THE "TYPE" ARRAYS FROM THE TYPE DATA FILE IMLTYPE 4

5 » ! M M ! LTYPE 5

6 *!!!!!!!!!!! M !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! M !!!!!!!!!!!!!!!! LTY P E 6

? **» COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS »*»COMT 2

11 INTEGER TMAX COMT 4 12 PARAMETER (TMAX=35) COMT 5 13 COMMON /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAI,2) ,TDBTOT,TERR COMT 6 14 COMMON /TYPEC/TYPE(TMAI,3) .TDBKTMAX) COMT 7 15 INTEGER TTOT , TDBTOT , TERR COMT 8 16 REAL TDIM,TDB2 COMT 9 17 CHARACTER * 3 TYPE.TDBl COMT 10

18 *================================================= COMT 11 1? * DESCRIPTION OF ARRAYS COMT 12 20 •================================================= COMT 13

21 * ID MATERIAL FRAME MATERIAL COMT 14 22 * COMT 15 23 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT 16 24 » A3 A3 A3 COMT 17 25 *================================================= COMT 18 26 * HEIGHT WIDTH LAYER DISTANCE COMT 19 27 * THICKNESS ABOVE FLOOR COMT 20

28 * COMT 21 29 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT 22 30 » F8.2 F8.2 F8 . 2 F8 .

2

COMT 23

31 «=: = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =: = = = = = = = = = = = = = = = COMT 24

32 * ID ATTENUATION AREA COMT 25

33 * COMT 26

34 » TDBKX) TDB2(X,1) TDB2(X,2) COMT 27

35 * A3 E9.3 E9.3 COMT 28

39 *** COMMON FOR INITIAL PARAMETERS **»COMF 2 40 * * * * * * * 1 1 1 * 1 1 1 * 1 1 1 * * 1 1 * 1 1 1 * * 1 1 1 1 1 1 * * 1 1 * * t * ii 1 1 1 * 1 1 1 1 1 * t * t * * * * * t * 1 1 1 1 * 1 1 1 * QQUY 3 41 INTEGER FMAX COMF 4 42 PARAMETER (FMAX = 50) COMF 5 43 COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF 6 44 5 FTOT COMF 7 45 COMMON /INITILC/ BLDG COMF 8 46 CHARACTER * 5 BLDG COMF 9 47 REAL FREQ, AFLAC, RFLAG, FREQA COMF 10 48 INTEGER QUALITY, FERR, FTOT COMF 11

53 «*•**«* A ***** ******************* ft **************** * LTYPE 10 52 * DECLARATION OF VARIABLES LTYPE 11 53 ************************************************** LTYPE 12 54 INTEGER GETLEN, R, C LTYPE 13 55 CHARACTER * 7 PFN LTYPE 14 5^ ************************************************** LTYPE 15 57 * LTYPE 16 5B ************************************************** LTYPE 17 59 PFN = -B’ II BLDG< 1 ;GETLEN(BLDG) ) II 'T' LTYPE 18 60 TERR = 0 LTYPE 19 61 CALL PF ( GET' , 0 ,PFN( 1 :GETLEN(PFN) ), 'RC ', TERR) LTYPE 20 62 IF (TERR EQ. 0 ) THEN LTYPE 21 63 OPEN (UNIT=3, F1LE=PFN, FORM= ' FORMATTED ' , LTYPE 22 64 $ STATUS='OLD' , ACCESS= ' SEQUENTI AL ' ) LTYPE 23 183
FTN 5,1+552

SUBROUTINE LTYPE

83/12/24. 10.36.12 PAGE 74/175 OPT=0

24

65 10 00 FORMAT ( 1 X, 3( IX , A3 ) , 4 ( IX, F8 . 2) ) LTYPE 24 66 TTOT = 0 LTYPE 1 5 67 DO 10 R = 1,TMAX LTYPE 2 6 68 READ (3,1000, END=20) (TYPE(R,C),C=1,3),(TDIM(R,C),C=1,4) LTYPE 27 69 TTOT = TTOT + 1 LTYPE 28

70 10 CONTINUE LTYPE 29 71 20 CONTINUE LTYPE 30 72 CLOSE (3 ,STATUS= 'DELETE'

)

LTYPE 31 73 ELSE IF ( TERR EQ. 2 ) THEN LTYPE 32 74 CALL WARNING (5) LTYPE 33 75 ELSE LTYPE 34 76 CALL WARNING (6) LTYPE 35 77 END IF LTYPE 36 78 RETURN LTYPE 37 79 END LTYPE 38

-VARIABLE MAP--(LO=A)

-NAME---ADDRESS- -BLOCK PROPERTIES TYPE SIZE

AFLAG 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C 236B INTEGER

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER PFN 23 7B CHAR*7

QUALITY IB / INITILN/ INTEGER

R 23 5B INTEGER

RFLAG 3B / INITILN/ REAL TDBTOT 323B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 21 SB /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 32 4B /TYPEN/ INTEGER

TTOT 21 4B /TYPEN/ INTEGER TYPE OB /TYPEC/ CHAR*3 105

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

FMAX INTEGER 50 TMAX INTEGER 35

-PROCEDURES--(LOrA)

-NAME TYPE

GETLEN INTEGER

PPWARNING

ARGS CLASS

1 FUNCTION

5 SUBROUTINE

1 SUBROUTINE

FTN 5.1+552 83/12/24. 10.36.12 PAGE 2 SUBROUTINE LTYPE 74/175 OPT=0

--ENTRY FOINTS--(LO=A)

-NAME --- ADDRESS-- ARGS- --

LTYPE 5B 0

--I 10 UNITS--(LO=A)

-NAME PROPERTIES

-STATEMENT LABELS- -( LO=A

)

LABEL- ADDRESS --PROPERTI ES-- -DEF

1 0 INACTIVE DO-TERM 70 20 1 1 IB 71

1 000 147B FORMAT 65

TAPES AUX/FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH 245B = 165 CM LABELLED COMMON LENGTH 470B = 312

CM STORAGE USED 63000B = 26112

COMPILE TIME 0.107 SECONDS

184
FTN 3 U552 83/12/24. 10.36.12 PAGE 26 SUBROUTINE ERROR 74/175 OPT=0

1 SUBROUTINE ERROR(IERR) ERROR 1

2 CHARACTER»45 MESSACE!20) ERROR 2

3 DATA MESSAGE! 1 ) / 'MATERIALS DATA BASE IS EMPTY / ERROR 3

4 DATA MESSAGE! 2)1 ' FREQUENCY IS OUT OF 1RANGE ' / ERROR 4

5 DATA MESSAGE! 3) / 'THIS MATERIAL IS 1MOT IN DATA BASE ' / ERROR 5

6 DATA MESSAGE! 4 )/ 'DENOMINATOR IS ZERO ' / ERROR 6

7 DATA MESSAGE! 5) /' FILE HANDLING ERROR ' / ERROR n

8 DATA MESSAGE! 6) /' ERROR CODE IS OUT OF RANGE ' / ERROR 8 9 DATA MESSAGE

!

7)1' ERROR CODE IS OUT OF RANGE ' / ERROR 9 10 DATA MESSAGE! 8) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 10

1

1

DATA MESSAGE! 9) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 1

1

1 2 DATA MESSAGE! 10) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 12

13 DATA MESSAGE! 11)/' ERROR CODE IS OUT OF RANGE ' / ERROR 13

1 4 DATA MESSAGE! 12) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 14

15 DATA MESSAGE!13)/ 'ERROR CODE IS OUT OF RANGE ' / ERROR 15

1 6 DATA MESSAGE! 14) / 'ERROR CODE IS OUT OF RANGE ' / ERROR U

17 DATA MESSAGE ! 15 ) /' ERROR CODE IS OUT OF RANGE ' / ERROR 17

1 8 DATA MESSAGE! 16) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 18 19 DATA MESSAGE! 17 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 19 20 DATA MESSAGE! 18) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 20

21 DATA MESSAGE!!?)/ 'ERROR CODE IS OUT OF RANGE ' / ERROR 21 22 DATA MESSAGE! 20) / 'ERROR CODE IS OUT OF RANGE ' / ERROR 22 23 IERRM=5 ERROR 23 24 IF ( lERR . GT . lERRM) IERR=20 ERROR 24 25 WRITE(6,10) lERR, MESSAGE! lERR) ERROR 25 26 10 FORMAT!' ***ERROR NUMBER =

' ,15, ' * * * ' , A45 ) ERROR 26 27 CALL PMDSTOP ERROR 27 28 STOP ' ERROR

ERROR 28 29 END ERROR 29

-VARIABLE MAP--!LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE ---SIZE

I ERR 1 DUMMY -ARG INTEGER

lERRM 210B INTEGER

MESSAGE 56B CHAR*45 20

-PROCEDURES--! LO=A) -NAME TYPE ARCS CLASS

PMDSTOP 0 SUBROUTINE

-STATEMENT LABELS-- ( LO=A)

-LAB EL- ADDRESS PROPERTIES DEF

10 36B FORMAT 26

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS-- ARCS- --

ERROR 5B 1

FTN 5.1+552 83/12/24. 10.36.12 PACE 27 SUBROUTINE ERROR 74/175 OPT=0

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

2 1 3B = 137

6 1 OOOB = 25 08 8

0 054 SECONDS

185
FTN 5 1+552 83/12/24. 10.36.12 PAGE 28 SUBROUTINE WARNING 74/175 OPT=0

1 SUBROUTINE VARNING(ERR) WARNING 1

2 INTEGER ERR, ERRM WARNING 2

3 CHARACTER*45 MESSAGE! 20

)

WARNING 3

4 DATA MESSAGE ! 1 ) / "HOLE" DATA FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 4 5 DATA MESSAGE ! 2) / ‘ FILE HANDLING PROBLEM ON "HOLE" DATA FILE • / WARNING 5

6 DATA MESSAGE ! 3) /"•MATTER" FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 6

7 DATA MESSAGE ! 4) /

• FILE HANDLING PROBLEM ON "MATTER FILE ' / WARNING 7

8 DATA MESSAGE ! 5 ) /

' "TYPE" DATA FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 8

9 DATA MESSAGE ! 6 ) /

' FILE HANDLING PROBLEM ON "TYPE" FILE ’ / WARNING 9 10 DATA MESSAGE ! 7 ) /

' "WALL" DATA FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 10

11 DATA MESSAGE ! 8) /

' FILE HANDLING PROBLEM ON "WALL" FILE ' / WARNING 1 1

1 2 DATA MESSAGE ! 9 ) /

' HEIGHT AND WIDTH OF ROOM MISSING ' / WARNING 1

2

13 DATA MESSAGE ! 10 )

/

' LENGTH OF ROOM IS MISSING ' / WARNING 13

1 4 DATA MESSAGE ! 11 ) /'FREQ FILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 14 15 DATA MESSAGE ! 12 ) /

' FILE HANDLING PROBLEM WITH FREQ FILE ' / WARNING 15 16 DATA MESSAGE ! 13 )

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 16 17 DATA MESSAGE ! 14 ) / 'WARNING CODE IS OUT OF RANGE ' / WARNING 17 18 DATA MESSAGE ! 15 ) / 'WARNING CODE IS OUT OF RANGE • / WARNING 18 19 DATA MESSAGE ! 16 )

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 19 20 DATA MESSAGE ! 17 )

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 20

21 DATA MESSAGE ! 18 ) / 'WARNING CODE IS OUT OF RANGE ' / WARNING 21 22 DATA MESSAGE ! 19 )

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 22 23 DATA MESSAGE ! 20 ) / 'WARNING CODE IS OUT OF RANGE • / WARNING 23 24 ERRM== 12 WARNING 24 25 I ERR = ERR WARNING 25 26 IF(ERR . GT. ERRM) IERR=20 WARNING 26 27 WRITE ( 6 , 20

)

WARNING 27 28 WRITE (6, 10) ERR, MESSAGE! lERR) WARNING 26 29 WRITE(6, 20) WARNING 29 30 10 FORMAT!' ***WARNING NUMBER = 15 ,

' * * * ' ,A45

)

WARNING 30

31 20 FORMAT!

' ) WARNING 3 1 32 RETURN WARNING 32

33 END WARNING 33

-VARIABLE MAP--(LO=A)

-NAME ADDRESS--BLOCK- -PROPERTI ES TYPE SIZE

ERR ERRM

lERR

MESSAGE

1 DUMMY-ARG

60B

2 1 3B 61E

INTEGER

INTEGER

INTEGER

CHARM5 20

-STATEMENT LABELS-- ( LO=A) -LAB EL -ADDRESS PROPERTIES DEF

10 34B FORMAT

20 42B FORMAT

3031

-ENTRY POINTS--! LO=A) -NAME- --ADDRESS- -ARGS---

VARNING 5B I

FTN 5.1+552 83/12/24. 10.36.12 PAGE 29 SUBROUTINE WARNING 74/175 OPT=0

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH 216B = 142 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.058 SECONDS

186
Appendix 9.6 Listing of Computer Program SFREQ

187
FTM 5.1 + 5!: 3 .3 / 12,' 2 0, 1 1 5 2.5 9 PAGE 1 'program STREQ 74/175 OPT=0

1 PROGRAM SFREQ ( I NPUT , TAPE 1 = INPUT

)

SFREQ 1

2

* SFREQ ?

3 *THIS INTERACTIVE PROGRAM INPUTS THE DATA DESCRIBING EACH FREQ SFREQ 3

4 »IN THE BUILDING AND STORES IT. THE FILE NAME IS CREATED BY SFREQ 4 5 *ATTACHING "S' TO THE FRONT OF AND "F" TO THE BACK OF THE BUILDING SFREQ c

6 ‘IDENTIFICATION. THE BUILDING IDENTIFICATION CAN BE NO MORE SFREQ 6

7 ‘THAN 5 ALPHANUMERIC CHARACTERS. SFREQ

s SFREQ s

9 *»***»********iinii************iii********iii***»**************fi*******iii** * * * * * c OMF

10 *** COMMON FOR INITIAL PARAMETERS ***COMF

1

1

***)(«*******lt**«Mlr**««*4Mli«*«M)******** + *)Mli*itilr««****it«ik**«)lr**itii(*it****>t * * * * *COMF 3

I 2 INTEGER FMAX COMF 4 13 PARAMETER (FMAX = 50) COMF 5

1 4 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMP 6 15 $ FTOT COMF 7

1 6 COMMON / INITILC/ BLDG COMF S 17 CHARACTER * 5 BLDG COMF 9 18 REAL FREQ, AFLAG, RFLAG, FREQA COMF 10

19 INTEGER QUALITY, FERR, FTOT COMF 1 1 20 1 1 1 M i( 1i it h i( t t i( h 1( -k 1( 1 1 1 it t 1 1 1 1 1 ii t t "k 1 1 1 1 1 1 t t It i( 1 1 t 1 1 1 1 ii 1 1 1( 1 1 i( 1 1 1( * t 1 1 1( t ii 1 1 1 1( 12

21 t it It t it it it it n t ititit it t it K Hitit Kit it it Hit it it it it t it it it t It it it it tt It It H t it it t it t It tit 1 1 it t it It It It t It* It * it it It it it 13 22 INTEGER GETLEN,QUIT, ABORT, ANSWER, OLDFI LE ,N,Y1 ,Y2 ,LINE SFREQ 10 23 INTEGER lERR SFREQ 1 1 24 CHARACTER * 7 PFN SFREQ 1 2 25 t SFREQ 1 3 26 * INITIALIZATION SFREQ 14 27 QUIT = 0 SFREQ 1 5 28 FTOT = 0 SFREQ 1 6 29 ABORT = 0 SFREQ 1 7 30 100 PRINT* SFREQ 18 31 PRINT *, 'ENTER BUILDING IDENTIFICATION (EG. ''101'')' SFREQ 19 32 PRINT ' (NO MORE THAN 5 ALPHANUMERIC CHARACTERS)' SFREQ 20

33 REWIND 1 SFREQ 21 34 READd ,* ,END=10Q) BLDG SFREQ 22

35 SFREQ 2 3 36 IF ( GETLEN(BLDG) . GT . 5 ) THEN SFREQ 24 37 GO TO 100 SFREQ 25

38 END IF SFREQ 2 6 39 PFN = 'B' II BLDG(

1

: GETLEN(BLDG) ) II ‘F’ SFREQ 27

40 * SFREQ 28

41 *** LOAD DATA FROM EXISTING FILE IF NECESSARY SFREQ 29 42 200 PRINT* SFREQ 30

43 PRINT* , 'WILL THIS BE ’ SFREQ 31 44 PRINT*,' (1) A MODIFICATION OF AN EXISTING FILE?' SFREQ 32

45 PRINT* ,

' ( 2 ) A NEW FILE? ' SFREQ 33

46 PRINT* ,' ENTER A NUMBER M!' SFREQ 34

47 REWIND 1 SFREQ 35 48 READ( 1

,

* , END=200 ) OLDFILE SFREQ 3 6 49 IF ( ( OLDFILE NE. 1 ) .AND. ( OLDFILE . NE . 2 ) ) THEN SFREQ 37 50 GOTO 200 SFREQ 38

51 ELSE IF ( OLDFILE EQ. 1 ) THEN SFREQ 39 52 * SFREQ 40 53 *** CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME SFREQ 41 54 lERR = 0 SFREQ 42

55 CALL PF (

' GET' , 0 , PFN( 1 : GETLEN( PFN) ) ,

' RC ' , lERR) SFREQ 4 3 56 IF ( lERR .EQ. 2 ) THEN SFREQ 44

57 PRINT* SFREQ 45 58 PRINT *, 'FILE ',PFN, ' NOT FOUND' SFREQ 46 59 PRINT*, ' PROGRAM ABORTED !!!

SFREQ 47 60 PRINT* SFREQ 48

61 PRINT*, 'FIND CORRECT BUILDING IDENTIFIER AND RESTART ', SFREQ 49 62 + 'PROGRAM' SFREQ 50 63 PRINT* SFREQ 51 64 STOP SFREQ 52 188
? 1 552 83/12/20. 1152.59 PAGE 2 PROGRAM SFREQ 74/175 OPT=0

65 t SFREQ 5 3 66 ELSE SFREQ j 4 67 CALL LFREQ SFREQ c c 6B IF (FERR .NE. 0) CALL ERROR(5) SFREQ 56

69 END IF SFREQ 57 70 ELSE IF ( OLDFILE . EQ . 2 ) THEN SFREQ 58

71 * SFREQ 59

72 *»* CHECK FOR EXISTENCE OF PERMANENT FILE OF SAME NAME SFREQ 60

73 lERR = 0 SFREQ 6 1 74 CALL PF ( 'GET' , 0 ,PFN( 1 ;GETLEN(PFN) >

, 'RC ' , lERR) SFREQ 62

75 IF ( lERR EQ. 0 ) THEN SFREQ 6 3 76 PRINT* SFREQ 64

77 PRINT*, 'DATA FILE ALREADY EXISTS FOR BUILDING ',BLDG SFREQ 6 5 78 PRINT* SFREQ 66

79 PRINT*, 'IF YOU ENTER DATA AND STORE IT, YOU WILL WRITE ', SFREQ 67

eo + 'OVER THE OLD FILE .

' SFREQ 68

B1 250 PRINT* SFREQ 69

82 PRINT*, 'YOU MAY EITHER (1) ABORT OR (2) CONTINUE.' SFREQ 70

83 PRINT* ,' INDICATE YOUR CHOICE BY ENTERING A NUMBER.' SFREQ 71 84 REWIND 1 SFREQ 72

85 READd , * , END = 250 ) ANSWER SFREQ 73

86 IF ( ANSWER .EQ. 1 ) THEN SFREQ 74 87 PRINT* SFREQ 75

88 PRINT* ,' PROGRAM HAS BEEN ABORTED, AT YOUR REQUEST' SFREQ 76

89 PRINT* SFREQ 77 90 STOP SFREQ 78

91 ELSE IF ( ANSWER EQ. 2 ) THEN SFREQ 79

92 9 0 90 CONTINUE SFREQ 80 93 ELSE SFREQ 81 94 GOTO 250 SFREQ 82

95 END IF SFREQ 83

96 ELSE IF ( lERR EQ. 2 ) THEN SFREQ 84

97 * SFREQ 85

98 * ** NO DATA FILE ALREADY EXISTS FOR THIS BUILDING AND DATA ENTRY SFREQ 86

99 *** CAN CONTINUE SFREQ 87

1 00 9091 CONTINUE SFREQ 88

10 i ELSE SFREQ 89 102 * SFREQ 90 103 *** PERMANENT FILE ERROR SFREQ 91 104 PRINT* SFREQ 92 105 PRINT* ,' PROGRAM ABORTED !!!' SFREQ 93 106 PRINT*,' SOME PERMANENT FILE ERROR HAS OCCURRED.' SFREQ 94 107 PRINT*,' DOUBLE CHECK YOUR BUILDING IDENTIFICATION ', SFREQ 95 108 + 'AND TRY AGAIN' SFREQ 96 109 STOP SFREQ 97

1 10 END IF SFREQ 98

11 1 * SFREQ 99 112 PRINT* SFREQ 100 113 PRINT*, ' BEGIN ENTERING DATA' SFREQ 101

1 14 300 FTOT = FTOT + 1 SFREQ 102 115 IF ( FTOT .EQ. 1) THEN SFREQ 103

1 16 CALL DATAINd , FTOT) SFREQ 104

117 ELSE SFREQ 105 118 CALL DATAIN (0,FTOT) SFREQ 106 119 END IF SFREQ 107 120 400 PRINT* SFREQ 108

12 1 PRINT*, 'DO YOU WANT TO ENTER MORE DATA?', SFREQ 109 122 + ' d ) YES (2) NO' SFREQ 1 10 123 PRINT*, ' ENTER A NUMBER !!!' SFREQ 1 1 1 124 REWIND 1 SFREQ 1 12 125 READd ,*, END = 400 ) ANSWER SFREQ 1 1 3 126 IF ( (ANSWER .NE. 1) .AND. (ANSWER .NE. 2) ) THEN SFREQ 1 1 4 127 GOTO 400 SFREQ 1 1 5 128 ELSE IF ( ANSWER EQ. 1) THEN SFREQ 1 1 6

189
FTN 3.1+552 83/12/20. 11.52.59 PAGE 3 PROGRAM SFREQ 74/175 OPT=0

129 GOTO 300 SFREQ 1 1 7 130 ELSE IF ( ANSWER EQ. 2 ) THEN 3FREG 1 18

13 1 PRINT* SFREQ 1 1 9 132 PRINT*, 'DATA ENTRY DISCONTINUED' SFREQ 120

133 END IF SFREQ 121 134 END IF SFREQ 122

135 * SFREQ 123 136 * * * MANIPULATE DATA SFREQ 124

137 CALL MANIP (QUIT, ABORT) SFREQ 12 5

1 36 A SFREQ 126 139 * * A TERMINATE PROGRAM, STORING DATA IF NECESSARY SFREQ 127 140 IF ( QUIT .EQ. 1 ) THEN SFREQ 126

14 1 OPEN(UNIT=6 , FILE=PFN( 1 : GETLEN(PFN) ) ,FORM= ' FORMATTED '

,

SFREQ 129 142 + ACCESS= 'SEQUENTIAL' , STATUS= ‘ NEW '

)

SFREQ 130 143 500 FORMAT (1PE12.6) SFREQ 13 1 144 DO 600 N = 1 , FTOT SFREQ 132 145 WRITE (6,500) FREQA(N) SFREQ 133 146 600 CONTINUE SFREQ 13 4 147 ENDFILE(6) SFREQ 135

1 48 WARNING*CALL PF ( 'REPLACE' ,0 ,PFN(1 :GETLEN(PFN) )

)

NUMBER OF ARGUMENTS IN REFERENCE TO _PF IS NOT CONSISTENT

SFREQ 136

149 CLOSE(6 , STATUS:: 'DELETE ) SFREQ 137 150 PRINT* SFREQ 136

15! PRINT*, 'DATA HAS BEEN STORED AND PROGRAM TERMINATED' SFREQ 1 39 152 END IF SFREQ 140 153 IF( ABORT .EQ. 1 ) THEN SFREQ 141 154 PRINT* SFREQ 142 155 PRINT*, 'PROGRAM HAS BEEN ABORTED' SFREQ 1 43 156 PRINT*,' NO DATA HAS BEEN STORED !!!' SFREQ 144 157 END IF SFREQ 145

15 8 STOP SFREQ 146 159 END SFREQ 147

--VARIABLE MAP--(LO=A)

-NAME ---ADDRESS --BLOCK PROPERTIES TYPE SIZE

ABORT 1031B INTEGER

AFLAG 2B / INITILN/ REAL ANSWER 1 032B INTEGER

BLDG OB / INITILC/ CHAR*5

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL

FTOT 67B / INITILN/ INTEGER

lERR 1 035B INTEGER

LINE NONE UNUSED/ *s* INTEGER

N 1 034B INTEGER

OLDFILE 1 0 3 3B INTEGER PFN 1 0 3 6B CHAR*7

QUALITY IB / INITILN/ INTEGER

QUIT 1 0 3 0B INTEGER

RFLAG 3B / INITILN/ REAL

Y1 NONE UNUSED/ *s* INTEGER

Y2 NONE UNUSED/ *s* INTEGER

190
FTN 5 1*552 83/12/20 11.52.59 PAGE 4 PROGRAM SFREQ 74/175 OPT=0

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE-- VALUE

FMAX INTEGER 50

-PROCEDURES--(LO=A)

-NAME TYPE --ARGS ---CLASS -NAME ---TYPE ARCS CLASS

DATA IN 2 SUBROUTINE LFREQ 0 SUBROUTINE

ERROR 1 SUBROUTINE MANIP 2 SUBROUTINE

GETLEN INTEGER 1 FUNCTION PF 5 SUBROUTINE

-STATEMENT LABELS- -( LO=A) -LABEL- ADDRESS -PROPERTIES-- --DEF -LABEL-ADDRESS --PROPERTIES--- -DEF

100 2 IB 30 500 570B FORMAT 1 43 200 47B 42 600 INACTIVE DO-TERM 146 250 166B 81 9090 *NO REFS* 92 300 2 4 6B 114 9091 *NO REFS* 100

400 26 0B 120

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS-- ARCS

SFREQ 14B 0

-I/O UNITS--(LO=A)

-NAME PROPERTIESTAPEl FMT/SEQ

TAPE6 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

1040B = 544

7 IB = 57 83000B = 28112

0.260 SECONDS

1 WARNING ERROR IN SFREQ

191
FTH 5 . 1+552

SUBROUTINE DATA IN 83/12/20, 11.52.59 PAGE 74/175 OPT=0

1 SUBROUTINE DATAIN ( I NSERT , L I NE ) SPREQ 148

1 *«**«'«**iK***«««**««(**«it4i«nli«*«****«*iii***«[**«*******«r***«t***iktt*«««**«i**««(<COI^r 1

3 *** COMMON FOR INITIAL PARAMETERS ***COMF 2

4 ****«c*<(*****iii**«i«x*)li<[*****iii*********«*«r*lt******4i**ili*«*lttk***«iii**<i**«il:*«*«(;OMF 3 5 INTEGER FMAX COMF 4

6 PARAMETER (FMAX = 50) COMF 5

7 COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQACFMAX), FERR, COMF 6

8 $ FTOT COMF 7

9 COMMON /INITILC/ BLDG COMF 8 10 CHARACTER * 5 BLDG COMF 9

1 1 REAL FREQ, AFLAC, RFLAC, FREQA COMF 1 0 12 INTEGER QUALITY, FERR, FTOT COMF 1 1 13 t'k'ktiftiitil'k'kt'k'kt'k'kt'kt'kt'kttt'kttt'k'kttttttit'kt'kttt'k'kil'kil'k'k'k'kiili'k'k'ktiitt'k » * * * t * * *COMF 1 2

1 4

t 1 1 t 1 1 t 1 1 * k t 1 1 t * t h * 1 1 1 * 1i k 1 1 * t * * 1 1 h * ti 1 1( * t * Irk t t * * 1 1i t t * * It * t t t * i( * t H 1 1 ii * * It ii it *.

* ^ 15 INTEGER INSERT, LINE SFREQ 150

1 6 IFdNSERT.EQ 1) THEN SFREQ 151

17 200 PRINT *, ' ENTER FREQUENCY FOR LINE #',LINE SFREQ 152

18 300 READd ,* ,END = 2 00 ,ERR = 20 0 ) FREQA (LINE) SFREQ 153

19 END IF SFREQ 1 5 4 20 IF( INSERT. EQ. 0) THEN SFREQ 155

21 400 PRINT *, 'ENTER NEXT FREQS, ONE PER LINE AFTER' , SFREQ 156

22 + ' EACH QUESTION MARK .SFREQ 157

23 PRINT *, ' ENTER ZERO (0.0) TO DISCONTINUE ENTRIES' SFREQ 158

24 PRINT *, 'START WITH LINE NUMBER = ', LINE SFREQ 159

25 500 REWIND 1 SFREQ 160

28 READd ,* ,END=400 , ERR=400 ) FREQA (LINE) SFREQ 161

27 IF(FREQA(LINE ) ,GT. 0 . 0) THEN SFREQ 162

28 irk'kkltitk'kkltkltk'kicirkliititkf. kk1(ki(1rk'k1(it*i(tk1i1(kkk1(t1(1t'k'kk1(t'ki(k1rk SFREQ 163

29 * CHECK IF ARRAY SIZE EXCEEDED SFREQ 164

30 A****************************************************** SFREQ 165

31 IF( LINE . GT . FMAX ) THEN SFREQ 166

32 PRINT *, 'MAXIMUM NUMBER OF DATA LINES CANNOT ' SFREQ 167

33 PRINT *, 'EXCEED ', FMAX, INSERTION NOT POSSIBLE.' SFREQ 168

34 RETURN SFREQ 169

35 END IF SFREQ 170

36 ***H*#l*********llt*************************************** SFREQ 171

37 LINE = LINE + 1 SFREQ 172

38 GOTO 500 SFREQ 173

39 ELSE SFREQ 174

40 LINE =LINE -1 SFREQ 175

41 END IF SFREQ 176

42 END IF SFREQ 177

43 RETURN SFREQ 178

44 END SFREQ 179

-VARIABLE MAP--

-NAME ADDRESS

(LO=A)

--BLOCK PROPERTIES TYPE

AFLAG 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

FERR 6 6B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL

FTOT 67B /INITILN/ INTEGER

INSERT 1 DUMMY-ARG INTEGER

LINE 2 DUMMY-ARG INTEGER

QUALITY IB / INITILN/ INTEGER

RFLAG 3B / INITILN/ REAL

SIZE

50

192
FTN 5 1*552

SUBROUTINE DATAIN

iimilQ 1 1 52.59 PAGE 74/175 OPT=0

6

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

PMAX INTEGER 50

-STATEMENT LABELS- - ! LO=A) -LABEL- ADDRESS -PROPERTIES- ---DEF

200 1 2B 17 300 *NO REFS* 18 400 25B 21 500 33B 25

-ENTRY POINTS--! LO=A) -NAME ADDRESS--ARGS

DATAIN 5B 2

-I/O UNITS--!LO=A)

-NAME--- PROPERTIES

TAPEl FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

200B = 128

7 IB = 57 61000B = 25088

0.073 SECONDS

193
FTN 5,1+552

SUBROUTINE HANI?

83/12/20 11.52.59 PAGE 74/175 OPT=0

7

1

2

4

5

6

7

B

9 10

1 1 12

1314

15

1 6 1718

1920

2122

2324

2526

2728

29

30

3132

3334

3536

3738

39

40

4142

4344

45

46

4748

49

50

5152

5354

5556

5758

5960

6162

6364

SUBROUTINE MANIP (QUIT, ABORT)

*** COMMON FOR INITIAL PARAMETERS * *************)i(**)i( A** A!)i;iii********]l(***<i***iir**A #(<t** **<t*ft**H**A**A*

INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR,

5 FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG

REAL FREQ, AFLAG, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

INTEGER ABORT, ANSWER , DOK, FLAGl , LOK,N,NOK,OK , OK 1 , OK2 , QU IT , INSERT

INTEGER TEMP, V,X,Y, COMMAND

CHARACTER » 3 DIR, FROM, TO

SFREQ

**COMF

**COMF

**COMF

COMF

COMF

COMF

COMF

COMF

COMF

*10 FLAGl = PRINT*

PRINT*

,

PRINT*

,

PRINT*

PRINT*

,

I- PRINT*

CHOOSE

( 1 )

( 2 ) (3)

PROGRAM

DISPLAY LINE OF DATA (4) DISPLAY ALL LINES' INSERT LINE INTO FILE (5) APPEND LINES OF DATA' DELETE LINE (6) STORE DATA AND EXIT '

(7) EXIT PROGRAM WITHOUT

STORING DATA' PRINT*, 'ENTER A NUMBER ' PRINT*

REWIND 1 READ ( 1

, * , END=1 0 ) COMMAND

a **

%

«

* * *

**h *

100

*t* *

DISPLAY LINE ***

IF ( COMMAND EQ. 1 ) THEN

INDICATE EMPTY DATA FILE

IF ( FTOT EQ. 0 ) THEN

PRINT*

PRINT*, 'DATA FILE IS EMPTY !!!'

ENTER NUMBER OF LINE TO BE DISPLAYED

ELSE

PRINT*

PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DISPLAYED'

PRINT*, ' ( ENTER "0" TO ESCAPE DISPLAY MODE )' REWIND 1 READ( 1

, * , END=100) N

CHECK VALIDITY OF LINE NUMBER

IF ( (N ,GT. FTOT) .OR. (N LT. 0) ) THEN

PRINT*

PRINT*, 'INCORRECT NUMBER !!!!!! TRY AGAIN !!!' PRINT*, ' -OR- ENTER "0" TO ESCAPE FROM ',

+

' "DISPLAY" MODE

GOTO 100

*AAA ABORT 'DISPLAY' MODE

ELSE IF ( N EQ. 0 ) THEN

PRINT*

PRINT*, ’ "DISPLAY" MODE ABORTED !!!'

**** DISPLAY LINE OF DATA

180

1

2

3

4

5

6

7

8

9 COMF 1 0 COMF 1

1

'COMF 12

13 SFREQ 182 SFREQ 183 SFREQ 184 SFREQ 185 SFREQ 186 SFREQ 187 SFREQ 188 SFREQ 189 SFREQ 190 SFREQ 191 SFREQ 192 SFREQ 193 SFREQ 194 SFREQ 195 SFREQ 196 SFREQ 197 SFREQ 198 SFREQ 1 99 SFREQ 200 SFREQ 201 SFREQ 202 SFREQ 203 SFREQ 204 SFREQ 2 05 SFREQ 206 SFREQ 207 SFREQ 208 SFREQ 209 SFREQ 210 SFREQ 2 11 SFREQ 212 SFREQ 2 13 SFREQ 214 SFREQ 2 15 SFREQ 2 1 6 SFREQ 2 17 SFREQ 218 SFREQ 2 19 SFREQ 220 SFREQ 221 SFREQ 222 SFREQ 223 SFREQ 224 SFREQ 225 SFREQ 226 SFREQ 227 SFREQ 228 SFREQ 229 SFREQ 230 SFREQ 231

194
FTN 5 U5 52 SUBROUTINE MAN IP 83/12/20. 11. 52. 59 PAGE

74/175 OPT=0

8586

o7

8869

70

7172

73

74

7578

7778

7980

818283

84

858887

88

8990

919293

94

9598

97

98

99 100

10 1 102

103

104

105 108

107

1 08 109

1 10

11 1 112

113 114

115 118 117

1 18 119

1 20

12 1 122

123

124

125

128

127 128

ELSE IF ( (N GT 0) AND. (N . LE . FTOT) ) THEN

PRINT*

CALL DISPLAY! N, COMMAND)

END IF END IF END IF

«*** INSERT LINE ***

IF ( COMMAND . EQ 2 ) THEN

t*** INDICATE EMPTY DATA FILE

IF ( FTOT .EQ. 0 ) THEN

PRINT*

PRINT*, 'DATA FILE IS EMPTY !!!'

**** REQUEST NUMBER OF LINE BEFORE WHICH INSERTION IS TO BE MADE

ELSE

200 PRINT*

PRINT*, 'SPECIFY NUMBER OF LINE BEFORE WHICH A NEW LINE IS

+ 'TO BE INSERTED'

PRINT*, ' ( ENTER "0" TO ESCAPE "INSERTION" MODE )' REWIND 1 READ!! , * ,END=200) N

«*** CHECK FOR VALID LINE NUMBER

IF ( ( N LT. 0 ) OR. ( N . GT . FTOT ) ) THEN

PRINT*

PRINT*, 'INCORRECT LINE NUMBER !!!' PRINT*, ' TRY AGAIN !!! -OR- ENTER "0" TO ESCAPE',

+

' " INSERTION" MODE

GOTO 200

**** ABORT INSERTION MODE

ELSE IF ( N EQ. 0 ) THEN

PRINT*

PRINT*, ' "INSERTION" MODE ABORTED'

**** MAKE ROOM FOR NEW LINE OF DATA

ELSE IF ( (N .GT. 0) .AND. (N .LE. FTOT) ) THEN

* CHECK IF ARRAY SIZE EXCEEDED

*ii*1i1i*1i1i1i*t1i*1i1ii(tt1fkt1i****1i t** **t*1i1i1t******t1t******

IF( FTOT. EQ. FMAX) THEN

PRINT *, 'MAXIMUM NUMBER OF DATA LINES CANNOT ' PRINT *, 'EXCEED ', FMAX, '. INSERTION NOT POSSIBLE.'

GO TO 10 END IF

DO 230 X = FTOT,N,-l

FREQA(X+1) = FREQA(X)

210 CONTINUE

230 CONTINUE

**** ENTER DATA FOR NEW LINE FTOT = FTOT + 1 CALL DATAIN (1 ,N)

* PRINT*

PRINT*, 'THE FOLLOWING LINE HAS BEEN ADDED AS LINE ', N CALL DISPLAY! N, COMMAND)

END IF

SFREQ 2 32 SFREQ 2 33 SFREQ 234

SFREQ 13 5 SFREQ 238 SFREQ 2 37 SFREQ 238

SFREQ 2 39 SFREQ 240 SFREQ 241 SFREQ 242 SFREQ 243

SFREQ 244 SFREQ 2 45 SFREQ 248 SFREQ 247 SFREQ 248

SFREQ 2 49 SFREQ 250 SFREQ 251 SFREQ 252 SFREQ 253

SFREQ 254

SFREQ 253

SFREQ 258

SFREQ 257

SFREQ 253

SFREQ 25?

SFREQ 280

SFREQ 281 SFREQ 282 SFREQ 263

SFREQ 284

SFREQ 285

SFREQ 288 SFREQ 287

SFREQ 288

SFREQ 269

SFREQ 270 SFREQ 271 SFREQ 272 SFREQ 273 SFREQ 274 SFREQ 275

SFREQ 278 SFREQ 2 77 SFREQ 278

SFREQ 279

SFREQ 280

SFREQ 281 SFREQ 282 SFREQ 283

SFREQ 284

SFREQ 285

SFREQ 288 SFREQ 287

SFREQ 288 SFREQ 289

SFREQ 290

SFREQ 291 SFREQ 292

SFREQ 293

SFREQ 294 SFREQ 295

195
FTN 5 , 1+5S2

SUBROUTINE MA.NIP 83/12/20. 11 . 52.59 PAGE 74/175 OPT=0

9

129 END IF SFREQ 296 130 END IF SFREQ 2 97

13 1 * SFREQ 298

1 32 * _ . SFREQ

133 A * * DELETE LINE *** SFREQ 300

134 A SFREQ

135 IF ( COMMAND . EQ . 3 ) THEN SFREQ 302

1 36 A SFREQ 303

137 AAA INDICATE EMPTY DATA FILE SFREQ 304

1 38 IF < FTOT EQ. 0 ) THEN SFREQ 3 05 139 PRINT* SFREQ 306 140 PRINT*, 'DATA FILE IS EMPTY M !

• SFREQ 3 07

14 1 A SFREQ 308

142 AAA READ NUMBER OF LINE TO BE DELETED SFREQ 309

14 3 ELSE SFREQ 310

144 300 PRINT* SFREQ 3 1 1 145 PRINT*, 'SPECIFY THE NUMBER OF THE LINE TO BE DELETED' SFREQ 312

1 46 PRINT*, ' (ENTER "0" TO ESCAPE DELETION MODE) ' SFREQ 3 1 3 147 REWIND 1 SFREQ 3 1 4 148 READd ,*,END = 3 0 0 ) N SFREQ 3 15 149 A SFREQ 316 150 AAA CHECK VALIDITY OF LINE NUMBER SFREQ 3 17

15 1 IF ( (N GT. FTOT ) OR. ( N .LT. 0 ) ) THEN SFREQ 318

152 PRINT* SFREQ 3 19 153 PRINT*, ' INCORRECT NUMBER MM SFREQ 320 154 PRINT* ,

' TRY AGAIN ! !

!

-OR- ENTER "0" TO ESCAPE FROM' , SFREQ 321

155 + '"DELETE" MODE' SFREQ 322 156 GOTO 300 SFREQ 323

157 A SFREQ 324

158 AAA ABORT 'DELETE' MODE SFREQ 325

159 ELSE IF ( N .EQ. 0 ) THEN SFREQ 326

160 PRINT*, ' "DELETE" MODE ABORTED' SFREQ 327

161 A SFREQ 328 162 AAA DOUBLE CHECK CHOICE OF LINE TO BE DELETED SFREQ 329

16 3 ELSE IF (( N GT. 0 ) .AND. ( N . LE

.

FTOT )) THEN SFREQ 330

164 PRINT* SFREQ 331 165 PRINT* , 'DOUBLE CHECK !!

!

SFREQ 332

166 PRINT*, ' DO YOU WANT TO DELETE THE FOLLOWING LINE? :SFREQ 333

167 CALL DISPLAY! N, COMMAND) SFREQ 334

1 68 305 PRINT*, ' ENTER (1) YES OR ( 2 ) NO ' SFREQ 335

169 REWIND 1 SFREQ 336 170 READd ,* ,END = 30 5 > ANSWER SFREQ 337

17 1 A SFREQ 338 172 AAA DELETE LINE SFREQ 339

173 IF ( ANSWER EQ. 1 ) THEN SFREQ 340

174 DO 330 X = N, FTOT - 1 SFREQ 341 175 FREQA(X) = FREQA(X+1) SFREQ 342

176 330 CONTINUE SFREQ 343

177 FTOT = FTOT - 1 SFREQ 344 178 PRINT* SFREQ 345

17 9 PRINT*, 'LINE I ',N,' DELETED' SFREQ 346

180 END IF SFREQ 347

18 1 A SFREQ 348

182 END IF SFREQ 3 49 183 END IF SFREQ 350 184 END IF SFREQ 351 185 A SFREQ 352

1 Q 1 SFR FO ^ ^ 18 7 AAA DISPLAY ALL DATA *** SFREQ 354

18 6

A . .. . fn ss 189 IF { COMMAND .EQ. 4 ) THEN SFREQ 356

1 90 A SFREQ 357

19 1 AAA INDICATE EMPTY DATA FILE SFREQ 358

192 IF ( FTOT EQ. 0 ) THEN SFREQ 359

196
rxN 5 us:

2

SUBROUTINE MANIP

83/12/20 11.52.59 PAGE

74/175 OPT=0

10

193 PRINT* 3FREQ 36 0 194 PRINT*, ’DATA FILE IS EMPTY !!!' SFHEQ 361

195 t SFREQ 362

196 t t t DISPLAY DATA SFREG 363

197 ELSE SFREQ 364

198 PRINT* SFREQ 3 6 5 19 9 CALL DISPLAY! N, COMMAND) SFREQ 3 6 6 200 t SFREQ 367

20 1 END IF SFREQ 368 202 END IF SFREQ 3 69 203 t SFREQ 370 204 t SFREQ 3 71 205 t t t ADD DATA *** SFREQ 372

206 SFREQ * 7 3 207 IF ( COMMAND EQ. 5 ) THEN SFREQ 374

208 t SFREQ 3 75 209 K t t ENTER DATA SFREQ 376

2 10 500 FTOT = FTOT + 1 SFREG 3 77

21 1 • ««**«**»(**««**« «** «****t*X*t*****«********«**«*«[* SFREQ 378

2 12 t CHECK IF ARRAY SIZE EXCEEDED SFREQ 379

213 ttttttt***ttttt*Xt****1Mlir«Att«t*t*At******t**ttlkttAt*t* SFREQ 380 214 IF( FTOT.EQ.FMAX) THEN SFREQ 3 8 1 215 PRINT *, 'MAXIMUM NUMBER OF DATA LINES CANNOT ' SFREQ 382

2 1 6 PRINT *, 'EXCEED ', FMAX, '. INSERTION NOT POSSIBLE.' SFREG 3 33 217 CO TO 10 SFREQ 384

2 18 END IF SFREQ 385

219 ttttttAAA*tttttAAA*AA**AAA«*******A**A*«AA*A*«A*x*A*A** SFREQ 386 220 CALL DATAIN (O.FTOT) SFREQ 387

22 1 510 PRINT* SFREQ 3 8 8 222 PRINT*, 'DO YOU WANT TO ENTER MORE DATA? (1) YES !2) NO' SFREQ 3 89 223 PRINT*, ' ENTER A NUMBER !!!' SFREQ 390

224 REWIND 1 SFREQ 391 225 READ! 1

, * , END=5 1 0) ANSWER SFREQ 392 226 t SFREQ 3 93 227 * * * CHECK VALIDITY OF NUMBER SFREQ 394

223 IF ! ! ANSWER .NE. 1 > .AND. ! ANSWER NE. 2 ) ) THEN SFREQ 3 95 229 GOTO 510 SFREQ 396 230 A SFREQ 3 97

23 1 AAA ENTER MORE DATA SFREQ 398

232 ELSE IF < ANSWER .EQ. 1 ) THEN SFREQ 3 99 233 GOTO 500 SFREQ 400 234 A SFREQ 4 0! 235 AAA DISCONTINUE DATA ENTRY SFREQ 402 236 ELSE IF ! ANSWER .EQ. 2 ) THEN SFREQ 403

237 PRINT* SFREQ 404 238 PRINT*, 'DATA ENTRY DISCONTINUED' SFREQ 405 239 A SFREQ 406 240 END IF SFREQ 407

24 1 END IF SFREQ 408 242 A SFREQ 4 09 243 A-- SFREQ 410 244 AAA STORE DATA AND PROGRAM *** SFREQ 4 1 1 245 A SFREQ 4 1 2 246 IF ! COMMAND .EQ. 6 ) THEN SFREQ 4 1 3 247 600 PRINT* SFREQ •1 A i 248 PRINT* , 'DOUBLE CHECK ! ! !

' SFREQ 4 15 249 PRINT*, ' DO YOU YOU WANT TO STORE THIS DATA AND END PROG ' SFREQ 4 1 6 250 PRINT*, ' NOTE: STORING THIS DATA WILL WIPE OUT ANY OLD FILE SFREQ 4 1 25 1 PRINT*, • OF THE SAME NAME M!' SFREQ 4 1 8 252 PRINT*, ' ENTER A NUMBER: !1) YES !2) NO' SFREQ 4 19 253 REWIND 1 SFREQ 420 254 READ!1 ,*,END=600) ANSWER SFREQ 421 255 A SFREQ 422 256 AAA SET FLAG FOR STORING DATA IN THE MAIN PROGRAM SFREQ 4 23

197
FTN 5 U552 83/12/20, 11.52.59 PAGE 11 SUBROUTINE MANIP 74/175 OPT=0

257 IF ( ANSWER . EQ . 1 ) THEN , SFREQ '4 2 4 258 QUIT = 1 SFREQ 4 25 259 RETURN SFREQ 4 2 6 260 * SFREQ 4 27

26 1 *** ABORT 'STORING’ MODE SFREQ 428 262 ELSE IF ( ANSWER EQ. 2 ) THEN SFREQ 429

26 3 PRINT* SFREQ 430

2 64 PRINT*, ' "STORING" MODE DISCONTINUED' SFREQ 431

26 5

* SFREQ 432

2 66 *** CHECK VALIDITY OF ANSWER SFREQ 4 33

26 7 ELSE IF ( ( ANSWER NE. 1 ) AND. ( ANSWER NE. 2 ) ) THEN SFREQ 43 4 268 GOTO 600 SFREQ 4 3 5 269 * SFREQ 43 6 2 70 END IF SFREQ 4 37

27 1 END IF SFREQ 4-3 8

2 72 * SFREQ 4 39 273 - SFREQ 440 274 *** END PROGRAM WITHOUT STORING DATA *** SFREQ 441 275 - SFREQ 442 276 IF ( COMMAND .EQ. 7 ) THEN SFREQ 4 43 27 7 700 PRINT* SFREQ 444 278 PRINT* , 'DOUBLE CHECK ! !

!

SFREQ 4 45 279 PRINT*, ' DO YOU WANT TO END THIS PROGRAM ', SFREQ 446 280 + 'WITHOUT STORING DATA?' SFREQ 447

28 1 PRINT*, ' ENTER A NUMBER: (1) YES (2) NO' SFREQ 448 282 REWIND 1 SFREQ 4 ^ ? 283 READ( 1

, * ,END=700) ANSWER SFREQ 450 284 * SFREQ 451 285 *** SET FLAG FOR ABORTING PROGRAM IN THE MAIN PROGRAM SFREQ 452 286 IF ( ANSWER EQ. 1 ) THEN SFREQ 4 53 287 ABORT = 1 SFREQ 45 4 288 RETURN SFREQ 4 55 289 * SFREQ 456 290 *** ABORT 'STORING' MODE SFREQ 457

29 1 ELSE IF { ANSWER . EQ . 2 ) THEN SFREQ 458 292 PRINT* SFREQ 45? 293 PRINT*, ' "ABORTION" MODE DISCONTINUED' SFREQ 460 294 * SFREQ 461 295 *** CHECK VALIDITY OF ANSWER SFREQ 462 296 ELSE IF ( ( ANSWER .NE. 1 ) AND. ( ANSWER . NE . 2 > > THEN SFREQ 463 297 GOTO 700 SFREQ 464 298 * SFREQ 465

29 9 END IF SFREQ 466 300 END IF SFREQ 467

30 1 * SFREQ 468 302 - SFREQ 469

30 3 *** LOOP TO BEGINNING OF 'MANIP' SUBROUTINE SFREQ 470 304 - SFREQ 471 305 GOTO 10 SFREQ 472 306 * SFREQ 473 307 END SFREQ 474

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK -PROPERTIES TYPE --•

ABORT 2 DUMMY-ARG INTEGER

AFLAG 2B / INITILN/ REAL ANSWER 1 36 4B INTEGER

BLDG OB / INITILC/ CHAR*5

COMMAND 1 3 7 0B INTEGER

DIR NONE UNUSED/ *s* CHAR*3

DOK NONE UNUSED/ *s* INTEGER

FERR 66B / INITILN/ INTEGER

198
FTN 5 U5J2

SUBROUTINE MANIF

83/12/20. 11.52.59 PAGE 12 74/175 OPT=0

FLACl 1 365B INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B / INITILN/ REAL

PROM NONE UNUSED/ *S* CHAR*3

FTOT 47B INITILN/ INTEGER

INSERT NONE UNUSED/*S* INTEGER

LOK NONE UNUSED/*S* INTEGER

N 1 346B INTEGER

NOK NONE UNUSED/ *5* INTEGER

OK NONE UNUSED/*S* INTEGER

OKI NONE UNUSED/*S* INTEGER

OK2 NONE UNUSED/ «S* INTEGER

QUALITY IB / INITILN/ INTEGER

QUIT 1 DUMMY-ARG INTEGER

RFLAG 3B / INITILN/ REAL

TEMP NONE UNUSED/ *S* INTEGER

TO NONE UNUSED/*S* CHAR*3

V NONE UNUSED/*S* INTEGER

X 1367B INTEGER

Y NONE UNUSED/ *S* INTEGER

50

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

FMAX INTEGER 50

-PROCEDURES--(LO=A)

-NAME TYPE

DATA IN DISPLAY

ARCS CLASS

2 SUBROUTINE

2 SUBROUTINE

-STATEMENT LABELS-- ( LO=A)

LABEL-ADDRESS -----PROPERTIES- ---DEF -LABEL -ADDRESS - - PROPERTIES- ---DEF

10 7B 19 305 32 5B 1 48 100 50B 45 330 INACTIVE DO-TERM 174 200 133B 85 500 41 3B 2 10 210 *NO REFS* 1 1 8 510 42 7B 22 1 230 INACTIVE DO-TERM 119 400 47 0B 247

300 254B 144 700 5 4 2B 277

-ENTRY POINTS-- (LO=A) -NAME ADDRESS --ARGS

MAN IP 5B 2

-I/O UNITS--(LO=A)

-NAME--- PROPERTIES

TAPEl PMT/SEQ

FTN 5.1+552 83/12/20. 11.52 59 PACE 13 SUBROUTINE MANIP 74/175 OPT=0

--STATISTICS--

PROGRAM-UNIT LENGTH 1 3 7 5B r 745 CM LABELLED COMMON LENGTH 7 IB = 57 CM STORAGE USED 43000B < 24112

COMPILE TIME 0 4 04 SECONDS

199
FTN 5 1+552 83/12/20. 11.52 59 PAGE SUBROUTINE DISPLAY 74/175 OPT=0

14

1 SUBROUTINE DISPLAY (LINE, COMMAND) SFREQ 475

2 *COMF 1 3 *** COMMON FOR INITIAL PARAMETERS K * *COMF 1

4 *COMF 0

5 INTEGER FMAX COMF 4

f> PARAMETER (FMAX = 50) COMF 5

7 COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR , COMF 6 8 $ FTOT COMF 7

9 COMMON /IMITILC/ BLDG COMF 8

1 0 CHARACTER * 5 BLDG COMF 9

1

1

REAL FREQ, AFLAC, RFLAG, FREQA COMF 10

1 2 INTEGER QUALITY, FERR, FTOT COMF 1

1

13 *COMF 1 2 14 *COMF 1 3 15 INTEGER LINE, COMMAND, N SFREQ 477 U 1000 FORMAT ( 1 X

,

‘ L I NE # FREQUENCY (HZ)') SFREQ 4 78

17 20 00 FORMAT ( 4 X , I 3 , 8 X , 1 P E 1 5 . 5

)

SFREQ 479

1 8 PRINT 1000 SFREQ 4 80

19 IF ( COMMAND . EQ . 4 ) THEN SFREQ 48 1 20 DO 10 N = 1 , FTOT SFREQ 482

21 PRINT 2000, N,FREQA(N) SFREQ 483

22 10 CONTINUE SFREQ 4 84 23 ELSE SFREQ 485

24 PRINT 2000, LINE , FREQA(LINE) SFREQ 486

25 END IF SFREQ 487

26 RETURN SFREQ 4 88 27 END SFREQ 489

--VARIABLE MAP--(LO=A)

NAME ADDRESS- -BLOCK PROPERTIES TYPE---

AFLAC 2B / INITILN/ REAL BLDG OB / INITILC/ CHAR*5

COMMAND 2 DUMMY-ARG INTEGER

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL

FTOT 67B / INITILN/ INTEGER

LINE 1 DUMMY-ARG INTEGER

N lOOB INTEGER

QUALITY IB / INITILN/ INTEGER

RFLAG 3B / INITILN/ REAL

--SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE- VALUE

FMAX INTEGER 50 FTN 5 . 1 + 5 5 2 83 / 1 2 / 2 0 . 1 1.52

SUBROUTINE DISPLAY 74/175 OPT=0

59 PAGE 15

--STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF --ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS

10 INACTIVE DO-TERM 22 1000 51B FORMAT 16 2000 56B FORMAT 17

DISPLAY 5B 2

--STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

104B = &8 71B = 57 61000B = 25088

0.045 SECONDS

200
TTN 5 U552 83/12/20 11.52.59 PAGE 16 FUNCTION VA: 74/175 OPT=0

1 INTEGER FUNCTION VAL(STRING) 3FREQ 4?

2 C»* RETURNS THE INTEGER VALUE OF A STRING. SFREG 49

3 INTEGER NUMBER, I , L , EXP , D I G I T , GETLEN SFREQ 49

4 CHARACTER * (*) STRING S FR E Q 4?

5 L = GETLEN(STRING) SFREQ 49

6 NUMBER = 0 SFREQ 49

7 DO 10 X = L, 1 , -1 SFREQ 4 ?

8 EXP = L - X SFREQ 49

9 DIGIT = ICHAR(STRING(X: X) ) - 16 SFREQ 49

10 NUMBER = NUMBER + D I G I T* 1 0 * * E XP SFREQ 4 9 11 10 CONTINUE SFREQ 50

12 VAL = NUMBER SFREQ 50

13 RETURN SFREQ 5 0

1 4 END SFREQ 5 0

-VARIABLE MAP--(LO=A)

-NAME ---ADDRESS- -BLOCK PROPERTIES TYPE SIZE

DIGIT 76B INTEGER

EXP 75B INTEGER

L 74B INTEGER

NUMBER 72B INTEGER

STRING 1 DUMMY-ARG CHAR* ( *) VAL 71B INTEGER

X 73B INTEGER

-PROCEDURES--(LO=A>

-NAME TYPE ARCS CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 11

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARCS

VAL 6B 1

-STATISTICS--

PROGRAM-UNIT LENGTH 102B = 66 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.039 SECONDS

' G

1

2

3

4

5

6

7

89

0

2

201
83/12/20. 11.52.59 PAGE 78/175 OPT=0

FTN 5 . 1+552 17 FUNCTION GETLEN

1 INTEGER FUNCTION GETLEN (STRING) SFREQ 504

2 C SFREQ 5 05

3 C DETERMINE LENGTH OF STRING EXCLUDING ANY BLANK PADDING SFREQ 506

4 C SFREQ 507

5 c SFREQ 508

6 c ARGUMENT DEFINITIONS -- SFREQ 5 09

7 c READ ARGUMENTS SFREQ 5 1 0

8 c STRING - STRING WHOSE LENGTH IS TO BE DETERMINED SFREQ 5 11

9 c SFREQ 5 1 2 10 CHARACTER * (*) STRING SFREQ 5 13

1

1

c SFREQ 514

12 c FUNCTION PARAMETERS SFREQ 5 15 13 CHARACTER * 1 BLANK SFREQ 5 1 6

1 4 PARAMETER ( BLANK =

' '

)

SFREQ 5 17 15 c SFREQ 5 1 8 U c LOCAL VARIABLES SFREQ 5 19 17 INTEGER NEXT SFREQ 5 2 0 18 c SFREQ 521

19 c START WITH THE LAST CHARACTER AND FIND THE FIRST NON-BLANK SFREQ 522

20 DO 10 NEXT = LEN(STRING) , 1

, -1 SFREQ 523

21 IF (STRINGINEXT : NEXT) . NE . BLANK) THEN SFREQ 524

22 GETLEN = NEXT SFREQ 525

23 RETURN SFREQ 526

24 END IF SFREQ 527

25 10 CONTINUE SFREQ 528

26 c SFREQ 529

27 c ALL CHARACTERS ARE BLANKS SFREQ 530

28 GETLEN = 0 SFREQ 531

29 c SFREQ 532

30 RETURN SFREQ 533

31 END SFREQ 534

-VARIABLE MAP--(LO=A)

-NAME ---ADDRESS- -BLOCK PROPERTIES --TYPE SIZE

GETLEN 63B INTEGER

NEXT 68B INTEGER

STRING 1 DUMMY-ARG CHAR*(*)

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE - VALUE

BLANK CHAR*1 ' ’

-PROCEDURES--(LO=A)

-NAME TYPE- -ARGS CLASS

LEN INTEGER 1 INTRINSIC

-STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTI ES DEF

10 INACTIVE DO-TERM 25

FTN 5.1+552 83/12/20. 11.52.59 PAGE FUNCTION GETLEN 74/175 OPT=0

--ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARGS

GETLEN 6B 1

--STATISTICS--

70B = 56 61000B = 25088

0.039 SECONDS

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME
fTN 5 U552

SUBROUTINE LFREQ

i3ll2l2Q 11.52.59 PAGE

7<1/175 OPT = 0

19

1 SUBROUTINE LFREQ LFREQ 1

2

* ' M M !!!!!!! M I !!!! I !!!!!!!!!! MM! M !!!!!!!!!!!!!!!!!!!! I ! M. H ! M !! M ! L F R E Q 2

3 « I

I I M I LFREQ 3

9 •''! LOAD THE CONTENTS OF THE FILE 'BXXXIXF' INTO ARRAYS FREQA . LFREQ 4

5

• I i| I M LFREQ 5

i

t I I I

I II ! M II II M I II I! M. I I M. M II M II M I! ! M I! M II ! II I! II I! ! II I! II ! I! I ! M ! L F R E Q 6

g •»»*«»»»«»«»«*»»***********************»***********»***********» »** *COMF 1

9 *** COMMON FOR INITIAL PARAMETERS ***COMF 2 10 **it**i)«([«*«i***ti***«»i «** *****«*««*«********«*«***«*****i«**)init**«(***it*«C0MF 3

1

1

INTEGER FMAX COMF 4 12 PARAMETER (FMAX = 50) COMF e

13 COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF 6

1 4 $ FTOT COMF 7 15 COMMON /INITILC/ BLDG COMF 8

1 6 CHARACTER * 5 BLDG COMF 9 17 REAL FREQ, AFLAG, RFLAG, FREQA COMF 10

1 8 INTEGER QUALITY, FERR, FTOT COMF 1

1

19 1 1 1 1 t tt It 1 1 1 1 1 1 1 1 1 1 1 It 1 1 1 1 1 1 H t 1 1 1 1 t 1 1 1 1 H * 1 1 1 1 1 1 1 1 1 * 1 1 1 1( * * t k * t It * 1 1 t H 1

1

12 20 t It 1

1

n n 1 1

1

it It It 1 1 1

1

h t It t It It 1

1

it 1

1

h It It It t It It It t it It it t tt 1

1

It 1

1

it t t tit it fk* 1 1

1

it It It t it It it t it * 1

1

K 13

21 LFREQ 9 22 A DECLARATION OF VARIABLES LFREQ 10 23 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LFREQ 1 1 24 INTEGER GETLEN, R, C LFREQ 12 25 CHARACTER * 7 NAME, PFN LFREQ 1 3 26 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LFREQ 14 27 * LFREQ 15 28 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA LFREQ 16 29 NAME = 'B ’ //BLDG< 1 : GETLEN(BLDG) ) / /

F

' LFREQ 17

30 PFN = NAME (1 GETLEN(NAME) ) LFREQ 18 31 FERR = 0 LFREQ 19 32 CALL PF ( 'GET* ,0,PFN(1 ;GETLEN(PFN) ), 'RC , FERR) LFREQ 20

33 IF ( FERR EQ. 0 ) THEN LFREQ 21 34 OPEN (UNIT=3, FILE=PFN, FORM= ' FORMATTED ’

, LFREQ 22

35 S STATUS= 'OLD' , ACCESS= ' SEQUENTIAL '

)

LFREQ 23

36 FTOT = 0 LFREQ 24

37 DO 10 R = 1,FMAX LFREQ 25

38 READ (3 , 1000 ,END=20) FREQA(R) LFREQ 26

39 1 00 0 FORMAT! El 2. 7) LFREQ 27

40 FTOT = FTOT + 1 LFREQ 28

41 10 CONTINUE LFREQ 29

42 20 CONTINUE LFREQ 30 43 CLOSE(3,STATUS='DELETE'

)

LFREQ 31 44 ELSE IF ( FERR EQ. 2 > THEN LFREQ 32

45 CALL WARNING (11) LFREQ 33

46 ELSE LFREQ 34 47 CALL WARNING (12) LFREQ 35 48 END IF LFREQ 36 49 RETURN LFREQ 37 50 END LFREQ 38

--VARIABLE MAP--(LO=A)

NAME-- -ADDRESS- -BLOCK -PROPERTIES -- -TYPE ---SIZE

AFLAG 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C NONE UNUSED/ *S» INTEGER

FERR 66B /INITILN/ INTEGER

FREQ 06 / INITILN/ REAL FREQA 46 / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER

NAME 21 OB CHAR*7

PFN 21 IB CHAR*7

203
FTN 5.1+552 83/12/20. 11.52.59 PAGE 20 SUBROUTINE LFREQ 74/175 OPT=0

INTEGER

INTEGER REAL

--SYMBOLIC CONSTANTS-- ( LO=A) -NAME TYPE VALUE

FMAX INTEGER 50

QUALITY IB /INITILN/

R 20 7B RFLAG 3B /INITILN/

--PROCEDURES--(LO=A)

-NAME TYPE

GETLEN INTEGER

PFWARNING

ARGS CLASS

1 FUNCTION

5 SUBROUTINE

1 SUBROUTINE

--STATEMENT LABELS-- ( LO=A

)

-LABEL- ADDRESS --PROPERTIES- ---DEF

10 INACTIVE DO-TERM 41 20 63B 42 1000 1 20B FORMAT 39

--ENTRY POINTS--(LO=A)

-NAME-- - ADDRESS-- ARGS- --

LFREQ 5B 0

--I/O UNITS--(LO=A)

-NAME--- PROPERTIESTAPE3 AUX/FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

215B = 141

7 IB = 57 61000B = 25088

0.080 SECONDS

204
FTN 5 U552 83/12/20. 11.52.59 PAGE 21 SUBROUTINE ERROR 74/175 OPT=0

1 SUBROUTINE ERROR! lERR) ERROR 1

2 CHARACTER»45 MESSAGE(20) ERROR 2

3 DATA MESSAGE! 1)/ 'MATERIALS DATA, BASE IS EMPTY ' / ERROR 3

4 DATA MESSAGE! 2)1 ' FREQUENCY IS OUT iOF RANGE ' / ERROR 4

5 DATA MESSAGE! 3)/ 'THIS MATERIAL IS ;NOT IN DATA BASE ' / ERROR 5

6 DATA MESSAGE! 4)/ 'DENOMINATOR IS1 ZERO ' / ERROR 6

7 DATA MESSAGE! 5)/ 'FILE HANDLING ERROR ' / ERROR 7

8 DATA MESSAGE! 6)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 8

9 DATA MESSAGE! 7)1 ' ERROR CODE IS OUT OF RANGE ' / ERROR 9

1 0 DATA MESSAGE! 8)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 10

1 1 DATA MESSAGE! 7)1 ' ERROR CODE IS OUT OF RANGE ' / ERROR 1 1

1 2 DATA MESSAGE! 10)/ ' ERROR CODE IS OUT OF RANGE ' / ERROR 12

13 DATA MESSAGE ! 1 1 ) / ERROR CODE IS OUT OF RANGE ' / ERROR 13

1 4 DATA MESSAGE! 12) / ERROR CODE IS OUT OF RANGE ' / ERROR 14

15 DATA MESSAGE! 13 ) /

' ERROR CODE IS OUT OF RANGE ' / ERROR 15

1 6 DATA MESSAGE! 14) / ERROR CODE IS OUT OF RANGE ' / ERROR 16

17 DATA MESSAGE! 15 ) / ’ ERROR CODE IS OUT OF RANGE ' / ERROR 1 7

1 8 DATA MESSAGE! 16 ) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 18

19 DATA MESSAGE ! 1 7 ) / ' ERROR CODE IS OUT OF RANGE ’ / ERROR 19 20 DATA MESSAGE! 18) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 20

21 DATA MESSAGE ! 19 ) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 21 22 DATA MESSAGE ! 20 ) / ' ERROR CODE IS OUT OF RANGE ' / ERROR 22 23 IERRM=5 ERROR 23 24 IF ( lERR . GT . lERRM) IERR = 20 ERROR 24

25 WRITE(6,10) lERR, MESSAGE! lERR) ERROR 25 26 10 FORMAT!' ***ERROR NUMBER = ,15, ‘ * Ht * '

, A45

)

ERROR 26 27 CALL PMDSTOP ERROR 27 28 STOP ERROR ' ERROR 28

29 END ERROR 29

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

lERR 1 DUMMY-ARG INTEGER

lERRM 210B INTEGER

MESSAGE 56B CHAR*45 20

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

PMDSTOP 0 SUBROUTINE

-STATEMENT LABELS-- < LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 36B FORMAT 26 FTN 5.1+552 83/12/20. 11 52.59 PACE 22 SUBROUTINE ERROR 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS

ERROR 5B 1

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

2 1 3B 2 139

6 1 OOOB 1 2 5 0 8 8

0 056 SECONDS

205
FTN 5,1+552 83/12/20. 11.52.59 PAGE SUBROUTINE WARNING 74/175 OPT=0

23

1

2

3

45

6

7

8

9

1 0

1

1

12

1314

15

26

2728

29

30

3132

33

1020

SUBROUTINE VARNING(ERR)

INTEGER ERR, ERRM CHARACTER*45 MESSAGE(20)

DATA DATA

DATA

DATA

DATA

DATA DATA

DATA DATA

DATA

DATA

DATA

MESSAGE!

MESSAGE

(

MESSAGE!

MESSAGE!

MESSAGE!

MESSAGE

!

MESSAGE!

MESSAGE

MESSAGE!

MESSAGE! 10 ) / MESSAGE! 11 )/

1 ) /

2 ) / 3) /

4 ) / 5 ) /

6 ) /

"HOLE" DATA FILE DOES NOT EXIST FOR THIS BLDG

FILE HANDLING PROBLEM ON "HOLE" DATA FILE "MATTER" FILE DOES NOT EXIST FOR THIS BLDG

FILE HANDLING PROBLEM ON "MATTER FILE NOT

ONNOT

ON

"TYPE" DATA FILE DOES

FILE HANDLING PROBLEM

7)

/ '"WALL" DATA FILE DOES

8)

/‘FILE HANDLING PROBLEM

HEIGHT AND WIDTH OF ROOM MISSING

LENGTH OF ROOM IS MISSING

FREQ FILE DOES NOT EXIST FOR THIS

EXIST

"TYPE" EXIST

"WALL"

FOR THIS

FILE

FOR THIS

FILE

BLDG

BLDG

9 ) /

BLDG

MESSAGE!12) / 'FILE HANDLING PROBLEM WITH FREQ FILE

1 6 DATA MESSAGE! 13 ) / ‘WARNING CODE IS OUT OF RANGE

17 DATA MESSAGE! 14 ) / 'WARNING CODE IS OUT OF RANGE

1 8 DATA MESSAGE! 15 )

/ 'WARNING CODE IS OUT OF RANGE

19 DATA MESSAGE ! Id ) / 'WARNING CODE IS OUT OF RANGE

20 DATA MESSAGE! 17 )

/ 'WARNING CODE IS OUT OF RANGE

21 DATA MESSAGE! 18) / 'WARNING CODE IS OUT OF RANGE

22 DATA MESSAGE! 19 ) / 'WARNING CODE IS OUT OF RANGE

23 DATA MESSAGE ! 20 )

/ 'WARNING CODE IS OUT OF RANGE

24 ERRM=:12 25 I ERR = ERR

IF !ERR . GT. ERRM) IERR=2Q WRITE ! 6 , 20

)

WRITE!6,10> ERR, MESSAGE! lERR)

WRITE!6,20)

FORMAT!' ***WARNING NUMBER = FORMAT! '

'

)

RETURN

END

15 ,A45 )

WARNING 1 WARNING 7 WARNING 3

' / WARNING 4

' / WARNING c

' / WARNING 6

' / WARNING 7

' / WARNING 8

' / WARNING 0

' / WARNING 10

' / WARNING 1 1

' / WARNING 12

' / WARNING 1 3

' / WARNING 1 4

' / WARNING 15

' / WARNING 16

' / WARNING 1 7

' / WARNING 18

' / WARNING 1 9

' / WARNING 20

' / WARNING 21

' / WARNING 22

' / WARNING 23 WARNING 24 WARNING 25 WARNING 26 WARNING 2 '/ WARNING 28 WARNING 29 WARNING 30 WARNING 31 WARNING 32 WARNING 33

-VARIABLE MAP--!LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

ERR 1 DUMMY-ARG

ERRM 606

lERR 213B

MESSAGE 61B

INTEGER

INTEGER

INTEGER

CHAR*45 20

-STATEMENT LABELS-- ! LO=A) -LAB EL -ADDRESS PROPERTIES DEF

10 34B FORMAT 30 20 42B FORMAT 31

-ENTRY P01NTS--!LO=A)

-NAME ADDRESS--ARGS

WARNING 5B 1

FTN 5.1+552 83/12/20. 11.52.59 PAGE 24 SUBROUTINE WARNING 74/175 OPT=0

--I/O UNITS-- ! LO=A

)

-NAME--- PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

216E = 142 61000B = 25088

0.064 SECONDS

206
Appendix 9.7 Listing of Computer Program MASTER

207
FTN 1 j. 1 + 552 84/03/14. 10.18.23 PAGE

PROGRAM MASTER 74/175 OPT=0

1

2

3

4

5

6

78

9

1 0 11

1 2 13

1 4 1516

1718

1920

2122

2324

2526

2728

2930

3132

3334

35

36

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

PROGRAM MASTER ( I NPUT , OUTPUT , TAPEl = INPUT, TAPE6 = OUTPUT)

»*H**<f*********<t******H'

AAAI *** COMMON FOR INITIAL PARAMETERS

* * * ; INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ, QUALITY

5 FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG REAL FREQ, AFLAG, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

MASTER

I************* master

I******** * COMF

***COMF

AFLAG, RFLAG, FREQA(FMAX), FERR

COMF

COMF

COMF

COMF

COMF

COMF

COMF

COMF ********** *COMF

COMMON FOR DATABASE OF WALL PARAMETERS ***COMV

INTEGER WMAX

PARAMETER (WMAX = 75)

COMMON /WALLN/ WDIM(WMAX,3)

COMMON /WALLC/ WALL(WMAX,4)

INTEGER WTOT,WERR

REAL WDIM

CHARACTER *3 WALL

* ===============================;

** DESCRIPTION OF ARRAYS

* ===============================:

* WALL IDENTIFICATION

*

«

*

**

*

*

*

*

WTOT, WERR

DIRECTION FROM

ROOM

TO

ROOM

WALL (X , 1

)

A3 WALL(X ,2) A3 WALL(X,3)A3

WALL PARAMETERS

MATERIAL HEIGHT WIDTH LAYER THICKNESS

WALL( X, 4) WDIM( X, 1

)

WDIM( X, 2) WDIM(X, 3) A3 F8 . 2 F8 . 2 F8 , 2

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

* * ) *** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS

******* 1 ***COMT

INTEGER TMAX PARAMETER (TMAX=35)

COMMON /TYPEN/TDIM(TMAX , 4) ,TTOT ,TDB2 (TMAX ,2) ,TDBTOT,TERR

COMMON /TYPEC/TYPE(TMAX,3) ,TDB1 (TMAX)

INTEGER TTOT,TDBTOT,TERR

REAL TDIM,TDB2

CHARACTER * 3 TYPE,TDB1

* DESCRIPTION OF ARRAYS

* ID

t _ _ _ MATERIAL FRAME MATERIAL

TYPE (X , 1 ) TYPE (X , 2 ) TYPE(X , 3)

* A3 A3 A3

« HEIGHT

* WIDTH LAYER DISTANCE

THICKNESS ABOVE FLOOR

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

COMT

1

2

1

2

3

4

5

67

89 10

1 1 1213

12

3

4

5

67

8

9 10

1112

13

I 4 1516

1718

1920

2122

2324

2526

2728

29

12

3

45

67

8

9 iO

I

I

1213

1415

1617

1819

20

208
FTN 5 U552 2 PROGRAM MASTER

84/03/14 10.18.23 PACE

74/17S OPT=0

6S

46

67

68

6770

7172

7374

7576

7778

7980

8182

8384

8586

8788

8990

9192

9394

9596

9798

99 100

10 1 102

103

104

105 106

107 108

109 110

11 1 112

113 114

115 116

117 118

119 120

121 122

123

124

125 126

127 128

TD1M(X 1) TDIM(X,2) TDIM(X , 3) TDIM(X,4)

FB . 2 F8 . 2 F8 . 2 F8 . 2

ID ATTENUATION AREA

COMT

COMT

COMT

COMT

COMT

COMT

TDBKX) TDB2(X,1) TDB2(X,2) COMT

A3 E9.3 E9.3 COMT

it*t**tit« «** **«** ««*****t*****it****************************************«***)«***********c OMH

• COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS ***COMH

1

1

* 1

1

* * INTEGER HMAX PARAMETER (HMAX = 35)

COMMON /HOLEN/ HTOT, HERR COMMON /HOLEC/ HOLE(HMAX,4)

INTEGER HTOT, HERR

CHARACTER » 3 HOLE ssssss = = ss = sss = = = = s: = = = = s = s: = s = = s: DESCRIPTION OF ARRAYS

ROOM IDENTIFICATION APERTURE ID

DIRECTION FROM ROOM TO ROOM

HOLE(X, 2) A3HOLECX, 3) A3 HOLE(X, 4) A3

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

HOLE( X, 1

)

A3 ********

* * * * «»» COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS *»*COMR

***t**ii*ttt**t*t*tt*iit**iitiit***tttt*tiitiit**t*t****t***t**t*iit*tt*t*t*t * COMR

INTEGER RMAX PARAMETER (RMAX = 20)

COMMON /ROOMN/ ROOM (RMAX

INTEGER NROOMS

REAL ROOM

+ 6, RMAX +6), NROOMS, RAREA(RMAX)

COMR

COMR

COMR

COMR

COMR

COMMON FOR DATABASE OF MATERIAL PROPERTIES ***COMM

INTEGER MMAX COMM

PARAMETER (MMAX=100) COMM

COMMON /MATN/ MATTEN(MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), OR (MMAX), COMM

$ MFREQ(MMAX, 7) , MERR, MTOT COMM

COMMON /MATCZMAT(MMAX) ,MATDESC(MMAX) COMM

INTEGER MTOT, MERR COMM

REAL MATTEN, MRCOEF, MFREQ, QA , OR COMM

CHARACTER * 3 MAT COMM

CHARACTER * 70 MATDESC COMM

COMMON FOR EVALUATION OF ROOM MATRIX

t

*

*A***************************************************************

COMMON / MAT /TMAT( RMAX, RMAX) , ENERGY ( RMAX ) , POWER! 6) , FT I ME +,SWR(RMAX,6) ,IDIR REAL TMAT , ENERGY , POWER , SWR

LOGICAL FTIME

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

21

2223

2425

2627

2829

30

1

23

45

67

8

9 10

1 1 1213

1415

1617

1819

20

1

2

3

45

67

89 10

1

23

45

67

89 10

1 1 1213

14

1

2

3

45

67

89

1

209
FTN 5.1+552 84/03/14. 10.18.23 PAGE 3 PROGRAM MASTER 74/175 OPT=0

127

130

131 132

133 134

135 136

137 138

139 140

141 142

143 144

145

1 46 147 143

149 150

15 1 152

153 154

155 156

157 158

159 160

161 162

163

164

165 166

167 168

169 170

17 1 172

173

174

175 176

177 178

179

1 80 181 182

183 184

185 186

187 188

189 190

191 192

30

PRINT*

,

READ! 1

,

PRINT*

PRINT *.

i

* COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS

COMMON /ROOMD/DDABS(RMAX + 6, RMAX + 6 ) ,DREFL, DREFLW

REAL DDABS ,DREFL , DREFLW

************t1i*1i*1i1i*1i*1rk*****tt1t*1i1it1t*tt*******1i*1i

* DECLARATION OF VARIABLES

*******«iir****««*ili*«*«*****ik«***«**ltl«*******tt*****it

INTEGER GETLEN

**********1i1i*1i**l!*1i1i*tK1HrK1i*ii1i*»***1iiit*t1t*1tii*****t

* INITIAL SETUP

*iiii**iiii iiii** ***iiiitiiiit*t*ii*i(*****t*ittii**ttt*it**it

NROOMS = 3 AFLAG = 0 RFLAG = 0 ***»*»********»*****i »»** ***»»***t*******»****»

* INPUT BUILDING IDENTIFICATION

***** 1i**liii*l(*ii*lili*tlitii*tttii***tt«t***lt* 1i*****tt*li*

20 PRINT*, 'ENTER BUILDING IDENTIFICATION (E.G. ''lOl'')

' (NO MORE THAN 5 ALPHANUMERIC CHARACTERS)'

* , END = 20) BLDG

BUILDING IDENTIFICATION ENTERED AS '',

BLDGd :GETLEN(BLDG) ) ,

' ' ' ' ENTER NUMBER OF ROOMS IN BUILDING'

READ (1,*,END = 30) NROOMS

t*tiiii*tii**iiiiii***iiii**ii*ii*tiiii*tii*t*****t*t****t*tii*t

* LOAD ARRAYS FROM DATA FILES

«i*«**« «** lt***«********************t***ik*******

CALL LMATTER

CALL LWALL

CALL LTYPE

CALL LHOLE

CALL LFREQ

***mit****** 1i* 1i* 1(** 1i 1ili 1itt**li 1ilrk 1itii** 1i*********tt 1it

* CHECK FOR ERROR IN FREQ FILE.

* IF THERE IS AN ERROR (E.G. MISSING) THEN

* JUST USE THE DEFAULT FREQUENCIES

*****tt**<l tit1[** 4lA**Ilt******«*4lt**1k******It1l(lMllt*<l** IF (FERR.NE.O) THEN

FTOT = 7 DO 40 IFR = 1,7

40 FREQA(IFR) = 1.0E03 * (10.0 ** IFR)

PRINT*, ' *** DEFAULT FREQUENCIES WILL BE USED *** ' END IF

iir**lt*<i**<tAltktt***(iltlt*lt*****lHtlk***(**lktt**D**«D*lt*«*lt*lklk*lt*Dlk«*

CALL PWALL

CALL PHOLE

CALL PTYPE

A*******1k1klt*****1k**ilrA***1t1t**A**A*lt*1k****lk*A*A***A*

* CHECK FOR FILE ERROR

) .OR. ( WERR .NE. 0 ) OR.

) .OR. (TERR .NE. 0 ) ) THEN

IF ( ( MERR .NE. 0

5 ( HERR NE. 0 CALL ERROR (5) END IF

**t*iiiiiiii*iiiiiiiitiiiiii*ii****iiitiitii*ii**ii********ii*ii*ii*t*t

*

DO 200 IFR= 1 , FTOT

FREQ = FREQA(IFR)

CALL IDDABS

CALL LTDB CALL LRAREA

COMD 2

3 COMD 4 COMD 5 *COMD 6

7 MASTER 1 1 MASTER 12 MASTER 13 MASTER 14 MASTER 15 MASTER 16 MASTER 17 MASTER 18 MASTER 1 9 MASTER 20 MASTER 21 MASTER 22 MASTER 23 MASTER 24 MASTER 25 MASTER 26 MASTER 27 MASTER 28 MASTER 29 MASTER 30 MASTER 31 MASTER 32 MASTER 33 MASTER 34 MASTER 35 MASTER 36 MASTER 37 MASTER 38 MASTER 39 MASTER 40 MASTER 41 MASTER 42 MASTER 43 MASTER 44 MASTER 45 MASTER 46 MASTER 47 MASTER 48 MASTER 49 MASTER 50 MASTER 51 MASTER 52 MASTER 53 MASTER 54 MASTER 55 MASTER 56 MASTER 57 MASTER

MASTER 59 MASTER 60 MASTER 61 MASTER 62 MASTER 63 MASTER 64 MASTER 65 MASTER 66 MASTER 67 MASTER 68

210
rXN 5 U552

PROGRAM MASTER

84/03/14. 10.18.23 PAGE

74/175 OPT=0

4

193 CALL CFACTOR MASTER 69 194 CALL DFACTOR MASTER 70 195 FTIME = TRUE. MASTER 71 196 DO 100 IDIR =1,5 MASTER 72 197 DO SO J = 1 , 6 MASTER 73 198 50 POWER (J) = 0.0 MASTER 74 199 POWER (IDIR) = 10.0 MASTER 75 200 CALL ECALC MASTER 76 20 1 100 CALL SPWR MASTER 77 202 CALL PPWR2 MASTER 78 203 200 CONTINUE MASTER 79 204 STOP MASTER 80 205 END MASTER 81

RIABLE MAP --(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

DDABS OB /ROOMD/ REAL 676 DREFL 1 244B /ROOMD/ REAL

DREFLW 1 24 5B /ROOMD/ REAL ENERGY 620B /MAT/ REAL 20 FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B / INITILN/ REAL 50 FTIME 6S2B /MAT/ LOGICAL

FTOT 67B / INITILN/ INTEGER

HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR»3 1 40 HTOT OB /HOLEN/ INTEGER

IDIR 1 043B /MAT/ INTEGER

IFR 332B INTEGER

J 3 3 6B INTEGER

MAT OB /MATC/ CHAR*3 100 MATDESC 36B /MATC/ CHAR*70 1 00 MATTEN OB /MATN/ REAL 700 MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700

MRCOEF 1 27 4B /MATN/ REAL 700

MTOT 4375B /MATN/ INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

POWER 644B /MAT/ REAL 6 QA 257 0B /MATN/ REAL 1 00 OR 2734B /MATN/ REAL 100 QUALITY IB / INITILN/ INTEGER

RAREA 1 245B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 676

SWR 65 3B /MAT/ REAL 1 20 TDBTOT 32 3B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 32 4B /TYPEN/ INTEGER

TMAT OB /MAT/ REAL 400 TTOT 21 4B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3 1 05 WALL OB /WALLC/ CHAR*3 300

WDIM OB /WALLN/ REAL 225

WERR 342B /WALLN/ INTEGER

WTOT 341B /WALLN/ INTEGER

211
FTN 5.1+552 84/03/14. 10.18.23 PAGE 5 PROGRAM MASTER 74/175 OPT=0

-SYMBOLIC CONSTANTS--! LO=A) NAME-- --TYPE VALUE -NAME- ---TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20 HMAX INTEGER 35 TMAX INTEGER 35 MMAX INTEGER 100 VMAX INTEGER 75

PROCEDURES--(LO=A)

NAME TYPE --ARGS CLASS -NAME --TYPE ARCS--- ---CLASS

CFACTOR 0 SUBROUTINE LRAREA 0 SUBROUTINE

DFACTOR 0 SUBROUTINE LTDB 0 SUBROUTINE

ECALC 0 SUBROUTINE LTYPE 0 SUBROUTINE

ERROR 1 SUBROUTINE LUALL 0 SUBROUTINE

GETLEN INTEGER 1 FUNCTION PHOLE 0 SUBROUTINE

IDDABS 0 SUBROUTINE PPWH2 0 SUBROUTINE

LFREQ 0 SUBROUTINE PTYPE 0 SUBROUTINE

LHOLE 0 SUBROUTINE PWALL 0 SUBROUTINE

LMATTER 0 SUBROUTINE SPWR 0 SUBROUTINE

-STATEMENT LABELS- -( LO=A

)

-LABEL- ADDRESS --PROPERTIES-- --DEF -LABEL -ADDRESS --PROPERTIES- DEF

20 26B 148 50 INACTIVE DO-TERM 1 98 30 44B 153 100 INACTIVE DO-TERM 201

40 INACTIVE DO-TERM 171 200 INACTIVE DO-TERM 203

-ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS- --

MASTER 20B 0

-I IQ UNITS--(LO = A) -NAME PROPERTIES

TAPEl FMT/SEQ

-STATISTICS--

340B = 224 12774B = 5628

63000B = 26112

0.183 SECONDS

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

212
FTN : U55 2 FUNCTION ATTEN

84/03/14. 10.18.23 PAGE

74/175 OPT=0

6

1 REAL FUNCTION ATTEN ( I D , FREQ , AFLAC ) ATTEN

2 «[[[ t C [[[[[[[[ C C C C [[ C [[[[ C [[[[[[[ t C C [[ C C [ C C C [[[[[ t C C C C C [[[[[ C C C C C t C [[ C C [ ATTEN

3 "CCC [[[ATTEN

4 •[[[ GIVEN THE FREQUENCY AND THE MATERIAL, THIS FUNCTIQN RETURNS [[[ATTEN

5 *[[[ THE ATTENUATION [[[ATTEN

6 •[[[ [[[ATTEN

7 •[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ATTEN

3 (***«**t**<it**************it*ik*«****************«*«******A Aitit** ***** * ATTEN

9 » FREQ IS IN HERTZ ATTEN

10 * HIFREQ.LOFREQ, AND F ARE IN LOG ( HERTZ ) ATTEN

11 • AFLAC RANGES FROM 0 TO 100 AND DETERMINES HOW MUCH OF THE QUALITY ATTEN

12 • FACTOR IS APPLIED TO THE ATTENUATION VALUE. ATTEN

15 *«» COMMON FOR DATABASE OF MATERIAL PROPERTIES *»*COMM

17 INTEGER MMAX COMM

18 PARAMETER (MMAX=100) COMM

19 COMMON /MATN/ MATTEN(MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), QR(MMAX), COMM

20 S MFREQ(MMAX , 7 ) , MERR, MTOT COMM

21 COMMON /MATC/ MAT (MMAX) , MATD ESC (MMAX

)

COMM

22 INTEGER MTOT, MERR COMM

23 REAL MATTEN, MRCOEF, MFREQ, QA

,

QR COMM

24 CHARACTER * 3 MAT COMM

25 CHARACTER * 70 MATDESC COMM

26

27 ft ft 28 ftft**ftft*ft*ftftft******«ft**ft*ft*ft*ftftft***ft*ft**ftft***ft*«!*** ATTEN

29 ft DECLARATION OF VARIABLES ATTEN

30 ftftft*ftftftftft*ft*ftft**ftft«ft**ft*ft**ft*ft*ft*ft**ft*ft*ft*«ftft*ft**ft ATTEN

31 REAL FREQ, FRAC ,MINFREQ,MAXFREQ, LOFREQ, HI FREQ, LOATTEN, HI ATTEN,

F

ATTEN

32 INTEGER R ,C ,RINDEX ,CINDEX ATTEN

33 LOGICAL FOUND, EXACT ATTEN

34 CHARACTER *3 ID ATTEN

35 ft * ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft ATTEN

36 * FIND ROW INDEX OF MATERIAL ATTEN

37 ft*ftftftftft*ftfttftftftr*ftftfttftftft*ft*fttftft*ftft*tft*ftftftftftfttftftftftfttt ATTEN

38 FOUND = .FALSE. ATTEN

39 DO 10 R = 1, MMAX ATTEN

40 IF ( MAT(R) .EQ. ID ) THEN ATTEN

41 FOUND = .TRUE. ATTEN

42 RINDEX = R ATTEN

43 END IF ATTEN

44 10 CONTINUE ATTEN

45 IF ( .NOT. FOUND ) THEN ATTEN

46 I ERR = 3 ATTEN

47 CALL ERROR (lERR) ATTEN

48 END IF ATTEN

49 ftftftft*ftftftft*«*ft*ftft**«*ftftftft****ftft«ft t** ***ft«««**ft* ATTEN

50 t TEST FOR FREQUENCY OUT OF RANGE ATTEN

51 ATTEN

52 MINFREQ = MFREQ (RINDEX, 1) ATTEN

53 MAXFREQ = MFREQ (RINDEX, 7) ATTEN

54 IF ( FREQ .LT. MINFREQ .OR. FREQ . GT. MAXFREQ ) THEN ATTEN

55 I ERR = 2 ATTEN

56 CALL ERROR (lERR) ATTEN

57 END IF ATTEN

58 ftftfk**t*ft*ftft*ft**ft*t*AftAftftft*ftftftftftftftftftftftftftftft*ftftftftftfkftft ATTEN

59 ft IF THE EXACT FREQUENCY IS IN THE TABLE, THEN ATTEN

60 ft USE THE ATTENUATION VALUE WITHOUT INTERPOLATION. ATTEN

61 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft ATTEN

62 DO 20 C= 1,7 ATTEN

63 EXACT = .FALSE. ATTEN

64 IF ( FREQ .EQ. MFREQ (RINDEX, C) ) THEN ATTEN

1

23

4

5

6

7

8

9 10

1 1 1213

1

2

3

4

56

7

8

9 10

1112

13

1 4 15U

1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

51

213
TTN 5.1+552 84/03/14. 10.18.23 PAGE 7 FUNCTION ATTEN 74/175 OPT=0

65 EXACT = .TRUE. ATTEN

66 CINDEX r: C ATTEN

67 ATTEN = MATTEN ( R INDEX , C INDEX

)

ATTEN

68 ATTEN = ATTEN * ( 1 + AFLAC / 100 ) ATTEN

69 END IF ATTEN

70 20 CONTINUE ATTEN

71 ******ii**t**ti(tti(ii**ii**tiit*****t*t****tt tittt**  ATTEN

72 INTERPOLATE ATTENUATION VALUES IF EXACT FREQUENCY IS ATTEN

73 t NOT IN THE FREQUENCY/ ATTENUATION ARRAYS. ATTEN

74 ATTEN

75 IF ( .NOT. EXACT ) THEN ATTEN

76 DO 30 C = 1 ,6 ATTEN

77 IF ( FREQ .GT. MFREQ (RINDEX.C) .AND. ATTEN

78 5 FREQ LT. MFREQ (RINDEX,C+1) ) THEN ATTEN

79 CINDEX = C ATTEN

80 END IF ATTEN

81 30 CONTINUE ATTEN

82 F = ALOGIO ( FREQ ) ATTEN

83 LOFREQ = ALOGIO ( MFREQ (RINDEX, CINDEX) ) ATTEN

84 HIFREQ = ALOGIO ( MFREQ (RINDEX, CINDEX + 1) ) ATTEN

85 LOATTEN = MATTEN (RINDEX , CINDEX) ATTEN

86 HIATTEN = MATTEN (RINDEX, CINDEX + 1) ATTEN

87 FRAC = (F - LOFREQ) / (HIFREQ - LOFREQ) ATTEN

88 ATTEN = LOATTEN + (FRAC * (HIATTEN - LOATTEN) ) ATTEN

89 ATTEN = ATTEN * ( 1 + AFLAC / 100 ) ATTEN

90 END IF ATTEN

91 RETURN ATTEN

92 END ATTEN

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

AFLAC 3 DUMMY-ARG REAL ATTEN 242B REAL

C 2S4B INTEGER

CINDEX 256B INTEGER

EXACT 2 6 0B LOGICAL

F 252B REAL FOUND 257B LOGICAL

FRAC 243B REAL

FREQ 2 DUMMY-ARG REAL HIATTEN 2S1E REAL HIFREQ 247B REAL

ID 1 DUMMY-ARG CHAR*

3

lERR 2 6 2B INTEGER

LOATTEN 250B REAL LOFREQ 246B REAL MAT OB /MATC/ CHAR*3 100 MATDESC 36B /MATC/ CHAR*70 1 00 MATTEN OB /MATN/ REAL 700 MAXFREQ 245B REAL MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700 MINFREQ 24 4B REAL MRCOEF 1 274B /MATN/ REAL 700 MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 1 00 QR 2734B /MATN/ REAL 100

R 253B INTEGER RINDEX 255B INTEGER

52

5354

5556

5758

5960

6162

6364

6566

6768

6970

7172

7374

7576

7778

79

214
riN 5 U552 84/03/14, 10.18.23 PAGE 8 FUNCTION ATTEN 74/175 OPT=0

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

MMAX INTEGER 100

-PROCEDURES--/ LO=A)

NAME-- TYPE ARCS--- ---CLASS

ALOGIO REAL 1 INTRINSIC

ERROR 1 SUBROUTINE

STATEMENT LABELS- -( LO=A) LABEL- ADDRESS -PROPERTIES- ---DEF

10 INACTIVE DO-TERM 44 20 INACTIVE DO-TERM 70

30 INACTIVE DO-TERM 81

ENTRY POINTS--(LO = A)

NAME-- -ADDRESS--ARGS

ATTEN 6B 3

-STATISTICS--

PROGRAM-UNIT LENGTH 2&7B = 183 CM LABELLED COMMON LENGTH 5730B = 30 32 CM STORAGE USED 61000B = 2S088

COMPILE TIME 0.132 SECONDS

215
FTN 5.1+552 84/03/14. 10 .18.23 PAGE 9 SUBROUTINE ERROR 74/175 OPT = 0

1 SUBROUTINE ERROR(IERR) ERROR

2 CHARACTER*45 MESSAGE(20) ERROR

3 DATA MESSAGE! 1)/ MATERIALS DATA. BASE IS EMPTY / ERROR

4 DATA MESSAGE! 1)1 FREQUENCY IS OUT OF ;RANGE / ERROR

5 DATA MESSAGE! 2)1 THIS MATERIAL IS NOT IN DATA BASE / ERROR

6 DATA MESSAGE! 4)/ 'DENOMINATOR IS ZERO / ERROR

7 DATA MESSAGE! 5)/ FILE HANDL ING ERROR / ERROR

8 DATA MESSAGE! 6)/ ERROR CODE I

S

OUT OF RANGE / ERROR

9 DATA MESSAGE! 7)1 ERROR CODE IS OUT OF RANGE / ERROR

1 0 DATA MESSAGE! 8)/ ERROR CODE IS OUT OF RANGE ' / ERROR

11 DATA MESSAGE! 9)1 ERROR CODE IS OUT OF RANGE / ERROR

12 DATA MESSAGE!10)

/

ERROR CODE IS OUT OF RANGE / ERROR

13 DATA MESSAGE! 11)/ ERROR CODE IS OUT OF RANGE / ERROR

1 4 DATA MESSAGE! 12)

/

ERROR CODE IS OUT OF RANGE / ERROR

15 DATA MESSAGE ! 13 )

/

ERROR CODE IS OUT OF RANGE / ERROR

1 6 DATA MESSAGE! 1 4)

/

ERROR CODE IS OUT OF RANGE / ERROR

17 DATA MESSAGE!15)/ ERROR CODE IS OUT OF RANGE / ERROR

1 8 DATA MESSAGE! 16) / ERROR CODE IS OUT OF RANGE / ERROR

19 DATA MESSAGE! 17)/ ERROR CODE IS OUT OF RANGE / ERROR

20 DATA MESSAGE!18) / ERROR CODE IS OUT OF RANGE / ERROR

21 DATA MESSAGE! 19 ) / ERROR CODE IS OUT OF RANGE / ERROR

22 DATA MESSAGE!2Q) / ‘ERROR CODE IS OUT OF RANGE / ERROR

23 IERRM=5 ERROR

24 IF( lERR.GT. lERRM) IERR=20 ERROR

25 WRITE(6,10) lERR, MESSAGE! lERR) ERROR

26 10 FORMAT!' ***ERROR NUMBER = , 15 ,

' tut ,A45) ERROR

27 CALL PMDSTOP ERROR

28 STOP ' ERROR

ERROR

29 END ERROR

-VARIABLE MAP--!LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

lERR 1 DUMMY-ARG INTEGER

lERRM 210B INTEGER

MESSAGE 56B CHAR*45 20

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

PMDSTOP 0 SUBROUTINE

-STATEMENT LABELS-- ( LO=A) -LAB EL- ADDRESS PROPERTIES DEF

10 36B FORMAT 26

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

ERROR 5B 1

1

2

3

45

6

7

89 10

1 1 1213

1415

16

1 7 1819

2021

2223

2425

2627

2829

216
FTN 5 1*552

SUBROUTINE ERROR

84/ 03 / 1 4. 1 0. 1 8.23 PACE

74/175 OPT=0

10

--I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE6 FMT/SEQ

--STATISTICS--

PROCRAM-UNIT LENGTH 213B

CM STORAGE USED 41000B

COMPILE TIME 0.055

= 139

= 25088

SECONDS

217
FTN 5.1+552 84/03/14, 10.18.23 PAGE SUBROUTINE CFACTOR 74/175 OPT=0

1 1

12

3

4

5

i7

8

9 10

1112

1314

15U

1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

63

64

SUBROUTINE CFACTOR CFACTOR

* [ C C [ I [ C [ C [ [ [ I C C C I [ [ [ [ C [ [ C [ C [ [ [ I [ [ C t C [ [ [ [ C [ t [ C [ C C C [ [ C [ C [ C I [ C C C [ C C C C C I t I [CFACTOR

C C [CFACTOR

[ [ [CFACTOR

[ [ [CFACTOR

[ [ [CFACTOR

[ [ [CFACTOR

[[[CFACTOR

*[ [ [ [[[ THIS ROUTINE CALCULATES THE ATTENUATION OF EACH WALL AND EACH

*[[[ OPENING IN EACH WALL, LAYER BY LAYER, AND THEN CALCULATES THE

*[[[ COMPOSITE TRANSMISSION FACTORS OF EACH WALL USING AN APPROACH

*[[[ DEVELOPED BY JERRY WYSS

.

*[[[

*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ [CFACTOR ************ ***** ****it*n**titt* * mill* *** t* ** at n** ************* ttttttCE kCTOR

*** VARIABLE DEFINITIONS: CFACTOR

*** WATTEN: WALL ATTENUATION CFACTOR

*** OATTEN: OPENING ATTENUATION CFACTOR

*** LATTEN; LAYER ATTENUATION CFACTOR

*** MATTEN: MATERIAL ATTENUATION CFACTOR

*** MAT: MATERIAL IDENTIFICATION CFACTOR

*** ID: IDENTIFICATION OF OPENING CFACTOR

*** WALL: WALL ARRAY CONTAINING WALL IDENTIFICATION AND MATERIAL CFACTOR

*** WDIM: WALL ARRAY CONTAINING PHYSICAL DIMENSIONS OF THE WALL CFACTOR

*** WMAX: MAXIMUM SIZE OF WALL AND WDIM ARRAYS CFACTOR

*** WTOT: TOTAL LINES OF DATA IN THE THE WALL AND WDIM ARRAYS, CFACTOR

*** HEIGHT: HEIGHT OF WALL CFACTOR

*** WIDTH: WIDTH OF WALL CFACTOR

*** WDIM(R,C): THICKNESS OF WALL CFACTOR

*** AREA: AREA CFACTOR

*** WAREA: TOTAL WALL AREA WITHOUT SUBTRACTING OPENINGS. CFACTOR

*** OAREA: TOTAL AREA OF THE OPENINGS. CFACTOR

*** NEWWALL. TRUE IF DATA LINE BELONGS TO A NEW WALL CFACTOR

*** WALLEND: TRUE IF DATA LINE IS THE LAST DATA LINE OF A WALL CFACTOR

*** T: TRANSMISSION FACTOR CFACTOR

*** S: AREA OF OPENING OR WALL AS APPROPRIATE CFACTOR

*** TS: TRANSMISSION FACTOR = T1*S1 + T2S2 + T3*S3 + ... CFACTOR

*** TS2: TRANSMISSION FACTOR = T1*S1*S1 + T2*S2*S2 + ... CFACTOR *********************************************************************** * CFACTOR

«*it«***it*«*«*it*****«x********it*****************«k**it*****«*****« «**  *C0MF

*** COMMON FOR INITIAL PARAMETERS ***COMF

**«***«i******«********)t*****************«ix*««**********««***********«**itcOMF

INTEGER FMAX COMF

PARAMETER (FMAX = 50) COMF

COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF

$ FTOT COMF

COMMON /INITILC/ BLDG COMF

CHARACTER * 5 BLDG COMF REAL FREQ, AFLAC, RFLAG, FREQA COMF

INTEGER QUALITY, FERR, FTOT COMF

A********************************************************************** *COMF ************************************************************************

*********************************************************************** * COMH

*** COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS »**COMH

*tt**«t*****t)«i«***lk*****«i <r«lk** ****************lt*«i**«***it*****«)k****** *COMH

INTEGER HMAX PARAMETER (HMAX = 35)

COMMON /KOLEN/ HTOT, HERR COMMON /HOLEC/ HOLE (HMAX, 4) INTEGER HTOT, HERR CHARACTER * 3 HOLE

DESCRIPTION OF ARRAYS

ROOM IDENTIFICATION APERTURE ID

DIRECTION FROM ROOM TO ROOM

HOLE(X, 1) HOLE(X,2) HOLE(X, 3) HOLE(X,4)

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

1

2

3

4

5

67

89 10

1 1 12

1 3 14

1 5 1617

18

I 9 2021

2223

2425

2627

2829

3031

3233

34

1

2

3

45

6

7

8

9 10

1 1 1213

12

3

45

67

8

9 10

II12

1314

1516

17

218
rXN 5 U552 84/03/14. 10.18.23 PAGE 12 SUBROUTINE CFACTOR 74/175 OPT=0

45 * A3 A3 A3 A3 COMH 18 *tt*****ii**iiitiii(**»tiiiiii**ii***ttii*t*ii****ii***ii*ii*****ii**ii**tii*ttii******i(* *COMH 1 9

69 •»* COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT 2

71 INTEGER TMAX COMT 4 72 PARAMETER (TMAX=35) COMT 5 73 COMMON /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR COMT 6 74 COMMON /TYPEC/TYPE(TMAX, 3) .TDBKTMAX) COMT 7 75 INTEGER TTOT , TDBTOT , TERR COMT 8 76 REAL TDIM,TDB2 COMT 9 77 CHARACTER * 3 TYPE.TDBl COMT 10

78 *================================================= COMT 11 79 * DESCRIPTION OF ARRAYS COMT 12 80 »================================================= COMT 13 81 * ID MATERIAL FRAME MATERIAL COMT 14 82 » COMT 15 83 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT 16

84 » A3 A3 A3 COMT 17 85 * = == = = = == = = = = = = = = = = = = = = = =: = = = = = = = = = = = = = = = = = = = = = = = = = COMT 18 86 * HEIGHT WIDTH LAYER DISTANCE COMT 19 87 * THICKNESS ABOVE FLOOR COMT 20

88 * COMT 21 89 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT 22

90 * F8.2 F8.2 F8.2 F8 . 2 COMT 23

91 * = == = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =: = = COMT 24

92 * ID ATTENUATION AREA COMT 25 93 « COMT 26

94 * TDBl(X) TDB2(X,1) TDB2(X,2) COMT 27 95 * A3 E9.3 E9.3 COMT 28

99 *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR 2

101 INTEGER RMAX COMR 4 102 PARAMETER (RMAX = 20) COMR 5 103 COMMON /ROOMN/ ROOM(RMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX) COMR 6 104 INTEGER NROOMS COMR 7 105 REAL ROOM COMR 8 108 * * * * * t * * * It * * * * * * t ** 1 1 * * 1 1 * t * t * * * 1 1 * * * * * * * t * * 1 1 1 * t * * * * It * 1 1 * * * * * * * * t * * * * t * 9

109 *** COMMON FOR DATABASE OF WALL PARAMETERS »**COMW 2

111 INTEGER WMAX COMW 4 112 PARAMETER (WMAX = 75) COMW 5 113 COMMON /WALLN/ WD IM( WMAX , 3 ) , WTOT, WERR COMW 6 114 COMMON /WALLC/ WALL (WMAX, 4) COMW 7 115 INTEGER WTOT, WERR COMW 8 116 REAL WDIM COMW 9 117 CHARACTER »3 WALL COMW 10 118 * ================================= COMW 11 119 ** DESCRIPTION OF ARRAYS COMW 12 120 * ================================= COMW 13 121 * WALL IDENTIFICATION COMW 14 122 * COMW 15 123 * DIRECTION FROM TO COMW 16 124 * ROOM ROOM COMW 17 125 * COMW 18 126 * WALL(X,1) WALL(X,2) WALL(X,3) COMW 19 127 * A3 A3 A3 COMW 20 128 * ========================================================= COMW 21

219
FTN 5.1+552 84/03/14. 10.18.23 PAGE

SUBROUTINE CFACTOR 74/175 OPT=0

13

129

130

131 132

133 134

135 136

137 138

139 140

141 142

143

144

145 146

147 148

149 150

151 152

153 154

155 156

157

158

159 160

16 1 162

163

164

165 166

167

168

169 170

17 1 172

173 174

175 176

177 178

179 180

181 182

183 184

185 186

187 188

189 190

19 1 192

* WALL PARAMETERS

»

* MATERIAL HEIGHT WIDTH LAYER THICKNESS

WDIM( I, 1) F8 . 2 WDIMC X, 2) F8 .2 WDIMCX, 3) F8 . 2

COMW

COMW

COMW

COMW

COMW

COMW

»***COMW

*»t*C0MW

* WALL(X, 4)

* A3 *»***»»*

ttt**tttt****tttiit*

* COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD

COMMON /ROOMD/DDABS (RMAX + 6, RMAX + 6 ) ,DREFL, DREFLV COMD

REAL DDAES ,DREFL , DREFLW COMD

i**«*****«*************** * COMD

RMAX + 5

x***it*it«***«*«*«*ik*t******« «** it*********«**«**

* DECLARATION OF VARIABLES

****«X***X*********»**t**t**«*«*«t(*«X«t***«***«*t

INTEGER NEXT, LAST, R, C, ROW

REAL WATTEN , LATTEN , OATTEN , MATTEN, ATTEN ,T , 5 , TS , TS2 REAL HEIGHT,WIDTH,AREA,OAREA,WAREA

CHARACTER * 3 FROM, TO, MAT, ID LOGICAL NEWVALL ,WALLEND

* INITIALIZE ROOM MATRIX. *«x««**««*****t**«x***********«**«*****« t** **t

DO 5 R = 1,RMAX

DO 5 C = 1 ,RMAX

ROOM(R,C) = 0.0

5 CONTINUE

DO 6 R = 1,RMAX

DO 6 C = RMAX + 1, ROOM(R,C) = 0.0

6 CONTINUE

* LOOP S PROCESS EACH LAYER OF THE WALL ARRAY *******t**«***«**«t*«****t**«**«««***««t*««*«*****

DO 10 R = 1 ,WTOT

t***t******t***tttt**iiiittt*ttt*t*****tiitt****t*t*t

* SET WALLEND CONDITION

**tt*tt**ttt*t*t*t*ttt*t***t***t**t**t**t*t*ttiiim*

NEXT = R + 1 IF (R .EQ. WTOT) THEN WALLEND = TRUE

ELSE IF ( WALL(R,2) ,NE

$ WALL(R,3) ,NE. WALLEND = TRUE. ELSE

WALLEND = FALSE.

END IF **t***<«««************«*«*t(t«******«t*t*«*X*(*«t«

* SET NEWWALL CONDITION

»*»»**»»»***»*t»»»»»»»**»»»»»»***»*»***t»»*»»»t»»*

LAST = R - 1 IF (R EQ. 1) THEN NEWWALL = TRUE. ELSE IF ( WALL(R,2) NE

$ WALL(R,3) .NE. NEWWALL = TRUE.

ELSE

NEWWALL = FALSE.

END IF

xtxxtxxxtttxxxxxttxtxxxxt*************************

WALL(NEXT,

WALL (NEXT

,

.OR .

) THEN

WALL(LAST,2)

WALL(LAST,3)

OR.

) THEN

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

CFACTOR

22

2324

2526

2728

29

12

3

45

6

7 4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

6566

6768

6970

7172

7374

7576

7778

7 ? 80

8182

8384

8586

8788

89

220
fTN ; 1. 5 5 2 «4/fl3.'M IQ 1« 23 PAGE 14 SUBROUTINE CFACTOR 74/175 OPT=C

173

1*4

175

1 »6

17 -> 17 ! 17 9 200

20 1 202

20 3 204

205

206

207

20 ! 209

2 10 211 212

213

2 1 4 215

216

217

2 18 219

220

22 1 222

22 3 224

225

226

227

228

229

230

23 1 232

233

234

235

236

237

238

239

240

241 242

243

244

245

246

247 248

249

250

251

252

253

254

255

256

• CALCULATE WALL ATTENUATION, LAYER BY LAYER

IF (NEUVALL) THEN

• INITIALIZE VALL CONDITIONS

•xtiiiixtxtiiitxxxxiixxxxixxxxxxxxxxxxxxxxxxxxxxxx

TS = 0 TS2 = 0 WATTEN = 0 END IF •lltXttItttXXIIItXXtIIXXXXXXXXXXXXXXXXXXXXIXXIXXXX

• CALCULATE ATTENUATION OF LAYER

tiiiixifxixxixxxxxxxxxxxxxixxxxxxxxxxxxitxxxxxxxxx

MAT = VALL(R,4)

MATTEN = ATTEN (MAT. FREQ, AFLAC)

LATTEN = MATTEN » VOIM(R,3)

tixixxixxxxtxixxxxxxxixxxxxxxxxxxxxxxxxxxxxtxxxxxx

• ACCUMULATE ATTENUATION OF VALL FROM LAYERS

xxxxxxxixxxixxxxxxxxxxxxxxixxxxxxixxxxxxxxxxxxxxxx

WATTEN = VATTEN + LATTEN

XtXIIIXXXXtXXXIIXXtXXXXXXXXXXXXXXXXXIXXXXXXXXXXXXX

ixxtxxxxxxxxxxxxixxxxxxxxxxxxxxxxxtxxxxxxxttxxxxxx

• CHECK IF END-OF-VALL LAYER

» AND THEN CALCULATE VALUES FOR HOLES IF TRUE

.

• . OTHERWISE GO BACK AND DO THE NEXT LAYER- txxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

IF (VALLEND) THEN

FROM = VALL(R,2)

TO = VALL(R,3)

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXIXXXXXXXXXXXXXXXXXXXX

• ..CALCULATE ATTENUATION OF OPENINGS

• AND TOTAL AREA OF OPENINGS

xxxxxxxxxxxxxxxxxxixxxxxxxxxxxxxxxxxxxxxtxxxxtttxx

OAREA = 0 DC 20 ROW = 1, HTOT

xxixxxxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxtxxxxxxixtxixx

» ...CHECK FOR A HOLE IN PRESENT VALL

xxxxxxxxxxxxxxxxxxxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxxx

IF (HOLE(ROW,2) .EG. FROM .AND. HOLE(RCV,3)

XXXXXXXXXXXtXXIXXXXXXXXXXXXXXXXXXXXXXXXXXXXIXXXXXX

• ...IF THERE IS A MATCH. CALCULATE ITS CONTRISUTIOK;

• ..OTHERWISE KEEP SEARCHING HOLE'S TABLE

tixxxxxxxxxxxxxxxxxxxxxxtixxxxxxxxxxxxxxxxxxxxxxxx

ID = HGLE(ROV,4)

xxxxxxxxxxtxxtxxxxxxxxxxxtxxtxxxxxxxtxxxxxxxxxxxxx

• ...GET ATTENUATION AND AREA OF HOLE

XXXXXXXXXXXXXXXXXXXXXXXIXXXXXXXXXXXXXXXXXXXXXXXXXX

CALL SRCHTD2CID, OATTEN.AREA)

OAREA = OAREA + AREA

CALL RESOND (ID)

IF (OATTEN .LE. 120) THEN

XXXXXXXXXXXXXXXXxXXXXXXXXXXXXXtXXXXXXXXXXXXXXXXXXX

• ...CALCULATE TRANSMISSION OF HOLE.

• .. .SET TO ZERO IF LESS THAN 120 DB

T = 1 0**( (-OATTEN + DREFLV) / 10 ) ELSET = 0 END IF

S = AREA XXXXXXXXXXXXXXXXXiXtXXXXXXXXXXXXXXIXXXXXXXIXXXXXXX

» ...ACCUMULATE TRANSMISSION * AREA AND

• ...TRANSMISSION * AREA * AREA

» . . .FOR HOLES IN VALL.

.EG. TO) THEN

: FACTOR

CFACTOR « 2 CFACTOR 93 CFACTCR 94 CFACTOR 95 CFACTOR 7 £ CFAOTOR 97 CFACTOR 98 Cr AC7CH

CFACTOR ISC CFAOTOR 131 OFAOTCR 1C2 CFAOTOR 13 2 CFACTOR A. • M CFACTCR 1 35 CFAOTOR 1 C 6 CFACTOR 137 CFACTOR • f*. S CFACTCR 13? CFACTOR lie

CFACTCR 111 CFACTCR 113

CFACTCR 113 CFACTOR 1 1 4 CFAOTOR « * 5 CFACTCR 1 1 £ CFACTCR. 1 17 CFACTCR 115

CFACTCR 1 19 CFACTCR ICC CFACTCR 121 OFAOTCR 122 CFACTOR 1 23 CFACTCR 12 4 CFACTOR 1 25 CFACTOR 12 6 CFACTCR 127 CFACTOR 12! CFACTCR 1 2 T CFACTCR 1 3 3 CFACTCR 131 CFACTCR 132 CFACTOR 133 CFACTCR 134 CFACTCR 1 35 CFACTOR 136 CFACTOR 137 CFACTCR 1 3 8 CFACTCR 1 39 CFACTOR 14C CFACTOR 141 CFACTOR 142 CFACTCR 1 42 CFACTCR 1 4 4 CFACTCR 1 45 CFACTOR 146 CFACTCR 1 4' CFACTOR 1 4 8 CFACTOR 1 47 CFACTOR 15C CFACTOR 151 CFACTCR 152 CFACTCR 153

221
FTN 5.1+552 84/03/14. 10.18.23 PAGE

SUBROUTINE CFACTOR 74/175 OPT=0

15

257

258

259

260

26 1 242

24 3 244

245 244

247 248

249

270

27 1 272

273 274

275 274

277 278

279

280

28 1 282

283

284

285

284

287

288

289

290

291 292

293

294

t*************************************************

TS = TS + T * S TS2=TS2+T*S*S

END IF

20 CONTINUE

«t***ft**«***t***«tk*********************«**it««**A*|t*

* CALCULATE & STORE ATTENUATION OF EACH ROOM

. . CALCULATE TOTAL WALL AREA

HEIGHT = UDIM(R, 1) WIDTH = WDIM(R,2)

WAREA = HEIGHT * WIDTH

S = WAREA - OAREA

****«**(i********tklt*ik1k*1k**lt**««[ «** Alk**)t******tlr*

* ...CALCULATE ATTENUATION

**mi1l**t1i****ii*ii***it1t*ii»/HI)ilr*li1itHHHHt*****»*t1i*»»*»

IF (WATTEN .LE. 120.) THEN

* ...CALCULATE TRANSMISSION OF WALL.

* ...SET TO ZERO IF LESS THAN -120 DB . ********k***lk4t<(**tt 1tlt4l** ***lt**ik**lt*lk«lkkit**AttAlt* T = 10** (-WATTEN / 10)

ELSE

T = 0 END IF TS = TS + T * S TS2 = TS2 + T * S * S *lM)**«ik******k*****lt*ik*it*t)*****A**4itit****)t*ili*****lt

* ...INSERT TOTAL TRANSMISSION * AREA OF WALL INTO ROOM ARRAY kkk********k***********«k***kk***k**«*k*k*********

CALL LROOM ( TS , TS2 , FROM , TO

)

END IF

10 CONTINUE

RETURN

END

CFACTOR 154 CFACTOR 1 55 CFACTOR 154 CFACTOR 1 57 CFACTOR 158 CFACTOR 1 59 CFACTOR 140 CFACTOR 141 CFACTOR 142 CFACTOR 1 43 CFACTOR 144 CFACTOR 1 45 CFACTOR 144 CFACTOR 147 CFACTOR 148 CFACTOR 1 49 CFACTOR 170 CFACTOR 171 CFACTOR 172 CFACTOR 173 CFACTOR 174 CFACTOR 1 75 CFACTOR 174 CFACTOR 1 77 CFACTOR 17 8' CFACTOR 1 79 CFACTOR 180 CFACTOR 1 81 CFACTOR 182 CFACTOR 1 83 CFACTOR 184 CFACTOR 185 CFACTOR 184 CFACTOR 187 CFACTOR 188 CFACTOR 1 89 CFACTOR 190 CFACTOR 191

-VARIABLE MAP-- (LO=A) -NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

AFLAC 2B / INITILN/ REAL AREA 500B REAL

BLDG OB / INITILC/ CHAR*5

C 444B INTEGER

DDABS OB /ROOMD/ REAL 474 DREFL 1 244B /ROOMD/ REAL DREFLW 1 245B /ROOMD/ REAL FERR 44B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FROM 50 3B CHAR*3

FTOT 47B / INITILN/ INTEGER

HEIGHT 474B REAL HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC

/

CHAR*3 1 40 HTOT OB /HOLEN/ INTEGER

ID 504B CHAR*3

LAST 442B INTEGER LATTEN 44 7B REAL MAT 505B CHAR*3

MATTEN 471B REAL

222
FTN 5 1+552 84/03/14. 10.18.23 PAGE 16 SUBROUTINE CFACTOR 74/175 OPT=0

NEVUALL 5 0 7B LOGICAL

NEXT 46 IB INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

OAREA 50 IB REAL OATTEN 470B REAL QUALITY IB / INITILN/ INTEGER

R 46 3B INTEGER

RAREA 1 2 45B /ROOMN/ REAL

RFLAC 3B / INITILN/ REAL

ROOM OB /ROOMN/ REAL

ROW 465B INTEGER

S 473B REAL

T 472B REAL TDBTOT 323B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3

TDB2 215B /TYPEN/ REAL

TDIM OB /TYPEN/ REAL

TERR 32 4B /TYPEN/ INTEGER

TO 504B CHAR*3

TS 474B REAL

TS2 475B REAL TTOT 214B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3

WALL OB /WALLC/ CHAR*3

WALL END 510B LOGICAL

UAREA 50 2B REAL WATTEN 466B REAL WDIM OB /WALLN/ REAL

WERR 342B /WALLN/ INTEGER

WIDTH 477B REAL WTOT 341B /WALLN/ INTEGER

-SYMBOLIC

-NAME CONSTANTS--(LO=A)TYPE VALUE

FMAI INTEGER 50 HMAX INTEGER 35 RMAX INTEGER 20 TMAX INTEGER 35 WMAX INTEGER 75

-PROCEDURES--(LO=A)

-NAME TYPE --ARGS CLASS

ATTEN REAL 3 FUNCTION

LROOM 4 SUBROUTINE

RESOND 1 SUBROUTINE

SRCHTDB 3 SUBROUTINE

20

676

35

70 140

105

300

225

-STATEMENT LABELS- -( LO= A

>

-LAB EL- ADDRESS PROPERTIES DEF

5 INACTIVE DO-TERM 158

6 INACTIVE DO-TERM 1 62 10 INACTIVE DO-TERM 292

20 INACTIVE DO-TERM 261

223
FTN 5.1+552 84/03/14. 10.18.23 PAGE 17 SUBROUTINE CFACTOR 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS- -ARCS--

CFACTOR 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

521B = 337

4000B = 2048

63000B = 26112

0.249 SECONDS

224
FTN 5 U55 2 SUBROUTINE LHOLE

B4 /03 / 14 . 10.18.23 PAGE

74/175 OPT=0

18

10

1112

13

1 4 ISU

1718

1920

2122

2324

2528

2728

2930

3132

3334

3538

37

1 SUBROUTINE LHOLE LHOLE

2 *[[[[[[[[[ tCC[C[[[C[[[[C[[[CCCCCC[CCC[CCC[[t[C[C[[[CCCCC[C[CCCC[[C[CCC[[LHOLE

3 »[[[ [[[LHOLE

4 »[[[ LOAD THE CONTENTS OF THE "HOLE" FILE INTO THE "HOLE" ARRAY [[[LHOLE

5 *[[[ [[[LHOLE

8 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[LHOLE

7 ****t*iiii****tiiiit*ii*tt*****t****iiii»lili*ttli**tt**tttiitlili*lit**ii***t***t**t* * COKH

8 »»* COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS **»COMH

9

* ( * « * I INTEGER HMAX PARAMETER (HMAX = 35)

COMMON /HOLEN/ HTOT, HERR COMMON /HOLEC/ HOLE(HMAX,4)

INTEGER HTOT, HERR CHARACTER * 3 HOLE

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

COMH

t t t tit t 1 1 t t * Hit t 1 1 t * H * t t t * 1 1 * t 1 1 t * t t t t * t 1 1 t t t t * t t t It 1 1 t * * * t * * t t t t t t It t * t 1 1 t

** COMMON FOR INITIAL PARAMETERS ***COMF

DESCRIPTION OF ARRAYS

ROOM IDENTIFICATION APERTURE ID

DIRECTION FROM ROOM TO ROOM

HOLE( X, 1

)

A3 HOLE( X, 2) A3

HOLE(X, 3) A3 HOLE(X

A3

, 4)

INTEGER FMAX COMF

PARAMETER (FMAX = 50) COMF

COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF

$ FTOT COMF

COMMON /INITILC/ BLDG COMF

CHARACTER * 5 BLDG COMF

REAL FREQ, AFLAC, RFLAG, FREQA COMF

INTEGER QUALITY, FERR, FTOT COMF

3g *******Alklt**A ltfl** ********ti**))1kltk*tttlk**********AilMk****i4t4l*4l*A*<itt*****lkQO]^p

40 INTEGER GETLEN, R, C LHOLE

41 CHARACTER * 7 PFN LHOLE

42 PFN = ‘B’ II BLDG( 1 ;GETLEN(BLDG) ) II 'H' LHOLE

43 HERR = 0 LHOLE

44 CALL PF ( 'GET' ,0 ,PFN(1 :GETLEN(PFN) ), ‘RC , HERR) LHOLE

45 IF ( HERR . EQ . 0 ) THEN LHOLE

48 OPEN (UNIT=3, FILE=PFN, FORM= ' FORMATTED ' , LHOLE

47 $ STATUS= 'OLD' , ACCESS= ’ SEQUENTIAL ' ) LHOLE

48 1000 FORMAT ( 1 X , 4 ( 1 X , A3 )

)

LHOLE

49 HTOT = 0 LHOLE

50 DO 10 R = 1,HMAX LHOLE

51 READ (3 , 1000 , END = 20) (HOLE(R, C) ,C=1 , 4) LHOLE

52 HTOT = HTOT + 1 LHOLE

53 10 CONTINUE LHOLE

54 20 CONTINUE LHOLE

55 CLOSE(3,STATUS='DELETE' ) LHOLE

58 ELSE IF ( HERR .EQ. 2 ) THEN LHOLE

57 CALL WARNING (1) LHOLE

58 ELSE LHOLE

59 CALL WARNING (2) LHOLE

80 END IF LHOLE

81 RETURN LHOLE

82 END LHOLE

1

23

45

8

1

23

45

8

7

8

9 10

1 1 1213

1415

1817

1819

20

12

3

4

5

8

7

8

9 10

1 1 12

I 39 10

II12

1314

15

1 8 17

1 8 1920

2122

2324

2528

2728

2930

31

225
FTN 5.1+552

SUBROUTINE LHOLE

84/03/14. 10.18.23 PAGE

74/175 OPT=0

19

-VARIABLE MAP-- ( LO=A)

-NAME---ADDRESS -BLOCK PROPERTIES TYPE ---SIZE

AFLAG 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C 214B INTEGER

TERR 66B /INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR*

3

1 40 HTOT OB /HOLEN/ INTEGER

PFN 215B CHAR*7

QUALITY IB / INITILN/ INTEGER

R 213B INTEGER

RFLAG 3B / INITILN/ REAL

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

FMAX INTEGER 50 HMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME TYPE

GETLEN INTEGER

PFWARNING

ARGS CLASS

1 FUNCTION

5 SUBROUTINE

1 SUBROUTINE

-STATEMENT LABELS- -( LO=A

)

-LABEL- ADDRESS --PROPERTIES -DEF

10 INACTIVE DO-TERM 53 20 73B 54 1000 130B FORMAT 48

-ENTRY POINTS--(LO=A>

-NAME ADDRESS- -ARGS

LHOLE 5B 0

-I/O UNITS--(LO=A)

-NAME PROPERTIESTAFE3 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

222B = 146 MSB = 101 61000B = 25088

0.094 SECONDS

226
FTN 5 1 + 552 8 4 / 0 3 / 1 <1 10.18.23 PAGE

SUBROUTINE LMATTER 74/175 OPT=0

20

12

3

45

i7

89 10

11

1 2 1314

15

1 6 17

1 8 19 20

2122

2324

2528

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

SUBROUTINE LMATTER LMATTER

• t C C [[[ C C t C [ C [[ C [[[[[[[

C

C [[[ t C [[ C L [ C

[

C C C

[

C C C C L C C C [ C C C C [[[ C C C C C C C C [[ C C [ C

[

LMATTER

*[[[ [[[LMATTER

*[[[ THIS SUBROUTINE LOADS THE MATERIAL DATABASE INTO ARRAYS FOR [[[LMATTER

•([[ FURTHER PROGRAM USE. [[[LMATTER

»[[( [[[LMATTER

»[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ LMATTER

************1

»*• COMMON FOR DATABASE OF MATERIAL PROPERTIES ***COMM

INTEGER MMAX COMM

PARAMETER (MMAX=100) COMM

COMMON /MATN/ MATTEN ( MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), QR(MMAX), COMM

5 MFREQIMMAX, 7) , MERR, MTOT COMM

COMMON /MATC/MAT(MMAX) ,MATDESC(MMAX) COMM

INTEGER MTOT, MERR COMM

REAL MATTEN, MRCOEF, MFREQ, QA , OR COMM

CHARACTER * 3 MAT COMM

CHARACTER * 70 MATDESC COMM

* DECLARATION OF VARIABLES

tAAt**********************************************

INTEGER R, C, VAL CHARACTER * 3 MATID

tiiiitii*ii*tt*iiniitt*t****iit**t*t*ttttt*t**t******t*tt

* GET FILE It*************************************************

MERR = 0 CALL PF ( 'GET' ,0, 'MATTER' , 'RC , MERR) **************************************************

* FILE ERROR CHECK **************************************************

IF ( MERR .EQ. 0 ) THEN

999 CONTINUE

ELSE IF ( MERR .EQ. 2 ) THEN

CALL WARNING (3)

RETURN

ELSE

CALL WARNING (4)

RETURN

END IF **************************************************

» OPEN FILE **************************************************

OPEN (UNIT = 3, FILE='MATTER' ,FORM='FORMATTED'

,

5 STATUS = 'OLD', ACCESS = 'SEQUENTIAL')

REWIND (3) **************************************************

* INITIALIZE ARRAYS **************************************************

DATA MAT / 100 »

'

' / DATA MATDESC / 100 *

'

' / DATA MFREQ / 700 * 0.0 / DATA MATTEN / 700 * 0.0 / DATA QA / 100 * 0 .0 / DATA MRCOEF / 700 * 0.0 / DATA QR / 100 * 0.0 / **************************************************

* READ IN THE MATERIAL FILE **************************************************

10 READ (3,1000,END=20) MATID

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

LMATTER

1

2

3

4

5

67

8

12

3

45

6

7

8

9 10

1 1 12

I 3 1410

II12

13

1 4 15

1 6 1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

51

227
FTN 5 , 1 + 552 84 / 03 / 1 4 . 1 0.18 .23 PAGE 21 SUBROUTINE LMATTER 74/175 OPT=0

65 R = VAL(MATID( 2 ; 3 )

)

LMATTER 52

66 MAT (R) = MATID LMATTER 53

67 READ (3 , 2000 , END=20) MATDESC (R) LMATTER 54 68 READ ( 3 , 4000 , END=20

)

(MFREQ(R,C) ,C=1 ,7) LMATTER 55

69 READ (3 , 4000 , END=20) (MATTEN(R,C) ,C=1 , 7) LMATTER 56 70 READ (3,4000,END=20) QA (R) LMATTER 57

71 READ (3 , 4000 , END=20) (MRCOEF(R,C) ,C=1 , 7) LMATTER 58 72 READ (3,4000,END=20) QR (R) LMATTER 59

73 GOTO 10 LMATTER 60

74 20 CONTINUE LMATTER 61 75 1000 FORMAT (A3) LMATTER 62

76 2000 FORMAT (A70) LMATTER 63

77 40 00 FORMAT (7(1X,E9.3)) LMATTER 64

78 A************************************************* LMATTER 65 79 * CLOSE FILE LMATTER 66

80 ****«**«**«**«ft**ft***ft ft** «*«*«ft*«**«*«**«*«*«* LMATTER 67

81 CLOSE (3, STATUS = 'DELETE'

>

LMATTER 68

82 RETURN LMATTER 69 83 END LMATTER 70

-VARIABLE MAP --(LO=A) -NAME- --ADDRESS- -BLOCK PROPERTIES TYPE SIZE

C 327B INTEGER

MAT OB /MATC/ CHAR*3 100 MATDESC 36B /MATC/ CHAR*70 1 00 MATID 330B CHAR*3

MATTEN OB /MATN/ REAL 700 MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700 MRCOEF 1 274B /MATN/ REAL 700 MTOT 4375B /MATN/ INTEGER

QA 2570B /MATN/ REAL 100 QR 2734B /MATN/ REAL 1 00 R 326B INTEGER

-SYMBOLIC CONSTANTS-

-NAME TYPE

-(LO=A>

VALUE

MMAX INTEGER 1 00

-PROCEDURES--(LO=A)

-NAME TYPE ARGS- - ---CLASS

PF 5 SUBROUTINE

VAL INTEGER 1 FUNCTION

WARNING 1 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

LABEL -ADDRESS --PROPERTIES DEF -LABEL-ADDRESS------PROPERTIES-- --DEF

10 36B 64 1000 202B FORMAT 75 20 160B 74 2000 204B FORMAT 76 999 *NO REFS* 37 4000 206B FORMAT 77

228
FTN 5 U552 84/03/14. 10.18.23 PAGE 22 SUBROUTINE LMATTER 74/175 OPT=0

-ENTRY POINTS--! LO=A) -NAME ADDRESS --ARCS

LMATTER 5B 0

-1 IQ UNITS--(LO=A)

-NAME--- PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 336B = 222 CM LABELLED COMMON LENGTH 5 73 0B = 30 32 CM STORAGE USED 61000B = 25088

COMPILE TIME 0 .1 38 SECONDS

229
FTN 5,1+552

SUBROUTINE LRAREA

84/ 03 / 1 4 . 1 0.1 8.23 PAGE

74/175 OPT=0

23

1

2

3

45

i7

8

9 10

11

1 2 13

1 4 15U

1718

1920

2122

2324

2526

2728

29

30

3132

33

34

3536

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

SUBROUTINE LRAREA LRAREA

*C m:C[ t [[[[[[[[[[[[[[[ [[[CC[C[[[CCCCC[[CC[t[[[[[tCCCCCCC etc It tltCCCICI [LRAREA

*[ [ t *C [[ *[ C C *C C [

CALCULATE THE SURFACE AREA OF EACH ROOM

AND INSERT IT IN THE "RAREA" ARRAY

[ [ [LRAREA

[ [[LRAREA

[ [ [LRAREA

[ [ [ LRAREA *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[[[[[[[[[[[[[[LRARE

A

*** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS *»*COMR

*******************tk**********«**l[i*Kllr*«***«ik********it***«**«***«*****«r**COMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMNZ ROOM(RMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR REAL ROOM COMR

***************it***************» iktt** «i***********«t«***«*********« C0MR ** ******************************************************************** * * COMR

*** COMMON FOR DATABASE OF WALL PARAMETERS ***COMV

**lk*****1i*******A******ft**A*****1k***A1t*A*fttft*llr***lt**ltA*ft'K***1ttt**«*A1t*** COMV

INTEGER WMAX PARAMETER (WMAX = 75)

COMMON /WALLN/ WD IM ( WMAX , 3 ) , WTOT, WERR COMMON /WALLC/ WALL (WMAX, 4) INTEGER WTOT, WERR

REAL WDIM

CHARACTER *3 WALL

** DESCRIPTION OF ARRAYS

* ======================

* WALL IDENTIFICATION

DIRECTION FROM

ROOM

TOROOM

WALL (X , 1

)

A3 WALL(X ,2) A3 WALL(X,3)

A3

WALL PARAMETERS

MATERIAL HEIGHT WIDTH LAYER THICKNESS

WALL( X, 4) WDIM( X, 1

)

WDIM( X, 2) WDIM( X, 3) A3 F8 . 2 F8 . 2 F8 . 2

COMW

COMV

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

»*COMW

* DECLARATION OF VARIABLES

INTEGER NEXT, LAST, R, RNUM, VAL CHARACTER * 3 FROM, TO LOGICAL NEWWALL, WALLEND **************************************************

LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA LRAREA

LRAREA

1

2

3

4

5

6

7

1

2

3

4

5

6

78

9 10

1

2

3

4

5

6

7

8

9 10

1112

1314

1516

1718

1920

2122

2324

2526

2728

2910

1112

1314

1516

1718

1920

2122

2324

2526

27

230
FTN 5 U552 84/03/M. 10,18.23 PAGE 24 SUIROUTINE LRAREA 74/175 OPT=0

85 LRAREA 28 66 * SET WALLEND CONDITION LRAREA 29

67 t**«*t*«««*«iti>***ti*ik*A«********DtMt)tti*)k***tlr))***ft*** LRAREA 30 68 NEXT = R + 1 LRAREA 31 6? IF (R EQ. WTOT) THEN LRAREA 32 70 WALLEND = TRUE. LRAREA 33

71 ELSE IF ( WALL(R,2) NE. WALL(NEXT,2) OR. LRAREA 34

72 5 UALL(R,3) .NE. WALL(NEXT,3) ) THEN LRAREA 35 73 WALLEND = .TRUE. LRAREA 36 74 ELSE LRAREA 37

75 WALLEND = .FALSE. LRAREA 38 76 END IF LRAREA 39 77 t»*ii****t*ii****tiit**ii***tttit******t*ti(ii*tt*ii*iit*ii* LRAREA 40 78 * SET NEWWALL CONDITION LRAREA 41 79 LRAREA 42 80 LAST = R - 1 LRAREA 43

81 IF (R .EQ. 1) THEN LRAREA 44 82 NEWWALL = .TRUE. LRAREA 45

83 ELSE IF ( WALL(R,2) .NE. WALL(LAST,2) .OR. LRAREA 46 84 $ WALL(R,3) .NE. WALL(LAST,3) ) THEN LRAREA 47 85 NEWWALL = TRUE. LRAREA 48 86 ELSE LRAREA 49 87 NEWWALL = .FALSE. LRAREA 50 88 END IF LRAREA 51 89 **1tAA1t*«A*ft*t**t**AllrAAt***AAft**AA*ttft1icft***1lr*AA«*t* LRAREA 52

90 * INSERT THE AREA INTO THE ARRAY LRAREA 53

91 t*****tt1tlt1kt**ftA*AA*AAt**A*tA**1it*AA*ft****t*1ltft1ttAt** LRAREA 54 92 IF (NEWWALL) THEN LRAREA 55 93 FROM = WALL (R , 2) LRAREA 56 94 TO = WALL (R,3) LRAREA 57 95 IF ( FROMd: 1) .EQ. 'D' ) THEN LRAREA 58

96 RNUM = VAL ( TO(l : 2) ) LRAREA 59 97 RAREA(RNUM) = RAREA (RNUM) + WD IM ( R , 1

) *WD IM

(

H , 2

)

LRAREA 60

98 ELSE IF ( TO(l:l) . EQ . ’D' ) THEN LRAREA 61 99 RNUM = VAL ( FROM( 1:2) ) LRAREA 62 00 RAREA(RNUM) = RAREA (RNUM) + WD IM ( R ,

1

) *WD IM (R ,

2

) LRAREA 63

0 1 ELSE IF (( FROM(l:l) NE. ‘D' ) .AND. ( TO ( 1 : 1 ) .NE. D* )) THENLRAREA 64

02 RNUM = VAL (FROMd ; 2) ) LRAREA 65 03 RAREA(RNUM) = RAREA (RNUM) + VD IM ( R , 1 ) *VD IM ( R , 2

)

LRAREA 66 04 RNUM = VAL ( TOd : 2) ) LRAREA 67 05 RAREA(RNUM) = RAREA (RNUM) + WD IM ( R , 1

) *WD IM( R , 2

)

LRAREA 68

06 END IE LRAREA 69 07 END IF LRAREA 70

08 * LRAREA 71 09 10 CONTINUE LRAREA 72

10 RETURN LRAREA 73

1

1

END LRAREA 74

--VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

FROM 275B CHAR*3

I 301B INTEGER

LAST 272B INTEGER

NEWWALL 277B LOGICAL

NEXT 271B INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

R 273B INTEGER

RAREA 1245B /ROOMN/ REAL RNUM 274B INTEGER

ROOM OB /ROOMN/ REAL

TO 276B CHAR»3

WALL OB /WALLC/ CHAR*3

231
FTN 5.1+552 84/03/14 . 10.18.23 PAGE 25 SUBROUTINE LRAREA 74/175 OPT = 0

UALLEND 3 0 0B LOGICAL

UDIM OB /WALLN/ REAL WERR 3 4 2B /WALLN/ INTEGER

WTOT 34 IB /WALLN/ INTEGER

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

RMAX INTEGER 20 VMAX INTEGER 75

-PROCEDURES--(LO=A)

-NAME TYPE ARGS CLASS- --

VAL INTEGER 1 FUNCTION

-STATEMENT L AB E LS- - ( LO= A

)

-LAB EL- ADDRESS PROPERTIES DEF

5 INACTIVE DO-TERM 60

10 INACTIVE DO-TERM 109

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARGS

LRAREA 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 30 6B = 198 CM LABELLED COMMON LENGTH 1 76 6B = 10 14 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.133 SECONDS

225

232
fTN 5 I + 55

2

SUBROUTINE LROOM

64/03/14. 10.18.23 PACE 26 74/175 OPT=0

1 SUBROUTINE LROOM (TS , TS 2 , FROM , TO ) LROOM

2 •[CCCCCCCLCCCCICCCCCCCLCCCCCCCCCCCCCCCCCLLCCCCCCCCCCLCCLLCCLCLCCCCCCEEECLROOM

3 *[[( CCCLROOM

4 »•» THIS ROUTINE LOADS THE TRANSMISSION COEFFICIENT INTO THE APPROPR I ATELROOM

5 *** LOCATION IN THE 'ROOM' ARRAY. LROOM

6 »»• LROOM

7 »»* NROOMS TOTAL NUMBERS OF ROOMS REPRESENTED BY DATA LROOM

8 •*» RMAX: MAXIMUM NUMBER POSSIBLE UNDER THE PRESENT PROGRAM CONF IGURATIOLROOM

? TS AND TS2: TRANSMISSION COEFFICIENTS LROOM

10 »»» FROM: TO: CONTAINS ROOM# * S OR THE DIRECTIONS D 1 , D2 , 4 , D5 , OR D6

.

LROOM

11 »[[[ CCCLROOM

12 * C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C LROOM

t * 1 14 * « « * t *•* COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS

INTEGER RMAX PARAMETER (RMAX = 20)

COMMON /ROOMN/ ROOMCRMAX + 6, RMAX + 6), NROOMS, RAREA(RMAX)

INTEGER NROOMS

REAL ROOM

*«***««**

***«««««*

tt*n**t**ii**ii*ii**tii***t**tiit*tittttttiitt***t**tiitii*t

* DECLARATION OF VARIABLES

INTEGER VAL, C, R, RNUM, D REAL TS, TS2

CHARACTER * 3 FROM, TO

***t*t***ii*tt**t*ii*t*tt**tttt*t**ii*****t*********t

«

IF ( FROM( 1:1) .EQ. 'D' ) THEN

RNUM = VAL ( TO(l : 2) ) D = VAL ( FROM (2: 2) ) **********«***k***lt*lt**lt***lt*<t************)t*)t«i***lt

* INSERT TRANSMISSION COEFFICENT FOR ENERGY ENTERING A ROOM FROM THE

* OUTSIDE OF THE BUILDING.

t**t*t1t***t***t*t***fk***t*tt*ttt*ii**t***t*tt*t*t*

R = NROOMS + D

C = RNUM

ROOM(R,C) = TS + ROOM(R,C)

* INSERT TRANSMISSION COEFFICIENT INTO 'ROOM' ARRAY FOR ENERGY LEAVIl

* A ROOM TO THE OUTSIDE OF THE BUILDING.

*t*ttt*tt****t***tii**t*tt******t*tii**t*****t**t**t

R = RNUM

C = NROOMS + D ROOM(R,C) = TS2 / RAREA(RNUM) + ROOM(R,C)

53 ELSE IF ( T0<1:1) .EQ. 'D' ) THEN

5 4 RNUM = VAL ( FROMd :2) ) 55 D = VAL ( TO(2 : 2) ) 56 **t*1t**IM<******)t******)i***1ilt*tA*4l*ilt)klt*t*k))*t*k*k)t*

57 * INSERT TRANSMISSION COEFFICIENT INTO 'ROOM' ARRI

* A ROOM FROM THE OUTSIDE OF THE BUILDING.

thttttlitttttttlilituttttttlittttttttttttttttttlttttttt

R = NROOMS + D

C = RNUM

ROOM(R,C) = TS + ROOM(R,C)

ttt*****iittii**t******ittii*tttt***ttt*tttt**t***t***

***COMR

COMR

COMR

COMR

COMR

COMR

58

5960

6162

6364

1

2

3

4

5

67

8

9 10

1 1 12

1 3

12

3

4

56

7

6

9

1 0 LROOM 15 LROOM 16 LROOM 17 LROOM 18 LROOM 19 LROOM 20 LROOM 21 LROOM 22 LROOM 23 LROOM 24 LROOM 25 LROOM 26 LROOM 27 LROOM 28 LROOM 29 LROOM 30 LROOM 31 LROOM 32 LROOM 33 LROOM 34 LROOM 35 LROOM 36 LROOM 37 LROOM 38 LROOM 39 LROOM 40 LROOM 41 LROOM 42 LROOM 43 LROOM 44 LROOM 45 LROOM 46 LROOM 47 LROOM 48 LROOM 49 LROOM 50 LROOM 51 LROOM 52 LROOM 53 LROOM 54 LROOM 55

233
FTN 5.1+552 84/03/14. 10.18.23 PAGE 27 SUBROUTINE LROOM 74/175 OPT=0

65 * A ROOM TO THE OUTSIDE OF THE BUILDING. LROOM 56

66 * * *4i*«********«iit*ll**«**«**lt*«****«*lk*«***x*<ii>***** LROOM 57 67 R = RNUM LROOM 58 68 C = NROOMS + D LROOM 59 69 ROOM(R,C) = TS2 / RAREA(RNUM) + ROOM(R,C) LROOM 60

70 * * xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx LROOM 61 71 t LROOM 62 72 h * xxxxxxxxxxxxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxxxtxxx* LROOM 63

73 ELSE LROOM 64

74 * * *x**xx****xx*xxx*xxx*xx*xx***x**«*x*x.xx«xxitx*x** LROOM 65

75 t INSERT TRANSMISSION COEFFICIENTS INTO 'ROOM' ARRAY FOR ENERGY GOIN LROOM 66

76 it FROM ROOM TO ROOM. LROOM 67

77 t * xx*xxxxxxxxxx*x*x*«xx*xxxxxxx**x*x****x*xxxxxxxx LROOM 68 78 R = VAL ( FROMd : 2) ) LROOM 69

79 C = VAL ( TO( 1 : 2) ) LROOM 70

80 ROOM(R,C) = TS2 / RAREA(R) + ROOM(R,C) LROOM 71

81 ROOM(C,R) = TS2 / RAREA(C) + ROOM(C,R) LROOM 72 82 END IF LROOM 73

83 RETURN LROOM 7 4 84 END LROOM 75

VARIABLE MAP-- (LO=A)

NAME---ADDRESS --BLOCK PROPERTIES TYPE

C 2 2 2B INTEGER

D 2 2 5E INTEGER

FROM 3 DUMMY-ARG CHAR*3

NROOMS 1 2 4 4B /ROOMN/ INTEGER

R 223B INTEGER RAREA 1 245B /ROOMN/ REAL RNUM 2 2 4B INTEGER

ROOM OB /ROOMN/ REAL

TO 4 DUMMY-ARG CHAR*3

TS 1 DUMMY-ARG REAL

TS2 2 DUMMY-ARG REAL

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

RMAX INTEGER 20

-PROCEDURES--(LO=A)

-NAME TYPE--- ARGS CLASS---

VAL INTEGER 1 FUNCTION

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS- --

LROOM 5B 4

234
FTN S USS2 84/03/14. 10.18.23 PACE 28 SUBROUTINE LROOM 74/175 OPT=0

--STATISTICS--

PROCRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

230B = 152

1271B = 697

61000B = 25088

0.100 SECONDS

235
8 4 / 0 3 / 1 4 . 10 .18 .23 PAGE

74/175 OPT=0

FTN 5 1+552 29 FUNCTION VAL

1 INTEGER FUNCTION VAL(STRING ) LROOM 76

2 *CC t [[[[[[[[[[[[[[[[[[[[[[tCCCCCC C C [ [ [[[[[[[[[[[[[[[ [[[[[[[CttCCCICICUtLROOM 77

3 c [[[LROOM 78

4 *C C [ RETURNS THE INTEGER VALUE OF A STRING

.

[[[LROOM 79

5 *[ [ [ [ [ [LROOM 80

6 *[[ c [[[[[[[[[[[[[[[CtCCCCCCCIFtCI [CCC CCCCItCCCICCtIC [[[[[[[[[[[[[[[[[[[[LROOM 81

7

* It Hr * **«***«*ti*ii*it*«************** It It It * tut************* «itii*it«iititit*iiiiititititttit** LROOM 82

8 INTEGER NUMBER, X, L, EXP, DIG IT, GETLEN LROOM 83

9 CHARACTER » (*) STRING LROOM 84

10 t LROOM 85

11 L = GETLEN(STRING) LROOM 86

12 NUMBER = 0 LROOM 87

13 DO 10 X = L, 1 , -1 LROOM 88

14 EXP = L - X LROOM 8?

15 DIGIT = ICHAR(STRING(X: X) ) - 16 LROOM 90

1 6 NUMBER = NUMBER + DIGIT*1 0**EXP LROOM 91 17 10 CONTINUE LROOM 92

18 VAL = NUMBER LROOM 93

19 RETURN LROOM 94

20 END LROOM 95

-VARIABLE MAP--(LO=A)

-NAME---ADDRESS--BLOCK PROPERTIES TYPE

DIGIT 76B INTEGER

EXP 75B INTEGER

L 74B INTEGER

NUMBER 72B INTEGER

STRING 1 DUMMY-ARG CHAR*( *) VAL 71B INTEGER

X 73B INTEGER

-PROCEDURES--(LO=A)

-NAME TYPE AHGS CLASS

GETLEN INTEGER 1 FUNCTION

ICHAR INTEGER 1 INTRINSIC

-STATEMENT LABELS- -( LO= A

)

-LABEL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 17

-ENTRY POINTS--(LO=A)

-NAME---ADDRESS--ARGS

VAL 6B 1

-STATISTICS--

PROGRAM-UNIT LENGTH

CM STORAGE USED

COMPILE TIME

102B = 66 61000B = 25088

0.039 SECONDS

236
FTN 5 1 *5 5 2 84/03/H. 10.18.23 PAGE 30 FUNCTION CETLEN 74/175 OPT=0

1 INTEGER FUNCTION GETLEN (STRING) LROOM 96

2 C C C C C C [ C [ C [ C C [ C [ C C [ [ C [ [ C t [ [ C C C [ C C C C C [ C C C C C [ [ [ C [ C C [ [ [ C C C [ C C [ C C C [ [ [

C

C C C [ [ LROOM 97

3 C [ [ [ C [LROOM 98

4 ICC DETERMINE LENGTH OF STRING EXCLUDING ANY BLANK PADDING [ [[LROOM 99

5 [ [ C [ [ [LROOM 100

i t C C [[[[[[[[[ C C C [ C C [[ C C [ C [[[ C C C C C C [[[ C [ LC C [ C C C C [ C [[[[ C C C [ C C C [ C [[[

C

C C C [ [ [LROOM 1 01

7 t»»**»»»»»»**»»*»*»»*»»»***»»*****»**»»***»»**»**jMi»*»*»»*»*»*»*»t**»*»LROOI'l 102

8 LROOM 1 03

9 ARGUMENT DEFINITIONS -- LROOM 104

10 INPUT ARGUMENTS LROOM 1 05

1

1

STRING - STRING WHOSE LENGTH IS TO BE DETERMINED LROOM 106

12 LROOM 1 07

13 LROOM 108

1 4 CHARACTER * (*) STRING LROOM 109

15 LROOM no

U FUNCTION PARAMETERS LROOM 1 11 17 LROOM 1 1 2

1 8 CHARACTER * 1 BLANK LROOM 1 13

19 PARAMETER (BLANK =

' '

)

LROOM 114

20 AAAAAAAAAAAAAAAAAAAAAAAAAAAA*A*****AA*A**«*AAAAAA LROOM 1 15

21 LOCAL VARIABLES LROOM 1 1 6 22 AAAAAAAAAAAAAAAAAAAAAAA«AAAAAA*A*AAA*AA*«AAAtt*AA LROOM 1 17 23 INTEGER NEXT LROOM 1 1 8 24 AAAAAAAAAAAAAAAAAA*AAAA**lkAA*A*A**AAA*AA«AAAAA*AA LROOM 1 19 25 START WITH THE LAST CHARACTER AND FIND THE FIRST NON-BLANK LROOM 120

26 AAAAAAAAAAAAAAAAAAAAAAAA«AAA*A*AAAAAAA*AAA*AAAAAA LROOM 121

27 DO 10 NEXT = LEN(STRING) , 1

, -1 LROOM 122

28 IF (STRING(NEXT ; NEXT) .NE. BLANK) THEN LROOM 123

29 GETLEN = NEXT LROOM 124

30 RETURN LROOM 1 25

31 END IF LROOM 126

32 10 CONTINUE LROOM 1 27 33 LROOM 128

34 * ALL CHARACTERS ARE BLANKS LROOM 1 29

35 LROOM 130

36 GETLEN = 0 LROOM 131

37 A LROOM 132

38 RETURN LROOM 1 33

39 END LROOM 134

-VARIABLE MAP--(LO=A)

-NAME---ADDRESS--BLOCK PROPERTIES TYPE ---SIZE

GETLEN 63B INTEGER

NEXT 64B INTEGER

STRING 1 DUMMY-ARG CHAR*( *)

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

BLANK CHAR*1 ' '

-PROCEDURES tl •< 1 1 o -NAME TYPE --ARGS CLASS

LEN INTEGER 1 INTRINSIC

237
FTN 5.1+552 84/03/14. 10.18.2

FUNCTION GETLEN 74/175 OPT=0

-STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 32

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS- -ARCS- --

GETLEN 6B 1

-STATISTICS--

PROGRAM-UNIT LENGTH 70B

CM STORAGE USED 61000B

COMPILE TIME 0 . 039

3 PAGE 31

= 56

= 25088

SECONDS

238
TTN 5 1+552 84/03/14. 10.18.23 PAGE 32 SUBROUTINE LTDB 74/175 OPT=0

1 SUBROUTINE LTDB LTDB 1

2 • C C [ I [ [ C [ C C [ C [ C [ C C C [ [ [ [ C C C [ [ [ C [ [ C C C C C [ C [ [ C [ t [ [ [ C [ C [ C [ [ C C C [ C [ C [ [ C [

C

C C C C [

C

LTDB 2

3 •[[[ [[[LTDB 3

4 *[[[ THIS ROUTINE CALCULATES THE ATTENUATION OF EACH DOOR AND [[[LTDB 4

5 »[[[ WINDOW [[[LTDB 5

i •[[[ [[[LTDB 6

7 «[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ [LTDB 7

9 * VARIABLE DEFINITIONS LTDB 9 10 » ID; IDENTIFICATION OF OPENING LTDB 10

11 • OATTEN: OPENING ATTENUATION LTDB 11

12 • LATTEN: LAYER ATTENUATION LTDB 12

13 » MATTEN; MATERIAL ATTENUATION LTDB 13

14 * MAT: MATERIAL IDENTIFICATION LTDB 14 15 * TDBTOT: TOTAL LINES OF DATA IN THE TDBl AND TDB2 ARRAYS LTDB 15 U » HEIGHT: HEIGHT OF DOOR OR WINDOW OPENING LTDB 16 17 * WIDTH: WIDTH OF DOOR OR WINDOW LTDB 17

18 » T; THICKNESS OF LAYER LTDB 18 19 • AREA: AREA LTDB 19 20 * NEWTYPE: TRUE IF DATA LINE BELONGS TO A NEW DOOR OR WINDOW TYPE LTDB 20

21 • TYPEEND: TRUE IF DATA LINE IS THE LAST DATA LINE OF AN OPENING TYPE LTDB 21

24 *** COMMON FOR INITIAL PARAMETERS »**COMF 2

26 INTEGER FMAX COMF 4 27 PARAMETER (FMAX = 50) COMF 5 28 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF 6 29 $ FTOT COMF 7 30 COMMON /INITILC/ BLDG COMF 8 31 CHARACTER * 5 BLDG COMF 9 32 REAL FREQ, AFLAG, RFLAG, FREQA COMF 10 33 INTEGER QUALITY, FERR, FTOT COMF 11

37 *** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT 2

39 INTEGER TMAX COMT 4 40 PARAMETER (TMAX=35) COMT 5 41 COMMON /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR COMT 6 42 COMMON /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX) COMT 7 43 INTEGER TTOT , TDBTOT , TERR COMT 8 44 REAL TDIM,TDB2 COMT 9 45 CHARACTER * 3 TYPE, TDBl COMT 10 46 *================================================= COMT 11 47 * DESCRIPTION OF ARRAYS COMT 12 48 »================================================= COMT 13 49 * ID MATERIAL FRAME MATERIAL COMT 14 50 * COMT 15 51 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT 16 52 * A3 A3 A3 COMT 17 53 *================================================= COMT 18 54 * HEIGHT WIDTH LAYER DISTANCE COMT 19 55 * THICKNESS ABOVE FLOOR COMT 20

54 * COMT 21 57 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT 22 58 * F8.2 F8.2 F8.2 F8 .

2

COMT 23 59 *================================================= COMT 24

60 * ID ATTENUATION AREA COMT 25 41 * COMT 2 6 62 * TDBKX) TDB2(X,1) TDB2(X,2) COMT 27 63 * A3 E9.3 E9.3 COMT 28 44 ********************»**«*«t*tt«************«»*t******«********t<i«******t«tcOMT 29

239
FTN 5.1+552

SUBROUTINE LTDB 84/03/M. 10.18.23 PAGE

74/175 OPT=0

33

6566

6768

6970

7172

7374

7576

7778

7980

8182

8384

8586

8788

8990

9192

9394

9596

9798

99 100

101 102

103 104

105 106

107 108

109 no

111 112

113 114

115 116

117 118

119 120

121 122

123 124

125 126

127 128

************ 1Hl*t 1tt*t*t* 1l* 1ltt* 1t 1l* 1lt** 1l*tt*t**t* 1l*tt

* DECLARATION OF VARIABLES

rt**********************************)***************

INTEGER NEXT, LAST, R REAL LATTEN, OATTEN, MATTEN, ATTEN

REAL HEIGHT, WIDTH, AREA CHARACTER * 3 MAT , ID LOGICAL NEWTYPE, TYPEEND

***«******lM(«k«i**«i)l*«****lk lk** **«r***«*»*Klt*ik*«*

*«**ik***«ili«Mk***<i<t********«*«*«**tt A** ****1tIkAAIt*

TDBTOT = 0 DO 10 R = 1, TTOT

t****t*ii*t*iit**»ii*ii*ii»iitii*itt***t****tttii*titiittitii**

* SET TYPEEND CONDITION

t**iiiit****t*ii***tiiii**iiiit***tt*lt*iit***itt**ttitttitt*t NEXT = R + 1 IF (R .EQ. TTOT) THEN

TYPEEND = .TRUE. ELSE IF ( TYPE(R,1) .NE. TYPE<NEXT,1) ) THEN TYPEEND = .TRUE. ELSE

TYPEEND = .FALSE. END IF

*4t*******lii*ikttilr**ik**4i**ltllr***A******lt**<t***)t*)k<ltMt*lt*

« SET NEVTYPE CONDITION

*f[*«1li«***i>tt***A A** 1k***A«AAftAA*t***AA**********

LAST = R - 1 IF (R EQ. 1) THEN

NEWTYPE = .TRUE. ELSE IF ( TYPE(R,1) .NE. TYPE(LAST,1) ) THEN NEWTYPE = .TRUE. ELSE

NEWTYPE = .FALSE. END IF *********lt**«**A*****t*lk****1t**it*]t**«ik1t**«**ltK***tt

* CALCULATE

IF (NEWTYPE) THEN

* ..INITIALIZE TYPE CONDITIONS

OATTEN = 0 END IF

**lt*lk***tt*«r*lt*t*1tlt4ilt*lt***t)tk*****ltik**lt********tk**lk*

* ...CALCULATE ATTENUATION FACTOR OF LAYER

**Aiit*********ilc**A********ft**Aft*****ik*tAt****t4tftft*1k MAT = TYPEIR, 2) MATTEN = ATTEN (MAT , FREQ , AFLAG

)

T = TDIMCR, 3) LATTEN = MATTEN * T

* ..CALCULATE RUNNING ATTENUATION FACTOR OF OPENING **************************************************

OATTEN = OATTEN + LATTEN

IF (TYPEEND) THEN

4(tt***<i****ltiii*lt***k********<k<i*lk*****tilMt**lk*<lli******

* ....CALCULATE TOTAL OPENING AREA

*t**********Aik lit** *l(*ftk****1kllt******A***A «** 

HEIGHT = TDIM(R, 1

)

WIDTH = TDIM(R,2)

AREA = HEIGHT * WIDTH

*t*t*t***t1i 1i** *1(*1itlt*li1i1i1i*1itli*t*1i1i*1rk1i**1i*1i*ii*

30 LTDB 25 LTDB 26 LTDB 27 LTDB 28 LTDB 29 LTDB 30 LTDB 31 LTDB 32 LTDB 33 LTDB 34 LTDB 35 LTDB 36 LTDB 37 LTDB 38 LTDB 39 LTDB 40 LTDB 41 LTDB 42 LTDB 43 LTDB 44 LTDB 45 LTDB 46 LTDB 47 LTDB 48 LTDB 49 LTDB 50 LTDB 51 LTDB 52 LTDB 53 LTDB 54 LTDB 55 LTDB 56 LTDB 57 LTDB 58 LTDB 59 LTDB 60 LTDB 61 LTDB 62 LTDB 63 LTDB 64 LTDB 65 LTDB 66 LTDB 67 LTDB 68 LTDB 69 LTDB 70 LTDB 71 LTDB 72 LTDB 73 LTDB 74 LTDB 75 LTDB 76 LTDB 77 LTDB 78 LTDB 79 LTDB 80 LTDB 81 LTDB 82 LTDB 83 LTDB 84 LTDB 85 LTDB 86 LTDB 87

240
riN 5 U55 2 SUBROUTINE LTDB 84/03/14 . 10.18.23 PAGE

74/175 OPT=0

34

1 29 * INSERT ID, ATTENUATION AND AREA INTO TYPE DATABASE ARRAYS LTDB 88 130 t************************************************* LTDB 89

13 1 TDBTOT = TDBTOT + 1 LTDB 90 132 ID = TYPE(R,1) LTDB 91 133 TDBl (TDBTOT) = ID LTDB 92 134 TDB2 (TDBTOT , 1 ) = OATTEN LTDB 93 135 TDB2(TDBTOT, 2) = AREA LTDB 94 136 END IF LTDB 95 137 10 CONTINUE LTDB 96 138 RETURN LTDB 97 139 END LTDB 98

VARIABLE MAP-- (LO=A)

NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

AFLAC 2B / INITILN/ REAL

AREA 22 IB REAL

BLDG OB / INITILC/ CHAR*5

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B /INITILN/ REAL 50 FTOT 676 / INITILN/ INTEGER

HEIGHT 217B REAL

ID 22 3B CHAR*3

LAST 212B INTEGER

LATTEN 214B REAL MAT 222B CHAR*3

MATTEN 216B REAL NEWTYPE 22 4B LOGICAL

NEXT 21 IB INTEGER

OATTEN 215B REAL QUALITY IB / INITILN/ INTEGER

R 213B INTEGER

RFLAG 3B / INITILN/ REAL T 22 7B REAL TDBTOT 32 36 /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 140 TERR 324B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3 1 05 TYPEEND 225B LOGICAL

WIDTH 22 0B REAL

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

FMAX INTEGER 50 TMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME ---TYPE ARCS--- CLASS

ATTEN REAL 3 FUNCTION

241
FTN 5.1+552 84/03/14. 10.18.23 PAGE 35 aUBROUTINE LTDB 74/175 OPT=0

-STATEMENT LABELS-- ( LOuA

)

-LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 137

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

LTDB 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 232B = 154 CM LABELLED COMMON LENGTH 470B = 312 CM STORAGE USED 81000B = 25088

COMPILE TIME 0.114 SECONDS

242
FTN 5 1+552

SUBROUTINE LTYPE 84/03/14. 10.18.23 PAGE74/175 OPT=0

36

1 SUBROUTINE LTYPE LTYPE

2 » [ [ [ [ [ C C [ C [ C I [ C C [ C [ [ [ C C C [ C C [ [ I [ [ C C C [ C C C C [ [ [[ C CC [ C [ [ C [[ C [ C [ C [ C C [ C C C C C C [ [ [LTYPE

3 *[[[ [[[LTYPE

4 *[[[ LOAD THE "TYPE" ARRAYS FROM THE TYPE DATA FILE [[[LTYPE

5 *[[[ [[[LTYPE

6 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[[[[ [[LTYPE

S t*********************************************************************** COMT

9 *** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT

10 ltli<i*ll<i*lk*4i*****)i*lt********t*kA*ktl****tlt***<ilt«i**tt**tt*<ilt«lkiii**ltAlt**tl****lt*4i<((^ OMT

11 INTEGER TMAX COMT

12 PARAMETER (TMAX=35) COMT

13 COMMON /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAX,2> ,TDBTOT,TERR COMT

14 COMMON /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX) COMT

15 INTEGER TTOT , TDBTOT , TERR COMT

16 REAL TDIM.TDB2 COMT

17 CHARACTER * 3 TYPE.TDBl COMT

18 *==============:=================================== COMT

19 * DESCRIPTION OF ARRAYS COMT

20 *================================================= COMT

21 * ID MATERIAL FRAME MATERIAL COMT

22 » COMT

23 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT

24 » A3 A3 A3 COMT

25 *================================================= COMT

26 * HEIGHT WIDTH LAYER DISTANCE COMT

27 * THICKNESS ABOVE FLOOR COMT

28 * COMT

29 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT

30 * F8.2 F8.2 F8.2 FB . 2 COMT

31 *================================================= COMT

32 * ID ATTENUATION AREA COMT

33 * COMT

34 * TDBl(X) TDB2(X,1) TDB2(X,2) COMT

35 A3 E9.3 E9.3 COMT

39 *** COMMON FOR INITIAL PARAMETERS ***COMF

41 INTEGER FMAX COMF

42 PARAMETER (FMAX = 50) COMF

43 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF

44 5 FTOT COMF

45 COMMON /INITILC/ BLDG COMF

46 CHARACTER * 5 BLDG COMF

47 REAL FREQ, AFLAG, RFLAG, FREQA COMF

48 INTEGER QUALITY, FERR, FTOT COMF

51 ************************************************** LTYPE

52 * DECLARATION OF VARIABLES LTYPE

53 ************************************************** LTYPE

54 INTEGER GETLEN, R, C LTYPE

55 CHARACTER * 7 PFN LTYPE

5^ *** *t ** tt tit * t ****** ***ii tt *** ii * t ****** *t ********** * LTYPE

57 * LTYPE

58 ************************************************** LTYPE

59 PFN = 'B' II BLDGd :GETLEN(BLDG) ) II 'T’ LTYPE

60 TERR = 0 LTYPE

61 CALL PF ( 'GET' ,0,PFN(1ETLEN(PFN) ), ‘RC , TERR) LTYPE 20 62 IF (TERR .EQ. 0 ) THEN LTYPE

63 OPEN (UNIT=3, FILE=PFN, FORM= ' FORMATTED ' , LTYPE

64 S STATUS='OLD' , ACCESS= ' SEQUENTI AL ' ) LTYPE

1

23

45

67

1

2

3

4

5

6

7

8

9 10

11

1 2 1314

15

1 6 1718

1920

2122

2324

2526

2728

2930

1

2

3

4

5

6

7

8

9

1 0

1

1

1 2 1310

11

1 2 13

1 4 15

1 6 17

1 8 19

2 1 22

23

243
FTN 5.1+552 84/03/14. 10.18.23 PAGE 37 SUBROUTINE LTYPE 74/175 OPT=0

65 1000 FORMAT (1X,3(1X,A3),4(1X,F8.2)

>

LTYPE 24

66 TTOT = 0 LTYPE 25 67 DO 10 R = l.TMAX LTYPE 26 68 READ (3,1000, END=20) (TYPE(R ,C) ,C=1,3),(TDIM(R,C),C=1,4) LTYPE 27 69 TTOT = TTOT + 1 LTYPE 28

70 10 CONTINUE LTYPE 29

71 20 CONTINUE LTYPE 30 72 CLOSE(3,STATUS='DELETE‘

>

LTYPE 31 73 ELSE IF ( TERR EQ. 2 ) THEN LTYPE 32 74 CALL WARNING (5) LTYPE 33 75 ELSE LTYPE 34

76 CALL WARNING (6) LTYPE 35 77 END IF LTYPE 36

78 RETURN LTYPE 37 79 END LTYPE 38

-VARIABLE MAP--(LO=A)

-NAME--- ADDRESS- -BLOCK PROPERTIES TYPE ---SIZE

AFLAC 28 1 INITILN/ REAL BLDG OB / INITILC/ CHAR*5

C 236B INTEGER

FERR 66B /INITILN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER PFN 237B CHAR*7

QUALITY IB / INITILN/ INTEGER

R 235B INTEGER

RFLAG 3B / INITILN/ REAL TDBTOT 323E /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 324B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER TYPE OB /TYPEC

/

CHAR*3 105

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

FMAX INTEGER 50 TMAX INTEGER 35

-PROCEDURES--(LO=A)

-NAME TYPE ARGS CLASS

GETLEN INTEGER 1 FUNCTION

PF 5 SUBROUTINE

WARNING 1 SUBROUTINE

-STATEMENT LABELS--! LO=A) LABEL- ADDRESS --PROPERTIES -DEF

10 INACTIVE DO-TERM 70

20 lllB 71 1000 147B FORMAT 65

244
FTN 5 1+552 84/03/14. 10.18,23 PAGE 38 SUBROUTINE LTYPE 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

LTYPE 5B 0

-1 10 UNITS--(LO=A)

-NAME PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

PROCRAM-UNIT LENGTH 24 5B = 185 CM LABELLED COMMON LENGTH 47 0B = 3 12 CM STORAGE USED 83000B = 26112

COMPILE TIME 0.103 SECONDS

245
FTN 5.1+552

SUBROUTINE LWALL 84/03/M. 10.18.23 PAGE 74/175 OPT=0

39

1

2

3

4

5

6

7

8

9 10

1112

1314

15

1 6 1718

1920

2122

2324

2526

2728

29

30

3132

3334

3538

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

SUBROUTINE LWALL LWALL meet U[[[CCt[[CC[[[[[[[C[[CC[[[C[[[[[CCCt[[[[tCC[C[C[[[[[C[[[[[[[[[t [[LWALL

*[[[ [[[LWALL

*[[[ LOAD THE CONTENTS OP THE FILE 'WALLS' INTO ARRAYS WALL AND WDIM. LWALL

*[[[ [[[LWALL

*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[LWALL

««******«**««i4M»**«ik*****«*««r*****«*****«t*******itik*«**«r**«*lk**ltt**lt****** LWALL

*** COMMON FOR DATABASE OF WALL PARAMETERS ***COMW

Ik * A A 1 INTEGER WMAX PARAMETER (WMAX = 75)

COMMON /WALLN/ WDIM(WMAX,3)

COMMON /WALLC/ WALL (WMAX, 4) INTEGER WTOT.WERR

REAL WDIM

CHARACTER *3 WALL

* ===============================:

*» DESCRIPTION OF ARRAYS

* WALL IDENTIFICATION

*

«

*

**

**

**

*

**

* *

WTOT, WERR

DIRECTION FROM

ROOM

TO

ROOM

WALL (X , 1

)

A3 WALL(X,2)A3 WALL(X,3)A3

WALL PARAMETERS

MATERIAL HEIGHT WIDTH LAYER THICKNESS

WALL( X, 4) WDIM( X, 1

)

WDIM(X, 2) WDIM(X, 3) A3 F8 . 2 F8 .2 FB . 2

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

COMW

*** COMMON FOR INITIAL PARAMETERS

«* ** INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR

$ FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG

REAL FREQ, AFLAC, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

*******<l**t)lktl**««lt***IMt*lk***<t***************ltlk****

* DECLARATION OF VARIABLES

t*t*t*******it t** t******itii*ii*ti***t***iit*tt*ii*tt

INTEGER GETLEN, R, C CHARACTER * 7 NAME, PFN **************************************************

*

NAME = ' B' / /BLDG( 1 ; GETLEN(BLDG) ) /

/

' W' PFN = NAME ( 1 : GETLEN(NAME)

)

WERR = 0 CALL PF (' GET' , 0 , PFN( lETLEN(PFN) ),' RC ', WERR)

IF ( WERR EQ. 0 ) THEN

OPEN (UNIT=3, FILE=PFN, FORM= ' FORMATTED '

,

5 STATUS= 'OLD ' , ACCESS= ' SEQUENTI AL '

)

*«*COMF

COMF

COMF

COMF

COMF

COMF

COMF

1

2

3

4

5

67

1

2

3

4

5

6

7

8

9

1 0 11

1 2 13

1 4 1516

1718

1920

2122

2324

2526

2728

29

1

23

4

5

6

7

COMF 10 COMF 11

1213 LWALL 10 LWALL 1

1

LWALL 12 LWALL 13 LWALL 14 LWALL 15 LWALL 16 LWALL 17 LWALL 18 LWALL 19 LWALL 20 'ALL 21 LWALL 22 LWALL 23 LWALL 24

246
rTN 5 U55 2 SUBROUTINE LWALL 84/03/14. 10.18.23 PAGE

74/175 OPT=0

40

&5 1000 FORMAT ( IX , 4( IX, A3 ) , 3( IX , F8 . 2) ) LWALL 25

&& WTOT = 0 LWALL 26 67 DO 10 R = 1,UMAX LWALL 27

68 READ (3,1000, END=20) (WALL(R,C) ,C=1,4),(WDIM(R,C),C=1,3) LWALL 28 69 WTOT = WTOT + 1 LWALL 29

70 10 CONTINUE LWALL 30

71 20 CONTINUE LWALL 3 1 72 CLOSE (3 ,STATUS=' DELETE’

)

LWALL 32 73 ELSE IF ( WERR .EQ. 2 ) THEN LWALL 33 74 CALL WARNING (7) LWALL 34 75 ELSE LWALL 35

76 CALL WARNING (8) LWALL 36 77 END IF LWALL 37 78 RETURN LWALL 38

79 END LWALL 39

-VARIABLE MAP-- (LO=A) -NAME ADDRESS --BLOCK PROPERTIES TYPE SIZE

AFLAG 2B / INITILN/ REAL

BLOG OB / INITILC/ CHAR*5

C 255B INTEGER

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER

NAME 25 6B CHAR*7

PFN 25 7B CHAR*7

QUALITY IB / INITILN/ INTEGER

R 2 5 4B INTEGER

RFLAG 3B / INITILN/ REAL

WALL OB /WALLC/ CHAR*3 300

WDIM OB /WALLN/ REAL 225

WERR 342B /WALLN/ INTEGER

WTOT 341B /WALLN/ INTEGER

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

FMAX INTEGER 50 WMAX INTEGER 75

-PROCEDURES--(LO=A>

-NAME TYPE ARGS CLASS

GETLEN INTEGER 1 FUNCTION

PF 5 SUBROUTINE

WARNING 1 SUBROUTINE

-STATEMENT LABELS--! LO=A) LABEL -ADDRESS --PROPERTIES-- --DEF

1 0 INACTIVE DO-TERM 70

20 117B 71 1000 155B FORMAT 65

247
FTN 5.1+552

SUBROUTINE LVALL 84/03/14. 10.18.23 PAGE

74/175 OPT=0

41

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

LWALL 5B 0

-I /O UNITS--(LO=A)

-NAME--- PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 265B

CM LABELLED COMMON LENGTH 566B

CM STORAGE USED 63000B

COMPILE TIME 0.108

= 181

= 374

= 26112

SECONDS

248
FTN 5 I *552

SUBROUTINE PHOLE

84/03/ M . 10 .18 .23 PAGE

74/175 OPT=0

42

12

3

45

8

78

9 10

1

1

12

13

1 4 IS

1 6 1718

1920

2122

23

24

2526

2728

2930

3132

3334

3536

3738

3940

4142

SUBROUTINE PHOLE PHOLE

•CCCC[[CC[CCCCCC[CC[CUC[[CC[[CCC[CCC[[CC[[[[C[CC[CC[C[[C[[[[[CC[C[[CCC[PHOLE

•[[[ [[[PHOLE

•[[[ PRINT OUT THE CONTENTS OF THE HOLE ARRAY [[[PHOLE

»[[[ [[[PHOLE

•[([[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[PHOLE

«*«t*««**«*******««**«i

»*» COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS *»*COMH

*******«*t«****«****«*«««*«**********»*****************it**************«*COMH

INTEGER HMAX PARAMETER (HMAX = 35)

COMMON /HOLEN/ HTOT, HERR COMMON /HOLEC/ HOLE (HMAX, 4) INTEGER HTOT, HERR CHARACTER » 3 HOLE

COMH

DESCRIPTION OF ARRAYS

ROOM IDENTIFICATION APERTURE ID

DIRECTION FROM ROOM TO ROOM

HOLE(X, 1) A3 HOLE(X,2)

A3

HOLE (X, 3

)

A3

HOLE (X A3

,4)

* : INTEGER R,C

PRINT * PRINT DOOR AND WINDOW LOCATIONS'

PR I NT* , '***************************'

PRINT*,' WALL IDENTIFICATION'

PRINT*,' ' PRINT*,' ID DIRECTION FROM TO' PRINT*, '==== ======================'

DO 10 R = 1 ,HTOT

PRINT 1000 .HOLE (R, 4) , (HOLE(R,C) ,C=1 , 3) 10 CONTINUE

PRINT* , '===========================

1000 FORMAT ( 2X , A3 , 5X , 3 ( 3X , A3 )

)

RETURN

END

COMH 5 COMH 6 COMH 7 COMH 8 COMH 9 COMH 10 COMH 11 COMH 12 COMH 13 COMH 14 COMH 15 COMH 16 COMH 17 COMH 18

1920 PHOLE 9 PHOLE 10 PHOLE 11 PHOLE 12 PHOLE 13 PHOLE 14 PHOLE 15 PHOLE 1 6 PHOLE 17 PHOLE 18 PHOLE 19 PHOLE 20 PHOLE 21 PHOLE 22 PHOLE 23

-VARIABLE MAP--(LO=A)

-NAME ADDRESS --BLOCK PROPERTIES TYPE SIZE

C 174B HERR IB /HOLEN/

HOLE OB /HOLEC/

HTOT OB /HOLEN/

R 173B

INTEGER

INTEGER

CHAR*3 140 INTEGER

INTEGER

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

HMAX INTEGER 35

249
FTN 5,1+552 84/03/14. 10.18.23 PAGE 43 SUBROUTINE PHOLE 74/175 OPT=0

-STATEMENT LABELS-- ( LO=A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 38 1000 124B FORMAT 40

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

PHOLE 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

201B = 129 54B = 44 ilOOOB = 25088

0.062 SECONDS

250
rXN 3 U55 2 SUBROUTINE PROOM

84/03/M. 10.18.23 PAGE

74/175 OPT=0

44

1 SUBROUTINE PROOM PROOM

2 » C C C C [[[ C C [[[ C C C C C C [[[ C [ C [[ C C t [ C C C [[ C C [[ C C [[[[[[[[[[ C C C C [[[ C [ C C [ C [[[ t C [ [ PROOM

3 »[[[ [[[PROOM

4 »[[[ PRINTOUT THE CONTENTS OF THE ROOM MATRIX [[[PROOM

5 *[[[ [[[PROOM

6 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [PROOM

7

* <t »*«***«**«** It **** 1

g

It *«** It **«*«**« <r ** I

9 *«* COMMON FOR INITIAL PARAMETERS ***COMF

10 * It * * * * * It It It * It It It It It * It ii It 1

1

1

1 2 1314

15

1 i 1718

QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR,

INTEGER RMAX PARAMETER (RMAX = 20)

COMMON /ROOMN/ ROOM(RMAX + 4, RMAX +6), NROOMS, RAREA(RMAX)

INTEGER NROOMS

REAL ROOM

INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ

$ FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG

REAL FREQ, AFLAC, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

19 itiiiiit)t«iittiiitititititit 20

21 ** *t*t*

22 *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

49

COMF

COMF

COMF

COMF

COMF

COMF

COMF

COMF

***COMR

COMR

COMR

COMR

COMR

COMR

' PROOM

INTEGER R,C PROOM

i PROOM

PRINT* PROOM

PRINT*,' ATTENUATION (DB) BETWEEN ROOMS' PROOM

PRINT*,' AT FREQUENCY = ',FREQ,' HERTZ' PROOM

$* Hit * It It * It It It It It It ' PROOM

DO 10 R = 1, NROOMS PROOM

PRINT 1000, (ROOM(R,C) , C = 1, NROOMS + 6) PROOM

10 CONTINUE PROOM

DO 20 R = NROOMS + 1 , NROOMS + 6 PROOM

PRINT 1000, (ROOM(R,C), C = 1, NROOMS ) PROOM

20 CONTINUE PROOM

PRINT* ,

' ==========================================================PROOM

$=============' PROOM

1000 FORMAT! IX , 12 (F8 . 3) ) PROOM

RETURN PROOM

END PROOM

1

2

3

4

5

6

7

1

2

3

4

5

6

7

8

9 10

1112

13

12

3

4

5

6

7

89 1010

1112

13

1 4 15

1 6 17

1 8 1920

2122

2324

2526

2728

VARIABLE MAP-- (LO=A)

NAME ADDRESS --BLOCK PROPERTIES TYPE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C 210B INTEGER

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL FTOT 67B / INITILN/ INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

QUALITY IB / INITILN/ INTEGER

R 207B INTEGER

SIZE

50

251
FTN 5.1+552 84/03/14. 10.18.23 PAGE 45 SUBROUTINE PROOM 74/175 OPT=0

RAREA 1 2 4 5E /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 676

-SYMBOLIC CONSTANTS-- (LO=A> -NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20

-STATEMENT LABELS-- ( LO=A

)

-LAB EL- ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM

20 INACTIVE DO-TERM

1000 154B FORMAT

4144

47

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

PROOM 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

217B = 143 1362B = 754

61000B = 25088

0.080 SECONDS

252
riN 5 U552 84 / 0 3 / 1 4. 1 0.1 8.23 PAGE 46 SUBROUTINE PTDB 74/175 OPT=0

1 SUBROUTINE PTDB PTDB

2 **i«« «** ******«*«iti**************************)t**it********************PTDB

3 » PRINT SUMMARY OF THE ATTENUATION OF THE DOORS AND WINDOWS PTDB

4 ***********tt*iitt**t**tt*t****iit***tt ii** tiitt*t**ii*ittt*tttti(***ttt*t* PTDB

5 *(<>**ii*******«**«*«*«***««***<i***************itit*********)r**)t*««********«c OMT

6 »•» COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT

7 * COMT

8 INTEGER TMAX COMT

9 PARAMETER (TMAX=35) COMT

10 COMMON /TYPEN/TDIM(TMAX, 4) ,TTOT,TDB2(TMAX, 2) ,TDBTOT,TERR COMT

11 COMMON /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX) COMT

12 INTEGER TTOT , TDBTOT , TERR COMT

13 REAL TDIM,TDB2 COMT

14 CHARACTER * 3 TYPE.TDBl COMT

15 •================================================= COMT

U * DESCRIPTION OF ARRAYS COMT

17 *================================================= COMT

18 » ID MATERIAL FRAME MATERIAL COMT

19 * COMT

20 »TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT

21 » A3 A3 A3 COMT

22 »================================================= COMT

23 * HEIGHT WIDTH LAYER DISTANCE COMT

24 » THICKNESS ABOVE FLOOR COMT

25 * COMT

26 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT

27 * F8.2 F8.2 F8 . 2 F8 . 2 COMT

28 *================================================= COMT

29 * ID ATTENUATION AREA COMT

30 » COMT

31 * TDBl(X) TDB2(X,1) TDB2(X,2) COMT

32 * A3 E9.3 E9 . 3 COMT

33 tii*t*t*t**t*t*tt*t*tt*tiitt***ttt**tt***t**ttt****t*t**ttitt*tttt*t*ttt**tQ OMT

34 *tt***tt**t***t***t*t**ii***ttt***t*************t*t***tt*t*t**ttt*tt«tit** COMT

35 INTEGER R,C PTDB

36 CHARACTER * 3 ID PTDB

37 PRINT * PTDB

38 PRINT*, 'DOOR AND WINDOW SUMMARY' PTDB

39 PRINT* ,'********************************* ' PTDB

40 PRINT*, 'ID ATTENUATION AREA' PTDB

41 PRINT* ,'================================= ' PTDB

42 DO 10 R = 1 , TDBTOT PTDB

43 PRINT 1000,TDB1(R) ,(TDB2(R,C) ,C=1,2) PTDB

44 10 CONTINUE PTDB

45 PRINT* ,'================================= ' PTDB

46 1000 FORMAT ( 1 X , A3 , 5X , F8 . 2 , 5X , F6 . 2 ) PTDB

47 RETURN PTDB

48 END PTDB

1

2

3

4

12

3

45

6

7

8

9 10

1 1 1213

1415

1617

1819

2021

2223

2425

2627

2829

30

6

7

8

9 10

1112

1314

15

1 6 17

1 8 19

-VARIABLE MAP-- (LO=A) -NAME ADDRESS --BLOCK --PROPERTIES --- TYPE ---SIZE

C 144B INTEGER

ID NONE UNUSED/ *S* CHAR*

3

R 143B INTEGER

TDBTOT 32 3B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 1 40 TERR 324B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3 105

253
FTN F 1+552

SUBROUTINE PTD3

S4/Q3/14. 10.18.23 PAGE 74/175 OPT=0

47

-SYMBOLIC COKSTANTS--(LO=A)

-NAME TYPE VALUE

"MAS INTEGER 35

-STATEMENT LABELS-- { LO=A)

-LAE EL- ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 44 1000 107B FORMAT 46

-ENTRY ?OINTS--(LO=A)

-NAME ADDRESS --ARGS

PTDB 53 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

151B = 105 3773 = 255

61000E = 25088

0.060 SECONDS

254
TTN ; ;.5!:

SUBROUTINE PTYPE •4/03/14 13 . la . 23 PAGE74/175 OPT=0

a

1 SUBROUTINE PTYPE PTYPI

2 • c c c c c c c c c c c c c [ c c c [ c c c c c c I c c c c c [ c [ EC c c c c r [ c c [ c E c c c c [ E c c c c [ [ mc [ c c

:

' : : : : ? T Y ?

I

3 *ccc :::?TY?z

4 'ICI PRINT OUT THE CONTENTS OP THE “TYPE" ANE “T3IN'* ARRAYS CCIPTYPE

5 *CCC CIIPTYPE

i •CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCECCCCIC-’CIEPTYPE

; ttttlltttttttlttXtXXXItXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXlX £2 VT

9 ••• COftMON FOR DATABASE OF TYPES OF DOORS A>iL VIN3DV5 **»:CNT

<2 ttxItltXtttXXttltXtXItXXXtlXXXXXXXXXXXXXXXXXXtXXXlXXXXXXXXXXXXXXXIXXXXXI zzyci

11

1 2 13

1 4 15

1 6 1718

1920

2122

2324

2528

2728

2930

3132

3334

3538

3738

3940

4142

4344

4548

4743

4950

5152

53

INTEGER TWA2

PARAMETER TMAI=35)

COMMON /TYPEK/TDIfUTMAX , 4^ ,TT0T,TCB2 (TMAX , 2 ) .TESTOT , TERR

COMMON /TYPEC/TYPE/TMA2.3) ,TE2I (TMA2)

INTEGER TTOT.TDBTOT.TERR

REAL TDIM.TDB2

CHARAC TER » 3 TYPE ,TD31

DESCRIPTION OF ARRAYS

ID MATERIAL FRAME MATERIAL

TYPE(X, 1) A3 TYPE( X. 2) A3 TYFEd, 3) A3

HEIGHT WIDTH LAYER THICKNESS

DISTANCE

ABOVE FLOOR

TDIM( I, 1) F8 . 2 TDIK(X,2)

P8 .2 TDIMd, 3)pa .2 TDIfUl, 4; F8 .2

ID ATTENUATION AREA

TD31 (X) A3 TD32(X, 1) E9 . 3 TD32 (X ,2) E9 . 3

CCMT

- n V—

< " W~

r ^ V” CCMT

CCMT

CCMT

- ^ V—

'TV”

XXttXIXXXXXXXXXXXXXXXXXXXXXXXXXI tXtXXXXXXtXXXXXXXXIXITXtX'

XttXXXtIXXXXXXXXXXIXXXX] ixxxxxxxxxxxxxxixxxxt'

INTEGER R, C

PRINT * PRINT * PRINT ‘ PRINT * PRINT * PRINT * BO 10 S

DOOR AND VINDOV PARAMETERS*

'XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXIXfXXXtX

ID MATERIAL FRAME HEIGHT VIDTK LAYER DISTANCE

MATERIAL THICKNESS ABOVE FLR

= l.TTOT

PRINT 1000 , (TYPECR.C) ,C=1 , 3 ) . (TDIM(R.C) ,C=1 .4)

10 CONTINUE

PRINT *,*============================

1 00 0 FORMAT ( 2 1 , A3 . 4X , A3 . 8 X , A3 . 4 1 1

2

, F7 . 2 ) ) RETURN

END

--VARIABLE MAP--(LO=A)

-NAME---ADDRESS--BLOCX PROPERTIES TYPE SIZE

C 2173 INTEGER

R 218B INTEGER

TDBTOT 3233 /TYFEN/ INTEGER

TDBl 373 /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 7

;

TDIM OB /TYPEN/ REAL 1 4 0

255
FTN 5.1+552 84/03/14. 10.18.23 PAGE 49 SUBROUTINE PTYPE 74/175 OPT=0

TERR 32 4B /TYPEN/ INTEGER

TTOT 214B /TYPEN/ INTEGER TYPE OB /TYPEC/ CHAR*3

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

TMAX INTEGER 35

-STATEMENT LABE LS- - ( LO= A

)

-LAB EL -ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 49 1000 152B FORMAT 51

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS- --

PTYPE 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

225B = 149 377B = 255

61000B = 25088

0.069 SECONDS

256
PTN 5 1+552

SUBROUTINE PUALL

84/ 03 / 1 4 . 1 0.1 8 .23 PAGE

74/175 OPT=0

50

1 SUBROUTINE PWALL

2 t*************************************************

3 **» PRINT OUT THE CONTENTS OF THE WALL AND WDIM ARRAYS

4 ******t*****************K**«*«***«******«Mt******«*

5

»

^ t*******************************************************************

7 •*« COMMON FOR DATABASE OF WALL PARAMETERS

g ttKtttut**************************************************************** COMV

INTEGER WMAX

PARAMETER (WMAX = 75)

COMMON /WALLN/ WD IM( WMAX , 3 ) , WTOT, WERR

COMMON /WALLC/ WALL(WMAX,4)

INTEGER WTOT, WERR

REAL WDIM

CHARACTER *3 WALL

9

1 0

1

1

1 2 13

1 4 15U

1718

1920

2122

2324

2528

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

49

» DESCRIPTION OF ARRAYS

WALL IDENTIFICATION

DIRECTION FROM

ROOM

TO

ROOM

WALL (X , 1

)

A3 WALL (X , 2) A3 WALL (X, 3) A3

WALL PARAMETERS

MATERIAL HEIGHT WIDTH LAYER THICKNESS

WALLC X, 4) WDIMC X, 1) WDIMC X, 2) WDIMC X, 3) A3 F8 . 2 F8 . 2 F8 . 2

WALL PARAMETERS’

INTEGER R, C

r PRINT*

PRINT *,‘WALL IDENTIFICATION

P R I NT *, '********************  t** it****«**«i <i** ii

PRINT *,’ DIR FROM TO MATERIAL HEIGHT WIDTH

PRINT *, ‘ ==================== ========================

DO 10 R = l.WTOT

PRINT 1000, (WALL(R,C) , C= 1 , 4 ) , ( WD IM (R , C) , C= 1 , 3

)

10 CONTINUE

PRINT *, =============================================

1 000 FORMAT ( 1 X , 3 ( 2X , A3 ) , 1 0 X , A3 , 1 X , 3 ( 1 X , F7 . 2 ) ) RETURN

END

PWALL 1 PWALL 2 PWALL 3 PWALL 4 PWALL 5 >COMW 1 *COMW 2 'COMW 3 COMW 4 COMW 5 COMW 6 COMW 7 COMW 8 COMW 9 COMW 1 0 COMW 11 COMW 12 COMW 13 COMW 1 4 COMW 15 COMW 16 COMW 17 COMW 18 COMW 19 COMW 20 COMW 21 COMW 22 COMW 23 COMW 24 COMW 25 COMW 26 COMW 27 'COMW 28 COMW 29 PWALL 7 PWALL 8 PWALL 9 PWALL 10 PWALL 1

1

PWALL 12 PWALL 13 PWALL 14 PWALL 15 PWALL 16 PWALL 17 PWALL 18 PWALL 19 PWALL 20 PWALL 2 1

--VARIABLE MAP--(LO=A)

-NAME---ADDRESS--BLOCK PROPERTIES TYPE SIZE

C 205B INTEGER

R 204B INTEGER

WALL OB /WALLC/ CHAR»3 300

WDIM OB /WALLN/ REAL 225

WERR 342B /WALLN/ INTEGER

WTOT 341B /WALLN/ INTEGER

257
FTN 51+552

SUBnOUTINE PWALL

84/03/1-1. 10.18.23 PAGE 74/175 OPT=0

51

-SYMBOLIC CONSTANTS--! LO:::A) -NAME TYPE

WMAX INTEGER

-STATEMENT L ABE LS- - ( LO= A

)

-LAB EL- ADDRESS PROPERTIES DEE

10 INACTIVE DO-TERM 45 1000 142B FORMAT 47

-ENTRY POINTS--(LO=A)

-NAME ADDRESS--ARGS

PWALL 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 213B

CM LABELLED COMMON LENGTH 475B

CM STORAGE USED 61000B

COMPILE TIME 0.063

VALUE

75

= 139

= 3 17

= 25088

SECONDS

258
FTN 5 U55 2 84/03/M. 10.18.23 PAGE 52 FUNCTION RCOEF 74/175 OPT=0

1

2

3

45

6

7

89 10

1112

1314

15

1 6 1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

REAL FUNCTION RCOEF (MATID , FREQ , RFLAG ) RCOEF

•[[[ CC [[ CC [[[[ C CCI [[[[ t [[ CC [[[[[[[[[[ [[[[[[[[[[[[[[[[[[[CCCICt [[[[[[[[ [[RCOEF

»[[[ [[[RCOEF

•[[[ GIVEN THE MATERIAL AND THE FREQUENCY, THIS FUNCTION RETURNS [[[RCOEF

*[[[ THE REFLECTION COEFFICIENT [[[RCOEF

•[[[ [[[RCOEF

*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[RCOEF

* FREQ IS IN HERTZ RCOEF

» HIFREQ.LOFREQ, AND F ARE IN LOG ( HERTZ ) RCOEF

» RFLAG RANGES FROM 0 TO 100 AND DETERMINES HOW MUCH OF THE QUALITY RCOEF

» FACTOR IS APPLIED TO THE REFLECTION COEFFICIENT VALUE. RCOEF

*»* COMMON FOR DATABASE OF MATERIAL PROPERTIES *»»COMM

INTEGER MMAX PARAMETER (MMAX=100)

COMMON /MATN/ MATTEN(MMAX , 7 ) , MRCOEF (MMAX , 7 )

,

5 MFREQ(MMAX,7) , MERR, MTOT

COMMON /MATC/ MAT (MMAX) .MATDESC (MMAX

)

INTEGER MTOT, MERR

REAL MATTEN, MRCOEF, MFREQ, QA , QR

CHARACTER * 3 MAT CHARACTER * 70 MATDESC

COMM

COMM

QA(MMAX), QR(MMAX), COMM

COMM

COMM

COMM

COMM

COMM

COMM

«*«****!

lililitt*itii»***t**t**tt***lili'kt**tiitli*tt*t***t*ii**t*tt RCOEF

* DECLARATION OF VARIABLES RCOEF

t*t******t*tt*iit*ii*ii**iit**it*t*t***ttmi*iit**t*t**** RCOEF

REAL FREQ, FRAC , MI NFREQ,MAXFREQ,LOFREQ, HI FREQ, LORCOEF , HI RCOEF ,F RCOEF

INTEGER R,C ,RINDEX ,CINDEX RCOEF

LOGICAL FOUND, EXACT RCOEF

CHARACTER *3 MATID RCOEF

ttr*****lt A«A** k***************«****lklk*ft***t**)k* RCOEF

* FIND ROW INDEX OF MATERIAL RCOEF

t*tt**t*t**iitii*t***iit*t**t*t*t**tt**t*ttii*****t*** RCOEF

FOUND = .FALSE. RCOEF

DO 10 R = 1, MMAX RCOEF

IF ( MAT(R) EQ. MATID ) THEN RCOEF

FOUND = .TRUE. RCOEF

RINDEX = R RCOEF

END IF RCOEF

10 CONTINUE RCOEF

IF ( .NOT. POUND ) THEN RCOEF

lERR = 3 RCOEF

CALL ERROR (lERR) RCOEF

END IF RCOEF

tt*tiit*ttint*tt****t*tt*ii*ttt*t*ii***t**itiit***t*ttiit RCOEF

* TEST FOR FREQUENCY OUT OF RANGE RCOEF

t***ttlitt***t*t*tt*tt***li*litli*lrk*li**ltitttttt*t**ttli RCOEF

MINFREQ = MFREQ (RINDEX,!) RCOEF

MAXFREQ = MFREQ (RINDEX, 7) RCOEF

IF ( FREQ .LT. MINFREQ .OR. FREQ .GT. MAXFREQ ) THEN RCOEF

lERR = 2 RCOEF

CALL ERROR (lERR) RCOEF

END IF RCOEF ************************************************** RCOEF

* IF THE EXACT FREQUENCY IS IN THE TABLE, THEN RCOEF

» USE THE REFLECTION COEFFICIENT VALUE WITHOUT INTERPOLATION. RCOEF

t****t***************»i************t*********«***** RCOEF

DO 20 C= 1,7 RCOEF

EXACT = .FALSE. RCOEF

IF ( FREQ .EQ. MFREQ (RINDEX, C) ) THEN RCOEF

1

2

3

4

5

6

7

8

9 10

1 1 12

I 3

1

2

3

4

5

6

7

8

9 10

I

I

12

1314

1516

17

1 8 1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

43

4 4 4546

4748

4950

51

259
FTN 5.1 + 5 5 2 0 4/Q3/M. 10.10.23 PACE 53 FUNCTION RCOEF 74/175 OPT=0

65 EXACT = .TRUE. RCOEF 52 66 CINDEX = C RCOEF 53 67 RCOEF = MRCOEF (RINDEX , CINDEX

)

RCOEF 54

68 RCOEF = RCOEF * ( 1 + RFLAG / 100 ) RCOEF 55 69 END IF RCOEF 56

70 20 CONTINUE RCOEF 57

71 RCOEF 58

72 * INTERPOLATE REFLECTION COEFFICIENT VALUES IF EXACT FREQUENCY IS RCOEF 59 73 * NOT IN THE FREQUENCY/REFLECTION COEFFICIENT ARRAYS. RCOEF 60

74 **i(iiiiiiiiiiiiiiii*iit*****it***tt***ii**t**it**itt**iit*ti(ttiit RCOEF 61

75 IF ( NOT. EXACT ) THEN RCOEF 62

76 DO 30 C=l,6 RCOEF 63

77 IF ( FREQ .GT. MFREQ (RINDEX, C) .AND. RCOEF 64

78 5 FREQ LT. MFREQ (RINDEX, C+1) ) THEN RCOEF 65

79 CINDEX = C RCOEF 66 80 END IF RCOEF 67

81 30 CONTINUE RCOEF 68 82 F = ALOGIO ( FREQ ) RCOEF 69 83 LOFREQ = ALOGIO ( MFREQ (RINDEX, CINDEX) ) RCOEF 70 84 HIFREQ = ALOGIO ( MFREQ (RINDEX, CINDEX + 1) ) RCOEF 71 85 LORCOEF = MRCOEF (RINDEX , CINDEX) RCOEF 72

86 HIRCOEF = MRCOEF (RINDEX , CINDEX + 1) RCOEF 73

87 FRAC = (F - LOFREQ) / (HIFREQ - LOFREQ) RCOEF 74 88 RCOEF = LORCOEF + (FRAC * (HIRCOEF - LORCOEF) ) RCOEF 75 89 RCOEF = RCOEF * ( 1 + RFLAG / 100 ) RCOEF 76

90 END IF RCOEF 77

91 RETURN RCOEF 78 92 END RCOEF 79

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK PROPERTIES TYPE - -SIZE

C 254B INTEGER

CINDEX 256B INTEGER

EXACT 260B LOGICAL

F 25 2B REAL FOUND 257B LOGICAL

FRAC 243B REAL FREQ 2 DUMMY-ARG REAL HIFREQ 247B REAL HIRCOEF 25 IB REAL

lERR 26 2B INTEGER

LOFREQ 2 4 6B REAL LORCOEF 250B REAL MAT OB /MATC/ CHAR*3 1 00 MATDESC 36B /MATC/ CHAR* 70 100 MAT ID 1 DUMMY-ARG CHAR*3

MATTEN OB /MATN/ REAL 700 MAXFREQ 2 4 5B REAL MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 7 00 MINFREQ 2 4 4B REAL MRCOEF 1 2 7 4B /MATN/ REAL 700 MTOT 4375B /MATN/ INTEGER

QA 257 0B /MATN/ REAL 1 00 QR 2 7 34B /MATN/ REAL 100

R 253B INTEGER

RCOEF 242B REAL RFLAG 3 DUMMY-ARG REAL RINDEX 255B INTEGER

260
84 / 03 / 1 4 . 1 0.1 8 .23 PAGE

74/175 OPT=0

FTN 5 1+552 54 FUNCTION RCOEF

-SYMBOLIC CONSTANTS--( LO=A) -NAME TYPE VALUE

MMAX INTEGER 100

-PROCEDURES --(LO=A)

-NAME TYPE --ARGS--- ---CLASS

ALOGIO REAL 1 INTRINSIC

ERROR 1 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

LABEL- ADDRESS--- --PROPERTIES- ---DEF

10 INACTIVE DO-TERM 44

20 INACTIVE DO-TERM 70

30 INACTIVE DO-TERM 81

ENTRY POINTS--(LO=A)

NAME-- -ADDRESS-- ARGS

RCOEF 6B 3

-STATISTICS--

PROGRAM-UNIT LENGTH 287B = 183

CM LABELLED COMMON LENGTH 5730B = 3032

CM STORAGE USED 81000B = 25088

COMPILE TIME 0.127 SECONDS

261
FTN 5.1+552 84/03/14. 10.18.23 PAGE SUBROUTINE SRCHTDB 74/175 OPT=0

55

1 SUBROUTINE SRCHTDB (ID, OATTEN , OAREA ) SRCHTDB

2 * [ It t C C C [ [ [ I C C [ C [ C C [ [ [ t [ [ t C C [ [ [ C t [ [ C C C C U t C C t [ C [ C [ [ [ C [ [ C C C [ I C C t C [ [ [ C [ [ C [ SRCHTDB

3 *111 [[[SRCHTDB

4 *[[[ GIVEN AN OPENING ID, THIS SUBROUTINE RETURNS ITS ATTENUATION [[[SRCHTDB

5 *[[[ AND AREA. [[[SRCHTDB

6 *[[[ [[[SRCHTDB

7 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ [SRCHTDB

g

* It * t 1 1 1 1 1 1 1 -k t 1 1 It * 1 1 * It t 1 1 1 1 1 1 1 it It 1 1 1 1 1 1 1 1 1 1 1 1 1 h 1 1 It t * 1 1 * t It 1 1 1 It It tt 1 1 1 1 1 1 1 1 1 QQ

9 *** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT

IQ *A***A*****!li(t***!ll[A*A:k**A*1l(*ft1i*t**Alicf(*t*A*AA*Alt**At*t*k*A**A**t*fttfMk*f(*At COMT

11 INTEGER TMAX COMT

12 PARAMETER (TMAX=35) COMT

13 COMMON /TYPEN/TDIM(TMAX,4> ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR COMT

14 COMMON /TYPEC/TYPE(TMAX,3) ,TDB1(TMAX) COMT

15 INTEGER TTOT , TDBTOT , TERR COMT

16 REAL TDIM,TDB2 COMT

17 CHARACTER * 3 TYPE,TDB1 COMT

18 »================================================= COMT

19 * DESCRIPTION OF ARRAYS COMT

20 *================================================= COMT

21 * ID MATERIAL FRAME MATERIAL COMT

22 * COMT

23 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT

24 * A3 A3 A3 COMT

25 *================================================= COMT

26 * HEIGHT WIDTH LAYER DISTANCE COMT

27 « THICKNESS ABOVE FLOOR COMT

28 * COMT

29 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT

30 * F8 . 2 F8 . 2 F8 . 2 F8 . 2 COMT

31 *================================================= COMT

32 * ID ATTENUATION AREA COMT

33 * COMT

34 * TDBKX) TDB2(X,1) TDB2(X,2) COMT

35 » A3 E9.3 E9.3 COMT

38 »*******»***»***»**************»*****»********»»*****»*********i«*»*****»C0MT

37 * COMT

38 INTEGER R SRCHTDB

39 REAL OAREA, OATTEN SRCHTDB

40 CHARACTER *3 ID SRCHTDB

41 * SRCHTDB

42 DO 10 R = 1 , TDBTOT SRCHTDB

43 IF (TDBl(R) .EQ. ID) THEN SRCHTDB

44 OATTEN = TDB2(R,1) SRCHTDB

45 OAREA = TDB2(R,2) SRCHTDB

46 RETURN SRCHTDB

47 END IF SRCHTDB

48 10 CONTINUE SRCHTDB

49 END SRCHTDB

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK-- - PROPERTIES -- -TYPE SIZE

ID 1 DUMMY-ARG CHAR«3

OAREA 3 DUMMY-ARG REAL OATTEN 2 DUMMY-ARG REAL

R 65B INTEGER

TDBTOT 32 3B /TYPEN/ INTEGER

TDBl 37E /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 140 TERR 32 4B /TYPEN/ INTEGER

TTOT 21 4B /TYPEN/ INTEGER

1

2

3

4

5

6

7

1

2

3

4

5

6

7

8

9 10

1112

1314

1516

1718

1920

2122

2324

2526

2728

2930

9

1 0 1112

1314

15

1 6 17

1 8 1920

262
FTN 5 U552 84/03/14. 10.18.23 PAGE

SUBROUTINE SRCHTDB 74/175 OPT=0

58

TYPE OB /TYPEC/

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE -VALUE

TMAX INTEGER 35

-STATEMENT LABELS- -( LO= A

)

-LAB EL -ADDRESS PROPERTIES DEE

10 INACTIVE DO-TERM 48

-ENTRY POINTS--(LO=A)

-NAME--- ADDRESS- -ARCS- --

SRCHTDB 5B 3

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

71B = 57 377B = 255

81000B = 250

0.049 SECONDS

CHAR*3 105

263
FTN 5.1 + 55 2 8 4 / 0 3 / 1 4 . 10.18.23 PAGE 57 SUBROUTINE WARNING 74/175 OPT=0

SUBROUTINE UARNING(ERR) WARNING

2 INTEGER ERR, ERRM WARNING 2

3 CHARACTER*45 MESSAGE!20) WARNING 3 4 DATA MESSAGE! 1 )/"'HOLE" DATA F ILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 4

5 DATA MESSAGE

!

2 ) / 'FILE HANDLING PROBLEM ON "HOLE" DATA FILE ' / WARNING 5

6 DATA MESSAGE! 3 //'"MATTER" FILE DOES NOT EXIST FOR THIS BLDG / WARNING 6 7 DATA MESSAGE

!

4 > / ' FILE HANDLING PROBLEM ON "MATTER FILE ' / WARNING 7

8 DATA MESSAGE! 5 //"TYPE" DATA F ILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 8

9 DATA MESSAGE

!

6 ) /

' FILE HANDLING PROBLEM ON "TYPE" FILE ' / WARNING 9

1 0 DATA MESSAGE

!

7 //'"WALL" DATA F ILE DOES NOT EXIST FOR THIS BLDG ' / WARNING 10

11 DATA MESSAGE

!

8 ) /

' FILE HANDLING PROBLEM ON "WALL" FILE ' / WARNING 1 1

1 2 DATA MESSAGE! 9 ) / 'HEIGHT AND WI DTH OF ROOM MISSING / WARNING 12 13 DATA MESSAGE! 10 //'LENGTH OF ROOM IS MISSING ' / WARNING 13

1 4 DATA MESSAGE

!

11 //'FREQ FILE DOES NOT EXIST FOR THIS BLDG • / WARNING 14 15 DATA MESSAGE

!

12 / /

' FILE HANDLING PROBLEM WITH FREQ FILE ' / WARNING 15

1 6 DATA MESSAGE! 13 //'WARNING CODE IS OUT OF RANGE ' / WARNING 16 17 DATA MESSAGE

!

14 / / 'WARNING CODE IS OUT OF RANGE ' / WARNING 17

1 8 DATA MESSAGE! 15 //'WARNING CODE IS OUT OF RANGE ' / WARNING 18 19 DATA MESSAGE! 16 /

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 19 20 DATA MESSAGE! 17 //'WARNING CODE IS OUT OF RANGE ' / WARNING 20 21 DATA MESSAGE

!

18 /

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 21 22 DATA MESSAGE! 19 //'WARNING CODE IS OUT OF RANGE ' / WARNING 22 23 DATA MESSAGE

!

20 /

/ 'WARNING CODE IS OUT OF RANGE ' / WARNING 23 24 ERRM:= 12 V/ARNING 24

25 lERR = ERR WARNING 25

26 IF(ERR GT.ERRM) IERR=20

27 WRITE(6,20)

28 WRITE(6,10) ERR , MESSAGE ( I ERR

)

29 WRITE(6,20)

30 10 FORMAT! • ***WARNING NUMBER = 31 20 FORMAT!' ') 32 RETURN

33 END

15 , , A45 )

WARNING

WARNING

WARNING

WARNING

WARNING

WARNING

WARNING

WARNING

2627

2829

3031

3233

-VARIABLE MAP--!LO=A)

-NAME ---ADDRESS --BLOCK

-PROPERTIES TYPE SIZE

ERR ERRM

lERR

MESSAGE

1 DUMMY-ARG

60B

213B

61B

INTEGER

INTEGER

INTEGER

CHAR*45 20

-STATEMENT L ABE LS- - ! LO= A

)

-LAB EL- ADDRESS PROPERTIES DEF

10 34B FORMAT

20 42B FORMAT

3031

-ENTRY POINTS--!LO=A)

-NAME ADDRESS --ARGS

WARNING 5B 1

264
FTN 5 U552 84/03/14. 10.18.2

SUBROUTINE WARNING 74/175 OPT=0

-I/O UNITS--(LO=A)

-NAME PROPERTIES

TAPE6 FMT/SEQ

-STATISTICS--

PROCRAM-UNIT LENGTH 216B

CM STORAGE USED &1000B

COMPILE TIME 0.061

3 PAGE 58

= 142

= 25088

SECONDS

265
TTN 51+552

SUBROUTINE SETUP

84/03/14 10.18.23 PAGE

74/175 OPT=0

59

1

2

3

45

6

7

B

9 10

1112

13

14

15U

1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

5152

53

SUBROUTINE SETUP SETUP

**«**<l***«l« + ««ltA*««X«****lt«I***«lt*tt**lltt*«******1t«****«(*«*«lit*******«**«**«cC0M{l *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS *»»COMR

****t**k*ittlttii*iiii*tK**tli*iili»t***l(li*li***iitl(*i(iii(iitit*iiii*********li***tfk**t* COMR

INTEGER RMAX COMR PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOM(RMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

**»***»******(Mit***********»***»*»*»«**j(***«»»*****fti!i**ts«***ft**«<[»**»sr»* COMR

*******iiii*iiii*iiiiii*tiiiiiiini*iitii***t*****iit*ii*t**t**iiii****t*t*ii****** COMJ

* COMJ

* COMMON FOR EVALUATION OF ROOM MATRIX COMJ

* COMJ

COMMON /MAT/TMAT(RMAX,RMAX) ,ENERGY(RMAX) ,POUER(6) ,FTIME COMJ

+,SWR(RMAX,6) , IDIR COMJ REAL TMAT , ENERGY , POWER , SWR COMJ

LOGICAL FTIME COMJ

* COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD

COMMON /ROOMD/DDABS<RMAX + A, RMAX + 6 ) ,DREFL, DREFLV COMD

REAL DDABS .DREFL , DREFLV COMD

t^************» >k<r** ***********Jt********************jir***************#tcOMD DATA FTIME /.TRUE./ SETUP

IF (FTIME . EQV .. FALSE . ) GOTO 500 SETUP

C*************************************************** SETUP

C* CALCULATE DIAGONAL ELEMENTS SETUP

C* ASSUME DIAGONAL ELEMENTS ARE INITIALLY ZERO SETUP

C*A*A + AltA*A******AA**A*A*AA1t1k*A*A1t1lt***1k***A*****1ltA** SETUP

DO 200 IR=1, NROOMS SETUP

DIAG =0.0 SETUP

DO 100 IC=1, NROOMS + 6 SETUP

100 DIAG =DIAG + ROOM(IR,IC) + DDABSdR.IC) SETUP

200 ROOM(IR,IR) = -DIAG SETUP

Q*t*At***AA**A«**1tA A** AtAAt**A**lkil(ik**A*AtA«*t** SETUP

C* SET FTIME FALSE SETUP

C*tAAAAAAAAAAAA**AAAAAAAAAAAA*ftA*AA*AHt*A*AAA*AA*AAA SETUP

FTIME = .FALSE. SETUP

C***)KA A** *****AAAA*****A*****AA*A*****A*A****** SETUP

SETUP

C* NOW LOAD ROOM INTO TMAT SETUP

C» NOTE THAT THE T MATRIX IS REFLECTED ABOUT THE DIAGONAL SETUP

C* WITH RESPECT TO THE ROOM MATRIX SETUP

500 DO 600 IR = 1, NROOMS SETUP

DO 600 IC = 1, NROOMS SETUP

600 TMAT(IR,IC) = ROOM(IC,IR) SETUP

RETURN SETUP

END * SETUP

1

1

2

3

4

5

6

7

3

9 10

1

2

3

4

5

6

7

8

9

1

2

3

4

5

6

7

5

6

7

8

9 10

11

1 2 13

1 4 1516

17

1 8 1920

2122

2324

2526

2728

2930

VARIABLE MAP-- ( LO=A)

NAME---ADDRESS --BLOCK------PROPERTIES TYPE SIZE

DDABS OB /ROOMD/ REAL 6 76 DIAG 1 1 4B REAL DREFL 1 2 4 4B /ROOMD/ REAL DREFLV 1 245B /ROOMD/ REAL ENERGY 6 2 0B /MAT/ REAL 20 FTIME 652B /MAT/ LOGICAL

266
FTN 5 U552 84/03/14. 10.18.23 PAGE 60 SUBROUTINE SETUP 74/175 OPT=0

1C 1 ISB INTEGER

IDIR 1 0 43B /MAT/ INTEGER

IR 112B INTEGER

NROOMS 1 2 4 4B /ROOMN/ INTEGER

POUER 644B /MAT/ REAL 6 RAREA 1 24SB /ROOMN/ REAL 20 ROOM OB /ROOMN/ REAL 676

SWR 6S3B /MAT/ REAL 1 20 TMAT OB /MAT/ REAL 400

-SYMBOLIC CONSTANTS--! LO=A> -NAME TYPE VALUE

RMAX INTEGER 20

-STATEMENT LABELS-- ( LO=A

)

-LABEL- ADDRESS--- --PROPERTI ES -DEF

100 INACTIVE DO-TERM 37 200 INACTIVE DO-TERM 38 500 53B 49 600 INACTIVE DO-TERM 51

-ENTRY POINTS--(LO=A)

-NAME-- -ADDRESS-- ARGS

SETUP 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 123B = 83 CM LABELLED COMMON LENGTH 360 3B = 1923

CM STORAGE USED 61000B = 25088

COMPILE TIME 0.074 SECONDS

267
: 5.1+552 84 / 0 3 / 1 4. 1 0. 1 8.23 PAGE 61 UNCTION DETERM 74/175 OPT=0

1 C

* * FUNCTION DETERM DETERM 1 2 C * * DETERM 2 3 c* * PURPOSE DETERM 3

4 c

* * CALCULATE THE DETERMINANT OF A SQUARE MATRIX DETERM 4

5 c* * DETERM 5

& c*» USAGE DETERM 6

7 c* * DET=DETERM( ARRAY ,NORDER) DETERM 7

8 c** DETERM 8

9 c* * DESCRIPTION OF PARAMETERS DETERM 9 10 c** ARRAY - MATRIX DETERM 10

11 c* * NORDER - ORDER OF DETERMINANKDEGREE OF MATRIX) DETERM 1 1 12 c * * DETERM 12 13 c* * COMMENTS DETERM 1 3 14 c»« THIS SUBROUTINE DESTROYS THE INPUT MATRIX ARRAY DETERM 14 15 c* * THIS ROUTINE WAS MODIFIED SO THAT THE MAXIMUM DETERM 15 16 c* * VALUE IN THE TOP ROW IS MOVED OVER TO THE DIAGONAL DETERM 16 17 FUNCTION DETERM( ARRAY, NORDER) DETERM 1 7

1 B DIMENSION ARRAY(20,*) DETERM 18 19 10 DETERM=1

.

DETERM 1 9 20 1

1

DO 50 K=1 .NORDER DETERM 20

21 c* * DETERM 2 1 22 c** INTERCHANGE COLUMNS IF DIAGONAL ELEMENT IS ZERO DETERM 22 23 c* * DETERM 23 24 21 AMAX=0 0 DETERM 24 25 JMAX---K DETERM 2 5 26 DO 25 J=K, NORDER DETERM 26 27 TMP=ARRAY(K, J) DETERM 27 28 TMP=ABS(TMP) DETERM 28 29 IF(TMP.LT.AMAX) GOTO 25 DETERM 29 30 AMAX=TMP DETERM 30

3

1

JMAX=J DETERM 3 1 32 25 CONTINUE DETERM 32

33 JrJMAX DETERM 33 34 IF(J.GT.K) GOTO 31 DETERM 34 35 AATMP = AES(ARRAY(K,K) ) DETERM 35 36 IF (AATMP GE. l.OE-05) GOTO 41 DETERM 36

37 30 DETERM =0

.

DETERM 37 38 GOTO 60 DETERM 38 39 31 DO 34 UK, NORDER DETERM 39 40 SAVE=ARRAY (I , J) DETERM 40

41 ARRAY! I , J) =ARRAY( I , K) DETERM 41 42 34 ARRAY! I ,K)=SAVE DETERM 42 43 DETERM=-DETERM DETERM 43

44 c** DETERM 44 45 c* * SUBTRACT ROW K FROM LOWER ROWS TO GET DIAGONAL MATRIX DETERM 45 46 c** DETERM 46 47 41 DETERM:=DETERM*ARRAY !K , K) DETERM 47 48 IF !DETERM . EQ . 0 . 0) RETURN DETERM 48

49 IF!K-NORDER> 43,50,50 DETERM 49 50 43 KUK+1 DETERM 50

51 DO 46 UKl .NORDER DETERM 51 52 DO 46 J=K1, NORDER DETERM 52 53 46 ARRAY! I , J)=ARRAY! I ,J) -ARRAY! I ,K) *ARRAY!K, J) /ARRAY!K,K) DETERM 53 54 50 CONTINUE DETERM 54 55 60 RETURN DETERM 55 56 END DETERM 56

268
rTN 5 1+552 84/03/14 . 10.18. 23 PAGE 42 FUNCTION DETERM 74/175 OPT = 0

-VARIABLE MAP-- (LO=A) -NAME ADDRESS --BLOCK PROPERTI ES -TYPE

AATMP 2 2 2B REAL

AMAX 215B REAL ARRAY 1 DUMMY-ARG REAL DETERM 212B REAL

I 22 3B INTEGER

J 217B INTEGER

UMAX 2 1 6B INTEGER

K 21 3B INTEGER

K1 22&B INTEGER

NORDER 2 DUMMY-ARG INTEGER

SAVE 22SB REAL

TMP 221B REAL

-PROCEDURES --(LO=A)

-NAME TYPE -ARCS- - ---CLASS

ABS GENERIC 1 INTRINSIC

-STATEMENT LABELS--( LO=A) LABEL- ADDRESS --PROPERTIES-- -DEF -LABEL -ADDRESS- ---PROPERTIES- ---DEF

10 *NO REFS* 19 34 INACTIVE DO-TERM 42

11 *NO REFS* 20 41 124B 47

21 »NO REFS* 24 43 INACTIVE 50 25 44B DO-TERM 32 44 INACTIVE DO-TERM 53 30 *NO REFS* 37 50 20 0B DO-TERM 54

31 71B 39 40 205B 55

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

DETERM 4B 2

-STATISTICS--

PROGRAM-UNIT LENGTH 233B = 155 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.111 SECONDS

269
riN b . 1 + 5 5 2 SUBROUTINE ECALC

84 / 03 / 14 . 10.18.23 PAGE 63 74/175 OPT=0

1

2

3

4

5

6

7

8

7

1 0

1

1

12

1314

1516

1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

49

5 0 3 0 0

SUBROUTINE ECALC

DIMENSION PVECTOR(20)

REAL NUM

LOGICAL TLOW

ECALC

ECALC

ECALC

ECALC

* * * * * It * * * * * * ** t * * » * * * * * * * t** * * * * t * * t * * * * * *» * t ** tt*** * * * * * * * t * * * * * ** t * * t * *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF V/ALLS ***COMR

* * * * * * * * * * n * * * * n 1 1 k 1 1 1 * * * t * 1 1 h * * * * * * * * H * * t * 1 1 * t * * t It h 1 1 * * * t * t * t * * t * * t * * * t INTEGER RMAX COMR PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOMIRMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

k It k k k 1 1 * t k * It It It t t it k t k * k It k k It k It * k t k k k k k k t k k k k k It t k k k * 1 1 1 it k k * k * k t k k * k k * k * * k k *

k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk

k

* COMMON FOR EVALUATION OF ROOM MATRIX

tkt'kKt'ktt'ktttKK'ktKt'kttKHtt'kttt'kt'klitlitimtttttmdittttttHttiittt'klildit*

COMMON /MAT/TMAT(RMAX,RMAX) , ENERGY ( RMAX ) ,POWER(6) ,FTIME

+,SWR(RMAX, 6) , IDIR REAL TMAT , ENERGY , POWER , SWR

LOGICAL FTIME

tliil'ktit'kt'kt'kt'kif'kidl'kat'kil'kt'ktil'ktttt'kttimiit'kttt'k'kit'k'kt'k

* CALCULATE THE ENERGY BALANCE IN THE ROOMS

*

* CALCULATE THE DENOMINATOR TERM

CALL SETUP

DENOM=DETERM( TMAT, NROOMS)

IF(DENOM) 100,50,100 **************************************************

* ERROR # 4: DENOMINATOR = 0.

5152

5354

5556

5758

5960

6162

6364

5 0 I ERR = 4 CALL ERROR(IERR)

RETURN **************************************************

» CALCULATE THE INPUT POWER VECTOR TO EACH ROOM **************************************************

100 TLOW=.TRUE.

DO 300 ICOL = 1 , NROOMS

SUM =0.0

DO 200 IPUR = 1,6 IROV = IPWR + NROOMS

200 SUM = SUM + POWER(IPWR) * ROOM(IROW,1

PVECTOR( ICOL) = - SUM

IF (SUM.GT. (1 . OE-06)) TLOW= . FALSE

.

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

* CHECK IF INPUT POWER IS TOO LOW **************************************************

IF (TLOW. NEQV. TRUE . ) GOTO 350 **************************************************

* INPUT TOO LOW **************************************************

DO 310 ICOL=l , NROOMS

310 ENERGY! ICOL) = l . OE-05

RETURN **************************************************

* SET UP NUMERATORS **************************************************

* RENEW TMATRIX

2

3

4

5

67

8

9 10 COMJ 1 COMJ 2 COMJ 3 COMJ 4 COMJ 5 COMJ 6 COMJ / COMJ 8 COMJ 9 ECALC 7 ECALC 8 ECALC 9 ECALC 10 ECALC 11 ECALC 1 2 ECALC 13 ECALC 1 4 ECALC 15 ECALC 1 6 ECALC 17 ECALC 18 ECALC 19 ECALC 20 ECALC 21 ECALC 22 ECALC 23 ECALC 24 ECALC 25 ECALC 26 ECALC 27 ECALC 28 ECALC 29 ECALC 30 ECALC 31 ECALC 32 ECALC 33 ECALC 34 ECALC 35 ECALC 36 ECALC 37 ECALC 36 ECALC 39 ECALC 40 ECALC 41 ECALC 42 ECALC 43 ECALC 44 ECALC 45 ECALC 46 ECALC 47

270
FTN 5 U552 84/ 03 / 1 4. 10.18.23 PAGE 64 SUBROUTINE ECALC 74/175 OPT=0

65 AAAAAAAAAAA ECALC 48 66 350 DO 500 ICOL = l.NROOMS ECALC 49 67 CALL SETUP ECALC 50

68 * AAAAAAAAAAA ECALC 51 69 t PUT PVECTOR INTO PROPER COLUMN ECALC 52

70 t A************************************* AAAAAAAAAA* ECALC 53

71 DO 400 IROW = l.NROOMS ECALC 54 72 400 TMAT( IROW, ICOL) = PVECTOR ! IROW) ECALC 55 73 t AAAAAAAAAAAAAAAAAAAAAA**************** AAAAAAAAAAA ECALC 56

74 t NOW CALCULATE THE ENERGY FOR THE ROOM REPRESENTED ECALC 57

75 A BY ICOL ECALC 58

76 A AA*A*AAA*A*AAAA*A**AAA**AAA*A*AAAAAAAA AAAtAAAAAAA ECALC 59

77 NUM = DETERM(TMAT,NROOMS) ECALC 60 78 ENERGY! ICOL) = NUM/DENOM ECALC 61 79 500 CONTINUE ECALC 62 80 RETURN ECALC 63

81 END ECALC 64

-VARIABLE MAP--(LO=A)

NAME ADDRESS- -BLOCK --PROPERTIES TYPE ---SIZE

DENOM 213B REAL ENERGY 620B /MAT/ REAL 20 FTIME 652B /MAT/ LOGICAL

ICOL 215B INTEGER

IDIR 1 043B /MAT/ INTEGER

lERR 214B INTEGER

IPWR 220B INTEGER

IROW 222B INTEGER

NROOMS 1244B /ROOMN/ INTEGER

NUM 21 IB REAL POWER 644B /MAT/ REAL 6 PVECTOR USB REAL 20 RAREA 124SB /ROOMN/ REAL 20 ROOM OB /ROOMN/ REAL 676

SUM 217B REAL

SWR 653B /MAT/ REAL 120 TLOW 212B LOGICAL

TMAT OB /MAT/ REAL 400

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

RMAX INTEGER 20

-PHOCEDURES--(LO=A)

-NAME TYPE ARGS — CLASS

DETERM REAL 2 FUNCTION

ERROR 1 SUBROUTINE

SETUP 0 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

LABEL- ADDRESS --PROPERTIES- ---DEF -LABEL -ADDRESS --PROPERTIES--- -DEF

50 INACTIVE 37 3 10 INACTIVE DO-TERM 59 100 22B 43 350 107B 66 200 INACTIVE DO-TERM 48 400 INACTIVE DO-TERM 72 300 INACTIVE DO-TERM 50 500 INACTIVE DO-TERM 79

271
FTN 5.1+552 84/03/14. 10.18.23 PAGE 65 SUBROUTINE ECALC 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS- --

ECALC 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 230B = 152 CM LABELLED COMMON LENGTH 2 335B = 1245 CM STORAGE USED 61000B = 2508B

COMPILE TIME 0.101 SECONDS

272
FTN 5 1+552

SUBROUTINE PPWR

84 /03 / 1 <1 . 10.18 .23 PAGE

74/175 OPT=0

1

2

3

45

67

89

1 0

1

1

12

1314

15U

1718

19 20

2122

2324

2526

2728

2930

3132

3334

3538

3738

3940

4142

4344

4546

4748

4950

SUBROUTINE PPWR PPWR

**» COMMON FOR INITIAL PARAMETERS ***COMF

**«i*******fiik<i<i«ik«iti«**«i «** **t**it*«<i««it*«[*****ii*4i*«****)k******* + *x + t)*cOMF

INTEGER FMAX COMF

PARAMETER (FMAX = 50) COMF

COMMON /INITILN/ FREQ, QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR, COMF

$ FTOT COMF

COMMON /INITILC/ BLDG COMF

CHARACTER * 5 BLDG COMF

REAL FREQ, AFLAC, RFLAG, FREQA COMF

INTEGER QUALITY, FERR, FTOT COMF

*K*A**tit)tttt**k*4Ml******lk<tltA*1t***lt***)l iit** i*A*<ilt*il(*lk*tk1l:***4iA*******)tA*k(20^F

t*****lt*t*t***1tt*t**t1i*1tt********1it1tt*1t****t*'k***tiiit1i**tttt*******t*tt* * COMR

*** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOM (RMAX + 6, RMAX +6), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

***** « * I ************************************************************************ COMR **************************************************************** COM

J

* COMJ

* COMMON FOR EVALUATION OF ROOM MATRIX COMJ

» COMJ **************************************************************** COMJ

COMMON /MAT/TMAT(RMAX,RMAX) ,ENERGY(RMAX) ,POWER(6) ,FTIME COMJ

+,SWR(RMAX,6) ,IDIR COMJ

REAL TMAT , ENERGY , POWER , SWR COMJ

LOGICAL FTIME COMJ

REAL DB PPWR WRITE!*, 20) FREQ PPWR

20 FORMAT (/" POWER BY DIRECTION 1-6 AT A FREQUENCY OF",1PE10.3," PPWR

+H2") PPWR WRITE (*,30) (POWER(I) ,1=1 ,6) PPWR

30 FORMAT ( " 1 2 3 4 5 PPWR

+ 6", /," ********************************************************* PPWR

+ *****",/, 6( 3X , F7 . 2) , / , ) WRITE (*,40)

40 FORMAT!" ROOM ENERGY DB ",/,

4. "***************************************")

DO 100 ICOL=l , NROOMS

DB=10.0 * ALOGIO ( ENERGY! ICOL) / 10. ) 100 WRITE!*, 50) ICOL, ENERGY (ICOL), DB

50 FORMAT! 3X , I 3 , 5X ,

F

10 . 2 , 5X , F 1 0 . 2 ) RETURN

END

PPWR

PPWR

PPWR

PPWR PPWR

PPWR PPWR

PPWR PPWR

PPWR

1

1

2

3

4

5

6

78

9

1 0 1112

13

1

23

45

6

7

89 10

1

2

3

45

6

7

8

9

5

6

7

8

9 10

1112

1314

1516

1718

1920

21

-VARIABLE MAP-- (LO=A)

-NAME---ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

AFLAG 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

DB 147B REAL ENERGY 620B /MAT/ REAL 20 FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTIME 6S2B /MAT/ LOGICAL

FTOT 67B / INITILN/ INTEGER

273
FTN 5.1+552 84/03/14. 10.18.23 PAGE 47 SUBROUTINE PPWR 74/175 OPT=0

I 150B INTEGER

ICOL 151B INTEGER

IDIR 1 043B /MAT/ INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

POWER 444B /MAT/ REAL 4 QUALITY IB / INITILN/ INTEGER RAREA 1 245B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 474 SWR 453B /MAT/ REAL 1 20 TMAT OB /MAT/ REAL 400

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20

-PROCEDURES--(LO=A)

-NAME TYPE ARGS CLASS

ALOGIO REAL 1 INTRINSIC

-STATEMENT LABELS-- ( LO=A

)

-LABEL- ADDRESS-- ---PROPERTI ES -DEF

20 55B FORMAT 34

30 45B FORMAT 39 40 105B FORMAT 43

50 117B FORMAT 48 100 INACTIVE DO-TERM 47

-ENTRY POINTS--(LO=A)

-NAME-- -ADDRESS- -ARGS

PPWR 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

155B = 109

2426B = 1302

61000B = 25088

0.075 SECONDS

274
FTN 5 1+552

SUBROUTINE PTMAT

84 / 03 / 1 4 . 1 0 .1 8.23 PAGE

74/175 OPT=0

68

1 SUBROUTINE PTMAT

2 C»* PRINTOUT THE CONTENTS OF THE ROOM MATRIX

3 *•**««*««***«**

4 »»* COMMON FOR INITIAL PARAMETERS

5

* « * It *

6 INTEGER FMAX

7 PARAMETER (FMAX = 50)

8 COMMON /INITILN/ FREQ, QUALITY

$ FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG

REAL FREQ, AFLAC, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

AFLAC, RFLAG, FREQA(FMAX), FERR,

9

1 0 11

1 2 1314 »«

15U

1716

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

PTMAT

PTMAT

***COMF

COMF

COMF

COMF

COMF

COMF

COMF

COMF

COMF

< * : ****ltlt*ltlt*ltltft*<ilt*ltlt**ll****lt*ltltltit*«tt**ltltt*tt***lt<I**l[*lt**tlt*ltlt*****k*lkltlt*A*QO]^{{

COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS »**COMR

INTEGER RMAX PARAMETER (RMAX = 20)

COMMON /ROOMN/ ROOM(RMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX)

INTEGER NROOMS

REAL ROOM

***itititit*it*)titA*(iititit*A**it*it*i**iitititii*ititiiititititit**ititiii*it)t**«ii(*ii*it)tit*it**ititiiiiitiiit*it CO MR

lttttlt4ltt1llltltltltltlt***A*ltltltlt*]tltllltltttllttttltAII**lt<tltltllltlMI*ltIklI*«lt*1t*lllt*«IIIIIlltll

«

* COMMON FOR EVALUATION OF ROOM MATRIX

«1i1it*****1i*t**ii**1i*t*1i1i1i*ii*1it*1i**tiit1tt1it1i*1i1i****i(tt1t**ti(**li**t1i*t

COMMON /MAT/TMAT( RMAX, RMAX) , ENERGY ( RMAX ) ,POWER(6) ,FTIME

+ ,SWR(RMAX , 6 )

, IDIR REAL TMAT , ENERGY , POWER , SWR

LOGICAL FTIME

INTEGER R,C

PRINT*

PRINT*,' TMAT MATRIX VALUES ' PRINT*,' AT FREQUENCY = ',FREQ,' HERTZ'

COMR

COMR

COMR

COMR

COMR

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

COMJ

PTMAT

PTMAT

PTMAT

PTMAT

PRINT* ,

^tttt*********

<

DO 10 R = 1, NROOMS

PRINT 100 , (TMAT(R,C)

,

10 CONTINUE

C = 1, NROOMS )

i»********it***»*» * PTMAT

PTMAT

PTMAT

PTMAT

PTMAT

PRINT* ,

' ==================================== ======================PTMAT =============' PTMAT

PTMAT

PTMAT

PTMAT

100 FORMAT! IX , 12 (E 12 . 6) RETURN

END

1

2

1

2

3

45

6

7

8

9 10

1 1 1213

1

2

3

4

5

6

7

8

9 10

1

2

3

4

5

67

8

9

6

7

8

9 10

1112

13

1 4 15

1 6 17

1 8 19

VARIABLE MAP-- (LO=A)

NAME---ADDRESS --BLOCK PROPERTIES - --TYPE SIZE

AFLAC 2B 1 INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C 146B INTEGER

ENERGY 620B /MAT/ REAL 20 FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTIME 6S2B /MAT/ LOGICAL

FTOT 67B / INITILN/ INTEGER

IDIR 1 043B /MAT/ INTEGER

NROOMS 1244B /ROOMN/ INTEGER

275
FTN b. 1 + 5 5 2 84/03/14. 10.18.23 PAGE 69 SUBROUTINE PTMAT 74/175 OPT=0

POWER 6 44B /MAT/ REAL 6 QUALITY IB / INITILN/ INTEGER

R 145B INTEGER RAREA 1 245B /ROOMN/ REAL 20 HFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 676

SWR 653B /MAT/ REAL 120 TMAT OB /MAT/ REAL 4 00

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20

-STATEMENT LABELS--! LO=A)

-LAB EL -ADDRESS PROPERTI ES DEF

10 INACTIVE DO-TERM 43 100 113B FORMAT 46

-ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARGS---

PTMAT 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

153B = 107 2426B = 1302

61000B = 25088

0.068 SECONDS

276
TTN 5 1+552 84/03/14. 10.18.23 PAGE

SUBROUTINE DFACTOR 74/175 OPT=0

70

1 SUBROUTINE DFACTOR DFACTOR

2

* t t****t**tii*****tt****ttt*tt*tiittt***t tut** ****** tt**t *****%******

3 •»» COMMON FOR INITIAL PARAMETERS **«COMF

5 INTEGER FMAX COMF

i PARAMETER (FMAX = 50) COMF

7 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF

e $ FTOT COMF

9 COMMON /INITILC/ BLDG COMF

10 CHARACTER * 5 BLDG COMF

11 REAL FREQ, AFLAG, RFLAG, FREQA COMF

12 INTEGER QUALITY, FERR, FTOT COMF

13 «*il*««ll<Ml*X«**lt***«**********)t ttfktt** **D*lt***lkltlk***1kA***lk******ttlt)ttt)t<iltCOt^p

U »»» COMMON FOR DATABASE OF LOCATIONS OF DOORS AND WINDOWS ***COMH

18 INTEGER HMAX COMH

19 PARAMETER (HMAX = 35) COMH

20 COMMON /HOLEN/ HTOT, HERR COMH

21 COMMON /HOLEC/ HOLE(HMAX,4) COMH

22 INTEGER HTOT, HERR COMH

23 CHARACTER * 3 HOLE COMH

24 * ================================================== COMH

25 • DESCRIPTION OF ARRAYS COMH

26 » ================================================== COMH

27 * ROOM IDENTIFICATION APERTURE ID COMH

28 * COMH

29 * DIRECTION FROM ROOM TO ROOM COMH

30 » COMH

31 * HOLE(X,l) HOLE(X,2) HOLE(X,3) HOLE(X,4) COMH

32 » A3 A3 A3 A3 COMH

36 *** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS **»COMT

38 INTEGER TMAX COMT

39 PARAMETER (TMAX=35) COMT

40 COMMON /TYPEN/TDIM(TMAX, 4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR COMT

41 COMMON /TYPEC/TYPE(TMAX, 3) ,TDB1 (TMAX) COMT

42 INTEGER TTOT , TDBTOT , TERR COMT

43 REAL TDIM,TDB2 COMT

44 CHARACTER * 3 TYPE.TDBl COMT

45 *================================================= COMT

46 * DESCRIPTION OF ARRAYS COMT

47 *================================================= COMT

48 * ID MATERIAL FRAME MATERIAL COMT

49 * COMT

50 *TYPE(X,1) TYPE(X,2) TYPE(X,3) COMT

51 * A3 A3 A3 COMT

52 »================================================= COMT

53 * HEIGHT WIDTH LAYER DISTANCE COMT

54 * THICKNESS ABOVE FLOOR COMT

55 * COMT

56 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT

57 » F8.2 F8.2 F8 . 2 F8 . 2 COMT

58 *================================================= COMT

59 * ID ATTENUATION AREA COMT

60 * COMT

61 * TDBl(X) TDB2(X,1) TDB2(X,2) COMT

62 * A3 E9.3 E9 . 3 COMT

^3 ***«*«*«**********«*«***)k**********tk« )Mt** *****«i*»**««t**«**t«t««*** *COMT

84 ************************************************************************ COMT

1

1

2

3

4

5

67

8

9 10

1112

13

1

2

3

4

5

6

7

8

9 10

1 1 1213

1415

1617

1819

20

1

2

3

4

5

6

7

89 10

1 1 1213

1415

1617

1819

20

21

2123

2425

2627

2829

30

277
FTN 5.1+552 84/03/14, 10.10.23 PAGE 71 SUBROUTINE DFACTOR 74/175 OPT=0

6 5 **»**«**»***********»***»»*»»»*»»****************«» »** »**»**,»,,**,

66 *** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

6 7 ***»***»**«********»**»»***»*»*»*******»*»»********»»*»»***»» ,** ,,

68 INTEGER RMAX COMR

69 PARAMETER (RMAX = 20) COMR

70 COMMON /ROOMN/ ROOM (RMAX + 6, RMAX +6), NROOMS , RAREA(RMAX) COMR

71 INTEGER NROOMS COMR

72 REAL ROOM COMR

73 t********************************************************************** * COMR

74 *********************************************«r********«t*****itt**********cOMR

75 «* *************************** ***************************** **********  C0MV

76 ** * COMMON FOR DATABASE OF WALL PARAMETERS ***COMW

77 ***************** ****************************************************** *cOMW

78 INTEGER WMAX COMW

79 PARAMETER (WMAX = 75) COMW

80 COMMON /WALLN/ WD IN ( WMAX , 3 ) , WTOT, WERR COMW

81 COMMON /WALLC/ WALL(WMAX,4) COMW

82 INTEGER WTOT, WERR COMW

83 REAL WDIN COMW

84 CHARACTER *3 WALL COMW

85 * ================================= COMW

86 ** DESCRIPTION OF ARRAYS COMW

87 * ================================= COMW

88 * WALL IDENTIFICATION COMW

89 * COMW

90 * DIRECTION FROM TO COMW

91 * ROOM ROOM COMW

92 * COMW

93 * WALL(X,1) WALL(X,2) WALL(X,3) COMW

94 * A3 A3 A3 COMW

95 * ========================================================= COMW

96 * WALL PARAMETERS COMW

97 * COMW

98 * MATERIAL HEIGHT WIDTH LAYER THICKNESS COMW

99 * COMW

100 * WALL(X,4) VDIM(X,1) WDIM(X,2) WDIN(X,3) COMW

101 * A3 F8.2 F8.2 F8 . 2 COMW

102 ********************************************** ************************«*C0MW

103 «*A*A1h1kA«jtA***««*«***]lr*«***ft**«ft***AftA*)k««***lkt**Jt«***A**tA*A**«*A1tfl*** *COMW

104 **A«*******t*«**AA******«***«******ftA*******«*«*«**«*«***«*lt**«*ft*t*«*ft* COMD

105 * COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD

106 **ft*A**A A** *ft«t*A*ft*A**AtMt*****ft***ftft*A***ft*****tAftt1k*A**1t*A**tlt**** * COMD

107 COMMON /ROOMD/DDABS(RMAX + 6, RMAX + 6 ) ,DREFL, DREFLW COMD

108 REAL DDABS ,DREFL , DREFLW COMD

109 ************************************************************************COMD

110 *********************************************************************** * COMD

111 INTEGER NEXT, LAST, R, ROW DFACTOR

112 REAL AFACTOR ,DREFLT DFACTOR

113 REAL WATTEN,LATTEN,OATTEN,MATTEN,ATTEN,T,S,TS,TS2 DFACTOR

114 REAL HEIGHT, WIDTH, AREA, OAREA,WAREA DFACTOR

115 CHARACTER * 3 FROM, TO, MAT, ID DFACTOR

116 LOGICAL NEWWALL,WALLEND DFACTOR

117 *** DFACTOR

118 *** THIS ROUTINE CALCULATES THE ABSORPTION OF THE WALL AND EACH DFACTOR

119 *** OPENING IN THE WALL, LAYER BY LAYER, AND THEN CALCULATES THE DFACTOR

120 *** COMPOSITE ABSORPTION BY WEIGHTING BY AREA EACH OPENING'S ABSORPTION DFACTOR

121 *** AND THE WALL ABSORPTION. DFACTOR

122 »** FOR REFLECTIONS, THE ABSORPTION IS DECREASED BY "DREFL" IF DFACTOR

123 *** THE WALL HAS A REFLECTION COEFFICIENT GREATER THAN 0.80 AND DFACTOR

124 *** THE ROOM HAS A RESONANCE. DFACTOR

125 *** DFACTOR

126 *** VARIABLE DEFINITIONS; DFACTOR

127 *** DREFLT: EQUALS DREFL IF RESONANCE, OTHERWISE ZERO DFACTOR

128 *** IT REPRESENTS REFLECTION GAINS DFACTOR
fTN 5 1+552 84/03/14. 10.18.23 PAGE

SUBROUTINE DFACTOR 74/175 OPT=0

72

1 27 t t « WATTEN. WALL ATTENUATION DFACTOR 26 130 « t t OATTEN: OPENING ATTENUATION DFACTOR 27 131 « A t LATTEN: LAYER ATTENUATION DFACTOR 28 132 ttt MATTEN: MATERIAL ATTENUATION DFACTOR 29 133 tun MAT: MATERIAL IDENTIFICATION DFACTOR 30 134 t tt WALL: WALL ARRAY CONTAINING WALL IDENTIFICATION AND MATERIAL DFACTOR 31 135 1 1

1

WDIM: WALL ARRAY CONTAINING PHYSICAL DIMENSIONS OF THE WALL DFACTOR 32

1 38 1 1

1

WMAX: MAXIMUM SIZE OF WALL AND WDIM ARRAYS DFACTOR 33 137 t tt WTOT: TOTAL LINES OF DATA IN THE THE WALL AND WDIM ARRAYS. DFACTOR 34 138 t tt HEIGHT; HEIGHT OF WALL DFACTOR 35 139 1 1

1

WIDTH: WIDTH OF WALL DFACTOR 36 140 t tt T: THICKNESS OF WALL DFACTOR 37 141 1 1

1

AREA: AREA DFACTOR 38

1 42 ttt WAREA: TOTAL WALL AREA WITHOUT SUBTRACTING OPENINGS. DFACTOR 39 143 ttt OAREA: TOTAL AREA OF THE OPENINGS. DFACTOR 40 144 ttt NEWWALL: TRUE IF DATA LINE BELONGS TO A NEW WALL DFACTOR 41 145 ttt WALLEND. TRUE IF DATA LINE IS THE LAST DATA LINE OF A WALL DFACTOR 42 146 ttt DFACTOR 43 147 DO 10 R = l,WTOT DFACTOR 44 148 ttt DFACTOR 45 149 t * t SET WALLEND CONDITION DFACTOR 46 150 NEXT = R + 1 DFACTOR 47 151 IF (R .EQ. WTOT) THEN DFACTOR 48 152 WALLEND = .TRUE. DFACTOR 49 153 ELSE IF ( WALL(R,2) .NE. WALL(NEXT,2) .OR. DFACTOR 50 154 Z WALL(R,3) .NE. WALL(NEXT,3) ) THEN DFACTOR 51 155 WALLEND = .TRUE. DFACTOR 52 156 ELSE DFACTOR 53 157 WALLEND = .FALSE. DFACTOR 54 158 END IF DFACTOR 55 159 ttt DFACTOR 56 160 ttt SET NEWWALL CONDITION DFACTOR 57

16 1 LAST = R - 1 DFACTOR 58 162 IF (R .EQ. 1) THEN DFACTOR 59 163 NEWWALL = .TRUE. DFACTOR 60 164 ELSE IF { WALL(R,2) .NE. WALL(LAST,2) .OR. DFACTOR 61 165 Z WALL<R,3) .NE. WALL(LAST,3) ) THEN DFACTOR 62 166 NEWWALL = TRUE. DFACTOR 63 167 ELSE DFACTOR 64 168 NEWWALL = .FALSE. DFACTOR 65 169 END IF DFACTOR 66 170 ttt DFACTOR 67

17 1 ttt CALCULATE DFACTOR 68 172 IF (NEWWALL) THEN DFACTOR 69 173 C* ..INITIALIZE WALL CONDITIONS DFACTOR 70 174 DREFLT =0.0 DFACTOR 71 175 TS = 0 DFACTOR 72 176 TS2 = 0 DFACTOR 73 177 WATTEN = 0 DFACTOR 74 178 END IF DFACTOR 75 179 Ik A * ..CALCULATE ATTENUATION FACTOR OF LAYER DFACTOR 76 180 MAT = WALL (R, 4) DFACTOR 77 181 MATTEN = ATTEN (MAT , FREQ , AF LAG

)

DFACTOR 78 182 CALL RESONW (WALL (R, 2) , MAT) DFACTOR 79 183 IF(DREPL.GT.O. 0) DREFLT = DREFL DFACTOR 80 184 LATTEN = MATTEN * WDIH(R,3) DFACTOR 81 185 ttt ..CALCULATE RUNNING AFACTOR OF WALL DFACTOR 82 186 WATTEN = WATTEN + LATTEN DFACTOR 83 187 IF (WALLEND) THEN DFACTOR 84 188 FROM = WALL(R,2) DFACTOR 85 189 TO = WALL(R, 3) DFACTOR 86 190 ttt ...CALCULATE WEIGHTED AFACTOR OF OPENINGS DFACTOR 87 191 ttt ...AND TOTAL AREA OF OPENINGS DFACTOR 88 192 OAREA = 0 DFACTOR 89

279
5.1+552 84/03/14. 10.18.23 PAGE 73 OUT INE DFACTOR 74/175 OPT=0

1 93 DO 20 ROW = 1, HTOT DFACTOR 90 194 IF (HOLE(ROW,2) . EQ . FROM .AND. HOLE(ROW,3) .EQ. TO) THEN DFACTOR 91 195 ID = HOLE(ROW,4> DFACTOR 92 196 CALL SRCHTDBdD, OATTEN.AREA) DFACTOR 93 197 OAREA = OAREA + AREA DFACTOR 94 198 IF (OATTEN .LE. 120) THEN DFACTOR 95 199 T = 1.0 - 10*»( -OATTEN / 10 ) DFACTOR 96 200 ELSE DFACTOR 97 20 1 T = 1 . 0 DFACTOR 98 202 END IF DFACTOR 99 203 S = AREA DFACTOR 100 204 TS = TS + T » S DFACTOR 1 01 205 TS2 = TS2 + T * S * S DFACTOR 102 206 END IF DFACTOR 1 03 207 20 CONTINUE DFACTOR 104 208 * «* ...CALCULATE TOTAL WALL AREA DFACTOR 1 05 209 HEIGHT = UDIM(R, 1) DFACTOR 106

2 10 WIDTH = WDIM(R,2) DFACTOR 107 211 WARE A = HEIGHT * WIDTH DFACTOR 108 212 S = WAREA - OAREA DFACTOR 1 09 213 IF (WATTEN .LE. 12 0. ) THEN DFACTOR no

214 T = 1.0 - 10** (-WATTEN / 10) -DREFLT DFACTOR 1 11 215 ELSE DFACTOR 112 216 T = 1 . 0 - DREFLT DFACTOR 1 13 217 END IF DFACTOR 114 218 IFCT.LT.O .0) T=0 .0 DFACTOR 1 15 219 ttt ...CALCULATE COMPOSITE ATTENUATION FACTOR OF WALL DFACTOR 116 220 TS = TS + T * S DFACTOR 1 17 22 1 TS2 •= TS2 + T * S * S DFACTOR 118 222 tut ...INSERT COMPOSITE ATTENUATION OF WALL INTO ROOM MATRIX DFACTOR 1 19 223 CALL LDDABS (TS , TS2 , FROM , TO

)

DFACTOR 120 224 END IF DFACTOR 1 21 225 10 CONTINUE DFACTOR 122 226 RETURN DFACTOR 1 23 227 END DFACTOR 124

VARIABLE MAP-- (LO=A)

NAME---ADDRESS --BLOCK -PROPERTIES TYPE

AFACTOR NONE UNUSED/*S* REAL AFLAG 2B / INITILN/ REAL

AREA 446B REAL BLDG OB / INITILC/ CHAR*5

DDABS OB /ROOMD/ REAL DREFL 1 244B /ROOMD/ REAL DREFLT 433B REAL DREFLW 1 245B /ROOMD/ REAL

FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL FROM 45 IB CHAR*3

FTOT 67B / INITILN/ INTEGER

HEIGHT 444B REAL

HERR IB /HOLEN/ INTEGER

HOLE OB /HOLEC/ CHAR*3

HTOT OB /HOLEN/ INTEGER

ID 454B CHAR*3

LAST 430B INTEGER LATTEN 435B REAL MAT 45 3B CHAR*3

MATTEN 437B REAL NEWWALL 455B LOGICAL NEXT 42 7B INTEGER

-SIZE

6U

50

140

280
TTN 5 U552 84/03/14. 10,18.23 PAGE 74 SUBROUTINE DFACTOR 74/175 OPT=0

NROOMS 1 2 4 4B /ROOMN/ INTEGER

OAREA 44 7B REAL OATTEN 436B REAL QUALITY IB / INITILN/ INTEGER

R 43 IB INTEGER

RAREA 1 2 4 5B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL

ROOM OB /ROOMN/ REAL 676

ROW 43 2B INTEGER

S 44 IB REAL

T 44 0B REAL TDBTOT 32 3B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 215B /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 140 TERR 32 4B /TYPEN/ INTEGER

TO 45 2B CHAR*3

TS 442B REAL

TS2 44 3B REAL TTOT 21 4B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3 105 WALL OB /WALLC/ CHAR*3 300

WALLEND 45 6B LOGICAL

VAREA 45 0B REAL WATTEN 43 4B REAL WDIM OB /WALLN/ REAL 225

WERR 34 2B /WALLN/ INTEGER

WIDTH 44 5B REAL WTOT 34 IB /WALLN/ INTEGER

-SYMBOLIC CONSTANTS-- (LO=A) -NAME-- --TYPE VALUE

FMAX INTEGER 50 HMAX INTEGER 35 RMAX INTEGER 20 TMAX INTEGER 35 WMAX INTEGER 75

-PROCEDURES--(LO=A)

-NAME TYPE --ARGS CLASS

ATTEN REAL 3 FUNCTION

LDDABS 4 SUBROUTINE

RESONW 2 SUBROUTINE

SRCHTDB 3 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

-LABEL-ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 225

20 INACTIVE DO-TERM 207

/

281
FTN 5.1 + 55 2 84 / 03 /M. 10.18.23 PAGE 75 SUBROUTINE DFACTOR 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ADDRESS-- ARCS

DFACTOR 5B 0

-STAT1STICS--

PROGRAM-UNIT LENGTH 463B = 307

CM LABELLED COMMON LENGTH 4000B = 20 48 CM STORAGE USED 63000B = 26112

COMPILE TIME 0 .230 SECONDS

282
TTN 5 I +55

2

SUBROUTINE LDDABS

84 / 03 / 14 . 10.18 .23 PAGE

74/175 OPT=0

76

1

2

3

4

56

78

7

1 0

1

1

12

1314

15

1 6 17

1 8 1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

5152

5354

5556

5758

5960

6162

6364

SUBROUTINE LDDABS ( TS , TS2 , FROM, TO ) LDDABS

* THIS ROUTINE LOADS THE ABSORPTION COEFFICIENT INTO THE APPROPRIATE LDDABS

* LOCATION IN THE 'DDABS' ARRAY. LDDABS

* LDDABS

* NROOMS: TOTAL NUMBERS OF ROOMS REPRESENTED BY DATA LDDABS

* RMAX: MAXIMUM NUMBER POSSIBLE UNDER THE PRESENT PROGRAM CONFIGURATIOLDDADS

» TS AND TS2: ABSORPTION COEFFICIENTS LDDABS

* FROM: TO: CONTAINS ROOM#'S OR THE DIRECTIONS D 1 , D2 , 4 , D5 , OR D6 . LDDABS

t********************************************************************** * COMR

*»* COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

i*lt*i>i*1iifHIA***«*4IAtt«X*AI)it*))*4tltlk)kAik*lt*1tAA*1li*llitt<IA***lklk**k*************lk**** C OMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOM(RMAX + 6, RMAX +6), NROOMS, RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

* COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD

COMMON /ROOMD/DDABS(RMAX + 6, RMAX + 6 ) ,DREFL, DREFLW COMD REAL DDABS ,DREFL , DREFLW COMD

tt*ltii***lili******l(**iiii*it*liii*****li**ii*t*li**t*tt*iilili**li***tii***iitii*****tt**Q OMD

INTEGER VAL, C, R, RNUM, D LDDABS

REAL TS, TS2 LDDABS

CHARACTER * 3 FROM, TO LDDABS

IF ( FROM(l:l) . EQ . 'D' ) THEN LDDABS

RNUM = VAL ( TO(l:2) ) LDDABS

D = VAL ( FROM(2 ; 2) ) LDDABS

****i«*«**************«***1k«*****«*******«ilt**************)[****«Ik*l«*******[,OQ;^BS

* INSERT ABSORPTION COEFFICENT FOR ENERGY ENTERING A ROOM FROM THE LDDABS

* OUTSIDE OF THE BUILDING. LDDABS

R = NROOMS + D LDDABS

C = RNUM LDDABS

DDABS(R,C) = TS + DDABS(R,C) LDDABS

***********ik********x***x******************«***«*iii*****«*«*it*******«****[.[)]3;^BS

* INSERT ABSORPTION COEFFICIENT INTO 'DDABS' ARRAY FOR ENERGY LEAVING LDDABS

* A ROOM TO THE OUTSIDE OF THE BUILDING. LDDABS

R = RNUM LDDABS

C = NROOMS + D LDDABS

DDABS(R,C) = TS2 / RAREA(RNUM) + DDABS(R,C) LDDABS

ELSE IF ( TO(l:l) . EQ . 'D' ) THEN LDDABS

RNUM = VAL ( FROM(l:2) ) LDDABS

D = VAL ( TO(2 : 2 ) ) LDDABS

»*»*»**************x «** *»x*******»***»******»***»***»**»»»x**»x»»»t»L0o;^gS

* INSERT ABSORPTION COEFFICIENT INTO 'DDABS' ARRAY FOR ENERGY ENTER INGLDDABS

* A ROOM FROM THE OUTSIDE OF THE BUILDING. LDDABS

XXXXXXX*XX*XXXX*X*XXX*XXX*XXXX*XXXXXXXXXXXXXX*XXXXXXXXXXXX*X*X*XX*X*XX«XLQQJ^g5

R = NROOMS + D LDDABS

C = RNUM LDDABS

DDABS(R,C) = TS + DDABS(R,C) LDDABS

XXX*XXXXXXXXXXX*XXXX*XXXXXXXXXXX*X«X*XXXXXXX*XX*«XXX***X*XX***X«***Xl*t*gQ[]^g3

* INSERT ABSORPTION COEFFICIENT INTO 'DDABS' ARRAY FOR ENERGY LEAVING LDDABS

* A ROOM TO THE OUTSIDE OF THE BUILDING. LDDABS

XXXXXXXXXXXXXXXXXXXXXAXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXtXtXXXXXgQQXBS

R = RNUM LDDABS

1

2

3

4

5

67

8

9 10

1

2

3

4

5

6

7

8

9 10

1

2

3

45

6

7 1314

15

1 6 1718

1920

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

49

283
FTN 5.1+55 2 84 / 03 / 1 4 . 1 0 .1 8.23 PAGE 77 SUBROUTINE LDDABS 74/175 OPT=0

65 C = NROOMS + D LDDABS SO

66 DDABS(R,C) = TS2 / RAREA(RNUM) + DDABS (R,C) LDDABS 51 67 t * ** *4ilk**itA**)t*lkA****ktt*A***it**it**«*Alt*«kk«lk*** AAAAA AAAAA ***************I,qqXBS 52 68 ELSE LDDABS 53

69 t t A* iiM)*ttlt********i> ltlt«)l** ************fr****** AAAAAAAAAA ***************I,DQAQS 54

70 * INSERT ABSORPTION COEFFICIENTS INTO ‘DDABS* ARRAY FOR ENERGY GOING LDDABS 55

71 t FROM ROOM TO ROOM. LDDABS 56 72 t * A A ********** *************** 57

73 R = VAL ( FROM! 1 -.2) ) LDDABS 58 74 C = VAL ! TO!l :2) ) LDDABS 59

75 DDABS!R,C) = TS2 / RAREA!R) + DDABS!R ,C) LDDABS 60

76 DDABS!C,R) = TS2 / RAREA!C) + DDABS!C ,R) LDDABS 61 77 END IF LDDABS 62 78 RETURN LDDABS 63

79 END LDDABS 64

-VARIABLE MAP--(LO=A)

NAME ADDRESS- -BLOCK PROPERTIES TYPE ---SIZE

C 222B INTEGER

D 225B INTEGER

DDABS OB /ROOMD/ REAL 676 DREFL 1 2 4 4B /ROOMD/ REAL DREFLW 1 245B /ROOMD/ REAL FROM 3 DUMMY-ARG CHAR*3

NROOMS 1244B /ROOMN/ INTEGER

R 22 3B INTEGER RAREA 1 245B /ROOMN/ REAL 20 RNUM 22 4B INTEGER

ROOM OB /ROOMN/ REAL 676 TO 4 DUMMY-ARG CHAR*3

TS 1 DUMMY-ARG REAL

TS2 2 DUMMY-ARG REAL

-SYMBOLIC CONSTANTS--! LO=A) -NAME TYPE VALUE

RMAX INTEGER 20

-PROCEDURES--(LO=A)

-NAME TYPE ARCS CLASS

VAL INTEGER 1 FUNCTION

-ENTRY POINTS--(LO=A)

-NAME ADDRESS- -ARCS

LDDABS SB 4

-3TATISTICS--

PROGRAM-UNIT LENGTH 230B = 152 CM LABELLED COMMON LENGTH 253 7B = 1375

CM STORAGE USED 61000B = 25088

COMPILE TIME 0.103 SECONDS

284
FTN 5 I + 55

2

SUBROUTINE PDDABS

84/03/14. 10.18.23 PAGE

74/175 OPT=0

78

12

3

45

6

78

9

1 0 11

1 2 1314

15U

1718

19 20

2122

2324

2528

2728

2930

3132

3334

3538

3738

3940

4142

4344

4548

4748

4950

5152

5354

5558

SUBROUTINE PDDABS PDDABS

C»* PRINTOUT THE CONTENTS OF THE ROOM MATRIX PDDABS

»•* COMMON FOR INITIAL PARAMETERS ***COMF

INTEGER FMAX COMF

PARAMETER (FMAX = 50) COMF

COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF

$ FTOT COMF

COMMON /INITILC/ BLDG COMF

CHARACTER » 5 BLDG COMF

REAL FREQ, AFLAG, RFLAG, FREQA COMF

INTEGER QUALITY, FERR, FTOT COMF

*** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS »»*COMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOM(RMAX + 8, RMAX + 8), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

1

2

1

2

3

4

5

8

7

8

9 10

1

1

1213

12

34

5

8

7

8

9 10

« COMMON FOR EVALUATION OF ROOM MATRIX

*

COMMON / MAT /TMAT( RMAX, RMAX) , ENERGY ( RMAX ) ,POWER(6) ,FTIME

+,SWR(RMAX, 6) , IDIR REAL TMAT , ENERGY , POWER , SWR

LOGICAL FTIME

tttmitt****t**tii*ii****tii**t***ii**ttii»***t**t**t ii** *****tii***i

* COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS

COMMON /ROOMD/DDABS(RMAX + 8, RMAX + 8 ) ,DREFL, DREFLW

REAL DDABS ,DREFL , DREFLW

INTEGER R,C

PRINT*

PRINT*,' DDABS MATRIX VALUES

PRINT*,' AT FREQUENCY = ',FREQ,'

PRINT*,' WITH AFLAG = ', AFLAG,

HERTZ

PER CENT'

4.****lt*4MtA**** ' DO 10 R = 1, NROOMS + 8 PRINT 100 , (DDABS(R,C) , 10 CONTINUE

100 FORMATdX, 12(F8 .3)

RETURN

END

C = 1 , NROOMS + 8 )

COMJ 1 COMJ 2 COMJ 3 COMJ 4 COMJ 5 COMJ 8 COMJ 7 COMJ 8 COMJ 9

1 COMD 2

3 COMD 4 COMD 5

8

7 PDDABS 7 PDDABS 8 PDDABS 9 PDDABS 10 PDDABS 11 •PDDABS 12 PDDABS 13 PDDABS 1 4 PDDABS 15 PDDABS 18 :PDDABS 17 PDDABS 18 PDDABS 19 PDDABS 20 PDDABS 2i

285
FTN 5,1+552 84/03/14. 10.18.23 PAGE 79 SUBROUTINE PDDABS 74/175 OPT=0

-VARIABLE MAP--(LO=A)

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

C 163B INTEGER

DDABS OB /ROOMD/ REAL 678 DREFL 1 244B /ROOMD/ REAL DREFLW 1 245B /ROOMD/ REAL ENERGY 620B /MAT/ REAL 20 FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FT I ME 652B /MAT/ LOGICAL

FTOT 87B / INITILN/ INTEGER

IDIR 1 043B /MAT/ INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

POWER 644B /MAT/ REAL 6 QUALITY IB / INITILN/ INTEGER

R 162B INTEGER RAREA 1245B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 676

SWR 653B /MAT/ REAL 120 TMAT OB /MAT/ REAL 400

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20

-STATEMENT LABELS--! LO=A)

-LAB EL- ADDRESS PROPERTIES DEF

10 INACTIVE DO-TERM 51 100 121B FORMAT 54

-ENTRY POINTS--(LO=A>

-NAME ADDRESS- -ARCS

PDDABS 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

170B = 120 3674B = 1980

61000B = 25088

0.071 SECONDS

286
FTN 5 U552

SUBROUTINE IDDABS

84/03/14. 10.18,23 PAGE

74/175 OPT=0

80

1

2

3

4

5

7

8

9

1 0 11

1 2 13

1 4 15

1 6 1718

1920

21

IDDABS

IDDABS

IDDABS

r********************************* * COMB

***COMR

SUBROUTINE IDDABS ******* I

» INITIALIZE DDABS MATRIX,

***************1

******* I »»» COMMON POR ROOM ARRAY CONTAINING ATTENUATION OF WALLS

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOMIRMAX + 6, RMAX +6), NROOMS, RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

************************************************************************ COMR

* COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD

COMMON /ROOMD/DDABS(RMAX + 6 , RMAX + 6 ) ,DREFL, DREFLW COMD

REAL DDABS ,DREFL , DREFLW COMD

1

2

3

4

1

2

3

4

5

1

7

8

9 10

1

2

3

4

5

i

7 22 INTEGER R,C IDDABS 7 23 DO 10 R = l.RMAX IDDABS 8 24 DO 10 C = 1 ,RMAX IDDABS 9 25 DDABS(R,C) = 0.0 IDDABS 10 26 10 CONTINUE IDDABS 11 27 DO 20 R = l.RMAX IDDABS 12 28 DO 20 C = RMAX + 1, RMAX + 5 IDDABS 13 29 DDABS(R,C) = 0.0 IDDABS 14 30 20 CONTINUE IDDABS 15 31 RETURN IDDABS 16 32 END IDDABS 17

-VARIABLE MAP-- (LO=A) -NAME ADDRESS --BLOCK --PROPERTIES TYPE SIZE

C 70B INTEGER

DDABS OB /ROOMD/ REAL 676

DREFL 1244B /ROOMD/ REAL DREFLW 1 245B /ROOMD/ REAL NROOMS 124 4B /ROOMN/ INTEGER

R 67B INTEGER

RAREA 1245B /ROOMN/ REAL 20 ROOM OB /ROOMN/ REAL 676

-SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

RMAX INTEGER 20

STATEMENT LABELS--( LO=A)

LAB EL -ADDRESS PROPERTIES DEF

10

20 INACTIVE

INACTIVE

DO-TERM

DO-TERM

26

30

287
FTN 5.1 + 55 2 84/03/M. 10.18.23 PAGE 81 SUBROUTINE IDDABS 74/175 OPT=0

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS --ARCS

IDDABS 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH 77B = 63 CM LABELLED COMMON LENGTH 2537B = 1375

CM STORAGE USED 81000B = 25088

COMPILE TIME 0.050 SECONDS

288
FTN 5 1+552

SUBROUTINE PPWR2

84/03/M. 10.18.23 PAGE

74/175 OPT=0

82

1

2

3

4

5

6

7

8

7

1 0

1

1

1 2 13

1 4 15U

1718

1? 20

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR

PPWR2

***COMF

** *COMF

***COMF

COMF

COMF

COMF

COMF

COMF

COMF

COMF

COMF

***COMR

SUBROUTINE PPWR2

t« D«** llt**<I*<l **• COMMON FOR INITIAL PARAMETERS

t«*t***«

INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ

0 FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG REAL FREQ, AFLAC, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

<*««*«««*****«*****

«*««*«*****««***

*** COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS

***li*********i(*li*****tli***************litt***t*******li**t*1i********

INTEGER RMAX PARAMETER (RMAX = 20)

COMMON /ROOMN/ ROOM(RMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX)

INTEGER NROOMS

REAL ROOM

t********************************************************************** * COMR

*

* COMMON FOR EVALUATION OF ROOM MATRIX

*t****t**ii****t*t********tii t** *ii**»******t*ttiit**ii*iit***ititt**

COMMON /MAT / THAT ( RMAX , RMAX) , ENERGY ( RMAX ) ,POVER(6) ,FTIME

+ , SWR(RMAX, 6) , IDIR REAL TMAT , ENERGY , POWER , SWR

LOGICAL FTIME

REAL DB WRITE!*, 30) FREQ

30 FORMAT ( / /

, " ATTENUATI ON AT A FREQUENCY OF " , 1 PE 1 0 . 3 , " HZ"

/

I " **»***»**»»*****»*»***************»***********" , *********»*****************"

/,"* * DIRECTIONS ",28X, "",/,

* ROOMS * 1 2 3 4 " ,

5 *"^/^"»********» »** »*********»*»*t**<i»*»»»*"

»***»***»**»******»***********»*")

WRITE!*, 100) ( IROW, (SWR! IROW, I) , 1=1 , 5) , I ROW= 1 , NROOMS

)

100 FORMAT ("* "

, 13 , 3X, "*" , F9 . 2 , 3X ,F10 . 2 , 3X,F10 . 2 , 3X,F10 . 2 , 3X ,F10 . 2

,

+

" *")

WRITE (*,120)

120 FORMAT ("'

RETURN

END

1

1

2

3

4

5

6

7

8

9 10

1112

13

1

2

3 COMR 4 COMR 5 COMR 6 COMR 7 COMR 8 *COMR 9 10 COMJ 1 COMJ 2 COMJ 3 COMJ 4 COMJ 5 COMJ 6 COMJ 7 COMJ 8 COMJ 9 PPWR2 5 PPWR2 6 PPWR2 7 PPWR2 8 PPWR2 9 PPWR2 10 PPWR2 11 ,PPWR2 12 PPWR2 13 PPWR2 14 PPWR2 IS PPWR2 1 6 PPWR2 17 PPWR2 18 PPWR2 19 PPWR2 20 PPWR2 21

-VARIABLE MAP-- (LO=A)

-NAME---ADDRESS --BLOCK -PROPERTIES TYPE SIZE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

DB NONE UNUSED/*S* REAL

ENERGY 620B /MAT/ REAL 20 FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTIME 6S2B /MAT/ LOGICAL

FTOT 67B / INITILN/ INTEGER

289
FTN 5,1+552 84/03/14, 10,18,23 PAGE 83 SUBROUTINE PPWR2 74/175 OPT=0

I 167B INTEGER

IDIR 1 043B /MAT/ INTEGER

IROW 145B INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

POWER 444B /MAT/ REAL 4 QUALITY IB / INITILN/ INTEGER RAREA 1 245B /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL ROOM OB /ROOMN/ REAL 474 SWR 45 3B /MAT/ REAL 120 TMAT OB /MAT/ REAL 400

-SYMBOLIC CONSTANTS-- (LO=A> -NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20

-STATEMENT LABELS-- ( LO=A)

-LAB EL- ADDRESS PROPERTIES DEF

30 58B FORMAT 34 100 123B FORMAT 44 120 133B FORMAT 47

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

PPWR2 5B 0

-STATISTICS--

PROGRAM-UNIT LENGTH

CM LABELLED COMMON LENGTH

CM STORAGE USED

COMPILE TIME

173B = 123 2424B = 1302

61000B = 25088

0.071 SECONDS

290
FTN 5 U552

SUBROUTINE SPUR

84/03/14. 10.18.23 PAGE

74/175 OPT=0

84

1

2

3

4

5

k

78

9

1 0

1

1

12

1314

15U

1718

19 20

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

43

SUBROUTINE SPUR SPWR

••• COMMON FOR INITIAL PARAMETERS ***COMF

(**«*«****«*««*««****t*******«*****«************«***ik**«*«*******««*<t** * COMP

INTEGER FMAX COMF

PARAMETER (FMAX = 50) COMF

COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF

5 FTOT COMF

COMMON /INITILC/ BLDG COMF

CHARACTER * 5 BLDG COMF REAL FREQ, AFLAG, RFLAG, FREQA COMF

INTEGER QUALITY, FERR, FTOT COMF

«**t**********«***« «** ******«***********it******ik******************«*C0MR

•»* COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR

INTEGER RMAX COMR

PARAMETER (RMAX = 20) COMR

COMMON /ROOMN/ ROOM(RMAX + 6, RMAX + 6), NROOMS , RAREA(RMAX) COMR

INTEGER NROOMS COMR

REAL ROOM COMR

t*************************************************************** COMJ

» COMJ

* COMMON FOR EVALUATION OF ROOM MATRIX COMJ

» COMJ

COMMON /MAT/TMAT(RMAX,RMAX) ,ENERGY(RMAX) ,POVER(6) ,FTIME COMJ

+,SWR(RMAX,6) ,IDIR COMJ

REAL TMAT , ENERGY , POWER , SWR COMJ

LOGICAL FTIME COMJ

REAL DB SPWR

DO 100 I ROW= 1 , NROOMS SPWR

IF(ENERGY( IROW) . LT. 1 . OE-05) THEN SPWR

DB = -60.0 SPWR

GO TO 100 SPWR

END IF SPWR

DB=10.0 * ALOGIO ( ENERGY! IROW) / 10. ) SPWR

100 SWR( IROW, IDIR) =DB SPWR

RETURN SPWR

END SPWR

1

1

2

3

4

5

6

7

8

9 10

1112

13

1

2

3

4

5

6

7

8

9 10

1

2

3

4

5

6

7

89

5

6

7

8

9 10

1112

1314

-VARIABLE MAP-- o It -NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

AFLAG 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR*5

DB SSB REAL

ENERGY 620B /MAT/ REAL 20 FERR 66B / INITILN/ INTEGER

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FTIME 652B /MAT/ LOGICAL

FTOT 67B / INITILN/ INTEGER

IDIR 1 043B /MAT/ INTEGER

IROW 56B INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

POWER 644B /MAT/ REAL 6 QUALITY IB / INITILN/ INTEGER

RAREA 124SB /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL

291
FTN 5.1 + 552 84/03/M. 10.18.23 PAGE 85 SUBROUTINE SPWR 74/175 OPT=0

ROOM OB /ROOMN/ REAL 676

SWR 853B /MAT/ REAL 120 TMAT OB /MAT/ REAL 400

--SYMBOLIC CONSTANTS--(LO=A)

-NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20

--PROCEDURES--(LO=A)

-NAME TYPE ARGS CLASS

ALOGIO REAL 1 INTRINSIC

--STATEMENT LABELS--! LO=A) -LAB EL -ADDRESS PROPERTIES DEF

100 31B DO-TERM 41

--ENTRY POINTS--! LO=A> -NAME---ADDRESS--ARGS---

SPWR 5B 0

--STATISTICS--

PROGRAM-UNIT LENGTH 62B = 50 CM LABELLED COMMON LENGTH 242 6B = 1302

CM STORAGE USED 61000B = 25088

COMPILE TIME 0 .057 SECONDS

292
FTN 5 U552 84/03/14. 10.18.23 PAGE 84 SUBROUTINE RESONV 74/175 OPT=0

1 SUBROUTINE RE SONV ( FROM , MATI D ) RESONV

2 • RESONV

3 • THIS ROUTINE CHECKS FOR RESONANCE CONDITIONS IN A ROOM RESONV

4 » IF A RESONANCE IS POSSIBLE AT THE PARTICULAR FREQUENCY RESONV

5 « FOR THE ROOM AND THE VALL IN QUESTION HAS A REFLECTION RESONV

4 • COEFFICIENT GREATER THAN 0.80, THEN THE ABSORPTION FOR RESONV

7 • THE VALL IS REDUCED BY THE REFLECTION COEFFICIENT. RESONV

8 • RESONV

9 *COMR

10 •»» COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF VALLS **»COMR

11 *COMR

12 INTEGER RMAi COMR

13 PARAMETER (RMAX = 20) COMR

14 COMMON /ROOMN/ ROOM(RMAX + 4, RMAX + 4), NROOMS , RAREA(RMAX) COMR

15 INTEGER NROOMS COMR

14 REAL ROOM COMR

17 *COMR

Ig * COMR

19 < COMV

20 »** COMMON FOR DATABASE OF VALL PARAMETERS ***COMV

21 * COMV

22 INTEGER VMAX COMV

23 PARAMETER (VMAX = 75) COMV

24 COMMON /VALLN/ VD IM ( VMAX , 3 ) , WTOT, VERR COMV

25 COMMON /VALLC/ VALL(VMAX,4) COMV

24 INTEGER VTOT.VERR COMV

27 REAL VDIM COMV

28 CHARACTER »3 VALL COMV

29 • ================================= COMV

30 ** DESCRIPTION OF ARRAYS COMV

31 * ================================= COMV

32 * VALL IDENTIFICATION COMV

33 t COMV

34 * DIRECTION FROM TO COMV

35 * ROOM ROOM COMV

34 * COMV

37 * VALL(X,1) VALL(X,2) VALL(X,3) COMV

38 » A3 A3 A3 COMV

39 * ========================================================= COMV

40 » VALL PARAMETERS COMV

41 » COMV

42 * MATERIAL HEIGHT VIDTH LAYER THICKNESS COMV

43 t COMV

44 * VALL(X,4) VDIM(X,1) VDIM(X,2) VDIM(X,3) COMV

45 • A3 F8.2 F8 . 2 F8.2 COMV

44 *«*«*«*«*»*****t**«ii*«*5t«***««««<x««**«*)t«*t******t********«t««««t****t* COMV

47 t COMV

43 ***tt**tt*t**t**tt ii** t**t*t*t**t**t*t*tt*ttt*tttt*tt*t**t*t*tt*tt*t * COMF

49 *** COMMON FOR INITIAL PARAMETERS *»»COMF

50 COMF

51 INTEGER FMAX COMF

52 PARAMETER (FMAX = 50) COMF

53 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF

54 $ FTOT COMF

55 COMMON /INITILC/ BLDG COMF

54 CHARACTER * 5 BLDG COMF

57 REAL FREQ, AFLAG, RFLAG, FREQA COMF

58 INTEGER QUALITY, FERR, FTOT COMF

59 t*«*«*««**(*«******t**t******tt*«**t***tt***t*ttt«*(**(«*t«(«*i*tt(tttttcOMF

40 **t*********tt*****************«**t****t*t*t«««x*t*tt>tt**t*t*t**t*ti(ttcOMF

41 • COMM

42 **» COMMON FOR DATABASE OF MATERIAL PROPERTIES «*»COMM

43 i**x***«**x«**««****t*««*****«x««xt*******«*t«t«t*t«**t*tt«ittt*t*t«*tt • COMM

44 INTEGER MMAX COMM

1

2

3

4

5

47

8

1

2

3

4

5

47

8

9 10

1

23

4

5

4

7

89 10

1

1

1213

1415

1417

1819

2021

2223

2425

2427

2829

1

2

3

4

5

4

7

8

9 10

1

1

12

13

1

2

3

4

293
FTN 5 . 1+552

SUBROUTINE RESONW

84/03/14, 10.18,23 PAGE

74/175 OPT=0

87

65 PARAMETER <MMAX=100> COMM 5 66 COMMON /MATN/ MATTENIMMAX , 7 ) , MRCOEF <MMAX , 7 ) , QA(MMAX), QR(MMAX), COMM 6 67 $ NFREQ(NMAX. 7) , MERR, MTOT COMM 7 68 COMMON /MATC/MAT(MMAX) .MATDESC (MMAX

>

COMM 8 69 INTEGER MTOT, MERR COMM 9 70 REAL MATTEN, MRCOEF, MFREQ, QA , OR COMM 10

71 CHARACTER * 3 MAT COMM 11 72 CHARACTER * 70 MATDESC COMM 12 73 * * A * ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftAftftftftfttftftftftftfttftftft ft COMM 13

74 * COMM 14

75 A*A**A***A***il[***A AA«** A**« «** *ft*A*«lk**«1t*1t**«****«*«*«*«ft1t«*«* *COMD 1 76 * COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD 2 77 A*A**A*«*A«*«******« «** A«ft*«*****Aft«ft**A*«t***«*«*««******«**«* ft ** * *COMD 3 78 COMMON /ROOMD/DDABSCRMAX + 6, RMAX + 6 ) ,DREFL, DREFLW COMD 4 79 REAL DDABS ,DREFL , DREFLW COMD 5 80 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft ft COMD 6 81 ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft ft COMD 7 82 REAL A,B,C,RH,RL,RW RESONW 14 83 REAL MREFL RESONW 15 84 CHARACTER * 3 FROM,MATID RESONW 16 85 I SET = 0 RESONW 17 86 MREFL = RCOEF (MATID , FREQ , RFLAG

)

RESONW 18 87 IF(MREFL.LT,0.80) THEN RESONW 19 88 DREFL =0.0 RESONW 20

89 RETURN RESONW 21 90 END IF RESONW 22

91 IF(FROM(l: 1) ,EQ. 'D' ) THEN RESONW 23 92 DREFL =0.0 RESONW 24

93 RETURN RESONW 25

94 END IF RESONW 26

95 ft RESONW 27

96 ft NOW GET HEIGHT, WIDTH AND LENGTH OF ROOM RESONW 28

97 ft RESONW 29

98 DO 100 11 = 1, WTOT RESONW 30

99 IF( FROM.EQ.WALL(Il,2) AND. WALL ( I 1 , 1 ) . EQ . ' FB ') THEN RESONW 31 100 RH = WDIM( 11,1) RESONW 32 101 GOTO 200 RESONW 33 102 END IF RESONW 34 103 100 CONTINUE RESONW 35 104 DREFL = 0 RESONW 36 105 IWARN = 9 RESONW 37 106 CALL WARNING! IWARN) RESONW 38 107 RETURN RESONW 39 108 200 11 = 0 RESONW 40 109 300 11 = 11 + 1 RESONW 41 110 IF(I1 GT.WTOT) THEN RESONW 42 111 DREFL =0.0 RESONW 43 112 IF( ISET. EQ. 1 ) RETURN RESONW 44 113 IWARN = 10 RESONW 45 114 CALL WARNING! IWARN) RESONW 46 115 RETURN RESONW 47

1 16 END IF RESONW 48 117 IF!FROM.EQ.WALL!Il ,2) AND. WALL ! 1 1 , 1 ) . EQ . ' UD ') THEN RESONW 49 118 RL= WDIM! 11,2) RESONW 50 119 RW= WDIM! 11 , 1

)

RESONW 51 120 ELSE RESONW 52

12 1 GOTO 300 RESONW 53 122 END IF RESONW 54 123 ft RESONW 55 124 ft NOW SORT OUT DIMENSIONS WITH A SMALLEST AND C LARGEST RESONW 56 125 ISET = 1 RESONW 57 126 IPASS = 0 RESONW 58 127 A = RH RESONW 59 128 B = RW RESONW 60

294
FTN 5 I *55

2

SUBROUTINE RESONU

84/03/14, 10.18.23 PAGE

74/175 OPT=0

88

1 29 C = RL RESONW 6 1 130 500 IF(A.GT.B) THEN RESONW 62

13 1 TMP= A RESONW 63 132 A = B RESONW 64 133 B = TMP RESONW 65 134 IPASS = 0 RESONW 66 135 ELSE RESONW 67 136 IPASS = 1 RESONW 68 137 ENDIF RESONW 69 138 IF (B.GT.C) THEN RESONW 70 139 TMP =B RESONW 71 140 B = C RESONW 72

14 1 C = TMP RESONW 73 142 IPASS = 0 RESONW 74 143 ENDIF RESONW 75 144 IF (IPASS. EQ. 0) GOTO 500 RESONW 76 145 * RESONW 77

1 46 NOW CALCULATE LOWER RESONANCE FREQUENCY RESONW 78 147 CLIGHT= 3.0E08 RESONW 79 148 FLOW = 1.0/ (B*B) + 1.0/ (C*C) RESONW 80 149 FLOW = SQRT(FLOW) RESONW 81 150 FLOW = FLOW*CLIGHT/2 .

0

RESONW 82

15 1 * RESONW 83 152 * NOW CALCULATE HIGH FREQUENCY LIMIT RESONW 84 153 FHIGH = 9,0*( 1.0/(A*A) + 1.0/(B*B) + 1.0/(C*C) ) RESONW 85 154 FHIGH = SQRT (FHIGH) RESONW 86 155 FHIGH = FHIGH*CLIGHT/2 .

0

RESONW 87 156 IF(FREQ.GE.FLOW .AND. FREQ . LE . FHIGH) THEN RESONW 88 157 DREFL = MREFL RESONW 89 158 RETURN RESONW 90 159 ELSE RESONW 91 160 DREFL =0.0 RESONW 92

16 1 GOTO 300 RESONW 93 162 ENDIF RESONW 94 163 END RESONW 95

VARIABLE MAP-- (LO=A)

NAME ADDRESS --BLOCK PROPERTIES TYPE ---SIZE

A 346B REAL AFLAG 2B / INITILN/ REAL

B 347B REAL

BLDG OB / INITILC/ CHAR*5

C 35 0B REAL

CLIGHT 363B REAL DDABS OB /ROOMD/ REAL 676

DREFL 1Z44B /ROOMD/ REAL DREFLW 1 245B /ROOMD/ REAL FERR 66B / INITILN/ INTEGER

FHIGH 365B REAL FLOW 364B REAL

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL 50 FROM 1 DUMMY-ARG CHAR*3

FTOT 67B / INITILN/ INTEGER

IPASS 361B INTEGER

ISET 35 5B INTEGER

IWARN 360B INTEGER

11 356B INTEGER

MAT OB /MATC/ CHAR»3 1 00 MATDESC 36B /MATC/ CHAR»70 100 MAT ID 2 DUMMY-ARG CHAR*3

MATTEN OB /MATN/ REAL 700

295
FTN 5.1+552 84/03/14. 10.18.23 PAGE 89 SUBROUTINE RESONU 74/175 OPT=0

MERR 4374B /MATN/ INTEGER

MFREQ 3100B /MATN/ REAL 700

MRCOEF 1 274B /MATN/ REAL 700 MREFL 3S4B REAL MTOT 4375B /MATN/ INTEGER

NROOMS 1 244B /ROOMN/ INTEGER

QA 2570B /MATN/ REAL 100 QR 2734B /MATN/ REAL 100 QUALITY IB / INITILN/ INTEGER RAREA 124SB /ROOMN/ REAL 20 RFLAG 3B / INITILN/ REAL

RH 35 IB REAL

RL 352B REAL

ROOM OB /ROOMN/ REAL 676 RW 35 3B REAL

TMP 3&2B REAL WALL OB /WALLC/ CHAR*

3

300

WDIM OB /WALLN/ REAL 225

WERR 342B /WALLN/ INTEGER

WTOT 3418 /WALLN/ INTEGER

•SYMBOLIC NAME CONSTANTS--! LO=A) TYPE VALUE

FMAX INTEGER 50 MMAX INTEGER 1 00 RMAX INTEGER 20 WMAX INTEGER 75

PROCEDURESi--(LO = A) NAME TYPE --ARGS ---CLASS

RCOEF REAL 3 FUNCTION

SORT GENERIC 1 INTRINSIC

WARNING 1 SUBROUTINE

-STATEMENT LABELS-- ( LO=A

)

-LABEL-ADDRESS-- PROPERTIES- ---DEF

100 INACTIVE DO-TERM 1 03 200 102B 108 300 104B 1 09 500 162B 130

-ENTRY POINTS--! LO = A) -NAME ADDRESS- -ARCS

RESONW 5B 2

-STATISTICS--

PROGRAM-UNIT LENGTH 370B = 248 CM LABELLED COMMON LENGTH 11255B = 47 81 CM STORAGE USED 6 1 OOOB = 25088

COMPILE TIME 0 . 1 90 SECONDS

296
FTN 1 U55Z 84/03/14. 10.18.23 PAGE 90 SUBROUTINE RESOND 74/175 OPT=0

1 SUBROUTINE RESOND(ID) RESOND 1

2 * RESOND 2

3 • RESOND 3

4 • THIS ROUTINE CALCULATES RESONANCES FOR DOORS AND RESOND 4

5 * WINDOWS IN THE RESONANCE FREQUENCY RANGE, THE RESOND 5

6 • INPUT TRANSMISSION OF THE WINDOW OR DOOR IS IN- RESOND 4

7 * BY 20 DB (ARBITRARY). RESOND 7

8 « RESOND 8

9 « RESOND 9

11 **• COMMON FOR ROOM ARRAY CONTAINING ATTENUATION OF WALLS ***COMR 2

13 INTEGER RMAE COMR 4 14 PARAMETER (RMAX = 20) COMR 5 15 COMMON /ROOMN/ ROOM (RMAX + 6, RMAX +6), NROOMS , RAREA(RMAX) COMR 4 16 INTEGER NROOMS COMR 7 17 REAL ROOM COMR 8

21 • COMMON FOR ABSORPTION AND REFLECTION COEFFICIENTS IN WALLS COMD 2

23 COMMON /ROOMD/DDABSCRMAX + 6, RMAX + 4 ) ,DREFL, DREFLW COMD 4 24 REAL DDABS ,DREFL , DREFLW COMD 5

28 *** COMMON FOR INITIAL PARAMETERS ***COMF 2

30 INTEGER FMAX COMF 4 31 PARAMETER (FMAX = 50) COMF 5 32 COMMON /INITILN/ FREQ, QUALITY, AFLAG, RFLAG, FREQA(FMAX), FERR, COMF 4 33 $ FTOT COMF 7 34 COMMON /INITILC/ BLDG COMF 8 35 CHARACTER * 5 BLDG COMF 9 36 REAL FREQ, AFLAG, RFLAG, FREQA COMF 10 37 INTEGER QUALITY, FERR, FTOT COMF 11

41 *** COMMON FOR DATABASE OF TYPES OF DOORS AND WINDOWS ***COMT 2

43 INTEGER TMAX COMT 4 44 PARAMETER (TMAX=35) COMT 5 45 COMMON /TYPEN/TDIM(TMAX, 4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR COMT 4 46 COMMON /TYPEC/TYPE(TMAX, 3) ,TDB1 (TMAX) COMT 7 47 INTEGER TTOT , TDBTOT , TERR COMT 8 48 REAL TDIH,TDB2 COMT 9 49 CHARACTER * 3 TYPE,TDB1 COMT 10 50 *================================================= COMT 11 51 * DESCRIPTION OF ARRAYS COMT 12 52 *================================================= COMT 13 53 * ID MATERIAL FRAME MATERIAL COMT 14 54 * COMT 15 55 *TYFE(X,1) TYPE(X,2) TYPE(X,3) COMT 16 56 * A3 A3 A3 COMT 17 57 *================================================= COMT 18 58 » HEIGHT WIDTH LAYER DISTANCE COMT 19 59 * THICKNESS ABOVE FLOOR COMT 20 60 » COMT 21 61 * TDIM(X,1) TDIM(X,2) TDIM(X,3) TDIM(X,4) COMT 22

62 * F8.2 F8.2 FB.2 F8.2 COMT 23 63 *================================================= COMT 24 64 * ID ATTENUATION AREA COMT 25

297
FTN 5.1+552 84/03/14. 10.18.23 PAGE 91 SUBROUT

6-5

INE RESOND 74/175 OPT=0

COMT

* TDBKX) TDB2(X,1) TDB2(X,2) COMT

L 0 27 67 * A3 E9.3 E9.3 COMT 28

68 A******************************************************************** * **COMT 29

69 «*«WA«*lt«lk**«***««***A*****«A««*««**ft**«*lt*«*«**«*«***«***«A********* ** *CONT 30 70 CHARACTER * 3, ID, MATID RESOND 14 71 DO 10 I = 1, TTOT RESOND 15 11 J = I RESOND 16 73 IF(TYPE(I,1) .EQ. ID) GOTO 20 RESOND 17 74 10 CONTINUE RESOND 18 75 IVARN = 11 RESOND 19 76 CALL WARNING! IWARN) RESOND 20

77 DREFLW =0.0 RESOND 21 78 RETURN RESOND 22 79 20 CONTINUE RESOND 23

80 MATID = TYPE (J,3) RESOND 24

81 RH = TD I M ( J , 1

)

RESOND 25 82 RW = TDIM (J,2> RESOND 26 83 REFL = RCOEF( MATID, FREQ, RFLAG) RESOND 27 84 IF( REFL .LT. 0.80 ) THEN RESOND 28

85 DREFLW =0.0 RESOND 29

86 RETURN RESOND 30 87 END IF RESOND 31 88 A = RH RESOND 32 89 B = RW RESOND 33

90 IF( A.GT.B) THEN RESOND 34

91 TMP = B RESOND 35 92 B = A RESOND 36

93 A = TMP RESOND 37

94 END IF RESOND 38

95 FLOW = 3 . 0E8 / 2/ B RESOND 39 96 FHIGH = 3.0E8 / 2.0 * 3.0 * SQRT( 1/(B*B) + 1 / (A*A) ) RESOND 40

97 IF(FREQ. GE . FLOW .AND. FREQ . LE . FH IGH ) THEN RESOND 41 98 DREFLW =20.0 RESOND 42 99 ELSE RESOND 43 100 DREFLW =0.0 RESOND 44

10 1 END IF RESOND 45 102 RETURN RESOND 46 103 END RESOND 47

VARIABLE MAP-- (LO=A) NAME ADDRESS --BLOCK PROPERTIES TYPE

A 205B REAL AFLAG 2B / INITILN/ REAL

B 206B REAL BLDG OB / INITILC/ CKAR*5

DOABS OB /ROOMD/ REAL DREFL 1 244B /ROOMD/ REAL DREFLW 1 245B /ROOMD/ REAL

I'ERR 66B / INITILN/ INTEGER

FHIGH 21 IB REAL FLOW 210B REAL

FREQ OB / INITILN/ REAL FREQA 4B / INITILN/ REAL

FTOT 67B / INITILN/ INTEGER

I 176B INTEGER

ID 1 DUMMY-ARG CHAR»3

I WARN 201B INTEGER

J 200B INTEGER MATID 175B CHAR*3

NROOMS 124 4B /ROOMN/ INTEGER

QUALITY IB / INITILN/ INTEGER

298
FTN 5 1+552 84/03/14. 10.18,23 PAGE 92 SUBROUTINE RESOND 74/175 OPT=0

RARCA 1 2 45B /ROOMN/ REAL 20 REFL 20 4B REAL

RFLAC 3B / INITILN/ REAL

RH 202B REAL ROOM OB /ROOMN/ REAL 676 RW 20 3B REAL TDBTOT 32 3B /TYPEN/ INTEGER

TDBl 37B /TYPEC/ CHAR*3 35 TDB2 21 SB /TYPEN/ REAL 70 TDIM OB /TYPEN/ REAL 140 TERR 32 4B /TYPEN/ INTEGER

TMP 2 0 7B REAL TTOT 21 4B /TYPEN/ INTEGER

TYPE OB /TYPEC/ CHAR*3 1 05

•SYMBOLIC CONSTANTS--! LO=A) NAME TYPE VALUE

FMAX INTEGER 50 RMAX INTEGER 20 TMAX INTEGER 35

-PROCEDURES --(LO=A) -NAME TYPE --ARGS CLASS

RCOEF REAL 3 FUNCTION

SORT GENERIC 1 INTRINSIC

WARNING 1 SUBROUTINE

-STATEMENT LABE LS- - ( LO= A

)

-LABEL-ADDRESS --PROPERTIES-- --DEF

1 0 INACTIVE DO-TERM 74 20 43B 79

-ENTRY POINTS--(LO=A)

-NAME ---ADDRESS --ARCS- --

RESOND 5B 1

-STATISTICS--

PROGRAM-UNIT LENGTH 214B = 140 CM LABELLED COMMON LENGTH 3 22 7B = 1687 CM STORAGE USED 61000B = 25088

COMPILE TIME 0.120 SECONDS

299
FTN 5.1+552

SUBROUTINE LFREQ

84/03/ 14 . 10.18 .23 PAGE 74/175 OPT=0

93

1

2

3

45

6

7

89 10

1112

1314

1516

1718

19 20

2122

2324

2526

2728

2930

3132

3334

3536

3738

3940

4142

4344

4546

4748

4950

SUBROUTINE LFREQ LFREQ

* [ C [ C C I C I C C C C C I [ 1 1 1 C [ C [ C C C [ 1 1 [ [ C [ 1 1 1 C [ I C I C [ I [ 1 1 [ [ [ I [ [ C I [ I [ C C C [ I [ 1 1 1 C C C C I LFREQ

*CCI [[[LFREQ

*[[[ LOAD THE CONTENTS OF THE FILE 'BXXXXXF' INTO ARRAYS FREQA. LFREQ

*[[[ [[[LFREQ

»[[[[[[ [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[LFREQ

QUALITY, AFLAC, RFLAG, FREQA(FMAX), FERR,

COMF

COMF

COMF

COMF

COMF

COMF

*** COMMON FOR INITIAL PARAMETERS ***COMF

INTEGER FMAX PARAMETER (FMAX = 50)

COMMON /INITILN/ FREQ

5 FTOT

COMMON /INITILC/ BLDG

CHARACTER * 5 BLDG

REAL FREQ, AFLAC, RFLAG, FREQA

INTEGER QUALITY, FERR, FTOT

it*********««*ii[**************A*****it**«i*ll*****«**lt************tt*lk******ik*CO)>tp

****«i***tk******«t**«*****li*******************«i*)lr***

* DECLARATION OF VARIABLES

*A**Att**ft**)tltltit*****)t**«***ltlt*I*«*)t**********«*****

INTEGER GETLEN, R, C CHARACTER * 7 NAME, PFN

t*k*******)t**k*k******tt*k****lt*t«******t***<Mk***tllk* NAME = B' //BLDG( 1 :GETLEN(BLDG) ) /

/

‘ F

•

PFN = NAME (1 ;GETLEN(NAME)

)

FERR = 0 CALL PF ( ‘GET' ,0,PFN(UTLEN(PFN) ), ‘RC , FERR)

IF ( FERR .EQ. 0 ) THEN

OPEN (UNIT=3, FILE=PFN, FORM= ' FORMATTED ‘

,

i STATUS=‘OLD‘ , ACCESS^ ' SEQUENTIAL '

)

FTOT = 0 DO 10 R = 1,FMAX

READ (3,1000,END=20) FREQA(R)

1 00 0 FORMAT! El 2. 7) FTOT = FTOT + 1 10 CONTINUE

20 CONTINUE

C LOSE ( 3, STATUS=‘ DELETE’

)

ELSE IF ( FERR .EQ. 2 ) THEN

CALL WARNING (11)

ELSE

CALL WARNING (12) END IF RETURN

END

COMF 10 COMF 11 'COMF 12

13 LFREQ 9 LFREQ 10 LFREQ 11 LFREQ 12 LFREQ 13 LFREQ 14 LFREQ 15 LFREQ 16 LFREQ 17 LFREQ 18 LFREQ 19 REQ 20 LFREQ 21 LFREQ 22 LFREQ 23 LFREQ 24 LFREQ 25 LFREQ 26 LFREQ 27 LFREQ 28 LFREQ 29 LFREQ 30 LFREQ 31 LFREQ 32 LFREQ 33 LFREQ 34 LFREQ 35 LFREQ 36 LFREQ 37 LFREQ 38

-VARIABLE MAP-- ( LO=A) -NAME ADDRESS --BLOCK -PROPERTIES TYPE ---SIZE

AFLAC 2B / INITILN/ REAL

BLDG OB / INITILC/ CHAR»5

C NONE UNUSED/»S* INTEGER

FERR 66B 1 INITI LN/ INTEGER

FREQ OB / INITILN/ REAL

FREQA 4B / INITILN/ REAL 50 FTOT 67B / INITILN/ INTEGER NAME 21 OB CHAR»7

PFN 21 IB CHAR*7

300
FTN S It 55

2

SUBROUTINE LFREQ

84 / 03 / M . 10.18.23 PAGE

74/175 OPT=0

94

QUALITY IB /INITILN/

R 20 7B RFLAC 3B /INITILN/

INTEGER

INTEGER REAL

-SYMBOLIC CONSTANTS-- (LO=A) -NAME TYPE VALUE

FMAI INTEGER 50

PROCEDURES--(LO=A)

NAME TYPE

CETLEN INTEGER

PFWARNING

ARCS CLASS

1 FUNCTION

5 SUBROUTINE

1 SUBROUTINE

-STATEMENT LABELS--! LO=A) -LABEL- ADDRESS --PROPERTIES- ---DEF

10 INACTIVE DO-TERM 41 20 63B 42 1000 120B FORMAT 39

-ENTRY POINTS--(LO=A)

-NAME ADDRESS --ARCS

LFREQ 5B 0

-I/O UNITS--(LO=A)

-NAME PROPERTIESTAPE3 AUX/FMT/SEQ

-STATISTICS--

PROGRAM-UNIT LENGTH 215B = 141 CM LABELLED COMMON LENGTH 71B = 57 CM STORAGE USED 61000 B = 25088

COMPILE TIME 0 . 085 SECONDS

301
Appendix 9.8 Blank Forms for Data Taking.

302
WALLS DATA FORM

BUILDING I. D. NUMBER DATE

NAME

LINE ^ DIRECTION FROM TO HEIGHT(m) WIDTH(m) THICKNESS(cm) MATERIAL COMMENT

!

1

303
HOLES DATA FORM

BUILDING I.D. NUMBER DATE

NAME

LINE # DIRECTION FROM TO ID COMMENT

304
TYPES DATA FORM

(for windows and doors )

BUILDING I.D. NUMBER DATE

NAME

LINE ID HEIGHT(m) WIDTH(m) DISTANCE ABOVE

FLOOR

THICKNESS(cm) LAYER

MATERIAL

FRAME

MATERIAL

305
NBS-n4A tREv. 2-ec) U.S. DEPT. OF COMM. BIBLIOGRAPHIC DATA

SHEET (See instructions)

1. PUBLICATION OR

REPORT NO. NBSIR 84-3009

2. Performing Organ. Report No 3. Publication Date

September 1984

4. TITLE AND SUBTITLE

BUILDING PENETRATION PROJECT

5. AUTHOR(S)

J. C. Wyss, W. J. Anson, R. D. Orr

6 . PERFORMING ORGANIZATION (If joint or other than NBS, see instructions) 7 . Contract/Grant No. national bureau of standards

DEPARTMENT OF COMMERCE 8. Type of Report & Period Covered

WASHINGTON, D.C. 20234

9. SPONSORING ORGANIZATION NAME AND COMPLETE ADDRESS (Street. City, State, ZIP)

Communications Electronics Engineering Installation Agency

Fort Huachuca, Arizona 08613

10.

SUPPLEMENTARY NOTES

1^21 Document describes a computer program; SF-185, FIPS Software Summary, is attached.

11.

ABSTRACT (A 200-word or less factual summary of most significant information. If document includes a significant

bi bliography or literature survey, mention it here)

This report documents a computer program which calculates building attenuation

of electromagnetic radiation over the frequency range 10 kHz - 10 GHz. Attenuation

(in dB) is computed from building shape, dimensions, room layout, and the electrical

properties of construction materials; no electromagnetic measurements are required.

Details of the structure and use of the program are given.

12.

KEY WORDS (S/x to twelve entries; alphabetical order; capitalize only proper names; and separate key words by semicolon s) computer model; electromagnetic attenuation; electromagnetic interference;

electromagnetic shielding; shielding materials

13. AVAILABILITY 14. NO. OF

PRINTED PAGES

[)^ Unl i mi ted

1 1 For Official Distribution. Do Not Release to NTIS

Order From Superintendent of Documents, U.S. Government Printing Office, Washington, D.C.

20402.

310

15. Price

[X^l Order From National Technical Information Service (NTIS), Springfield, VA, 22161 $ 25.00

USCOMM-DC 6043-P80