-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathaverage.f
135 lines (135 loc) · 4.55 KB
/
average.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
subroutine average(losat,igrd,dt,ncol,nrow,nlay,nlayav,
& nspav,nspc,lmap,tempk,press,conc,avcnc,ipa_cel,
& Jnuc, avJnuc)
c
c-----CAMx v4.02 030709
c
c AVERAGE computes time-averaged concentrations
c
c Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
c ENVIRON International Corporation
c
c Modifications:
c 01/30/02 --gwilson-- Added code for RTRAC probing tool
c
c Input arguments:
c losat .TRUE. if concentrations are tracer species
c igrd grid index
c dt time step for present grid concentration (s)
c ncol number of columns
c nrow number of rows
c nlay number of layers in instantaneous array
c nlayav number of layers in average array
c nspav number of average species
c nspc number of species in conc array
c lmap mapping array for average species
c tempk temperature field (K)
c press pressure field (mb)
c conc instant species concentration (umol/m3)
c avcnc average species concentration (gas=ppm,
c other=ug/m3)
c ipa_cel gridded array to identify if cell is
c in a IPRM sub-domain
c
c Output arguments:
c avcnc average species concentration (gas=ppm,
c other=ug/m3)
c
c Routines Called:
c none
c
c Called by:
c CAMx
c FGAVRG
c
include "camx.prm"
include "camx.com"
include "bndary.com"
include "chmstry.com"
c
c========================= Source Apportion Begin ==============================
c
include "tracer.com"
include "rtracchm.com"
c
c========================= Source Apportion End ==============================
c
c
c========================= Process Analysis Begin ==============================
c
include "procan.com"
c
integer ipa_cel(ncol,nrow,nlay)
c
c========================= Process Analysis End ==============================
c
logical lgas, losat
real tempk(ncol,nrow,nlay),press(ncol,nrow,nlay),
& avcnc(ncol,nrow,nlayav,nspav),conc(ncol,nrow,nlay,nspc),
& avJnuc(ncol,nrow,nlayav,2),Jnuc(ncol,nrow,nlay,2)
integer lmap(nspc)
c
c-----Entry point
c
c-----Increment running average
c
dtfact = dt/(dtout*60.)
do 40 l = 1,nspav
lsp = lmap(l)
lgas = .true.
if( lsp .GT. ngas .AND. .NOT. losat) then
convfac = 1.
lgas = .false.
endif
if( losat .AND. tectyp .EQ. RTRAC .AND. lsp .GT. nrtgas ) then
convfac = 1.
lgas = .false.
endif
do 30 j = 2,nrow-1
i1 = 2
i2 = ncol-1
if (igrd.eq.1) then
if (ibeg(j).eq.-999) goto 30
i1 = ibeg(j)
i2 = iend(j)
endif
do i = i1,i2
c
do k=1,nlayav
if (lgas) then
tmp = 273./tempk(i,j,k)*press(i,j,k)/1013.
convfac = 1./(densfac*tmp)
endif
avcnc(i,j,k,l) = convfac*conc(i,j,k,lsp)*dtfact +
& avcnc(i,j,k,l)
!Store running average of nucleation rates. The 2 limit
!on l is confusing and something more straight-forward
!could be done. This value should MATCH the number of
!nucleation mechniasms that are being tracked. It has
!NOTHING to do with the number of species even though
!we made it look like it does. (unsigned commenter)
if (l.le.2) then
avJnuc(i,j,k,l) = Jnuc(i,j,k,l)*dtfact + avJnuc(i,j,k,l)
endif
c
c========================= Process Analysis Begin ==============================
c
if( .NOT. losat .AND. lipr .AND.
& ipa_cel(i,j,k) .GT. 0 ) then
ipa_idx = ipa_cel(i,j,k)
c
c-----Save the units conversion factor for use in IPR post-processing
c
cipr(IPR_CONV, ipa_idx, lsp) =
& cipr(IPR_CONV, ipa_idx, lsp)+ convfac * dtfact
endif
c
c========================= Process Analysis End ==============================
c
enddo
enddo
30 continue
40 continue
c
return
end