-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathnesting.f
150 lines (150 loc) · 3.76 KB
/
nesting.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
subroutine nesting
c
c-----CAMx v4.02 030709
c
c NESTING is the driver for grid nesting algorithm. It does the
c following tasks in a recursive order:
c 1. determines boundary conditions for children grids
c 2. calls EMISTRNS for each grid
c 3. calls CHEMRXN for each grid
c 4. aggregates concentrations on children grids to parent grid
c Chemistry and transport are performed for each grid on their own
c time step. Up to 4 generations of grid nesting are currently allowed.
c
c Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
c ENVIRON International Corporation
c
c Modifications:
c none
c
c Input arguments:
c none
c
c Output arguments:
c none
c
c Subroutines Called:
c SETBC
c EMISTRNS
c CHEMRXN
c AGGR00
c FGAVRG
c
c Called by:
c CAMx
c
include "camx.prm"
include "grid.com"
c
dimension iparnt(20),igrd0(20)
c
c-----Entry point
c
c-----Computation for children grids
c
do igen=1,20
iparnt(igen)=0
igrd0(igen)=0
enddo
c
c-----Generation 2
c
igen=1
iparnt(igen+1)=1
call setbc(iparnt(igen+1))
mch2=nchdrn(iparnt(igen+1))
do 100 ic2=1,mch2
igen=2
igrd0(igen)=idchdrn(ic2,iparnt(igen))
c
c-----Perform emissions and transport for generation 2
c
do 99 it2=1,ntim(igrd0(igen))
call fgavrg(igrd0(igen))
call emistrns(igrd0(igen))
c
c-----Generation 3
c
iparnt(igen+1)=igrd0(igen)
call setbc(iparnt(igen+1))
mch3=nchdrn(iparnt(igen+1))
do 90 ic3=1,mch3
igen=3
igrd0(igen)=idchdrn(ic3,iparnt(igen))
c
c-----Perform emissions and transport for generation 3
c
do 89 it3=1,ntim(igrd0(igen))
call fgavrg(igrd0(igen))
call emistrns(igrd0(igen))
c
c-----Generation 4
c
iparnt(igen+1)=igrd0(igen)
call setbc(iparnt(igen+1))
mch4=nchdrn(iparnt(igen+1))
do 80 ic4=1,mch4
igen=4
igrd0(igen)=idchdrn(ic4,iparnt(igen))
c
c-----Perform emissions and transport for generation 4
c
do 79 it4=1,ntim(igrd0(igen))
call fgavrg(igrd0(igen))
call emistrns(igrd0(igen))
c
c-----Generation X: more generations would be added here
c
c-----Perform chemistry for generation 4
c
igen=4
call chemrxn(igrd0(igen))
call fgavrg(igrd0(igen))
79 continue
icode = 3
if (mch4.eq.1) then
icode = 0
elseif (ic4.eq.1) then
icode = 1
elseif (ic4.eq.mch4) then
icode = 2
endif
call aggr00(igrd0(igen),iparnt(igen),icode)
80 continue
c
c-----Perform chemistry for generation 3
c
igen=3
call chemrxn(igrd0(igen))
call fgavrg(igrd0(igen))
89 continue
icode = 3
if (mch3.eq.1) then
icode = 0
elseif (ic3.eq.1) then
icode = 1
elseif (ic3.eq.mch3) then
icode = 2
endif
call aggr00(igrd0(igen),iparnt(igen),icode)
90 continue
c
c-----Perform chemistry for generation 4
c
igen=2
call chemrxn(igrd0(igen))
call fgavrg(igrd0(igen))
99 continue
icode = 3
if (mch2.eq.1) then
icode = 0
elseif (ic2.eq.1) then
icode = 1
elseif (ic2.eq.mch2) then
icode = 2
endif
call aggr00(igrd0(igen),iparnt(igen),icode)
100 continue
c
return
end