## 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 27709Table 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-38Table 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-77Introduction

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 te sted 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.

1The 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 di stricts, 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.

2Microenvironmental 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.

31) The MASSBAL method

The MASSBAL method uses a mass-balance algorithm with a one-hour time step. For reasonsdiscussed 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 turndepends 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 Pr oximity, 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.

4If 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 + (PrevC onc-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

5The 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 * Pe netration) + 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 f ile. Another input file contains the mapping from CHAD codes to APEX micros. That mapping must use the same set (or a subset) of the

6micros 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

7The 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 (m 3 ) - 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 theweek, 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

8are 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 presen ted 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

9occurred, in chronological order. Thus, the firs t 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 H BR(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

10DO 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, th en 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'.

114) 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 bl ocks 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 di strict 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

12The 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, witha 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

13Some 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.

145) 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 MPinput 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

15B = 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 da ily-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 vect or. 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

16would 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 menti oned 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), INTEN T(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

17NC1 = 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 Distri b(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

19each 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 distributi on. 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 Distri b(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 mi ght 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 Distri b(MDPtr=Ptr,RRes=Buffer(N,1:DSS(N)))
ENDDO DO I = 1, NumDays D = TS(I) DR = TSR(I) DO H=1, 24

21B = 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

22balance 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.

23ESum 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.

249) 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 incorporat e 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 stru cture 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

25The 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)

26since 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 s ection 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 tw o sets of PARAMETER definitions, the first of which already exists in APEX2.

INTEGER (KIND=IK), PA RAMETER :: 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

27made 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.

28For 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

299-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=Bu ffer(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))

30and 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.

31Point (9-7) needs some explanation. It is eas y 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. Proxi mity 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)*MP V(:,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 + (PrevC onc-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

32AirExRate 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

33Conditional 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

34REAL (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 de fine 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. Othe r variables could then be added as needed. The actual DaySeq structure could refer to this data via pointers set to the appropriate district. Either

35way, 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:

36Add 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

37Conditional 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 vari able 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 w ith 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.

38One 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 prof ile 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 thos e 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, Prof ileModule, 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.

39DaySeq 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

40MaxTemp(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

41TYPE :: 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)

42INTEGER (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), TARG ET, 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.

43Modification 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 improvementwould 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

44solution, 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’ canbe 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 theend 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.

45Descriptions 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 vers ion 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), andassuming 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

46N(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

47APEX 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 2A0 - D0 2A1 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) z 2/ 2 + N```(0) z 3 / 6 + N iv(0) z 4/ 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.

48The value of N(0) is known (it is the %COHb leve l 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 2A0 - 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) 2A1 N`(z) / [ (100-N(z) ] 2 (14)

N``(0) = - A1 N`(0) (15)

N```(z) = -(100 D0) 2A1 N``(z)/[(100-N(z)] 2- 2 (100 D0) 2A1 N`(z) 2/[(100-N(z)] 3 (16)

N```(0) = (2D - A1) N``(0) (17)

N iv (z) = - (100 D0) 2A1 [(100-N(z))N```(z) +3 N`(z) N``(z) ] / [(100-N(z)] 3 - 3 (100 D0) 2A1 N`(z) [(100-N(z))N``(z)+2 N`(z) 2] / [(100-N(z)] 4 (18)

N iv (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 z 2/ 2 +100 A1 D0 D (A1-2D) z 3 / 6 (20)

T4(z) = T3(z) - 100 A1 D0 D (A1 2- 8 D A1 + 6 D 2 ) z 4 / 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

49equation (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 s lightly 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 notedthat 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.

50Table 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

51Table 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

52Taylor, 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.

532) ‘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, 3 rd ’ refers to a Taylor’s series keeping terms up to third order (the method used in earlier versions of APEX).

9) ‘Taylor, 4 th ’ refers to method (8) with the addition of the fourth-order term.

10) ‘Taylor, 3 rd , 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, 4 th , 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 e rror is in the positive direction, while the other half of the time the error is in the negative dir ection, so over a long time the errors tend to cancel.

54However, 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 retu rned 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)

55COMMON /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. Ther e 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 ca lls. 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

56The 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”.

57The 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 i nput 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.

58To 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 PARA MS 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

59short 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 combinedto 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 s ector # -> final district #) and (final sector # -> final zone #) mappings.

60Revisions 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 work ed outside the known districts. These persons could be reassigned to a known district, or si mply 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 GenerateProf iles 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 efficien cy 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 awkw ard if the array of 500 profiles had gaps where profiles were deleted. Hence, the Generate Profiles 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.

61Creation of the nationwide Commuting file

The source of the data used to create the nati onwide 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 fo rmat 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 c ounts 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 consta nt 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 a nd distance were set to -1.0 to indicate a home
tract. The first three records on the nationwide ASCII file are as follows:

6201001020100 -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 commutingdatabase 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 c ontains 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 tr act 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 th e 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

63are 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 ar ea, 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.

64Using 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.

65Structure 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 ve rsion 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 instructi ons; 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).

66The 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 recei ves 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 conflic t 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 (thos e 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.

673) 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, U tility, 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 inparticular 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, 2002PROGRAM 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-1CALL 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-2SUBROUTINE 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, Age2 Probab, Altitude, AnnDoseLev, AnnExpLev, Clock, ! DAvgExpLev, DAvgDoseLev, DM1HDoseLev, DM1HExpLev, DM8HDoseLev, ! DM8HExpLev, DMEHDoseLev, DoDose, DoseTime, DSTAdjust, EndDate, ExpTime, ! FName, HourlyOu t, Ios, ISdAct, ISdAER, ISdD ec, 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,I OSTAT=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-3IF (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) FN ame(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-4PopCat(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-5ALLOCATE (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-6ALLOCATE (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-7IF (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-8SUBROUTINE 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-9WRITE(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 = ", Ai rRadius ! 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-10WRITE(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-11MODULE 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 :: MAXPOPTY PE = 10 ! Maximum # of gender-race combinations INTEGER(KIND=IK), PARAMETER :: MAXAGEGRPS = 100 ! Maximum # of age groups permitted INTEGER(KIND=IK), PARAMETER :: EVENTS DAY = 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-12CHARACTER(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-13INTEGER(KIND=IK), PARAMETER :: MALE=1, FEMA LE=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-14INTEGER (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-15INTEGER (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-16INTEGER (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-18REAL (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 :: SLis t(:) ! 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 :: TemD ata(:,:) ! 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-19INTEGER (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,ALLOCATA BLE :: PersonDay(:) ! Daily-varying data for current profile TYPE (EventSequence),TARGET,ALLOCATA BLE :: EventSeq(:) ! Event sequence for current profile TYPE (HourSequence), TARGET,ALLOCATABLE :: HourSeq(:) ! Hourly sequence for current profile TYPE (ExpDoseDay), TARGET,ALLOCATA BLE :: ExpDose(:,:) ! Profile-day exposures
and doses

! Variable set in MicroEnvModule REAL (KIND=RK), ALLOCATABLE :: MicroC onc(:,:,:) ! 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-20REAL (KIND=RK), ALLOCATABLE :: DoseTimeLev(:) ! Levels for dose duration
table

END MODULE GlobalModule

A-21MODULE 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-22CHARACTER (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-23SUBROUTINE 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-24IF (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 TA BLE 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-25IF (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-26IF (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-27IF (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-28SUBROUTINE 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-29MODULE 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 :: TRUNC TEXT(0:NTRUNC) = & (/"NONE","VALUE","ZVALUE","PERCENT"/) ! Text for truncation options INTEGER (KIND=IK), PARAMETER :: CONDITIONAL=1, PROBABILITY=2, &

A-30REALRANGE=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", "P OINT", "UNIFORM", "NORMAL", & "LOGNORMAL", "TRIANGLE", "EXPONENTIAL" /) ! Text for allowed distrib types INTEGER (KIND=IK) :: NumDistrib ! # of user distributions defined TYPE(Distribution), TARGET :: DistribList(MAXDI STRIB) ! List of user
distributions

CONTAINS

A-31SUBROUTINE 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, CondSi ze ! 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='R EAD',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%Descrip tion ! 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-32IF (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))==DISTTEX T(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 Fata l(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))==TRUNC TEXT(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-33C%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%M ax) 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))==TRUNC TEXT(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-34CondIndex=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(D Len),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(D Len),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-35D%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-36READ (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-37SUBROUTINE 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-38SUBROUTINE 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) :: IR es(:) ! 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-39DO 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-40IF(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-41CASE(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-42SUBROUTINE 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-43ENDDO ! Continue with next percentile
END SUBROUTINE Percentiles ! Return to WriteTables

END MODULE DistributionModule ! Last source code line in module

A-44MODULE 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-45ProcName(1) = "Null" ! Default procedure name END SUBROUTINE CalcDates ! Return to main APEX program

A-46INTEGER 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(Da yMon(1:(Month-1)))+Day ! Formula for Julian day ProcName(2) = "Null" ! Default procedure name END FUNCTION JulianDay ! Return to calling routine

A-47INTEGER FUNCTION YearMonthDay(JulianDay) ! Called within
TimeSeriesModule INTEGER (KIND=IK), INTENT(IN) :: JulianDay ! Inverse function to JulianDay() INTEGER (KIND=IK) :: Year,Month,Day,N400,N 100,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-48SUBROUTINE 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) :: SC ount, 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=Io s(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%Na me, 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-49IF (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+AirRa dius)) 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-50READ(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-51ENDDO ! 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-52SList(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, SL ist(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-53WRITE(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-54REAL 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-55SUBROUTINE 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),IOST AT=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-56ENDDO ! 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-57SUBROUTINE 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),A CTION='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-58IF (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=RBFact or*(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-59SUBROUTINE 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-60MODULE 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-61INTEGER (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), ALLOCATA BLE :: NumDiaries(:,:) ! # diaries per profile and pool INTEGER (KIND=IK), ALLOCATAB LE :: 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-62SUBROUTINE 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, Pool Vec(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),IOSTA T=Ios(ChQuU),ACTION='READ') ! Open CHAD questionnaire file OPEN (ChEvU,FILE=FName(ChEvU),IOSTA T=Ios(ChEvU),ACTION='READ') ! Open CHAD diary event file DO ! Loop until EXIT occurs READ(ChQuU,*,IOSTAT=Ios(ChQuU)) QID, CWkDay, CSex, CRace, &

A-63CEmp, 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-64DData(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-65QData(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%Empl oyed==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-66SUBROUTINE 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),IO STAT=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-67SUBROUTINE 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),IOSTA T=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-68WRITE(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-69SUBROUTINE 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)*A geCutPct/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) TH EN ! 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-70ENDIF ! 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-71SUBROUTINE CompositeDiary(P) ! Called from main APEX program INTEGER (KIND=IK), INTENT(IN) :: P ! Profile number (input) INTEGER (KIND=IK) :: I, J, K, Start, L, LO ffset, 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-72Start=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-73SUBROUTINE 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)/St Dev) ! 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-74END SUBROUTINE MetEval ! Return to CompositeDiary

END MODULE DiaryModule ! Last source code line in module

A-75MODULE 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),ALLOCATAB LE :: 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-76END SUBROUTINE SetCVList ! Return to main APEX program

A-77INTEGER 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-78SUBROUTINE 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, ALLOCA TE, 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-79CALL 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)) EmpPr ob(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-80PopCounts = 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,IOS TAT=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 Fata l(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-81PopProbs(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-82SUBROUTINE 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-83ENDDO ! 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-84SUBROUTINE 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-85Emp = 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 ra nge = ',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%GasP ilot) ! 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-86CALL 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=I 2,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-87SUBROUTINE 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),RMR I(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),R MRE(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-88NVO2MX = 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-89END SUBROUTINE GeneratePhysiology ! Return to main APEX

program

A-90SUBROUTINE 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=PersonD ay(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-91MODULE 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 :: FACT ORS=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-92INTEGER (KIND=IK), PARAMETER :: MR=6,ES=7,C S=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), ALLOCATAB LE :: 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-93SUBROUTINE 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),I OSTAT=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-94IF (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,"MA SSBAL"),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-95IF (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=Io s(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(S ubS)) 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-96MPar(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,C har1):) ! 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-97CALL 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-98SUBROUTINE 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-99MPDistr(:)%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-100SUBROUTINE 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-101R(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-102SUBROUTINE 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-103ENDDO ! 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(MD Ptr=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-104MPV(:,-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-105CALL 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-106SUBROUTINE 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-107MODULE 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), ALLOCATAB LE :: DM1HExp(:,:) ! Daily max 1-hour exposure table INTEGER (KIND=IK), ALLOCATAB LE :: DM8HExp(:,:) ! Daily max 8-hour exposure table INTEGER (KIND=IK), ALLOCATAB LE :: DAvgExp(:,:) ! Daily average exposure table INTEGER (KIND=IK), ALLOCATAB LE :: 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-108SUBROUTINE 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-109DAvgDose = 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-110SUBROUTINE 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), UpLi m, 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)+HourSe q(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-111ENDDO ! 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-112SUBROUTINE 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-113ENDDO ! 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 Fa tal(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)%E xposure)/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)%Expos ure)/8. ! Add new hour and drop off
old IF(Dose) HourSeq(I)%R un8Dose = 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-114IF (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)) DAvgDos e(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-115ENDDO ! 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)=A nnDose(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-116SUBROUTINE 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*H LDNE*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-117COHB = 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-118SUBROUTINE 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 We ight 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=FNa me(HDoseU),IOSTAT=Ios(HDoseU), &

A-119RECL=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//H P5//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)%HemF ac,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-120ENDDO ! 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-121SUBROUTINE 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-122DO 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-123WRITE(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-125N = 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-126SUBROUTINE WriteTables(N,K,Values,ByPerson) ! Called from FinalSummary INTEGER (KIND=IK), INTENT(In) :: N, K, Valu es, 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 :: S I(:) ! 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-127WRITE(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)/D 2,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