Programmer’s Guide 

for the APEX3 model

Prepared for:

Tom McCurdy, Work Assignment Manager

Work Assignment 37

EMD Contract 

U.S. Environmental Protection Agency

Prepared by:

Graham Glen

April 30, 2002

ManTech Environmental Technology, Inc.

P.O. Box 12313

Research Triangle Park, NC 27709
Table of Contents

Section Page

Introduction 1

The modeling algorithms 2

Microenvironmental Parameter Determination 3

Conditional Variable List 34

DaySeq and related arrays 36

Modification of the COHb algorithm 38

The site selection and site matching algorithms 51

Revisions to the commuting data 54

Structure of the APEX3 source code 60

Programming Style 60

Code Organization and Program Flow 62

Appendix - APEX3 source code as of March 18, 2002

APEX3 main program A-1

Subroutine ReadParameters A-2

Subroutine OutputParameters A-5

GlobalModule A-7

Parameter declarations A-7

Type declarations A-8

Global variable list A-10

UtilityModule A-12

Subroutine GetLine A-12

Function Up A-13

Subroutine Fatal A-14

Subroutine Warning A-17

DistributionModule A-18

Subroutine ReadDistributions A-19

Subroutine RnNor A-23

Subroutine Distrib A-24

Subroutine Percentiles A-27

SpaceTime Module A-28

Subroutine CalcDates A-28

Function JulianDay A-29

Function YearMonthDay A-30

Subroutine SelectSites A-31

Function Distance A-35

Subroutine ReadTemperatures A-36

Subroutine ReadAirQuality A-37

Subroutine DaylightSaving A-38
Table of Contents (con’t)

DiaryModule A-39

Subroutine ReadDiaries A-39

Subroutine ReadMicroMap A-42

Subroutine ReadMETS A-43

Subroutine DiaryProbabilities A-44

Subroutine CompositeDiary A-45

Subroutine MetEval A-46

ProfileModule A-47

Subroutine SetCVList A-47

Function CVValue A-48

Subroutine ReadPopulation A-49

Subroutine ReadCommute A-51

Subroutine GenerateProfiles A-52

Subroutine GeneratePhysiology A-54

Subroutine GenerateDailyVars A-55

MicroEnvModule A-56

Subroutine ReadMicroData A-57

Subroutine SetupMicArrays A-60

Subroutine GetMicroDistrib A-61

Subroutine MicroConcs A-63

Subroutine GenerateDayshift A-65

ExposureDoseModule A-66

Subroutine SetupTables A-67

Subroutine Ventilation A-68

Subroutine ExposureDose A-69

Subroutine CalcCOHb A-71

Subroutine Output A-72

Subroutine FinalSummary A-74

Subroutine WriteTables A-77
Introduction

APEX3 is acronym for Air Pollutant EXposure model, version 3. It is a stochastic,

microenvironmental human exposure model, derived from the pNEM family of exposure models

developed by the Environmental Protection Agency over the last 15 years. The first version of

APEX was essentially identical to pNEM/CO except that it ran on a personal computer instead

of a mainframe. The APEX2 model made substantial changes, particularly in the use of a

personal profile approach rather than a cohort simulation approach. The current version,

APEX3, adds a number of new features, including automatic site selection from large (e.g.

national) databases, a series of new output tables providing summary statistics, and a thoroughly

reorganized method of describing microenvironments and their parameters.

A separate APEX3 User’s Guide explains the details of the model’s input and output files and

the steps necessary to run the model. Users who are interested in applying APEX3 to one or

more specific scenarios without altering the program code should find suitable instructions there. 

This Programmer’s Guide examines the organization and details of the source code, for those

who wish to make alterations to the model. The algorithms used in APEX3 are explained in

some detail.

The APEX3 program is written in Fortran 90 and runs on a personal computer. When compiled,

it may be run as a stand-alone application without the need for a Fortran compiler. The code was

produced and tested using Compaq Visual Fortran Professional Edition V6.6 on a personal

computer running at 900 MHZ with 256 MB of RAM, on the Windows98 operating system. 

APEX3 is newly developed and has not been tested on many other configurations. The most

likely limitation to program performance is expected to be memory, as machines with

significantly less memory might have trouble storing the internal arrays needed to run the model. 

APEX3 runs in batch mode in a DOS window. All of the input and output files are text files that

can be viewed or edited in almost any text editor.

1
The Modeling Algorithm

This section is under development and needs extensive revision. Currently, this section contains

several previous short reports detailing various aspects of the model revisions. These reports

have been edited minimally and are not consistent in the use of bold or underlined headings. The

reports included in this section are

Microenvironmental Parameter Determination 

This is a lengthy discussion on the options available for the determination of

concentration in the various micros.

Conditional Variable List

The conditional variables are the set of profile variables that may be used to select the

specific distributions for determining micro concentrations. For example, the air

exchange rate distributions may be different depending on the availability of air

conditioning for the profile in question.

DaySeq and related arrays

Each simulation day is characterized by a combination of factors such as weekday,

season, and conditional variables like temperature. For each profile and micro, each day

must be assigned to a category that determines the distributions used for the micro

concentration calculations.

Modification of the COHb algorithm

The method for determining the solution to the Coburn-Forster-Kane equation for blood

carboxyhemoglobin concentration has been altered somewhat from APEX2. The new

method is non-iterative, achieves high accuracy, works for high CO and COHb levels,

executes quickly, and provides both the endpoint level and the time-average level.

The site selection and site matching algorithms

APEX3 selects population sectors, air quality districts, and temperature zones from larger

lists provided on the input files, by first checking if the sectors are within the specified

study area and then by pairing each sector with the nearest district and zone. 

Revisions to the commuting data

The national commuting flow database of 1994 has been updated to the match the census

tracts used in the 2000 census. This was achieved using a file provided by the Census

Bureau that lists the populations of all tract fragments formed from intersections of the

1990 and 2000 tracts.

2
Microenvironmental Parameter Determination for APEX3

The following is a summary of the new method for specifying the various microenvironmentparameter (MP) combinations.

Contents

0) Introduction

1) Parameters for the MASSBAL method

2) Parameters for the FACTOR method

3) The Micro descriptions input file

4) Time and Area Mappings

5) Conditional Variables

6) Resampling Options

7) Specification of Distributions

8) Logic for Assigning Values

9) Organization of the MP data

10) Random number seeds

11) Fortran Algorithms

Introduction

APEX is a microenvironmental exposure model. The fundamental approach is to follow a set of

simulated individuals through time, determining the sequence of microenvironments (micros)

visited using appropriate activity diaries. An ‘event’ is a visit to a single micro with a single

(that is, constant) pollutant concentration. In APEX, the concentration in each micro is assumed

to remain constant within each clock hour. The exposure sequence follows the event sequence;

for each event the exposure is the product of concentration and duration.

There are two methods of determining the micro concentrations in the APEX model: FACTOR

and MASSBAL. The FACTOR method uses a regression equation to relate each micro to the

current ambient concentration. The MASSBAL method starts with the previous concentration in

each micro, which is modified over time by exchange with the ambient air. Both methods

require that a number of parameters, like proximity, penetration, and sources, be specified over

time. The MASSBAL method uses a few additional parameters like air exchange, volume, and

decay rates. These methods are described in greater detail in the next two sections.

All the information about the micros is provided on a single input file in ASCII text form. This

file can easily be viewed or edited by the user. When the input data are read, the model must

check that the information is complete, and that the parameters defined for each micro are

consistent. Not all parameters are needed for each micro, and in some cases defaults may be

assumed. An important feature of this file is that while the data itself may differ for each micro

and parameter, the format for presenting the data is always the same.

3
1) The MASSBAL method

The MASSBAL method uses a mass-balance algorithm with a one-hour time step. For reasons

discussed elsewhere, it was not deemed necessary to implement a finer time scale such as a oneminute mass balance algorithm. The MASSBAL method requires knowledge of the

concentration at the previous hour, which in turn depends on the hour before. Therefore, a single

hour or even a group of hours cannot be estimated without a method of establishing initial

conditions. In APEX, an initial 24 hour period is evaluated prior to the start of the simulation. It

is assumed that 24 hours is sufficient so that equilibrium is approached and the initial

concentration becomes irrelevant. The entire study period is then estimated hour by hour

without gaps, with each hour being used in determining the next. 

For MASSBAL, the possible parameters are Proximity, Penetration, AirExchangeRate (or

AirExRate), Volume, DecayRate, MeanR, CSource, and ESource. Additionally, the

concentration in the micro at the end of the previous hour (called ‘PrevConc’) and the ambient

concentration for the current hour are needed as well. 

First, the source terms must be converted to a standard format, in units of (ppm / hr). ESource

terms are expressed as emission rates in units of micrograms per hour. To convert ESource

terms to the standard units, the emission rate must be divided by the volume of the micro in

cubic meters, and divided by the conversion factor ‘F’ from ppm to (ug/m3). For CO, the

conversion is 1 ppm = 1145 ug/m3. CSource terms are expressed in units of concentration

(ug/m3). Strictly speaking, CSource terms are somewhat inconsistent with the MASSBAL

method, since concentrations should not be inputs but should be consequences of exchanging air

with the outside. Nevertheless, a suitable meaning can be attached as follows. Assume that a

micro is always in contact with clean air (ambient =zero), and it contains one CSource term. 

Then the mean concentration over time (CBar) in this micro from this source should be

numerically equal to CSource. If the mean source strength in units of (ppm / hr) is represented

by SBar, then in equilibrium,

CSource = CBar = SBar / MeanR

where MeanR is the time-averaged sum of the air exchange rate and the decay rate. Solving for

SBar, 

SBar = CSource * MeanR.

Since in general the mass balance solution will not be in equilibrium, the question remains as to

how to best estimate S. One solution is to replace SBar and MeanR by the time-varying

quantities S and R, where R = AirExchangeRate+DecayRate. This assumes that the source

strength is time-varying, but in proportion to the removal rate. To allow the most options for the

user, APEX3 will allow a user-defined MeanR distribution to be entered. If distributions for

MeanR are not entered then APEX will simply assume that MeanR equals the sum of the air

exchange rate and the decay rate at all times. 

4
If there are multiple ESource and CSource terms, then they can all be combined into a single

source term

S = ( ESource(1)+ESource(2)+..) / ( F * Volume) + ( CSource(1)+CSource(2)+...) * MeanR

Note that the units for ESource terms should be micrograms per hour, F should be in micrograms

per cubic meter per ppm (parts per million), volume should be in cubic meters, CSource terms

should be in ppm, and MeanR in inverse hours. The result S has units of ppm per hour.

Given the source strength S, the previous concentration PrevConc, the current ambient

concentration Ambient, and the current parameter values, the solution to the mass balance

equation with a one-hour time step is found by the process

R = AirExRate+DecayRate

EquilConc = (S + Ambient*Proximity*Penetration*AirExRate) / R

EndConc = EquilConc + (PrevConc-EquilConc)*Exp(-R)

MeanConc = EquilConc + (PrevConc-EquilConc)*(1-Exp(-R) ) / R 

Here ‘EndConc’ is the air concentration at the end of the hour, which becomes ‘PrevConc’ for

the next hour. The mean concentration over the course of the hour is given by MeanConc.

The consequences of the above equations for any MASSBAL micro are the following:

1) AirExRate is a critical parameter. 

2) DecayRate is also critical if not zero. But in many cases (like CO) it is zero.

3) Proximity and Penetration are essential unless assumed to be unity.

4) If any ESource terms are present, then Volume is necessary.

5) If any CSource terms are present, then MeanR is necessary, but it may assume a default value

of 

MeanR = AirExRate+DecayRate.

For any micro that uses the MASSBAL method, AirExRate is essential and Volume is also

essential if any ESource terms are used. Other parameters may be absent if the user is willing to

use the defaults. The defaults are DecayRate is zero, Proximity and Penetration are unity, and

MeanR equals the sum of AirExRate plus DecayRate.

On the micro descriptions input file it should be possible to provide distributions for unnecessary

parameters. For example, if Volume is given but there happens to be no ESource terms, then a

warning message should be issued but the run should continue.

2) The FACTOR method

5
The FACTOR method is simpler than the MASSBAL method. It has no mandatory parameters

and does not depend on previous concentrations. The parameters Proximity, Penetration, and

CSource are optional. Multiple CSource terms may be given, in which case they are additive. 

Other parameters cannot be used with FACTOR, and if they are present then a warning message

is issued. The basic equation for the FACTOR method is

Concentration = (Ambient * Proximity * Penetration) + CSource(1) + CSource(2) + ...

A missing proximity or penetration is assumed to be unity at all times. Naturally, missing

sources are assumed to be zero. If all parameters are missing, then the concentration in the

micro is the same as the ambient concentration. All of the terms in the above equation are given

hourly values. For the ambient concentration, these hourly values come from an input data file,

and may be either measurements or modeled results. For the other parameters, the hourly values

are the result of the calculations based on the information specified on the MP input file. 

3) The Micro descriptions input file

As mentioned above, for each micro there are a number of parameters such as proximity,

penetration, etc., that are used along with the ambient air concentration to determine the

pollutant concentration in that micro. Parameters for one micro are not related to the same

parameters for any other micro. Therefore, each micro-parameter (MP) combination is distinct. 

For example, the rules used to determine the proximity for the residence are distinct from the

rules used to determine any other MP. Specifically, the seasonal variation or the frequency of

resampling rules may differ for each MP.

The micro input file consists of two sections. The first lists the micros, assigning each a number,

a name, and a method. The method must be either MASSBAL or FACTOR. APEX uses the

micro number internally, the name exists only to assist the user. An example of the first section

of the micro input file follows:

Micro Name Method

1 Residence MASSBAL

2 Car MASSBAL

3 Office FACTOR

4 Restaurant FACTOR

5 InsideOther FACTOR

6 Outside FACTOR

The micros must be assigned distinct numbers in the range 1 to 127. It is customary but not

essential to assign consecutive numbers starting with one. The highest micro number should

equal NumMicros defined on the PARAMS input file. Another input file contains the mapping

from CHAD codes to APEX micros. That mapping must use the same set (or a subset) of the

6
micros defined on the micros input file, except that it may also use certain special mapping

numbers including zero and -1. Each micro must be of type MASSBAL or FACTOR.

The second section of the micro input file contains descriptive information for each MP. The

order in which the MP are presented is not significant to APEX, although it might help the user

to put each micro in numerical order. The following example shows the information for the

proximity parameter for the first microenvironment. The actual data are only for illustrative

purposes and are not intended to properly represent this MP in any real scenario. 

Micro number = 1

Parameter Type = PRX

Hours - Block = 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 

Weekday - Daytype = 1 1 1 1 1 1 1 

Month - Season = 1 1 2 2 2 3 3 3 4 4 4 1

District- Area = 1 1 1 1 1 1 

Condition # 1 = 0

Condition # 2 = 0

Condition # 3 = 0

ResampHours = NO

ResampDays = YES

ResampWork = YES

Block DType Season Area C1 C2 C3 PZero Shape Min Max Par1 Par2

1 1 1 1 1 1 1 0. Normal 0. 4. 1.5 1.2

2 1 1 1 1 1 1 0. Point 2. . . .

1 1 2 1 1 1 1 0. Lognormal 0. 6. 2. 1.5

2 1 2 1 1 1 1 0. Exponential 1. . 2. .

1 1 3 1 1 1 1 0. Triangle 0. 3. 2. .

2 1 3 1 1 1 1 0. Normal 1. . 2.5 1.5

1 1 4 1 1 1 1 0. Uniform 0. 3. . .

2 1 4 1 1 1 1 0. Lognormal 1. . 3. 2.

The general format is the same for all MP. The first two lines are mandatory and specify the

micro number and the parameter. The next seven lines describe the seven possible indices that

select the distribution used to evaluate the MP. Next come three resampling options, for hours,

days, and the work district. The remaining information consists of a header line, followed by the

distributions. 

The blocks of data for the various MP should be visually separated on the input file by comment

lines, which start with an exclamation point (!). 

Micro number

Naturally, this number must match one of the ones listed in the first section of the file.

Parameter type

7
The parameter types are indicated using standard codes. The units of the parameters are not

checked, in fact there is no way for the user to even report the units apart from using a comment

line on the input file. It is necessary that the parameters be provided in the correct units. The

parameters codes and required units are as follows:

Code Parameter Units Default Value

PR Proximity None 1

PE Penetration None 1

CS CSource parts per million (ppm) 0

ES ESource micrograms per hour (ug/hr) 0

DE DecayRate per hour (hr -1) 0

AE AirExRate air changes per hour (hr -1) -

VO Volume cubic meters (m3) -

MR MeanR per hour (hr -1) AirExRate+DecayRate

The micros and parameters as explained up to here were used in the same manner in the previous

version of APEX (which was APEX2). The remaining lines in the sample MP data shown above

require more detailed explanations, as these features are new. These are provided in the

following sections.

4) Time and Area Mappings

Time and area mappings are new in APEX3. The purpose is to allow the user to specify

distributions only once, and to tell the program when and where to use each distribution. In the

previous version it was necessary to provide an explicit distribution for every possible case,

which could mean hundreds or even thousands of distributions were needed for each MP. In

practical terms, the paucity of data on parameter distributions means that large numbers of

distinct distributions are seldom justifiable. Therefore, in APEX3 a method was developed that

allows the user to specify each distribution just once, which uses mappings that indicate when

and where each distribution is to be used. There are four such mappings, called hour-block,

dayofweek-daytype, month-season, and district-area. 

The concept of these mapping is to group the basic time and are units according to the

distributions needed to define each MP. For hours of the day the grouping is called a ‘block’. 

This term was used in the HAPEM model, but in APEX3 the hours that belong to a single block

no longer must be consecutive, so the term ‘block’ is perhaps over-restrictive. For days of the

week, the groupings are called ‘daytypes’. The most common daytypes are ‘weekday’ (MondayFriday) and ‘weekend’ (Saturday and Sunday). However, any other groupings are possible. 

There can be from one to seven daytypes, and the days in a given daytype do not need to be

consecutive. For months, the groupings are called seasons. Again, there can be any number of

seasons from one to twelve, and the months belonging to a given season do not need to be

consecutive. Finally, the air quality districts in the study area can be grouped into ‘Areas’, with

similar generality. The blocks, daytypes, seasons, and areas are all referred to by number; there

8
are no names attached to them. The user will likely attach implicit meanings to each, but these

are not part of the model. 

The Hour-Block (HB) mapping indicates which block each hour of the day belongs to. The

mapping must contain 24 numbers. The first is the block number for hour 1 (midnight to 1 a.m.),

and so on. All hours belonging to the same block use the same distribution. The block numbers

range from 1 upwards; there can be anything from 1 to 24 blocks. The number of blocks

(#blocks) is determined from this mapping itself. If the Hour-Block mapping is missing it is

assumed that there is only one block, which implies that the parameter values for all 24 hours of

the day are taken from the same distribution.

The Weekday-Daytype (WT) mapping is similar to the Hour-Block mapping, except that it

contains seven values instead of 24. The first value is the daytype for Sunday, the second is for

Monday, and so on until the last which is the daytype for Saturday. The seven days of the week

are in the same order as on a standard calendar. Thus if daytype 1 is weekday and 2 is weekend,

the vector should be ( 2 1 1 1 1 1 2), but without the parentheses. The mapping (1 2 2 2 2 2 1)

would be equivalent if the distributions presented further down were appropriately renumbered. 

If the WT mapping is missing on the MP input file, then only one daytype is assumed, that is, the

default mapping is (1 1 1 1 1 1 1).

The Month-Season (MS) mapping is similar to the previous two, except that 12 numbers are

needed. The first number indicates the season for January, and so on through December. In this

version of APEX it is not possible to subdivide a single month into multiple seasons. Again, if

this mapping is missing then a single season is assumed to apply to all months.

The District-Area (DA) mapping is similar to the others, except that the number of districts is not

a universal constant, but may vary from one simulation to another. It is likely that a user will

recycle MP input files from one model run to another, only making as many changes as are

necessary. Therefore, for those MP that do not depend on district (most of them), it is better to

omit the DA mapping. Otherwise, the program would complain if the same micro input file were

reused in a scenario with a different number of districts. If the mapping is present, the user must

ensure that it contains the correct number of terms (one area assignment for each district in the

study area).

Each mapping produces a scalar and several vectors that can be evaluated when the data are first

read. For Hour-Block, these are

NB - the number of blocks

HB(Hour) - the block number for each hour

HBR(Hour) - the block repetition number for each hour

HBN(Block) - the number of hours belonging to each block

The HB vector is the same as the data provided on the MP input file. NB is simply the highest

number in the HB vector. The block repetition number is the number of times that block has

9
occurred, in chronological order. Thus, the first hour assigned to a given block has HBR=1, the

second hour assigned to that block has HBR=2, etc. This can be calculated from the HB vector

as follows

DO J=1,24

 HBR(J)=COUNT(HB(1:J)==HB(J))

ENDDO

There are many equivalent ways to determine HBR(J). For example, this way also finds HBN 

HBN = 0

DO J=1,24

 HBN(HB(J)) = HBN(HB(J))+1

 HBR(J) = HBN(HB(J))

ENDDO

For the WT, MS, and DA mappings there are one scalar and one vector each

NT - the number of daytypes

WT(Weekday) - the type number for each weekday

NS - the number of seasons

MS(Month) - the season number for each month

NA - the number of areas

DA(District) - the area number for each district.

The month for each simulation day ‘D’ has already been determined and stored as

DaySeq(D)%Month, and the weekday for each simulation day has been stored as

DaySeq(D)%Weekday. 

Internally, APEX3 does not need either the WT or MS mappings separately; it needs the

combination of daytype and season for each simulation day, which is called the TS mapping. 

TS is numbered by daytype within season and then by season. For later convenience, the TS

numbering starts with zero and goes up to a maximum of (#daytypes*#seasons-1) or (NT*NS-1). 

Hence the vector TSN is indexed in the range (0:NT*NS-1) 

NTS - the number of daytype-season combinations

TS(SimDay) - the TS number for each simulation day

TSR(SimDay) - the TS repetition number for each simulation day

TSN(TS) - the number of days for each TS combination

NTS is simply the product of NT and NS. The vectors are given by

TSN = 0

10
DO I=1,NumDays

 TS(I) = WT(DaySeq(I)%Weekday) -1 + NT*(MS(DaySeq(I)%Month)-1)

 TSN(TS(I)) = TSN(TS(I)) + 1

 TSR(I) = TSN(TS(I))

ENDDO

Nothing further needs to be done with the district-area mapping. For each profile and MP, the

area for the home district is needed and optionally the area for the work district as well 

AreaH = DA(Person(P)%HomeD)

AreaW = DA(Person(P)%WorkD)

Note that these areas are properties of the MP-profile combination, since the DA mappings

themselves are properties of the MP and may differ from one MP to another. As such, they

should be calculated on the fly as needed.

3) Conditional Variables

The user may select up to three conditional variables from a pre-generated list. It is rare that

more than one will be needed. Many distributions will not have any. If one is used, it does not

technically matter whether conditional variable #1, #2, or #3 is used, but the ‘usual’ choice is #1. 

The variable is identified by its position on the master list, or alternatively by its name. The

programming is simpler if the number is used, but it would be easier for the user to make

mistakes. If more than one is used, it does not make any difference which one comes first, as

only the product matters (A and B is the same thing as B and A). It is conceivable to use the

same condition twice, but this would be both silly and inefficient.

The conditions all relate to variables attached to the personal profile. Currently, there are two

sets of such variables, stored in the structures for Person and Physiology. Both of these are

constant from one simulation day to another. A third structure will be developed for new

variables that have a specific value for each simulation day, such as WindowPos, or AC_On, etc. 

 The program will know which variables on its list are constants and which change daily.

It is possible that Speed could be a conditional variable, but then it would have to be lumped into

categories. If there were six possible speeds, then six distributions would have to be provided

for every combination of the other variables, which might become excessive. Ideally, a better

way to incorporate speed dependence can be developed.

There are two ways to indicate that a conditional variable is not used. Either the line for it can

be omitted, or else the variable number can be set to zero. The latter method is used in the

sample provided earlier in this document. In the distributional data section, the index for any

missing or unused conditional variable should always be set to ‘1'. 

11
4) Resampling Options

The time and area mappings indicate when the same distribution applies to multiple cases, which

avoids having to repeat the distributional data over and over. But even if multiple hours have

their parameter values drawn from the same distribution, that does not distinguish between cases

when a single parameter value is to be drawn and applied to multiple hours and when separate

values from the same distribution are to be drawn for each hour. The concept is called

resampling, and the two specific cases mentioned above correspond to ResampHours=NO and

ResampHours=YES. 

There are three resampling options, namely for hours, days, and work district. Each may be set

to either YES or NO. As indicated above, if ResampHours=NO, then all hours in the same

block on any given day will share the same parameter value. For each day, one parameter value

is drawn for each block. Hours in different blocks have their values drawn from different

distributions, so these values are never shared. If ResampHours=YES, then each hour in the

same block on the same day will have its own value drawn from the (same) distribution. This

means that 24 samples are drawn per day regardless of the number of blocks. The blocks

determine which parent distribution is used for each particular hour.

The second resampling variable is ResampDays. If ResampDays=NO, then the same daily

profile (set of 24 hourly values) is used on all days that belong to the same category. If

ResampDays=YES, then all days in the same category have new, independent values drawn for

them. The category for days is defined by the combination of daytype, season, and conditional

variables. An example might be all winter weekdays with windows open, if daytype = weekday

and season = winter and condition #1 = (WindowPos==OPEN), assuming these terms have been

defined appropriately. 

Until now, APEX always generated different samples for home and work locations. However,

after reconsideration, there are cases when this is not logical. For example, if a car is a

microenvironment and it uses the mass balance method, the volume of the car should be the

same wherever the car happens to be. If ResampWork=YES, then home and work always get

different values, whether they are in the same district or area, or not. If ResampWork=NO, then

the same values are used for work as are used for the home, again regardless of work district or

area. This is intended to be used for situations like the car volume example. Since these cases

occur rarely, the default is ResampWork=YES, meaning that the work district will normally get

its own distinct parameter values. 

To sum up, the default values for ResampHours and ResampDays are NO, and for ResampWork

it is YES. If a default is to be used then the line may be omitted from the input file, but it does

not hurt to show the lines anyway for purposes of clarity.

5) Specification of Distributions

12
 The number of distributions that the user must supply is the product of these numbers,

#Distributions = #blocks*#daytypes*#seasons*#areas*#c1*#c2*#c3

Here #c1 is the number of possible responses for conditional variable #1, etc. If a conditional

variable is not used, then it has one possible value (its index is always equal to 1). The number

of possible responses varies from one conditional variable to another; it can be looked up on a

list. Each distribution occupies one line on the MP input file. In the example data for proximity

given earlier, #blocks=2 and #seasons=4, with the other numbers equal to one, so eight

distributions are needed in that example.

The user does not need to number the distributions, this is done internally by the program. They

are assigned index numbers in standard Fortran order (the block index changes fastest, and

condition3 changes slowest). Thus, distribution#1 is for (1,1,1,1,1,1,1), and if there is more than

one block then distribution#2 is for (2,1,1,1,1,1,1), et cetera. On the input file the distributions

can appear in any order, but the standard order is preferred for consistency. 

Each line describing a distribution contains the following information. First, the seven indices

are listed; block, daytype, season, area, c1, c2, and c3. The order cannot be changed, and no

indices can be omitted. Next comes PZero, which is the probability that the returned value

should be zero instead of being selected from the distribution. Historically, this feature existed

in pNEM and earlier versions of APEX, and was used for primarily for cooking and smoking

emissions. For example, when cooking is not occurring then emissions are zero, but if cooking

occurs then emissions are sampled from a distribution. For many parameters (like house

volume) the PZero term is not sensible, in which case it should be turned off (set to zero). In

effect, all distributions are actually compound, with a probability of PZero that a value of zero is

returned, and a probability of (1-PZero) that a value is drawn from the distribution with the

stated shape. 

After PZero comes the distributional shape. Possible shapes include point, uniform, normal,

lognormal, triangle, and exponential. The program actually checks only the first letter of the

shape, so these can be abbreviated as P, U, N, L, T, and E, respectively. Finally, four parameters

are listed, the minimum, maximum, and two others. Not all parameters are necessary; missing

ones are represented by periods. The following table lists the required parameters.

Shape Required parameters Optional Parameters

Point Min

Uniform Min, Max

Normal Par1 (Mean), Par2 (Std.Dev) Min, Max

Lognormal Par1 (Geo. mean), Par2 (Geo. Std.) Min, Max

Triangle Min, Max, Par1 (Mode)

Exponential Min, Par1 Max

13
Some distributions permit optional Min or Max values, which represent truncation points. If a

sample value is outside the stated range then the value is resampled. 

6) Logic for Assigning Values

The basic task here is to assign a value to every MP for every hour of the simulation. Depending

on the resampling options, these values may be unique, or may be equal to values used for other

hours. Depending on the conditional variables, a value for any specific hour may be selected

from one of several distributions. 

The obvious approach would be to step through the simulation hour by hour, calculating which

distribution should be used, then generating a random value from it, before proceeding to the

next hour. This approach has two limitations. First, it is slow. Determining which distribution

is required involves a lot of repetition from one hour to another. Also, it is slower to generate

one random value from each of 1000 function calls than to generate 1000 random values from a

single function call. Ideally, therefore, it is best to return all the values required from each

parent distribution by invoking a single call. The second limitation to the obvious approach is

that if any resampling options are set to NO, then new values are not needed, but old values must

be reused. Then the problem is to decide which of the old values is appropriate. This is not

simply a calendar issue, but is more complicated if conditional variables are used. For example,

if ResampDays=NO, then on a winter weekday at 10 a..m. we need to use the value for the

previous winter weekday at 10 a.m. (if there was one), with the same values for any conditional

variables. This could require searches to be implemented just to determine a single parameter

value for a single hour, which is impractical. Since a model run can require literally billions of

values to be generated, it is too inefficient to indulge in such searches. 

The following approach is preferred. Note that here the term ‘hour’ refers to the indexed hour of

the entire simulation period, not hour of the day.

1) Evaluate and store the profile-independent parts of the hour-distribution mapping

before starting the loop over profiles. 

2) For each profile, evaluate the profile-varying part of the hour-distribution mapping.

3) For each hour, combine (1) and (2) along with the resampling options to determine

which distribution and which sample number from that distribution are to be used for

each hour.

4) Find the maximum sample number for each distribution from (3), and generate that

many random values and store them in a buffer.

14
5) Use the distribution number and sample number from (3) to assign a value from the

buffer to each hour.

6) If ResampWork=YES, then repeat steps 2-5 for the Work district for the current

profile. If ResampWork=NO, then simply copy the home district values to the work

district array.

This six-step process must be repeated for every MP. For each MP, steps 2-6 must be repeated

for every profile. A typical model run may contain 50 MP and 2000 profiles. For each

combination, the run may require 10,000 hourly values, both at home and at work. With

100,000 MP-profiles and 20,000 hourly values, a total of 2 billion parameter evaluations are

needed just to determine the microenvironmental concentrations. Many of these may require

random numbers to be drawn, a nontrivial task.

The rest of this section contains details on how to program steps, numbered 6-1 to 6-6.

(6-1) Constant (profile-independent) parts of the hour-distribution mapping

Here the term ‘constant’ means the mapping is the same for all profiles, which is not the same

thing as constant in time. The allocation of hours to blocks, daytypes, and seasons always

remains constant from profile to profile, although it may differ from one MP to another. The HB

and TS mappings evaluated in the Time and Area Mappings section above are constants, as are

the related vectors HBR, TSR, and scalars NB, HBN, and TSN. Code for evaluating all of these

was given earlier, but is repeated here for convenience.

HB(hour of day) is read directly from the MP input file. NB is the maximum block number. 

The HBR and HBN vectors are determined directly from HB. Of course, the space for these

values must be assigned before they can be evaluated and stored. This space is most logically

placed in an MP vector, with one complete data structure for each MP.

NB = MAXVAL(HB)

HBN = 0

DO J=1,24

 HBN(HB(J)) = HBN(HB(J))+1

 HBR(J) = HBN(HB(J))

ENDDO

Consider two nested DO loops over hours and days.

DO I = 1, NumDays

 D = TS(I)

 DR = TSR(I)

 DO H=1, 24

15
 B = HB(H)

 BR = HBR(H)

 J = H + 24*(I-1)

 ENDDO

ENDDO

This produces D, DR, B, BR and J values for each hour of the simulation, making use of the HB

and TS vectors. D is the daytype-season category, and DR is the repetition number for this

value. B is the block number and BR is the repetition number for this value. J is simply the

running index of simulation hours. To determine the actual distribution number for each hour J,

the profile-varying parts must also be calculated. The code for the profile-varying parts must be

incorporated into the above nested DO loops.

(6-2) Profile-varying parts of the hour-distribution mapping

The profile-varying part of the hour-distribution mapping is the part that depends on area or on

the conditional variables. The conditional variables may be of two types, each may be a constant

over time for an individual profile, or it may change daily. An example of a constant is the

possession of a gas stove. An example of a daily-varying variable is window status (open or

closed), or duration of gas stove usage (binned into categories). Effectively, the area behaves

just like a constant conditional variable, whether it refers to the home district or the work district.

For each simulation day, the case for the area and each conditional variable must be evaluated,

and converted to a DayShift. If the number of areas is one and there are no conditional variables,

then DayShift is the same for all days on all profiles. Otherwise, if there are no time-varying

conditional variables then the DayShift is the same for all days on one profile, but may be

different for another profile. In the final case, with time-varying conditional variables, the

DayShift may change day-to-day. A little calculation time may be saved by knowing ahead of

time which of these three cases applies (it will be the same for all profiles). 

Suppose we know #areas, #c1, #c2, and #c3, and we know the home area (AreaH) for the profile,

and on each simulation day I we can determine the condition numbers c1(I), c2(I), and c3(I). 

Then the DayShift for each day for the current profile is

DayShift(I) = (AreaH-1) + #areas*(c1(I)-1+ #c1*(c2(I)-1+#c2*(c3(I)-1)))

The minimum value for DayShift is zero, and the maximum is (#areas*#c1*#c2*#c3-1), or

NShift-1. 

DayShift is the profile-dependent part of the Distribution number.

There are two ways of looking at the DayShift vector. It could be considered part of the profile

itself, in which case it could be evaluated by ProfileModule at the time the profile is generated. 

However, the conditional variables will differ from one MP to another, so one DayShift vector

16
would be needed for each MP. The other way of looking at DayShift is as part of the MP

determination in MicroConcs. Here the calculation would take place inside the loop over MP,

and only one DayShift vector needs to be retained at a time. For the present, the latter seems to

be the preferable course.

The implementation is as follows. First, as part of the MP structure, variables exist to store the

following values:

NAr = # areas

NC1 = # possible responses for conditional variable #1

NC2 = # possible responses for conditional variable #2

NC3 = # possible responses for conditional variable #3

NShift = NAr*NC1*NC2*NC3

C1 = Choice for conditional variable #1

C2 = Choice for conditional variable #2

C3 = Choice for conditional variable #3

Calling the MP structure MPar, the #areas for a combination MP is given by MPar(MP)%NAr.

The rest of the information comes from the profile. This should probably be encapsulated in a

new subroutine. Suppose the DayShift vector is declared dynamically at the start of

MicroEnvModule:

INTEGER (KIND=IK), ALLOCATABLE :: DayShift(:)

and in Subroutine ReadMicroData

ALLOCATE (DayShift(NumDays)).

The new subroutine would contain all the hard-coded information on the conditional variables. 

It would also distinguish the three cases mentioned above, that DayShift is always zero, or it is

the same on all days for a given profile, or it changes daily. A new global variable called

‘NCFixed’ exists which is the largest conditional variable number that remains fixed and does

not change daily. In the example code given here, NCFixed = 4. Finally, there is a mapping

DA(Person(P)%HomeD) which must be supplied. This could made part of the MPar structure,

except that the length of the vector depends on the number of districts. It could be declared

separately, but this is not aesthetic. The new subroutine might look like

SUBROUTINE GenerateDayShift(P,MP)

INTEGER (KIND=IK), INTENT(IN) :: P ! Person or profile number

INTEGER (KIND=IK), INTENT(IN) :: MP ! MP number

INTEGER (KIND=IK) :: NAr, NC1, NC2, C(3), VC(3)

INTEGER (KIND=IK) :: AreaH, NDays, I, J

DayShift = 0

IF (MPar(MP)%NShift==1) RETURN

NAr = MPar(MP)%NAr

17
NC1 = MPar(MP)%NC1

NC2 = MPar(MP)%NC2

C(1) = MPar(MP)%C1

C(2) = MPar(MP)%C2

C(3) = MPar(MP)%C3

AreaH = DA(Person(P)%HomeD)

NDays = NumDays

IF (MAX(C)<=NCFixed) THEN NDays=1

DO I=1, NDays

 DO J=1, 3

 SELECT CASE C(J)

 CASE(1)

 VC(J) = Person(P)%GasStove

 CASE(2) 

 VC(J) = Person(P)%HasPilot

 CASE(3)

 VC(J) = Person(P)%HasAC

 CASE(4) 

 VC(J) = Person(P)%Gender

 CASE(5)

 VC(J) = PersonDay(I)%StoveUse

 CASE(6)

 VC(J) = PersonDay(I)%WindowPos

 CASE(7) 

 VC(J) = PersonDay(I)%SpeedCat

 CASE(8)

 VC(J) = PersonDay(I)%TempCat

 END SELECT 

 VC(J) = VC(J)-1

 ENDDO

 DayShift(I) = (AreaH-1) + NAr* (VC(1) + NC1* (VC(2) + NC2*VC(3)))

ENDDO

IF (NDays==1) DayShift(:) = DayShift(1)

END

The only problem with the above code is that it supposes that the values NC1 and NC2 have

already been determined and stored on the MPar structure. To do this, the actual cases must be

known. For example, the program must know that conditional variable #1 has two levels (YES

or NO), but some of the others may have more. Thus, this knowledge must reside in at least two

places in the code, one here and one accessible to the ReadMicroData subroutine. It would be

better if the mapping of conditional variables were only in one place, so it could be modified

without danger of inconsistencies arising.

18
(6-3) Combine constant and time-varying parts to find the hourly distribution and sample

numbers

Once DayShift is evaluated, for each simulation day both the day category D and the day

repetition number DR can be evaluated.

IF (ResampHours==NO) THEN DO

 HBR = 1

 HBN = 1

ENDIF

DR = 0

CALL GenerateDayShift(P,MP)

DO I = 1, NumDays

 D = TS(I) + NTS * DayShift(I)

 IF (ResampDays==YES) DR = TSR(I)-1

 DO H=1, 24

 NDist(H,I) = HB(H) + NB*D 

 NSamp(H,I) = HBR(H) + HBN(HB(H))*DR

 ENDDO

ENDDO

(6-4) The maximum sample number for each distribution, and generation of values

Now that the sample number for each hour has been determined, the total number of samples

needed from each distribution can be determined. Call this number DSS(N) (for Distribution

Sample Size of Distribution #N). 

IF (ResampDays==NO) DCN=1

DO N = 1, NDistrib

 B = 1+MOD(N-1,NB)

 DC = INT(N/NB)

 DSS(N) = HBN(B)*DCN(DC)

 Ptr => Distr(N)

 CALL Distrib(MDPtr=Ptr,RRes=Buffer(N,1:DSS(N)))

ENDDO

The actual distributions are indicated here as a list Distr(N). The organization of these

distributions across multiple MP will be discussed in a later section. The results from the

distribution call are stored in a buffer with the generic name ‘Buffer’, which is indexed by the

distribution and sample numbers. 

The main problem with the above code is that Buffer must be large enough to store as many

distributions and samples as might be needed. The number of distributions can be different for

19
each MP. The sample size might be as large as the total number of hours in the simulation

period. If space were allowed for 100 distributions with 10,000 samples each, the buffer would

occupy 1 million cells or 4 MB. It is not hard to imagine cases even larger than this. 

The alternative would be to create a one-dimensional buffer instead, and to append the values

returned from each distribution to the existing set. This would require a second vector

containing the starting indices for each distribution. However, the buffer itself would not need to

be very large. It would contain SUM(DSS(1:NDistrib)) values.

(6-5) Assign values to each hour

Consider a second buffer, this time called ‘Buff’ (the name will definitely change at some point

in the future). Buff has two indices, the first is the simulation hour and the second is the MP

number. The previous buffer (named ‘Buffer’) held values for a single MP only, and they were

not in hourly sequence.

For a given MP numbered N,

DCR = 0

DCN = 0

DO I=1,NumDays

 DC(I) = TS(I) + NTS * DayShift(I)

 DCN(DC(I)) = DCN(DC(I))+1

 DCR(I) = DCN(DC(I))

ENDDO

DO N = 1, NDistrib

 B = 1+MOD(N-1,NB)

 DC = INT(N/NB)

 DSS(N) = HBN(B)*DCN(DC)

 PTR => Distr(N)

 CALL Distrib(MDPtr=Ptr,RRes=Buffer(N,1:DSS(N)))

ENDDO

DO I=1,NumDays

 DO H=1, 24

 J = H + 24*(I-1)

 NDist(H,I) = HB(H) + NB * DC(I)

 NSamp(H,I) = HBR(H) + HBN(B(H)) * (DCR(I)-1)

 Buff(J,N) = Buffer(NDist(H,I),NSamp(H,I))

 ENDDO

ENDDO

This concludes the assignment of values to all hours for the home district.

20
(6-6) Resampling the Work district

Now, if ResampWork=YES, similar values must be generated for the work district for the same

profile. The area containing the work district might differ from the home area, in which case the

distributions will differ as well. However, it is not necessary to repeat all the above steps; many

of the results for the home district carry over to the work district.

The basic point is that the block, TS, and conditional variable assignments all remain exactly the

same in the home and work districts. The area may change, but if it does then it is a constant

change that applies to all hours and days. Specifically, all the distribution numbers for the work

district are offset from the corresponding ones for the home district by a fixed amount.

DCOffset = NTS * (AreaW-AreaH)

DistOffset = NB * DCOffset

Because this shift is always constant, that means that the sample numbers and DSS numbers

follow the same patterns as for the home district, apart from the overall shift. Thus, HBR and

HBN are identical to the home values, the DCR and DCN vectors are shifted by DCOffset using

the EOSHIFT function, and DSS is shifted by DistOffset, and NDist(H,I) is increased by

DistOffset. The NSamp array in unaffected.

Note that DCOffset and DistOffset may be positive, negative, or zero. If DCOffset is positive,

then AreaW>AreaH, and the distribution number assigned to each day is increased. Since

DCN(X) is the number of times that the day category is X, if all day categories are increased by

DCOffset then the DCN values are shifted to higher indices. This is done by using the

EOSHIFT function with a negative shift.

The buffer Buff had two indices, for hour and for MP. Clearly, if distinct work values are

needed then it requires another index with two values, either home or work. So now we have

Buff(J,HW,MP), where HW=1 for home, or HW=2 for work. The code fragment for generating

and assigning values is modified as

DCN = EOSHIFT(DCN,-DCOffset)

NDist = NDist + DistOffset

DO N = 1, NDistrib

 B = 1+MOD(N-1,NB)

 DC = INT(N/NB)

 DSS(N) = HBN(B)*DCN(DC)

 PTR => Distr(N)

 CALL Distrib(MDPtr=Ptr,RRes=Buffer(N,1:DSS(N)))

ENDDO

DO I = 1, NumDays

 D = TS(I)

 DR = TSR(I)

 DO H=1, 24

21
 B = HB(H)

 BR = HBR(H)

 J = H + 24*(I-1)

 Buff(J,2,N) = Buffer(NDist(H,I),NSamp(H,I))

 ENDDO

ENDDO

7) Organization of the MP data

The previous section explains how parameter values are filled for a single MP. The present

section is concerned with the method of storing information on the various MP, and the

alteration to data structures in APEX that are used by the MicroEnvModule. Nearly all the code

changes are contained within this one module.

The general information on each micro is stored in a structure of type MicroEnv. This structure

type needs some alteration. The MeanX parameter should be renamed to MeanR. Also,

NumSources should be broken into two parameters: NumESources and NumCSources. The

SourceNumber and SourceType vectors are no longer needed. 

The next question is how the actual MP data should be stored. This data is more or less

equivalent to the contents of the Micro input file. One point is that the amount of information

for one MP may vary from a couple of lines to hundreds of distributions, so a single framework

to hold them all may be inefficient. In any case, it is certain that the old APEX2 approach will

no longer work. That method called for all proximity distributions for all micros to be placed in

a single array. This no longer works since the block, season, and other indices will not have

consistent meaning or values from one micro to another.

Other than the number of distributions, the MP are similar to each other in their data

requirements. Each basically has the same twelve lines of information (micro#, parameter, HB,

WT, MS, DA, C1, C2, C3, and three Resamp options). Since all distributions are the same, they

could all be stored in a single list, much like the activity diaries. Then each MP would need two

additional pieces of information, for the starting index number and the #distributions. This

would allow each MP to access its distributions from the main list. Finally, room should be

made in each MP for the vectors HBR, HBN, DCR, DCN and so on, that are derived from the

calendar and the MP data. 

Not all parameters are needed for all micros. Therefore, the MP data do not fill a

(micro,parameter) array, since many of the possible combinations are not used. This raises two

efficiency questions. First, to avoid the waste of memory, how should space be allocated for the

MP data? Second, to avoid the waste of time, how should the micros and parameters be looped

over when filling in the concentrations? This question potentially is connected to the issue of

filling in micro concentrations only when the diary indicates the micro is occupied. Note that

only one micro is ever occupied at any time (although there may be several in one hour), but that

concentrations are needed in all micros for every hour. There are two reasons: first, the mass

22
balance method requires concentrations before the micro is entered, and second, it is time

consuming to search the diaries to identify the time periods that each micro is occupied.

The MP data itself could simply be referred to by a single index. For each profile, all MP must

be evaluated regardless of the micro# or parameter, so a single loop over all MP is sufficient. 

However, the results must be accessible in a more orderly fashion. One way would be to use the

MicroEnv structure to indicate where data for a particular MP are stored. For example, if

Micro(1)%Proximity=3, that means that the proximity data for micro#1 is stored in MP(3), the

third element of the MP vector. The MP vector stores the rules for determining the parameters. 

A second array, indexed similar to MP, could be used to store the output parameter values.

Using the above approach, for a FACTORS micro M, the concentration for each hour J for the

area HW (home or work) would be

Conc(J,HW) = Ambient(J,HW) * Buff(J,HW,Micro(M)%Proximity) *

Buff(J,HW,Micro(M)%Penetration) + Buff(J,HW,Micro(M)%CSum)

Here we have assumed that the output values are in an array Buff, and that the sources have been

added together into a term CSum. This equation could benefit from some abbreviation, but the

idea remains. For a MASSBAL micro, the result is

S(J,HW) = Buff(J,HW,Micro(M)%ESum)/(F*Buff(J,HW,Micro(M)%Volume))

+ Buff(J,HW,Micro(M)%CSum)*Buff(J,HW,Micro(M)%MeanR)

R(J,HW) = Buff(J,HW,Micro(M)%AirExRate)+Buff(J,HW,Micro(M)%DecayRate)

EquilConc(J,HW) = (S(J,HW) + Ambient(J,HW) * Buff(J,HW,Micro(M)%Proximity) *

Buff(J,HW,Micro(M)%Penetration) * Buff(J,HW, Micro(M)%AirExRate)) /

R(J,HW)

Conc(J,HW) = EquilConc(J,HW) + (Conc(J-1,HW)-EquilConc(J,HW))*Exp(-R(J,HW))

Again, the array referencing is cumbersome. The point is that the ESource terms are added and

stored in the result ESum, and the CSource terms are added and stored in CSum. The buffer

‘Buff’ has two indices: the first is the hour and the second is the MP number (apart from the

replacement of the individual sources by sums). The problem may be complicated by the fact

that certain parameters might not exist. For example, if there are no ESources, then ESum is

zero, but more importantly there is no Volume. Since the above equations divide by volume, a

computational problem results. One way around this is very sneaky. Any parameter that is not

used automatically points to element zero of the MP array. The buffer Buff has a column

numbered zero which contains a value of unity for all hours, and this value is never reset since it

is outside the DO loop over MP. Then, any unused parameter will always have a value of one. 

This will work great for all parameters except decay and the sources, which must be zero if

missing. For example, if the user does not define Proximity for some micro M, then

Micro(M)%Proximity=0, and Buff(J,HW,Micro(M)%Proximity) = Buff(J,HW,0) = 1. This

saves the program from calculating thousands of hourly proximity values that are all set exactly

to one. The use of the ESum and CSum terms helps avoid any problem with missing sources. 

23
ESum and CSum are initialized to zero, and then loops over the ESource and CSource MP are

performed, adding the results to ESUm and CSum, respectively. If these loops are empty, then

the sums remain at zero. However, the problem with the decay parameter remains. If the user

does not set the decay, a rate of zero should be assumed. This could be avoided by adding an

extra column to Buff, containing all zeros, or it could be solved by replacing the line for R(J) in

the above program fragment by two lines as follows

R(J,HW) = Buff(J,HW.Micro(M)%AirExRate)

IF (Micro(M)%DecayRate>0) THEN

R(J,HW)=R(J,HW)+Buff(J,HW,Micro(M)%DecayRate).

8) Random Number Seeds

APEX2 contains separate random number seeds for most micro parameters, including

AirExRate, Decay, Penetration, Proximity, Volume, and each Source. This allows the rules for

one of these parameters to be altered without changing the sequences of random numbers that are

generated for other parameters. The new MP approach makes the existing strategy obsolete. 

The obvious replacement for the above random number seeds is a list of seeds, one for each MP. 

In fact, the simplest way to do this is to make the seed part of the MP structure itself. This

structure is detailed near the start of the Fortran Code section which follows.

24
9) Fortran Algorithms

The MicroEnvModule code contains four distinct parts:

a) Front section

b) Subroutine ReadMicroData

c) Subroutine GetMicroDistrib

d) Subroutine MicroConcs

A lot of new Fortran code must be written in the MicroEnv module. The subroutines

ReadMicroData and MicroConcs must be totally replaced. The GetMicroDistrib subroutine

needs only minor changes, primarily to incorporate the new indices. Certain data structures and

space allocation, especially in the front section of MicroEnvModule, must be changed. Finally, a

list of conditional variables must be prepared, including the number of possible values each may

have. This may have to be coordinated with minor changes to the Profile Module and

GlobalModule (where the profile data are stored).

(9-a) Front Section of MicroEnvModule

The front section of MicroEnvModule contains the definitions of types (structures) pertaining

directly to micros. Structures defined here can only be used inside the subroutines of

MicroEnvModule, they are not accessible by the rest of APEX. Any structure needed elsewhere

must be defined in GlobalModule. 

The old version of APEX defined only one structure here, along with a series of arrays of

distributions. The new version will contain one array for all distributions, and several structures. 

The new version of the MicroEnv structure is

 TYPE :: MicroEnv ! Stores info on each micro

 INTEGER (KIND=IK) :: Index = 0 ! Index # for microenvironment

 CHARACTER(LEN=LEN2) :: Name = "" ! Name of microenvironment 

 CHARACTER(LEN=LEN3) :: Description = "" ! Description of micro 

 INTEGER (KIND=IK) :: CalcType = 0 ! Mass Balance or Factors

 INTEGER (KIND=IK) :: Proximity = 0 ! MP# for proximity 

 INTEGER (KIND=IK) :: Penetrate = 0 ! MP# for penetration 

 INTEGER (KIND=IK) :: AirExRate = 0 ! MP# for air exchange rate 

 INTEGER (KIND=IK) :: Decay = 0 ! MP# for decay rate

 INTEGER (KIND=IK) :: Volume = 0 ! MP# for volume 

 INTEGER (KIND=IK) :: MeanR = 0 ! MP# for mean removal rate

 INTEGER (KIND=IK) :: NumESources = 0 ! # emission sources in micro

 INTEGER (KIND=IK) :: NumCSources = 0 ! # concentration sources in

micro

 END TYPE MicroEnv ! Used to declare Micro array

25
The MicroEnv structure does not contain any distributions or parameter values. It merely

summarizes the information known about each micro in more general terms. The main purpose

of this structure is to ensure that all necessary parameters have been defined for each micro.

 TYPE :: MParam

 INTEGER (KIND=IK) :: Micro

 INTEGER (KIND=IK) :: Param

 INTEGER (KIND=IK) :: HB(24)

 INTEGER (KIND=IK) :: WT(7)

 INTEGER (KIND=IK) :: MS(12)

 INTEGER (KIND=IK) :: C1

 INTEGER (KIND=IK) :: C2

 INTEGER (KIND=IK) :: C3

 INTEGER (KIND=IK) :: RHours

 INTEGER (KIND=IK) :: RDdays

 INTEGER (KIND=IK) :: RWork

 INTEGER (KIND=IK) :: DOffset

 INTEGER (KIND=IK) :: NDist

 INTEGER (KIND=IK) :: ISeed(MAXK)

 INTEGER (KIND=IK) :: HBR(24)

 INTEGER (KIND=IK) :: HBN(24)

 INTEGER (KIND=IK) :: NB

 INTEGER (KIND=IK) :: NT

 INTEGER (KIND=IK) :: NS

 INTEGER (KIND=IK) :: NA

 INTEGER (KIND=IK) :: NC1

 INTEGER (KIND=IK) :: NC2

 INTEGER (KIND=IK) :: NC3

 END TYPE MParam

 TYPE (MicroEnv), ALLOCATABLE :: M(:) 

 TYPE (MParam), ALLOCATABLE :: MP(:)

 TYPE (CDist), TARGET, ALLOCATABLE :: Distr(:)

 

It is annoying to preset the size of the DA array in this manner. If MAXDISTRICTS is small,

there is a chance that a user might exceed it. If it is large, then a lot of wasted space will ensue. 

At compile time the number of districts is not known. At run time, it is known as soon as the

PARAMS file is read. However, it is not valid in Fortran to write

 INTEGER (KIND=IK) :: DA(NumDistricts)

26
since the quantity NumDistricts is not known to the compiler. Note that unlike SAS, the entire

Fortran program is compiled before the run begins. It is possible to set DA as an allocatable

array, but I am suspicious of attempts to make substructures allocatable, since that affects the

allocation and storage of the parent structure as well. The easiest solution is to remove the DA

vector from the MP structure and define it separately. Thus,

INTEGER (KIND=IK), ALLOCATABLE :: DA(:,:)

ALLOCATE ( DA(NumMP, NumDistricts)) 

Another quantity in a similar position is the TS array, which must contain one value for each

simulation day. This can similarly be removed from the MP structure and stored on its own

INTEGER (KIND=IK), ALLOCATABLE :: TS(:,:)

ALLOCATE ( TS(NumMP, NumDays)).

The INTEGER statements go in the front section of MicroEnvModule, and the ALLOCATE

statements go in ReadMicroData. With the removal of DA and TS from the MP structure, all

the remaining terms have known sizes so there is no wasted space.

In addition, the front section must contain two sets of PARAMETER definitions, the first of

which already exists in APEX2.

 INTEGER (KIND=IK), PARAMETER :: FACTOR=1, MASSBAL=2

 INTEGER (KIND=IK), PARAMETER :: PRX=1, PEN=2, AER=3, DEC=4, VOL=5, MR=6,

ES=7, CS=8 

 

The question of how to convert parameter names from the input file to parameter numbers is not

resolved. This could simply be hard-coded for now.

The arrays Buff and Buffer do not need to be defined here, as they are only used in one

subroutine (MicroConcs). 

(9-b) Subroutine ReadMicroData

 

This subroutine may actually be simpler than in APEX2. The reason is that all MP now share

exactly the same format, so only one piece of code is needed to process them all. Previously,

every parameter type (proximity, penetration, etc.) required specialized instructions.

The MP input file should be scanned twice. The first time through, the program merely counts

micros, MPs, and distributions. These counts are used to allocate the dynamic arrays. The

second time through, the data are read and stored in these arrays. In this manner, the arrays are

27
made only as large as necessary. If the arrays were predefined, they would have to be large

enough to accommodate any reasonable numbers that the user might choose, which would be

perhaps ten times larger than a typical run requires. 

ReadMicroData must perform the following actions.

1) Declare local variables

2) OPEN the MP input file

3) READ one line from the file 

4) Check the type of information on it

5) If a micro number, check it is in range

6) If a parameter type, add one to the MP counter

7) If a distribution, add one to the distribution counter

8) Loop back to step (3), if not at end-of-file

8) At the end-of-file, REWIND the MP file

9) ALLOCATE M, MP, Distr, DA, and TS.

10) READ one line from the MP file

11) Categorize line into one of four types

12) If a comment, then delete line

13) If an assignment (contains ‘=’), add the info to MP array

14) If a distribution header, delete

15) If a distribution, add it to Distr array

16) Loop back to (10) , if not at end-of-file 

17) At end-of-file, CLOSE file

18) Check that every micro has all the necessary parameters defined

19) Loop over MP, calculating the derived parameters

It would be nice if the code sorted the distributions into standard order, in case the user has not

done this. To do so, the program would already have to know all the counters, namely NB, NT,

NS, NA, NC1, NC2, NC3, for each MP. There are two ways to do this. One would be to

determine these counters during the first pass through the MP file, and then each distribution can

be correctly positioned as it is read during the second pass. In this way, the seven indices for

each distribution are only needed temporarily to figure out the assignment. The other way would

be to read all distributions in the given order, storing the seven indices, and at the end perform a

sort. This takes more space and time, and requires a sorting routine to be written. So the first

method is preferable. But that means that all the counters must be determined during the first

pass. The downside is that these counters must eventually be stored in the MP array, but this

array is not allocated until after the first pass. Therefore, the counters will have to be evaluated

twice, or else they must be stored in some predefined array, before we know how many MP there

are. Both options are inelegant.

28
For now, the simplest option is to insist that the user put the distributions in standard order. This

can be checked without much difficulty, and an error message produced if anything is wrong. 

This is much easier than trying to sort the data.

(9-c) Subroutine GetMicroDistrib

The purpose of GetMicroDistrib is to read a distribubition (one line) from the MP input file and

process that information into a standard form. The subroutine has two arguments, the first is the

input line itself, passed into GetMicroDistrib as a character string, and the second is a pointer to

a distribution. This pointer is of type CDist and is set to an array location prior to the subroutine

call, and the subroutine fills the various parts of the CDist structure. Since the pointer is simply

an alias for the row of the array, that means the array is filled with the various parts of the CDist

structure. 

The main thing that the existing subroutine does not do is to fill the PZero value. In the past, this

was only used with Sources, and in that case PZero was determined outside the GetMicroDistrib

code. This will have to change. After the shape is read, four numbers (R1, R2, R3, R4) are read. 

These are interpreted as the minimum, maximum, par1, and par2, respectively. One question is

whether this order should be maintained, or whether another is preferable. Possibly the order

should be different for different distribution types. One final point is that the exponential

distribution requires that R1, R2, and R3 all be non-missing. This should be checked, as I

thought that the exponential did not necessarily require a maximum. However, the formula in

Subroutine Distrib for the exponential does require a maximum. 

(9-d) Subroutine MicroConcs

Subroutine MicroConcs in APEX2 has one argument, the personal profile number. There is no

formal output argument, but the array MicroConc defined in GlobalModule is filled by the

subroutine. 

Like ReadMicroData, the code for the new MicroConcs subroutine might actually be shorter

than for the old one, despite all the new functionality that is being added. This is due to the fact

that all the MP are treated in exactly the same manner in the new code, so separate sections of

code for each parameter type are no longer required. 

The basic task of MicroConcs is as follows:

9-1) Evaluate each MP for each hour, at home and (optionally) at work.

9-2) Separately sum the ESource and CSource terms for each micro

9-3) Set the 24 hours before the start of the simulation for each MP

9-4) Set the values for each MP in the ‘other’ district

9-5) Locate the ambient air quality data for home, work and other.

9-6) Loop over micros

9-7) Identify FACTORS or MASSBAL, and calculate concentrations

29
9-8) Continue with next micro

For each MP in step 1, the following must be done

9-1-a) Calculate the vectors DCR, DCN for each profile

9-1-b) Find DSS(N), and draw that many random values and put them in a buffer

9-1-c) Calculate NDist(H,I) and NSamp(H,I) 

9-1-d) Populate the parameter array using NDist, NSamp, and the values in the buffer.

One important point is that the MP can be evaluated without regard to the micros. Since

concentrations are needed for all hours for all micros, that means that all MP must be fully

evaluated. This can be done in a simple loop over MP. The FACTORS and MASSBAL

equations point to the correct MP to be used for each micro. 

The earlier discussion pointed out the need for two buffers, named ‘Buff’ and ‘Buffer’ in the

text. The size of these buffers must be determined so they can be allocated properly. The one

called ‘Buff’ had dimensions (NumHours, 2, NumMP). Actually, to accommodate the initial 24

pre-simulation hours and the ‘other’ district, this should be increased to (-

23:NumHours,3,NumMP). 

The other buffer (called ‘Buffer’) is more difficult. That is indexed by the distribution and

sample numbers. Both of these quantities differ from one MP to another. The maximum number

of distributions used by any one MP is given by MaxN = MAXVAL(MP%NDist). The

maximum sample size from any one distribution is harder to determine, although it cannot

exceed the number of hours in the simulation. Therefore if we allocate Buffer as (MaxN,

NumHours), this is enough to cover all cases. If MaxN=100 and NumHours=10,000, then this

Buffer contains 1 million elements at 4 bytes each, or 4 MB. This is much more than is really

needed. If a clever way were found to compress this, a lot less wasted space would result.

One way to reduce the space needed for Buffer would be to cut it back to a single index. All of

the results would be stored sequentially in this vector. To retrieve them, an indexing vector

would be needed of length MaxN. As each distribution is sampled (sample size is DSS(N)), the

cumulative value of DSS(N) is written to the indexing vector; call it IndxB(N). The old method

of filling Buffer was 

CALL Distrib(MDPtr=Ptr,RRes=Buffer(N,1:DSS(N)))

which would now become

CALL Distrib(MDPtr=Ptr,RRes=Buffer(IndxB(N)+1:IndxB(N)+DSS(N))).

The old method of retrieving the values was

Buff(J,HW,N) = Buffer(NDist(H,I),NSamp(H,I))

30
and the new method would be 

Buff(J,HW,N) = Buffer(IndxB(NDist(H,I))+NSamp(H,I))

The buffer only needs to be long enough to store the maxuium number of samples that can be

returned for one MP, which is NumHours. So all that is needed is

ALLOCATE (Buffer(NumHours))

ALLOCATE (IndxB(MaxN))

The total space is the sum of NumHours and MaxN, instead of the product.

Another issue that must be resolved is task (9-2) above, summing the ESource and CSource

terms. This raises the following points:

a) How are the ESource and CSource MPs distinguished from non-source MPs?

b) Where are the sums stored?

c) Since the sums are separated by micro, how are the micros identified?

Points (a) and (c) can be resolved simply by searching all the MP in order. This could in fact be

done within the main loop over MP, that is, as part of step (1). As soon as all the hours of an MP

are filled, a check could be made to see if it is a source type, and if so then add it to the ESum or

CSum total for that micro. This might be more convenient than filling all the MP first without

regard as to which are sources. 

In fact, by adding the results to the sum during the processing of each MP, the issue of counting

the number of sources is irrelevant. 

Point (b) still remains. For each micro, two vectors (ESum and CSum) are needed, perhaps both

at home and at work. These vectors must be of length NumHours, or perhaps (-23:NumHours). 

So the allocation might consist of the following steps. At the start of MicroEnvModule, set

REAL (KIND=RK), ALLOCATABLE :: ESum(:,:,:), CSum(:,:,:)

and later on in ReadMicroData 

ALLOCATE (ESum (-23:NumHours,NumMicros,3), CSum(-

23:NumHours,NumMicros,3))

and finally, at the start of MicroConcs

ESum = 0.

CSum = 0.

The last index on ESum and CSum, which has value 3, makes room for the home, work, and

other locations.

31
Point (9-7) needs some explanation. It is easy to identify whether FACTOR or MASSBAL is to

be used, since the micro is known. What is harder is to determine which MP are to be used. 

Suppose that there is a structure called ‘Mic’ and ‘M’ is the index that loops over micros. Then

Mic(M)%Type will be either FACTOR or MASSBAL. (actually, 1 or 2). Suppose it is

FACTOR. Then the basic equation is

Concentration = (Ambient * Proximity * Penetration) + CSum

Now the number of the MP used to store Proximity for micro M can be indicated as

Mic(M)%Prx. However, there is the possibility that no such MP exists, in which case the default

is that all Proximity values should be unity. This can be achieved by setting up a special MP

numbered -1, with all values set to one. In the ReadMicroData subroutine, Mic(:)%Prx=-1 and

Mic(:)%Pen=-1 can be set, which assures that any micros that do not define Proximity or

Penetration will automatically have them set to unity. Similarly, if no CSources exist for micro

M, then CSum will automatically be zero.

In the above equation, concentration has three indices: hour, micro, and location, as does CSum. 

Ambient has two indices: hour and location. Proximity and Penetration are simply indices for

the MPar vector; the data for all hours for micro M and location L are in MPV(:,Mic(M)%Prx,L)

and MPV(:,Mic(M)%Pen,L), respectively. Hence, using an explicit loop over locations L for

micro M,

DO L=1, 3

 MicroConc(:,M,L) =

AQBuf(:,L)*MPV(:,Mic(M)%Prx,L)*MPV(:,Mic(M)%Pen,L)+CSum(:,M,L)

ENDDO

Now consider a MASSBAL micro. The main point here is that Volume is needed only if ESum

is not zero, and MeanR is needed only if CSum is not zero. Instead of actually checking ESum

and CSum, if is better if the number of ESource and CSource terms were included as part of the

Mic structure. Call these terms Mic(M)%NESources and Mic(M)%NCSources. 

The basic set of equations for any MASSBAL micro is the following:

R = AirExRate+DecayRate

S = ESum / ( F * Volume) + CSum * MeanR

Out = Ambient*Proximity*Penetration*AirExRate

EquilConc = (S + Out) / R

EndConc = EquilConc + (PrevConc-EquilConc)*Exp(-R)

MeanConc = EquilConc + (PrevConc-EquilConc)*(1-Exp(-R) ) / R 

Note that the constant F is called ‘PPMFact’ in the APEX3 code, and is defined on the PARAMS

file and stored in GlobalModule. It is therefore available anytime it is needed. Also note that if

the user does not define MeanR explicitly, then it is simply assumed to be the sum of the

32
AirExRate and the DecayRate. The absence of a user-defined MeanR term is indicated by

Mic(M)%MnR = 0. Set up two buffers called S and R with an index for hour. They can be

reused again for the next location and/or micro. The last three equations require explicit

stepping through time, starting at hour=-23 (one day prior to the actual simulation period). Let C

represent EquilConc, C0 represent PrevConc, and C1 represent EndConc. The MeanConc is the

desired value for the concentration, and is stored in the MicroConc array. At the end of each

hour, the PrevConc value is set to the EndConc value for the last hour. Hence, using explicit

loops for ours J and locations L, for a given micro M,

DO L=1, 3

 R(:) = MPV(:,Mic(M)%AER,L) + MPV(:,Mic(M)%Dec,L)

 IF (Mic(M)%MnR>0) THEN

 S(:) = CSum(:,M,L) * MPV(:,Mic(M)%MnR,L)

 ELSE

 S(:) = CSum(:,M,L) * R(:)

 ENDIF

 IF (Mic(M)%NESources>0) THEN S(:) = S(:) +

ESum(:,M,L)/(PPMFact*MPV(:,Mic(M)%Vol,L))

 C0 = 0.

 DO J=-23, NumHours

 IF (R(J)==0.) THEN 

 C1 = C0 + S(J)

 MicroConc(J,M,L) = C0 + S(J)*0.5

 ELSE

 ExpMR = EXP(-R(J))

 Out =

AQbuf(J,L)*MPV(J,Mic(M)%Prx,L)*MPV(J,Mic(M)%Pen,L)*MPV(J,Mic(M)%AER,L)

 C = (S(J)+Out)/R(J)

 C1 = C + (C0-C)*ExpMR

 MicroConc(J,M,L) = C + (C0-C)*(1.0-ExpMR)/R(J)

 ENDIF

 C0 = C1

 ENDDO

ENDDO

33
Conditional Variables

Before the MP values can be filled, the list of conditional variables must be constructed. This list

is needed by ReadMicroData, to find out how many possible responses each conditional variable

has, and it is needed by MicroConcs, when the data for a particular profile must be examined. 

The profile data itself is global, hence it is already available to both subroutines. Of course, a

new global structure must be added to the profile to contain the variables that change daily, like

WindowStatus, MaxTemp, etc. Actually, the three conditional variables themselves (C1, C2,

and C3) might be set up as pointers. The only problem with that is that some of them are scalars

and some are vectors. 

Add the profile variables that change on a daily basis to the DaySequence structure. For test

purposes, just add the two mentioned above (WindowStatus, MaxTemp). Note that all

conditional variables must be of integer type, and must be coded into a set of consecutive

numbers starting with 1. Since temperature is not in this form, define a variable called

MaxTempCat to hold the coded temperature category. Note that the DaySequence structure no

longer needs either Weekend or Season defined, since the definitions of these terms are now

specific to each MP. So the new DaySequence structure is 

 TYPE :: DaySequence

 INTEGER (KIND=IK) :: Year = 0 ! Year for each day of simulation

 INTEGER (KIND=IK) :: Month = 0 ! Month for each day of simulation

 INTEGER (KIND=IK) :: Day = 0 ! Day of month for each simulation day

 INTEGER (KIND=IK) :: DayOfWeek = 0 ! Day of week (0=Sun, 1=Mon, etc)

 INTEGER (KIND=IK) :: FirstHour = 0 ! First hour of simulation for given day

 INTEGER (KIND=IK) :: LastHour = 0 ! Last hour of simulation for given day

 INTEGER (KIND=IK) :: Weekend = 0 ! Weekend status (1=Sat,Sun; 0=other

day)

 INTEGER (KIND=IK) :: MaxTempCat = 0 ! Daily maximum temperature

category

 INTEGER (KIND=IK) :: WindowStatus = 0 ! Daily window status (1=OPEN,

2=CLOSED)

 INTEGER (KIND=IK) :: Pool = 0 ! Diary pool type for each day

 INTEGER (KIND=IK) :: DiaryNum = 0 ! Selected diary # for each day

 INTEGER (KIND=IK) :: FirstEvent = 0 ! First event # for given day

 INTEGER (KIND=IK) :: LastEvent = 0 ! Last event # for given day

 REAL (KIND=RK) :: EndGn = 0.0 ! Endogenous CO production rate

 REAL (KIND=RK) :: Max1Exp = 0.0 ! Daily maximum 1-hour average

exposure

 REAL (KIND=RK) :: Max8Exp = 0.0 ! Daily maximum 8-hour average

exposure

 REAL (KIND=RK) :: AvgExp = 0.0 ! Daily average exposure

 REAL (KIND=RK) :: Max1Dose = 0.0 ! Daily maximum 1-hour average dose

 REAL (KIND=RK) :: Max8Dose = 0.0 ! Daily maximum 8-hour average dose

34
 REAL (KIND=RK) :: Max1FDose = 0.0 ! Daily maximum end-of-hour dose

 REAL (KIND=RK) :: AvgDose = 0.0 ! Daily average dose

 END TYPE DaySequence

Now that the references to Weekend and Season are gone, the APEX code that refers to these

must be eliminated. This occurs in TimeSeriesModule, where the arrays SimBS, SimBT,

BSCount, and BTCount were defined. These arrays were used in MicroConcs to assign daytype

and season, and are no longer necessary. Therefore, these arrays can also be deleted from

GlobalModule. Also in GlobalModule, the random number seeds for all the micro parameters

can be deleted. These are IsdAER, IsdDec, IsdPen, IsdPrx, IsdVol, and IsdSrc. This also means

that the code in subroutine ReadParameters that sets these seeds must be modified. 

The method for filling the hourly values for each MP was described in section (6). Some

changes have been suggested later in this document, and in any case it would be helpful to

collect pieces of the Fortran code, or at least the algorithms, in one place. In the list of tasks (9-

1) to (9-8) above, all but the first two are already performed by the old MicroConcs code in

almost the same manner as required by the new MicroConcs, apart from the way in which the

MP data are stored. Nearly all of the major changes will 

be confined to (9-1) and (9-2). 

Diary selection

The activity diaries are grouped into pools according to the user-defined rules set in the

‘DiaryPools’ distribution on the Distrib.txt input file. Currently, this uses three temperature

bands and two day types (weekend/weekday) to define six pools. The temperatures and days of

the week come from the diaries themselves and therefore are not affected by changes to the

DaySequence structure. However, the dairy pools are used by assigning a pool to each

simulation day; this is done in subroutine ReadTemperatures, and the results are stored in

DaySeq(I)%Pool. This code explicitly uses both DaySeq%Weekend and DaySeq%MaxTemp to

determine the pool number. 

The Work Assignment calls for APEX3 to be able to use more than one temperature site. The

consequence is that MaxTemp will no longer be a property of the day alone, but will depend on

both the day and the district. The daily MaxTemp vector for a profile will depend on the home

district assigned to that profile. This means that the daily pool assignments currently stored in

DaySeq%Pool will also vary from one home district to another. 

One way around this is to remove both MaxTemp and Pool from the DaySeq structure, and

create separate allocatable arrays for each. Another way to do this would be to create a structure

analogous to DaySeq that had an additional dimension for the district number, and to make

MaxTemp and Pool parts of this structure. Other variables could then be added as needed. The

actual DaySeq structure could refer to this data via pointers set to the appropriate district. Either

35
way, it would be possible to generate all the pool assignments at the start of the run, and for each

profile the code would only have to set the two pointers.

Summary of Code Changes

APEX3:

In Main, add the argument (P) to the call to CompositeDiary. Also add a new call to

GenerateDailyVars after the call to GeneratePhysiology.

In ReadParameters and OutputParameters, delete the lines referring to NumBlocks,

NumSeasons, NumTempCats. NumCatsUseAC. Also delete the obsolete random number

seed initializations.

GlobalModule :

Delete MAXSOURCES

Change Type DaySequence as indicated above

Delete NumBlocks, NumSeasons, NumTempCats, NumCatsUseAC

Add a new Type DistrictDay with elements MaxTemp and Pool.

Add an allocatable declaration for an array DDay(:,:) of type DistrictDay

Delete the obsolete random number seeds IsdAER, IsdDec, IsdPen, IsdPrx, IsdVol,

IsdSrc

Delete SimBS, SimBT, BSCount, BTCount

ErrorModule:

Update as necessary anytime old code calling ErrorModule is deleted, or new code

calling ErrorModule is added.

DistributionModule:

No Change

TimeSeriesModule:

In CalcDates, delete SimBS and BSCount, and the setting of Season

In ReadTemperatures, add a header line indicating which districts each temperature

vector applies to. Also add a loop in case there are multiple temperature sites, and check

that all districts are assigned to one of the sites. Eliminate SimBT and BTCount. Put the

DiaryPools assignment into a loop over districts.

DiaryModule:

In CompositeDiary, add the argument (P) to the call. Also change the reference to

DaySeq(J)%Pool to the correct column of the DDay array (it should be

DDay(J,Person(P)%HomeD)%Pool)

ProfileModule:

36
Add a new subroutine called GenerateDailyVars. Have it assign the Window status and

Temperature category for each simulation day and add them to DaySeq.

MicroEnvModule:

Rewrite front section, ReadMicroData and MicroConcs completely.

Make minor changes to GetMicroDistrib

ExposureDoseModule:

No Change

37
Conditional Variable List

Jan 23, 2002

The list of profile variables that may be used as conditional variables (CV) should be written in

APEX3 just once. In this way, any modifications need to be made in one place only and there is

no danger of creating incompatible versions of this list at different places in the code.

The number of levels (values) that each CV may have is best determined on the fly. Some CV

such as Temp_Cat may be user-defined functions. Another such case might be Vehicle_Speed,

or Stove_Usage, and perhaps others. Any variable that is created by binning a non-categorical

variable may be allowed to have a user-defined binning strategy.

All of the profile variables must have explicit code that defines them in terms of previously

defined profile variables. The process starts with the selection of a (PopDistrict, Age, Gender,

Race) combination, according to the probabilities extracted from the population input file. Other

profile variables are then added, such as Employed, which can be a user-defined function of

these four. If the person is employed, then a WorkDistrict must be chosen. From the PopDistrict

and the DistrictMap mapping, the temperature can be derived. Actually, the best way to handle

temperature may be to define an array (sites, days) and then simply copy the right vector to the

personal profile. Similarly, Temp_Cat can also be an array, and again the correct vector can be

copied when the profile is generated.

A list of categorical profile variables and their CV numbers must exist somewhere. If this list is

hard-coded, it is both more difficult to alter and more difficult for a non-programmer to find. If

the list is read as input data then there is the danger that it could be modified without making

appropriate changes elsewhere in APEX, namely in the hard-coded profile variable evaluation

described in the previous paragraph. For example, if one added a second Temp_Cat variable to

the list, then the code would need to be modified to declare the new variable in GlobalModule as

part of the Person (or Physiology or PersonDay) structure, and to provide values for this new

variable.

For now, a compromise may be best. There is not much point in making the list into an input file

if it cannot be changed. Therefore, hard-code it for the present. Essentially, the list is a look-up

table that indicates which profile variable corresponds to each CV number. However, two

routines must make use of it. The first is GetCVCounts, which must determine the number of

possible levels for each CV. As indicated earlier, this may depend on user-defined mappings. 

However, it does not need to examine the profiles at all, and in fact is best evaluated once, prior

to the generation of any profiles. The second routine is GetCVValue, which must evaluate the

appropriate profile variable for the CV number that it receives. The compromise may be to

hard-code the list, but to treat both the location (CV number) and the number of values for each

profile variable not as constants, but as numbers to be determined when APEX is run.

38
One way to do this would be to actually store the list in an array, much like the list of UserDefined Distributions. Then, as each profile variable is determined (for the first profile at least),

the list is checked to see if (and where) that profile variable appears on it. If it is found, then the

number of possible values can be saved, indexed by CV number (which is the position on the

list). The number of possible values is either fixed (as for AC_Home), or determined from a

user-defined distribution whose name is fixed. The number of levels for each user-defined

distribution is part of its definition, and can be explicitly stored.

The problem is that the number of levels cannot be determined until the profile generator is

called for the first time, but the number of levels is needed to determine various MPar values, in

particular to determine if the correct number of distributions was provided on the Micro input

file. In the normal course of events, the Micro input file would be processed before any profiles

were generated. This is a chicken-and-egg problem.

The solution is to avoid using the profile generator for this task. The CV variables fall into two

types, those that have fixed definitions and those that are partly user-definable. For the fixed

CV, the number of levels can be hard-coded into the list itself. For the others, the default value

of one can be coded into the list, and the ReadDistribution subroutine can overwrite this when

the user definition is processed. Each user-definable CV has such a distribution, and the number

of levels is explicitly part of the definition. If the user fails to supply a definition, then it can be

assumed that there is only one category, and all input values produce an output value of unity. 

The CV list should be placed in GlobalModule so it is accessible by the various modules that

refer to it, including DistributionModule, ProfileModule, and MicroEnvModule. For each CV,

this list should include an index number, a name, an indicator of user-definable status, and the

number of levels. For the user-definable ones read by DistributionModule, the name of the

distribution should be the same as the name of the CV itself. Since ReadDistributions is called

before ReadMicroData, the proper number of levels for each CV are already known by the time

the MPar information is being filled.

- Declare CVList in GlobalModule

- Populate the CVList in a new subroutine FillCVList in ProfileModule

- Add code to ReadDistributions to search CVList to determine if each user-defined distribution

is a CV, and if so then record the number of items on the list.

- Modify the code in GenerateProfiles to be compatible with the new CV list.

39
DaySeq and related arrays

January 24, 2002

The existing DaySeq array in APEX2 has the DaySequence structure as follows:

 TYPE :: DaySequence

 INTEGER (KIND=IK) :: Year = 0 ! Year for each day of simulation

 INTEGER (KIND=IK) :: Month = 0 ! Month for each day of simulation

 INTEGER (KIND=IK) :: Day = 0 ! Day of month for each simulation day

 INTEGER (KIND=IK) :: DayOfWeek = 0 ! Day of week (0=Sun, 1=Mon, etc)

 INTEGER (KIND=IK) :: FirstHour = 0 ! First hour of simulation for given day

 INTEGER (KIND=IK) :: LastHour = 0 ! Last hour of simulation for given day

 INTEGER (KIND=IK) :: Weekend = 0 ! Weekend status (Sat,Sun=1, others=0)

 INTEGER (KIND=IK) :: MaxTemp = 0 ! Daily maximum temperature

 INTEGER (KIND=IK) :: Season = 0 ! Season for each day of simulation

 INTEGER (KIND=IK) :: Pool = 0 ! Diary pool type for each day

 INTEGER (KIND=IK) :: DiaryNum = 0 ! Selected diary # for each day

 INTEGER (KIND=IK) :: FirstEvent = 0 ! First event # for given day

 INTEGER (KIND=IK) :: LastEvent = 0 ! Last event # for given day

 REAL (KIND=RK) :: EndGn = 0.0 ! Endogenous CO production rate

 REAL (KIND=RK) :: Max1Exp = 0.0 ! Daily maximum 1-hour average

exposure

 REAL (KIND=RK) :: Max8Exp = 0.0 ! Daily maximum 8-hour average

exposure

 REAL (KIND=RK) :: AvgExp = 0.0 ! Daily average exposure

 REAL (KIND=RK) :: Max1Dose = 0.0 ! Daily maximum 1-hour average dose

 REAL (KIND=RK) :: Max8Dose = 0.0 ! Daily maximum 8-hour average dose

 REAL (KIND=RK) :: Max1FDose = 0.0 ! Daily maximum end-of-hour dose

 REAL (KIND=RK) :: AvgDose = 0.0 ! Daily average dose

 END TYPE DaySequence

This needs modification, mainly because new profile variables that vary daily must be defined,

such as WindowPos, VehicleSpeed, and Temp_Cat. These will have different values for each

profile. Furthermore, some of the existing variables (specifically MaxTemp, Season, and Pool)

are no longer profile independent.

The proposal is to divide the old DaySeq into multiple structures. The first may keep the name

DaySeq, but it will be restricted to those variables that are the same for all profiles. For now,

this means the first seven of the existing variables (Year through Weekend). The second can be

called PersonDay and will vary from one profile to another. This includes all the rest of the

existing variables except Season, which no longer has a single value per profile and day, but may

differ from one MP to another. Certain new variables may be added.

A third category of daily-varying data will be arrays of temperature-dependent data, such as

40
MaxTemp(TemDistrict, Day)

Temp_Cat(TemDistrict,Day)

Pool(TemDistrict,Day)

One way to handle this is to create a TemperDay structure. The resulting three structures are

41
 TYPE :: DaySequence

 INTEGER (KIND=IK) :: Year = 0 ! Year for each day of simulation

 INTEGER (KIND=IK) :: Month = 0 ! Month for each day of simulation

 INTEGER (KIND=IK) :: Day = 0 ! Day of month for each simulation day

 INTEGER (KIND=IK) :: DayOfWeek = 0 ! Day of week (0=Sun, 1=Mon, etc)

 INTEGER (KIND=IK) :: FirstHour = 0 ! First hour of simulation for given day

 INTEGER (KIND=IK) :: LastHour = 0 ! Last hour of simulation for given day

 INTEGER (KIND=IK) :: Weekend = 0 ! Weekend status (Sat,Sun=1, others=0)

 END TYPE DaySequence

 TYPE :: ProfileDay

 INTEGER (KIND=IK) :: DiaryNum = 0 ! Selected diary # for each day

 INTEGER (KIND=IK) :: FirstEvent = 0 ! First event # on EventSeq for given day

 INTEGER (KIND=IK) :: LastEvent = 0 ! Last event # on EventSeq for given day

 INTEGER (KIND=IK) :: WindowPos = 0

 INTEGER (KIND=IK) :: SpeedCat = 0

 REAL (KIND=RK) :: EndGn = 0.0 ! Endogenous CO production rate

 REAL (KIND=RK) :: Max1Exp = 0.0 ! Daily maximum 1-hour average

exposure

 REAL (KIND=RK) :: Max8Exp = 0.0 ! Daily maximum 8-hour average

exposure

 REAL (KIND=RK) :: AvgExp = 0.0 ! Daily average exposure

 REAL (KIND=RK) :: Max1Dose = 0.0 ! Daily maximum 1-hour average dose

 REAL (KIND=RK) :: Max8Dose = 0.0 ! Daily maximum 8-hour average dose

 REAL (KIND=RK) :: Max1FDose = 0.0 ! Daily maximum end-of-hour dose

 REAL (KIND=RK) :: AvgDose = 0.0 ! Daily average dose

 END TYPE ProfileDay

 TYPE :: TemperDay

 INTEGER (KIND=IK) :: MaxTemp

 INTEGER (KIND=IK) :: TemperCat

 INTEGER (KIND=IK) :: Pool

 END TYPE TemperDay 

 

 TYPE :: Profile

 INTEGER (KIND=IK) :: Index = 0 ! Sequential number for profile

 INTEGER (KIND=IK) :: HomeD = 0 ! Number of home district

 INTEGER (KIND=IK) :: WorkD = 0 ! # of work district (=HomeD if not

worker)

 INTEGER (KIND=IK) :: Age = 0 ! Age in years

 INTEGER (KIND=IK) :: Gender = 0 ! Gender (1=male, 2=female)

42
 INTEGER (KIND=IK) :: Race = 0 ! Race (definitions in PROFILE variables)

 INTEGER (KIND=IK) :: Employed = 0 ! Employment status (1=YES, 2=NO)

 INTEGER (KIND=IK) :: GasStove = 0 ! Has gas stove (1=YES, 2=NO)

 INTEGER (KIND=IK) :: GasPilot = 0 ! Has gas stove pilot light (1=YES,

2=NO)

 INTEGER (KIND=IK) :: AC_Home = 0 ! Has home air conditioning (1=YES,

2=NO)

 INTEGER (KIND=IK) :: AC_Car = 0 ! Has car air conditioning (1=YES,

2=NO) 

 INTEGER (KIND=IK) :: DGRP = 0 ! Demographic group (cohort) #

 END TYPE Profile 

 TYPE (ProfileDay), TARGET, ALLOCATABLE :: PersonDay(:)

 TYPE (TemperDay), TARGET, ALLOCATABLE :: TempDay(:,:)

and later on

 ALLOCATE (PersonDay(NumDays))

 ALLOCATE (TempDay(NumTemDistricts,NumDays))

Note that the PersonDay array does not retain the data for all profiles, only the current profile. 

This means that a new subroutine is needed that will be called inside the loop over profiles to

evaluate the elements of PersonDay for the current profile. This new routine has been referred to

previously as GenerateDailyVars, but it could be renamed GeneratePersonDay.

43
Modification of the COHb algorithm 

July, 2001

Introduction

The APEX model estimates human exposure and dose of carbon monoxide (CO). The dose

calculation refers to the percent carboxyhemoglobin (%COHb) in the blood, and is based on the

solution to the Coburn, Forster, Kane (CFK) equation, as detailed in Appendix E in Johnson et.

al. (2000). As pointed out by that report, the CFK equation does not have an explicit solution,

so some sort of iterative solution or approximation is needed to determine the %COHb. This

report compares several techniques for finding this solution.

The APEX model calculates %COHb for every diary event for each simulated person. A typical

model run of one calendar year has roughly 14,000 events per person. A run may consist of

several thousand such persons, constituting tens of millions diary events. This number is large

enough that any inefficiencies in the %COHb calculation result in large increases in model

execution time.

The pNEM/CO model as described in the aforementioned report used an iterative approach,

based on the Newton-Raphson root-finding technique, to find the %COHb concentration at the

end of each diary event. This worked well in practice, and had the advantage of converging

under all reasonable parameter values. However, there were several small drawbacks. First, the

code was difficult to follow. Second, the implementation could be more efficient, as typically

around nine function or subroutine calls were needed for each %COHb concentration. Finally,

while this method was reliable in obtaining the root (the %COHb concentration at the end of the

event, it did not produce an accurate estimate of the average %COHb level during the event. In

fact, the pNEM/CO model did not attempt to calculate a time-average, it simply used the final

%COHB concentration as being representative of the preceding hour. An obvious improvement

would be to average the initial and final values for each hour (or each event), but due to the nonlinear change in %COHb over time, this is not the true time-average.

Several approaches for estimating both the final %COHb value for each event and the timeaverage %COHb value for each event have been compared in numerical tests, summarized in the

tables at the end of this report. The conclusion is that the best approach is to use a modified

Taylor’s series method, which is restricted in time duration to ensure rapid convergence. This

means that the method may need to be used more than once to evaluate a single event. In coding

terms, this method is actually quite simple to implement and debug in Fortran, and also runs very

quickly. It also avoids the dangers of non-convergence that arise in some other methods.

Definitions

Throughout this report, certain terms are used repeatedly. These are defined in this section. 

First, the usual CFK equation is also called the non-linear CFK equation, and its solution is

called the non-linear solution. As explained in the introduction, there is no explicit form for this

44
solution, so it must be found either by approximation or by iterative methods. For purposes of

this report, the non-linear solution is considered to represent the ‘correct’ or ‘true’ value for the

%COHb level in the blood, with no error. Other solutions are accurate only to the extent that

they agree with the non-linear solution. The non-linear CFK solution as a function of time can

be represented by the symbol ‘N(t)’, to distinguish it from the linear solution. ‘N(t)’ represents

the %COHb level in the blood at time ‘t’, and is mathematically restricted to range between 0

and 100 (percent). It satisfies the following differential equation:

N`(t) = C0 - C1 N(t) / (100 - N(t) ) (1)

where C0 and C1 are constants (at least over the duration of one event) that depend on physical

and physiological parameters and on the CO concentration in the air. Equation (1) above is the

same as (Eq.12) in Appendix E in Johnson et. al. (2000), except that report uses the symbol

%[COHb] instead of N(t). 

In order to allow an explicit solution, a linearized version of the CFK equation is often used.

This was in fact the recommendation made in the original paper by Coburn, Forster, Kane

(1965). The linear solution may be represented by the symbol ‘L(t)’. The CFK equation is

linearized by replacing the time-varying denominator in the non-linear equation by a constant:

L`(t) = C0 - C1 L(t) / (100 - L(0) ) (2)

Here L(0) is the blood %COHb concentration at the start of the event. Note that for

convenience, the start of the event is defined to occur at time t = 0, and the constants C0 and C1

are expressed in units that allow time ‘t’ to be in minutes. Therefore, time ‘t’ means ‘t’ minutes

after the start of the event. In APEX, ‘t’ can be no larger than 60 minutes for a single event.

The linear CFK equation has an exact solution that is easy to work with, but the caveat is that 

is only an approximation to the ‘correct’ solution N(t). In the following section, the linear CFK

solution is examined along with several other methods of estimating N(t), to compare both speed

and accuracy.

For use in the APEX model, two quantities are of interest. The first is the %COHb level at the

end of a given event, that is, N(T) for an event of duration T minutes. The second is the timeaverage value of N(t) during the event. The time-average of N(t) between time=0 and time=t is

called ‘Nbar(t)’. It represents the average dose over an event. 

If the user wanted to know the maximum (or minimum) value of N(t) over an event, then it

should be pointed out that the solution N(t) is monotonic in time, as long as C0 and C1 remain

fixed. Thus, the larger of the initial and final values ( N(0) and N(T) ) will be the maximum of

N(t) over the event, and similarly the smaller of N(0) and N(T) will be the minimum. 

45
Descriptions of the various algorithms for estimating N(T) and Nbar(T)

In this section, five methods for finding N(T) and Nbar(T) are detailed. Most of these methods

entail setting a parameter that determines the accuracy of the solution. In practice, this means

that greater accuracy can be achieved at the cost of slower computer execution time. The

methods comparison examines both speed and accuracy, and in some cases more than one

parameter setting is examined to determine the speed and accuracy tradeoff for that approach.

1) pNEM/CO approach

As described in the introduction, the pNEM/CO model uses an iterative root-finding approach to

solve for the N(T) at the end of each event. It has the advantage producing accurate values for

any range of input parameters, but the disadvantage of not estimating a time-average value. In

the comparison tables, this method appears twice. The first, labeled ‘pNEM/CO’, is the method

implemented in the pNEM/CO model, where the ‘dose’ or time-averaged %COHb value Nbar(T)

was simply the same as the final value. The second method is labeled ‘pNEM/CO, (I+F)/2', and

it is the same as the first, except that Nbar(T) for an event is assumed to be the mean of the initial

and final values. These two methods obviously have the same accuracy as regards N(T), and the

same execution time, but differ in the accuracy of the dose estimates.

The code for the pNEM/CO approach was copied from the IBM mainframe version that was the

source of the APEX1 model. It was the version of pNEM/CO current in the summer of 1999,

and appears to be identical with the method described in Johnson et. al. (2000). The only

changes that were made was in the adjustment of some hard-coded physical and physiological

constants, to ensure that the algorithm is solving the same problem as the other algorithms. The

code consists of three routines, namely COHB, FUNCTN, and RTSAFE, from the pNEM/CO

model. 

2) Simpson’s rule approach

Simpson’s rule is also known as the trapezoidal rule, and is commonly used to estimate integrals. 

It involves dividing the event into a large number of very short intervals (subevents), and

assuming that the function is represented by a straight line during each interval. The timeaverage over each interval is simply the numerical average of the end points (initial and final

values) of the interval.

For application to the CFK equation, Simpson’s rule must be modified slightly. It is difficult to

evaluate N(t) directly at the end of an interval due to the lack on an explicit solution. However,

the initial value N(0) is known and the slope N`(0) is readily determined from equation (1). 

Since Simpson’s rule assumes that the function can be represented by a straight line over a small

time interval ‘dt’, the value N(dt) is given by

46
N(dt) = N(0) + N`(0) dt (3)

This process can then be repeated for the next interval, which requires putting the value N(dt)

into equation (1) to determine the value of N`(dt). Then, N(2 dt) can be determined, and so on. 

4) Linearized CFK equation approach 

As mentioned in the previous section, the linearized version of the CFK equation has a long

history. It has the advantage of being explicit, and also allows an explicit time-average to be

calculated. The drawback is that the linear method loses some accuracy. This is particularly true

for long duration events or high CO or COHb levels (or both). Note that the term ‘linearized’

refers to the form of the CFK equation itself, not to the solution. The solution, called L(t), is not

itself a straight line, but is actually an exponential function. The explicit form of L(t) is

L(t) = C0/C2 + (L(0) - C0/C2) exp(-C2 t), (4)

where C2 is the constant

C2 = C1 / (100 - L(0) ). (5)

In the programs and tables, the product (C2 t) is represented by the symbol ‘tau’ for

convenience. 

The linearized equation is fairly accurate, meaning close to N(t), as long as tau is small. As tau

becomes larger, the difference between L(t) and N(t) increases, but ultimately levels off at a

constant value.

One way to improve the accuracy of the linearized approach is to restrict the size of tau by

restricting the duration of the event. This is achieved by splitting one long event into two or

more shorter subevents. The linearized solution can then be applied to each subevent in turn,

using the final value for one as the starting value for the next. This is more accurate than

applying the linearized method to the entire event at once, but it is also slower. This tradeoff is

examined in the methods comparison section.

5) Taylor’s series approach

When the pNEM/CO code was migrated to personal computers and became the APEX model,

the %COHb algroithm was modified to use a Taylor’s series estimate of N(t). The solution N(t)

was expanded in a Taylor’s series about t=0, and terms up to third order were kept. This had two

practical advantages. First, it was extremely fast, since it involved only a single pass (no

iteration) and no calls to transcendental functions like EXP or LOG. Second, it was easy to code

and debug, as there were no separate ‘cases’ to consider, and no additional functions or

subroutines were needed. It produced reasonable accuracy under the operating range of the

47
APEX model. The main concern is that the method has a limited range of applicability (low to

moderate CO and COHb values), and it could be possible to push the APEX model to a point

where the series would fail to converge.

The problem of expanding N(t) in a Taylor’s series becomes simpler if some new variables are

defined first.

D0 = 1- N(0) / 100 (6)

A0 = C0 / (C0+C1) (7)

A1 = C1 / (C0+C1) (8)

D = D0 - A1 (9)

 z = (C0+C1) t / (100*D0*D0) (10)

‘z’ is a re-scaled time variable that is dimensionless. It is used as the independent variable for

the Taylor’s series expansion. In equations expressed as functions of ‘z’ rather than ‘t’, any

primes will indicate the derivatives with respect to ‘z’.

Two equations that follow immediately from the above are:

A0 = 1 - A1 (11)

D = A0 - N(0) / 100 (12)

Expressing equation (1) as a function of ‘z’ results in

N`(z) = D0 2 A0 - D0 2 A1 N(z) / ( 100 - N(z) ) (13)

The Taylor’s series about the origin (z=0) for N(z) is given by

N(z) = N(0) + N`(0) z + N``(0) z2

 / 2 + N```(0) z3 / 6 + Niv (0) z4/ 24 + ... (14)

The terms beyond fourth order will not be used in the following discussion. Any Taylor’s series

has a radius of convergence, which means the range of ‘z’ values for which the series converges. 

Inside this range, each additional term in the series is smaller than the previous one, and more

terms means a more accurate estimate of the function. Outside the convergence range, the terms

generally become larger, and the inclusion of more terms actually provides a worse estimate. A

discussion on convergence for the CFK problem follows in a later section of this report.

48
The value of N(0) is known (it is the %COHb level at the start of the event), and N`(0) can be

found from equation (13), using (6)-(9) to simplify the result: 

N`(0) = D0 2 A0 - D0 A1 N(0) / 100

= 100 D0 D (13)

To obtain the values of the higher derivatives such as N``(0) and N```(0), equation (12) is

differentiated with respect to ‘z’. This was first done by hand, and the results were verified by

performing symbolic differentiation using Mathematica. The results are:

N``(z) = - (100 D0) 2 A1 N`(z) / [ (100-N(z) ]2 (14)

N``(0) = - A1 N`(0) (15)

N```(z) = -(100 D0)2

 A1 N``(z)/[(100-N(z)]2 - 2 (100 D0)2 A1 N`(z)2 /[(100-N(z)]3 (16)

N```(0) = (2D - A1) N``(0) (17)

Niv(z) = - (100 D0)2 A1 [(100-N(z))N```(z) +3 N`(z) N``(z) ] / [(100-N(z)]3

 - 3 (100 D0)2 A1 N`(z) [(100-N(z))N``(z)+2 N`(z)2 ] / [(100-N(z)]4 (18)

Niv(0) = N``(0) [A1 2 - 8 D A1 + 6 D 2 ] (19)

The Taylor’s series for N(z) can now be evaluated. The Taylor’s series methods tested here

include both a third order and a fourth order version. The series truncated to third order is

represented by ‘T3(z)’, and to fourth order is represented by the symbol ‘T4(z)’.

T3(z) = N(0) +100 D0 D z -100 A1 D0 D z2

 / 2 +100 A1 D0 D (A1-2D) z3 / 6 (20)

T4(z) = T3(z) - 100 A1 D0 D (A1 2 - 8 D A1 + 6 D 2) z4

 / 24 (21)

Both T3(z) and T4(z) give good approximations to the correct solution N(z) anywhere in the

radius of convergence. For typical values for the constants in equation (20), convergence occurs

for z<1. For z values below this limit but still close to one, the convergence is slow, so the terms

beyond fourth order would be needed if high accuracy were desired. It is found that (z<1)

generally corresponds to N(0) values below forty to fifty percent for one-hour events.

The z value for a given event depends on the event duration, the initial %COHb level N(0), and

on the physiological parameters, and can be directly evaluated at the start of each event. For

events with a z value above some threshold, it is possible to improve the performance of

49
equation (20) by dividing the event into smaller events, each with shorter duration and hence

smaller z values. Thus, if a limit of z=0.5 is desired, then an event with z between 0.5 and 1.0

can be divided into two pieces, or an event with z between 1.0 and 1.5 can be divided into three

pieces, and so on. In the latter case, for example, the z value for the first third of the event will

be exactly one-third of the overall z value. For the second and third pieces, this is not strictly

correct, since their z values will be modified slightly since the initial %COHb for these intervals

will not match the overall initial %COHb exactly. However, the z value is not greatly affected

by changes in %COHb (unless the initial value is very large), so the z values for the subsequent

pieces will be either below, or if above then very close to, the threshold value.

Comparison of approximation methods

Table 1 through Table 5 present results for ten methods of estimating both the final %COHb

value and the mean or time-average value for an event. The methods are described in detail in

the previous section. Each method is summarized by five numbers. These are:

MeanF: Mean absolute error in final %COHb value N(t)over 25,000 scenarios,

MaxF: Maximum absolute error in final %COHb value N(t)over 25,000 scenarios,

MeanD: Mean absolute error in time-average %COHb value Nbar(t) over 25,000 scenarios,

MaxD: Maximum absolute error in time-average %COHb value Nbar(t) over 25,000 scenarios,

Time: Execution time in seconds for 10 million %COHb calculations.

The tables cover various ranges of CO and %COHb concentrations. The first table covers low

to moderate levels of CO in the air (range 0-150 ppm) and similarly low to moderate levels of

%COHb in the blood (0 - 6%). This includes well over 99% of the operating conditions for a

typical run of the APEX model. The second table extends the range of both CO concentration

(up to 500 ppm) and of blood %COHb (up to 20%), to a point that would include virtually all of

the values seen in an APEX run under current model usage. 

Tables 3 - 5 extend both the CO and %COHb concentrations to values beyond those seen in

typical APEX model runs. It should be noted that in reality, some people suffer acute CO

poisoning, sometimes fatal, that involve blood %COHb levels of 50% and above. The APEX

model now permits the user to define their own microenvironments. At some point in time,

modelers will try to apply APEX to scenarios that consider acute CO poisoning, say by defining

a house with a malfunctioning furnace as a specific microenvironment, or say a gasoline motor

operated indoors. Since APEX now permits users to attempt such scenarios, is it desirable that

the %COHb algorithm be stable and accurate beyond the parameter limits of the current model

scenarios.

50
Table 1: Low to moderate CO and COHb levels

 Range of CO = 0 to 150.0000 parts per million 

 Range of COHb = 0 to 6.000000 percent 

 Number of iterations = 10000000

 Method MeanF MaxF MeanD MaxD Time

pNEM/CO = 0.0000 0.0097 0.8822 2.2754 24.3

pNEM/CO, (I+F)/2 = 0.0000 0.0097 0.0392 0.0975 24.3

Simpsons, 1 min = 0.0034 0.0086 0.0289 0.0745 46.4

Simpsons, 30 sec = 0.0017 0.0043 0.0144 0.0372 87.6

Linear, 1 piece = 0.0104 0.0369 0.0033 0.0120 7.7

Linear, Tau<0.1 = 0.0031 0.0110 0.0013 0.0049 16.9

Linear, Tau<0.02 = 0.0007 0.0024 0.0004 0.0013 53.8

Taylor, 3rd = 0.0004 0.0016 0.0001 0.0004 6.6

Taylor, 4th = 0.0001 0.0002 0.0001 0.0002 6.7

Taylor, 3rd,Z<.5 = 0.0004 0.0016 0.0001 0.0004 7.9

Taylor, 4th,Z<.5 = 0.0001 0.0002 0.0001 0.0002 8.1

Taylor, 4th,Z<.25= 0.0000 0.0000 0.0000 0.0001 10.3

Table 2: Up to high CO and/or COHb levels

 Range of CO = 0 to 500.0000 parts per million 

 Range of COHb = 0 to 20.00000 percent 

 Number of iterations = 10000000

 Method MeanF MaxF MeanD MaxD Time

pNEM/CO = 0.0000 0.0093 2.7523 7.4329 23.8

pNEM/CO, (I+F)/2 = 0.0000 0.0093 0.1528 0.3666 23.8

Simpsons, 1 min = 0.0130 0.0314 0.0899 0.2437 46.4

Simpsons, 30 sec = 0.0065 0.0156 0.0448 0.1215 87.6

Linear, 1 piece = 0.1327 0.5133 0.0417 0.1669 7.8

Linear, Tau<0.1 = 0.0388 0.1490 0.0166 0.0672 16.8

Linear, Tau<0.02 = 0.0080 0.0282 0.0039 0.0144 57.5

Taylor, 3rd = 0.0078 0.0304 0.0014 0.0060 6.6

Taylor, 4th = 0.0006 0.0057 0.0002 0.0009 6.8

Taylor, 3rd,Z<.5 = 0.0056 0.0283 0.0011 0.0060 8.1

Taylor, 4th,Z<.5 = 0.0004 0.0057 0.0001 0.0009 8.6

Taylor, 4th,Z<.25= 0.0000 0.0003 0.0001 0.0003 11.0

51
Table 3: Up to very high CO and/or COHb levels

 Range of CO = 0 to 1000.000 parts per million 

 Range of COHb = 0 to 40.00000 percent 

 Number of iterations = 10000000

 Method MeanF MaxF MeanD MaxD Time

pNEM/CO = 0.0001 0.0093 4.9171 14.4347 22.9

pNEM/CO, (I+F)/2 = 0.0001 0.0093 0.3922 1.0583 22.9

Simpsons, 1 min = 0.0305 0.0777 0.1603 0.4743 46.5

Simpsons, 30 sec = 0.0152 0.0387 0.0799 0.2364 87.7

Linear, 1 piece = 0.6578 2.7010 0.2090 0.9095 7.7

Linear, Tau<0.1 = 0.1568 0.5973 0.0695 0.2576 18.4

Linear, Tau<0.02 = 0.0328 0.1119 0.0162 0.0572 64.6

Taylor, 3rd = 0.0560 0.6182 0.0109 0.1315 6.6

Taylor, 4th = 0.0142 0.3138 0.0023 0.0549 6.7

Taylor, 3rd,Z<.5 = 0.0077 0.1621 0.0020 0.0341 9.7

Taylor, 4th,Z<.5 = 0.0012 0.0549 0.0003 0.0093 10.3

Taylor, 4th,Z<.25= 0.0001 0.0024 0.0002 0.0010 13.7

Table 4: Up to extremely high CO and/or COHb levels

 Range of CO = 0 to 1500.000 parts per million 

 Range of COHb = 0 to 60.00000 percent 

 Number of iterations = 10000000

 Method MeanF MaxF MeanD MaxD Time

pNEM/CO = 0.0001 0.0099 6.3630 20.8184 24.5

pNEM/CO, (I+F)/2 = 0.0001 0.0099 0.7503 2.2634 24.5

Simpsons, 1 min = 0.0502 0.1385 0.2075 0.6871 46.4

Simpsons, 30 sec = 0.0250 0.0690 0.1033 0.3424 87.6

Linear, 1 piece = 1.8011 7.1638 0.5963 2.4468 7.7

Linear, Tau<0.1 = 0.3275 1.4003 0.1580 0.5909 20.7

Linear, Tau<0.02 = 0.0673 0.2519 0.0359 0.1243 75.9

Taylor, 3rd = 0.4843 15.3144 0.1023 3.4182 6.6

Taylor, 4th = 0.3668 21.6174 0.0649 3.9681 6.9

Taylor, 3rd,Z<.5 = 0.0108 0.2525 0.0048 0.2008 12.0

Taylor, 4th,Z<.5 = 0.0027 0.1064 0.0011 0.0905 12.9

52
Taylor, 4th,Z<.25= 0.0003 0.0049 0.0003 0.0041 18.8

Table 5: Up to fatal CO and/or COHb levels

 Range of CO = 0 to 2000.000 parts per million 

 Range of COHb = 0 to 80.00000 percent 

 Number of iterations = 10000000

 Method MeanF MaxF MeanD MaxD Time

pNEM/CO = 0.0001 0.0100 7.3439 26.2519 27.9

pNEM/CO, (I+F)/2 = 0.0001 0.0100 1.3402 4.4295 27.9

Simpsons, 1 min = 0.0712 0.2549 0.2383 0.8738 46.4

Simpsons, 30 sec = 0.0354 0.1262 0.1187 0.4352 87.7

Linear, 1 piece = 4.3551 19.6215 1.6556 10.6190 7.7

Linear, Tau<0.1 = 0.5017 2.6546 0.2832 0.9905 25.3

Linear, Tau<0.02 = 0.1010 0.4585 0.0620 0.2114 97.6

Taylor, 3rd = 26.9258 1186.4465 6.2970 283.7391 6.7

Taylor, 4th = 110.8587 7725.1494 21.2515 1498.5800 6.7

Taylor, 3rd,Z<.5 = 0.0129 0.2525 0.0079 0.2169 19.0

Taylor, 4th,Z<.5 = 0.0038 0.1025 0.0020 0.1068 21.0

Taylor, 4th,Z<.25= 0.0004 0.0051 0.0004 0.0045 35.2

Description of methods in Tables 1-5

All tests in Tables 1-5 cover a one hour event, which is the maximum permitted by APEX. Note

that all methods have equal or better accuracy on shorter events, so the tables present the worst

cases. Each table summarizes the results from 25,000 accuracy tests (500 CO levels times 50

%COHb levels), and the speed refers to the time required (in seconds) to perform 10 million

calculations. The accuracies were determined by comparison with the results of a Simpson’s

rule approach that used an interval of 0.1 seconds (the hour was divided into 36,000 intervals),

and double precision arithmetic. It was found that the Simpson’s rule results continued to

change as the interval was shortened until this point was reached. Other than this standard

calculation for comparison purposes, all the methods used single precision arithmetic.

1) ‘pNEM/CO’ refers to the algorithm current in the pNEM/CO model in the summer of 1999.

53
2) ‘pNEM/CO, (I+F)/2' refers to method 1, with the dose estimate replaced by the average of the

initial and final %COHb concentrations for the given event.

3) ‘Simpsons, 1 min’ refers to Simpson’s rule using 60 1-minute intervals and single precision.

4) ‘Simpsons, 30 sec’ refers to Simpson’s rule using 120 30-second intervals and single

precision.

5) ‘Linear, 1 piece’ refers to the solution to the Linear CFK equation, with the 1-hour event

taken as a whole.

6) ‘Linear, tau<0.1' refers to the Linear CFK equation, with the 1-hour event divided into enough

equal duration subintervals that the first subinterval had (tau<0.1).

7) ‘Linear, tau<0.02' is the same as method (6), except the subintervals were restricted in

duration such that (tau<0.02) for the first subinterval.

8) ‘Taylor, 3rd’ refers to a Taylor’s series keeping terms up to third order (the method used in

earlier versions of APEX).

9) ‘Taylor, 4th’ refers to method (8) with the addition of the fourth-order term.

10) ‘Taylor, 3rd, Z<.5' refers to a third-order Taylor series, with the 1-hour event divided into

enough equal duration subintervals that the first subinterval had (z<0.5).

11) ‘Taylor, 4th, Z<.5' refers to a fourth-order Taylor series, with the 1-hour event divided into

enough equal duration subintervals that the first subinterval had (z<0.5).

12) ‘Taylor, 4th, Z<.25' refers to a fourth-order Taylor series, with the 1-hour event divided into

enough equal duration subintervals that the first subinterval had (z<0.25).

Discussion

For practical purposes, an accuracy of 0.01% is more than adequate for both the final and the

time-average %COHb levels. In Table 1, all of the methods achieved this as a mean accuracy,

and all but the Linear method achieved it in all tested cases. For the Linear method in Table 1,

the maximum error was approximately (tau/10)%. However, setting a small tau value meant that

a relatively long execution time was required. 

The time-average or dose estimates in Table 1 show that the pNEM/CO method of simply using

the final value is subject to a fair amount of error. This is mitigated somewhat by the fact that

half of the time (when %COHb is rising), the error is in the positive direction, while the other

half of the time the error is in the negative direction, so over a long time the errors tend to cancel. 

54
However, the pNEM/CO and APEX models are often used in a threshold detection mode, to

determine if a specific dose threshold is ever crossed. Clearly, if the model overestimates rising

doses, it may occasionally cross the threshold when the other dose estimates do not. Note that

the improved dose estimate using the pNEM/CO approach is still only accurate to within 0.1% in

Table 1, the poorest performance of all the methods. 

The Simpson’s rule methods improve in accuracy in proportion to the number of intervals used. 

But these methods also slow down in a similar manner. To achieve high accuracy using

Simpson’s rule requires substantially more time than any of the other methods require. By

comparison, all of the Taylor’s series methods perform well in Table 1, being both fast and

accurate.

For Tables 2-5, the tendency is that all methods perform somewhat worse as the CO and/or the

%COHb levels increase. In Tables 4 and 5, it is seen that the two Taylor’s series methods that

do not use subintervals fail to converge, and the fourth order form is less accurate than the third

order form. To prevent the model from ever encountering this situation, it is better to use one of

the methods with subintervals. 

The fourth order Taylor series (with subintervals) is more accurate than the third order version,

at a very small cost in speed. The final method in each table examines the fourth order Taylor

series with a tight limitation on z (of only 0.25). It can be seen that this provides more accuracy,

but at a noticeable cost in speed. 

The implementation chosen for use in APEX3 is the fourth order Taylor series with subintervals. 

The limit on z that determines the number of subintervals can be read in as a modeling

parameter. In this way, the user can decide whether or not to trade accuracy for speed. A

recommended value for the z limit would be 0.4 or 0.5. Note that the new approach is about

three times faster than the pNEM/CO method at the most common concentrations, and is still

faster than the pNEM/CO method even at high concentrations.

Fortran Code

The Fortran code for the fourth order Taylor’s series with subintervals is presented here. Note

that this code is extracted from the accuracy testing program. The version that actually appears

in the APEX3 model differs only in minor details. For example, the APEX3 code has no

common blocks and no arguments, the relevant data are stored in global variables. The function

argument ‘FACTOR’ that appears below is actually the reciprocal of the upper limit on z;

therefore for a limit of z<0.5, set factor=2., or for z<0.4 set factor=2.5. In this version, the final

value for %COHb at the end of the event is returned as the function value, and the time-average

is stored as DOSE in a common block. In the APEX3 code, both of these values are stored as

global variables.

 FUNCTION COHbTay4S(RHBK,CRCMHB,Factor)

55
 COMMON /INBLK/ COPPM,ALT,VENT,HLDNE,BLOOD, HMGLB,DIFF,ENDGNS

 COMMON /GLOBAL/ XK0,XK1,COHBIN,COHB0,TIME,DOSE

 REAL :: K,K0,K1

 PM47 = 760.*EXP(-0.0000386*ALT)-47.

 PICO = COPPM*PM47*1.E-6

 PCO2 = 0.209*PM47-49.

 DIFFA = DIFF + 0.000845*VENT - 5.7 

 B = (1./DIFFA)+(PM47/VENT) 

 RHB0 = 1.39*HMGLB*CRCMHB / 100.

 K0 = (ENDGNS+PICO/B)/(RHB0*BLOOD)

 K1 = (1.+RHBK*PCO2)/(RHBK*RHB0*HLDNE*B*BLOOD)

 K = K0+K1

 A1 = K1/K

 D0 = 1.-COHB0/100.

 COHB = COHB0

 NREPS = 1+INT(Factor*K*TIME/(D0*D0))

 DSum = 0.

 DO N = 1, NREPS

 D0 = 1.-COHB/100.

 D = D0-A1

 Z = K*TIME/(D0*D0*REAL(NREPS))

 F1 = 100.*D*D0*Z

 F2 = -F1*A1*Z/2.

 F3 = F2*(2.*D-A1)*Z/3.

 F4 = F2*(A1*A1-8.*A1*D+6.*D*D)*Z*Z/12.

 DSum= DSum+COHB+F1/2.+F2/3.+F3/4.+F4/5.

 COHB= COHB+F1+F2+F3+F4

 ENDDO

 COHBTay4S = COHB

 DOSE = DSUM/REAL(NREPS)

 END

Note the simplicity of the code structure. There is just one DO loop and everything else consists

of assignment statements. There are no IF statements, or SELECT CASE statements, or

branching logic, or function or subroutine calls. The DO loop is only executed once for typical

low level CO and %COHb levels. This simplicity explains the fast execution speed. Table 5

shows that this algorithm give both final %COHB and DOSE values accurate to 0.1% in all

cases for %COHb up to 80% and CO up to 2000 ppm with (Z<0.5), and much higher accuracy if

the limit is set to (Z<0.25). 

Summary 

56
The fourth order Taylor series with subintervals method executes two to three times faster than

the previous root-finding algorithm. This is only marginally important, as the older version only

accounted for perhaps 3% of the model execution time. More important, the new method is

shorter to code, simpler to understand and to debug, and consists of a single subroutine call with

one loop that is executed a fixed number of times. The older algorithm used three subroutines

that are called until a convergence criterion is met, which potentially might never happen. The

final benefit to the new method is that an explicit evaluation of the time-average %COHb

concentration is returned as well as the final %COHb value. This was not available at all using

the previous algorithm.

References

Coburn, R.F., R.E. Forster, and R.B. Kane (1965). “Considerations of the physiology and

variables theat determine blood carboxyhemoglobin concentration in man”. J. Clin. Invest.,

Vol. 44, pp. 1899-1910.

Johnson, T., G. Mihlan, J. LaPointe, K. Fletcher, J.Capel, A. Rosenbaum, J. Cohen, P. Stiefer,

(2000). “Estimation of carbon monoxide exposures and associated carboxyhemoglobin levels

for residents of Denver and Los Angeles using pNEM/CO (Version 2.1)”. Report prepared for

U.S. Environmental Protection Agency under Contract No. 68-D6-0064.

(Reference 3). http://www.csia.org/home/cohazard.html. Source for data reported as “The

Building Official and Code Administrator, March/April 1993, BOCA International, publisher”.

57
The site selection and site matching algorithms

Feb 15, 2002

A number of new features regarding the selection and pairing of sites have been added to

APEX3. By contrast, earlier versions of APEX required the user to supply data for a set of

abstract ‘districts’, defined in any manner that the user chose. For each district, representative

air quality data and population data were required. The models did not allow information for

‘extra’ districts on the input files. Finally, only a single temperature site was permitted, which

was automatically paired with all districts.

There are three types of input data to APEX3 that refer to specific site locations. These are

population data, air quality data, and weather (temperature) data. The weather data could easily

include other variables besides temperature, as long as the format of one value per day per site is

maintained. The air quality data consists of hourly values for each site. The entire simulation

period must be covered by hourly data or else the air quality site will not be used. It is

permissible and even common for the air quality data to cover more time than the simulation

period. This allows the user to prepare a larger file with all the data for a given site and APEX3

can extract the part that it needs. The simulation period can then be changed without having to

alter the air quality data file. The population files contain counts by age, race, and gender, for

each geographical region. These are assumed to be time independent. 

The geographical units for population are called ‘sectors’ in APEX3. These may be the same as

census tracts, but there is no necessity to restrict the meaning. The geographical units for air

quality are called ‘districts’, consistent with usage in earlier versions of APEX. These are

essentially circles of user-definable size around fixed points. The points may either be the

location of monitors, or some representative point such as a county centroid or a grid cell

location. Similar considerations apply to the temperature sites, for which the geographical units 

are called ‘zones’.

To specify a study area in APEX3, the user must supply the coordinates (latitude and longitude)

of a central point, and a radius expressed in kilometers entered as ‘CityRadius’ on the PARAMS

file. Optionally, the user may provide a list of counties (using their FIPS codes) for inclusion in

the study area. The user must also supply input data files containing population, air quality, and

temperature data. 

The intended method for preparing APEX3 model runs is that the user would obtain or prepare a

few relatively large data files that could be reused for many different scenarios. A set of

population files covering the entire country are being prepared using the results from the census

of 2000. These files could be used without alteration for all model scenarios. It is possible to

construct a nationwide temperature file as well. Also, the air quality files might be much larger

than necessary. For example, a model run for Houston might use an air quality file that contains

all the data for Texas. 

58
To speed up the site selection and matching, APEX3 requires the three data types (population,

air quality, and temperature) to each have files indicating site locations and properties, separate

from the files containing the data. Thus, for air quality there is a file containing the site name,

coordinates, start date, and stop date, with one site per line. This file is much smaller and more

manageable than the file containing all the hourly observations, which may amount to tens of

thousands of values per site. The temperature data is arranged similarly. The population site file

is also similar, apart from the absence of start and end dates. The population site file therefore

contains only three values per line, the site name (of which the first five characters must be the

county FIPS code), and latitude and longitude, both of which must be in decimal degrees.

For each of the three data types, APEX3 must read the site files and determine which sites are to

be used. These sites must be numbered, and each of the three files requires three numberings,

which are explained below. The first number indicates the position on the original site list. This

is needed for later extraction of data appropriate to that site. For example, if a cluster of sectors

in Harris County, Texas are to be used to model the Houston area, the first such sector might be

number 45,000 on the nationwide census tract list. There is no need for APEX3 to read or store

data for tracts that are far from Houston. This is determined by calculating the distance between

each sector on the input file and the study area center, and only keeping those within the stated

study area radius. Since the actual population data is not on the same file as the population sites,

it is important for APEX3 to know that sector #1 on the short list of sectors close to Houston

corresponds to sector #45,833 (or whatever) on the main population data file, and #2 on the short

list is # 46,012 on the main file, and so on.

Short lists of nearby sites are also compiled for the air quality sites and the temperature sites. 

Since this process of creating short lists requires only one pass through each site list and one

distance calculation per site, it proceeds fairly quickly even if the site lists are long. Once the

three short lists have been constructed, the next step is to pair up sectors with districts and with

zones.

Each sector is to be paired with the nearest air quality site and the nearest temperature site. It is

planned that the user will be able to manually override these selections if desired, but that is not

of concern to the general pairing process. For each sector, the nearest air quality site is found by

calculating the distances from the given sector to all the sites on the short list of air monitors. 

The nearest air site is identified and its distance is compared to the maximum allowed distance to

an air site (the ‘AirRadius’ parameter on the PARAMS file). If the nearest air site is close

enough, then the sector is mapped to that air site, else the sector is flagged as outside the study

area. Similar considerations apply to mapping the sectors to temperature zones. Note that both

of these mappings indicate the relative positions on the short lists. For example, sector #3 on the

sector short list may map to air site #5 on the air site short list. The air sites, at least the ones

included in the final analysis, are synonymous with ‘districts’.

Once the sector-district and sector-zone mappings are determined, the final lists of each type

must be created. The final list of sectors may be shorter than the sector short list, since some of

the sectors on the short list might not have a nearby air site. Similarly, not all sites on the air site

59
short list are necessarily used, since some air sites might not have any sectors assigned to them. 

The same applies to temperature sites (zones). Thus, for each data type, the final list may be

shorter than the short list. In the previous example, sector #3 was paired with district #5 on the

respective short lists. But this sector might be #2 on the final list, and district #5 may become

district #3 on the final list. Thus, sector #2 on the final list must obtain its population data from

the double mapping (#2 final -> #3 short list) and (#3 short list -> #46,052 on input file). 

Similarly, the air quality data for final district #3 is located from the double mapping (#3 final ->

#5 short list) and (#5 short list -> #736 on input file). Finally, the three mappings (sector #3

short list -> district #5 short list), and (sector #2 final -> sector #3 short list), and (district #3

final -> district #5 short list) must be combined to produce (sector #2 final -> district #3 final). 

A similar combination of mappings is done for the temperature zones. 

Once these mappings have been resolved, the numbers of sectors, districts, and zones are

determined ,and arrays are allocated of the correct size to hold each type of data. The actual data

relevant to the final lists are read from the input files to fill these arrays. After this, the only

mappings that need to be retained are the (final sector # -> final district #) and (final sector # ->

final zone #) mappings. 

60
Revisions to the Commuting Data, February 21, 2002

The APEX2 model required the user to supply both population counts (by home location) and

commuting flows from home to work, both aggregated to the district level. Here ‘district’ refers

to the area around an air monitor site that is deemed to be represented by that monitor, generally

a circle with a set radius. This meant that the user had a large burden of data preparation. Also,

the user had implicit control over decisions on inclusion or exclusion of difficult cases, such as

persons who lived in a known district but worked outside the known districts. These persons

could be reassigned to a known district, or simply excluded from the model by removing them

from the overall population statistics. Note that in APEX2 the relative location of the districts

was immaterial to the model, and in fact was never determined.

In APEX3 the geographical unit for both the population and the commuting flows is now a

‘sector’, which is usually identified with a census tract. Each sector has coordinates, a latitude

and a longitude, that represent the sector ‘location’. This is an idealization that treats the sector

as a point and ignores its geographical extent. Similarly, each air monitor (or each modeled air

site) has coordinates indicating its location.

Each simulation in APEX3 requires the user to specify a study area center and a radius. 

Optionally a list of counties may be specified as well. The model then reads the file that lists the

location of the population sectors and selects those within the designated circle (and optionally,

counties). Similarly, air monitor locations near the study area are extracted from the air site

input file. Distances from each selected sector to each air site are calculated, and the minimum

distance is used to assign an air site to each district, assuming the nearest is within a predefined

radius. Sectors without a sufficiently close air site and deleted from the study area.

The intention of the above method is that a single site file for population sectors can be prepared

for the entire country, and that all APEX3 model runs would use that same file as input. This

greatly reduces the burden of preparing input files. Similarly, a single nationwide file of

commuting data has be prepared; it is around 120 megabytes in size. APEX3 can then extract

the flows for the selected home sectors from this large commuting file. 

It is inevitable that some of the persons living in the selected home sectors will commute to

sectors outside the study area. The decision has been made by EPA to exclude such persons

from APEX3. The implementation is as follows. In APEX3, the profile parameters are

generated all at once by Subroutine GenerateProfiles in the ProfileModule. If 500 profiles are

desired, the parameters for all 500 are generated and stored in an array before any exposures are

calculated. This is useful both from an efficiency point of view and because later on the model

creates tables of various exposure and dose measures across profiles. To keep this logic in place,

it is necessary to identify and eliminate any profiles that commute out of the study area before

finalizing the profile array. It would be awkward if the array of 500 profiles had gaps where

profiles were deleted. Hence, the GenerateProfiles subroutine should identify profiles that

commute outside the study area, eliminate them, and replace them with new profiles, so that it

returns a full list of 500 (or whatever number was requested) valid profiles. 

61
Creation of the nationwide Commuting file

The source of the data used to create the nationwide commuting file was a set of files of home

and workplace locations (i.e. census tracts), with counts for each pair representing the number of

persons fitting the description. These data were collected by the census bureau around 1990 and

generally follow the census tract numbering as used in the 1990 census. The data were

generated from a sample, so very small flows may be missing. The files do not list tract pairs

that have flows of zero persons. The original format was one file per state, using the workplace

tract to identify the state. 

One concern that was immediately apparent is that some home-work pairs are very widely

separated. For example, some people live in Alabama but work in Alaska. This may be the case

for either military personnel, or others who are stationed in remote workplaces for weeks or

months at a time. However, in APEX3 the need is for commuting flows, which implies that the

home to work and return journeys occur on a daily basis. Unfortunately, there is no way to

determine the number of such cases from the original data files. 

A preliminary data analysis of the home-work counts showed that a graph of Log(flows) versus

Log(distance) had a near-constant slope out to a distance of around 120 kilometers. Beyond that

distance, the relationship also had a fairly constant slope but it was flatter, meaning that flows

were not as sensitive to distance. A simple interpretation of this result is that up to 120 km, the

majority of the flow was due to persons traveling back and forth daily, and the numbers of such

persons decrease fairly rapidly with increasing distance. Beyond 120 km, the majority of the

flow are persons who stay at the workplace for extended times, in which case the separation

distance is not as crucial in determining the flow.

To apply the home-work data to commuting patterns in APEX3, a simple rule was chosen. It

was assumed that all persons in home-work flows up to 120 km are daily commuters, and no

persons in more widely separated pairs commute daily. This meant that the list of destinations

for each home tract can be restricted to only those work tracts that are within 120 km of the

home. This distance cutoff eliminates 4.75% of the home-work pairs in the nationwide database,

representing 1.29% of the workers. The assumption is that this 1.29% of workers do not

commute from home to work on a daily basis.

The remaining home-work tract pairs were sorted by the home tract ID, and for each home tract

the possible destinations were listed, one per line, also sorted by tract ID. The flows were

converted to fractions of the home tract total, and then expressed as cumulative fractions since

this is the form that will be needed by APEX3. This information was written to an ASCII text

file. Every record in this file contains three variables: a tract ID, a flow fraction, and a distance. 

A convention was used that the flow fraction and distance were set to -1.0 to indicate a home

tract. The first three records on the nationwide ASCII file are as follows:

62
01001020100 -1.0000 -1.0

01001020100 0.05006 0.0

01001020200 0.05704 1.6

The first record contains the ID of the first home tract by sort order. The second record contains

ID for the first destination tract for that home tract, which happens to be the same tract. Only

5% of the commuters who live in this home tract also work there. The separation distance is

zero since the home and work tracts are the same. The third record shows the second destination

tract in sort order, followed by a cumulative fraction of 0.057. This means that only 0.7% of the

workers in that home tract go to the specified work tract, despite the two being only 1.6

kilometers apart. This particular home tract has 31 destination tracts to which workers commute.

There are two ways to know that the list of destinations for a given home tract has been

completed. First, the cumulative flow fraction for the last destination is always 1.00000. 

Second, the next record on the file has the negative flow and distance indicators. The median

number of destinations for all home tracts is 58, and the maximum number of destinations

(within 120 km) for one home tract is 559. Overall, this file has over 4.2 million records and

occupies 125 megabytes of disk space.

The national commuting database for the 2000 census tracts

The discussion in the previous section referred to the preparation of the national commuting

database for the 1990 census tracts. On March 8, 2002, new population files containing the agerace-gender combinations for the 2000 census were obtained. These files make use of a revised

list of census tracts. The 1990 census had about 61,250 tracts nationwide. The 2000 census has

65,443 tracts, a 7% increase. However, a large number of tracts had modifications, often by

carving a piece off one tract and adding it to another. In some cases, the tract boundaries did not

change, but the tract ID changed. 

A file was obtained from the Census Bureau listing all the 1990 and 2000 tracts, and their

overlapping regions and populations. This file contains one record for each tract fragment that

belongs to a unique 1990 and 2000 tract pair. There are over 90,000 of these tract fragments,

which can be aggregated back to either the 1990 or 2000 tracts. This file provides the population

of each fragment as well as the fractions of tract population that the fragment contributes, for

both the 1990 and 2000 tracts.

The national commuting database for the 1990 tracts was mapped onto the tract fragment list by

assuming that each fragment receives a flow proportional to its fraction of the 1990 tract

population. The second assumption is that the fractional flow to each destination is similar for

all fragments of a single home tract. Then the fragments were population-weighted using the

new 2000 census populations, and aggregated to form the new 2000 tracts. This database

contains about 50% more home-work tract pairs than the 1990 database, since many single

destinations from 1990 now are multiple destinations for 2000.

In the commuting database for the year 2000 tracts, the average home tract sends flows to 104

destination tracts, with a range from 1 to 829 destinations. All 65,443 tracts for the 2000 census

63
are listed as home tracts, and over 6.6 million destinations are listed. This file occupies 180

megabytes of disk space. A typical computer can read this file and extract the part relevant to

the APEX study area in under one minute.

Processing the nationwide commuting file in APEX3

Before the commuting file is read in APEX3, the final list of sectors to be included in the model

run must be prepared. This includes sectors within a specified distance of the study area center,

within a specified list of counties (optional), and within an acceptable distance of air and

temperature sites. The sectors that meet these requirements are called the ‘study area’. It has

been decided that APEX3 will require workers to live and work inside the study area or else they

will be excluded from consideration. 

It will be assumed that both the population input file and the commuting input file are sorted by

home sector. However, it will not be assumed that every sector on one file also appears on the

other. The sectors that belong in the study area, extracted from the population input file, are

numbered sequentially. Thus, for a given model run, sector #1 might be tract 48201000100,

sector #2 might be 48201000200, and so on. The commuting file must then be searched until the

first record for home tract 48201000100 is found, or until a home tract number larger than this is

found (which means that the commuting file contains no data for this home tract). Then all the

work tracts and their flow fractions are read for this home tract, the work tract IDs are converted

to sector numbers. Any work tract on the commuting file that is not part of the study area (not

on the sequentially numbered sector list) is assigned a sector number of zero. The work sector

numbers and the cumulative flow fractions are retained in a data vector. The index of the first

work sector for the given home sector is recorded in a mapping vector. Thus, the data for home

sector #1 will start in record #1 of the data vector, the data for home sector #2 may start in record

#59 of the data vector (assuming there were 58 destinations for the first home sector), and so on. 

In this manner, all the commuting data needed by the model are stored in these two vectors. 

Only one question remains at this stage. What should be done with home sectors that do not

have any commuting data? There are at least three reasonable possibilities. One, such tracts

could be dropped from the study area. Two, it could be assumed that all workers in such tracts

work in the home tract. Three, the commuting patterns could be assumed to be the same as those

in a neighboring sector (say, the next one on the list). It is likely that the main reason for the

absence of commuting data is that the tract contains very few persons. There are tracts with few

or even no inhabitants. Obviously, it does not matter how the workplaces are assigned if no such

persons are created by the profile generator, which uses the population to determine probability

of selecting the home tract for each profile.

64
Using the commuting data during an APEX3 model run

As explained earlier, the profile generator in APEX3 creates the basic profiles for the entire

number of requested profiles before continuing with diaries, exposure, and dose calculations. 

Each profile is first assigned an age, gender, race, and home district based on the population

data.

Next, each profile is assigned an employment status, either a worker or a non-worker. The

workers are then assigned a work sector using the commuting vectors. Each non-worker is

automatically assigned a ‘work sector’ equal to the home sector.

For each worker, a uniform random number R from zero to one is generated. Then the mapping

from home sector to commuting vector is used to determine the first record to examine. For

example, a given profile might live in sector #5, and the data for sector #5 starts in record #383

of the commuting data vector. So the cumulative flow fraction in cell #383 of the commuting

vector is compared to the random number R. If R is smaller, then the worker is assigned to the

work sector number stored in cell #383. Otherwise, the cumulative flow fraction for cell #384 is

compared to R. This continues until an assignment is made. If the assigned work sector is #0,

then that person works outside the study area, which means the profile is to be deleted and

another generated in its place. If the work sector number is positive, then it is added to the

profile description. The mapping from sectors to air districts is then consulted to assign air

district numbers to both the home sector and the work sector.

65
Structure of the APEX3 Source Code 

Programming Style

The APEX3 model, like its predecessors APEX2, APEX, and pNEM, is essentially a batch-mode

program. Almost all the operations are carried out in a specific order with no user interaction

and no branching. The main program calls a series of subroutines in a fixed order, with no

possibility of varying the sequence (apart from abnormal termination). None of these

subroutines are invoked from any other place. To a large extent these subroutines are just lexical

conveniences; the code from each could easily be placed into the main program. The large

majority of the functions and subroutines in APEX3 are invoked or called from a single location,

and so could easily be eliminated. This has not been done since the subroutines assist the

programmer by creating logical groupings of operations.

The source code is organized into nine files: the main APEX3 program and eight modules. These

modules are like directories on a computer, they make it easier for the programmer to locate the

relevant code by grouping subroutines into broader categories. The modules in APEX3 are

essentially independent, apart from their effects on global variables. All global variables are

declared in one place (in GlobalModule). No common blocks are used in APEX3, and most

subroutines have few or no arguments passed to them. Instead, most subroutines perform

operations on one or more of the global variables. When writing code, programmers should

check that any new local variables do not unintentionally share names with the existing global

variables. Every function and subroutine lists the global variables it accesses, immediately after

the local variable declarations.

The APEX3 source code currently consists of the main program and 43 functions and

subroutines. Compared to APEX2, 12 functions and subroutines were eliminated, 17 new ones

added, and five have the same name but have almost entirely new code. Minor changes were

made to nearly all the others. Thus 22 out of 43 routines are completely new and many other

changes exist. Perhaps 40% of the code in APEX3 also existed in APEX2. APEX3 has virtually

no code at all in common with APEX, the first version of the model, although they often perform

related tasks. The extensive nature of the changes means that many of the new features in

APEX3 have only undergone preliminary testing. It is likely that minor changes may be

necessary to fix bugs or otherwise optimize the new code.

The APEX3 code uses a consistent style. It is written in free format, with the executable

statements written in the first 68 columns of each line. Instructions that extend further are

indicated by an ampersand in column 69. Each line, except comment lines and continued lines,

contains an exclamation point in column 70, followed by a brief comment (up to 32 characters). 

These comments provide some guidance to the purpose of each statement. (There are a few

exceptions to the column 70 rule in GlobalModule and UtilityModule.) In addition, there a 

some comment lines without executable instructions; these start with an initial ‘!’. No line

numbers or GO TO statements exist in the code. All variables are explicitly declared, both their

type (real, integer, etc.) and their kind (their length in bytes).

66
The indentation rules are consistent. Generally, lines that are seen as blocks of code are indented

three spaces, and move three spaces back to the left when the block terminates. This includes

the body of subroutines, DO loops, block IF statements, ELSE statements, TYPE statements,

CASE statements, or WHERE statements. Each of the preceding has its end marked in a

standard manner (ENDDO, ENDIF, END TYPE, etc.), except CASE. A series of CASE

statements appear together after a SELECT statement, and the end of the last one is marked by

END SELECT. Each nested block receives another three spaces of indentation.

The capitalization rules are as follows. Fortran commands and keywords are all capitals, as are

constants (having the PARAMETER attribute). A few constants with a lower-case prefix ‘k’

exist (for example, kINTEGER) to avoid a conflict with a reserved word in Fortran. Variables

names may be single word or multi-word. Each word has its first letter capitalized and the

remainder in lower case, and multi-word names are concatenated without spaces. For example,

‘NumProfiles’ is the variable name for the Number of Profiles generated in the model run. 

In addition to the comments in the code mentioned earlier, each function or subroutine contains

four comments lines after all the initial declarations and before the first executable instruction.

The first of these lists the global variables that are used but not modified by the subroutine. The

second lists the global variables that are altered by the subroutine. The third lists the

intrinsically defined functions or subroutines (those that are part of standard Fortran 90) called

by the subroutine. The fourth lists the functions or subroutines defined elsewhere in the APEX3

code that are used by that routine. These lists are for the convenience of programmers or users;

they have no effect on the model. 

A few other remarks on programming style:

1)Often, the division of the program into subroutines is somewhat arbitrary since most

subroutines are only called from one location. A single long subroutine could be broken

into several smaller ones, or small ones could be eliminated by putting their content

directly into the calling routine. There are two conflicting goals. First, a large number of

short subroutines could obscure the program flow by creating many levels of nested calls. 

On the other hand, larger subroutines can become unwieldy. In APEX3, an optimum

subroutine size of about one printed page was used as a rough guideline, although there

are some exceptions.

2) Whenever a problem with input data occurs, the program must either attempt to

continue or else terminate. In APEX3 the decision is in favor of termination. The

rationale is that continuation would result in one of two things: either the program

crashes later, in which case it becomes more difficult to locate the problem; or it doesn’t

crash, in which case there is a danger that the user might not realize that there was a

problem. Wrong results can be more dangerous than no results at all. Therefore, when

problems occur, the code usually invokes the Fatal subroutine, which selects an

appropriate error message to print out before stopping program execution. 

67
3) Each input file and most output files have their OPEN, READ, WRITE, and CLOSE

statements in a single subroutine. These subroutines usually have the word ‘Read’ or

‘Write’ as part of their names. The contents of each input file are stored in memory, at

which point the file is no longer needed and hence closed. The actual file names and unit

numbers are stored as global variables. Since much of the effort in debugging a program

is spent in I/O related problems, it is useful to keep the I/O operations for each file

together in a compact and easily located place in the code. The main exception to this

rule is the log file which keeps a record of the progress of the model run. Many

subroutines add a few lines to the log file.

Code Organization and Program Flow

The APEX3 source code is organized into nine modules, each with a set of subroutines related to

one subject. Three of the modules (Global, Utility, and Distribution) provide facilities for use by

all the other modules. Five modules (SpaceTime, Diary, Profile, MicroEnv, and ExposureDose)

perform specific steps in the exposure assessment. The remaining module is the main APEX

program, which reads the job scenario parameters and invokes the other modules in turn.

The APEX model essentially consists of a large loop over simulated profiles. A simplified

description of the program structure is the following:

Step Module

1) Read input parameters to define the scenario. Main

2) Select sites and dates, and read inputs to initialize arrays. SpaceTime

3) Generate a personal profile. Profile

4) Select activity diaries to represent the profile. Diary

5) Determine microenvironmental concentrations. MicroEnv

6) Exposure per event equals concentration times duration. ExposureDose

7) Estimate dose from sequence of activities and exposures. ExposuseDose

8) Output results for the current profile. ExposureDose

9) If not enough profiles have been run, then return to step (3).

10) Create and output summary tables across profiles. ExposureDose

From the above summary it appears that the ExposureDose module performs most of the work. 

However, steps 6 and 7 are quite simple. Step 6 in particular is just a single line of code, as both

concentration and duration are inputs supplied by other modules. As APEX evolves, more postprocessing of the exposure and dose results may be performed within the model. It is likely that

at some point this post-processing will be separated into another module.

68
APPENDIX

APEX3 source code

March 18, 2002
PROGRAM APEX3 ! Start of main program

 ! This is the Fortran 90 source code for APEX3 model, developed for EPA in 2001-2002.

 ! APEX3 is derived from the APEX and APEX2 models, developed for EPA in 2000 and 2001.

 ! This program was developed and written by ManTech Environmental Technology, Inc.

 ! Latest revisions to this code made by WGG on March 18, 2002.

 ! 

 ! The source code for APEX3 consists of this file plus eight modules, named below in USE

statements.

 ! Compile GlobalModule first, then UtilityModule, then DistributionModule third, and

ProfileModule

 ! fourth. Other modules may be compiled in any order, except this file (APEX3.F90) must be

compiled

 ! last of all.

 !

 USE GlobalModule ! In file GlobalModule.F90

 USE UtilityModule ! In file UtilityModule.F90

 USE DistributionModule ! In file DistributionModule.F90 

 USE ProfileModule ! In file ProfileModule.F90

 USE SpaceTimeModule ! In file SpaceTimeModule.F90

 USE DiaryModule ! In file DiaryModule.F90

 USE MicroEnvModule ! In file MicroEnvModule.F90

 USE ExposureDoseModule ! In file ExposureDoseModule.F90

 IMPLICIT NONE ! Must declare all variables 

 INTEGER (KIND=IK) :: P ! Index for profile #

 ! Globals needed: IK, NumProfiles

 ! Globals altered: <None>

 ! Intrinsic procs: <None>

 ! External procs: CalcDates, CompositeDiary, DiaryProbabilities, ExposureDose,

FinalSummary

 ! GenerateDailyVars, GenerateProfiles, GeneratePhysiology, MicroConcs, 

 ! Output, OutputParameters, ReadAirQuality, ReadDiaries, ReadDistributions, 

 ! ReadMicroData, ReadParameters, ReadPopulation, ReadTemperatures, 

 ! SelectSites, SetCVList, SetupTables, Ventilation

 CALL ReadParameters ! In main APEX module

 CALL OutputParameters ! In main APEX module

 CALL SetCVList ! In ProfileModule 

 CALL ReadDistributions ! In DistributionModule

 CALL CalcDates ! In SpaceTimeModule

 CALL SelectSites ! In SpaceTimeModule

 CALL ReadTemperatures ! In SpaceTimeModule

 CALL ReadAirQuality ! In SpaceTimeModule

 CALL ReadPopulation ! In ProfileModule 

 CALL GenerateProfiles ! In ProfileModule 

 CALL GeneratePhysiology ! In ProfileModule

 CALL ReadDiaries ! In DiaryModule

 CALL ReadMicroData ! In MicroEnvModule 

 CALL SetupTables ! In ExposureDoseModule 

 DO P = 1, NumProfiles ! Loop over profiles

A-1
 CALL GenerateDailyVars(P) ! In ProfileModule 

 CALL DiaryProbabilities(P) ! In DiaryModule 

 CALL CompositeDiary(P) ! In DiaryModule 

 CALL MicroConcs(P) ! In MicroEnvModule 

 CALL Ventilation(P) ! In ExposureDoseModule

 CALL ExposureDose(P) ! In ExposureDoseModule

 CALL Output(P) ! In ExposureDoseModule

 ENDDO ! Finished profile

 CALL FinalSummary ! In ExposureDoseModule

 STOP "Finished APEX model run" ! Succesful job termination

CONTAINS ! Routines internal to this module

A-2
SUBROUTINE ReadParameters ! Called from main APEX program

 IMPLICIT NONE ! Must declare all variables 

 CHARACTER(LEN=LEN3) :: ParamLine,VarName,VarChar, UpChar ! Buffers for

storing records 

 INTEGER (KIND=IK) :: I, J, VarInt, SeedInc, NumLev, LType ! Temporary integer

variables

 REAL (KIND=RK) :: RBTarget, RBMax, VarReal, Buf(0:100) ! Temporary real

variables

 ! Globals needed: AQU, ChEvU, ChMapU, ChQuU, DistU, FMT3, HDoseU, HExpU, IK, 

 ! LEN3, LogU, MAXSOURCES, MetsU, MicroU, MSumU, NO, ParFile,

 ! ParU, PhysU, PopU, PSumU, RK, TempU, YES 

 ! Globals altered: AgeCutPct, Age2Probab, Altitude, AnnDoseLev, AnnExpLev, Clock,

 ! DAvgExpLev, DAvgDoseLev, DM1HDoseLev, DM1HExpLev, DM8HDoseLev, 

 ! DM8HExpLev, DMEHDoseLev, DoDose, DoseTime, DSTAdjust, EndDate,

ExpTime,

 ! FName, HourlyOut, Ios, ISdAct, ISdAER, ISdDec, ISdMts, ISdPen, ISdPrs,

 ! ISdPrx, ISdSrc, ISdVol, ISeed, KSeed, Location, MissAge, MissEmpl,

 ! MissGender, ModuleName, NumBlocks, NumCatsUseAC, NumDistricts,

NumMicros, 

 ! NumPools, NumProfiles, NumSeasons, NumTempCats, Pctl, Pollutant, PPMFact,

 ! ProcName, RBFactor, RBBackgnd, Rollback, Scenario, StartDate, Units

 ! Intrinsic procs: ADJUSTL, ALLOCATE, CLOSE, COUNT, INDEX, LEN_TRIM, OPEN, 

 ! RANDOM_SEED, READ, REAL, SYSTEM_CLOCK, TRIM

 ! External procs: Fatal, GetLine, Up

 ModuleName = "APEX" ! Module name for messages

 ProcName(1) = "ReadParameters" ! Procedure name for messages

 OPEN (ParU,FILE=ParFile,RECL=LEN3,IOSTAT=Ios(ParU),ACTION="READ") ! Open

parameters file

 CALL SYSTEM_CLOCK(Clock(1)) ! Start job timing 

 DO ! Loop over parameter records

 CALL GetLine(ParU,ParamLine,LType) ! Get one record from input file 

 IF (Ios(ParU)/=0) EXIT ! Exit DO loop on end of file

 IF (LType<=0) CYCLE ! If no equals sign, discard

 VarName = TRIM(Up(ADJUSTL(ParamLine(1:LType-1)))) ! Part on left of "="

(uppercase)

 VarChar = TRIM(ADJUSTL(ParamLine(LType+1:))) ! Part on right of "="

 UpChar = Up(VarChar) ! Uppercase version of VarChar 

 NumLev = 1+COUNT((/(UpChar(I:I)==",",I=1,LEN_TRIM(UpChar))/)) ! = 1 + #commas

in UpChar

 Buf(0) = REAL(NumLev+1) ! Store # of levels in buffer

 Buf(1) = 0. ! Lowest level is zero by default

 DO I=1, NumLev ! Loop over levels

 READ(VarChar,*,IOSTAT=Ios(1)) Buf(I+1) ! Read first item in list

 VarChar = VarChar(INDEX(VarChar,",")+1:) ! Remove first item from list

 IF (I>1.AND.Buf(I+1)<=Buf(I)) CALL Fatal(1) ! Levels must be ascending

 ENDDO ! Continue with next level

 NumLev = NumLev+1 ! # levels = # commas + 2

 IF (INDEX(VarName,"COUNTYL")>0) PRINT*,'Found CountyList' !

A-3
 IF (INDEX(VarName," FILE")>0) THEN ! For file names...

 IF (INDEX(VarName,"LOG")>0) FName(LogU) =VarChar ! Set log filename

 IF (INDEX(VarName,"TABLE")>0) FName(TabU) =VarChar ! Set output tables

filename

 IF (INDEX(VarName,"EXPOSURE")>0) FName(HExpU) =VarChar ! Set exposure

filename

 IF (INDEX(VarName,"DOSE")>0) FName(HDoseU)=VarChar ! Set dose filename

 IF (INDEX(VarName,"PERSON")>0) FName(PSumU) =VarChar ! Set personal data

filename

 IF (INDEX(VarName,"MICROSUM")>0) FName(MSumU) =VarChar ! Set micro.

summary filename

 IF (INDEX(VarName,"MICROENV")>0) FName(MicroU)=VarChar ! Set

microenvironment filename

 IF (INDEX(VarName,"DIARYSUM")>0) FName(ChQuU) =VarChar ! Set diary quest.

filename

 IF (INDEX(VarName,"DIARYEVE")>0) FName(ChEvU) =VarChar ! Set diary event

filename

 IF (INDEX(VarName,"DIARYMAP")>0) FName(ChMapU)=VarChar ! Set location

mapping filename 

 IF (INDEX(VarName,"DISTRIB")>0) FName(DistU) =VarChar ! Set distribution

filename

 IF (INDEX(VarName,"PHYSIOL")>0) FName(PhysU) =VarChar ! Set physiology

filename

 IF (INDEX(VarName,"METABOL")>0) FName(MetsU) =VarChar ! Set metabolic

filename

 IF (INDEX(VarName,"COMMUT")>0) FName(CommU) =VarChar ! Set commuting

filename

 IF (INDEX(VarName,"QUALITY")>0) FName(AQU) =VarChar ! Set air quality

filename

 IF (INDEX(VarName,"TEMPERAT")>0) FName(TempU) =VarChar ! Set

tempereature filename

 IF (INDEX(VarName,"SECTOR")>0) FName(SectU) =VarChar ! Set pop. sectors

filename

 IF (INDEX(VarName,"DISTRICT")>0) FName(MonU) =VarChar ! Set air districts

filename

 IF (INDEX(VarName,"ZONE")>0) FName(ZoneU) =VarChar ! Set temperature

zones filename

 IF (INDEX(VarName,"AGEGROUP")>0) FName(PopU) =VarChar ! Set pop age

ranges filename

 IF (INDEX(VarName,"POP")>0) THEN ! There are many pop files 

 I = INDEX(VarName,",") ! Location of first comma

 J = INDEX(VarName(I+1:),",") ! Location of second comma 

 IF (I*J==0) CALL Fatal(7) ! Stop if either comma missing

 NumPopTypes = NumPopTypes+1 ! Increment pop type counter

 PopCat(NumPopTypes)%Gender = ADJUSTL(VarName(I+1:I+J-1)) ! Extract gender of

this type

 PopCat(NumPopTypes)%Race = ADJUSTL(VarName(I+J+1:)) ! Extract race of this

type

A-4
 PopCat(NumPopTypes)%FName = VarChar ! Set filename for this type

 ENDIF ! End of population file logic

 ELSE IF (INDEX(VarName,"POLL")>0) THEN ! Found keyword for

pollutant

 Pollutant=VarChar ! Set the pollutant name

 ELSE IF (INDEX(VarName,"UNIT")>0) THEN ! Found keyword for units

 Units=VarChar ! Set the units

 ELSE IF (INDEX(VarName,"LOCATION")>0) THEN ! Found keyword for

study area

 Location=VarChar ! Set the study area location

 ELSE IF (INDEX(VarName,"SCENARIO")>0) THEN ! Found keyword for

scenario

 Scenario=VarChar ! Set the scenario description

 ELSE IF (INDEX(VarName,"ROLLBACK")>0) THEN ! Found keyword for

rollback

 IF (UpChar(1:1)=="Y") Rollback=YES ! Set ambient air Rollback flag

 ELSE IF (INDEX(VarName,"DST")>0) THEN ! Found keyword for DST

adjustment

 IF (UpChar(1:1)=="N") DSTAdjust=NO ! Set Daylight Savings flag

 ELSE IF (INDEX(VarName,"HOURLY")>0) THEN ! Found keyword for

hourly output

 IF (UpChar(1:1)=="N") HourlyOut=NO ! Set Hourly output flag

 ELSE IF (INDEX(VarName,"DODOSE")>0) THEN ! Found keyword for dose

calcs.

 IF (UpChar(1:1)=="N") DoDose=NO ! Set Dose calculation flag

 ELSE IF (INDEX(VarName,"COMMUT")>0) THEN ! Found keyword for

commuting

 IF (UpChar(1:1)=="Y") CommuteFlag = YES ! Set flag for commuting

 ELSE IF (INDEX(VarName,"COUNTYL")>0) THEN ! Found keyword for

county list

 IF (UpChar(1:1)=="Y") CountyList=YES ! Set flag for using a county list

 ELSE IF (INDEX(VarName,"COUNTY ")>0) THEN ! Found keyword for a

county FIPS 

 NumCounties = NumCounties+1 ! Increment list of counties

 CList(NumCounties) = VarChar(1:5) ! Add county FIPS code to list

 ELSE IF (INDEX(VarName,"PERCENTILE")>0) THEN ! Found keyword for

percentiles 

 ALLOCATE (Pctl(0:NumLev-1)) ! Make space for percentiles

 Pctl(0) = Buf(0)-1 ! Set # of percentiles

 Pctl(1:) = Buf(2:NumLev) ! Load values from list buffer

 ELSE IF (INDEX(VarName,"DM1HEXP")>0) THEN ! Found DM1HExp

levels keyword

 ALLOCATE (DM1HExpLev(0:NumLev)) ! Make space for DM1HExp

levels

 DM1HExpLev = Buf(0:NumLev) ! Load DM1HExp levels from

buffer

 ELSE IF (INDEX(VarName,"DM8HEXP")>0) THEN ! Found DM8HExp

levels keyword 

A-5
 ALLOCATE (DM8HExpLev(0:NumLev)) ! Make space for DM8HExp

levels

 DM8HExpLev = Buf(0:NumLev) ! Load DM8HExp levels from

buffer

 ELSE IF (INDEX(VarName,"DAVGEXP")>0) THEN ! Found DAvgExp levels

keyword

 ALLOCATE (DAvgExpLev(0:NumLev)) ! Make space for DAvgExp

levels

 DAvgExpLev = Buf(0:NumLev) ! Load DAvgExp levels from buffer

 ELSE IF (INDEX(VarName,"ANNEXP")>0) THEN ! Found AnnExp levels

keyword 

 ALLOCATE (AnnExpLev(0:NumLev)) ! Make space for AnnExp levels

 AnnExpLev = Buf(0:NumLev) ! Load AnnExp levels from buffer

 ELSE IF (INDEX(VarName,"EXPTIME")>0) THEN ! Found ExpTime levels

keyword 

 ALLOCATE (ExpTimeLev(0:NumLev)) ! Make space for ExpTime

levels

 ExpTimeLev = Buf(0:NumLev) ! Load ExpTime levels from buffer

 ELSE IF (INDEX(VarName,"DM1HDOSE")>0) THEN ! Found DM1HDose

levels keyword 

 ALLOCATE (DM1HDoseLev(0:NumLev)) ! Make space for DM1HDose

levels

 DM1HDoseLev = Buf(0:NumLev) ! Load DM1HDose levels from

buffer

 ELSE IF (INDEX(VarName,"DM8HDOSE")>0) THEN ! Found DM8HDose

levels keyword 

 ALLOCATE (DM8HDoseLev(0:NumLev)) ! Make space for DM8HDose

levels

 DM8HDoseLev = Buf(0:NumLev) ! Load DM8HDose levels from

buffer

 ELSE IF (INDEX(VarName,"DAVGDOSE")>0) THEN ! Found DAvgDose

levels keyword 

 ALLOCATE (DAvgDoseLev(0:NumLev)) ! Make space for DAvgDose

levels

 DAvgDoseLev = Buf(0:NumLev) ! Load DAvgDose levels from buffer

 ELSE IF (INDEX(VarName,"ANNDOSE")>0) THEN ! Found AnnDose levels

keyword 

 ALLOCATE (AnnDoseLev(0:NumLev)) ! Make space for AnnDose

levels

 AnnDoseLev = Buf(0:NumLev) ! Load AnnDose levels from buffer

 ELSE IF (INDEX(VarName,"DMEHDOSE")>0) THEN ! Found DMEHDose

levels keyword 

 ALLOCATE (DMEHDoseLev(0:NumLev)) ! Make space for DMEHDose

levels

 DMEHDoseLev = Buf(0:NumLev) ! Load DMEHDose levels from

buffer

 ELSE IF (INDEX(VarName,"DOSETIME")>0) THEN ! Found DoseTime

levels keyword 

A-6
 ALLOCATE (DoseTimeLev(0:NumLev)) ! Make space for DoseTime

levels

 DoseTimeLev = Buf(0:NumLev) ! Load DoseTime levels from buffer

 ELSE ! Or else set parameters...

 READ(VarChar,*,IOSTAT=Ios(1)) VarReal ! Convert string into real

 IF (Ios(1)/=0) CYCLE ! Discard if not numeric 

 READ(VarChar,*,IOSTAT=Ios(2)) VarInt ! Convert string to integer 

 IF (INDEX(VarName,"START_")>0) StartDate = VarInt ! Set simulation start date 

 IF (INDEX(VarName,"END_")>0) EndDate = VarInt ! Set simulation end date

 IF (INDEX(VarName,"PROFILE")>0) NumProfiles = VarInt ! Set number of profiles

 IF (INDEX(VarName,"MICRO")>0) NumMicros = VarInt ! Set number of

microenvironments

 IF (INDEX(VarName,"AGEMIN")>0) AgeMin = VarInt ! Set minimum age for

profiles

 IF (INDEX(VarName,"AGEMAX")>0) AgeMax = VarInt ! Set maximum age for

profiles

 IF (INDEX(VarName,"RANDOM")>0) ISeed(1) = VarInt ! Set random number

seed

 IF (INDEX(VarName,"LATIT")>0) Center%Lat = VarReal ! Set city center latitude

 IF (INDEX(VarName,"LONGIT")>0) Center%Lon = VarReal ! Set city center

longitude

 IF (INDEX(VarName,"CITYRAD")>0) CityRadius = VarReal ! Set radius of study

area in km

 IF (INDEX(VarName,"AIRRAD")>0) AirRadius = VarReal ! Set radius of air

districts (km)

 IF (INDEX(VarName,"ZONERAD")>0) ZoneRadius = VarReal ! Set radius of temp.

zones in km 

 IF (INDEX(VarName,"PPM")>0) PPMFact = VarReal ! Units conversion factor

 IF (INDEX(VarName,"RBTARGET")>0) RBTarget = VarReal ! Rollback target

value

 IF (INDEX(VarName,"RBBACK")>0) RBBkgnd = VarReal ! Rollback background

value

 IF (INDEX(VarName,"RBMAX")>0) RBMax = VarReal ! Rollback maximum

value

 IF (INDEX(VarName,"MISSGEND")>0) MissGender = VarReal ! Probability of diary

selection

 IF (INDEX(VarName,"MISSEMP")>0) MissEmpl = VarReal ! Probability of diary

selection

 IF (INDEX(VarName,"MISSAGE")>0) MissAge = VarReal ! Probability of diary

selection 

 IF (INDEX(VarName,"AGECUT")>0) AgeCutPct = VarReal ! Width of age window

in percent

 IF (INDEX(VarName,"AGE2PROB")>0) Age2Probab = VarReal ! Shoulder

probability for age

 IF (INDEX(VarName,"ALTITUDE")>0) Altitude = VarReal ! Altitude in feet of

study area

 IF (INDEX(VarName,"COHBFACT")>0) COHbFact = VarReal ! COHb convergence

safety factor

A-7
 IF (INDEX(VarName,"COTHRESH")>0) COThresh = VarReal ! CO threshold for

warnings

 END IF ! Finished with line

 END DO ! Get next record

 CLOSE(ParU) ! Close ParFile

 IF (Rollback==YES) THEN ! Rollback air quality data 

 IF (RBMax<=RBBkgnd) CALL Fatal(2) ! Cannot have Max<Background

 IF (RBTarget>RBMax) CALL Fatal(3) ! Cannot have Target>Max 

 IF (RBTarget<=RBBkgnd) CALL Fatal(4) ! Cannot have

Target<Background

 RBFactor = (RBTarget-RBBkgnd) / (RBMax-RBBkgnd) ! Air quality reduction

factor 

 ELSE ! If no air quality rollback...

 RBFactor = 1.0 ! Factor of unity means no change

 RBBkgnd = 0.0 ! No background if no rollback

 ENDIF ! End of rollback logic

 IF (ISeed(1)==0) CALL SYSTEM_CLOCK(ISeed(1)) ! If Seed=0, use clock for

seed

 CALL RANDOM_SEED(SIZE=KSeed) ! # words used to store seeds

 SeedInc=1 ! This works for multiword seeds

 IF (KSeed==1) SeedInc = 10000000 ! Single word seeds are a problem

 ISeed = ISeed(1) ! Set each word in ISeed to base

 ISdAct = ISeed+1*SeedInc ! Set each word in ISdAct to base

 ISdMET = ISeed+2*SeedInc ! Set each word in ISdMts to base

 ISdPrs = ISeed+3*SeedInc ! Set each word in ISdPrs to base

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE ReadParameters ! Return to main APEX program

A-8
SUBROUTINE OutputParameters ! Called from main APEX program

 INTEGER (KIND=IK) :: I ! Local integer variable

 ! Globals needed : LogU, LEN3, Location, Pollutant, Units, Scenario, StartDate, EndDate,

 ! FName, TempU, AQU, MetsU, PhysU, PopU, DistU, ChMapU, ChEvU, ChQuU,

MicroU,

 ! HExpU, HDoseU, PSumU, MSumU, NumProfiles, NumDistricts, NumMicros, 

 ! NumSeasons, NumBlocks, NumTempCats, NumCatsUseAC, YESNO,

DSTAdjust,

 ! HourlyOut, DoDose, Rollback, RBFactor, RBBackgnd, MissAge, MissGender, 

 ! MissEmpl, AgeCutPct, Age2Probab, Altitude, ISeed, Clock 

 ! Globals altered : Ios, ModuleName, ProcName

 ! Intrinsic procs : OPEN, TRIM, WRITE

 ! External procs : <None>

 ModuleName = "APEX" ! Module name for messages

 ProcName(1) = "OutputParameters" ! Procedure name for messages

 OPEN (LogU,FILE=FName(LogU),RECL=2*LEN3,IOSTAT=Ios(LogU), & 

 ACTION="WRITE") ! Open log file

 WRITE(LogU,*) "Log file for APEX3 model run" ! -- Job information -- 

 WRITE(LogU,*) " Location = ", Location ! The details given on the left

 WRITE(LogU,*) " Pollutant = ", Pollutant ! are echoed from the input 

 WRITE(LogU,*) " Units = ", Units ! parameters file. None affect 

 WRITE(LogU,*) " Scenario = ", Scenario ! the actual simulation except

 WRITE(LogU,*) " Start date = ", StartDate ! for StartDate and

 WRITE(LogU,*) " End date = ", EndDate ! EndDate.

 WRITE(LogU,*) ! Write blank line to log

 WRITE(LogU,*) "File names used for this run:" ! List of file names

 WRITE(LogU,*) "Input:" ! Input files:

 WRITE(LogU,*) " Pop. Sectors = ",TRIM(FName(SectU)) ! Used in

SpaceTimeModule

 WRITE(LogU,*) " Air Districts = ",TRIM(FName(MonU)) ! Used in

SpaceTimeModule

 WRITE(LogU,*) " Temperature Zones = ",TRIM(FName(ZoneU)) ! Used in

SpaceTimeModule

 WRITE(LogU,*) " Temperature Data = ",TRIM(FName(TempU)) ! Used in

SpaceTimeModule

 WRITE(LogU,*) " Air Quality Data = ",TRIM(FName(AQU)) ! Used in

SpaceTimeModule

 WRITE(LogU,*) " METS distributions = ",TRIM(FName(MetsU)) ! Used in

DiaryModule 

 WRITE(LogU,*) " Physiology = ",TRIM(FName(PhysU)) ! Used in

PhysiologyModule

 WRITE(LogU,*) " Age & Employment = ",TRIM(FName(PopU)) ! Used in

ProfileModule

 WRITE(LogU,*) " Commuting = ",TRIM(FName(CommU)) ! Used in

ProfileModule

 WRITE(LogU,*) " Distributions = ",TRIM(FName(DistU)) ! Used in

DistributionModule

A-9
 WRITE(LogU,*) " Location Mapping = ",TRIM(FName(ChMapU)) ! Used in

DiaryModule 

 WRITE(LogU,*) " Diary Events = ",TRIM(FName(ChEvU)) ! Used in DiaryModule 

 WRITE(LogU,*) " Diary Questionaire = ",TRIM(FName(ChQuU)) ! Used in

DiaryModule 

 WRITE(LogU,*) " Microenvironments = ",TRIM(FName(MicroU)) ! Used in

MicroEnvModule

 WRITE(LogU,*) "Output:" ! Output files:

 WRITE(LogU,*) " Log = ",TRIM(FName(LogU)) ! Used by all modules

 WRITE(LogU,*) " Exposure = ",TRIM(FName(HExpU)) ! Used in

ExposureDoseModule

 WRITE(LogU,*) " Dose = ",TRIM(FName(HDoseU)) ! Used in

ExposureDoseModule

 WRITE(LogU,*) " Profile Summary = ",TRIM(FName(PSumU)) ! Used in

ExposureDoseModule

 WRITE(LogU,*) " Micro. Summary = ",TRIM(FName(MSumU)) ! Used in

ExposureDoseModule

 WRITE(LogU,*) ! Write blank line to log

 WRITE(LogU,*) "Job Parameters:" ! List of job parameter settings

 WRITE(LogU,*) " # Personal profiles = ", NumProfiles ! Range: 1 - <no limit> 

 WRITE(LogU,*) " # Microenvironments = ", NumMicros ! Range: 1 - 127

 WRITE(LogU,*) " City center latitude = ", Center%Lat ! Latitude in decimal degrees

 WRITE(LogU,*) " City center longitude = ", Center%Lon ! Longitude in decimal

degrees

 WRITE(LogU,*) " Study area radius (km) = ", CityRadius ! Study area radius in

kilometers

 WRITE(LogU,*) " List of counties = ", YESNO(CountyList) ! Sectors in specific

counties

 WRITE(LogU,*) " Commuting implemented = ", YESNO(CommuteFlag) ! Commuting on

or off 

 WRITE(LogU,*) " Air district radius = ", AirRadius ! Radius of air districts in km

 WRITE(LogU,*) " Temp. zone radius = ", ZoneRadius ! Radius of temp. zones in

km

 WRITE(LogU,*) " Daylight Savings adjust = ", YESNO(DSTAdjust) ! All districts adjusted

or none

 WRITE(LogU,*) " Save hourly output = ", YESNO(HourlyOut) ! 80 KB per person-year

(exp only)

 WRITE(LogU,*) " Calculate doses = ", YESNO(DoDose) ! Another 80KB per

person-year

 WRITE(LogU,*) " Rollback = ", YESNO(Rollback) ! All districts rolled or none

 WRITE(LogU,*) " Rollback factor = ", RBFactor ! One factor for all districts

 WRITE(LogU,*) " Rollback background = ", RBBkgnd ! One background for all

districts 

 WRITE(LogU,*) " Missing gender probab. = ", MissGender ! Range: 0.0 - 1.0

 WRITE(LogU,*) " Missing age probab. = ", MissAge ! Range: 0.0 - 1.0 

 WRITE(LogU,*) " Missing employ. probab. = ", MissEmpl ! Range: 0.0 - 1.0

 WRITE(LogU,*) " Age window width, pct. = ", AgeCutPct ! Range: 0.0 - <no limit> 

 WRITE(LogU,*) " Age shoulder probab. = ", Age2Probab ! Range: 0.0 - 1.0 

A-10
 WRITE(LogU,*) " Altitude in feet = ", Altitude ! Range: 0.0 - <no limit>

 WRITE(LogU,*) " Random number seed = ", ISeed(1) ! Range: 0 - (2**31-1)

 WRITE(LogU,*) ! Write blank line to log

 IF (CountyList==YES) THEN !

 WRITE(LogU,*) !

 WRITE(LogU,*) "List of Counties included in study area" !

 DO I=1,NumCounties !

 WRITE(LogU,*) I, ' ',CList(I) !

 ENDDO !

 WRITE(LogU,*) !

 ENDIF !

 DO I=1,NumPopTypes ! 

 WRITE(LogU,*) 'Population type ',I,PopCat(I)%Gender,' ', &

 PopCat(I)%Race,' ',PopCat(I)%FName !

 ENDDO !

 WRITE(LogU,*) "Job start time = ", Clock(1) ! Time at start of job execution 

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE OutputParameters ! Return to main APEX program

END PROGRAM ! End of main APEX program code

A-11
MODULE GlobalModule

 ! This module contains three sections:

 ! The first has certain useful constants that are used throughout APEX

 ! The second contains the TYPE declarations used here or used in multiple modules

 ! The third contains all the global variables used in APEX

 

 IMPLICIT NONE ! All variables must be declared

 ! Useful Constants 

 INTEGER, PARAMETER :: BYT=1, SHORT=4, LONG=8 ! Lengths for KIND values

 INTEGER, PARAMETER :: IK=SHORT, RK=SHORT ! Selected KIND values for

Int and Real

 INTEGER(KIND=IK), PARAMETER :: YES=1, NO=2 ! Constants for binary

switches in code

 INTEGER(KIND=IK), PARAMETER :: RECLEN = 250 ! Maximum Record length

for ASCII files

 INTEGER(KIND=IK), PARAMETER :: LEN1 = 12 ! Maximum length for short

strings (words)

 INTEGER(KIND=IK), PARAMETER :: LEN2 = 40 ! Maximum length for medium

text strings

 INTEGER(KIND=IK), PARAMETER :: LEN3 = 200 ! Maximum length for long

text strings 

 INTEGER(KIND=IK), PARAMETER :: SECTORLEN = 15 ! Max length of sector

labels (tract ID)

 INTEGER(KIND=IK), PARAMETER :: MAXCOUNTY = 1000 ! Maximum # of

counties listed on PARAMS

 INTEGER(KIND=IK), PARAMETER :: MAXDISTRIB = 100 ! Maximum # of

user-defined distributions

 INTEGER(KIND=IK), PARAMETER :: MAXDIM = 6 ! Maximum # of input

variables per distrib.

 INTEGER(KIND=IK), PARAMETER :: MAXCV = 50 ! Maximum # of items on

CV List

 INTEGER(KIND=IK), PARAMETER :: NUMGENDERS = 2 ! Number of genders in

simulation

 INTEGER(KIND=IK), PARAMETER :: NUMRACES = 5 ! Number of races in

simulation

 INTEGER(KIND=IK), PARAMETER :: MAXPOPTYPE = 10 ! Maximum # of

gender-race combinations

 INTEGER(KIND=IK), PARAMETER :: MAXAGEGRPS = 100 ! Maximum # of age

groups permitted

 INTEGER(KIND=IK), PARAMETER :: EVENTSDAY = 100 ! Limit on mean

events/day for composites

 INTEGER(KIND=IK), PARAMETER :: HOURSDAY = 24 ! Number of hours per day 

 INTEGER(KIND=IK), PARAMETER :: MINSHOUR = 60 ! Number of minutes per

hour

 CHARACTER(LEN=6), PARAMETER :: FMT1="(A12) " ! Format for reading LEN1

strings

A-12
 CHARACTER(LEN=6), PARAMETER :: FMT2="(A40) " ! Format for reading LEN2

strings

 CHARACTER(LEN=6), PARAMETER :: FMT3="(A200)" ! Format for reading LEN3

strings

 CHARACTER(LEN=3), PARAMETER :: YESNO(2)=(/"Yes","No "/) ! For printing binary

switch status 

 INTEGER(KIND=IK), PARAMETER :: ParU = 10 ! Unit # for job parameters input

file

 INTEGER(KIND=IK), PARAMETER :: SectU = 11 ! Unit # for list of pop. sector

locations

 INTEGER(KIND=IK), PARAMETER :: MonU = 12 ! Unit # for list of air monitor

locations

 INTEGER(KIND=IK), PARAMETER :: ZoneU = 13 ! Unit # for list of temperature

locations

 INTEGER(KIND=IK), PARAMETER :: PopU = 14 ! Unit # for population input file

 INTEGER(KIND=IK), PARAMETER :: CommU = 15 ! Unit # for commuter input

file

 INTEGER(KIND=IK), PARAMETER :: TempU = 16 ! Unit # for temperature input

file

 INTEGER(KIND=IK), PARAMETER :: AQU = 17 ! Unit # for air quality input file 

 INTEGER(KIND=IK), PARAMETER :: MetsU = 18 ! Unit # for METS input file

 INTEGER(KIND=IK), PARAMETER :: PhysU = 19 ! Unit # for physiology input

file 

 INTEGER(KIND=IK), PARAMETER :: DistU = 20 ! Unit # for user distributions

input file

 INTEGER(KIND=IK), PARAMETER :: ChMapU = 21 ! Unit # for CHAD code

mapping input file

 INTEGER(KIND=IK), PARAMETER :: ChQuU = 22 ! Unit # for CHAD

questionnaire input file

 INTEGER(KIND=IK), PARAMETER :: ChEvU = 23 ! Unit # for CHAD diary

events input file

 INTEGER(KIND=IK), PARAMETER :: MicroU = 24 ! Unit # for microenvironments

input file 

 INTEGER(KIND=IK), PARAMETER :: LogU = 25 ! Unit # for execution log

output file

 INTEGER(KIND=IK), PARAMETER :: HExpU = 26 ! Unit # for hourly exposure

output file

 INTEGER(KIND=IK), PARAMETER :: HDoseU = 27 ! Unit # for hourly dose

output file

 INTEGER(KIND=IK), PARAMETER :: PSumU = 28 ! Unit # for profile summary

output file

 INTEGER(KIND=IK), PARAMETER :: MSumU = 29 ! Unit # for microenv.

summary output file

 INTEGER(KIND=IK), PARAMETER :: TabU = 30 ! Unit # for output tables file

 INTEGER(KIND=IK), PARAMETER :: MAXU = 30 ! Maximum unit number used

 INTEGER(KIND=IK), PARAMETER :: MAXK = 8 ! Max. # words available for

storing seeds

A-13
 INTEGER(KIND=IK), PARAMETER :: MALE=1, FEMALE=2 ! Internal model values

for each gender

 INTEGER(KIND=IK), PARAMETER :: WHITE=1, BLACK=2, & 

 ASIAN=3, NATAM=4, OTHER=5 ! Internal model values for each race

 CHARACTER(LEN=6), PARAMETER :: SEXTEXT(1:2) = & 

 (/"Male ","Female"/) ! Text for printing out gender data

 CHARACTER(LEN=5), PARAMETER :: RACETEXT(1:5)= & 

 (/"White","Black","Asian","NatAm","Other"/) ! Text for printing out race data

 CHARACTER(LEN=5), PARAMETER :: EMPTEXT(1:2) = & 

 (/"Works","NoWrk"/) ! Text for printing out employment data

 CHARACTER(LEN=5), PARAMETER :: GASTEXT(1:2) = & 

 (/"Gas ","NoGas"/) ! Text for printing out gas stove data

 CHARACTER(LEN=5), PARAMETER :: PILOTTEXT(1:2) = & 

 (/"Pilot","NoPlt"/) ! Text for printing out pilot light data

 CHARACTER(LEN=5), PARAMETER :: ACTEXT(1:2) = & 

 (/"HasAC","NoAC "/) ! Text for printing air conditioning data

 CHARACTER(LEN=3), PARAMETER :: DAYOFWEEK(1:7) = &

 (/"SUN","MON","TUE","WED","THU","FRI","SAT"/) ! Days of week for printing

output

 

 

 ! TYPE declarations

 TYPE :: Calendar

 INTEGER (KIND=IK) :: Year = 0 ! Year for each day of simulation

 INTEGER (KIND=IK) :: Month = 0 ! Month for each day of simulation

 INTEGER (KIND=IK) :: Day = 0 ! Day of month for each simulation day

 INTEGER (KIND=IK) :: DayOfWeek = 0 ! Day of week (1=Sun, 2=Mon, etc)

 INTEGER (KIND=IK) :: FirstHour = 0 ! First hour of simulation for given day

 INTEGER (KIND=IK) :: LastHour = 0 ! Last hour of simulation for given day

 INTEGER (KIND=IK) :: Weekend = 0 ! Weekend status (Sat,Sun=1, others=0)

 END TYPE Calendar

 TYPE :: TemperDay

 INTEGER (KIND=IK) :: MaxTemp ! Maximum daily 1-hour temperature

(deg F)

 REAL (KIND=RK) :: MeanTemp ! Mean daily temperature (deg F)

 INTEGER (KIND=IK) :: TempCat ! Temperature category for current day

 INTEGER (KIND=IK) :: Pool ! Diary pool assignment for current day

 END TYPE TemperDay 

 TYPE :: Profile

 INTEGER (KIND=IK) :: Index = 0 ! Sequential number for profile

 INTEGER (KIND=IK) :: Gender = 0 ! Gender (1=male, 2=female)

 INTEGER (KIND=IK) :: Race = 0 ! Race (definitions in PROFILE variables)

 INTEGER (KIND=IK) :: Age = 0 ! Age in years

 INTEGER (KIND=IK) :: HomeSec = 0 ! Number of home sector

 INTEGER (KIND=IK) :: WorkSec = 0 ! Work sector (=HomeSec if not worker)

A-14
 INTEGER (KIND=IK) :: HomeD = 0 ! Number of home sector

 INTEGER (KIND=IK) :: WorkD = 0 ! Work sector (=HomeSec if not worker)

 INTEGER (KIND=IK) :: Zone = 0 ! Temperature zone for home sector

 INTEGER (KIND=IK) :: Employed = 0 ! Employment status (1=YES, 2=NO)

 INTEGER (KIND=IK) :: GasStove = 0 ! Has gas stove (1=YES, 2=NO)

 INTEGER (KIND=IK) :: GasPilot = 0 ! Has gas stove pilot light (1=YES,

2=NO)

 INTEGER (KIND=IK) :: AC_Home = 0 ! Has home air conditioning (1=YES,

2=NO)

 INTEGER (KIND=IK) :: AC_Car = 0 ! Has car air conditioning (1=YES,

2=NO)

 INTEGER (KIND=IK) :: DGRP = 0 ! Demographic group (cohort) #

 END TYPE Profile 

 TYPE :: Physiology

 REAL (KIND=RK) :: Blood = 0.0 ! Blood volume (ml) 

 REAL (KIND=RK) :: BM = 0.0 ! Body mass (kg)

 REAL (KIND=RK) :: Diff = 0.0 ! Lung diffusivity (ml/min/torr) 

 REAL (KIND=RK) :: ECF = 0.0 ! Energy conversion factor (liters-O2/kcal)

 REAL (KIND=RK) :: Endgn1 = 0.0 ! Endogenous CO production rate #1

(ml/min)

 REAL (KIND=RK) :: Endgn2 = 0.0 ! Endogenous CO production rate #2

(ml/min)

 REAL (KIND=RK) :: Height = 0.0 ! Body height (inches) 

 REAL (KIND=RK) :: HemFac = 0.0 ! Hemoglobin altitude factor (1/foot)

 REAL (KIND=RK) :: Hmglb = 0.0 ! Hemoglobin density (g/ml-blood)

 REAL (KIND=RK) :: METmax = 0.0 ! Maximum MET value (dimensionless)

 REAL (KIND=RK) :: RMR = 0.0 ! Resting metabolic rate (kcal/min)

 REAL (KIND=RK) :: Weight = 0.0 ! Body weight (pounds) 

 INTEGER (KIND=IK) :: Start = 0 ! Starting day for menstrual cycle 

 END TYPE Physiology

 TYPE :: ProfileDay

 INTEGER (KIND=IK) :: DiaryNum = 0 ! Selected diary # for each day

 INTEGER (KIND=IK) :: FirstEvent = 0 ! First event # on EventSeq for given day

 INTEGER (KIND=IK) :: LastEvent = 0 ! Last event # on EventSeq for given day

 INTEGER (KIND=IK) :: WindowPos = 0 ! Window position category 

 INTEGER (KIND=IK) :: SpeedCat = 0 ! Vehicle speed category 

 REAL (KIND=RK) :: EndGn = 0.0 ! Endogenous CO production rate

 END TYPE ProfileDay

 TYPE :: EventSequence

 INTEGER (KIND=IK) :: Day = 0 ! Day of simulation (1-NumDays)

 INTEGER (KIND=IK) :: Hour = 0 ! Hour of day for start of event (0-23)

 INTEGER (KIND=IK) :: Duration = 0 ! Duration of event in minutes (1-60) 

 INTEGER (KIND=IK) :: Activity = 0 ! Activity code for event (may be

negative) 

 INTEGER (KIND=IK) :: Location = 0 ! Location code for event (0-115)

A-15
 INTEGER (KIND=IK) :: HomeWork = 0 ! Place code (1=Home, 2=Work,

3=Other)

 REAL (KIND=RK) :: MET = 0.0 ! METS value for event

 REAL (KIND=RK) :: VA = 0.0 ! Alveolar ventilation rate (ml/min) 

 REAL (KIND=RK) :: VE = 0.0 ! Ventilation rate (l/min)

 REAL (KIND=RK) :: Exposure = 0.0 ! Average exposure over the event

 REAL (KIND=RK) :: Dose = 0.0 ! Average dose over the event

 REAL (KIND=RK) :: FDose = 0.0 ! Final dose at end of event

 END TYPE EventSequence 

 TYPE :: HourSequence

 INTEGER (KIND=IK) :: FirstEvent = 0 ! # of first event for that hour 

 INTEGER (KIND=IK) :: LastEvent = 0 ! # of last event for that hour

 REAL (KIND=RK) :: MET = 0.0 ! Mean MET value for that hour

 REAL (KIND=RK) :: Exposure = 0.0 ! Average exposure for that hour

 REAL (KIND=RK) :: Dose = 0.0 ! Average dose for that hour

 REAL (KIND=RK) :: VE = 0.0 ! Average ventilation rate for that hour

 REAL (KIND=RK) :: FDose = 0.0 ! End-of-hour dose for that hour

 REAL (KIND=RK) :: Run8Exp = 0.0 ! Running 8-hour average exposure

 REAL (KIND=RK) :: Run8Dose = 0.0 ! Running 8-hour average dose

 END TYPE HourSequence

 TYPE :: ExpDoseDay

 REAL (KIND=RK) :: Max1Exp = 0.0 ! Daily maximum 1-hour average

exposure

 REAL (KIND=RK) :: Max8Exp = 0.0 ! Daily maximum 8-hour average

exposure

 REAL (KIND=RK) :: AvgExp = 0.0 ! Daily average exposure

 REAL (KIND=RK) :: Max1Dose = 0.0 ! Daily maximum 1-hour average dose

 REAL (KIND=RK) :: Max8Dose = 0.0 ! Daily maximum 8-hour average dose

 REAL (KIND=RK) :: Max1FDose = 0.0 ! Daily maximum end-of-hour dose

 REAL (KIND=RK) :: AvgDose = 0.0 ! Daily average dose

 END TYPE ExpDoseDay

 

 TYPE :: Site 

 INTEGER (KIND=IK) :: Index = 0 ! Sequential index number for site

 CHARACTER(LEN=LEN2) :: Name = "" ! Site name (Max of LEN2

characters)

 REAL (KIND=RK) :: Lat = 0. ! Latitude of site (decimal degrees) 

 REAL (KIND=RK) :: Lon = 0. ! Longitude (decimal, West=negative)

 REAL (KIND=RK) :: DistC = -1. ! Distance in km to study area center

 REAL (KIND=RK) :: DistD = -1. ! Distance in km to district center

 REAL (KIND=RK) :: DistZ = -1. ! Distance in km to zone center

 INTEGER (KIND=IK) :: NumD = 0 ! Assigned district (for sectors) 

 INTEGER (KIND=IK) :: NumZ = 0 ! Assigned zone (for sectors) 

 END TYPE Site 

 TYPE :: CondVar

A-16
 INTEGER (KIND=IK) :: Index = 0 ! Position on CV list

 CHARACTER(LEN=LEN1) :: Name = "" ! Name of profile var (max LEN1

chars)

 INTEGER (KIND=IK) :: UserDef = NO ! User adjustable settings

 INTEGER (KIND=IK) :: Levels = 1 ! # of responses

 END TYPE CondVar

 TYPE :: PopType

 INTEGER (KIND=IK) :: Index = 0 ! Position on PopCat list

 CHARACTER(LEN=6) :: Gender = "" ! Gender of this PopCat

 CHARACTER(LEN=5) :: Race = "" ! Race of this PopCat

 CHARACTER(LEN=LEN3) :: FName = "" ! Population file for this PopCat

 INTEGER (KIND=IK) :: TotPop = 0 ! Total population for this PopCat

 REAL (KIND=RK) :: Frac = 0. ! Population fraction of all PopCats

 END TYPE PopType

 

A-17
! GLOBAL variable list

 

 ! SIMULATION variables - From PARAMS file or derived

 CHARACTER(LEN=LEN3) :: ParFile = "" ! Or "C:\apex3\input\p.txt" 

 CHARACTER(LEN=LEN2) :: ModuleName = "" ! Module name for error routines

 CHARACTER(LEN=LEN2) :: ProcName(2) = "" ! Procedure names for error

routines

 INTEGER (KIND=IK) :: StartDate = 0 ! First day of simulation (YYYYMMDD)

 INTEGER (KIND=IK) :: EndDate = 0 ! Last day of simulation

(YYYYMMDD)

 INTEGER (KIND=IK) :: NumHours = 0 ! Number of hours in simulation

 INTEGER (KIND=IK) :: NumDays = 0 ! Number of days in simulation

 INTEGER (KIND=IK) :: NumYears = 0 ! Number of years (including part

years)

 INTEGER (KIND=IK) :: NumEvents = 0 ! Number of events on composite diary

 INTEGER (KIND=IK) :: NumProfiles = 0 ! # personal profiles to run in model

 INTEGER (KIND=IK) :: NumDistricts = 0 ! # air quality districts

 INTEGER (KIND=IK) :: NumMicros = 0 ! Number of microenvironments

 INTEGER (KIND=IK) :: NumMP = 0 ! Number of Micro-Param conbinations

 INTEGER (KIND=IK) :: NumMPDistrib = 0 ! Number of MP distributions

 INTEGER (KIND=IK) :: NumCV = 0 ! Number of profile variables used as

CV

 INTEGER (KIND=IK) :: NumCVFixed = 0 ! Number of CV not changing daily

 INTEGER (KIND=IK) :: NumPools = 0 ! Number of diary pools

 INTEGER (KIND=IK) :: NumSectors = 0 ! Number of population sectors (tracts)

 INTEGER (KIND=IK) :: NumZones = 0 ! Number of temperature zones

 INTEGER (KIND=IK) :: NumCounties = 0 ! Number of counties on input list

 INTEGER (KIND=IK) :: NumPopTypes = 0 ! Number of gender-race

combinations

 INTEGER (KIND=IK) :: NumAges = 0 ! Number of age groups on population

files

 INTEGER (KIND=IK) :: AgeMin = 0 ! Minimum age in simulation

 INTEGER (KIND=IK) :: AgeMax = 0 ! Maximum age in simulation

 INTEGER (KIND=IK) :: TotPop = 0 ! Population universe 

 INTEGER (KIND=IK) :: CountyList = NO ! Flag for list of study area counties 

 INTEGER (KIND=IK) :: CommuteFlag = NO ! Flag for implementing commuting 

 INTEGER (KIND=IK) :: DoDose = YES ! Flag for doing physiology and dose 

 INTEGER (KIND=IK) :: DSTAdjust = YES ! Flag for Daylight Savings Time 

 INTEGER (KIND=IK) :: HourlyOut = YES ! Flag for hourly exposure and dose

file

 INTEGER (KIND=IK) :: Rollback = NO ! Flag for rolling back ambient values

 REAL (KIND=RK) :: RBFactor = 0.0 ! Rollback factor

 REAL (KIND=RK) :: RBBkgnd = 0.0 ! Rollback background level

 REAL (KIND=RK) :: MissGender = 0.0 ! Prob. of selecting missing gender 

 REAL (KIND=RK) :: MissEmpl = 0.0 ! Prob. of selecting missing employment 

 REAL (KIND=RK) :: MissAge = 0.0 ! Prob. of selecting missing age diaries

 REAL (KIND=RK) :: AgeCutPct = 0.0 ! Percent variation allowed in age match

 REAL (KIND=RK) :: Age2Probab = 0.0 ! Prob. for selecting shoulder age match

A-18
 REAL (KIND=RK) :: PPMFact = 0.0 ! Conversion: number of ug/m3 in 1 ppm

 REAL (KIND=RK) :: Altitude = 0.0 ! Altitude in feet (for lung physiology)

 REAL (KIND=RK) :: COHbFact = 0.0 ! COHb convergence safety factor

 REAL (KIND=RK) :: COThresh = 0.0 ! Threshold CO concentration for

warnings

 REAL (KIND=RK) :: CityRadius = 99999. ! Radius of study area in km

 REAL (KIND=RK) :: AirRadius = 99999. ! Radius of air monitor districts in km

 REAL (KIND=RK) :: ZoneRadius = 99999. ! Radius of temperature zone in km

 CHARACTER(LEN=LEN2) :: Pollutant = "" ! Name of pollutant

 CHARACTER(LEN=LEN2) :: Units = "" ! Units for pollutant concentration

 CHARACTER(LEN=LEN2) :: Location = "" ! Study area location

 CHARACTER(LEN=LEN2) :: Scenario = "" ! Name of scenario

 INTEGER (KIND=IK) :: Clock(2) = 0 ! Job timing variables

 INTEGER (KIND=IK) :: Ios(MAXU) = 0 ! Status of I/O actions

 CHARACTER(LEN=LEN3) :: FName(11:MAXU) = "" ! Array of file names for

OPEN statements

 CHARACTER(LEN=5) :: CList(MAXCOUNTY) = "00000" ! Array of county FIPS

codes

 TYPE (Site) :: Center ! Coordinates of study area center

 TYPE (PopType) :: PopCat(MAXPOPTYPE) ! Array of population categories

 

 ! Random Number seeds - Set in ReadParams in APEX Module 

 INTEGER (KIND=IK) :: KSeed = 0 ! # words needed to store a seed

(<=MAXK)

 INTEGER (KIND=IK) :: ISeed(MAXK) = 0 ! Random seed for general purposes

 INTEGER (KIND=IK) :: ISdAct(MAXK) = 0 ! Random seed for activity diary

selection 

 INTEGER (KIND=IK) :: ISdMET(MAXK) = 0 ! Random seed for METS

distributions

 INTEGER (KIND=IK) :: ISdPrs(MAXK) = 0 ! Random seed for personal variables

 

 ! Variables set in SpaceTimeModule

 TYPE (Calendar), TARGET,ALLOCATABLE :: Calen(:) ! Daily-varying profile-indep.

variables

 TYPE (Site), TARGET,ALLOCATABLE :: SList(:) ! List of population sector

descriptions

 TYPE (Site), TARGET,ALLOCATABLE :: DList(:) ! List of air district descriptions

 TYPE (Site), TARGET,ALLOCATABLE :: ZList(:) ! List of temperature zone

descriptions

 TYPE (TemperDay),TARGET,ALLOCATABLE :: TemData(:,:) ! Temperature data by day

and zone

 REAL (KIND=RK), TARGET,ALLOCATABLE :: AQData(:,:) ! Air quality data by hour

and district

 ! Variables set in ProfileModule

 INTEGER (KIND=IK) :: MinAges(MAXAGEGRPS) = 0 ! Minimum age for each age

group 

A-19
 INTEGER (KIND=IK) :: MaxAges(MAXAGEGRPS) = 0 ! Maximum age for each age

group

 INTEGER (KIND=IK) :: GroupYrs(MAXAGEGRPS) = 0 ! Number of years in each

age group

 REAL (KIND=RK) :: EmpProb(MAXAGEGRPS) = 0. ! Employment probability for

age groups

 TYPE (CondVar) :: CVList(MAXCV) ! List of potential conditional variables

 TYPE (Profile), TARGET,ALLOCATABLE :: Person(:) ! Vector of generated personal

profiles

 TYPE (Physiology), TARGET,ALLOCATABLE :: Phys(:) ! Physiology data for all

profiles

 TYPE (ProfileDay), TARGET,ALLOCATABLE :: PersonDay(:) ! Daily-varying data for

current profile 

 TYPE (EventSequence),TARGET,ALLOCATABLE :: EventSeq(:) ! Event sequence for

current profile

 TYPE (HourSequence), TARGET,ALLOCATABLE :: HourSeq(:) ! Hourly sequence for

current profile

 TYPE (ExpDoseDay), TARGET,ALLOCATABLE :: ExpDose(:,:) ! Profile-day exposures

and doses

 

 ! Variable set in MicroEnvModule

 REAL (KIND=RK), ALLOCATABLE :: MicroConc(:,:,:) ! Concentrations

(hour,micro,district#)

 ! Levels for Output Tales - Set in ReadParameters

 REAL (KIND=RK), ALLOCATABLE :: Pctl(:) ! Percentiles for use on output

tables

 REAL (KIND=RK), ALLOCATABLE :: DM1HExpLev(:) ! Levels for daily max

1-hour exposure

 REAL (KIND=RK), ALLOCATABLE :: DM8HExpLev(:) ! Levels for daily max

8-hour exposure

 REAL (KIND=RK), ALLOCATABLE :: DAvgExpLev(:) ! Levels for daily average

exposure

 REAL (KIND=RK), ALLOCATABLE :: AnnExpLev(:) ! Levels for annual average

exposure

 REAL (KIND=RK), ALLOCATABLE :: ExpTimeLev(:) ! Levels for exposure

duration table

 REAL (KIND=RK), ALLOCATABLE :: DMEHDoseLev(:) ! Levels for daily max

end-of-hour dose

 REAL (KIND=RK), ALLOCATABLE :: DM1HDoseLev(:) ! Levels for daily max

1-hour dose

 REAL (KIND=RK), ALLOCATABLE :: DM8HDoseLev(:) ! Levels for daily max

8-hour dose

 REAL (KIND=RK), ALLOCATABLE :: DAvgDoseLev(:) ! Levels for daily average

dose

 REAL (KIND=RK), ALLOCATABLE :: AnnDoseLev(:) ! Levels for annual average

dose

A-20
 REAL (KIND=RK), ALLOCATABLE :: DoseTimeLev(:) ! Levels for dose duration

table

END MODULE GlobalModule

 

A-21
MODULE UtilityModule ! Compile after GlobalModule

 USE GlobalModule ! Compile this module first

 IMPLICIT NONE ! Must declare all variables

CONTAINS ! Routines internal to this module

SUBROUTINE GetLine(UnitNum,String,LType) ! Called from many places

 INTEGER (KIND=IK), INTENT(IN) :: UnitNum ! Input is unit number for

read

 CHARACTER (LEN=LEN3), INTENT(OUT) :: String ! Output is one record

 INTEGER (KIND=IK), INTENT(OUT) :: LType ! Output is record type 

 INTEGER (KIND=IK) :: I ! Local integer variable

 ! Globals needed: FMT3, IK, LEN3 

 ! Globals altered: Ios

 ! Intrinsic procs: ADJUSTL, INDEX, LEN_TRIM, READ

 ! External procs: <None>

 DO ! Loop until RETURN or EXIT

 READ(UnitNum,FMT3,IOSTAT=Ios(UnitNum)) String ! Read one line from

input file

 IF (Ios(UnitNum)/=0) RETURN ! Exit subroutine on end-of-file 

 String = ADJUSTL(String) ! Trim leading blanks

 I = INDEX(String,'!') ! Locate '!' in input line

 IF (I==1) CYCLE ! Skip comment lines

 IF (I>1) String = String(1:I-1) ! Strip off trailing comments

 IF (LEN_TRIM(String)>0) EXIT ! If anything found, exit loop

 ENDDO ! Continue to read input file

 LType = -1 ! Default line type is numeric

 IF (INDEX("1234567890",String(1:1))>0) RETURN ! Return if first char is

number

 LType = INDEX(String,"=") ! Else locate '=' sign in line

END SUBROUTINE GetLine ! Return to calling routine

A-22
CHARACTER (LEN=LEN3) FUNCTION Up(String) ! Called from many

places

 CHARACTER (LEN=*), INTENT(IN) :: String ! Input is a character string

 INTEGER (KIND=IK) :: I, J ! Local integer variables

 ! Globals needed: IK, LEN3

 ! Globals altered: <None>

 ! Intrinsic procs: ACHAR, IACHAR, LEN_TRIM

 ! External procs: <None>

 Up="" ! Default return value is null

 DO I=1, LEN_TRIM(String) ! Loop over chars in input

 J = IACHAR(String(I:I)) ! ASCII code for char

 IF (J>96.AND.J<123) J=J-32 ! Make lowercase letters uppercase

 Up(I:I) = ACHAR(J) ! Translate ASCII back to char

 ENDDO ! Continue with next char

END FUNCTION Up ! Return to calling routine

A-23
SUBROUTINE Fatal(N)

 INTEGER (KIND=IK), INTENT(IN) :: N

 INTEGER (KIND=IK) :: I

 CHARACTER(LEN=LEN3) :: C

 ! Globals needed: IK, LEN3, LogU, ModuleName, ProcName

 ! Globals altered: <None>

 ! Intrinsic procs: PRINT, WRITE

 ! External procs: <None>

 PRINT*, '** Fatal Error **'

 PRINT*, 'In Module: ', ModuleName

 PRINT*, 'Procedure: ', ProcName

 PRINT*, 'Number : ', N

 WRITE(LogU,*) '** Fatal Error **'

 WRITE(LogU,*) 'In Module: ', ModuleName

 WRITE(LogU,*) 'Procedure: ', ProcName

 WRITE(LogU,*) 'Number : ', N

 C = "Unknown error"

 IF (ModuleName=="APEX") THEN

 IF (ProcName(1)=="ReadParameters".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Table levels not in ascending sequence"

 IF (N== 2) C="Rollback Background > Max" 

 IF (N== 3) C="Rollback Target > Max"

 IF (N== 4) C="Rollback Background > Target"

 ENDIF

 ENDIF 

 IF (ModuleName=="DiaryModule") THEN

 IF (ProcName(1)=="ReadDiaries".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Problem reading CHAD Event File"

 IF (N== 2) C="Cannot read CHAD location code as integer"

 IF (N== 3) C="Cannot read CHAD activity code as integer"

 IF (N== 4) C="Pool number out of range in ReadCHAD"

 IF (N== 5) C="At least one diary pool is empty"

 IF (N== 6) C="Unknown CHAD Activity Codes"

 IF (N== 7) C="Unknown CHAD Location Codes"

 ENDIF

 IF (ProcName(2)=="ReadMicroMap") THEN

 IF (N== 1) C="MicroMap Micro# is out of range"

 ENDIF

 IF (ProcName(2)=="ReadMETS") THEN

 IF (N== 1) C="Data on METS file are not readable"

 ENDIF

 IF (ProcName(1)=="DiaryProbabilities".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="At least one diary pool was empty"

 ENDIF 

 IF (ProcName(2)=="MetEval") THEN

 IF (N== 1) C="Unknown METS distribution type"

 ENDIF

 ENDIF

A-24
 IF (ModuleName=="DistributionModule") THEN

 IF (ProcName(1)=="ReadDistributions".AND.ProcName(2)=="Null") THEN 

 IF (N== 1) C="Maximum number of user-defined distributions exceeded"

 IF (N== 2) C="Unreadable header data on distribution"

 IF (N== 3) C="Missing value for POINT distribution"

 IF (N== 4) C="Bad or missing parameters for UNIFORM distribution"

 IF (N== 5) C="Unreadable data for NORMAL or LOGNORMAL distribution"

 IF (N== 6) C="Negative standard deviation for NORMAL distribution"

 IF (N== 7) C="Bad geom. mean or GSD for LOGNORMAL distribution"

 IF (N== 8) C="Bad truncation values for NORMAL distribution"

 IF (N== 9) C="Bad truncation values for LOGNORMAL distribution"

 IF (N==10) C="Bad Zvalues for NORMAL or LOGNORMAL truncation"

 IF (N==11) C="Cannot do percent truncation for NORMAL or LOGNORMAL"

 IF (N==12) C="Unreadable data for TRIANGLE distribution"

 IF (N==13) C="Bad parameters for TRIANGLE distribution"

 IF (N==14) C="Bad parameters for EXPONENTIAL distribution"

 IF (N==15) C="Bad or unreadable data for truncation of EXPONENTIAL"

 IF (N==16) C="Bad truncation option for EXPONENTIAL"

 IF (N==17) C="Unreadable info line for TABLE distribution"

 IF (N==18) C="Unreadable parameters for TABLE input variable"

 IF (N==19) C="TABLE input variable out of sequence"

 IF (N==20) C="TABLE input variable type not recognized"

 IF (N==21) C="First TABLE variable cannot be conditional"

 IF (N==22) C="Only one conditional variable allowed per TABLE"

 IF (N==23) C="CONDITIONAL TABLE input and result extents do not conform"

 IF (N==24) C="Bad or unreadable CONDITIONAL TABLE probability data"

 IF (N==25) C="Bad or unreadable PROBABILITY TABLE input variable data"

 IF (N==26) C="Bad or unreadable REALRANGE TABLE input variable data"

 IF (N==27) C="Bad or unreadable INTRANGE TABLE input variable data"

 IF (N==28) C="Bad or unreadable INTVALUE TABLE input variable data"

 IF (N==29) C="Unknown type for TABLE input variable"

 IF (N==30) C="Bad or unreadable TABLE RESULT type and extent"

 IF (N==31) C="RESULT TABLE length does not match input extents"

 IF (N==32) C="Bad or unreadable TABLE RESULT data"

 IF (N==33) C="Unknown distribution type encountered"

 IF (N==34) C="Conditional variables must be of type TABLE"

 IF (N==35) C="Conditional variables must have INTEGER results"

 ENDIF

 ENDIF 

 IF (ModuleName=="ExposureDoseModule") THEN

 IF (ProcName(1)=="ExposureDose".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="A negative exposure has been generated"

 IF (N== 2) C="Durations not equal to 60 minutes per hour"

 ENDIF

 ENDIF 

 IF (ModuleName=="MicroEnvModule") THEN

 IF (ProcName(1)=="ReadMicroData".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Micro number is out of range (1-127)"

A-25
 IF (N== 2) C="Micro number exceeds limit on PARAMS file"

 IF (N== 3) C="Micro is neither Mass Balance nor Factors"

 IF (N== 4) C="Micro is not listed in first section of file"

 IF (N== 5) C="Unknown MP parameter type"

 IF (N== 6) C="Problem reading 24 values for Hours-Block mapping"

 IF (N== 7) C="Non-positive Block number found"

 IF (N== 8) C="Problem reading 7 values for Weekday-Daytype mapping"

 IF (N== 9) C="Non-positive Daytype number found"

 IF (N==10) C="Problem reading 12 values for Month-Season mapping"

 IF (N==11) C="Non-positive Season number found"

 IF (N==12) C="Problem reading values for District-Area mapping"

 IF (N==13) C="Non-positive Area number found"

 IF (N==14) C="No # sign in Condition keyword"

 IF (N==15) C="Condition number on MP file unreadable"

 IF (N==16) C="Condition number out of range (1-3)"

 IF (N==17) C="Random number seed is unreadable"

 IF (N==18) C="Distribution data on MP file are unreadable" 

 IF (N==19) C="Found distribution index less than one"

 IF (N==20) C="Distribution index is too large"

 IF (N==21) C="Too many distributions listed for MP"

 IF (N==22) C="Distribution index number out of range"

 IF (N==23) C="Distribution with these indices already defined"

 IF (N==24) C="Unrecognized line type on MP file"

 IF (N==25) C="At least one MP distribution not defined"

 IF (N==26) C="MP counter does not total correctly"

 IF (N==27) C="Distribution counter does not equal total"

 IF (N==28) C="Mass balance micro is missing air exchange rate"

 IF (N==29) C="Mass balance micro with ESource is missing volume"

 ENDIF 

 IF (ProcName(2)=="GetMicroDistrib") THEN

 IF (N== 1) C="First parameter is required for POINT micro distrib"

 IF (N== 2) C="First two parameters required for UNIFORM micro distrib"

 IF (N== 3) C="Maximum not above minimum for UNIFORM micro distrib"

 IF (N== 4) C="Last two parameters required for NORMAL micro distrib"

 IF (N== 5) C="Maximum not above minimum for NORMAL micro distrib"

 IF (N== 6) C="Standard deviation not positive for NORMAL micro distrib"

 IF (N== 7) C="Last two parameters required for LOGNORMAL micro distrib"

 IF (N== 8) C="Negative minimum set for LOGNORMAL micro distrib"

 IF (N== 9) C="Maximum not above minimum for LOGNORMAL micro distrib"

 IF (N==10) C="Median is not positive for LOGNORMAL micro distrib"

 IF (N==11) C="GSD is not over one for LOGNORMAL micro distrib"

 IF (N==12) C="First three parameters required for TRIANGLE micro distrib"

 IF (N==13) C="Maximum not above minimum for TRIANGLE micro distrib"

 IF (N==14) C="Peak below minimum for TRIANGLE micro distrib"

 IF (N==15) C="Peak above maximum for TRIANGLE micro distrib"

 IF (N==16) C="First and third parameters required for EXPONENTIAL micro distrib"

 IF (N==17) C="Maximum not above minimum for EXPONENTIAL micro distrib"

 IF (N==18) C="Mean not above minimum for EXPONENTIAL micro distrib"

A-26
 IF (N==19) C="Unknown shape for microenvironmental distribution"

 ENDIF

 IF (ProcName(2)=="SetupMicroArrays") THEN

 IF (N== 1) C="No micros are defined"

 IF (N== 2) C="No air quality districts for microconcs"

 ENDIF 

 IF (ProcName(1)=="MicroConcs".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Volume for micro is not positive"

 IF (N== 2) C="Negative ESource total found"

 IF (N== 3) C="Negative CSource total found"

 IF (N== 4) C="Negative MP value"

 IF (N== 5) C="Negative concentration found in micro"

 ENDIF

 ENDIF

 IF (ModuleName=="ProfileModule") THEN

 IF (ProcName(1)=="ReadPopulation".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Values after equal sign on Agegroups file not numeric" 

 IF (N== 2) C="No age groups defined for population inputs"

 IF (N== 3) C="Negative employment probability on Agegroups file"

 IF (N== 4) C="Employment probability >1 on Agegroups file"

 IF (N== 5) C="Empty age group defined on Agegroups file"

 IF (N== 6) C="Age groups overlap on Agegroups file"

 IF (N== 7) C="Sectors on pop and sectors files do not match"

 IF (N== 8) C="Not enough populations on input record"

 IF (N== 9) C="Negative population found"

 ENDIF

 ENDIF

 IF (ModuleName=="SpaceTimeModule") THEN 

 IF (ProcName(1)=="CalcDates".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="End date of simulation is before start date"

 ENDIF

 IF (ProcName(1)=="CalcDates".AND.ProcName(2)=="JulianDay") THEN 

 IF (N== 1) C="Earliest possible date is year 1"

 IF (N== 2) C="Month not between 1 and 12 inclusive"

 IF (N== 3) C="Day of month not in valid range"

 ENDIF 

 IF (ProcName(1)=="CalcDates".AND.ProcName(2)=="YearMonthDay") THEN 

 IF (N== 1) C="Minimum Julian day is 1 (Jan 1,0001)"

 ENDIF 

 IF (ProcName(1)=="ReadTemperatures".AND.ProcName(2)=="Null") THEN 

 IF (N== 1) C="Temperature site name is missing"

 IF (N== 2) C="Zone number exceeds NumZones"

 IF (N== 3) C="Problem reading temperature data"

 IF (N== 4) C="Missing temperature data"

 ENDIF

 IF (ProcName(1)=="ReadAirQuality".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Air quality site name is missing" 

 IF (N== 2) C="District number exceeds NumDistricts"

A-27
 IF (N== 3) C="Problem reading air quality data"

 IF (N== 4) C="Missing or negative values in air quality data"

 ENDIF

 IF (ProcName(1)=="SelectSites") THEN

 IF (N== 1) C="Found keyword line on sectors list"

 IF (N== 2) C="Too many sectors - increase MAXSECTORS parameter"

 IF (N== 3) C="No sectors found within study area"

 IF (N== 4) C="Found keyword or numeric input on air monitors list"

 IF (N== 5) C="No monitors found within study area"

 IF (N== 6) C="Found keyword or numeric input on zones list"

 IF (N== 7) C="No temperature zones within study area"

 IF (N== 8) C="No sectors found near air monitors"

 IF (N== 9) C="No air districts selected"

 IF (N==10) C="No temperature zones selected"

 ENDIF

 ENDIF

 IF (ProcName(2)=="Distrib") THEN

 IF (N== 1) C="Distribution name not found on the list"

 IF (N== 2) C="Input value for TABLE not found on integer value list"

 IF (N== 3) C="Variable type for TABLE not found on list of types"

 IF (N== 4) C="Distribution type not found on list of types"

 ENDIF 

 PRINT*, C

 WRITE(LogU,*) C

 WRITE(LogU,'(2I10)') ((I,Ios(I)),I=1,MAXU)

 STOP "See Log File for description of error"

END SUBROUTINE Fatal

A-28
SUBROUTINE Warning(N)

 INTEGER (KIND=IK), INTENT(IN) :: N

 CHARACTER(LEN=LEN3) :: C

 ! Globals needed: IK, LEN3, LogU, ModuleName, ProcName

 ! Globals altered: <None>

 ! Intrinsic procs: PRINT, WRITE

 ! External procs: <None>

 PRINT*, '* Warning * - In :', ModuleName

 PRINT*, ProcName, N

 WRITE(LogU,*) '* Warning * - In :', ModuleName

 WRITE(LogU,*) ProcName, N 

 C = "Unknown error"

 IF (ModuleName=="MicroEnvModule") THEN

 IF (ProcName(1)=="ReadMicroData".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Micro number previously defined"

 ENDIF

 IF (ProcName(2)=="SetupMicroArrays") THEN

 IF (N== 1) C="No MP defined - all micros at ambient levels"

 IF (N== 2) C="No MP distributions"

 ENDIF

 ENDIF

 IF (ModuleName=="SpaceTimeModule") THEN 

 IF (ProcName(1)=="ReadTemperatures".AND.ProcName(2)=="Null") THEN 

 IF (N== 1) C="Less data on temperature file than header indicates"

 IF (N== 2) C="More data on temperature file than header indicates"

 ENDIF

 IF (ProcName(1)=="ReadAirQuality".AND.ProcName(2)=="Null") THEN

 IF (N== 1) C="Less data on air quality file than header indicates"

 IF (N== 2) C="More data on air quality file than header indicates" 

 ENDIF

 ENDIF

 PRINT*, C

 WRITE(LogU,*) C

END SUBROUTINE Warning

END MODULE UtilityModule

A-29
MODULE DistributionModule ! Compile after modules in USE

 USE GlobalModule ! Must compile GlobalModule first

 USE UtilityModule ! Must compile UtilityModule next

 IMPLICIT NONE ! Must declare all variables

 TYPE :: Ptrs ! Stores pointer arrays 

 INTEGER(KIND=IK), POINTER :: I(:) => NULL() ! Pointer to integer table

values 

 REAL (KIND=RK), POINTER :: R(:) => NULL() ! Pointer to real table values

 END TYPE Ptrs ! Used to declare PA in distrib

 TYPE :: Distribution ! Stores data for user distribs

 INTEGER (KIND=IK) :: Index = 0 ! Index # for distribution

 CHARACTER(LEN=LEN2) :: Name = "" ! Name of distribution

 CHARACTER(LEN=LEN3) :: Description = "" ! Description of distribution

 CHARACTER(LEN=LEN2) :: Units = "" ! Units for output of distribution

 INTEGER (KIND=IK) :: DistType = 0 ! Distribution type 

 INTEGER (KIND=IK) :: ResultType = 0 ! Type of result (integer or real) 

 INTEGER (KIND=IK) :: NDim = 0 ! # input dimensions for tables

 INTEGER (KIND=IK) :: TLen(MAXDIM) = 0 ! Extents of input dimensions 

 INTEGER (KIND=IK) :: VarType(MAXDIM) = 0 ! Type of each input

dimension

 TYPE(Ptrs) :: PA(MAXDIM) ! Pointer array for table inputs

 TYPE(CDist) ,POINTER :: CPtr => NULL() ! Pointer to distrib parameters 

 INTEGER (KIND=IK),POINTER :: IRes(:,:,:,:,:,:) => NULL() ! Pointer to integer results 

 REAL (KIND=RK),POINTER :: RRes(:,:,:,:,:,:) => NULL() ! Pointer to real results 

 END TYPE Distribution ! Used to declare DistribList

 TYPE :: CDist ! Stores non-tabular distribs

 REAL (KIND=RK) :: PZero = 0.0 ! Probability of using distrib

 INTEGER (KIND=IK) :: Shape = 0 ! Distribution type # (shape) 

 REAL (KIND=RK) :: Min = 0.0 ! Minimum value (lower truncation) 

 REAL (KIND=RK) :: Max = 0.0 ! Maximum value (upper truncation) 

 REAL (KIND=RK) :: Par1 = 0.0 ! First param for untrunc distrib

 REAL (KIND=RK) :: Par2 = 0.0 ! Second param for untrunc distrib 

 END TYPE CDist ! Used below and in MicroEnvModule

 INTEGER (KIND=IK), PARAMETER :: kINT=1, kREAL=2 ! Fortran type for

numeric vars 

 INTEGER (KIND=IK), PARAMETER :: NDISTTYPE=7, NVARTYPE=6, NTRUNC=3 !

Number of available types

 INTEGER (KIND=IK), PARAMETER :: NONE=0,VALUE=1,ZVALUE=2,PERCENT=3 !

Truncation options

 CHARACTER(LEN=LEN1),PARAMETER :: TRUNCTEXT(0:NTRUNC) = & 

 (/"NONE","VALUE","ZVALUE","PERCENT"/) ! Text for truncation

options

 INTEGER (KIND=IK), PARAMETER :: CONDITIONAL=1, PROBABILITY=2, & 

A-30
 REALRANGE=3, INTRANGE=4, INTVALUE=5, INTINDEX=6 ! Allowed

variable types

 CHARACTER(LEN=LEN1),PARAMETER :: VARTEXT(0:NVARTYPE) = & 

 (/"UNDEFINED", "CONDITIONAL", "PROBABILITY", "REALRANGE", &

 "INTRANGE", "INTVALUE", "INTINDEX" /) ! Text for allowed variable

types

 INTEGER (KIND=IK), PARAMETER :: UNDEFINED=0, TABLE=1, FIXED=2, & 

 POINT=2, UNIFORM=3, NORMAL=4, LOGNORMAL=5, TRIANGLE=6, &

 EXPONENTIAL=7 ! Allowed distrib types

 CHARACTER(LEN=LEN1),PARAMETER :: DISTTEXT(0:NDISTTYPE) = & 

 (/"UNDEFINED","TABLE", "POINT", "UNIFORM", "NORMAL", & 

 "LOGNORMAL", "TRIANGLE", "EXPONENTIAL" /) ! Text for allowed

distrib types

 INTEGER (KIND=IK) :: NumDistrib ! # of user distributions defined

 TYPE(Distribution), TARGET :: DistribList(MAXDISTRIB) ! List of user

distributions 

CONTAINS

A-31
SUBROUTINE ReadDistributions ! Called from main APEX module

 INTEGER (KIND=IK) :: I, J, K, L(MAXDIM), DN, DLen, CV ! Local integer

variables

 INTEGER (KIND=IK) :: CondIndex, CondRes, CondSize ! More local integer

variables 

 REAL (KIND=RK) :: Norm ! Local real variable

 CHARACTER(LEN=LEN2) :: InString, DType ! Local character variables

 TYPE(Distribution), TARGET :: D ! Buffer to hold the distribution

 TYPE(CDist), TARGET :: C ! Holds non-tabular parameters

 ! Globals needed: DistU, FMT2, FMT3, FName, IK, LEN2, LogU, MAXDIM,

MAXDISTRIB, RK 

 ! Globals altered: Ios, ModuleName, NumDistrib, ProcName

 ! Intrinsic procs: ADJUSTL, ALLOCATE, CLOSE, HUGE, LOG, MOD, OPEN, PRODUCT,

READ, SQRT,

 ! SUM, TRIM, WRITE

 ! External procs: Fatal

 ModuleName = "DistributionModule" ! Module name for messages

 ProcName(1) = "ReadDistributions" ! Procedure name for messages

 NumDistrib = 0 ! Start with no distributions

 D%CPtr => C ! Connect D with C 

 OPEN(DistU,FILE=FName(DistU),ACTION='READ',IOSTAT=Ios(DistU)) ! Open file

 DO ! Loop over distributions on file

 READ (DistU,FMT2,IOSTAT=Ios(DistU)) InString ! Read next line on input file

 IF (Ios(DistU)/=0) EXIT ! Exit DO loop on end of file 

 InString = TRIM(ADJUSTL(InString)) ! Left justify the line content 

 IF (InString(1:1)=="!".OR.InString=="") CYCLE ! Drop comment lines

 D%Name = Up(InString) ! Distrib name is first line

 D%Index = NumDistrib + 1 ! Set distrib number 

 IF (D%Index>MAXDISTRIB) CALL Fatal(1) ! Stop if too many

distributions 

 C%PZero = 0.0 ! Default value for probability

 C%Par1 = 0.0 ! Reset defaults for next distrib

 C%Par2 = 0.0 ! Same

 C%Min = 0.0 ! Same 

 C%Max = 0.0 ! Same 

 WRITE(LogU,*) 'Distribution = ',D%Name, D%Index ! Write note to Log file 

 DO CV=1, NUMCV ! Loop over CV distributions

 WRITE(LogU,*) 'CV Search ',CV,CVList(CV)%Name,TRIM(D%Name) ! Check that CV

dists are matched

 IF (CVList(CV)%Name==TRIM(D%Name)) EXIT ! Exit loop when name

matches

 ENDDO ! Try next distribution in list

 IF (CV>NUMCV) CV = 0 ! If not on CV list, set CV=0

 READ (DistU,FMT3,IOSTAT=Ios(DistU)) D%Description ! Description is second

input line

 READ (DistU,FMT2,IOSTAT=Ios(DistU)) D%Units ! Units are on third input

line

 READ (DistU,FMT2,IOSTAT=Ios(DistU)) InString ! Fourth line is distrib type 

A-32
 IF (Ios(DistU)/=0) CALL Fatal(2) ! Stop if error reading headers 

 D%ResultType=kREAL ! Default result type is real

 D%DistType=0 ! No default distrib type

 DO I=1,NDISTTYPE ! Loop over known distrib types

 IF (TRIM(ADJUSTL(InString))==DISTTEXT(I)) D%DistType=I ! Record distrib type

if found

 ENDDO ! Check next type on list

 IF (D%DistType/=TABLE) C%Shape=D%DistType ! If not TABLE, it is

continuous

 IF (CV>0 .AND. D%DistType/=TABLE) CALL Fatal(34) ! Conditional variables

are TABLEs

 SELECT CASE (D%DistType) ! Select the distrib type 

 CASE (POINT) ! For POINT distributions

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Par1 ! Read PAR1 value (only

value)

 IF (Ios(DistU)/=0) CALL Fatal(3) ! Value cannot be read

 C%Min = C%Par1 ! Set minimum to point value 

 C%Max = C%Par1 ! Set maximum to point value 

 CASE (UNIFORM) ! For UNIFORM distributions

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Min, C%Max ! Read MAX and MIN

from file

 IF (Ios(DistU)/=0.OR.C%Min>C%Max) CALL Fatal(4) ! Stop on error

 C%Par1 = (C%Max+C%Min)/2. ! Set mean for uniform

 C%Par2 = (C%Max-C%Min)/SQRT(12.0) ! Set std. dev. for uniform

 CASE (NORMAL,LOGNORMAL) ! For NORMAL or

LOGNORMAL distrib

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Par1, C%Par2 ! Read two parameters

from input

 IF (Ios(DistU)/=0) CALL Fatal(5) ! Stop if values unreadable 

 IF (D%DistType==NORMAL.AND.C%Par2<=0.) CALL Fatal(6) ! Stop if Std dev is

neagative

 IF (D%DistType==LOGNORMAL.AND. &

 ((C%Par1<=0.).OR.(C%Par2<=1.))) CALL Fatal(7) ! Stop if parameters are

invalid

 READ (DistU,*,IOSTAT=Ios(DistU)) InString ! Read truncation type from

input

 DO I=1,NTRUNC ! Loop over known types 

 IF (TRIM(ADJUSTL(InString))==TRUNCTEXT(I)) EXIT ! Exit if I matches type

 ENDDO ! Try the next truncation type

 C%Min=-HUGE(C%Par1) ! Default is large negative 

 C%Max= HUGE(C%Par1) ! Default is large positive 

 SELECT CASE (I) ! Select truncation type

 CASE (VALUE) ! If VALUE truncation...

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Min, C%Max ! Read the MIN and

MAX values

 IF (Ios(DistU)/=0.OR.C%Min>=C%Max) CALL Fatal(8) ! Stop if bad truncation

values

 IF (D%DistType==NORMAL) THEN ! For a NORMAL distrib...

A-33
 C%Min=(C%Min-C%Par1)/C%Par2 ! Convert min value to Zvalue

 C%Max=(C%Max-C%Par1)/C%Par2 ! Convert max value to Zvalue

 ELSE ! Else it is LOGNORMAL... 

 IF ((C%Min<0.).OR.(C%Max<=0.)) CALL Fatal(9) ! Stop if bad truncation

values 

 IF (C%Min>0.) C%Min=LOG(C%Min/C%Par1)/LOG(C%Par2) ! Convert min

value to Zvalue 

 C%Max=LOG(C%Max/C%Par1)/LOG(C%Par2) ! Convert max value to

Zvalue

 ENDIF ! End of VALUE truncation

 CASE (ZVALUE) ! If ZVALUE truncation

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Min, C%Max ! Read MIN and MAX

Zvalues

 IF (Ios(DistU)/=0.OR.C%Min>=C%Max) CALL Fatal(10) ! Stop if bad zvalues

 CASE (PERCENT) ! IF PERCENT truncation...

 CALL Fatal(11) ! Option not implemented yet

 CASE DEFAULT ! Defaults are outside SELECT 

 END SELECT ! End of truncation logic

 CASE (TRIANGLE) ! For TRIANGLE distrib...

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Min, C%Par1, C%Max ! Read three

parameter values

 IF (Ios(DistU)/=0) CALL Fatal(12) ! Unreadable data for triangle

 IF (C%Par1<C%Min.OR.C%Par1>C%Max) CALL Fatal(13) ! Bad parameters for

triangle

 IF (C%Min==C%Max) D%DistType=POINT ! Change distrib type to

POINT

 CASE (EXPONENTIAL) ! For EXPONENTIAL distrib...

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Min, C%Par1 ! Read two parameter

values

 IF (Ios(DistU)/=0.OR.C%Min>C%Par1) CALL Fatal(14) ! Stop if values are bad

 C%Max= HUGE(C%Par1) ! Default upper truncation limit

 READ (DistU,*,IOSTAT=Ios(DistU)) InString ! Read truncation type

 DO I=1,NTRUNC ! Loop over truncation types

 IF (TRIM(ADJUSTL(InString))==TRUNCTEXT(I)) EXIT ! Exit if type matches

 ENDDO ! Try next truncation type

 SELECT CASE (I) ! Select truncation type

 CASE (VALUE) ! If VALUE truncation...

 READ (DistU,*,IOSTAT=Ios(DistU)) C%Max ! Read upper value limit

 IF (Ios(DistU)/=0.OR.C%Min>=C%Max) CALL Fatal(15) ! Stop if limit is invalid 

 CASE (ZVALUE, PERCENT) ! On other truncation options...

 CALL Fatal(16) ! Options not available

 CASE DEFAULT ! Default is no truncation

 END SELECT ! End of truncation options

 CASE (TABLE) ! For TABLE distributions...

 D%NDim=0 ! Start with zero dimensions

 D%VarType=0 ! Set all variable types to NONE

 D%TLen=1 ! Set default lengths to 1

 L=1 ! L are extents of result table

A-34
 CondIndex=0 ! No conditional indices yet

 DO ! Loop over table information

 READ (DistU,FMT2,IOSTAT=Ios(DistU)) InString ! Read next line of input

 IF (Ios(DistU)/=0) CALL Fatal(17) ! Stop if end of file

 InString=TRIM(ADJUSTL(InString)) ! Remove leading blanks

 IF (InString(1:1)=="!") CYCLE ! Drop comment lines

 IF (InString(1:5)=="INPUT") THEN ! If new input variable...

 READ(InString(7:),*,IOSTAT=Ios(7)) DN,DType,DLen ! Read data for new

variable

 IF (Ios(7)/=0) CALL Fatal(18) ! Stop if data are unreadable 

 IF (DN/=D%NDim+1) CALL Fatal(19) ! Stop if variables out of order

 D%NDim=DN ! Assign input variable number 

 D%TLen(DN)=DLen ! Assign input variable extent 

 L(DN)=DLen ! Assign result extent

 DO J=1, NVARTYPE ! Loop over variable types 

 IF (DType==VARTEXT(J)) EXIT ! Exit when right one found

 ENDDO ! Try the next variable type

 IF (J>NVARTYPE) CALL Fatal(20) ! Stop if no match was found

 D%VarType(DN)=J ! Record the variable type in D

 IF (J>=INTRANGE) THEN ! If variable type is integer...

 ALLOCATE (D%PA(DN)%I(DLen),D%PA(DN)%R(0)) ! Make space for

integers

 D%PA(DN)%I = 0 ! Initialize integers to zero

 ELSE ! Else variable type is real...

 ALLOCATE (D%PA(DN)%R(DLen),D%PA(DN)%I(0)) ! Make space for reals

 D%PA(DN)%R = 0. ! Initialize reals to zero

 ENDIF ! End of integer-real block

 SELECT CASE (J) ! J is specific type for variable

 CASE (CONDITIONAL) ! If variable is CONDITIONAL...

 IF (DN==1) CALL Fatal(21) ! First var cannot be conditional

 IF (CondIndex>0) CALL Fatal(22) ! Maximum is one conditional var 

 CondIndex = DN ! Assign index of conditional var

 CondSize = PRODUCT(L(1:DN-1)) ! Extent of conditional input

 IF (MOD(DLen,CondSize)/=0) CALL Fatal(23) ! Stop if extents do not

conform

 CondRes=DLen/CondSize ! Extent of conditional output

 L(1:DN-1)=1 ! Reassign extent of result table

 L(DN)=CondRes ! Extent of conditional result

 READ (DistU,*,IOSTAT=Ios(DistU)) D%PA(DN)%R ! Read conditional data

 IF (Ios(DistU)/=0) CALL Fatal(24) ! Stop if problems reading data

 DO K=0,DLen-CondRes, CondRes ! Loop over rows of data

 Norm = SUM(D%PA(DN)%R(K+1:K+CondRes)) ! Sum of each probability

row 

 D%PA(DN)%R(K+1:K+CondRes) = &

 D%PA(DN)%R(K+1:K+CondRes)/Norm ! Normalize probability to

unity

 DO J=2, CondRes-1 ! For elements in each row...

 D%PA(DN)%R(K+J)=D%PA(DN)%R(K+J) + & 

A-35
 D%PA(DN)%R(K+J-1) ! Convert to cumulative probab.

 ENDDO ! Do the next element

 D%PA(DN)%R(K+CondRes)=1.0 ! Eliminate any roundoff error

 ENDDO ! Finished row of probabilities

 CASE (PROBABILITY) ! If variable is PROBABILITY...

 READ (DistU,*,IOSTAT=Ios(DistU)) D%PA(DN)%R ! Read probability data

 IF (Ios(DistU)/=0) CALL Fatal(25) ! Stop if problems reading data

 Norm = SUM(D%PA(DN)%R) ! Sum of all probabilities 

 D%PA(DN)%R=D%PA(DN)%R/Norm ! Normalize probability to

unity 

 DO J=2, DLen-1 ! Loop over probability values...

 D%PA(DN)%R(J)=D%PA(DN)%R(J)+D%PA(DN)%R(J-1) ! Convert to

cumulative probab. 

 ENDDO ! Do the next element

 D%PA(DN)%R(DLen)=1.0 ! Eliminate any roundoff error

 CASE (REALRANGE) ! If variable is REALRANGE...

 READ (DistU,*,IOSTAT=Ios(DistU)) & 

 D%PA(DN)%R(1:DLen-1) ! Read all but last cutpoint

 IF (Ios(DistU)/=0) CALL Fatal(26) ! Stop if trouble reading data

 CASE (INTRANGE) ! If variable is INTRANGE...

 READ (DistU,*,IOSTAT=Ios(DistU)) & 

 D%PA(DN)%I(1:DLen-1) ! Read all but last cutpoint 

 IF (Ios(DistU)/=0) CALL Fatal(27) ! Stop if trouble reading data 

 CASE (INTVALUE) ! If variable is INTVALUE...

 READ (DistU,*,IOSTAT=Ios(DistU)) D%PA(DN)%I ! Read all values

 IF (Ios(DistU)/=0) CALL Fatal(28) ! Stop if trouble reading data 

 CASE (INTINDEX) ! INTINDEX needs no values 

 CASE DEFAULT ! Unknown variable type

 CALL Fatal(29) ! Stop if unknown variable type 

 END SELECT ! End of TABLE variable block 

 ENDIF ! End of TABLE INPUT block

 IF (InString(1:6)=="RESULT") THEN ! Start of TABLE RESULT block

 READ(InString(8:),*,IOSTAT=Ios(8)) DType, DLen ! Read result type and extent

 IF (Ios(8)/=0) CALL Fatal(30) ! Stop if unreadable result data

 IF (DLen/=PRODUCT(L)) CALL Fatal(31) ! Stop if tables do not conform

 IF (TRIM(ADJUSTL(DType))=="REAL") THEN ! For real number results...

 IF (CV>0) CALL Fatal(35) ! CVs must have integer results

 D%ResultType=kREAL ! Assign result type

 ALLOCATE (D%RRes(L(1),L(2),L(3),L(4),L(5),L(6))) ! Make space for real

results

 ALLOCATE (D%IRes(0,0,0,0,0,0)) ! No space needed for integers

 READ (DistU,*,IOSTAT=Ios(DistU)) D%RRes ! Read real results from file

 ELSE ! Else results are integers

 D%ResultType=kINT ! Assign result type

 IF (CV>0) CVList(CV)%Levels = DLen ! Set # of CV levels

 ALLOCATE (D%IRes(L(1),L(2),L(3),L(4),L(5),L(6))) ! Make space for integer

results

 ALLOCATE (D%RRes(0,0,0,0,0,0)) ! No space needed for reals 

A-36
 READ (DistU,*,IOSTAT=Ios(DistU)) D%IRes ! Read integer results from file

 ENDIF ! End of result type logic block

 IF (Ios(DistU)/=0) CALL Fatal(32) ! Stop if problem reading results

 EXIT ! Exit DO, finished distribution

 ENDIF ! End of TABLE RESULT block

 ENDDO ! End of TABLE block

 IF (TRIM(D%Name)=="DIARYPOOLS") NumPools = MAXVAL(D%IRes) ! Set # of

diary pools

 CASE DEFAULT ! If unknown distribution type...

 CALL Fatal(33) ! Stop if unknown distrib type

 END SELECT ! End of distribution type block 

 IF (Ios(DistU)>0) THEN ! If problems occured...

 WRITE(LogU,*) 'Error ',Ios,' Reading Distribution ', D%Name ! Note which distrib failed

 EXIT ! Get out of subroutine 

 ELSE ! Else if no problems...

 NumDistrib = NumDistrib + 1 ! Add to distribution list

 DistribList(NumDistrib) = D ! Entire D structure copied

 ENDIF ! Finished distribution

 ENDDO ! Loop to next distribution

 WRITE(LogU,*) 'Read ', NumDistrib,' distributions from file' ! Summary message to Log 

 CLOSE(DistU) ! Close input file

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name 

END SUBROUTINE ReadDistributions ! Return to main APEX program 

A-37
SUBROUTINE RnNor(N,Harvest,Min,Max) ! <Called by several modules>

 INTEGER (KIND=IK), INTENT(IN) :: N ! This routine generates 

 REAL (KIND=RK), INTENT(OUT) :: Harvest(:) ! a bivariate normal by 

 REAL (KIND=RK), INTENT(IN) :: Min, Max ! transforming a point in 

 INTEGER (KIND=IK) :: ISet, I ! a uniformly sampled

 REAL (KIND=RK) :: V(0:1), R2 ! unit circle.

 ! Globals needed: IK, RK

 ! Globals altered: <None>

 ! Intrinsic CALLS: LOG, RANDOM_NUMBER, SQRT

 ! External procs: <None> 

 ISet=0 ! Initialize even-odd flag

 I=0 ! Initialize loop counter

 DO WHILE (I<N) ! Loop until enough found

 IF (ISet.EQ.0) THEN ! If even get two new ones

 R2=2. ! Start with bad point

 DO WHILE ((R2>=1.0).OR.(R2==0.)) ! End if in unit circle

 CALL RANDOM_NUMBER(V) ! Get two uniform (0-1) #s

 V=2.*V-1. ! Map onto square 

 R2=V(0)**2+V(1)**2 ! Find distance from origin

 END DO ! Loop for new point

 V = V * SQRT(-2.*LOG(R2)/R2) ! V is bivariate normal 

 END IF ! End of even condition

 ISet = 1-ISet ! Flip even-odd condition 

 IF ((V(ISet)>=Min).AND.(V(ISet)<=Max)) THEN ! If value within bounds...

 I=I+1 ! Increment counter

 Harvest(I)=V(ISet) ! Add random value to list 

 ENDIF ! Done with this value

 END DO ! Do next random value

END SUBROUTINE RnNor ! Return to calling routine

A-38
SUBROUTINE Distrib(Name,Ptr,MDPtr,R1,R2,R3,R4,R5,R6, &

 I1,I2,I3,I4,I5,I6,RRes,IRes) ! <Called by several modules>

 CHARACTER(LEN=LEN2), OPTIONAL, INTENT(IN) :: Name ! Name of desired

distribution

 TYPE(Distribution), OPTIONAL, POINTER :: Ptr ! Pointer to distribution

 TYPE(CDist), OPTIONAL, POINTER :: MDPtr ! Pointer to non-tabular

distrib

 INTEGER(KIND=IK), OPTIONAL, POINTER :: I1(:), I2(:), I3(:) ! First 3 input vectors

(integer)

 INTEGER(KIND=IK), OPTIONAL, POINTER :: I4(:), I5(:), I6(:) ! Next 3 input vectors

(integer)

 REAL (KIND=RK), OPTIONAL, POINTER :: R1(:), R2(:), R3(:) ! First 3 input vectors

(real)

 REAL (KIND=RK), OPTIONAL, POINTER :: R4(:), R5(:), R6(:) ! Next 3 input vectors

(real)

 INTEGER(KIND=IK), OPTIONAL, INTENT(OUT) :: IRes(:) ! Integer output vector

 REAL (KIND=RK), OPTIONAL, INTENT(OUT) :: RRes(:) ! Real output vector

 TYPE(Distribution), POINTER :: D ! Pointer to intended distribution

 TYPE(CDist), POINTER :: C ! Pointer to continuous distrib

 TYPE(Ptrs) :: P(MAXDIM) ! Pointers to I1-I6 and R1-R6

 INTEGER(KIND=IK) :: I, J, K, Indx, N(1), L(MAXDIM), Shape ! Local integer

variables 

 REAL (KIND=RK), ALLOCATABLE :: TProb(:), R(:) ! Dynamic arrays of

probabilities

 INTEGER(KIND=IK), ALLOCATABLE :: TInd(:,:) ! Dynamic array of indices

 ! Globals needed: IK, LEN2, LogU, MAXDIM, RK

 ! Globals altered: ProcName

 ! Intrinsic procs: ALLOCATE, DEALLOCATE, EXP, LBOUND, LOG, PRESENT, 

 ! RANDOM_NUMBER, SQRT, TRIM, UBOUND

 ! External procs: Fatal, RnNor

 ProcName(2) = "Distrib" ! Procedure name for messages

 IF (PRESENT(IRes)) THEN ! If the results are integer...

 N=UBOUND(IRes)-LBOUND(IRes)+1 ! Find number of values needed

 IRes=0 ! Initialize results to zero

 ELSE ! Else if results are real...

 N=UBOUND(RRes)-LBOUND(RRes)+1 ! Find number of values

needed 

 RRes=0. ! Initialize results to zero

 ENDIF ! End of result type logic block

 ALLOCATE(R(N(1))) ! Make space for random numbers

 IF (PRESENT(MDPtr)) THEN ! If contin. distrib is chosen...

 C => MDPtr ! Point to continuous distrib

 Shape = C%Shape ! Assign the distribution type 

 ELSEIF (PRESENT(Ptr)) THEN ! If general distrib is chosen...

 D => Ptr ! Point to general distribution

 IF (D%DistType/=TABLE) C => D%CPtr ! Point to contin. subdistrib.

 Shape = D%DistType ! Assign the distribution type 

 ELSE ! Only the distrib name is known

A-39
 DO I=1, NumDistrib ! Loop over known distributions

 IF (DistribList(I)%Name==TRIM(Name)) EXIT ! Exit loop when name

matches

 ENDDO ! Try next distribution in list

 IF (I>NumDistrib) CALL Fatal(1) ! Stop if no match found

 D => DistribList(I) ! Set pointer to distribution

 IF (D%DistType/=TABLE) C => D%CPtr ! Point to contin. subdistrib. 

 Shape = D%DistType ! Assign the distribution type 

 ENDIF ! End of distrib selection logic

 SELECT CASE (Shape) ! Select distribution type 

 CASE (POINT) ! If type is POINT...

 RRes = C%Min ! Results = minimum value

 CASE (UNIFORM) ! If type is UNIFORM...

 CALL RANDOM_NUMBER(R) ! Get vector of random uniforms

 RRes = (C%Max-C%Min)*R + C%Min ! Map (0,1) to correct interval

 CASE (NORMAL) ! If type is NORMAL...

 CALL RnNor(N(1),R,C%Min,C%Max) ! Get vetor of random normals

 RRes = C%Par1+(C%Par2*R) ! Map (0,1) to correct interval

 CASE (LOGNORMAL) ! If type is LOGNORMAL...

 CALL RnNor(N(1),R,C%Min,C%Max) ! Get vetor of random normals

 RRes = C%Par1*(C%Par2**R) ! Map to interval and transform

 CASE (TRIANGLE) ! If type is TRIANGLE...

 CALL RANDOM_NUMBER(R) ! Get vector of random uniforms

 WHERE (R<(C%Par1-C%Min)/(C%Max-C%Min)) ! For points on left of

peak...

 RRes=C%Min+SQRT((C%Par1-C%Min)*(C%Max-C%Min)*R) ! Transform

uniform to triangle

 ELSEWHERE ! For points on right of peak...

 RRes=C%Max-SQRT((C%Max-C%Par1)*(C%Max-C%Min)*(1.0-R)) ! Transform

uniform to triangle

 END WHERE ! All points now transformed

 CASE (EXPONENTIAL) ! If type is EXPONENTIAL

 CALL RANDOM_NUMBER(R) ! Get vector of random uniforms

 RRes = C%Min-(C%Par1-C%Min)*LOG(1.0-R* &

 (1.0-EXP(-(C%Max-C%Min)/(C%Par1-C%Min)))) ! Transform uniform to

exponen.

 CASE (TABLE) ! If type is TABLE...

 IF(PRESENT(I1)) P(1)%I => I1 ! Load I1 into P array

 IF(PRESENT(I2)) P(2)%I => I2 ! Load I2 into P array, etc.

 IF(PRESENT(I3)) P(3)%I => I3 ! Note: P is an array of pointers

 IF(PRESENT(I4)) P(4)%I => I4 ! to all input variables.

 IF(PRESENT(I5)) P(5)%I => I5 ! It holds from 1 to 6 

 IF(PRESENT(I6)) P(6)%I => I6 ! variables, each either 

 IF(PRESENT(R1)) P(1)%R => R1 ! integer or real, and each 

 IF(PRESENT(R2)) P(2)%R => R2 ! of arbitrary extent.

 IF(PRESENT(R3)) P(3)%R => R3 ! This avoids the need for 

 IF(PRESENT(R4)) P(4)%R => R4 ! large numbers of IF 

 IF(PRESENT(R5)) P(5)%R => R5 ! statements later on.

A-40
 IF(PRESENT(R6)) P(6)%R => R6 ! End of loading the P array

 ALLOCATE(TInd(N(1),MAXDIM)) ! Make space for array of indices

 TInd=1 ! Initialize all indices to one

 DO I=1,D%NDim ! Loop over table dimensions

 SELECT CASE(D%VarType(I)) ! Find the variable type

 CASE(CONDITIONAL) ! For CONDITIONAL variables...

 L(1)=D%Tlen(1) ! Initialize extent of result

 DO K=2,I-1 ! Loop over other variables

 L(K)=D%TLen(K)*L(K-1) ! Extent is product of extents

 ENDDO ! End of loop over variables

 L(I)=D%Tlen(I)/L(I-1) ! Result extent is #table/#input

 ALLOCATE (TProb(L(I))) ! Make space for results

 CALL RANDOM_NUMBER(R) ! Get vector of random uniforms

 DO J=1,N(1) ! Loop over # results needed

 Indx=L(I)*(TInd(J,1)-1) ! Index for conditional lookup

 DO K=2,I-1 ! Loop over conditional inputs

 Indx=Indx+L(I)*L(K-1)*(TInd(J,K)-1) ! Find total index

 ENDDO ! Do next conditional input

 TProb=D%PA(I)%R(Indx+1:Indx+L(I)) ! Vector of result probabilities

 DO K=1,L(I)-1 ! Search probability vector

 IF (R(J)<=TProb(K)) EXIT ! Exit if random # < probability

 ENDDO ! Try next probab. vector element

 TInd(J,I)=K ! Assign index for this result

 ENDDO ! Do next result

 DEALLOCATE (TProb) ! Free conditional probab. table

 TInd(:,1:I-1)=1 ! Set previous indices to unity

 CASE(PROBABILITY) ! For PROBABILITY variables...

 CALL RANDOM_NUMBER(R) ! Get vector of random uniforms

 DO J=1,N(1) ! Loop over # results needed

 DO K=1,D%TLen(I)-1 ! Loop over cumul. probabilties

 IF (R(J)<D%PA(I)%R(K)) EXIT ! Exit if random # < cum. probab.

 ENDDO ! Try next cumulative probability

 TInd(J,I)=K ! Assign index for this result

 ENDDO ! Do next result

 CASE(REALRANGE) ! For REALRANGE variables...

 DO J=1,N(1) ! Loop over # results needed

 DO K=1,D%TLen(I)-1 ! Loop over real cutpoints

 IF (P(I)%R(J)<D%PA(I)%R(K)) EXIT ! Exit if input value < cutpoint

 ENDDO ! Try next cutpoint

 TInd(J,I)=K ! Assign index for this result

 ENDDO ! Do next result

 CASE(INTRANGE) ! For INTRANGE variables...

 DO J=1,N(1) ! Loop over # results needed

 DO K=1,D%TLen(I)-1 ! Loop over integer cutpoints

 IF (P(I)%I(J)<D%PA(I)%I(K)) EXIT ! Exit if input value < cutpoint

 ENDDO ! Try next cutpoint

 TInd(J,I)=K ! Assign index for this result 

 ENDDO ! Do next result

A-41
 CASE(INTVALUE) ! For INTVALUE variables...

 DO J=1,N(1) ! Loop over # results needed

 DO K=1,D%TLen(I) ! Loop over allowed values

 IF (P(I)%I(J)==D%PA(I)%I(K)) EXIT ! Exit if input matches value

 ENDDO ! Try next allowed value

 IF (K>D%TLen(I)) THEN ! If no match is found...

 WRITE(LogU,*) D%Name ! Put distribution name on Log

 CALL Fatal(2) ! Stop with error message

 ENDIF ! End of no match condition 

 TInd(J,I)=K ! Assign index for this result 

 ENDDO ! Do next result

 CASE(INTINDEX) ! For INTINDEX variables...

 TInd(:,I)=D%PA(I)%I(:) ! Copy input index to result

 CASE DEFAULT ! For unknown variable types...

 WRITE(LogU,*) D%VarType(I) ! Put variable type on Log

 CALL Fatal(3) ! Stop with error message

 END SELECT ! End of TABLE VARIABLE logic

 ENDDO ! Do next TABLE dimension

 IF (D%ResultType==kINT) THEN ! For integer TABLE results...

 DO J=1,N(1) ! Loop over vector of results

 IRes(J)=D%IRes(TInd(J,1),TInd(J,2),TInd(J,3), &

 TInd(J,4),TInd(J,5),TInd(J,6)) ! Lookup result from table

 ENDDO ! Do next result 

 ELSE ! Else for real TABLE results

 DO J=1,N(1) ! Loop over vector of results

 RRes(J)=D%RRes(Tind(J,1),TInd(J,2),TInd(J,3), &

 TInd(J,4),TInd(J,5),TInd(J,6)) ! Lookup result from table

 ENDDO ! Do next result 

 ENDIF ! End of result assignment block

 DEALLOCATE(TInd) ! Free index array for results

 CASE DEFAULT ! For unknown distribution type

 CALL Fatal(4) ! Stop with error message 

 END SELECT ! End of distribution type block 

 IF (Shape/=TABLE) THEN ! For continuous distributions...

 CALL RANDOM_NUMBER(R) ! Get uniform random numbers

 WHERE (R<C%PZero) RRes=0.0 ! Zero out those below threshhold 

 ENDIF ! End of zeroing-out logic

 DEALLOCATE(R) ! Free space for random numbers

 ProcName(2) = "Null" ! Default procedure name 

END SUBROUTINE Distrib ! Return to calling routine

A-42
SUBROUTINE Percentiles(Y,N,Pctl,Npctl,Results) ! Called from WriteTables

 INTEGER (KIND=IK), INTENT(In) :: N, Npctl ! # data points, # percentiles

 REAL (KIND=LONG),INTENT(InOut) :: Y(N) ! Input values (sorted in

place)

 REAL (KIND=RK), INTENT(In) :: Pctl(Npctl) ! List of percentiles needed

 REAL (KIND=RK), INTENT(Out) :: Results(Npctl) ! Output value for each

percentile

 REAL (KIND=LONG) :: Z, G ! Local real variables

 INTEGER (KIND=IK) :: I, J, L, IR, NJ ! Local integer variables

 ! Globals needed: IK, LONG, RK

 ! Globals altered: <None>

 ! Intrinsic procs: INT, REAL

 ! External procs: <None>

 L = N/2+1 ! Index for first new hire 

 IR = N ! Index for first retiree

 DO ! Start of Heapsort algorithm

 IF (L>1) THEN ! If still in hiring phase...

 L = L-1 ! Decrement index of new hire

 Z = Y(L) ! Value for the next new hire

 ELSE ! Else in retirement phase

 Z = Y(IR) ! Treat this one as a new hire

 Y(IR) = Y(1) ! Retiring chairman goes to IR

 IR = IR-1 ! Company shrinks by one

 IF (IR==1) EXIT ! Done, if down to one employee

 ENDIF ! End of phase selection logic

 I = L ! Initial index for new hire

 J = L+L ! Index for first subordinate

 DO WHILE (J<=IR) ! Do until no more subordinates

 IF (J<IR.AND.Y(J)<Y(J+1)) J = J+1 ! Pick the higher subordinate

 IF (Z>=Y(J)) EXIT ! If new hire > both, then done

 Y(I) = Y(J) ! Else promote highest subord.

 I = J ! New hire shifts to this index

 J = J+J ! Index of next subordinate

 ENDDO ! Continue with next subordinate

 Y(I) = Z ! New hire belongs here

 ENDDO ! Continue hiring or retiring

 Y(1) = Z ! Final employee is lowest of all

 DO I=1,Npctl ! Loop over list of percentiles

 Z = REAL(N+1)*Pctl(I)/100. ! Find location in sorted list

 NJ = INT(Z) ! Integer part of location

 G = Z-REAL(NJ) ! Fractional part of location

 IF (NJ==0) THEN ! If integer part is zero...

 Results(I) = Y(1) ! Percentile = minimum value

 ELSEIF (NJ==N) THEN ! If integer part is largest #...

 Results(I) = Y(N) ! Percentile = maximum value

 ELSE ! Otherwise, just the usual case

 Results(I) = (1.-G)*Y(NJ)+G*Y(NJ+1) ! Percentile is interpolated

 ENDIF ! End of NJ logic block

A-43
 ENDDO ! Continue with next percentile

END SUBROUTINE Percentiles ! Return to WriteTables

END MODULE DistributionModule ! Last source code line in module

A-44
MODULE SpaceTimeModule ! Compile after the modules below

 USE GlobalModule ! Must compile this module first

 USE UtilityModule ! Must compile this module second

 USE DistributionModule ! Must compile this module third

 IMPLICIT NONE ! Must declare all variables

 INTEGER (KIND=IK) :: StartJulian = 0 ! Julian Day of first day of sim

 INTEGER (KIND=IK) :: EndJulian = 0 ! Julian Day of last day of sim

CONTAINS

SUBROUTINE CalcDates ! Called from main APEX program

 INTEGER (KIND=IK) :: I, J, K, YMD ! Local integer variables

 ! Globals needed: EndDate, HOURSDAY, IK, LEN2, LogU, StartDate 

 ! Globals altered: Calen, ModuleName, NumDays, NumHours, NumYears, ProcName

 ! Intrinsic procs: ALLOCATE, MOD, PRINT, WRITE

 ! External procs: Fatal, JulianDay, YearMonthDay 

 ModuleName = "SpaceTimeModule" ! Module name for messages 

 ProcName(1) = "CalcDates" ! Procedure name for messages

 StartJulian = JulianDay(StartDate) ! Convert start to Julian date

 EndJulian = JulianDay(EndDate) ! Convert end to Julian date

 PRINT*, "Simulation start date =", StartDate, StartJulian ! Message start date to screen

 PRINT*, "Simulation end date =", EndDate , EndJulian ! Message end date to screen

 WRITE(LogU,*) "Simulation start date =", StartDate, StartJulian ! Put start date on log

 WRITE(LogU,*) "Simulation end date =", EndDate, EndJulian ! Put end date on log

 NumDays = 1+EndJulian-StartJulian ! # of days in the simulation

 NumHours = HOURSDAY*NumDays ! # of hours in the simulation

 NumYears = 1+EndDate/10000-StartDate/10000 ! # of years (including partials)

 WRITE(LogU,*)'# Days, Years=',Numdays, NumYears ! Note above values on the

Log

 IF (NumDays<1) CALL Fatal(1) ! Simulation must cover >=1 day

 ALLOCATE(Calen(NumDays)) ! Space for calendar data

 Calen(:)%Weekend = 0 ! Initialize all days to weekdays

 DO I=1,NumDays ! Loop over days in simulation

 J = StartJulian+I-1 ! Julian day corresponding to I

 YMD = YearMonthDay(J) ! Convert date to YYYYMMDD form

 K = MOD(J,7)+1 ! K is day of week (1=Sun)

 Calen(I)%Year = YMD/10000 ! Year for each simulation day

 Calen(I)%Month = MOD(YMD,10000)/100 ! Month for each simulation

day

 Calen(I)%Day = MOD(YMD,100) ! Day for each simulation day

 Calen(I)%DayofWeek = K ! Day of week for each day

 IF ((K==1).OR.(K==7)) Calen(I)%Weekend = 1 ! 1 is Sunday and 7 is Saturday

 Calen(I)%FirstHour = 1+HOURSDAY*(I-1) ! Index of first hour on day I 

 Calen(I)%LastHour = HOURSDAY*I ! Index of last hour on day I

 ENDDO ! End of loop over days

 ModuleName = "Null" ! Default module name

A-45
 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE CalcDates ! Return to main APEX program

A-46
INTEGER FUNCTION JulianDay(Date) ! Called within

TimeSeriesModule

 INTEGER (KIND=IK), INTENT(IN) :: Date ! Date must be in

YYYYMMDD form

 INTEGER (KIND=IK) :: Leap, Z, Month, Day, Year ! Temporary variables

 INTEGER (KIND=IK) :: DayMon(12) ! Array for days per month

 ! Globals needed: IK 

 ! Globals altered: ProcName

 ! Intrinsic procs: MOD, SUM

 ! External procs: Fatal

 ProcName(2) = "JulianDay" ! Procedure name for messages

 Year = Date/10000 ! YYYY part of the input date

 IF (Year<=0) CALL Fatal(1) ! Dates must be positive

 DayMon = (/31,28,31,30,31,30,31,31,30,31,30,31/) ! # days per month (non-leap)

 Leap = 0 ! Default leap year status (no)

 IF (MOD(Year,4)==0) Leap = 1 ! Normal condition for leap year

 IF ((MOD(Year,100)==0).AND.(MOD(Year,400)/=0)) Leap = 0 ! Century rules for leap

year

 IF (Leap) DayMon(2) = 29 ! Extra February day in leap year

 Month = (Date-10000*Year)/100 ! MM part of the input date

 IF ((Month<1).OR.(Month>12)) CALL Fatal(2) ! Check for valid month

 Day = Date-10000*Year-100*Month ! DD part of input date

 IF ((Day<1).OR.(Day>DayMon(Month))) CALL Fatal(3) ! Check for valid day

number

 Z = Year-1 ! Formula is based on last year

 JulianDay = Z*365+Z/4-Z/100+Z/400+SUM(DayMon(1:(Month-1)))+Day ! Formula for

Julian day

 ProcName(2) = "Null" ! Default procedure name

END FUNCTION JulianDay ! Return to calling routine

A-47
INTEGER FUNCTION YearMonthDay(JulianDay) ! Called within

TimeSeriesModule

 INTEGER (KIND=IK), INTENT(IN) :: JulianDay ! Inverse function to

JulianDay()

 INTEGER (KIND=IK) :: Year,Month,Day,N400,N100,N4,N1,Rem,Leap ! Local integer

variables

 INTEGER (KIND=IK) :: DayMon(12) ! Array for days per month

 ! Globals needed: IK

 ! Globals altered: ProcName

 ! Intrinsic procs: MIN, MOD

 ! External procs: Fatal

 ProcName(2) = "YearMonthDay" ! Procedure name for messages

 IF (JulianDay<1) CALL Fatal(1) ! All JulianDays>1 are valid

 N400 = (JulianDay-1)/146097 ! 146097 is # days in 400 years

 Rem = JulianDay - (N400*146097) ! Remainder after 400s removed 

 N100 = MIN((Rem-1)/36524,3) ! 36524 days in short century

 Rem = Rem - (N100*36524) ! Remainder after 100s removed

 N4 = (Rem-1)/1461 ! 1461 days in four years

 Rem = Rem - (N4*1461) ! Remainder after 4s removed

 N1 = MIN((Rem-1)/365,3) ! 365 days in short year

 Rem = Rem - (N1*365) ! Remainder after years removed

 Year = (N400*400) + (N100*100) + (N4*4) + N1 + 1 ! Current year number

 DayMon = (/31,28,31,30,31,30,31,31,30,31,30,31/) ! # days per month (non-leap) 

 Leap = 0 ! Default leap yesr status (no)

 IF (MOD(Year,4)==0) Leap=1 ! Normal leap year condition

 IF ((MOD(Year,100)==0).AND.(MOD(Year,400)/=0)) Leap=0 ! Century leap year

condition

 IF (Leap) DayMon(2)=29 ! # February days in leap year

 DO Month=1,12 ! Loop over months 

 IF (Rem<=DayMon(Month)) EXIT ! Exit if rem <= days in month

 Rem = Rem-DayMon(Month) ! If not, then decrease rem

 ENDDO ! Try the next month

 Day = Rem ! Day number within current month

 YearMonthDay = (Year*10000) + (Month*100) + Day ! Put pieces together

 ProcName(2) = "Null" ! Default procedure name

END FUNCTION YearMonthDay ! Return to calling routine

A-48
SUBROUTINE SelectSites ! Called from main APEX program

 INTEGER (KIND=IK), PARAMETER :: MAXSECTORS = 70000 ! Array sizes for

temporary

 INTEGER (KIND=IK), PARAMETER :: MAXDISTRICTS = 1000 ! storage of site

lists for 

 INTEGER (KIND=IK), PARAMETER :: MAXZONES = 1000 ! sectors, districts

and zones. 

 INTEGER (KIND=IK) :: I, J, II, JJ, Keep1, Keep2 ! Local integer variables

 INTEGER (KIND=IK) :: SCount, DCount, ZCount, NearNum ! More local integer

variables 

 INTEGER (KIND=IK) :: MonStart, MonEnd, LType ! (ditto)

 REAL (KIND=RK) :: Dist, NearDist ! Real variables for distances

 CHARACTER (LEN=LEN3) :: String, SubS ! Buffers for input strings

 TYPE (Site) :: Buf ! Buffer for site parameters

 TYPE (Site), ALLOCATABLE :: S(:), D(:), Z(:) ! Temporary arrays for sites

 ModuleName = "SpaceTimeModule" ! Module name for messages

 ProcName(1) = "SelectSites" ! Procedure name for messages

 ALLOCATE (S(MAXSECTORS),D(MAXDISTRICTS), Z(MAXZONES)) ! Make

space for site lists

 ! S, D, and Z contain the first pass of sites for sectors, districts and zones, respectively.

 ! The eventual lists used in APEX may be shorter; these are named SList, DList, & ZList.

 ! Once the latter lists are filled, the longer lists S, D, and Z are deallocated.

 ! The number of items on the first lists are SCount, DCount, and ZCount.

 ! The number of items on the final lists are NumSectors, NumDistricts, and NumZones.

 ! Each sector is assigned an index number which indicates the row number on the various 

 ! population files. It is assumed (and later tested) that these row numbers match on all

 ! the population files.

 SCount = 0 ! Initialize count of sectors

 Buf%Index = 0 ! Initialize site index #

 OPEN (SectU,File=FName(SectU),IOSTAT=Ios(SectU),ACTION='READ') ! Open the

sectors list file

 DO ! Loop over records on file

 CALL GetLine(SectU,String,LType) ! Get one record

 IF (Ios(SectU)/=0) EXIT ! Exit loop on end-of-file

 IF (LType==0) CYCLE ! Skip non-keyword char lines

 IF (LType>0) CALL Fatal(1) ! No keyword lines allowed

 READ (String,*,IOSTAT=Ios(SectU)) Buf%Name, Buf%Lat, Buf%Lon ! Name must start

with number

 Buf%Index = Buf%Index + 1 ! Increment input file counter 

 Keep1 = 1 ! Flag for keeping this sector

 Buf%DistC = Distance(Center,Buf) ! Find distance to study center

 IF (Buf%DistC>CityRadius) Keep1 = 0 ! Reject sector if too far away

 Keep2 = 1 ! Second keep/reject flag

 IF (CountyList==YES.AND.Keep1==1) THEN ! If user gave a county list...

 Keep2 = 0 ! Set flag to reject

 DO I=1,NumCounties ! Loop over county list

 ! WRITE(LogU,*), 'Buf(1:5), I, Clist(I)=', &

 ! Buf%Name(1:5),I,Clist(I) ! Write county list to log file

A-49
 IF (Buf%Name(1:5)==CList(I)) THEN ! If county name is on list...

 Keep2 = 1 ! Then set flag to KEEP

 EXIT ! Exit the loop over counties

 ENDIF ! End of logic block

 ENDDO ! Continue with next county

 ENDIF ! End of county list logic

 IF (Keep1*Keep2==1) THEN ! If both flags =1 then...

 SCount = SCount + 1 ! Increment sector counter

 IF (SCount>MAXSECTORS) CALL Fatal(2) ! Check if array has space

 S(SCount) = Buf ! Add sector to list

 WRITE(LogU,*) "Sector",SCount,Buf ! Put status message on log

 ENDIF ! End of Keep sector logic

 ENDDO ! Continue with next input record

 CLOSE(SectU) ! Close sector list input file

 IF (SCount==0) CALL Fatal(3) ! Stop run if no sectors found

 ! Now S contains those sectors within CityRadius of Center and on the county list (if it exists)

 ! S%Index indicates the position (row number) of the sector on the population files

 ! This is the first list, the final list depends on proximity to an air monitor. 

 OPEN (MonU,File=FName(MonU),IOSTAT=Ios(MonU),ACTION='READ') ! Open air

districts list file

 DCount = 0 ! Initialize district counter

 DO ! Loop over input records

 CALL GetLine(MonU,String,LType) ! Get one record from input file

 IF (Ios(MonU)/=0) EXIT ! Exit loop on end-of-file

 IF (LType/=0) CALL Fatal(4) ! Insist on non-numeric site name

 READ(String,*,IOSTAT=Ios(MonU)) Buf%Name,Buf%Lat,Buf%Lon, & 

 MonStart, MonEnd ! Extract site info from record

 IF (JulianDay(MonStart)>StartJulian) CYCLE ! Reject site if data starts late

 IF (JulianDay(MonEnd) <EndJulian) CYCLE ! Reject site if data stops early 

 Buf%DistC = Distance(Center,Buf) ! Find distance to study center

 IF(Buf%DistC<=(CityRadius+AirRadius)) THEN ! If site within range then...

 DCount = DCount+1 ! Increment district counter

 Buf%Index = DCount ! Index # = counter

 D(DCount) = Buf ! Copy site info into list

 WRITE(LogU,*) "District",DCount,Buf ! Note site info on log file

 ENDIF ! End of Keep site processing

 ENDDO ! Continue with next record

 CLOSE(MonU) ! Close the district list file

 IF (DCount==0) CALL Fatal(5) ! Stop run if no districts found

 ! Now D contains districts able to affect the sectors on S. Not all these districts will

 ! survive the next pass. Each district has a name from the Mon file, but index=0

 OPEN (ZoneU,File=FName(ZoneU),IOSTAT=Ios(ZoneU),ACTION='READ') ! Open

temperature zone list file

 ZCount = 0 ! Initialize zone counter

 DO ! Loop over records on input file

 CALL GetLine(ZoneU,String,LType) ! Get one record from input file

 IF (Ios(ZoneU)/=0) EXIT ! Exit loop on end-of-file

 IF (LType/=0) CALL Fatal(6) ! Insist on non-numeric site name

A-50
 READ(String,*,IOSTAT=Ios(ZoneU)) Buf%Name,Buf%Lat,Buf%Lon, &

 MonStart, MonEnd ! Extract site info from record

 IF (JulianDay(MonStart)>StartJulian) CYCLE ! Reject site if data starts late

 IF (JulianDay(MonEnd) <EndJulian) CYCLE ! Reject site if data stops early 

 Buf%DistC = Distance(Center,Buf) ! Find distance to study center

 IF(Buf%DistC<=(CityRadius+ZoneRadius)) THEN ! If site within range then...

 ZCount = ZCount+1 ! Increment zone counter

 Z(ZCount) = Buf ! Copy site info into list

 WRITE(LogU,*) "Zone",ZCount,Buf ! Note site info on log file

 ENDIF ! End of Keep site processing

 ENDDO ! Continue with next record

 CLOSE(ZoneU) ! Close the zone list file

 IF (ZCount==0) CALL Fatal(7) ! Stop run if no zones found

 ! Now Z contains zones able to affect the sectors on S.

 ! 

 ! Air sites should be paired with sectors based on distance to the nearest neighbor.

 S(:)%NumD = 0 ! Sectors not paired with district 

 D(:)%NumD = 0 ! Count of sectors per district

 DO J=1,SCount ! Loop over initial sector list

 NearDist = HUGE(NearDist) ! Start with very large distance

 NearNum = 0 ! Start with no selected district

 DO I=1,DCount ! Loop over initial district list

 Dist = Distance(S(J),D(I)) ! Distance from I to J in km

 ! WRITE(LogU,*) "Distance",J,I,Dist ! Report distance on log file

 IF (Dist<NearDist) THEN ! If this is the closest so far...

 NearDist = Dist ! Update nearest distance

 NearNum = I ! Indicate nearest district #

 ENDIF ! End of new-nearest logic

 ENDDO ! Continue with next district

 IF (NearDist<=AirRadius) THEN ! If nearest is close enough...

 S(J)%NumD = NearNum ! Assign sector-district mapping

 S(J)%DistD = NearDist ! Keep actual distance

 D(NearNum)%NumD = D(NearNum)%NumD + 1 ! Increment district usage

counter

 ENDIF ! End of sector-district mapping

 ! WRITE(LogU,*) "SECTOR-MON ", J, S(J)%NumD,S(J)%DistD ! Report mapping

on log file

 ENDDO ! Continue with next sector

 ! Now every sector on S has NumD set to the district # on the first district list (D).

 ! Every district D has NumD set to the number of sectors that are mapped to it.

 ! The district numbering must be revised to reflect the position on DList.

 II = 0 ! Initialize new district counter

 DO I=1,DCount ! Loop over first district list

 D(I)%Index = 0 ! Default index value is zero

 IF (D(I)%NumD>0) THEN ! If district is used...

 II = II + 1 ! Increment new district counter

 D(I)%Index = II ! Set index # to counter

 ENDIF ! End of disrict renumbering

A-51
 ENDDO ! Continue with next district

 ! Now the D%Index number indicates the (eventual) position on DList

 NumSectors = COUNT(S(1:SCount)%NumD>0) ! Count the # of mapped

sectors

 NumDistricts = COUNT(D(1:DCount)%NumD>0) ! Count the # of used

districts

 IF (NumSectors==0) CALL Fatal(8) ! Stop run if no sectors used

 IF (NumDistricts==0) CALL Fatal(9) ! Stop run if no districts used

 ALLOCATE (SList(NumSectors)) ! Final storage space for sectors

 ALLOCATE (DList(NumDistricts)) ! Final district storage space 

 WRITE(LogU,*) "S,D ", SCount, DCount ! Put initial counts on log file

 WRITE(LogU,*) "Sec, Dis ", NumSectors, NumDistricts ! Put final counts on log file

 ! Sectors with S%NumD=0 must be deleted and the sector list compacted.

 ! Also, the district numbers must be changed to the second list instead of the first.

 JJ = 0 ! Initialize new sector counter

 DO J=1,SCount ! Loop over first sector list

 ! WRITE(LogU,*) J,"Sector Maps ",S(J)%Index,S(J)%NumD,S(J)%DistD ! Report mapping

on log file

 IF (S(J)%NumD>0) THEN ! If sector has a district...

 JJ = JJ+1 ! Increment new sector counter

 SList(JJ) = S(J) ! Copy sector info to new list

 SList(JJ)%NumD = D(S(J)%NumD)%Index ! Set NumD to new indexing

 ENDIF ! End of logic for mapped sectors

 ENDDO ! Continue with next sector

 DO I=1,DCount ! Loop over first district list

 WRITE(LogU,*) I,"District Props ", D(I)%Index,D(I)%NumD ! Report mapping on log

file 

 II = D(I)%Index ! Position of I on new list

 IF (II>0) DList(II) = D(I) ! Copy district info to new list

 ENDDO ! Continue with next district

 DList(:)%DistD = 0. ! Zero distance to district

 ! DList should now be final

 !

 ! Now match sectors to zones

 S(:)%NumZ = 0 ! Sectors not paired with zones

 Z(:)%NumZ = 0 ! Count of sectors per zone

 DO J=1,NumSectors ! Loop over final sector list

 NearDist = HUGE(NearDist) ! Start with very large distance

 NearNum = 0 ! Start with no selected zone

 DO I=1,ZCount ! Loop over initial zone list

 Dist = Distance(SList(J),Z(I)) ! Distance from I to J in km

 WRITE(LogU,*) "Distance",J,I,Dist ! Report distance on log file

 IF (Dist<NearDist) THEN ! If this is the closest so far...

 NearDist = Dist ! Update nearest distance

 NearNum = I ! Indicate nearest district #

 ENDIF ! End of new-nearest logic

 ENDDO ! Continue with next zone

 IF (NearDist<=ZoneRadius) THEN ! If nearest is close enough...

A-52
 SList(J)%NumZ = NearNum ! Assign sector-zone mapping

 SList(J)%DistZ = NearDist ! Keep actual distance

 Z(NearNum)%NumZ = Z(NearNum)%NumZ + 1 ! Increment zone usage

counter

 ENDIF ! End of sector-zone mapping

 ! WRITE(LogU,*) "SECTOR-ZONE", J, SList(J)%NumZ,S(J)%DistZ ! Report mapping

on log file

 ENDDO ! Continue with next sector

 ! Each sector has a zone, but NumZ reflects only the position on Z, not on ZList.

 Z(:)%Index = 0 ! Default position on new list

 II = 0 ! Initialize new zone counter

 DO I=1,ZCount ! Loop over first zone list

 IF (Z(I)%NumZ>0) THEN ! If zone is used...

 II = II + 1 ! Increment new zone counter

 Z(I)%Index = II ! Set new zone index #

 ENDIF ! End of used-zone logic block

 ENDDO ! Continue with next zone

 ! Now Z%Index reflects the position on Zlist.

 NumZones = COUNT(Z(1:ZCount)%NumZ>0) ! Count # of zones used

 IF (NumZones==0) CALL Fatal(10) ! Stop run if no zones used

 ALLOCATE (ZList(NumZones)) ! Final array for zones

 DO J=1,NumSectors ! Loop over sectors

 SList(J)%NumZ = Z(SList(J)%NumZ)%Index ! Reassign sector-zone

mapping

 ENDDO ! Continue with next sector

 ! Now Slist should be final

 DO I=1,ZCount ! Loop over first zone list

 II = Z(I)%Index ! Position of I on new list

 IF (II>0) ZList(II) = Z(I) ! Copy zone info to new list

 ENDDO ! Continue with next zone

 ZList(:)%DistZ = 0. ! Nearest zone distance is zero

 ! Now ZList should be final 

 WRITE(LogU,'(/A26)') 'List of population sectors' ! Put sector list on log file

 DO I=1,NumSectors ! Loop over sectors

 WRITE(LogU,*), I, SList(I)%Name, SList(I)%Lat, SList(I)%Lon, & 

 Slist(I)%NumD,Slist(I)%DistD,SList(I)%NumZ,SList(I)%DistZ ! Write sector info to log

file

 ENDDO ! Continue with next sector

 WRITE(LogU,'(/A29)') 'List of air quality districts' ! Put district list on log file

 DO I=1,NumDistricts ! Loop over districts

 WRITE(LogU,*), I, DList(I)%Name, DList(I)%Lat, DList(I)%Lon ! Write district info to

log file

 ENDDO ! Continue with next district

 WRITE(LogU,'(/A25)') 'List of temperature zones' ! Put zone list on log file

 DO I=1,NumZones ! Loop over zones

 WRITE(LogU,*), I, ZList(I)%Name, Zlist(I)%Lat, ZList(I)%Lon ! Write zone info to log

file

 ENDDO ! Continue with next zone

A-53
 WRITE(LogU,*) ! Put blank line on log file

 DEALLOCATE (S,D,Z) ! Erase temporary arrays

 ALLOCATE (AQData(-23:NumHours,0:NumDistricts)) ! Make space for air data

 ALLOCATE (TemData(NumDays,NumZones)) ! Make space for

temperature data

 ModuleName = "Null" ! Default name for module

 ProcName(1) = "Null" ! Default name for procedure

END SUBROUTINE SelectSites ! Return to main APEX program

 

A-54
REAL FUNCTION Distance(P1,P2) ! Called from SelectSites 

 TYPE(Site), INTENT(IN) :: P1,P2 ! Input variables of type SITE 

 REAL (KIND=RK), PARAMETER :: ECC2 = 0.00672265 ! Square of earth's

eccentricity

 REAL (KIND=RK) :: DeltaLat, DeltaLon, K2, Sin2, DA, DB ! Local real variables

 DeltaLat = P2%Lat - P1%Lat ! Separation in latitude degrees

 DeltaLon = ABS(P2%Lon - P1%Lon) ! Separation in longitude degrees 

 IF (DeltaLon>180.) DeltaLon = 360.-DeltaLon ! Take shorter direction 

 Sin2 = SIN((P1%Lat+0.5*DeltaLat)/57.29578)**2 ! Sin(latitude) squared

 K2 = 12393.00467 / (1.-ECC2*Sin2) ! (km/degree) squared, for Earth

 DA = (1.-Sin2) * DeltaLon**2 ! Squared degrees of longitude

 DB = ((1.-ECC2) * DeltaLat / (1.-ECC2*Sin2))**2 ! Squared degrees of latitude

 Distance = SQRT(K2*(DA+DB)) ! Pythagorean distance

END FUNCTION Distance ! Return to SelectSites

A-55
SUBROUTINE ReadTemperatures ! Called from main APEX program

 CHARACTER(LEN=LEN3) :: String ! Buffer for input record

 CHARACTER(LEN=LEN2) :: DistName, SubS ! Buffer for dist and site

names

 INTEGER (KIND=IK) :: Date, I, J, LType, NMiss, TotMiss=0 ! Local integer variables

 REAL (KIND=RK) :: TMax ! Buffer in case inputs are real

 INTEGER (KIND=IK), POINTER :: MT(:), WD(:) ! Pointers to temp and

dayofweek

 ! Globals needed: FName, IK, LEN2, LEN3, LogU, NumDays, NumZones, TempU

 ! Globals altered: Ios, ModuleName, ProcName, TemData 

 ! Intrinsic procs: ADJUSTL, CLOSE, COUNT, INDEX, MINLOC, MINVAL, NINT, OPEN,

READ, TRIM, WRITE

 ! External procs: Distrib, Fatal, GetLine, Up

 ModuleName = "SpaceTimeModule" ! Module name for messages

 ProcName(1) = "ReadTemperatures" ! Procedure name for messages

 TemData(:,:)%TempCat = 0 ! Initialize categories to zero

 DistName = "TEMPCAT" ! Set first distribution name

 OPEN (TempU,File=FName(TempU),IOSTAT=Ios(TempU),ACTION='READ') ! OPEN

temperature input file

 WRITE(LogU,*) 'List of Temperature zone site names:' ! List useful temper sites on

log

 DO I=1,NumZones ! Loop over zones

 WRITE(LogU,*) I,ZList(I)%Name ! Put index and name on log

 ENDDO ! Continue with next zone

 DO ! Loop over records on input file

 CALL GetLine(TempU,String,LType) ! Get one record from input file

 IF (Ios(TempU)/=0) EXIT ! If end-of-file, exit DO loop

 IF (INDEX(Up(String),"NAME")==1) THEN ! If keyword is NAME,

process it

 SubS = TRIM(ADJUSTL(String(LType+1:))) ! Get part on right of '='

 IF (SubS=="") CALL Fatal(1) ! If site has no name, then error

 WRITE(LogU,*) "Subs ", SubS ! Echo site name from input record

 I = MINVAL(MINLOC(ZList%Index,MASK=(ZList%Name==SubS))) ! Find name in

Zlist names

 WRITE(LogU,*) "Found data for zone ",I ! Put site number match on log

 ENDIF ! I is the zone number 

 IF (I<=0) CYCLE ! Skip line if zone not valid

 IF (I>NumZones) CALL Fatal(2) ! This should never happen

 IF (LType>=0) CYCLE ! Only numeric data below here

 READ (String,*,IOSTAT=Ios(TempU)) Date, TMax ! Get YYYYMMDD and

max temp

 IF (Ios(TempU)/=0) CALL Fatal(3) ! Data not numeric

 J = 1 + JulianDay(Date) - StartJulian ! Day number for this record 

 IF (J<1.OR.J>NumDays) CYCLE ! Drop dates out of range

 TemData(J,I)%MaxTemp = NINT(TMax) ! Convert temps to integer

 MT => TemData(J:J,I)%MaxTemp ! Pointer to temp value

 CALL Distrib(Name=DistName,I1=MT,IRes=TemData(J:J,I)%TempCat) ! Get TempCat

for current day

A-56
 ENDDO ! Continue loop over input records

 CLOSE(TempU) ! Close the temperature file

 WRITE(LogU,*) 'Finished reading temperature data' ! Message status to Log file

 WD => Calen%DayofWeek ! Pointer to day of week vector

 DistName = "DIARYPOOLS" ! Name of the distribution

 DO I=1,NumZones ! Loop over temperature zones

 NMiss = COUNT(TemData(:,I)%TempCat==0) ! Count the unassigned

TempCats

 TotMiss = TotMiss+NMiss ! Add site total to overall total 

 IF (NMiss>0) WRITE(LogU,*) "Zone ", ZList(I)%Name," missing", &

 Nmiss, "daily temperatures" ! Write count of missing to log

 MT => TemData(:,I)%MaxTemp ! Pointer to temperature vector

 CALL Distrib(Name=DistName,I1=MT,I2=WD,IRes=TemData(:,I)%Pool) ! Get pool

numbers from distrib

 ENDDO ! Continue with next zone

 IF (TotMiss>0) CALL Fatal(4) ! Stop if any temp data is missing 

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE ReadTemperatures ! Return to main APEX program 

A-57
SUBROUTINE ReadAirQuality ! Called from main APEX program

 CHARACTER(LEN=LEN3) :: String ! Buffer for input record

 CHARACTER(LEN=LEN2) :: SubS ! Buffer for site name

 INTEGER (KIND=IK) :: Date, I, J, LType, NMiss, TotMiss=0 ! Local integer variables

 REAL (KIND=RK) :: Concs(HOURSDAY) ! Buffer for hourly air concs

 ! Globals needed: AQU, DSTAdjust, FName, HOURSDAY, IK, LEN2, LEN3, LogU, 

 ! NumDistricts, NumHours, RBBackgnd, RBFactor, YES

 ! Globals altered: AQData, Ios, ModuleName, ProcName

 ! Intrinsic procs: ADJUSTL, CLOSE, COUNT, INDEX, MINLOC, MINVAL, OPEN, READ,

TRIM, WRITE

 ! External procs: DaylightSaving, Fatal, GetLine, Up 

 ModuleName = "SpaceTimeModule" ! Module name for messages

 ProcName(1) = "ReadAirQuality" ! Procedure name for messages

 OPEN (AQU,File=FName(AQU),IOSTAT=Ios(AQU),ACTION='READ') ! Open air

quality input file

 AQData = -1. ! Initialize data to negative

 WRITE(LogU,*) 'List of Air district site names:' ! List useful air sites on log

 DO I=1,NumDIstricts ! Loop over districts

 WRITE(LogU,*) I,DList(I)%Name ! Put index and name on log

 ENDDO ! Continue with next district

 DO ! Loop over input records

 CALL GetLine(AQU,String,LType) ! Get one record from input file

 IF (Ios(AQU)/=0) EXIT ! If end-of-file, exit DO loop

 IF (INDEX(Up(String),"NAME")==1) THEN ! If keyword is NAME,

process it

 SubS = TRIM(ADJUSTL(String(LType+1:))) ! Get part on right of '='

 IF (SubS=="") CALL Fatal(1) ! If site has no name, then error

 WRITE(LogU,*) "Subs ", SubS ! Echo site name from input record

 I = MINVAL(MINLOC(DList%Index,MASK=(DList%Name==SubS))) ! Find name in

Dlist names

 WRITE(LogU,*) "Found data for district ",I ! Status message for log

 ENDIF ! I is the district number 

 IF (I<=0) CYCLE ! Skip line if district not valid

 IF (I>NumDistricts) CALL Fatal(2) ! This should never happen

 IF (LType>=0) CYCLE ! Only numeric data below here

 READ (String,*,IOSTAT=Ios(AQU)) Concs, Date ! Get 24 concs and

YYYYMMDD

 IF (Ios(AQU)/=0) CALL Fatal(3) ! Data not numeric

 J = 1 + JulianDay(Date) - StartJulian ! Day number for this record

 IF (J<1.OR.J>NumDays) CYCLE ! Drop dates out of range

 AQData(HOURSDAY*(J-1)+1:HOURSDAY*J,I) = Concs ! Copy hourly values

to AQData

 ENDDO ! Continue loop over input records

 CLOSE(AQU) ! Close the air quality file

 WRITE(LogU,*) 'Finished reading air quality data' ! Message status to Log file

 DO I=1,NumDistricts ! Loop over air quality districts

 NMiss = COUNT(AQData(1:,I)<0) ! Count the negative concs

 TotMiss = TotMiss+NMiss ! Add site total to overall total 

A-58
 IF (NMiss>0) WRITE(LogU,*) "District ", DList(I)%Name, &

 " missing", Nmiss, " hourly air concentrations" ! Write count of missing to log

 ENDDO ! Continue with next zone

 IF (TotMiss>0) CALL Fatal(4) ! Stop if any air data is missing 

 IF (DSTAdjust==YES) CALL DaylightSaving ! Adjust for Daylight Saving

Time

 AQData(:,0) = SUM(AQData(:,1:),DIM=2)/NumDistricts ! Average AQ across all

districts

 AQData(1-HOURSDAY:0,:) = AQData(1:HOURSDAY,:) ! Repeat first day of

AQ data

 WHERE(AQData>RBBkgnd) AQData=RBFactor*(AQData-RBBkgnd)+RBBkgnd ! Adjust

AQ data for rollback

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE ReadAirQuality ! Return to main APEX program

A-59
SUBROUTINE DaylightSaving ! Called from ReadAirQuality

 INTEGER (KIND=IK) :: Year, Z, Start, Leap, JulOn, JulOff, On, Off ! Local integer variables

 ! Globals needed: EndDate, HOURSDAY, IK, NumDays, StartDate

 ! Globals altered: AQData, ProcName

 ! Intrinsic procs: EOSHIFT, MOD

 ! External procs: <None>

 ProcName(2) = "DaylightSaving" ! Procedure name for messages

 DO Year = StartDate/10000, EndDate/10000 ! Loop over years in simulation

 Z = Year-1 ! Base is previous year

 Start = (Z*365)+(Z/4)-(Z/100)+(Z/400) ! End Julian day for base year

 Leap = 0 ! Default is non-leap year

 IF (MOD(Year,4)==0) Leap = 1 ! Normal leap year condition 

 IF ((MOD(Year,100)==0).AND.(MOD(Year,400)/=0)) Leap = 0 ! Century bounds

condition

 JulOn = Start+97 +Leap-MOD(Start+Leap+6,7) ! First DST Julian day 

 IF (Year<1986) JulOn = 120+Leap-MOD(Start+Leap+1,7) ! First DST Julian day

(pre-1986)

 JulOff = Start+304+Leap-MOD(Start+Leap+3,7) ! Last DST day (all years)

 IF (StartJulian > JulOff) CYCLE ! No DST for this year

 IF (EndJulian < JulOn) EXIT ! No more DST for simulation

 On = HOURSDAY*(JulOn-StartJulian)+2 ! First DST hour this year

 IF (On < 0) On = 1 ! If simulation starts in summer

 Off = HOURSDAY*(JulOff-StartJulian)+2 ! Last DST hour this year

 IF (Off > HOURSDAY*NumDays) Off = HOURSDAY*NumDays ! If simulation

ends in summer

 AQData(On:Off,:) = EOSHIFT(AQData(On:Off,:),1,AQData(On,:),1) ! Shift DST block one

hour ahead

 ENDDO ! Continue with next year

 ProcName(2) = "Null" ! Default procedure name 

END SUBROUTINE DaylightSaving ! Return to ReadAirQuality

END MODULE SpaceTimeModule ! End of SpaceTimeModule code

A-60
MODULE DiaryModule ! Compile after modules in USE

 USE GlobalModule ! Compile this module first

 USE UtilityModule ! Compile this module second

 USE DistributionModule ! Compile this module third 

 IMPLICIT NONE ! Must declare all variables

 TYPE :: OccupType ! Occupation used to assign METS

 INTEGER (KIND=BYT) :: Row ! Occupation number

 CHARACTER(LEN=LEN1) :: OccDesc ! Occupation description

 END TYPE OccupType ! Used to declare Occups

 TYPE :: METType ! Stores MET distribution data

 CHARACTER(LEN=LEN1) :: DistName = "" ! Distribution type, see

DISTTEXT

 INTEGER (KIND=IK) :: NumType = 0 ! # of distribution type (shape) 

 REAL (KIND=RK) :: Mean = 0.0 ! Mean of untruncated distrib 

 REAL (KIND=RK) :: Median = 0.0 ! Median of untruncated distrib

 REAL (KIND=RK) :: StDev = 0.0 ! Std. dev. of untruncated distrib

 REAL (KIND=RK) :: Min = 0.0 ! Minimum value (lower truncation) 

 REAL (KIND=RK) :: Max = 0.0 ! Maximum value (upper truncation) 

 END TYPE METType ! Used to declare MetDist

 TYPE :: DiarySummary ! Stores diary questionnaire data

 INTEGER (KIND=IK) :: Pool = 0 ! Pool # for diary 

 INTEGER (KIND=IK) :: Index = 0 ! # of diary within the pool 

 INTEGER (KIND=BYT) :: Age = 0 ! Age of respondent (127 max)

 INTEGER (KIND=BYT) :: MaxTemp = 0 ! Max temperature (F) on diary

day 

 INTEGER (KIND=BYT) :: Gender = 0 ! Gender (1=male, 2=female)

 INTEGER (KIND=BYT) :: Race = 0 ! Race (list is in PROFILE)

 INTEGER (KIND=BYT) :: Employed = 0 ! Employment status (1=YES,

2=NO)

 INTEGER (KIND=BYT) :: WeekDay = 0 ! Day of week (1=Monday,

7=Sunday)

 INTEGER (KIND=IK) :: FirstEvent = 0 ! First record # in DData 

 INTEGER (KIND=IK) :: LastEvent = 0 ! Last record # in DData 

 REAL (KIND=RK) :: Probability = 0.0 ! Probability of selecting diary

 CHARACTER (LEN=9) :: DiaryID = "" ! CHADID for each diary

 END TYPE DiarySummary ! Used to declare QData

 TYPE :: DiaryEvents ! Stores diary event data

 INTEGER (KIND=BYT) :: Hour = 0 ! Hour of day event start (0-23)

 INTEGER (KIND=BYT) :: Duration = 0 ! Duration in minutes (1-60)

 INTEGER (KIND=BYT) :: Activity = 0 ! Activity code (may be negative)

 INTEGER (KIND=BYT) :: Location = 0 ! Location code (0-115)

 INTEGER (KIND=BYT) :: HomeWork = 0 ! Place (1=Home, 2=Work,

3=Other)

 END TYPE DiaryEvents ! Used to declare DData

A-61
 

 INTEGER (KIND=IK), PARAMETER :: MAXOCCUPS=16 ! Max # of

occupation categories

 INTEGER (KIND=IK) :: NumOccups=0 ! # of occupation categories used 

 TYPE (OccupType) :: Occups(MAXOCCUPS) ! Vector of type occupation

 TYPE (METType) :: MetDist(-128:127) ! MET params for each activity

 INTEGER (KIND=BYT) :: CHADAct(10300:18940,3) = 0 ! Mapping for CHAD

activities

 INTEGER (KIND=BYT) :: CHADLoc(30000:36500) = -99 ! Mapping for CHAD

locations

 INTEGER (KIND=IK), ALLOCATABLE :: NumDiaries(:,:) ! # diaries per profile

and pool 

 INTEGER (KIND=IK), ALLOCATABLE :: PCount(:) ! Number of diaries per

pool

 TYPE (DiarySummary), ALLOCATABLE :: QData(:,:) ! Diary questionnaire data

 TYPE (DiaryEvents), ALLOCATABLE :: DData(:) ! Diary event data 

 

CONTAINS ! Routines internal to this module

A-62
SUBROUTINE ReadDiaries ! Called from main APEX module

 INTEGER (KIND=IK), PARAMETER :: MAXDIARIES=2**13, MAXEVENTS=2**20 !

Maximum space for diary data

 CHARACTER(LEN=LEN1) :: Occup ! Buffer for reading occupation

 CHARACTER(LEN=LEN2) :: DistName ! Buffer for distribution name

 CHARACTER(LEN=9) :: DID, QID ! Diary and questionnaire IDs

 CHARACTER(LEN=5) :: ActCode, LocCode ! CHAD activity & location

codes

 CHARACTER(LEN=3) :: CWkDay ! Weekday ('MON'-'SUN')

 CHARACTER(LEN=1) :: CEmp, CSex, CRace ! Local character variables

 REAL (KIND=RK) :: CAge, CMaxT ! CHAD age and temperature

 INTEGER (KIND=IK) :: Age, AgeCat, Pool, PoolVec(1), RecCt ! Local integer variables

 INTEGER (KIND=IK) :: AgeSum, AgeMiss, QCMiss, I ! More local integer

variables 

 INTEGER (KIND=IK) :: StartTime, LocInt, ActInt, Discard=0 ! Even more integer

variables

 INTEGER (KIND=IK) :: NumEvents=0, Dur, FirstEvent, DiaryNum=0 ! Still more integer

variables

 INTEGER (KIND=IK) :: QGender, QRace, QEmployed, QWeekDay ! CHAD

questionnaire variables

 INTEGER (KIND=IK), TARGET :: QDayOfWk(1), QMaxTemp(1) ! More

questionnaire variables

 INTEGER (KIND=IK), POINTER :: MT(:), WK(:) ! Pointers to temper. and

weekend

 ! Globals needed: ChQuU, ChEvU, FName, IK, LEN1, LEN2, LogU, NumPools,

NumProfiles, RK

 ! Globals altered: Ios, ModuleName, ProcName

 ! Intrinsic procs: ALLOCATE, ANY, CLOSE, COUNT, INDEX, MOD, OPEN, PRINT,

READ, REAL, WRITE

 ! External procs: Fatal, ReadMicroMap, ReadMETS

 ModuleName = "DiaryModule" ! Module name for messages

 ProcName(1) = "ReadDiaries" ! Procedure name for messages

 ALLOCATE (QData(MAXDIARIES,NumPools)) ! Make space for summary

data 

 ALLOCATE (DData(MAXEVENTS)) ! Make space for diary events 

 ALLOCATE (PCount(NumPools)) ! Make space for pool counts

 ALLOCATE (NumDiaries(NumProfiles,NumPools)) ! Make space for diary

counts 

 CALL ReadMicroMap ! Read CHAD-APEX location mapping

 CALL ReadMETS ! Read METS distributions

 PCount = 0 ! Initialize pool counts to zero

 OPEN (ChQuU,FILE=FName(ChQuU),IOSTAT=Ios(ChQuU),ACTION='READ') ! Open

CHAD questionnaire file

 OPEN (ChEvU,FILE=FName(ChEvU),IOSTAT=Ios(ChEvU),ACTION='READ') ! Open

CHAD diary event file

 DO ! Loop until EXIT occurs

 READ(ChQuU,*,IOSTAT=Ios(ChQuU)) QID, CWkDay, CSex, CRace, &

A-63
 CEmp, CAge, CMaxT, Occup, QCMiss, RecCt ! Read one record from quest

file

 IF (Ios(ChQuU)/=0) EXIT ! Exit on end-of-file

 Discard = Discard+1 ! Assume record will be discarded

 IF (CMaxT<=-99.) CYCLE ! Discard if temperature missing

 IF (CWkDay=="X") CYCLE ! Discard if weekday is missing

 IF (QCMiss>=180) CYCLE ! Discard if >=3 hours missing

 IF (QID=="VAL28040A".OR.QID=="VAL28179A".OR. &

 QID=="VAL28260A".OR.QID=="VAL38027A") CYCLE ! These diaries are

not 24 hours

 Discard = Discard-1 ! Undo the discard status

 FirstEvent = NumEvents+1 ! Add events to end of list

 IF (CAge<0.OR.CAge>=199) CAge = -1. ! This means the age is missing

 Age = CAge ! Age is integer and CAge is real

 IF (Age>=0.AND.Age<=18.AND.CEmp=="X") CEmp="N" ! Those under 19 are

not employed

 AgeCat = 3 ! Default age group is 40+

 IF (Age>25.AND.Age<40) AgeCat = 2 ! Middle age group for METS

 IF (Age>=0.AND.Age<=25) AgeCat = 1 ! Young age group for METS

 DO I=1,NumOccups-1 ! Loop over occupations

 IF (Occup==Occups(I)%OccDesc) EXIT ! Exit when occupation matches

 ENDDO ! Try next occupation

 CHADAct(10900,:) = Occups(I)%Row ! 10900 is code for work

 StartTime = 0 ! Start diary at midnight

 DO WHILE ((StartTime+Dur < 2360).OR.(DID/=QID)) ! Loop over diary event

records 

 READ(ChEvU,*,IOSTAT=Ios(ChEvU)) DID, StartTime, Dur, & 

 ActCode, LocCode ! Read one diary event record

 IF (Ios(ChEvU)/=0) CALL Fatal(1) ! Stop if event file unreadable 

 IF (DID/=QID) CYCLE ! Drop if IDs do not match

 IF (LocCode=="U") LocCode = "36400" ! Numeric value for location 'U'

 IF (LocCode=="X") LocCode = "36500" ! Numeric value for location 'X'

 READ(LocCode,*,IOSTAT=Ios(ChEvU)) LocInt ! Convert character to

integer

 IF (Ios(ChEvU)/=0) CALL Fatal(2) ! Location code is not integer

 IF (ActCode=="U") ActCode = "18930" ! Numeric value for activity 'U'

 IF (ActCode=="X") ActCode = "18940" ! Numeric value for activity 'X'

 IF (ActCode=="17123") ActCode = "17213" ! Correction for CHAD

miscoding 

 READ(ActCode,*,IOSTAT=Ios(ChEvU)) ActInt ! Convert character to integer

 IF (Ios(ChEvU)/=0) CALL Fatal(3) ! Activity code is not integer

 IF (ActInt<11000.AND.ActInt/=10300) ActInt=10900 ! Special code for all work 

 NumEvents = NumEvents+1 ! Increment the event index

 DData(NumEvents)%Hour = StartTime/100 ! Get hour from military time

 DData(NumEvents)%Duration = Dur ! Duration is 1-60 minutes

 DData(NumEvents)%Activity = CHADAct(ActInt,AgeCat) ! Activity from mapping

array

A-64
 DData(NumEvents)%Location = CHADLoc(LocInt) ! Location from mapping

vector

 SELECT CASE (LocInt) ! Assign Home-Work based on Loc

 CASE (:30500,32300,33100,33300,33700,33900,35600,35620) ! For these location

codes...

 DData(NumEvents)%HomeWork=1 ! Place is 'at home'

 CASE (36400,36500) ! For these location codes...

 DData(NumEvents)%HomeWork=-1 ! Place is 'unknown'

 CASE DEFAULT ! For anything else...

 DData(NumEvents)%HomeWork=3 ! Place is 'other'

 END SELECT ! End of location code block

 IF (ActInt<11000) DData(NumEvents)%HomeWork=2 ! These activities are 'at

work'

 ENDDO ! Continue with next event record

 IF (NumEvents-FirstEvent+1/=RecCt) THEN ! Test for consistency in counts

 WRITE(LogU,*) 'Mismatch',QID,RecCt,NumEvents-FirstEvent+1 ! Write message to

Log file

 DO I=FirstEvent, NumEvents ! Loop over events in diary

 WRITE(LogU,*) DData(I) ! Write the events to Log file

 ENDDO ! Next event

 ENDIF ! End of consistency check

 QGender = INDEX("MFX",CSex) ! Convert gender to number 

 QEmployed = INDEX("YNX",CEmp) ! Convert employment to number

 QRace = INDEX("WBAHOX",CRace) ! Convert race to number

 QWeekDay = (INDEX("SUNMONTUEWEDTHUFRISAT",CWkDay)+2)/3 ! Convert

weekday to number

 QMaxTemp(1) = CMaxT ! Put in target for distrib call

 QDayOfWk(1) = QWeekDay ! Put in target for distrib call

 MT => QMaxTemp(1:1) ! Pointer to maximum temperature

 WK => QDayOfWk(1:1) ! Pointer to day of week

 DistName = "DIARYPOOLS" ! Buffer for distribution name

 CALL Distrib(Name=DistName,I1=MT,I2=WK,IRes=PoolVec(1:1)) ! Get pools for this

diary

 Pool = PoolVec(1) ! Convert from vector to scalar

 IF (Pool<1.OR.Pool>NumPools) CALL Fatal(4) ! Pool # out of range

 PCount(Pool) = PCount(Pool)+1 ! Increment count for this pool

 QData(PCount(Pool),Pool)%Pool = Pool ! Load diary into QData array

 QData(PCount(Pool),Pool)%Index = PCount(Pool) ! Ditto, index # within pool

 QData(PCount(Pool),Pool)%Age = Age ! Ditto, age for this diary

 QData(PCount(Pool),Pool)%MaxTemp = QMaxTemp(1) ! Ditto, temperature on

this day

 QData(PCount(Pool),Pool)%Gender = QGender ! Ditto, gender for this diary

 QData(PCount(Pool),Pool)%Race = QRace ! Ditto, race for this diary

 QData(PCount(Pool),Pool)%Employed = QEmployed ! Ditto, employment status 

 QData(PCount(Pool),Pool)%Weekday = QWeekDay ! Ditto, weekday (1-7)

 QData(PCount(Pool),Pool)%FirstEvent = FirstEvent ! Ditto, DData # for first event 

 QData(PCount(Pool),Pool)%LastEvent = NumEvents ! Ditto, DData # for last

event

A-65
 QData(PCount(Pool),Pool)%DiaryID = QID ! Ditto, CHADID for diary

 DiaryNum = DiaryNum+1 ! Total # of diaries accepted

 IF (MOD(DiaryNum,1000)==0) PRINT*,"Reading activity diary #" & 

 ,DiaryNum, QData(PCount(Pool),Pool)%LastEvent ! Report status each 1000

diaries

 ENDDO ! End of diary reading loop

 CLOSE(ChEvU) ! Close diary event file

 CLOSE(ChQuU) ! Close diary questionnaire file

 PRINT*, 'Diaries Discarded=', Discard ! Message on discarded diaries

 PRINT*, 'Pool sizes=', PCount ! Screen report on pool counts

 IF (ANY(PCount(1:NumPools)==0)) CALL Fatal(5) ! Stop if any pool is empty 

 WRITE(LogU,*) 'Diary counts', PCount ! Log file report on pool counts

 AgeSum = 0 ! Initialize summary statistics

 AgeMiss = 0 ! Initialize # with missing age

 DO Pool=1,NumPools ! Loop over pools

 DO I=1,PCount(Pool) ! Loop over diaries within pool

 Age = QData(I,Pool)%Age ! Temporary variable for age 

 IF (Age<0) AgeMiss = AgeMiss+1 ! Counter for missing ages

 IF (Age>=0) AgeSum = AgeSum+Age ! Sum the non-missing ages

 ENDDO ! Continue with next diary

 ENDDO ! Continue with next pool

 WRITE(LogU,*) 'Age mean ', REAL(Agesum)/(DiaryNum-AgeMiss) ! Average of all

non-missing ages

 WRITE(LogU,*) 'Age missing:', AgeMiss ! # of diaries with missing ages

 WRITE(LogU,*) 'Gender=M ',COUNT(QData%Gender==1) ! # of diaries from

males

 WRITE(LogU,*) 'Gender=F ',COUNT(QData%Gender==2) ! # of diaries from

females

 WRITE(LogU,*) 'Gender=X ',COUNT(QData%Gender==3) ! # of diaries of

unknown gender

 WRITE(LogU,*) 'Employed=Y ',COUNT(QData%Employed==1) ! # from employed

persons

 WRITE(LogU,*) 'Employed=N ',COUNT(QData%Employed==2) ! # from persons

not employed

 WRITE(LogU,*) 'Employed=X ',COUNT(QData%Employed==3) ! # of unknown

employment status

 IF (ANY(DData(1:NumEvents)%Activity==0)) CALL Fatal(6) ! Stop if any missing

activities

 IF (ANY(DData(1:NumEvents)%Location==-99)) CALL Fatal(7) ! Stop if any missing

locations

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE ReadDiaries ! Return to main APEX program

A-66
SUBROUTINE ReadMicroMap ! Called from ReadDiaries

 CHARACTER(LEN=LEN3) :: InString ! Buffer for input records

 CHARACTER(LEN=5) :: CHADCode ! CHAD location code

 INTEGER (KIND=IK) :: Exclam, Equals, CHADInt ! Local integer variables

 INTEGER (KIND=BYT) :: MicroNum ! Local 1-byte variable

 ! Globals needed: BYT, ChMapU, FMT3, FName, IK, LEN3

 ! Globals altered: Ios, ProcName

 ! Intrinsic procs: ADJUSTL, CLOSE, INDEX, OPEN, READ, TRIM

 ! External procs: Fatal

 ProcName(2) = "ReadMicroMap" ! Procedure name for messages

 OPEN (ChMapU,FILE=FName(ChMapU),IOSTAT=Ios(ChMapU),ACTION='READ') ! Open

CHAD-micro mapping file 

 READ (ChMapU,*,IOSTAT=Ios(ChMapU)) ! Skip first header line

 READ (ChMapU,*,IOSTAT=Ios(ChMapU)) ! Skip second header line

 DO ! Loop over input file records

 READ(ChMapU,FMT3,IOSTAT=Ios(ChMapU)) InString ! Read next input

record

 Exclam = INDEX(InString,"!") ! Locate start of comment

 IF (Exclam==1) CYCLE ! Drop if entire line is comment

 IF (Exclam>1) InString=TRIM(ADJUSTL(InString(1:Exclam-1))) ! Drop comment

portion of line

 Equals = INDEX(InString,"=") ! Locate = sign in input line

 IF (Ios(ChMapU)<0.OR.Equals==0) EXIT ! Exit loop if error or no =

 READ(InString,'(A5)',IOSTAT=Ios(4)) CHADCode ! Read CHAD code from

buffer

 IF (CHADCode=="U") CHADCode="36400" ! Numeric code for location

'U'

 IF (CHADCode=="X") CHADCode="36500" ! Numeric code for location

'X'

 READ(CHADCode,*,IOSTAT=Ios(5)) CHADInt ! Convert location to

integer

 InString=TRIM(ADJUSTL(InString(Equals+1:))) ! Portion to right of = sign

 READ(InString,*,IOSTAT=Ios(6)) MicroNum ! Convert this to numeric

 IF (MicroNum<-1.OR.MicroNum>NumMicros) CALL Fatal(1) ! Stop if micro # out

of range

 CHADLoc(CHADInt) = MicroNum ! Assign the CHAD-micro

mapping

 ENDDO ! Continue with next input record

 CLOSE(ChMapU) ! Close CHAD-micro mapping file

 ProcName(2) = "Null" ! Default procedure name

END SUBROUTINE ReadMicroMap ! Return to ReadDiaries 

A-67
SUBROUTINE ReadMETS ! Called from ReadDiaries

 INTEGER (KIND=BYT) :: MetsNum ! 1-byte METS distribution #

 CHARACTER(LEN=5) :: CHADCode ! CHAD activity code

 CHARACTER(LEN=LEN1) :: Occup ! CHAD occupation category

 CHARACTER(LEN=1) :: CMetType ! METS distribution type

 INTEGER (KIND=IK) :: AgeCat, CHADInt, I ! Local integer variables 

 ! Globals needed: BYT, IK, FName, LogU, LEN1, MetsU

 ! Globals altered: Ios, ProcName

 ! Intrinsic procs: CLOSE, OPEN, READ, WRITE 

 ! External procs: Fatal

 ProcName(2) = "ReadMETS" ! Procedure name for messages

 OPEN (MetsU,FILE=FName(MetsU),IOSTAT=Ios(MetsU),ACTION='READ') ! Open

METS input file

 READ (MetsU,*,IOSTAT=Ios(MetsU)) ! Skip one header line

 DO ! Loop over records on input file

 READ(MetsU,*,IOSTAT=Ios(MetsU)) MetsNum, CHADCode, AgeCat, &

 Occup, MetDist(MetsNum)%DistName, MetDist(MetsNum)%Mean, &

 MetDist(MetsNum)%Median, MetDist(MetsNum)%StDev, &

 MetDist(MetsNum)%Min, MetDist(MetsNum)%Max ! Read one input record

 IF (Ios(MetsU)<0) EXIT ! Exit loop on end-of-file

 IF (Ios(MetsU)>0) CALL Fatal(1) ! Stop if data are unreadable

 IF (CHADCode=="U") CYCLE ! No METS needed for 'U'

 IF (CHADCode=="X") CYCLE ! No METS needed for 'X'

 CMetType = MetDist(MetsNum)%DistName(1:1) ! Get first letter from shape

 IF (CMetType=="P") MetDist(MetsNum)%NumType = 2 ! P means POINT (2)

 IF (CMetType=="U") MetDist(MetsNum)%NumType = 3 ! U means UNIFORM

(3)

 IF (CMetType=="N") MetDist(MetsNum)%NumType = 4 ! N means NORMAL

(4)

 IF (CMetType=="L") MetDist(MetsNum)%NumType = 5 ! L means

LOGNORMAL (5)

 IF (CMetType=="T") MetDist(MetsNum)%NumType = 6 ! T means TRIANGLE

(6)

 IF (CMetType=="E") MetDist(MetsNum)%NumType = 7 ! E means

EXPONENTIAL (7)

 READ(CHADCode,*,IOSTAT=Ios(3)) CHADInt ! Convert activity to integer

 IF (Occup=='Any') THEN ! If not occupation dependent...

 IF (AgeCat==0) CHADAct(CHADInt,:) = MetsNum ! This means all ages

 IF (AgeCat==20) CHADAct(CHADInt,1) = MetsNum ! Age range 0-25 

 IF (AgeCat==30) CHADAct(CHADInt,2) = MetsNum ! Age range 26-39

 IF (AgeCat==40) CHADAct(CHADInt,3) = MetsNum ! Age range 40+

 ELSE ! Else occupation dependent...

 NumOccups = NumOccups+1 ! Add new occupation to list

 Occups(NumOccups)%OccDesc = Occup ! Description of new occupation

 Occups(NumOccups)%Row = MetsNum ! Number for new occupation

 ENDIF ! End of age-occupation block

 ENDDO ! Continue with next record

A-68
 WRITE(LogU,*) 'Num OCCUP=', NumOccups ! Summarize the occupations

found

 DO I=1, NumOccups ! Loop over occupations

 WRITE(LogU,*) Occups(I)%OccDesc,I ! Write # and description

 ENDDO ! Continue with next occupation

 CHADAct(18930,:) = -1 ! Mapping for CHAD activity 'U'

 CHADAct(18940,:) = -1 ! Mapping for CHAD activity 'X'

 CLOSE(MetsU) ! Close METS input file

 ProcName(2) = "Null" ! Default procedure name

END SUBROUTINE ReadMETS ! Return to ReadDiaries

A-69
SUBROUTINE DiaryProbabilities(P) ! Called from main APEX program

 INTEGER (KIND=IK), INTENT(IN) :: P ! Profile number (input)

 INTEGER (KIND=IK) :: J, K, NonZero ! Local integer variables

 REAL (KIND=RK) :: P1, P2, P3, Total ! Local real variables

 INTEGER (KIND=BYT) :: Gender, Age, Employed, AgeWindow ! Local 1-byte

integer variables

 ! Globals needed: AgeCutPct, BYT, EMPTEXT, IK, LogU, NumPools, Person, RK,

SEXTEXT 

 ! Globals altered: ModuleName, ProcName

 ! Intrinsic procs: ABS, ANY, INT, MAX, NINT, REAL, SUM, WRITE

 ! External procs: Fatal

 ! IF (P<0) WRITE(LogU,*) ! Fix to make Release version work 

 ModuleName = "DiaryModule" ! Module name for messages

 ProcName(1) = "DiaryProbabilities" ! Procedure name for messages

 Gender = INT(Person(P)%Gender,BYT) ! Local 1-byte version of gender

 Age = INT(Person(P)%Age,BYT) ! Local 1-byte version of age

 Employed = INT(Person(P)%Employed,BYT) ! Local 1-byte version of

employ.

 AgeWindow = INT(MAX(NINT(REAL(Age)*AgeCutPct/100.0),1),BYT) ! Width of age

window in years

 DO K=1, NumPools ! Loop over all diary pools

 NonZero = 0 ! Initialize count to zero

 DO J=1, PCount(K) ! Loop over diaries in pool

 P1 = 0.0 ! Initialize gender probability

 P2 = 0.0 ! Initialize employ probability

 P3 = 0.0 ! Initialize age probability

 IF (QData(J,K)%Gender==Gender) P1 = 1.0 ! If gender matches, set p1=1

 IF (QData(J,K)%Gender==3) P1 = MissGender ! If gender missing, set p1

 IF (QData(J,K)%Employed==Employed) P2 = 1.0 ! If employ matches, set p2=1

 IF (QData(J,K)%Employed==3) P2 = MissEmpl ! If employ missing, set p2

 IF (ABS(QData(J,K)%Age-Age)<=AgeWindow) THEN ! If age within window...

 P3=1.0 ! Then set p3=1

 ELSE ! Or if age not within window...

 IF (ABS(QData(J,K)%Age-Age)<=2*AgeWindow) P3=Age2Probab ! If within

shoulder, set p3 

 ENDIF ! End of age testing

 IF (QData(J,K)%Age==-1) P3 = MissAge ! If age is missing, set p3

 QData(J,K)%Probability = P1*P2*P3 ! Set total diary probability

 IF (QData(J,K)%Probability>0.0) NonZero=NonZero+1 ! Count # probabilities > 0

 ENDDO ! Continue with next diary 

 NumDiaries(P,K)=NonZero ! Set diary count array

 Total = SUM(QData(1:PCount(K),K)%Probability) ! Total the probabilities

 IF (Total>0.0) THEN ! If there is any probability...

 QData(1,K)%Probability=QData(1,K)%Probability/Total ! Convert to unit probability

 DO J=2,PCount(K) ! Loop over diaries in pool

 QData(J,K)%Probability=QData(J,K)%Probability/Total+ & 

 QData(J-1,K)%Probability ! Convert to cumulative probab.

 ENDDO ! Continue with next diary

A-70
 ENDIF ! End of setting probability

 ENDDO ! Continue with next pool

 WRITE(LogU,'(A9,I7,A5,I3,1X,A6,1X,A5,A10,12(I6))') &

 'Profile #',P,' Age=',Age, SEXTEXT(Gender), & 

 EMPTEXT(Employed),' Poolsize=', NumDiaries(P,:) ! Put status message on log

 IF (ANY(NumDiaries(P,:)==0)) CALL Fatal(1) ! Stop if a diary pool is empty

 WRITE(LogU,*) 'Finished DiaryProbabilities for #', P !

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE DiaryProbabilities ! Return to main APEX program

A-71
SUBROUTINE CompositeDiary(P) ! Called from main APEX program

 INTEGER (KIND=IK), INTENT(IN) :: P ! Profile number (input)

 INTEGER (KIND=IK) :: I, J, K, Start, L, LOffset, Hour, HOffset ! Local integer variables

 INTEGER (KIND=IK) :: Pool !

 REAL (KIND=RK) :: R(NumDays) ! Local array for random numbers

 ! Globals needed: HOURSDAY, IK, KSeed, NumDays, RK

 ! Globals altered: EventSeq, HourSeq, ISdAct, ISdMET, ModuleName, NumEvents,

ProcName

 ! Intrinsic procs: RANDOM_SEED, RANDOM_NUMBER

 ! External procs: MetEval

 ModuleName = "DiaryModule" ! Module name for messages

 ProcName(1) = "CompositeDiary" ! Procedure name for messages

 WRITE(LogU,*) 'Starting CompositeDiary for # ',P ! 

 Start = 0 ! Initialize first event offset

 EventSeq%Hour = 0 ! Initialize hour for each event

 EventSeq%Duration = 0 ! Initialize duration per event

 EventSeq%Activity = 0 ! Initialize activity per event

 EventSeq%Location = 0 ! Initialize location per event

 HourSeq%FirstEvent = 0 ! Initialize first event per hour

 HourSeq%LastEvent = 0 ! Initialize last event per hour

 CALL RANDOM_SEED(Put=ISdAct(1:KSeed)) ! Set ACT random number

seed

 CALL RANDOM_NUMBER(R) ! Get uniform randoms for each

day

 CALL RANDOM_SEED(Get=ISdAct(1:KSeed)) ! Record ACT random seed

setting

 DO J=1,NumDays ! Loop over days in simulation

 Pool = TemData(J,SList(Person(P)%HomeSec)%NumZ)%Pool ! Pool for that person

and day

 DO K=1,PCount(Pool)-1 ! Loop over diaries in pool

 IF (R(J)<QData(K,Pool)%Probability) EXIT ! Exit if R < cumulative probab

 ENDDO ! Try next diary in this pool

 LOffset = QData(K,Pool)%FirstEvent-1 ! Offset for start of diary

 HOffset = HOURSDAY*(J-1)+1 ! Offset for starting hour

 DO L=LOffset+1,QData(K,Pool)%LastEvent ! Loop over events in diary

 I = Start+L-LOffset ! I is event # on composite

 Hour = HOffset+DData(L)%Hour ! Hour is hour # on composite

 EventSeq(I)%Day = J ! Set day for each event

 EventSeq(I)%Hour = Hour ! Set hour for each event 

 EventSeq(I)%Duration = DData(L)%Duration ! Set duration for each event

 EventSeq(I)%Activity = DData(L)%Activity ! Set activtiy for each event

 EventSeq(I)%Location = DData(L)%Location ! Set location for each event

 EventSeq(I)%HomeWork = DData(L)%HomeWork ! Set home-work for each

event

 IF (HourSeq(Hour)%FirstEvent==0) HourSeq(Hour)%FirstEvent=I ! Set hour for first

event

 HourSeq(Hour)%LastEvent=I ! Set hour for last event

 ENDDO ! Continue with next event 

A-72
 Start=Start+QData(K,Pool)%LastEvent-LOffSet ! Update the event offset

 ENDDO ! Continue with next day

 NumEvents = Start ! # events for this composite

 DO I=1,NumEvents ! Loop over events in composite

 EventSeq(1)%Location = EventSeq(I)%Location ! Reset first location 

 IF (EventSeq(1)%Location/=-1) EXIT ! Exit when it is not missing

 ENDDO ! Continue with next event

 DO I=1,NumEvents ! Loop over events in composite

 EventSeq(1)%Activity = EventSeq(I)%Activity ! Reset first activity 

 IF (EventSeq(1)%Activity/=-1) EXIT ! Exit when it is not missing

 ENDDO ! Continue with next event

 DO I=1,NumEvents ! Loop over events in composite 

 EventSeq(1)%HomeWork=EventSeq(I)%HomeWork ! Reset first home-work

value

 IF (EventSeq(1)%HomeWork/=-1) EXIT ! Exit when it is not missing 

 ENDDO ! Continue with next event

 DO I=2,NumEvents ! Loop over remaining events

 IF (EventSeq(I)%Location==-1) &

 EventSeq(I)%Location = EventSeq(I-1)%Location ! Set missing locs to previous

 IF (EventSeq(I)%Activity==-1) & 

 EventSeq(I)%Activity = EventSeq(I-1)%Activity ! Set missing acts to previous

 IF (EventSeq(I)%HomeWork==-1) &

 EventSeq(I)%HomeWork = EventSeq(I-1)%HomeWork ! Set missing HWs to

previous

 ENDDO ! Continue with next event

 CALL RANDOM_SEED(Put=ISdMET(1:KSeed)) ! Set MET random

number seed

 DO I=1,NumEvents ! Loop over events in composite

 CALL MetEval(EventSeq(I)%Activity,EventSeq(I)%MET) ! Set METS value for

this event

 ENDDO ! Continue with next event

 CALL RANDOM_SEED(Get=ISdMET(1:KSeed)) ! Record MET random

number seed

 WRITE(LogU,*) 'Finished CompositeDiary for # ',P !

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE CompositeDiary ! Return to main APEX program

A-73
SUBROUTINE MetEval(MetNum,MetVal) ! Called from CompositeDiary

 INTEGER (KIND=IK), INTENT(IN) :: MetNum ! Input variable declaration

 REAL (KIND=RK), INTENT(OUT) :: MetVal ! Output variable declaration

 REAL (KIND=RK) :: X(1), Mean, Med, StDev, Min, Max, GSD ! Local real variables

 ! Globals needed: IK, RK

 ! Globals altered: ProcName

 ! Intrinsic procs: EXP, LOG, SQRT, RANDOM_NUMBER

 ! External procs: Fatal, RnNor

 ProcName(2) = "MetEval" ! Procedure name for messages

 Mean = MetDist(MetNum)%Mean ! Local copy of distrib mean

 Med = MetDist(MetNum)%Median ! Local copy of distrib median

 StDev = MetDist(MetNum)%StDev ! Local copy of distrib std dev

 Min = MetDist(MetNum)%Min ! Local copy of distrib minimum

 Max = MetDist(MetNum)%Max ! Local copy of distrib maximum

 SELECT CASE (MetDist(MetNum)%NumType) ! Select on distrib type

(shape)

 CASE (2) ! Point distrbution... 

 MetVal = Mean ! Formula for point

 CASE (3) ! Uniform distribution...

 CALL RANDOM_NUMBER(X) ! Get (0-1) uniform random #

 MetVal = Min + (Max-Min)*X(1) ! Convert to proper range

 CASE (4) ! Normal distribution...

 CALL RnNor(1,X,(Min-Mean)/StDev,(Max-Mean)/StDev) ! Get truncated unit

normal 

 MetVal = Mean + (StDev*X(1)) ! Convert to proper range

 CASE (5) ! Lognormal distribution...

 GSD = EXP(SQRT(0.5*LOG(1.0+StDev**2/LOG(Med)**2))) ! Geometric standard

deviation

 CALL RnNor(1,X,LOG(Min/Med)/LOG(GSD),LOG(Max/Med)/LOG(GSD)) ! Get

truncated unit lognormal 

 MetVal = Med * (GSD**X(1)) ! Convert to proper range

 CASE (6) ! Triangle distribution...

 CALL RANDOM_NUMBER(X) ! Get (0-1) uniform random #

 IF(X(1)<=(3.*Mean-2.*Min-Max)/(Max-Min))THEN ! If X on left of mode...

 MetVal = Min+SQRT((Max-Min)*(3.*Mean-2.*Min-Max)*X(1)) ! Formula for left

side

 ELSE ! Else X on right of mode...

 MetVal = Max-SQRT((Max-Min)*(Min-3.*Mean+2.*Max)*(1.-X(1))) ! Formula for right

side

 ENDIF ! End of triangle distribution

 CASE (7) ! Exponential distribution...

 CALL RANDOM_NUMBER(X) ! Get (0-1) uniform random #

 MetVal = Min - StDev*LOG(1.-X(1)*(1.0-EXP(-(Max-Min)/StDev))) ! Formula for trunc.

exponential

 CASE DEFAULT ! Unknown distribution type

 CALL Fatal(1) ! Stop on unknown type

 END SELECT ! End of distribution type select

 ProcName(2) = "Null" ! Default procedure name

A-74
END SUBROUTINE MetEval ! Return to CompositeDiary

END MODULE DiaryModule ! Last source code line in module

A-75
MODULE ProfileModule ! Compile after the modules below

 USE GlobalModule ! Compile this module first

 USE UtilityModule ! Compile this module second

 USE DistributionModule ! Compile this module third

 IMPLICIT NONE ! Must declare all variables

 INTEGER (KIND=IK),ALLOCATABLE :: PopCounts(:,:,:) ! Sector-age

populations

 REAL (KIND=RK),ALLOCATABLE :: PopProbs(:,:,:) ! Sector-age cumul.

probabilities

 INTEGER (KIND=IK),ALLOCATABLE :: CommWork(:) ! CommProb - Work

sector mapping

 INTEGER (KIND=IK),ALLOCATABLE :: CommHome(:) ! Home sector -

CommProb mapping

 REAL (KIND=RK),ALLOCATABLE :: CommProb(:) ! Work sector

probabilities

CONTAINS ! Internal subroutines 

SUBROUTINE SetCVList ! Called from main APEX program 

 INTEGER (KIND=IK) :: I ! Local integer variable

 ! Globals needed : NUMGENDERS, NUMRACES, NO, YES

 ! Globals altered : CVList, NumCV, NumCVFixed

 ! Intrinsic procs : TRIM

 ! External procs : Up

 NumCV = 10 ! # of potential CV variables

 NumCVFixed = 7 ! # of CV that do not change daily

 CVList(1)%Name = "Gender" ! Name of first CV variable

 CVList(2)%Name = "Race" ! Note that the order of the

 CVList(3)%Name = "Employed" ! CV variables is arbitrary,

 CVList(4)%Name = "GasStove" ! except that the array 

 CVList(5)%Name = "GasPilot" ! positions indicated here

 CVList(6)%Name = "AC_Home" ! must agree with the ones 

 CVList(7)%Name = "AC_Car" ! in Function CVValue.

 CVList(8)%Name = "WindowPos" ! Also, the ones that do not 

 CVList(9)%Name = "TempCat" ! vary daily should be listed

 CVList(10)%Name = "SpeedCat" ! first (1-7 in this case).

 CVList(1:3)%UserDef = NO ! No user definitions allowed

 CVList(4:10)%UserDef = YES ! User defined properties

 CVList(1)%Levels = NUMGENDERS ! # of possible genders

 CVlist(2)%Levels = NUMRACES ! # of possible races

 CVList(3:8)%Levels = 2 ! # of possible response values

 CVList(9:10)%Levels = 3 ! # of possible response values

 DO I=1,NumCV ! Loop over the CV List

 CVList(I)%Index = I ! Set the index position

 CVList(I)%Name = TRIM(Up(CVList(I)%Name)) ! Put name in uppercase 

 ENDDO ! Continue with next item 

A-76
END SUBROUTINE SetCVList ! Return to main APEX program 

A-77
INTEGER FUNCTION CVValue(P,I,C) ! Called from MicroEnvModule

 INTEGER (KIND=IK), INTENT(IN) :: P, I ,C ! All parameters are inputs

 ! Globals needed : NumCV, Person, PersonDay, SList, TemData

 ! Globals altered : <None>

 ! Intrinsic procs : <None>

 ! External procs : Fatal

 ! WRITE(LogU,*) 'CVValue called with ', P,I,C ! Message for debugging 

 IF (C<0.OR.C>NumCV) CALL Fatal(1) ! C must be one of the CV List

 IF (C==0) CVValue = 1 ! C=Zero means no CV selected 

 IF (C==1) CVValue = Person(P)%Gender ! As mentioned in SetCVList

above,

 IF (C==2) CVValue = Person(P)%Race ! the items in this function

 IF (C==3) CVValue = Person(P)%Employed ! must be in the same order 

 IF (C==4) CVValue = Person(P)%GasStove ! as the ones in SetCVList.

 IF (C==5) CVValue = Person(P)%GasPilot ! At present, APEX does not 

 IF (C==6) CVValue = Person(P)%AC_Home ! automatcially check that the

 IF (C==7) CVValue = Person(P)%AC_Car ! two lists are the same, so 

 IF (C==8) CVValue = PersonDay(I)%WindowPos ! the programmer must do

so.

 IF (C==9) CVValue = &

 TemData(I,SList(Person(P)%HomeSec)%NumZ)%TempCat ! TempCat for day I,

person P 

 IF (C==10) CVValue = PersonDay(I)%SpeedCat ! Vehicle speed category for

day I

END FUNCTION CVValue ! Return to MicroConcs subroutine 

A-78
SUBROUTINE ReadPopulation ! Called from main APEX program

 INTEGER (KIND=IK) :: Age, I, J, K, LCount, SCount, LType ! Local integer variables

 INTEGER (KIND=IK) :: Skip(MAXAGEGRPS) ! Local integer vector

 CHARACTER(LEN=3) :: Key ! Keyword of length 3 chars

 CHARACTER(LEN=LEN2) :: Name ! Variable for sectors IDs 

 CHARACTER(LEN=LEN3) :: String ! Buffer for line from input file

 REAL (KIND=LONG) :: RPop ! Local real variable

 ! Globals needed: CommuteFlag, FName, IK, LEN2, LEN3, LONG, 

 ! MAXAGEGRPS, NumPopTypes, PopCat, PopU, YES

 ! Globals altered: Ios, ModuleName, NumAges, ProcName, TotPop

 ! Intrinsic procs: ADJUSTL, ALLOCATE, ANY, CLOSE, INDEX, MAX, OPEN, READ,

REAL, SCAN, SUM, WRITE 

 ! External procs: Fatal, GetLine, ReadCommute, Up

 ModuleName = "ProfileModule" ! Module name for messages

 ProcName(1) = "ReadPopulation" ! Procedure name for messages

 PRINT*, 'Starting ReadPopulation' ! Status message for screen

 !

 ! Popcounts: first index is gender*race combination

 ! second index is home sector

 ! third index is age group

 ! In order to select a person, first find the fractions of the total population in each

 ! gender-race combination (a vector of length NumPopTypes). Select one using these probabs.

 ! Within the selected one, select a sector. This requires the counts of that row (all ages) for 

 ! that sector, but does not consider any persons in other gender-race categories. 

 ! This can be done by setting up a cell to hold each row total, and then normalizing them

 ! over the sectors in the study area (on SList).

 ! Then within each row, an age group is selected by dividing each count by the row total 

 ! which provides probabilities. Finally, the selected age group is divided into single

 ! years of age using uniform probs, except perhaps for the highest (over 85) age group.

 ! If there are 1000 sectors, 30 ages, and 10 gender-races, then there are 300,000 pops. 

 ! Actually, two vectors are needed, one with probabilties and one with counts (for use 

 ! with the output tables. In popcounts, agegroup zero contains the sum across ages. 

 ! For PopProbs, it is the fraction of all persons of the given type living in that sector. 

 ! PopProbs(I,0,0) contains the fraction of all persons that happen to be of type I.

 ! PopProbs(I,0,J) contains the fraction of all persons of type I who are in age group J,

 ! although these fractions are not necessary for the selection of random profiles.

 ! NumPoptypes was determined in ReadParameters, by counting the population input files.

 ! NumSectors was determined in SelectSites, by reading the sector list from unit SectU.

 ! Also, the list of acceptable sectors is available as SList(:)%Name.

 ! NumAges is not known at the start of the ReadPopulation subroutine.

 ! However, Casson has agreed to create a separate file that contains the list of Agegroups

 ! with their minimum and maximum ages. This information will likely be repeated on each of

 ! the gender-race files for the user's convenience, but APEX will read it from the special 

 ! file prior to the DO loop over poptypes.

 NumAges = 0 ! Initialize agegroup counter

 OPEN(PopU,File=FName(PopU),IOSTAT=Ios(PopU),ACTION='READ') ! Open

population ages file

 DO ! Loop over input lines

A-79
 CALL GetLine(PopU,String,LType) ! Get one line from input file

 IF (Ios(PopU)/=0) EXIT ! Exit if no more lines

 Key = Up(String) ! Extract 3-character keyword

 WRITE(LogU,*) 'Agegroups ', Key, String ! Message for debugging

 IF (Key=="MIN".OR.Key=="MAX") THEN ! If agegroup keyword

 I = SCAN(String,"012345689") ! Find first numeric column

 IF (I==0) CALL Fatal(1) ! Error if no numbers found

 String=String(I:) ! Cut off non-numeric prefix

 DO I=1,MAXAGEGRPS ! Loop over agegroups

 READ(String,*,IOSTAT=Ios(PopU)) Skip(1:I-1),Age ! Jump over ones already

read 

 IF (Ios(PopU)/=0) EXIT ! Exit when whole line is skipped

 IF (Key=="MIN") MinAges(I)=Age ! Set minimum age for group I

 IF (Key=="MAX") MaxAges(I)=Age ! Set maximum age for group I

 ENDDO ! Continue with next agegroup

 IF (Key=="MIN") NumAges = I-1 ! NumAges is # of agegroups

 ENDIF ! End of agegroup processing

 IF (Key=="EMP") THEN ! If employment probab. keyword

 String = ADJUSTL(String(INDEX(String,"=")+1:)) ! Find part to right of '='

 READ(String,*,IOSTAT=Ios(PopU)) EmpProb(1:NumAges) ! Read employment

probabilities

 ENDIF ! End of employment logic

 ENDDO ! Continue with next input line

 CLOSE(PopU) ! Close input file

 IF (NumAges==0) CALL Fatal(2) ! If no agegroups, then problem

 IF (MaxAges(NumAges)>99) THEN ! If top age >99, then

 CALL Warning(1) ! Inform user of situation

 MaxAges(NumAges) = 99 ! Lower top age to 99

 ENDIF ! End of top age logic

 IF (ANY(EmpProb(1:NumAges)<0.)) CALL Fatal(3) ! Each probability must be

>=0

 IF (ANY(EmpProb(1:NumAges)>1.)) CALL Fatal(4) ! Each probability must be

<=1

 GroupYrs = 0 ! Initialize # years in groups

 GroupYrs(1:NumAges) = MaxAges(1:NumAges)-MinAges(1:NumAges)+1 ! Calculate #

years per group

 IF (ANY(GroupYrs(1:NumAges)<1)) CALL Fatal(5) ! Stop if any groups are

empty

 WRITE(LogU,*) 'GroupYrs ', GroupYrs ! Inform user of agegroup sizes

 WRITE(LogU,*) 'NumGrps ', NumAges ! # of age groupings

 WRITE(LogU,*) 'Max Age ', MaxAges(NumAges) ! Maximum allowed age in

APEX

 IF (SUM(GroupYrs(1:NumAges))>MaxAges(NumAges)+1) CALL Fatal(6) ! Stop if

agegroups overlap

 ALLOCATE (PopProbs(NumPopTypes,0:NumSectors,0:NumAges)) ! Declare list of

probabilities

 ALLOCATE (PopCounts(NumPopTypes,0:NumSectors,0:NumAges)) ! Declare list of

populations 

A-80
 PopCounts = 0 ! Initialize populations to zero

 PopProbs = 0. ! Initialize probabilities to zero

 DO I=1,NumPopTypes ! Loop over gender-race combs.

 LCount = 0 ! Initialize line counter

 SCount = 1 ! Initialize sector counter

 WRITE(LogU,*) I,'Opening ',PopCat(I)%FName ! Status message for log file

 OPEN(PopU,File=PopCat(I)%FName,IOSTAT=Ios(PopU),ACTION='READ') ! Open one

population input file

 DO ! Loop over input records

 CALL GetLine(PopU,String,LType) ! Get one line from input file

 IF (Ios(PopU)<0) EXIT ! Exit DO loop when file ends

 IF (LType>=0) CYCLE ! Ignore if line is non-numeric

 LCount = LCount+1 ! Increment numeric line counter 

 IF (LCount < SList(SCount)%Index) CYCLE ! Drop data for unwanted sectors

 READ(String,*,IOSTAT=Ios(PopU)) Name ! Read sector ID

 IF (Name /= SList(SCount)%Name) CALL Fatal(7) ! Problem if name does not

match

 READ(String,*,IOSTAT=Ios(PopU)) Name,PopCounts(I,SCount,1:) ! Get ID and counts

from input

 IF (Ios(PopU)/=0) CALL Fatal(8) ! If not enough numbers on line

 IF (ANY(PopCounts(I,SCount,1:)<0)) CALL Fatal(9) ! Stop if negative population 

 PopCounts(I,SCount,0) = SUM(PopCounts(I,SCount,1:)) ! Calculate sums over ages

 SCount = SCount+1 ! Increment sector counter

 IF (SCount>NumSectors) EXIT ! When last sector complete, exit

 ENDDO ! Otherwise continue reading lines

 CLOSE(PopU) ! Close current pop input file

 DO J=0,NumAges ! For each agegroup

 PopCounts(I,0,J) = SUM(PopCounts(I,1:,J)) ! Calculate total across sectors

 ENDDO ! Continue with next age group

 ENDDO ! Continue with next pop type

 TotPop = SUM(PopCounts(:,0,0)) ! Population universe

 WRITE(LogU,*) "Area population=",TotPop ! Write pop total to log file

 RPop = REAL(MAX(TotPop,1)) ! Ensure denominator >=1 

 PopProbs(:,0,0) = REAL(PopCounts(:,0,0))/RPop ! Convert type-totals to

fractions

 DO I=2,NumPopTypes ! Loop over type-totals vector

 PopProbs(I,0,0) = PopProbs(I-1,0,0)+PopProbs(I,0,0) ! Convert to cumulative probab.

 ENDDO ! Do next element in pop vector

 DO I=1,NumPopTypes ! Loop over population types

 RPop = REAL(MAX(PopCounts(I,0,0),1)) ! Ensure denominator >=1 

 PopProbs(I,1:,0) = REAL(PopCounts(I,1:,0))/RPop ! Normalize sector totals by

type

 DO J=2,NumSectors ! Loop over sectors

 PopProbs(I,J,0) = PopProbs(I,J-1,0)+PopProbs(I,J,0) ! Convert to cumulative probabs

 ENDDO ! Continue with next sector

 WRITE(LogU,*) 'PopProbs=',I,' 0',PopProbs(I,0,:) ! Write age totals for this type

 DO J=1,NumSectors ! Loop over sectors

 RPop = REAL(MAX(PopCounts(I,J,0),1)) ! Ensure denominator >=1 

A-81
 PopProbs(I,J,1:) = REAL(PopCounts(I,J,1:))/RPop ! Normalize age totals by type

 DO K=2,NumAges ! Loop over agegroups

 PopProbs(I,J,K) = PopProbs(I,J,K)+PopProbs(I,J,K-1) ! Convert to cumulative

probabs

 ENDDO ! Continue with next agegroup

 WRITE(LogU,*) 'PopProbs=',I,J,PopProbs(I,J,:) ! Write sector*age cumul probabs

 ENDDO ! Continue with next sector

 ENDDO ! Continue with next pop type

 PRINT*,'Finished ReadPopulation' ! Status message for screen

 IF (CommuteFlag==YES) CALL ReadCommute ! Read commuting data if

needed

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE ReadPopulation ! Return to main APEX program

A-82
SUBROUTINE ReadCommute ! Called from ReadPopulation

 INTEGER (KIND=IK),PARAMETER :: MEANDESTS=1000 ! Max # of dests

per home sector

 INTEGER (KIND=IK) :: I, Keep=0, DNum=0 ! Local integer variables 

 REAL (KIND=RK) :: Frac ! Local real variable

 CHARACTER (LEN=SECTORLEN) :: ID ! Local variable for sector

name

 INTEGER (KIND=IK),ALLOCATABLE :: WBuf(:) ! Temporary buffer for

Work IDs

 REAL (KIND=RK),ALLOCATABLE :: PBuf(:) ! Temporary buffer for

probabs

 ! Globals needed : CommU, Fname, IK, NumSectors, PopU, RK, SECTORLEN

 ! Globals altered: Ios

 ! Intrinsic procs: ALLOCATE, CLOSE, DEALLOCATE, OPEN, PRINT, READ

 ! External procs : <None>

 PRINT*, 'Starting ReadCommute' ! Status message for screen

 ALLOCATE (CommHome(NumSectors)) ! Space for home indexing

vector

 ALLOCATE (PBuf(NumSectors*MEANDESTS)) ! Space for temporary

buffers 

 ALLOCATE (WBuf(NumSectors*MEANDESTS)) ! Space for temporary

buffers

 CommHome = 0 ! Initialize all values to zero

 PBuf = 0 ! Initialize all values to zero

 WBuf = 0 ! Initialize all values to zero

 OPEN (CommU,FILE=FName(CommU),IOSTAT=Ios(PopU),ACTION='READ') ! Open

commuting file

 DO ! Loop over input records

 READ(CommU,*,IOSTAT=Ios(CommU)), ID, Frac ! Read one line from input

file

 IF (Ios(CommU)/=0) EXIT ! Exit DO loop on end of file 

 IF (Keep==1) THEN ! If already in a KEEP block...

 DO I=NumSectors,1,-1 ! Loop backward down sectors list

 IF (SList(I)%Name(1:SECTORLEN)==ID) EXIT ! Exit loop if sector ID found

 ENDDO ! Try next sector in study area

 DNum = DNum+1 ! Increment destination counter

 PBuf(DNum) = Frac ! Probability of this destination

 WBuf(DNum) = I ! Destination sector number

 IF (Frac>=1.0) Keep=0 ! Frac=1 means last dest in block

 ELSEIF (Frac>=0.0) THEN ! Dests for sectors outside study

 CYCLE ! Skip over them

 ELSE ! Else the start of a new block

 DO I=1,NumSectors ! Loop over sectors in study area

 IF (Slist(I)%Name(1:SECTORLEN)==ID) THEN ! If sector name is found ...

 CommHome(I) = DNum+1 ! Set the sector indexing vector

 Keep = 1 ! Keep this block of destinations

 EXIT ! Stop searching home sector list

 ENDIF ! End of matching ID logic

A-83
 ENDDO ! Continue with next home sector

 ENDIF ! End of input processing logic

 ENDDO ! Continue with next input record

 CLOSE(CommU) ! Close the commuting data file

 DO I=1,NumSectors-1 ! Loop over home sectors

 IF (CommHome(I)==CommHome(I+1)) CommHome(I)=0 ! If sector has no dests,

re-index

 ENDDO ! Continue with next home sector

 IF (CommHome(NumSectors)>DNum) CommHome(NumSectors)=0 ! This means last

sector was empty

 ALLOCATE (CommProb(DNum)) ! Set proper size for Probab vector

 ALLOCATE (CommWork(DNum)) ! Set proper size for WorkID

vector 

 CommProb = PBuf(1:DNum) ! Copy probability data 

 CommWork = WBuf(1:DNum) ! Copy work destination list

 DEALLOCATE (WBuf, PBuf) ! Erase temporary vectors

 PRINT*, 'Finished ReadCommute' ! Status message for screen 

END SUBROUTINE ReadCommute ! Return to ReadPopulation

A-84
SUBROUTINE GenerateProfiles ! Called from main APEX program

 INTEGER (KIND=IK), POINTER :: I1(:), I2(:), I3(:) ! Pointers used in distrib calls 

 REAL (KIND=RK), ALLOCATABLE :: R(:) ! Local array for probabilities

 INTEGER (KIND=IK) :: I, J, K, L, P, W, Extra, Age ! Local integer variables

 INTEGER (KIND=IK) :: Emp, WorkSec, CommOut=0, AgeOut=0 ! More local integer

variables

 CHARACTER(LEN=LEN2) :: DistName ! Buffer for distribution name

 ! Globals needed: IK, KSeed, LogU, NumDistricts, NumPools, 

 ! NumPops, NumProfiles, PopVector, RK 

 ! Globals altered: ISeed, ModuleName, Person, ProcName

 ! Intrinsic procs: ALLOCATE, DEALLOCATE, INT, PRINT, RANDOM_SEED,

RANDOM_NUMBER, WRITE

 ! External procs: Distrib

 ModuleName = "ProfileModule" ! Module name for messages

 ProcName(1) = "GenerateProfiles" ! Procedure name for messages

 WRITE(LogU,*) 'Starting GenerateProfiles' ! Put status message on Log

 ALLOCATE (EventSeq(NumDays*EVENTSDAY)) ! Space for composite

events 

 ALLOCATE (HourSeq(NumHours)) ! Space for composite hours

 ALLOCATE (Person(NumProfiles)) ! Space for profile data

 ALLOCATE (PersonDay(NumDays)) ! Space for daily varying data

 ALLOCATE (R(6)) ! Space for local random numbers

 CALL RANDOM_SEED(Put=ISeed(1:KSeed)) ! Set random number seed

 WRITE(LogU,*) '#poptypes ', NumPopTypes ! Write list of population types

 DO I=1,NumPopTypes ! Loop over types

 WRITE(LogU,*) PopCat(I)%Gender, ' ',PopCat(I)%Race ! Write gender and race

 ENDDO ! Continue with next type

 P = 0 ! Initialize profile counter

 DO ! Loop over all profiles

 CALL RANDOM_NUMBER(R) ! Get uniform randoms

 DO J=1,NumPopTypes-1 ! Loop over population types

 IF (R(1)<=PopProbs(J,0,0)) EXIT ! Select type using pop. weights

 ENDDO ! Try next element in pop vector

 IF (NumPopTypes==1) J=1 ! Value in case DO loop is empty

 DO K=1,NumSectors-1 ! Loop over home sectors

 IF (R(2)<=PopProbs(J,K,0)) EXIT ! Select sector using pop. weights

 ENDDO ! Try next sector

 IF (NumSectors==1) K=1 ! Value in case DO loop is empty

 DO L=1,NumAges-1 ! Loop over age groups

 IF (R(3)<=PopProbs(J,K,L)) EXIT ! Select age group using weights

 ENDDO ! Try next age group

 IF (NumAges==1) L=1 ! Value in case DO loop is empty

 Extra = INT(R(4)*REAL(GroupYrs(L))) ! Years above group minimum

 Age = MinAges(L)+MIN(Extra,GroupYrs(L)-1) ! Generate age in years

 IF (Age<AgeMin.OR.Age>AgeMax) THEN

 AgeOut = AgeOut+1

 CYCLE

 ENDIF

A-85
 Emp = NO ! Default is not employed

 IF (R(5)<=EmpProb(L)) Emp = YES ! Generate employment status

 WorkSec = K ! Default work sector = home 

 IF (CommuteFlag==YES.AND.Emp==YES) THEN ! If a commuter ...

 W = CommHome(K) ! Start of data for home sector K

 IF (W==0) THEN ! If no data for home sector K

 WorkSec = K ! Then profile does not commute

 ELSE ! Or else commuting data exists

 DO ! Loop over possible destinations

 IF (R(6)<=CommProb(W)) EXIT ! Pick destination at random

 W = W+1 ! Move pointer to next destination

 ENDDO ! Continue loop until exit occurs

 WorkSec = CommWork(W) ! Number of selected work sector

 IF (WorkSec==0) THEN ! If work sector not in study area

 CommOut = CommOut+1 ! Increment rejection counter

 CYCLE ! Start another profile 

 ENDIF ! End of work outside area logic

 ENDIF ! End of commuting data processing

 ENDIF ! End of commuting logic 

 P = P+1 ! Increment profile counter

 Person(P)%Index = P ! Set the profile index

 Person(P)%Gender = INDEX("MF",PopCat(J)%Gender(1:1)) ! Set the profile gender

 Person(P)%Race = INDEX("WBANO",PopCat(J)%Race(1:1)) ! Set the profile race

 Person(P)%HomeSec = K ! Set the profile home sector

 Person(P)%HomeD = SList(K)%NumD ! Air district for sector K

 Person(P)%Employed= Emp ! Set profile employment status

 Person(P)%WorkSec = WorkSec ! Set profile work sector

 Person(P)%WorkD = SList(WorkSec)%NumD ! Set profile work district 

 Person(P)%Age = Age ! Set the profile age

 Person(P)%Zone = SList(K)%NumZ ! Set the profile temp zone

 IF (P==NumProfiles) EXIT ! Exit if enough profiles done

 ENDDO ! Continue with next profile

 WRITE(LogU,*) '# of generated ages outside range = ',AgeOut ! # ages outside allowed

range

 WRITE(LogU,*) '# commuting out of study area = ', CommOut ! # commuting outside

study area

 WRITE(LogU,*) 'Base profiles ready' ! Write base profile summary

 DistName = "HASGASSTOVE" ! Buffer for distribution name

 CALL Distrib(Name=DistName,IRes=Person%GasStove) ! Get gas stove status for

all

 I1 => Person%GasStove ! Pointer to gas stove status

 DistName = "HASPILOT" ! Buffer for distribution name

 CALL Distrib(Name=DistName,I1=I1,IRes=Person%GasPilot) ! Get pilot light status

for all

 DistName = "AC_HOME" ! Buffer for distribution name

 CALL Distrib(Name=DistName,IRes=Person%AC_Home) ! Get air conditioning

for all

 DistName = "AC_CAR" ! Buffer for distribution name

A-86
 CALL Distrib(Name=DistName,IRes=Person%AC_Car) ! Get car AC status for all 

 I1 => Person%Age ! Set pointer to profile age

 I2 => Person%Gender ! Set pointer to profile gender

 I3 => Person%Employed ! Set pointer to employment status

 DistName = "IDGRP" ! Set distribution name

 CALL Distrib(Name=DistName,I1=I1,I2=I2,I3=I3,IRes=Person%DGRP) ! Get cohort

number for all

 CALL RANDOM_SEED(Get=ISeed(1:KSeed)) ! Save current random seed

 DEALLOCATE (R) ! Free space for random # vector

 PRINT*, 'Finished GenerateProfiles' ! Put status message on screen

 WRITE(LogU,*) 'Finished GenerateProfiles' ! Put status message on Log file

 IF (NumProfiles<=10) THEN ! If there are few profiles...

 WRITE(LogU,*) 'Gender ', Person%Gender ! List genders on log file

 WRITE(LogU,*) 'Ages ', Person%Age ! List ages on log file

 WRITE(LogU,*) 'Race ', Person%Race ! List races on log file

 WRITE(logU,*) 'HSect ', Person%HomeSec ! List home sectors on log file

 WRITE(logU,*) 'WSect ', Person%WorkSec ! List work sectors on log file

 WRITE(LogU,*) 'HDist ', Person%HomeD ! List home districts on log file

 WRITE(LogU,*) 'WorkD ', Person%WorkD ! List work districts on log file

 WRITE(LogU,*) 'Zone ', Person%Zone ! List temperature zones on log

 WRITE(logU,*) 'Emp ', Person%Employed ! List employment status on log

 WRITE(LogU,*) 'Stove ', Person%GasStove ! List gas stove status on log

 WRITE(LogU,*) 'Pilot ', Person%GasPilot ! List pilot light status on log

 WRITE(LogU,*) 'ACHome ', Person%AC_Home ! List home AC status on

log

 WRITE(LogU,*) 'ACCar ', Person%AC_Car ! List car AC status on log

 WRITE(LogU,*) 'IDGRP ', Person%DGRP ! List pNEM group #s on log

 ENDIF ! End of profile listing logic

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE GenerateProfiles ! Return to main APEX program

A-87
SUBROUTINE GeneratePhysiology ! Called from main APEX program

 INTEGER (KIND=IK) :: Age, Gender, I, J, P ! Local integer variables

 REAL (KIND=RK) :: Z(6),RSE,Rand(2),NVO2MX,VO2MX,BM,RMR ! Local real

variables

 REAL (KIND=IK) :: HEIGHT,WEIGHT,WF ! More local real variables

 REAL (KIND=RK) :: NVO2MN(0:100,2),NVO2SD(0:100,2) ! Arrays of mean and

std of VO2

 REAL (KIND=RK) :: BMMN(0:100,2), BMSD(0:100,2) ! Arrays of mean and std

body mass

 REAL (KIND=RK) :: RMRS(0:100,2),RMRI(0:100,2),RMRE(0:100,2) ! Regression slope,

interc., error

 REAL (KIND=RK) :: BLDF(0:100,2),HGMN(0:100,2),HGSD(0:100,2) ! Blood parameter

arrays

 CHARACTER(LEN=25) :: FMT1 = "(//,202(/23X, F7.1,F7.1))" ! Format for reading

VO2 data

 CHARACTER(LEN=25) :: FMT2 = "(//,202(/21X, F9.1,F8.3))" ! Format for body mass

data

 CHARACTER(LEN=25) :: FMT3 = "(//,202(/29X,2F9.3,F7.3))" ! Format for regression

data

 CHARACTER(LEN=25) :: FMT4 = "(//,202(/ 6X,2F9.1,F8.1))" ! Format for blood

parameters

 ! Globals needed: FName, IK, KSeed, MALE, NumProfiles, Person, PhysU, RK

 ! Globals altered: Ios, IsdPrs, ModuleName, Phys, ProcName

 ! Intrinsic procs: ALLOCATE, CLOSE, INT, LOG, OPEN, RANDOM_NUMBER,

RANDOM_SEED, READ, REAL 

 ! External procs: RnNor

 ModuleName = "ProfileModule" ! Module name for messages

 ProcName(1) = "GeneratePhysiology" ! Procedure name for messages

 OPEN(PhysU,FILE=FName(PhysU),IOSTAT=Ios(PhysU),ACTION='READ') ! Open

physiology input data file

 IF (Ios(PhysU)/=0) STOP 'Cannot open physiology file' ! Stop if file not available

 READ(PhysU,FMT1) ((NVO2MN(I,J),NVO2SD(I,J),I=0,100),J=1,2) ! Read VO2 mean

and std. dev.

 READ(PhysU,FMT2) (( BMMN(I,J), BMSD(I,J),I=0,100),J=1,2) ! Read body mass

mean and std. dev

 READ(PhysU,FMT3) ((RMRS(I,J),RMRI(I,J),RMRE(I,J),I=0,100),J=1,2) ! Read regression

parameters

 READ(PhysU,FMT4) ((BLDF(I,J),HGMN(I,J),HGSD(I,J),I=0,100),J=1,2) ! Read blood

parameters

 CLOSE(PhysU) ! Close physiology input file

 ALLOCATE (Phys(NumProfiles)) ! Dynamic array for phys. data

 CALL RANDOM_SEED(Put=ISdPrs(1:KSeed)) ! Initialize physiology seed

 DO P=1, NumProfiles ! Loop over profiles

 CALL RnNor(6,Z,-4.,4.) ! Pick six normal numbers

 CALL RANDOM_NUMBER(Rand) ! Pick two uniform numbers

 Age = Person(P)%Age ! Set local age variable 

 Gender = Person(P)%Gender ! Set local gender variable

A-88
 NVO2MX = NVO2MN(Age,Gender) + NVO2SD(Age,Gender)*Z(1) ! Generate

normal NVO2MX

 BM = BMMN(Age,Gender) * BMSD(Age,Gender)**Z(2) ! Generate normal body

mass (kg)

 Phys(P)%BM = BM ! Set global body mass parameter

 Phys(P)%Weight = 2.2046 * BM ! Set global body weight (pounds)

 VO2MX = NVO2MX * BM * 0.001 ! Set VO2MX (ml/min ?)

 RSE = RMRE(Age,Gender) * Z(3) ! Set regression standard error

 RMR = RMRS(Age,Gender)*BM+RMRI(Age,Gender)+RSE ! RMR = Resting

metabolic rate 

 Phys(P)%RMR = 0.166 * RMR ! Convert units to ?

 Phys(P)%ECF = 0.2 + (0.21 - 0.2 ) * Rand(1) ! ECF = Energy conversion factor

 Phys(P)%METmax = VO2MX / (Phys(P)%ECF*Phys(P)%RMR) ! Maximum

allowed MET value

 WEIGHT = Phys(P)%Weight ! Local variable for weight 

 WF = BLDF(Age,Gender) ! Local variable for blood factor

 IF(Gender==MALE)THEN ! Physiology for males

 HEIGHT = 34.43 + 6.67*LOG(WEIGHT) + 2.38*Z(4) ! Height is a function of

weight

 Phys(P)%Blood = WEIGHT*WF + .00683*HEIGHT**3 - 30. ! Blood volume is

f(height,weight)

 Phys(P)%Diff = .361*HEIGHT - .232*REAL(Age) + 16.3 ! Pulmonary diffusion rate

 Phys(P)%HemFac = .000161 ! Hemoglobin altitude factor

 Phys(P)%Endgn1 = (.473 * 1.316**Z(5))/60. ! Endogenous CO production rate

1

 Phys(P)%Endgn2 = Phys(P)%Endgn1 ! Rate 2 = rate 1 for males

 ELSE ! Else physiology for females

 HEIGHT = 48.07 + 3.07*LOG(WEIGHT) + 2.48*Z(4) ! Height is a function of

weight

 Phys(P)%Blood = WEIGHT*WF + .00678*HEIGHT**3 - 30. ! Blood volume is

f(height,weight)

 Phys(P)%Diff = .556*HEIGHT - .115*REAL(Age) - 5.97 ! Pulmonary diffusion rate

 Phys(P)%HemFac = .0001153 ! Hemoglobin altitude factor 

 Phys(P)%Endgn1 = (.497 * 1.459**Z(5))/60. ! Endogenous CO production rate

1

 Phys(P)%Endgn2 = (.311 * 1.459**Z(5))/60. ! Rate 2 follows menstrual cycle

 IF(Age>=12.AND.Age<=50) Phys(P)%Start = 1+INT(28.*Rand(2)) ! Phase for menstrual

cycle

 ENDIF ! End of physiology for females

 Phys(P)%Hmglb = HGMN(Age,Gender) + Z(6)*HGSD(Age,Gender) ! Set hemoglobin 

 Phys(P)%Height = HEIGHT ! Set global variable for height

 Phys(P)%HemFac = 0. ! Set to zero until error is fixed

 ENDDO ! Continue with next profile

 CALL RANDOM_SEED(Get=ISdPrs(1:KSeed)) ! Store the physiology

random seed

 PRINT*, "Finished generating physiology" ! Status message for screen

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

A-89
END SUBROUTINE GeneratePhysiology ! Return to main APEX

program

A-90
SUBROUTINE GenerateDailyVars(P) ! Called from main APEX

program

 INTEGER (KIND=IK), INTENT(IN) :: P ! Input variable (person number)

 INTEGER (KIND=IK), POINTER :: I1(:), I2(:) ! Pointers for use with Distrib

 INTEGER (KIND=IK),TARGET,ALLOCATABLE :: Buff(:) ! Buffer to hold

copies of ACHome

 CHARACTER(LEN=LEN2) :: DistName ! Buffer for distribution name

 ! Globals needed : IK, LEN2, Person, TemData

 ! Globals altered : PersonDay

 ! Intrinsic procs : ALLOCATE, ALLOCATED, WRITE

 ! External procs : Distrib

 IF (.NOT.ALLOCATED(Buff)) ALLOCATE(Buff(NumDays)) ! Make space for

buffer

 Buff = Person(P)%AC_Home ! One copy of ACHome per day

 I1 => Buff ! Point to daily AC_Home data

 I2 => TemData(:,SList(Person(P)%HomeSec)%NumZ)%MaxTemp ! Point to daily

Temperature data

 DistName = "WINDOWPOS" ! Set WINDOWPOS distribution

name

 CALL Distrib(Name=DistName,I1=I1,I2=I2, &

 IRes=PersonDay(1:NumDays)%WindowPos) ! Determine daily window

positions

 DistName = "SPEEDCAT" ! Set SPEEDCAT distribution name

 CALL Distrib(Name=DistName,IRes=PersonDay(1:NumDays)%SpeedCat) ! Determine

daily speed categories

 WRITE(LogU,*) 'Finished GenerateDailyVars for #',P ! Put message on log file

 ! WRITE(LogU,*) PersonDay%WindowPos ! Write window positions on

log

 ! WRITE(LogU,*) PersonDay%SpeedCat ! Write speed categories on log

END SUBROUTINE GenerateDailyVars ! Return to main APEX program

END MODULE ProfileModule ! End of ProfileModule source code

A-91
MODULE MicroEnvModule ! Compile after the modules below

 USE GlobalModule ! Compile this module first

 USE UtilityModule ! Compile this module second

 USE DistributionModule ! Compile this module third

 USE ProfileModule ! Compile this module fourth

 IMPLICIT NONE ! Must declare all variables

 TYPE :: MicroEnv ! Stores summary info for micros

 INTEGER (KIND=IK) :: Index ! Position in the MIC vector

 CHARACTER(LEN=LEN2) :: Name ! Name of micro (one word)

 CHARACTER(LEN=LEN3) :: Description ! Description of micro

 INTEGER (KIND=IK) :: Method ! FACTORS (=1) or MASSBAL

(=2)

 INTEGER (KIND=IK) :: PRX ! MP index for proximity

 INTEGER (KIND=IK) :: PEN ! MP index for penetration

 INTEGER (KIND=IK) :: AER ! MP index for air exchange rate 

 INTEGER (KIND=IK) :: DEC ! MP index for decay & deposition

 INTEGER (KIND=IK) :: VOL ! MP index for volume

 INTEGER (KIND=IK) :: MR ! MP index for mean removal rate

 INTEGER (KIND=IK) :: NES ! # of emission sources 

 INTEGER (KIND=IK) :: NCS ! # of concentration sources

 END TYPE MicroEnv ! Used to declare the MIC vector

 TYPE :: MicroParam ! Stores properties of MP

 INTEGER (KIND=IK) :: Mic ! Micro # to which MP belongs

 INTEGER (KIND=IK) :: Par ! Paramter type for this MP

 INTEGER (KIND=IK) :: HB(24) ! Hour - block mapping

 INTEGER (KIND=IK) :: WT(7) ! Day of week - daytype mapping

 INTEGER (KIND=IK) :: MS(12) ! Month - season mapping

 INTEGER (KIND=IK) :: C(3) ! Conditional variable #s 

 INTEGER (KIND=IK) :: N(7) ! # of levels for each index

 INTEGER (KIND=IK) :: ResampHours ! Resample hours (YES or NO) 

 INTEGER (KIND=IK) :: ResampDays ! Resample days (YES or NO)

 INTEGER (KIND=IK) :: ResampWork ! Resample workplace (YES or

NO)

 INTEGER (KIND=IK) :: NShift ! # of possible dayshift values

 INTEGER (KIND=IK) :: NDistrib ! # distributions for this MP

 INTEGER (KIND=IK) :: ZDist ! Offset for this MP in MPDistrib

 INTEGER (KIND=IK) :: Seed(MAXK) ! Random number seed for this

MP

 INTEGER (KIND=IK) :: HBR(24) ! Hourly block repetition numbers

 INTEGER (KIND=IK) :: HBN(24) ! Block sizes (# of hours)

 END TYPE MicroParam ! Used to declare MP vector

 INTEGER (KIND=IK), PARAMETER :: FACTORS=1, MASSBAL=2 ! Codes for

calculation types

 INTEGER (KIND=IK), PARAMETER :: PR=1,PE=2,AE=3,DE=4,VO=5 ! Codes for

parameter types

A-92
 INTEGER (KIND=IK), PARAMETER :: MR=6,ES=7,CS=8 ! More codes for

paramter types

 INTEGER (KIND=IK), ALLOCATABLE :: DA(:,:) ! District-Area map

(MP,district)

 INTEGER (KIND=IK), ALLOCATABLE :: TS(:,:) ! Daytype-Season(MP,day)

 INTEGER (KIND=IK), ALLOCATABLE :: DayShift(:) ! CV indexing shift array

(day)

 INTEGER (KIND=IK), ALLOCATABLE :: NDist(:,:) ! Distribution # (hour,day) 

 INTEGER (KIND=IK), ALLOCATABLE :: NSamp(:,:) ! Sample # (hour,day)

 INTEGER (KIND=IK), ALLOCATABLE :: DCN(:) ! DayCounts (distrib #)

 TYPE (MicroEnv), ALLOCATABLE :: Mic(:) ! Micro properties (micro #)

 TYPE (MicroParam), ALLOCATABLE :: MPar(:) ! MP descriptions (MP #)

 TYPE (CDist),TARGET,ALLOCATABLE :: MPDistr(:) ! Array of MP Distribs

(index #) 

 REAL (KIND=RK), ALLOCATABLE :: ESum(:,:,:) ! Emission sums

(hour,micro,place)

 REAL (KIND=RK), ALLOCATABLE :: CSum(:,:,:) ! Conc source sums (",",")

 REAL (KIND=RK), ALLOCATABLE :: MPV(:,:,:) ! MP values

(hour,MP,place)

 REAL (KIND=RK), ALLOCATABLE :: PP(:,:) ! Prox * Penetration

(hour,place)

 REAL (KIND=RK), ALLOCATABLE :: R(:) ! Removal rate (hour)

 REAL (KIND=RK), ALLOCATABLE :: S(:) ! Source strength (hour)

 REAL (KIND=RK), ALLOCATABLE :: Buff(:,:) ! Distribution results

(dist,hour) 

CONTAINS ! Routines internal to this module

A-93
SUBROUTINE ReadMicroData ! Called from main APEX program

 Type(CDist),POINTER :: Ptr ! Pointer to a micro distribution

 INTEGER (KIND=IK) :: Mode=0, Num, Val, NMP=0, B, D, LType, M ! Local integer

variables 

 INTEGER (KIND=IK) :: ZDist=0, NDist=0, I, J(7), N(7), H, W ! More local integer

variables

 INTEGER (KIND=IK) :: MaxDist=0, MaxDC=0 ! Counters for aray sizing

 CHARACTER (LEN=LEN3) :: String, UpString, SubS ! Buffers for input records

 CHARACTER (LEN=LEN1) :: Word1,Word2 ! Buffers for short words

 CHARACTER (LEN=1) :: Char1 ! Buffer for a single character

 REAL (KIND=RK) :: P0, P(4) ! Local real variables

 ModuleName = "MicroEnvModule" ! Module name for messages

 ProcName(1) = "ReadMicroData" ! Procedure name for messages

 CALL SetCVList ! Code is in ProfileModule

 OPEN (MicroU,File=FName(MicroU),IOSTAT=Ios(MicroU),ACTION='READ') ! Open

micro description file

 NumMP = 0 ! Initialize MP counter

 NumMPDistrib = 0 ! Initialize distrib counter

 DO ! Loop over input records

 CALL GetLine(MicroU, String, LType) ! Get one record from input file

 IF (Ios(MicroU)/=0) EXIT ! Exit loop on end-of-file

 UpString=Up(String) ! Make uppercase version of line

 IF (UpString(1:3)=="PAR") THEN ! Each MP must have a keyword

PAR

 NumMP = NumMP+1 ! Increment MP counter

 NDist = 0 ! Start distrib counter for MP

 ENDIF ! End of new MP logic block

 IF (NumMP>0.AND.INDEX("1234567890",UpString(1:1))>0) THEN ! If MP and line is

numeric...

 NDist = NDist + 1 ! Then it must be a distribution

 NumMPDistrib = NumMPDistrib + 1 ! Increment both counters

 IF (MaxDist<NDist) MaxDist = NDist ! Reset maximum if necessary

 ENDIF ! End of distribution counting

 ENDDO ! Continue with next record 

 REWIND(MicroU) ! Go back to start of input file

 CALL SetupMicArrays(MaxDist) ! Code is here in MicroEnvModule

 NDist = 0 ! Initialize distribution counter

 NMP = 0 ! Initialize MP counter

 DO ! Loop over input records

 CALL GetLine(MicroU, String, LType) ! Get one line from input file

 IF (Ios(MicroU)/=0) EXIT ! Exit loop on end-of-file

 UpString = Up(String) ! Make uppercase version of line 

 IF (UpString(1:12)=="MICRO NUMBER") NMP = NMP + 1 ! Each MP starts with

this key

 IF (NMP==0.AND.INDEX("1234567890",UpString(1:1))>0) THEN ! This case is for

micro data

 READ(UpString,*) Num, Word1, Word2 ! Get micro number, name,

method

A-94
 IF (Num<1 .OR.Num>127) CALL Fatal(1) ! Allowed range of micro #

(1-127)

 IF (Num>NumMicros) CALL Fatal(2) ! Micro # limited by PARAMS file

 IF (Mic(Num)%Index>0) CALL Warning(1) ! Micro should not be listed

twice

 I=MAX(INDEX(UpString,"MASSBAL"),INDEX(UpString,"FACTORS")) ! Find

keyword for method

 IF (I==0) CALL Fatal(3) ! Stop run if method not found

 Mic(Num)%Index = Num ! Set micro index

 Mic(Num)%Name = Word1 ! Set micro name

 IF (Word2(1:1)=="M") Mic(Num)%Method = MASSBAL ! Set method to

MASSBAL

 IF (Word2(1:1)=="F") Mic(Num)%Method = FACTORS ! Set method to

FACTORS

 Mic(Num)%Description = ADJUSTL(UpString(I+7:)) ! Beyond method is

description

 ELSE IF (NMP==0) THEN ! This is non-data, non-MP line 

 CYCLE ! Skip this input record

 ELSE ! Must be in MP data section

 SubS = ADJUSTL(UpString(INDEX(UpString,"=")+1:)) ! Data for keyword lines

 WRITE(LogU,*) 'UpString=',UpString ! Echo line for debugging

 WRITE(LogU,*) 'SubS =',SubS ! Echo data portion for debugging

 SELECT CASE(UpString(1:5)) ! Identify keyword using 5 chars

 CASE("MICRO") ! Keyword for micro number 

 READ(SubS,*) Val ! Extract micro # from input line

 IF (Val<1.OR.Val>127) CALL Fatal(1) ! Stop if micro # out of range

 IF (Mic(Val)%Index/=Val) CALL Fatal(4) ! Stop if micro not in first part

 MPar(NMP)%Mic = Val ! Set micro # for this MP

 ZDist = ZDist + NDist ! Update ZDist by last MP count

 MPar(NMP)%ZDist = ZDist ! Set Zdist for this MP

 NDist = 0 ! Reset distrib counter for MP

 CASE("PARAM") ! Keyword for parameter type

 Val = (INDEX("PRPEAEDEVOMRESCS",SubS(1:2))+1)/2 ! Find parameter type

in this list

 IF (SubS(1:2)=="AI") Val=3 ! Alternate form for 'AE'

 IF (SubS(1:2)=="ME") Val=6 ! Alternate form for 'MR'

 IF (SubS(1:2)=="EM") Val=7 ! Alternate form for 'ES'

 IF (SubS(1:2)=="CO") Val=8 ! Alternate form for 'CS'

 IF(Val==0) CALL Fatal(5) ! Unknown parameter type

 MPar(NMP)%Par = Val ! Set parameter type for this MP

 M = MPar(NMP)%Mic ! Micro for this MP

 IF (Val==1) Mic(M)%PRX = NMP ! Map micro(M) proximity to MP

 IF (Val==2) Mic(M)%PEN = NMP ! Map micro(M) penetration to MP

 IF (Val==3) Mic(M)%AER = NMP ! Map micro(M) air exch. to MP

 IF (Val==4) Mic(M)%DEC = NMP ! Map micro(M) decay rate to MP

 IF (Val==5) Mic(M)%VOL = NMP ! Map micro(M) volume to MP

 IF (Val==6) Mic(M)%MR = NMP ! Map micro(M) removal rate to MP

A-95
 IF (Val==7) Mic(M)%NES = Mic(M)%NES + 1 ! Increment micro(M) ES

counter

 IF (Val==8) Mic(M)%NCS = Mic(M)%NCS + 1 ! Increment micro(M) CS

counter

 CASE("HOURS") ! Keyword for hours-blocks mapping

 READ(SubS,*,IOSTAT=Ios(MicroU)) MPar(NMP)%HB ! Read 24 values from

input

 IF (Ios(MicroU)/=0) CALL Fatal(6) ! Stop if trouble reading values

 IF (ANY(MPar(NMP)%HB<1)) CALL Fatal(7) ! Stop if block # out of range

 MPar(NMP)%N(1) = MAXVAL(MPar(NMP)%HB) ! # blocks is largest of

24 values

 CASE("WEEKD") ! Keyword for weekday-daytype map

 READ(SubS,*,IOSTAT=Ios(MicroU)) MPar(NMP)%WT ! Read 7 values from

input

 IF (Ios(MicroU)/=0) CALL Fatal(8) ! Stop if trouble reading values

 IF (ANY(MPar(NMP)%WT<1)) CALL Fatal(9) ! Stop if daytype # out of

range

 MPar(NMP)%N(2) = MAXVAL(MPar(NMP)%WT) ! # daytypes is largest

value

 CASE("MONTH") ! Keyword for Month-Season mapping

 READ(SubS,*,IOSTAT=Ios(MicroU)) MPar(NMP)%MS ! Read 12 values from

input

 IF (Ios(MicroU)/=0) CALL Fatal(10) ! Stop if trouble reading values

 IF (ANY(MPar(NMP)%MS<1)) CALL Fatal(11) ! Stop if Season # out of

range

 MPar(NMP)%N(3) = MAXVAL(MPar(NMP)%MS) ! # seasons is largest

value

 CASE("DISTR") ! Keyword for District-Area map

 READ(SubS,*,IOSTAT=Ios(MicroU)) DA(NMP,:) ! Read (#districts) values 

 IF (Ios(MicroU)/=0) CALL Fatal(12) ! Stop if trouble reading values

 IF (ANY(DA(NMP,:)<1)) CALL Fatal(13) ! Stop if Area is out of range

 MPar(NMP)%N(4) = MAXVAL(DA(NMP,:)) ! # Areas is largest value 

 CASE("CONDI") ! Keyword for conditional variable

 Val = INDEX(UpString,"#") ! Locate pound sign in input line

 IF (Val==0) CALL Fatal(14) ! Stop if no pound sign found

 READ(UpString(Val+1:),*,IOSTAT=Ios(MicroU)) Num ! Get condition number

 IF (Ios(MicroU)/=0) CALL Fatal(15) ! Stop if CV number is unreadable 

 IF (Num<1.OR.Num>3) CALL Fatal(16) ! Stop if CV number out of range

 DO I=1,NumCV ! Loop over CV List

 IF (TRIM(CVList(I)%Name)==TRIM(SubS)) EXIT ! Exit loop if name of CV

found

 WRITE(LogU,*), I,TRIM(CVList(I)%Name),TRIM(SubS) ! For debugging only

 ENDDO ! Continue with next CV 

 WRITE(LogU,*) 'Cond #',Num, '=', I ! Report the CV match

 IF (I>NumCV) THEN ! If no CV match is found...

 MPar(NMP)%C(Num) = 0 ! No CV used for this condition

 MPar(NMP)%N(4+Num) = 1 ! One level by default

 ELSE ! Else CV match found

A-96
 MPar(NMP)%C(Num) = I ! Identify CV by number

 MPar(NMP)%N(4+Num) = CVList(I)%Levels ! Set # levels for the CV

 ENDIF ! End of logic block

 WRITE(LogU,*) 'Levels=',MPar(NMP)%N(4+Num) ! Debugging message

 CASE("RESAM") ! Keyword for Resampling options

 Val = NO ! Default to NO

 IF (Subs(1:1)=="Y") Val= YES ! Set to YES if 'Y' found

 IF (UpString(7:7)=="H") MPar(NMP)%ResampHours = Val ! Character 7 (right after 

 IF (UpString(7:7)=="D") MPar(NMP)%ResampDays = Val ! 'Resamp')

distinguishes 

 IF (UpString(7:7)=="W") MPar(NMP)%ResampWork = Val ! the 3 options.

 CASE("RANDO") ! Keyword for RandomSeed

 READ(SubS,*,IOSTAT=Ios(MicroU)) Val ! Value to right of '='

 IF (Ios(MicroU)/=0) CALL Fatal(17) ! Stop if value is unreadable

 IF (Val>0) MPar(NMP)%Seed(:) = Val ! Set random seed for this MP

 CASE("BLOCK") ! Keyword for start of distribs

 MPar(NMP)%NDistrib = PRODUCT(MPar(NMP)%N(:)) ! Calculate # of

distribs

 MPar(NMP)%NShift = PRODUCT(MPar(NMP)%N(4:7)) ! Set # dayshift values

 CASE DEFAULT ! No more keywords 

 N = MPar(NMP)%N ! Local vector for distr. indices

 WRITE(LogU,*) 'N=',N ! Report 7 values of N on log

 Num = IACHAR(UpString(1:1)) ! Convert first character to ASCII

 IF (Num>48.AND.Num<58) THEN ! If it is a digit 1-9 ...

 READ(UpString,*,IOSTAT=IOS(MicroU)) J, P0, Char1 ! Read 7 indices, a real, a

shape 

 WRITE(LogU,*) 'J=',J ! Print indices on log

 IF (Ios(MicroU)/=0) CALL Fatal(18) ! Stop if trouble reading data

 IF (ANY(J<1)) CALL Fatal(19) ! Stop if index not positive

 IF (ANY(J-N>0)) CALL Fatal(20) ! Stop if index too large

 J = J-1 ! Start all indices at zero

 NDist = NDist + 1 ! Increment distribution counter

 IF (NDist>MPar(NMP)%NDistrib) CALL Fatal(21) ! Stop if too many distribs

 I = J(4)+N(4)*(J(5)+N(5)*(J(6)+N(6)*J(7))) ! Locate distribution in order

 I = 1+J(1)+N(1)*(J(2)+N(2)*(J(3)+N(3)*I)) ! according to indices

 WRITE(LogU,*) 'I=',I ! Report index for debugging

 WRITE(LogU,*) 'NMP=',NMP ! Report MP number for debugging

 WRITE(LogU,*) 'ND =',MPar(NMP)%NDistrib ! Report # distribs for

debugging

 IF (I<0.OR.I>MPar(NMP)%NDistrib) CALL Fatal(22) ! Check range on distrib

index

 I = ZDist + I ! Find position in full list

 IF (MPDistr(I)%Shape>0) CALL Fatal(23) ! Stop if distrib already defined

 UpString = UpString(INDEX(UpString,Char1):) ! Drop indices and P0 from line

 MPDistr(I)%PZero = P0 ! Set the PZero value

 Ptr => MPDistr(I) ! Set pointer to Distrib location

 CALL GetMicroDistrib(UpString,Ptr) ! Read distribution parameters

 ELSE ! Else not a numeric line

A-97
 CALL Fatal(24) ! Then stop

 ENDIF ! End of CASE DEFAULT logic block

 END SELECT ! End of SELECT logic

 ENDIF ! End of GetLine processing logic

 ENDDO ! Continue with next input record

 CLOSE(MicroU) ! Close micro descriptions file

 WRITE(LogU,*) 'Finished reading micro file' ! Status message for log file

 IF (ANY(MPDistr%Shape==0)) CALL Fatal(25) ! All distribs should be

defined

 IF (NMP /= NumMP) CALL Fatal(26) ! Running counter should = total

 IF (NumMPDistrib /= ZDist + NDist) CALL Fatal(27) ! Running counter should =

total

 DO I=1,NumMicros ! Loop over micros

 IF (Mic(I)%Method==MASSBAL) THEN ! For MASSBAL micros...

 IF (Mic(I)%AER<=0) CALL Fatal(28) ! Stop if AER is not defined

 IF (Mic(I)%NES>0.AND.Mic(I)%VOL<=0) CALL Fatal(29) ! Stop if ESource but

no volume

 ENDIF ! End of MASSBAL logic 

 ENDDO ! Continue with next micro

 DO I=1,NumMP ! Loop over MPs

 DO D=1,NumDays ! Loop over simulation days

 W = MPar(I)%WT(Calen(D)%DayOfWeek)-1 ! Find Daytype for day and

MP

 TS(I,D) = W*N(2)+ MPar(I)%MS(Calen(D)%Month) ! Set Daytype-Season

combination

 ENDDO ! Continue with next day

 IF (MPar(I)%ResampHours==YES) THEN ! If hours are resampled...

 MPar(I)%HBN(:) = 0 ! Initialize block counters

 DO H=1, 24 ! Loop over hours in day

 B = MPar(I)%HB(H) ! Find Block for given hour

 MPar(I)%HBN(B) = MPar(I)%HBN(B) + 1 ! Increment Block counter

 MPar(I)%HBR(H) = MPar(I)%HBN(B) ! Set repetition number for hour

 ENDDO ! Continue with next hour

 ENDIF ! End of ResampHours logic

 ENDDO ! Continue with next MP

 WRITE(LogU,*) 'Finished ReadMicroData' ! Status message for log file 

END SUBROUTINE ReadMicroData ! Return to main APEX3

program

A-98
SUBROUTINE SetupMicArrays(MaxDist) ! Called from ReadMicroData

 INTEGER (KIND=IK),INTENT(IN) :: MaxDist ! Input max # distrib per MP

 INTEGER (KIND=IK) :: I, SeedInc ! Local integer variables

 ! Globals needed : IK, LogU, NumDistricts, NumMicros, NumMP, NumMPDistrib

 ! Globals altered: MicroConc, ProcName

 ! Intrinsic procs: ALLOCATE, WRITE

 ! External procs : Fatal

 ProcName(2) = "SetupMicArrays"

 IF (NumMicros==0) CALL Fatal(1) ! Stop if no micros defined 

 IF (NumDistricts==0) CALL Fatal(2) ! Stop if no air quality districts

 IF (NumMP==0) CALL Warning(1) ! Warn user if no MP defined

 IF (NumMPDistrib==0) CALL Warning(2) ! Warn user if no MP distribs

used

 WRITE(LogU,*) 'NumMP = ', NumMP ! Report # MP to log file

 WRITE(LogU,*) 'NumMPD= ', NumMPDistrib ! Report # MP distribs to log

 WRITE(LogU,*) 'NumMic= ', NumMicros ! Report # micros to log

 WRITE(LogU,*) 'NumDis= ', NumDistricts ! Report # AQ districts to log

 ALLOCATE (MicroConc(-23:NumHours,0:NumMicros,3)) ! Space for micro conc

values

 ALLOCATE (Mic(NumMicros)) ! Space for properties of micros

 ALLOCATE (MPDistr(NumMPDistrib)) ! Space for MP distributions

 ALLOCATE (MPar(NumMP)) ! Space for MP descriptions

 ALLOCATE (DA(NumMP,NumDistricts)) ! Space for district-area

mappings

 ALLOCATE (TS(NumMP,NumDays)) ! Space for daytype-season

indices

 ALLOCATE (Buff(MaxDist,NumHours)) ! Buffer for generated random

#s

 ALLOCATE (DCN(MaxDist)) ! Space for day category counts

 ALLOCATE (DayShift(NumDays)) ! Space for day category results 

 ALLOCATE (NDist(24,NumDays)) ! Space for hour-distribution map

 ALLOCATE (NSamp(24,NumDays)) ! Space for hour-sample # map

 ALLOCATE (ESum(-23:NumHours,NumMicros,3)) ! Space for ESource sums

 ALLOCATE (CSum(-23:NumHours,NumMicros,3)) ! Space for CSource sums

 ALLOCATE (MPV(-23:NumHours,-2:NumMP,3)) ! Space for generated MP

values

 ALLOCATE (PP(-23:NumHours,3)) ! Space for (prox*pene) product

 ALLOCATE (R(-23:NumHours)) ! Space for hourly removal rates

 ALLOCATE (S(-23:NumHours)) ! Space for hourly source strength

 MicroConc(:,0,:) = 0. ! Micro #0 has zero conc

 Mic(:)%Index = 0 ! Undefined micros have no index

 Mic(:)%Method = 0 ! Undefined micros have no method

 Mic(:)%PRX = -1 ! Default prox is MP=-1 (all ones)

 Mic(:)%PEN = -1 ! Default pene is MP=-1 (all ones)

 Mic(:)%DEC = 0 ! Default decay is zero

 Mic(:)%MR = -2 ! Default removal is MP=-2

 Mic(:)%NES = 0 ! Default # ESource is zero

 Mic(:)%NCS = 0 ! Default # CSource is zero

A-99
 MPDistr(:)%Shape = 0 ! Undefined shapes are zero

 DA(:,:) = 1 ! Default area is 1 

 MPV(:,-2,:) = 1. ! Initial MR value is 1.

 MPV(:,-1,:) = 1. ! MP=-1 stays at value=1 

 MPV(:,0,:) = 0. ! MP=0 stays at value=0

 SeedInc = 1 ! This works for multiword seeds

 IF (KSeed==1) SeedInc = 1000000 ! Single word seeds are a problem

 MPar(:)%Mic = 0 ! Undefined MP have no micro

 MPar(:)%Par = 0 ! Undefined MP have no param type

 DO I=1,NumMP ! Loop over MP vector

 MPar(I)%HB(:) = 1 ! Default block is 1 for all hours

 MPar(I)%WT(:) = 1 ! Default daytype is 1 

 MPar(I)%MS(:) = 1 ! Default season is 1 

 MPar(I)%C(:) = 0 ! Default conditional var is none

 MPar(I)%N(:) = 1 ! Default # distribs is 1

 MPar(I)%HBR(:) = 1 ! Default hour repetition is 1

 MPar(I)%HBN(:) = 1 ! Default block count is 1

 MPar(I)%Seed(:) = ISeed(1)+(4+I)*SeedInc ! Default MP random seed 

 ENDDO ! Continue with next MP

 MPar(:)%ResampHours = NO ! Default is no hourly resampling

 MPar(:)%ResampDays = NO ! Default is no daily resampling

 MPar(:)%ResampWork = YES ! Default is work resampling

 ProcName(2) = "Null" ! Default procedure name

END SUBROUTINE SetupMicArrays ! Return to ReadMicroData

A-100
SUBROUTINE GetMicroDistrib(String,Ptr) ! Called from ReadMicroData

 CHARACTER(LEN=LEN3), INTENT(IN) :: String ! Character input variable

 TYPE(CDist), POINTER :: Ptr ! Pointer to output destination

 CHARACTER(LEN=LEN3) :: Line ! Buffer for holding input string

 CHARACTER(LEN=1) :: Letter ! One letter extraced from input

 CHARACTER(LEN=2) :: C(4) ! Two letters extracted from input

 INTEGER (KIND=IK) :: I ! Local integer variable

 REAL (KIND=RK) :: R(4) ! Local real variables 

 ! Globals needed: IK, LEN1, LEN3, RK 

 ! Globals altered: Ios, ProcName

 ! Intrinsic procs: ADJUSTL, HUGE, IACHAR, LOG, SQRT

 ! External procs: Fatal

 ProcName(2) = "GetMicroDistrib" ! Procedure name for messages

 Line = ADJUSTL(String) ! Remove leading blanks

 DO ! Loop over characters in input

 READ (Line,'(A1)',IOSTAT=Ios(MicroU)) Letter ! Read one character

 I = IACHAR(Letter) ! Get ASCII code for character

 IF ((I>=65.AND.I<=90).OR.(I>=97.AND.I<=122)) EXIT ! Exit loop if a letter is

found

 Line=ADJUSTL(Line(2:)) ! Remove first character and...

 ENDDO ! Continue with next character

 READ (Line,*,IOSTAT=Ios(MicroU)) Letter, C ! Read line as character 

 R(1) = -HUGE(R) ! No minimum truncation 

 R(2) = HUGE(R) ! No maximum truncation

 DO I=1,4 ! Loop over parameters

 Line = ADJUSTL(Line(INDEX(Line," "):)) ! Delete first remaining item

 IF (C(I)/='. ') READ(Line,*) R(I) ! Read if item is not a period

 ENDDO ! Continue with next parameter

 SELECT CASE (Letter) ! Select distrib based on letter

 CASE ('F','f','P','p') ! If Word is 'fixed' or 'point'

 Ptr%Shape = POINT ! Set Shape to POINT

 IF (C(1)==". ") CALL Fatal(1) ! Stop if required param missing

 R(2) = R(1) ! Set maximum to minimum

 R(3) = R(1) ! Set Par1 (mean) to minimum

 R(4) = 0. ! Set Par2 (Std.Dev.) to zero

 CASE ('U','u') ! If Word is 'Uniform'...

 Ptr%Shape = UNIFORM ! Set Shape to UNIFORM

 IF (C(1)=='. '.OR.C(2)=='. ') CALL Fatal(2) ! Stop if required values missing 

 IF (R(2)<=R(1)) CALL Fatal(3) ! Stop if maximum not above min 

 R(3) = (R(1)+R(2))/2. ! Set Par1 to mean of uniform

 R(4) = (R(2)-R(1))/SQRT(12.) ! Set Par2 to standard deviation 

 CASE ('N','n') ! If Word is 'Normal'...

 Ptr%Shape = NORMAL ! Set Shape to NORMAL

 IF (C(3)=='. '.OR.C(4)=='. ') CALL Fatal(4) ! Stop if required values missing 

 IF (R(2)<=R(1)) CALL Fatal(5) ! Stop if max not above min 

 IF (R(4)<=0.) CALL Fatal(6) ! Stop if Std. Dev. not positive

 R(1) = (R(1)-R(3))/R(4) ! Convert min to standard score 

A-101
 R(2) = (R(2)-R(3))/R(4) ! Convert max to standard score

 CASE ('L','l') ! If Word is 'Lognormal'...

 Ptr%Shape = LOGNORMAL ! Set Shape to LOGNORMAL

 IF (C(3)=='. '.OR.C(4)=='. ') CALL Fatal(7) ! Stop if required values missing 

 IF (C(1)=='. ') R(1) = 0. ! Smallest minimum for lognormal 

 IF (R(1)<0.) CALL Fatal(8) ! Stop if user sets negative min

 IF (R(2)<=R(1)) CALL Fatal(9) ! Stop if max not above min 

 IF (R(3)<=0.) CALL Fatal(10) ! Stop if median is negative

 IF (R(4)<=1.) CALL Fatal(11) ! Stop if GSD is not over one

 IF (R(1) >0.) THEN ! True unless R(1)=0.

 R(1) = LOG(R(1)/R(3))/LOG(R(4)) ! Convert min to standard score 

 ELSE ! Else R(1)=0.

 R(1) = -HUGE(R) ! No minimum truncation 

 ENDIF ! End of minimum truncation logic

 R(2) = LOG(R(2)/R(3))/LOG(R(4)) ! Convert max to standard score

 CASE ('T','t') ! If Word is 'Triangle'...

 Ptr%Shape = TRIANGLE ! Set Shape to TRIANGLE

 IF (C(1)=='. '.OR.C(2)=='. '.OR.C(3)=='. ') CALL Fatal(12) ! Stop if required values

missing

 IF (R(2)<=R(1)) CALL Fatal(13) ! Stop if max not above min 

 IF (R(3)<R(1)) CALL Fatal(14) ! Stop if peak below minimum

 IF (R(3)>R(2)) CALL Fatal(15) ! Stop if peak above maximum

 R(4) = 0. ! Par2 not needed for triangle

 CASE ('E','e') ! If Word is 'Exponential'...

 Ptr%Shape = EXPONENTIAL ! Set Shape to EXPONENTIAL

 IF (C(1)=='. '.OR.C(3)=='. ') CALL Fatal(16) ! Stop if required values missing

 IF (R(2)<=R(1)) CALL Fatal(17) ! Stop if max not above min

 IF (R(3)<=R(1)) CALL Fatal(18) ! Stop if mean not above min

 R(4) = R(3)-R(1) ! Std. dev. = mean - min

 CASE DEFAULT ! If Word not in above list...

 CALL Fatal(19) ! Stop if shape is unknown

 END SELECT ! End of Word selection (shape)

 Ptr%Min = R(1) ! Minimum is R1

 Ptr%Max = R(2) ! Maximum is R2

 Ptr%Par1 = R(3) ! Par1 (mean) is R3

 Ptr%Par2 = R(4) ! Par2 (Std Dev) is R4

 ProcName(2) = "Null" ! Default name for procedure

END SUBROUTINE GetMicroDistrib ! Return to ReadMicroData

A-102
SUBROUTINE MicroConcs(P) ! Called from main APEX program

 INTEGER (KIND=IK),INTENT(IN) :: P ! Input argument is profile #

 TYPE(CDist),POINTER :: Ptr ! Local pointer to distributions

 INTEGER (KIND=IK) :: LP(3), MP, M, NB, NTS, NDC, DCR, DSS ! Local integer

variables

 INTEGER (KIND=IK) :: L, H, HW, I, J, DC, N, DCOffset ! More local integer

variables

 INTEGER (KIND=IK) :: HB(24), HBR(24), HBN(24) ! Local integer arrays

 REAL (KIND=RK) :: C0, C1, C, Out, ExpMR ! Local real variables

 ! Globals needed : IK, LogU, NumDays, NumHours, NumMicros, PPMFact, RK, YES 

 ! Globals altered: MicroConcs, ModuleName, ProcName

 ! Intrinsic procs: ABS, ANY, CSHIFT, EXP, INT, MOD, RANDOM_SEED, WRITE

 ! External procs : Distrib, Fatal, GenerateDayShift

 ModuleName = "MicroEnvModule" ! Module name for messages

 ProcName(1) = "MicroConcs" ! Procedure name for messages

 WRITE(LogU,*) 'Starting MicroConcs for #',P ! Status message for debugging

 MPV(:,1:,:) = 0. ! Zero out micro concs

 ESum(:,:,:) = 0. ! Zero out ESource sums

 CSum(:,:,:) = 0. ! Zero out CSource sums

 LP(1) = Person(P)%HomeD ! Place #1 is home district

 LP(2) = Person(P)%WorkD ! Place #2 is work district

 LP(3) = 0 ! Place #3 is zero

 DO MP=1, NumMP ! Loop over MP

 M = MPar(MP)%Mic ! M is micro # for MP

 NB = Mpar(MP)%N(1) ! NB is # blocks for MP

 NTS = MPar(MP)%N(2)*MPar(MP)%N(3) ! NTS is # daytype-seasons for

MP

 NDC = MPar(MP)%NShift * NTS ! NDC is # day categories for MP

 HB = MPar(MP)%HB ! HB is hour-block mapping for MP

 HBR = MPar(MP)%HBR ! HBR is hour-block repetitions

 HBN = MPar(MP)%HBN ! HBN is # hours in each block

 DCR = 1 ! Day repetition starts at 1

 DCN(:) = 0 ! Initialise day category counter

 CALL RANDOM_SEED(Put=MPar(MP)%Seed(1:KSeed)) ! Initialize MP seed

 CALL GenerateDayShift(P,MP) ! Code is in MicroEnvModule

 HW = 1 ! Home-work loop upper bound

 IF (MPar(MP)%ResampWork==YES) HW = 2 ! Bound is 2 if work values

needed

 DO L = 1, HW ! Loop over places

 IF (L==1) THEN ! If at home...

 DO I = 1, NumDays ! Loop over simulation days

 DC = TS(MP,I) + NTS * DayShift(I) ! Calculate day category #

 DCN(DC) = DCN(DC)+1 ! Increment day category counter

 IF (MPar(MP)%ResampDays==YES) DCR = DCN(DC) ! Set repetition # if

needed

 DO H=1, 24 ! Loop over hours in day

 NDist(H,I)= HB(H) + NB*(DC-1) ! Set distrib # for each hour

 NSamp(H,I)= HBR(H) + HBN(HB(H))*(DCR-1) ! Set sample # for each hour

A-103
 ENDDO ! Continue with next hour

 ENDDO ! Continue with next day

 ELSE ! Else place is at work...

 DCOffset = NTS*(DA(MP,LP(2))-DA(MP,LP(1))) ! Offset day categories for

areas

 NDist(:,:) = NDist(:,:) + NB*DCOffset ! Offset the distributions used

 DCN(1:NDC) = CSHIFT(DCN(1:NDC),-DCOffset) ! Offset the day category

array

 ENDIF ! End of logic for home-work place

 IF (MPar(MP)%ResampDays==NO) DCN(1:NDC) = 1 ! One value per category

is enough

 DO N = 1,MPar(MP)%NDistrib ! Loop over distribs for this MP

 DSS = HBN(1+MOD(N-1,NB)) * DCN(1+INT((N-1)/NB)) ! Sample size needed

for distrib

 PTR => MPDistr(N + MPar(MP)%ZDist) ! Point to correct distrib

 IF (DSS>0) CALL Distrib(MDPtr=Ptr,RRes=Buff(N,1:DSS)) ! Get random values

from distrib

 ENDDO ! Continue with next distrib

 DO I=1,NumDays ! Loop over simulation days

 DO H=1, 24 ! Loop over hours in day

 MPV(H+24*(I-1),MP,L) = Buff(NDist(H,I),NSamp(H,I)) ! Set MP value

 ENDDO ! Continue with next hour

 ENDDO ! Continue with next day

 IF (MPar(MP)%Par==ES) ESum(:,M,L)=ESum(:,M,L)+MPV(:,MP,L) ! If ESource, add

to ESum

 IF (MPar(MP)%Par==CS) CSum(:,M,L)=CSum(:,M,L)+MPV(:,MP,L) ! If CSource, add

to CSum

 ENDDO ! Continue with next place

 IF (HW==1) MPV(:,:,2) = MPV(:,:,1) ! Work=home if only one place

 CALL RANDOM_SEED(Get=MPar(MP)%Seed(1:KSeed)) ! Update MP seed 

 IF(MPar(MP)%Par==VO.AND.ANY(MPV(1:,MP,1:2)<=0.)) CALL Fatal(1) ! Stop if

volume not positive 

 ENDDO ! Continue with next MP

 MPV(:,1:,3) = 0.5* (MPV(:,1:,1) + MPV(:,1:,2)) ! Place #3 is average of #1 & #2

 ESum(:,:,3) = 0.5* (ESum(:,:,1) + ESum(:,:,2)) ! Same for ES sums

 CSum(:,:,3) = 0.5* (CSum(:,:,1) + CSum(:,:,2)) ! Same for CS sums

 MPV(-23:0,1:,:) = MPV(1:24,1:,:) ! First day is repeated 

 ESum(-23:0,:,:) = ESum(1:24,:,:) ! Same for ES sums

 CSum(-23:0,:,:) = CSum(1:24,:,:) ! Same for CS sums

 ESum(:,:,:) = ESum(:,:,:)/PPMFact ! Convert ug/m3 to ppm

 IF (ANY(ESum<0.)) CALL Fatal(2) ! Stop if negative ESources

 IF (ANY(CSum<0.)) CALL Fatal(3) ! Stop if negative CSources

 IF (ANY(MPV <0.)) CALL Fatal(4) ! Stop if negative MP value

 DO M=1,NumMicros ! Loop over micros

 PP(:,:) = MPV(:,Mic(M)%Prx,:) * MPV(:,Mic(M)%Pen,:) ! Product of proximity and

penetr

 IF (Mic(M)%Method==MASSBAL) THEN ! For MASSBAL micros...

A-104
 MPV(:,-2,:) = MPV(:,Mic(M)%AER,:) + MPV(:,Mic(M)%Dec,:) ! Find default hourly

removal rate

 DO L=1, 3 ! Loop over places

 R(:) = MPV(:,Mic(M)%MR,L) ! Set hourly removal rate

 S(:) = 0. ! Initialize sources to zero

 IF (Mic(M)%NES>0) S(:) = ESum(:,M,L)/MPV(:,Mic(M)%Vol,L) ! Add to S if

ESources exist

 IF (Mic(M)%NCS>0) S(:) = S(:) + CSum(:,M,L)*R(:) ! Add to S if CSources exist

 C0 = 0. ! Start with nothing in micro

 DO J=-23, NumHours ! Loop over all hours

 IF (R(J)>80.) R(J)=80. ! Numerical limit on removal rate

 IF (R(J)==0.) THEN ! If no removal...

 C1 = C0 + S(J) ! Conc increases by source amount

 MicroConc(J,M,L) = C0 + S(J)*0.5 ! Mean conc is start-end average

 ELSE ! Else removal occurs...

 ExpMR = EXP(-R(J)) ! Call EXP once, value used twice

 Out = AQData(J,LP(L))*PP(J,L)*MPV(J,Mic(M)%AER,L) ! Air concentration

outside micro

 C = (S(J)+Out)/R(J) ! Equilibrium concentration

 C1 = C + (C0-C)*ExpMR ! End-of-hour concentration

 MicroConc(J,M,L) = C + (C0-C)*(1.0-ExpMR)/R(J) ! Average concentration over

hour

 ENDIF ! End of current hour calculations

 C0 = C1 ! Final conc becomes initial 

 ENDDO ! Continue with next hour

 ENDDO ! Continue with next place

 ELSE ! Else a FACTORS micro...

 DO L=1, 3 ! Loop over places

 MicroConc(:,M,L) = AQData(:,LP(L))*PP(:,L)+CSum(:,M,L) ! FACTORS equation for

micro conc

 ENDDO ! Continue with next place

 ENDIF ! End of method logic

 IF (ANY(MicroConc(:,M,:)<0.)) THEN ! If a negative micro conc found

 DO J=-23,NumHours ! Loop over hours

 DO L=1,3 ! Loop over places

 IF (MicroConc(J,M,L)<0.) THEN ! If conc is negative ... 

 WRITE(LogU,*) 'Neg Conc ',J,M,L,MicroConc(J,M,L) !

 WRITE(LogU,*) 'AirQual= ',AQData(J,LP(L)) ! Put AQ data on log 

 WRITE(LogU,*) 'PP = ',PP(J,L) ! Put Prox*pen on log

 WRITE(LogU,*) 'CSum = ',CSum(J,M,L) ! Put CSum on log

 IF (Mic(M)%Method==MASSBAL) THEN ! If a MASSBAL micro

 WRITE(LogU,*) 'Source =',S(J) ! Put Source on log

 WRITE(LogU,*) 'AER =',MPV(J,Mic(M)%AER,L) ! Put AER on log

 WRITE(LogU,*) 'Removal=',R(J) ! Put removal rate on log

 ENDIF ! End of MASSBAL logic

 ENDIF ! End of negative conc block

 ENDDO ! Continue with next place

 ENDDO ! Continue with next hour

A-105
 CALL Fatal(5) ! Stop program

 ENDIF ! End of negative conc logic

 ENDDO ! Continue with next micro

 WRITE(LogU,*) 'Finished MicroConcs for # ',P ! Status message for log

END SUBROUTINE MicroConcs ! Return to main APEX program

A-106
SUBROUTINE GenerateDayShift(P,MP) ! Called from MicroConcs

 INTEGER (KIND=IK), INTENT(IN) :: P ! Input argument is

profile #

 INTEGER (KIND=IK), INTENT(IN) :: MP ! Input argument is

MP #

 INTEGER (KIND=IK) :: NAr, NC1, NC2, VC(3) ! Local integer variables

 INTEGER (KIND=IK) :: AreaH, NDays, I, J ! More local integer variables

 ! Globals needed : IK, NumCVFixed, NumDays

 ! Globals altered: ProcName

 ! Intrinsic procs: MAXVAL

 ! External procs : CVValue

 ProcName(2) = "GenerateDayShift" ! Procedure name for messages

 DayShift = 0 ! Initialize output to zero

 IF (MPar(MP)%NShift==1) RETURN ! If only one case, then done

 NAr = MPar(MP)%N(4) ! # of areas for MP

 NC1 = MPar(MP)%N(5) ! # of CV1 values for MP

 NC2 = MPar(MP)%N(6) ! # of CV2 values for MP

 AreaH = DA(MP,Person(P)%HomeD) ! Area for this profile

 NDays = NumDays ! # of days to calculate

 IF (MAXVAL(MPar(MP)%C(:))<=NumCVFixed) NDays=1 ! If no daily CV used,

just 1 day

 DO I=1, NDays ! Loop over days

 DO J=1, 3 ! Loop over CV

 VC(J) = CVValue(P,I,MPar(MP)%C(J))-1 ! Get CV value for current day

 ENDDO ! Continue with next CV

 DayShift(I) = (AreaH-1) + NAr*(VC(1)+NC1*(VC(2)+NC2*VC(3))) ! Dayshift for this

day

 ENDDO ! Continue with next day

 IF (NDays==1) DayShift(:) = DayShift(1) ! If all same, then copy results

 ProcName(2) = "Null" ! Default procedure name

END SUBROUTINE GenerateDayShift ! Return to MicroConcs

END MODULE MicroEnvModule ! End of source code for module

A-107
MODULE ExposureDoseModule ! Compile after the modules below

 USE GlobalModule ! Compile this module first

 USE UtilityModule ! Compile this module second

 USE DistributionModule ! Compile this module third

 IMPLICIT NONE ! Must declare all variables

 TYPE :: MicroSummary ! Stores profile sums by micro 

 INTEGER (KIND=IK) :: Minutes = 0 ! # minutes spent in each micro 

 REAL (KIND=RK) :: MeanConc = 0.0 ! Mean exposure in each micro

 REAL (KIND=RK) :: MaxConc = 0.0 ! Max. exposure in each micro

 END TYPE MicroSummary ! Used to declare MSum

 TYPE(MicroSummary),ALLOCATABLE :: MSum(:,:) ! Summary by profile

and micro

 INTEGER (KIND=IK), ALLOCATABLE :: DM1HExp(:,:) ! Daily max 1-hour

exposure table

 INTEGER (KIND=IK), ALLOCATABLE :: DM8HExp(:,:) ! Daily max 8-hour

exposure table

 INTEGER (KIND=IK), ALLOCATABLE :: DAvgExp(:,:) ! Daily average

exposure table

 INTEGER (KIND=IK), ALLOCATABLE :: AnnExp(:,:) ! Annual average

exposure table

 INTEGER (KIND=IK), ALLOCATABLE :: DMEHDose(:,:) ! Daily max

end-of-hour dose table

 INTEGER (KIND=IK), ALLOCATABLE :: DM1HDose(:,:) ! Daily max 1-hour

dose table

 INTEGER (KIND=IK), ALLOCATABLE :: DM8HDose(:,:) ! Daily max 8-hour

dose table

 INTEGER (KIND=IK), ALLOCATABLE :: DAvgDose(:,:) ! Daily average dose

table

 INTEGER (KIND=IK), ALLOCATABLE :: AnnDose(:,:) ! Annual average dose

table

 REAL (KIND=LONG), ALLOCATABLE :: DoseTime(:,:) ! Minutes per dose

level table

 REAL (KIND=LONG), ALLOCATABLE :: ExpTime(:,:) ! Minutes per exposure

level table

 REAL (KIND=LONG), ALLOCATABLE :: Array(:,:) ! Buffer for table data

 REAL (KIND=LONG), ALLOCATABLE :: TableLev(:) ! Buffer for table levels

 REAL (KIND=RK), ALLOCATABLE :: Percs(:,:) ! Buffer for desired

percentiles

 CHARACTER*120 :: Header ! Buffer for table title

CONTAINS ! Routines internal to this module

A-108
SUBROUTINE SetupTables ! Called from main APEX program

 INTEGER (KIND=IK) :: N(11), K ! Local integer variables

 ! Globals needed: DM1HDoseLev, DM1HExpLev, DM8HDoseLev, DM8HExpLev,

DMEHDoseLev,

 ! DoseTimeLev, ExpTimeLev, IK, Pctl

 ! Globals altered: <None>

 ! Intrinsic procs: ALLOCATE, MAXVAL, NINT

 ! External procs: <None>

 N(1) = NINT(DM1HExpLev(0)) ! # levels on DM1HExp table 

 N(2) = NINT(DM8HExpLev(0)) ! # levels on DM8HExp table 

 N(3) = NINT(DAvgExpLev(0)) ! # levels on DAvgExp table 

 N(4) = NINT(AnnExpLev(0)) ! # levels on AnnExp table 

 N(5) = NINT(ExpTimeLev(0)) ! # levels on ExpTime table 

 N(6) = NINT(DM1HDoseLev(0)) ! # levels on DM1HDose table 

 N(7) = NINT(DM8HDoseLev(0)) ! # levels on DM8HDose table 

 N(8) = NINT(DAvgDoseLev(0)) ! # levels on DAvgDose table 

 N(9) = NINT(AnnDoseLev(0)) ! # levels on AnnDose table 

 N(10) = NINT(DoseTimeLev(0)) ! # levels on DoseTime table 

 N(11) = NINT(DMEHDoseLev(0)) ! # levels on DMEHDose table 

 ALLOCATE (ExpDose(NumProfiles,NumDays)) ! Daily exposure and dose

stats

 ALLOCATE (MSum(0:NumMicros,NumProfiles)) ! Profile-micro summary

table

 ALLOCATE (DM1HExp(NumProfiles,N(1))) ! Daily max 1-hour exposures

 ALLOCATE (DM8HExp(NumProfiles,N(2))) ! Daily max 8-hour exposures

 ALLOCATE (DAvgExp(NumProfiles,N(3))) ! Daily average exposures

 ALLOCATE (AnnExp( NumProfiles,N(4))) ! Annual average exposures

 ALLOCATE (ExpTime(0:NumMicros,N(5))) ! Minutes at each exposure

level

 ALLOCATE (DM1HDose(NumProfiles,N(6))) ! Daily max 1-hour doses

 ALLOCATE (DM8HDose(NumProfiles,N(7))) ! Daily max 8-hour doses

 ALLOCATE (DAvgDose(NumProfiles,N(8))) ! Daily average doses

 ALLOCATE (AnnDose( NumProfiles,N(9))) ! Annual average doses

 ALLOCATE (DoseTime(NumProfiles,N(10))) ! Minutes at each dose level

 ALLOCATE (DMEHDose(NumProfiles,N(11))) ! Daily max end-of-hour

doses

 K = MAXVAL(N) ! Find largest # of table levels 

 ALLOCATE (Percs(NINT(Pctl(0)),K)) ! Percentiles for output tables

 ALLOCATE (Array(NumProfiles,K)) ! Buffer for values in tables

 ALLOCATE (TableLev(K)) ! Buffer for table levels

 DM1HExp = 0 ! Initialize DM1HExp table

 DM8HExp = 0 ! Initialize DM8HExp table

 DAvgExp = 0 ! Initialize DAvgExp table

 AnnExp = 0 ! Initialize AnnExp table 

 ExpTime = 0. ! Initialize ExpTime table

 DM1HDose = 0 ! Initialize DM1HDose table

 DM8HDose = 0 ! Initialize DM8HDose table

 DMEHDose = 0 ! Initialize DMEHDose table 

A-109
 DAvgDose = 0 ! Initialize DAvgDose table

 AnnDose = 0 ! Initialize AnnDose table

 DoseTime = 0. ! Initialize DoseTime table 

 MSum%Minutes = 0 ! Initialize sum for minutes

 MSum%MeanConc = 0. ! Initialize sum for mean conc

 MSum%MaxConc = 0. ! Initialize max conc to zero

END SUBROUTINE SetupTables ! Return to main APEX program 

A-110
SUBROUTINE Ventilation(P) ! Called from main APEX program

 INTEGER (KIND=IK), INTENT(IN) :: P ! Input variable (person number) 

 INTEGER (KIND=IK) :: H, I, J, K ! Local integer variables

 REAL (KIND=RK) :: RunAvg(9), MaxAvg(9), UpLim, MaxRatio ! Local real variables

 ! Globals needed: DoDose, IK, NumDays, NumEvents, NumHours, Person, Phys, RK, YES

 ! Globals altered: DaySeq, EventSeq, HourSeq, ModuleName, ProcName

 ! Intrinsic procs: MAX, MAXVAL, MIN, MOD, REAL, SUM, WRITE

 ! External procs: <None>

 IF (DoDose/=YES) RETURN ! Ventilation only needed for dose

 ModuleName = "ExposureDoseModule" ! Module name for messages

 ProcName(1) = "Ventilation" ! Procedure name for messages

 PersonDay%EndGn = Phys(P)%ENDGN1 ! Normal EndGn rate (all days)

 K = Phys(P)%Start ! Phase of menstrual cycle

 IF (K>0) THEN ! If menstrual cycle exists

 DO J=1,NumDays ! Loop over days in simulation 

 IF (1+MOD(J+K,28)>14) PersonDay(J)%EndGn = Phys(P)%ENDGN2 ! Set 14 days per

28 to ENDGN2

 ENDDO ! Continue with next day 

 ENDIF ! End of ENDGN logic

 MaxAvg = (/.64,.54,.48,.44,.41,.39,.37,.35,.33/)*Phys(P)%METmax ! Max sustainable MET

averages

 RunAvg = 0. ! Running MET averages

 DO I=1,NumEvents ! Loop over events

 UpLim = Phys(P)%METmax * MIN(1.0,1.212*EventSeq(I)%Duration) ! Upper MET limit

for event

 EventSeq(I)%MET = MIN(EventSeq(I)%MET,UpLim) ! Reset MET if over limit

 ENDDO ! Continue with next event 

 DO I=1,NumHours ! Loop over hours

 J = HourSeq(I)%FirstEvent ! First event for given hour 

 K = HourSeq(I)%LastEvent ! Last event for given hour

 HourSeq(I)%MET = & 

 SUM(EventSeq(J:K)%MET*EventSeq(J:K)%Duration)/60. ! Mean MET value for

given hour

 IF (I<=9) RunAvg(I) = SUM(HourSeq(1:I)%MET)/REAL(I) ! Kickoff each RunAvg

 DO J=1,MIN(I-1,9) ! Loop over valid RunAvg values

 RunAvg(J) = RunAvg(J)+HourSeq(I)%MET/J-HourSeq(I-J)%MET/J ! Update RunAvgs

to next hour

 ENDDO ! Continue with next RunAvg

 MaxRatio = MAXVAL(RunAvg/MaxAvg) ! Maximum exceedance ratio

 IF (MaxRatio>1.0) THEN ! If some RunAvgs are too big...

 H = MAX(1,I-8) ! First hour to adjust 

 J = HourSeq(H)%FirstEvent ! First event to adjust

 EventSeq(J:K)%MET = EventSeq(J:K)%MET / MaxRatio ! Adjust all events from J

to K 

 HourSeq(H:I)%MET = HourSeq(H:I)%MET / MaxRatio ! Adjust all hour means H

to I

 RunAvg = RunAvg / MaxRatio ! Adjust RunAvg (used next hour)

 ENDIF ! End of tiredness logic

A-111
 ENDDO ! Continue with next hour

 EventSeq%VA = EventSeq%MET*19630.0*Phys(P)%ECF*Phys(P)%RMR ! VA is

proportional to MET

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name 

END SUBROUTINE Ventilation ! Return to main APEX program

A-112
SUBROUTINE ExposureDose(P) ! Called from main APEX program

 INTEGER (KIND=IK), INTENT(IN) :: P ! Input variable (person number)

 INTEGER (KIND=IK) :: D, I, J, K, L, M, NOver, TOver ! Local integer variables

 REAL (KIND=RK) :: E, Div, HighE, X ! Local real variables

 LOGICAL (KIND=1) :: Dose ! Shorter form for DoDose

 ! Globals needed: COThresh, IK, MicroConc, NumEvents, NumHours, NumMicros, RK

 ! Globals altered: EventSeq, HourSeq, ModuleName, ProcName

 ! Intrinsic procs: MAX, PRINT, REAL, SUM, WRITE

 ! External procs: CalcCOHb, Fatal

 ModuleName = "ExposureDoseModule" ! Module name for messages

 ProcName(1) = "ExposureDose" ! Procedure name for messages

 Dose = (DoDose==YES) ! 'Dose' is true or false 

 NOver = 0 ! Initialize high CO event count

 TOver = 0 ! Initialize high CO time

 HighE = 0. ! Initialize high concentration

 DO I=1,NumEvents ! Loop over events

 M = EventSeq(I)%Location ! Event location

 D = EventSeq(I)%Duration ! Event duration

 E = MicroConc(EventSeq(I)%Hour,M,EventSeq(I)%HomeWork) ! Exposure rate

equals conc

 DO L=1,NINT(ExpTimeLev(0)) ! Loop over levels in DM1H table

 IF (E<ExpTimeLev(L)) EXIT ! Exit if E < level cutoff

 ENDDO ! Continue with next level

 IF (L==1) CALL Fatal(1) ! This means exposure is negative

 ExpTime(M,L-1) = ExpTime(M,L-1)+REAL(D,LONG) ! Row L-1 is where E

belongs

 IF (E>COThresh) THEN ! If person encounters high CO

 NOver = NOver+1 ! Increment high CO count

 TOver = TOver+D ! Increment high CO time

 HighE = MAX(HighE,E) ! Find maximum E encountered

 ENDIF ! End of high CO logic block

 EventSeq(I)%Exposure = E ! Store exposure on time series

 MSum(M,P)%Minutes = MSum(M,P)%Minutes + D ! Add minutes spent in

micro M

 MSum(M,P)%MeanConc = MSum(M,P)%MeanConc + E*REAL(D) !

Time-weighted exposure for M

 MSum(M,P)%MaxConc = MAX(MSum(M,P)%MaxConc,E) ! Maximum conc in

micro M

 ENDDO ! Continue with next event

 IF (NOver>0) THEN ! If this person had high CO

 PRINT*, "High CO for Person ",P,NOver, TOver, HighE ! Print warning message 

 WRITE(LogU,*) "High CO for Person ",P,NOver, TOver, HighE ! Write message to log

 ENDIF ! End of high CO logic block

 DO M=1,NumMicros ! Loop over micros

 Div = REAL(MAX(1,MSum(M,P)%Minutes)) ! Time divisor (must not be

zero) 

 MSum(M,P)%MeanConc = MSum(M,P)%MeanConc / Div ! Mean conc for micro

M

A-113
 ENDDO ! Continue with next micro

 IF (Dose) THEN ! Dose ==.TRUE. means do doses

 CALL CalcCOHb(P) ! Calculate COHB blood levels

 DO I=1,NumEvents ! Loop over events

 DO L=1,NINT(DoseTimeLev(0)) ! Loop over levels in table 

 IF (EventSeq(I)%Dose<DoseTimeLev(L)) EXIT ! Exit if Dose < level cutoff

 ENDDO ! Continue with next level 

 DoseTime(P,L-1) = DoseTime(P,L-1)+ & 

 REAL(EventSeq(I)%Duration,LONG) ! Accumulate time at level L-1

 ENDDO ! Continue with next event

 ENDIF ! End of Dose==.TRUE. logic

 DO I=1,NumHours ! Loop over hours

 J = HourSeq(I)%FirstEvent ! Index of first event in hour

 K = HourSeq(I)%LastEvent ! Index of last event in hour

 IF (SUM(EventSeq(J:K)%Duration)/=60) CALL Fatal(2) ! Check that hour has 60

minutes

 HourSeq(I)%Exposure = SUM(EventSeq(J:K)%Exposure* &

 REAL(EventSeq(J:K)%Duration))/60. ! Time-weighted average exposure

 IF (Dose) THEN ! Dose ==.TRUE. means do doses

 HourSeq(I)%Dose = SUM(EventSeq(J:K)%Dose* &

 REAL(EventSeq(J:K)%Duration))/60. ! Time-weighted average dose 

 HourSeq(I)%FDose = EventSeq(K)%FDose ! End-of-hour dose

 ENDIF ! End of Dose==.TRUE. logic

 IF (I<=8) THEN ! First 8 hours use special logic 

 HourSeq(I)%Run8Exp = SUM(HourSeq(1:I)%Exposure)/I ! Running 8-hour average

for exp

 IF(Dose) HourSeq(I)%Run8Dose = SUM(HourSeq(1:I)%Dose)/I ! Running 8-hour

average for dose

 ELSE ! If beyond first 8 hours

 HourSeq(I)%Run8Exp = HourSeq(I-1)%Run8Exp + &

 (HourSeq(I)%Exposure-HourSeq(I-8)%Exposure)/8. ! Add new hour and drop off

old

 IF(Dose) HourSeq(I)%Run8Dose = HourSeq(I-1)%Run8Dose + &

 (HourSeq(I)%Dose-HourSeq(I-8)%Dose)/8. ! Add new hour and drop off old

 ENDIF ! End of running 8-hour logic

 ENDDO ! Continue with next hour

 DO I=1,NumDays ! Loop over days in simulation

 X = MAXVAL(HourSeq(24*I-23:24*I)%Exposure) ! Find daily max 1-hour

exposure

 DO L=1,NINT(DM1HExpLev(0)) ! Loop over levels in DM1HE table

 IF (X>=DM1HExpLev(L)) DM1HExp(P,L)=DM1HExp(P,L)+1 ! Increment levels

exceeded by X 

 ENDDO ! Continue with next table level 

 ExpDose(P,I)%Max1Exp = X ! Store daily max 1-hour exposure

 X = MAXVAL(HourSeq(24*I-23:24*I)%Run8Exp) ! Find daily max 8-hour

exposure

 DO L=1,NINT(DM8HExpLev(0)) ! Loop over levels in DM8HE table

A-114
 IF (X>=DM8HExpLev(L)) DM8HExp(P,L)=DM8HExp(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level

 ExpDose(P,I)%Max8Exp = X ! Store daily max 8-hour exposure

 X = SUM(HourSeq(24*I-23:24*I)%Exposure)/24 ! Average daily exposure

 DO L=1,NINT(DAvgExpLev(0)) ! Loop over levels in DAvg table

 IF (X>=DAvgExpLev(L)) DAvgExp(P,L)=DAvgExp(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level

 ExpDose(P,I)%AvgExp = X ! Store daily average exposure

 ENDDO ! Continue with next day

 X = SUM(ExpDose(P,1:NumDays)%AvgExp)/NumDays ! Average exposure

over simulation

 DO L=1,NINT(AnnExpLev(0)) ! Loop over levels in AnnExp table

 IF (X>=AnnExpLev(L)) AnnExp(P,L)=AnnExp(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level 

 IF (Dose) THEN ! If user has set DoDose==YES

 DO I=1,NumDays ! Loop over days in simulation

 X = MAXVAL(HourSeq(24*I-23:24*I)%Dose) ! Find daily max 1-hour dose

 DO L=1,NINT(DM1HDoseLev(0)) ! Loop over levels in DM1HD

table

 IF (X>=DM1HDoseLev(L)) DM1HDose(P,L)=DM1HDose(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level

 ExpDose(P,I)%Max1Dose = X ! Store daily max 1-hour dose

 X = MAXVAL(HourSeq(24*I-23:24*I)%Run8Dose) ! Find daily max 8-hour

dose

 DO L=1,NINT(DM8HDoseLev(0)) ! Loop over levels in DM8HD

table

 IF (X>=DM8HDoseLev(L)) DM8HDose(P,L)=DM8HDose(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level

 ExpDose(P,I)%Max8Dose = X ! Store daily max 8-hour dose

 X = MAXVAL(HourSeq(24*I-23:24*I)%FDose) ! Find daily max end-of-hour

dose

 DO L=1,NINT(DMEHDoseLev(0)) ! Loop over levels in DMEHD

table

 IF (X>=DMEHDoseLev(L)) DMEHDose(P,L)=DMEHDose(P,L)+1 ! Increment

levels exceeded by X

 ENDDO ! Continue with next table level

 ExpDose(P,I)%Max1FDose = X ! Store daily max end-of-hour dose

 X = SUM(HourSeq(24*I-23:24*I)%Dose)/24 ! Average daily dose

 DO L=1,NINT(DAvgDoseLev(0)) ! Loop over levels in DAvg table

 IF (X>=DAvgDoseLev(L)) DAvgDose(P,L)=DAvgDose(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level

 ExpDose(P,I)%AvgDose = X ! Store daily average dose 

A-115
 ENDDO ! Continue with next day

 X = SUM(ExpDose(P,1:NumDays)%AvgDose)/NumDays ! Average dose over

simulation

 DO L=1,NINT(AnnDoseLev(0)) ! Loop over AnnDose table levels

 IF (X>=AnnDoseLev(L)) AnnDose(P,L)=AnnDose(P,L)+1 ! Increment levels

exceeded by X

 ENDDO ! Continue with next table level 

 ENDIF ! End of DoDose==YES logic

 ModuleName = "Null" ! Default name for module

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE ExposureDose ! Return to main APEX program 

A-116
SUBROUTINE CalcCOHb(P) ! Called from ExposureDose

 INTEGER (KIND=IK), INTENT(IN) :: P ! Input variable (person number)

 REAL (KIND=RK), PARAMETER :: HLDNE =218. ! Haldane constant

 REAL (KIND=RK), PARAMETER :: RHBK =0.32 ! k factor (eq. E-7)

 REAL (KIND=RK), PARAMETER :: CRCMHB=0.995 ! Correction for

MetHb 

 REAL (KIND=RK) :: COHB, PM47, PICO, PCO2, DIFF, RHB0, B, Dose ! Local real

variables 

 REAL (KIND=RK) :: KT, K0, K1, D, D0, A1, Z, F1, F2, F3, F4 ! Local real variables

 INTEGER (KIND=IK) :: Day, I, J, N, DayOneEvents, NPieces ! Local integer variables

 ! Globals needed: Altitude, COHbFact, HourSeq, IK, NumEvents, Phys, RK

 ! Globals altered: EventSeq, ProcName

 ! Intrinsic procs: EXP, INT, REAL

 ! External procs: <None>

 ProcName(2) = "CalcCOHb" ! Procedure name for messages 

 PM47 = 760.*EXP(-0.0000386*Altitude)-47. ! Pressure of dry gases 

 PCO2 = 0.209*PM47-49. ! O2 Partial pressure in lungs

 RHB0 = 1.39*(Phys(P)%HMGLB*0.01)*CRCMHB ! Maximum Hb available

(sea level) 

 RHB0 = RHB0*(1.0+Phys(P)%HemFac*Altitude) ! Altitude correction for

Max Hb

 DayOneEvents=HourSeq(HOURSDAY)%LastEvent ! # of repeated events

(day one)

 COHB = 0. ! Initialize blood COHB to zero

 DO I=1-DayOneEvents,NumEvents ! Loop over events

 J=I ! J is event index 

 IF (J<1) J=J+DayOneEvents ! Repeats the first day events

 Day = EventSeq(J)%Day ! Day for event J

 PICO = PM47*EventSeq(J)%Exposure*1.E-6 ! Partial pressure of CO 

 DIFF = Phys(P)%Diff + 0.000845*EventSeq(J)%VA - 5.7 ! Adjusted lung diffusivity

 B = (1./DIFF)+(PM47/EventSeq(J)%VA) ! A term used twice, below

 K0 = (PersonDay(Day)%EndGn+PICO/B)/(RHB0*Phys(P)%Blood) ! CO takeup rate

 K1 = (1.+RHBK*PCO2)/(RHBK*RHB0*HLDNE*B*Phys(P)%Blood) ! O2 takeup

rate

 A1 = K1/(K0+K1) ! Equilibrium CO fraction

 KT = (K0+K1)*REAL(EventSeq(J)%Duration) ! Scaled event duration 

 Dose = 0. ! Initialise integral for dose

 Npieces = 1+INT(COHbFact*KT/(1.-COHB/100.)**2) ! Number of subevents to

use

 DO N=1, Npieces ! Loop over subevents (usually 1)

 D0 = 1.-COHB/100. ! Percent non-COHb at start

 D = D0-A1 ! Reciprocal time constant

 Z = KT/(D0*D0*REAL(NPieces)) ! Dimensionless duration of event

 F1 = 100.*D0*D*Z ! Linear Taylor's series term

 F2 = -F1*A1*Z/2. ! Quadratic Taylor's series term

 F3 = F2*(2.*D-A1)*Z/3. ! Cubic Taylor's series term

 F4 = F2*(A1*A1-8.*A1*D+6.*D*D)*Z*Z/12. ! Quartic Taylor's series term

 Dose = Dose + COHB + F1/2. + F2/3. + F3/4. + F4/5. ! Accumulate average COHB 

A-117
 COHB = COHB + F1 + F2 + F3 + F4 ! COHB at end of subevent

 ENDDO ! Continue with next subevent

 EventSeq(J)%Dose = Dose/REAL(NPieces) ! Assign mean COHB to result

 EventSeq(J)%FDose = COHB ! Final dose is final COHB value

 ENDDO ! Continue with next event

 ProcName(2) = "Null" ! Default procedure name

END SUBROUTINE CalcCOHb ! Return to ExposureDose

A-118
SUBROUTINE Output(P) ! Called from main APEX program

 INTEGER (KIND=IK), INTENT(IN) :: P ! Input variable (profile number)

 INTEGER (KIND=IK) :: I, Z ! Local integer variable

 CHARACTER*40 :: HH1='Person Day# Year Mn Dy Wkd Tmp Hou' ! Part 1 of Hourly

file header

 CHARACTER*40 :: HH2='r1 Hour2 Hour3 Hour4 Hou' ! Part 2 of Hourly file

header

 CHARACTER*40 :: HH3='r2 Hour6 Hour7 Hour8 Hou' ! Part 3 of Hourly file

header

 CHARACTER*40 :: HH4='r3 Hour10 Hour11 Hour12 Hour' ! Part 4 of Hourly file

header

 CHARACTER*40 :: HH5='13 Hour14 Hour15 Hour16 Hour' ! Part 5 of Hourly file

header

 CHARACTER*40 :: HH6='17 Hour18 Hour19 Hour20 Hour' ! Part 6 of Hourly file

header

 CHARACTER*34 :: HH7='21 Hour22 Hour23 Hour24 ' ! Part 7 of Hourly file

header

 CHARACTER*40 :: HP1=' Person HSect WSect HDis WDis Zone DGRP' ! Part 1 of

Personal file header

 CHARACTER*40 :: HP2=' Age Gender Race Empl Stove Pilot ACH' ! Part 2 of Personal

file header 

 CHARACTER*40 :: HP3='om ACCar Height Weight Hemoglob Dif' ! Part 3 of Personal

file header

 CHARACTER*40 :: HP4='fday BloodVol HemFac Endgn1 Endgn2' ! Part 4 of Personal

file header

 CHARACTER*40 :: HP5=' #Events AvgExp AvgDose Ma' ! Part 5 of Personal file

header 

 CHARACTER*16 :: HP6='xExp MaxDose' ! Part 6 of Personal file header

 CHARACTER*40 :: HM1=' Person Micro# Minutes Mean' ! Part 1 of Micro file

header

 CHARACTER*20 :: HM2='Conc MaxConc ' ! Part 2 of Micro file header

 ! Globals needed: ACTEXT, DAYOFWEEK, DaySeq, DoDose, EMPTEXT, FName,

GASTEXT, HDoseU, HExpU, 

 ! HourlyOut, HOURSDAY, HourSeq, IK, LogU, MSumU, NumDays, NumProfiles, 

 ! NumPools, NumDistricts, Person, PSumU, RACETEXT, RK,SEXTEXT, YES

 ! Globals altered: Ios, ModuleName, ProcName

 ! Intrinsic procs: CLOSE, MAXVAL, OPEN, REAL, SUM, WRITE

 ! External procs: <None>

 ModuleName = "ExposureDoseModule" ! Module name for messages

 ProcName(1) = "Output" ! Procedure name for messages

 IF (P==1) THEN ! Do the first time called only

 IF (HourlyOut==YES) THEN ! If user wants hourly output

 OPEN(HExpU,File=FName(HExpU),IOSTAT=Ios(HExpU), &

 RECL=274,ACTION='WRITE') ! Open the hourly exposure file

 WRITE(HExpU,'(A274)') HH1//HH2//HH3//HH4//HH5//HH6//HH7 ! Write hourly file

header

 IF (DoDose==YES) THEN ! If user wants dose calculation

 OPEN(HDoseU,File=FName(HDoseU),IOSTAT=Ios(HDoseU), & 

A-119
 RECL=274,ACTION='WRITE') ! Open the hourly dose file

 WRITE(HDoseU,'(A274)') HH1//HH2//HH3//HH4//HH5//HH6//HH7 ! Write hourly file

header

 ENDIF ! End of DoDose logic block

 ENDIF ! End of HourlyOut logic block

 OPEN(PSumU,File=FName(PSumU),IOSTAT=Ios(PSumU), &

 RECL=216,ACTION='WRITE') ! Open personal output file 

 WRITE(PSumU, '(A216)') HP1//HP2//HP3//HP4//HP5//HP6 ! Write personal file

header

 OPEN(MSumU,File=FName(MSumU),IOSTAT=Ios(MSumU), & 

 RECL= 60,ACTION='WRITE') ! Open micro output file

 WRITE(MSumU, '(A60)' ) HM1//HM2 ! Write micro file header

 ENDIF ! End of P=1 logic block

 IF (HourlyOut==YES) THEN ! If user wants hourly output

 Z = SList(Person(P)%HomeSec)%NumZ

 DO I=1,NumDays ! Loop over days

 WRITE(HExpU, '(3I6,2I3,1X,A3,I4,24E10.3)') P,I, & 

 Calen(I)%Year, Calen(I)%Month, Calen(I)%Day, &

 DAYOFWEEK(Calen(I)%DayOfWeek), TemData(I,Z)%MaxTemp, & 

 HourSeq(HOURSDAY*(I-1)+1:HOURSDAY*I)%Exposure ! Write date & 24

exposures

 ENDDO ! Continue with next day

 IF (DoDose==YES) THEN ! If dose output required

 DO I=1,NumDays ! Loop over days

 WRITE(HDoseU,'(3I6,2I3,1X,A3,I4,24E10.3)') P,I, & 

 Calen(I)%Year,Calen(I)%Month,Calen(I)%Day, &

 DAYOFWEEK(Calen(I)%DayOfWeek), TemData(I,Z)%MaxTemp, & 

 HourSeq(HOURSDAY*(I-1)+1:HOURSDAY*I)%Dose ! Write date & 24

doses

 ENDDO ! Continue with next day

 ENDIF ! End of dose output block 

 ENDIF ! End of hourly output block

 WRITE(PSumU,'(I8,2I6,5I5,1X,7A6,4F9.3,F9.2,3F9.6,I8,4E12.4)') &

 P, Person(P)%HomeSec, Person(P)%WorkSec, Person(P)%HomeD, &

 Person(P)%WorkD, Person(P)%Zone, Person(P)%DGRP, &

 Person(P)%Age, SEXTEXT(Person(P)%Gender), & 

 RACETEXT(Person(P)%Race), EMPTEXT(Person(P)%Employed), &

 GASTEXT(Person(P)%GasStove), PILOTTEXT(Person(P)%GasPilot), &

 ACTEXT(Person(P)%AC_Home), ACTEXT(Person(P)%AC_Car), &

 Phys(P)%Height,Phys(P)%Weight,Phys(P)%Hmglb,Phys(P)%Diff, &

 Phys(P)%Blood,Phys(P)%HemFac,Phys(P)%Endgn1,Phys(P)%Endgn2, & 

 NumEvents, SUM(HourSeq(:)%Exposure)/REAL(NumHours), & 

 SUM(HourSeq(:)%Dose)/REAL(NumHours), &

 MAXVAL(HourSeq(:)%Exposure), MAXVAL(HourSeq(:)%Dose) ! Write personal

data

 DO I=1,NumMicros ! Loop over micros

 WRITE(MSumU,'(2I10,I12,2F12.6)') P,I,MSum(I,P)%Minutes, & 

 MSum(I,P)%MeanConc, MSum(I,P)%MaxConc ! Write micro data

A-120
 ENDDO ! Continue with next micro

 PRINT*, 'Finished output for profile #', P ! Put person counter on screen

 IF (P==NumProfiles) THEN ! If finished then cleanup

 CLOSE (HExpU) ! Close hourly exposure file

 IF (DoDose==YES) CLOSE (HDoseU) ! Close hourly dose file

 CLOSE (PSumU) ! Close personal file

 CLOSE (MSumU) ! Close micro file

 ENDIF ! End of file cleanup

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE Output ! Return to main APEX program

A-121
SUBROUTINE FinalSummary ! Called from main APEX program

 INTEGER (KIND=IK) :: ClockRate, ClockMax, I, J, K, M, N, U, Width ! Local integer

variables

 REAL (KIND=RK) :: JobTime, Cumul, D1, D2 ! Local real variables

 CHARACTER (LEN=1),ALLOCATABLE :: C(:) ! Dynamic array of dashes 

 CHARACTER*40 :: TFI, TFR, TFH ! Formats for writing table rows 

 CHARACTER*6 :: FM = '(2I12)' ! Format for listing data on log

 ! Globals needed: DaySeq, DM1HDoseLev, DM1HExpLev, DM8HDoseLev, DM8HExpLev,

DoDose,

 ! ExpTime, ExpTimeLev, IK, LONG, LogU, NUMAGES, NumDistricts,

NUMGENDERS, 

 ! NumMicros, NumPools, NUMRACES, NumProfiles, Person, RK, YES

 ! Globals altered: Clock, ModuleName, ProcName

 ! Intrinsic procs: ALLOCATE, CLOSE, COUNT, NINT, REAL, SIZE, SUM,

SYSTEM_CLOCK, WRITE

 ! External procs: WriteTables

 ModuleName = "ExposureDoseModule" ! Module name for messages

 ProcName(1) = "FinalSummary" ! Procedure name for messages

 WRITE(LogU,*) 'Home District counts' ! # persons per home district

 WRITE(LogU,FM) ((I,COUNT(Person%HomeD==I)),I=1,NumDistricts) ! Write # persons

living here 

 WRITE(LogU,*) 'Work District counts' ! # persons per work district

 WRITE(LogU,FM) ((I,COUNT(Person%WorkD==I)),I=1,NumDistricts) ! Write # persons

working here 

 WRITE(LogU,*) 'Age counts' ! # persons of each year of age

 WRITE(LogU,FM) ((I,COUNT(Person%Age==I)),I=0,NUMAGES-1) ! Write # persons

of that age

 WRITE(LogU,*) 'Gender counts' ! # persons of each gender

 WRITE(LogU,FM) ((I,COUNT(Person%Gender==I)),I=1,NUMGENDERS+1) ! Write #

persons of each gender

 WRITE(LogU,*) 'Race counts' ! # persons of each race

 WRITE(LogU,FM) ((I,COUNT(Person%Race==I)),I=1,NUMRACES+1) ! Write # of

that race

 WRITE(LogU,*) 'Employment counts' ! # persons employed/unemployed

 WRITE(LogU,FM) ((I,COUNT(Person%Employed==I)),I=1,3) ! # persons of that

status

 WRITE(LogU,*) 'GasStove counts' ! # persons with/without gas stove

 WRITE(LogU,FM) ((I,COUNT(Person%GasStove==I)),I=1,3) ! Write # of that status

 WRITE(LogU,*) 'Has AC counts' ! # persons of each A/C status

 WRITE(LogU,FM) ((I,COUNT(Person%AC_Home==I)),I=1,3) ! Write # of that

status

 K = NINT(DM1HExpLev(0)) ! # of levels in current table

 IF (NumProfiles<=20) THEN ! Write data only if <=20 profiles

 WRITE(TFI,'(A1,I3,A3)') '(',K+1,'I8)' ! Create format for writing table

 WRITE(LogU,*) ! Put blank line on log

 WRITE(LogU,*) "Frequency for each DM1H level by person" ! Write table header to

log

A-122
 DO I=1, NumProfiles ! Loop over profiles

 WRITE(LogU,TFI) I,(DM1HExp(I,J),J=1,K) ! Write # days for each level

 ENDDO ! Continue with next profile

 ENDIF ! End of logic for <=20 profiles

 K = NINT(ExpTimeLev(0)) ! # of levels in next table

 N = NumProfiles ! # of profiles to sum across

 WRITE(TFI,'(A22,I3,A6)') '(I4,A10,F14.0,3F12.0,',K-4,'F10.0)' ! Integer format for

ExpTime table

 WRITE(TFR,'(A22,I3,A6)') '(I4,A10,F14.4,3F12.4,',K-4,'F10.4)' ! Real format for ExpTime

table

 WRITE(TFH,'(A22,I3,A6)') '(4X,A10,F14.4,3F12.4,',K-4,'F10.4)' ! Level format for

ExpTime table

 Width = 10*K + 16 ! Width of data part of table

 ALLOCATE (C(Width)) ! Buffer for writing dashes

 C = "-" ! Fill buffer with dashes

 OPEN(TabU,FILE=FName(TabU),RECL=LEN3,IOSTAT=Ios(TabU), &

 ACTION='WRITE') ! Open the output tables file

 DO I=1,2 ! Loop over output units

 IF (I==1) U=LogU ! First loop writes to log file 

 IF (I==2) U=TabU ! Second loop writes to table file 

 WRITE(U,'(///,A76,I8,A9,/)') " Non-cumulative " &

 //"minutes at each exposure level by microenvironment," &

 //" for N =",N," Profiles" ! Header for exposure time table

 WRITE(U,TFH) " Level:",(ExpTimeLev(J),J=1,K) ! Write table levels

 WRITE(U,*) "Micro ",C ! Write line of dashes

 D1 = SUM(ExpTime)/100. ! Total time for % calculations

 DO M=0,NumMicros ! Loop over microenvironments 

 D2 = SUM(ExpTime(M,:))/100. ! Total time in this micro,as 1/%

 WRITE(U,TFI) M," Minutes",(ExpTime(M,J),J=1,K) ! Minutes at this level &

micro

 WRITE(U,TFR) M," Row_%",(ExpTime(M,J)/D2,J=1,K) ! Percentage of this row

 WRITE(U,TFR) M," Tot_%",(ExpTime(M,J)/D1,J=1,K) ! Percentage of total

across rows

 ENDDO ! Continue with next micro

 WRITE(U,*) '-------',C ! Write line of dashes

 WRITE(U,'(///,A72,I8,A9,/)') " Cumulative " &

 //"minutes at each exposure level by microenvironment," &

 //" for N =",N," Profiles" ! Header for cumul. ExpTime table 

 WRITE(U,TFH) " Level:",(ExpTimeLev(J),J=1,K) ! Write table levels

 WRITE(U,*) "Micro ",C ! Write line of dashes

 DO M=0,NumMicros ! Loop over microenvironments 

 Cumul = 0. ! Initialize cumulative total

 DO J=K,1,-1 ! Loop downwards over table levels

 Cumul = Cumul + ExpTime(M,J) ! Accumulate data in table

 ExpTime(M,J) = Cumul ! Replace data in old table 

 ENDDO ! Continue with next table level

 D2 = ExpTime(M,1)/100. ! Total time in this micro,as 1/%

A-123
 WRITE(U,TFI) M," Minutes",(ExpTime(M,J),J=1,K) ! Minutes at this level &

micro

 WRITE(U,TFR) M," Row_%",(ExpTime(M,J)/D2,J=1,K) ! Percentage of this row

 WRITE(U,TFR) M," Tot_%",(ExpTime(M,J)/D1,J=1,K) ! Percentage of total

across rows

 ENDDO ! Continue with next micro 

 WRITE(U,*) '-------',C ! Write line of dashes

 ENDDO ! Continue with next output unit

 WRITE(Header,'(A67,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Max 1-Hour Exposure levels for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for DM1HExp table

 K = NINT(DM1HExpLev(0)) ! # of levels in DM1HExp table

 N = SIZE(DM1HExp,1) ! # of statistics in this table

 Array(1:N,1:K) = REAL(DM1HExp,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(DM1HExpLev(1:K),LONG) ! Fill level buffer with

data

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A67,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Max 8-Hour Exposure levels for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for DM8HExp table

 K = NINT(DM8HExpLev(0)) ! # of levels in DM8HExp table

 N = SIZE(DM8HExp,1) ! # of statistics in this table

 Array(1:N,1:K) = REAL(DM8HExp,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(DM8HExpLev(1:K),LONG) ! Fill level buffer with

data 

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A64,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Average Exposure levels for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for DAvgExp table

 K = NINT(DAvgExpLev(0)) ! # of levels in DAvgExp table

 N = SIZE(DAvgExp,1) ! # of statistics in this table

 Array(1:N,1:K) = REAL(DAvgExp,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(DAvgExpLev(1:K),LONG) ! Fill level buffer with data 

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A69,I8,A34,I8)')" Cumulative # Persons at each" &

 //" Overall Average Exposure level for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for AnnExp table

 K = NINT(AnnExpLev(0)) ! # of levels in AnnExp table

 N = SIZE(AnnExp,1) ! # of statistics in this table

 Array(1:N,1:K) = REAL(AnnExp,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(AnnExpLev(1:K),LONG) ! Fill level buffer with data 

 CALL WriteTables(N,K,1,NO) ! Code is in ExposureDoseModule

 IF (DoDose==YES) THEN ! If user asked for doses ...

 WRITE(Header,'(A68,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Max End-of-Hour Dose levels for N =",N, &

A-124
 " Profiles, with Area Population = ", TotPop ! Header for DMEHDose table

 K = NINT(DMEHDoseLev(0)) ! # of levels in DMEHDose table

 N = SIZE(DMEHDose,1) ! # of statistics in this table 

 Array(1:N,1:K) = REAL(DMEHDose,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(DMEHDoseLev(1:K),LONG) ! Fill level buffer with

data 

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A63,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Max 1-Hour Dose levels for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for DM1HDose table

 K = NINT(DM1HDoseLev(0)) ! # of levels in DM1HDose table

 N = SIZE(DM1HDose,1) ! # of statistics in this table 

 Array(1:N,1:K) = REAL(DM1HDose,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(DM1HDoseLev(1:K),LONG) ! Fill level buffer with

data 

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A63,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Max 8-Hour Dose levels for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for DM8HDose table

 K = NINT(DM8HDoseLev(0)) ! # of levels in DM8HDose table

 N = SIZE(DM8HDose,1) ! # of statistics in this table 

 Array(1:N,1:K) = REAL(DM8HDose,LONG) ! Fill table buffer with data

 TableLev(1:K) = DM8HDoseLev(1:K) ! Fill level buffer with data 

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A60,I8,A34,I8)')" Cumulative Person-days " &

 //"of Daily Average Dose levels for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for DAvgDose table

 K = NINT(DAvgDoseLev(0)) ! # of levels in DAvgDose table

 N = SIZE(DAvgDose,1) ! # of statistics in this table 

 Array(1:N,1:K) = REAL(DAvgDose,LONG) ! Fill table buffer with data

 TableLev(1:K) = DAvgDoseLev(1:K) ! Fill level buffer with data 

 CALL WriteTables(N,K,NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A64,I8,A34,I8)')" Cumulative # Persons " &

 //"at each Overall Average Dose level for N =",N, &

 " Profiles, with Area Population = ", TotPop ! Header for AnnDose table

 K = NINT(AnnDoseLev(0)) ! # of levels in AnnDose table

 N = SIZE(AnnDose,1) ! # of statistics in this table

 Array(1:N,1:K) = REAL(AnnDose,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(AnnDoseLev(1:K),LONG) ! Fill level buffer with data 

 CALL WriteTables(N,K,1,NO) ! Code is in ExposureDoseModule

 WRITE(Header,'(A51,I8,A33,I8)') " Non-cumulative minutes " &

 //"at each dose level, for N =",N," Profiles, with " &

 //"Area Population = ",TotPop ! Header for DoseTime table

 K = NINT(DoseTimeLev(0)) ! # of levels in DoseTime table

A-125
 N = SIZE(DoseTime,1) ! # of statistics in this table 

 Array(1:N,1:K) = REAL(DoseTime,LONG) ! Fill table buffer with data

 TableLev(1:K) = REAL(DoseTimeLev(1:K),LONG) ! Fill level buffer with data 

 CALL WriteTables(N,K,1440*NumDays,YES) ! Code is in

ExposureDoseModule

 WRITE(Header,'(A47,I8,A33,I8)') " Cumulative minutes " &

 //"at each dose level, for N =",N," Profiles, with " &

 //"Area Population = ",TotPop ! Header for cumul. DoseTime table

 DO I=1,N ! Loop over statistics

 Cumul = 0. ! Initialize cumulative total

 DO J=K,1,-1 ! Loop downwards over table levels

 Cumul = Cumul + Array(I,J) ! Accumulate data in table

 Array(I,J) = Cumul ! Replace data in old table 

 ENDDO ! Continue with next table level

 ENDDO ! Continue with next statistic

 CALL WriteTables(N,K,1440*NumDays,YES) ! Code is in

ExposureDoseModule

 ENDIF ! End of DoDose==Yes logic block 

 CLOSE(TabU) ! Close the output tables file

 WRITE(LogU,*) ! Put blank line on log

 CALL SYSTEM_CLOCK(Clock(2),ClockRate, ClockMax) ! Find job stop time

 JobTime = REAL(Clock(2)-Clock(1))/REAL(ClockRate) ! Elapsed time in seconds

 IF (Jobtime<0) JobTime=JobTime+REAL(ClockMax)/REAL(ClockRate) ! Fix if clock was

reset

 WRITE(LogU,*) ' Job Stop Time = ',Clock(2) ! Put final job time on log

 WRITE(LogU,*) ' Job Duration = ',JobTime, ' seconds' ! Put elapsed time on log

 CLOSE(LogU) ! Close the log file

 ModuleName = "Null" ! Default module name

 ProcName(1) = "Null" ! Default procedure name

END SUBROUTINE FinalSummary ! Return to main APEX module

A-126
SUBROUTINE WriteTables(N,K,Values,ByPerson) ! Called from

FinalSummary

 INTEGER (KIND=IK), INTENT(In) :: N, K, Values, ByPerson ! Input parameters

 INTEGER (KIND=IK) :: I, J , Width , NP, NU, U ! Local integer variables

 REAL (KIND=RK) :: D1, D2, D3, Pop ! Local real variables

 CHARACTER*40 :: TFI, TFR, TFE, TFP ! Local character variables

 CHARACTER (LEN=1), ALLOCATABLE :: C(:) ! Buffer for writing dashes

 REAL (KIND=LONG), ALLOCATABLE :: SR(:,:) ! Real array sums for

tables 

 REAL (KIND=LONG), ALLOCATABLE :: X(:) ! Buffer for one row of

Array

 INTEGER (KIND=IK), ALLOCATABLE :: SI(:) ! Integer array sums for

tables 

 ! Globals needed: Array, IK, LONG, LogU, Percs, RK, TableLev, TotPop, YES 

 ! Globals altered: Pctl, ProcName

 ! Intrinsic procs: ALLOCATE, COUNT, MAX, MAXVAL, MINVAL, NINT, REAL, SQRT,

SUM, WRITE

 ! External procs: Percentiles

 ProcName(2) = "WriteTables" ! Procedure name for messages

 Width = 10*K + 24 ! Width of data part of table

 ALLOCATE (C(Width)) ! Buffer for line of dashes

 ALLOCATE (SR(5,K),SI(K),X(N)) ! Buffers for array sums

 C = "-" ! Fill buffer with dashes

 D1 = REAL(N) ! Sample size, used in Std. Dev.

 D2 = REAL(Values)/100.0 ! Sum of elements for one profile

 D3 = D1*D2 ! Sum of all elements 

 NP = NINT(Pctl(0)) ! Number of percentiles to print

 Pop = REAL(TotPop) ! Population of study area

 DO J=1,K ! Loop over table levels

 X = Array(1:N,J) ! Copy table row into buffer 

 SR(1,J) = SUM(X) ! Sum over profiles

 SR(2,J) = SQRT((SUM(X**2)-SR(1,J)**2/D1)/(D1-1.)) ! Std. dev. across profiles

 SR(3,J) = D1*SR(2,J)/MAX(SR(1,J),1.) ! CV across profiles

 SR(4,J) = MINVAL(X) ! Minimum value across profiles

 SR(5,J) = MAXVAL(X) ! Maximum value across profiles

 SI(J) = COUNT(X>0.) ! Count of profiles above zero

 CALL Percentiles(X,N,Pctl(1:),NP,Percs(:,J)) ! Code is in DistributionModule 

 ENDDO ! Continue with next table level

 WRITE(TFI,'(A23,I3,A6)') '(A13,2I14 ,2I12 ,',K-4,'I10) ' ! Format for integer data

 WRITE(TFR,'(A23,I3,A6)') '(A13,2F14.3,2F12.3,',K-4,'F10.3)' ! Format for real decimal

data

 WRITE(TFE,'(A23,I3,A6)') '(A13,2E14.3,2E12.3,',K-4,'E10.3)' ! Format for exponential

data

 WRITE(TFP,'(A23,I3,A6)') '(F5.1,A8,2F14.3,2F12.3,',K-4,'F10.3)' ! Format for percentile

data

 DO NU=1,2 ! Loop over output units

 IF (NU==1) U=LogU ! First loop writes to log file

 IF (NU==2) U=TabU ! Second loop writes to table file

A-127
 WRITE(U,'(///,A120,/)') Header ! Write the table header

 WRITE(U,TFR) " Level: ",(TableLev(J),J=1,K) ! Write the table levels

 WRITE(U,*) C ! Write a line of dashes

 WRITE(U,TFE) " Counts(Pop):",(Pop*SR(1,J)/D1,J=1,K) ! Write the sum for the

population

 WRITE(U,TFI) " #Doers(Pop):",(NINT(Pop*SI(J)/D1),J=1,K) ! Write the # > 0 in

population

 WRITE(U,TFR) " %Doers(Pop):",(100.*SI(J)/D1,J=1,K) ! Percentage of population

> 0

 IF (ByPerson==YES) THEN ! If table shows stats by person

 WRITE(U,TFR) " Mean :",(SR(1,J)/D1,J=1,K) ! Mean across population

 WRITE(U,TFR) " Std.Dev. :",(SR(2,J),J=1,K) ! Standard deviation across pop.

 WRITE(U,TFR) " CV :",(SR(3,J),J=1,K) ! Coefficient of variation for pop

 WRITE(U,TFR) " Minimum :",(SR(4,J),J=1,K) ! Minimum for this sample

 DO I=1,Pctl(0) ! Loop over chosen percentiles

 WRITE(U,TFP) Pctl(I)," %ile :",(Percs(I,J),J=1,K) ! Write percentile for each level

 ENDDO ! Continue with next percentile

 WRITE(U,TFR) " Maximum :",(SR(5,J),J=1,K) ! Maximum for this sample

 WRITE(U,TFR) " Mean (%) :",(SR(1,J)/D3,J=1,K) ! Mean as % of possible

values

 WRITE(U,TFR) " Min (%) :",(SR(4,J)/D2,J=1,K) ! Minimum as % of possible

values 

 WRITE(U,TFR) " Max (%) :",(SR(5,J)/D2,J=1,K) ! Maximum as % of possible

values

 ENDIF ! End of stats by person

 WRITE(U,TFE) " Counts(Sim):",(SR(1,J),J=1,K) ! Sum across simulated

individuals

 WRITE(U,TFI) " #Doers(Sim):",(SI(J),J=1,K) ! # of simulated persons > 0

 WRITE(U,*) C ! Write line of dashes

 ENDDO ! Continue with next output unit 

 ProcName(2) = "Null" ! Default procedure name

END SUBROUTINE WriteTables ! Return to FinalSummary

END MODULE ExposureDoseModule ! End of source code for module

A-128