Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_soilnox_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_SoilNOx\_Mod contains routines to compute soil
9 : ! NOx emissions. We follow the implementation in GEOS-Chem by Hudman
10 : ! et al 2012.
11 : !\\
12 : !\\
13 : ! !INTERFACE:
14 : !
15 : MODULE HCOX_SoilNOx_Mod
16 : !
17 : ! !USES:
18 : !
19 : USE HCO_ERROR_Mod
20 : USE HCO_CHARTOOLS_MOD
21 : USE HCO_DIAGN_Mod
22 : USE HCOX_TOOLS_MOD
23 : USE HCOX_State_Mod, ONLY : Ext_State
24 : USE HCO_STATE_Mod, ONLY : HCO_State
25 :
26 : IMPLICIT NONE
27 : PRIVATE
28 : !
29 : ! !PUBLIC MEMBER FUNCTIONS:
30 : !
31 : PUBLIC :: HCOX_SoilNOx_Run
32 : PUBLIC :: HCOX_SoilNOx_Init
33 : PUBLIC :: HCOX_SoilNOx_Final
34 : !
35 : ! !REMARKS:
36 : ! This is a HEMCO extension module that uses many of the HEMCO core
37 : ! utilities.
38 : ! .
39 : ! Original codes from:
40 : ! HARVARD ATMOSPHERIC CHEMISTRY MODELING GROUP
41 : ! MODULE FOR SOIL NOX EMISSIONS
42 : ! by Yuhang Wang, Gerry Gardner, and Prof. Daniel Jacob
43 : ! Updated model code:
44 : ! by Rynda Hudman, Neil Moore, Randall Martin, and Bram Maasakkers
45 : ! .
46 : ! The soil NOx code has been updated from the original implementation
47 : ! of Yienger & Levy [1995] from Wang et al., [1998] as summarized below.
48 : ! .
49 : ! Old:
50 : ! ENOx = f( T, biome, w/d) x Pulse(precip) x canopy uptake + FERT
51 : ! .
52 : ! New:
53 : ! ENOx = f( T, biome, WFPS, Fert) x Pulse(dryspell) x canopy uptake
54 : ! .
55 : ! 1 - Update moisture treatment: soil moisture as a continuous variable
56 : ! using WFPS rather than discrete wet/dry states and purely exponential
57 : ! T impact (impact = -1. Tg N/yr)
58 : ! .
59 : ! 2 - Update to Fertilizer: new fertilizer maps including chemical and
60 : ! manure fertilizer from Potter et al., [2010] distributed using MODIS EVI
61 : ! seasonality, online-N deposition as a fertilizer source, and N-fertilizer
62 : ! source subject to T, WFPS, and pulsing like other N (impact = +1.3 Tg N/yr)
63 : ! .
64 : ! 3- Update Pulsing Scheme: Yan et al., [2005] (shorter, stronger pulses)
65 : ! (impact = +1. Tg N/yr). Also added restart file containing dry spell
66 : ! information to properly account for dry spell length in continuing runs.
67 : ! .
68 : ! References:
69 : ! ============================================================================
70 : ! (1 ) Wang, Y., D.J. Jacob, and J.A. Logan, Global simulation of
71 : ! tropospheric O3-NOx-hydrocarbon chemistry, 1. Model formulation,
72 : ! J. Geophys. Res., 103/D9, 10, 713-10,726, 1998.
73 : ! (2 ) Yienger, J.J, and H. Levy, Empirical model of global soil-biogenic
74 : ! NOx emissions, J. Geophys. Res., 100, D6, 11,447-11464, June 20, 1995.
75 : ! (3 ) Yan, X., T. Ohara, and H. Akimoto, Statistical modeling of global
76 : ! soil NOx emissions, Global Biogeochem. Cycles, 19, GB3019,
77 : ! doi:10.1029/2004GB002276, 2005.
78 : ! (4 ) Potter, P., Ramankutty, N., Bennett, E., and Donner, S.:
79 : ! Characterizing the Spatial Patterns of Global Fertilizer Application
80 : ! and Manure Production, Earth Interactions, 14, 1-22,
81 : ! 10.1175/2009EI288.1, 2010.
82 : ! (5 ) Moore, N.E., Improving global bottom-up biogenic soil NOx inventories,
83 : ! Master's Thesis, Dalhousie University, 2007.
84 : ! (6 ) Hudman, R.C., N.E. Moore, A.K. Mebust, R.V. Martin, A.R. Russell,
85 : ! L.C. Valin, and R.C Cohen, Steps toward a mechanistic model of global
86 : ! soil nitric oxide emissions: implementation and space
87 : ! based-constraints, Atmos. Chem. Phys., 12, 7779-7795,
88 : ! doi:10.5194/acp-12-7779-2012, 2012.
89 : !
90 : ! !REVISION HISTORY:
91 : ! See https://github.com/geoschem/hemco for complete history
92 : !EOP
93 : !------------------------------------------------------------------------------
94 : !BOC
95 : !
96 : ! !MODULE VARIABLES:
97 : !
98 : ! Derived type to hold MODIS land types
99 : TYPE MODL
100 : REAL(hp), POINTER :: VAL (:,:)
101 : ENDTYPE MODL
102 :
103 : TYPE :: MyInst
104 : INTEGER :: Instance
105 : INTEGER :: ExtNr ! Extension number
106 : INTEGER :: IDTNO ! NO tracer ID
107 : LOGICAL :: LFERTILIZERNOX ! Use fertilizer NOx?
108 : REAL(hp) :: FERT_SCALE ! fertilizer scale factor
109 :
110 : ! Dry period length (from restart)
111 : REAL(sp), ALLOCATABLE :: DRYPERIOD(:,: )
112 :
113 : ! Pulse factors (from restart)
114 : REAL(sp), ALLOCATABLE :: PFACTOR(:,: )
115 : REAL(sp), ALLOCATABLE :: GWET_PREV(:,: )
116 :
117 : ! Deposition reservoir (from restart)
118 : REAL(sp), ALLOCATABLE :: DEP_RESERVOIR(:,: )
119 :
120 : ! NOx in the canopy
121 : REAL(hp), ALLOCATABLE :: CANOPYNOX(:,:,:)
122 :
123 : ! MODIS landtype
124 : TYPE(MODL), POINTER :: LANDTYPE(:) => NULL()
125 :
126 : ! Soil fertilizer (kg/m3)
127 : REAL(hp), POINTER :: SOILFERT(:,:) => NULL()
128 :
129 : ! Fraction of arid and non-arid land
130 : REAL(hp), POINTER :: CLIMARID(:,:) => NULL()
131 : REAL(hp), POINTER :: CLIMNARID(:,:) => NULL()
132 :
133 : ! DRYCOEFF (if read from settings in configuration file)
134 : REAL(hp), POINTER :: DRYCOEFF(:)
135 :
136 : ! Overall scale factor to be applied to total soil NOx emissions. Must
137 : ! be defined in the HEMCO configuration file as extension attribute
138 : ! 'Scaling_NO'
139 : REAL(sp), ALLOCATABLE :: SpcScalVal(:)
140 : CHARACTER(LEN=61), ALLOCATABLE :: SpcScalFldNme(:)
141 :
142 : ! Diagnostics
143 : REAL(sp), POINTER :: FertNO_Diag(:,:)
144 :
145 : TYPE(MyInst), POINTER :: NextInst => NULL()
146 : END TYPE MyInst
147 :
148 : ! Pointer to all instances
149 : TYPE(MyInst), POINTER :: AllInst => NULL()
150 : !
151 : ! !DEFINED PARAMETERS:
152 : !
153 : ! # of MODIS/Koppen biome types
154 : INTEGER, PARAMETER :: NBIOM = 24
155 :
156 : ! Max. # of allowed drycoeff vars
157 : INTEGER, PARAMETER :: MaxDryCoeff = 50
158 :
159 : ! Canopy wind extinction coefficients
160 : ! (cf. Yienger & Levy [1995], Sec 5), now a function of the
161 : ! MODIS/KOPPEN biometype (J.D. Maasakkers)
162 : REAL(hp), PARAMETER, PRIVATE :: SOILEXC(NBIOM) = (/&
163 : 0.10_hp, 0.50_hp, 0.10_hp, 0.10_hp, 0.10_hp, 0.10_hp, 0.10_hp, &
164 : 0.10_hp, 0.10_hp, 1.00_hp, 1.00_hp, 1.00_hp, 1.00_hp, 2.00_hp, &
165 : 4.00_hp, 4.00_hp, 4.00_hp, 4.00_hp, 4.00_hp, 4.00_hp, 4.00_hp, &
166 : 2.00_hp, 0.10_hp, 2.00_hp /)
167 :
168 : ! Steinkamp and Lawrence, 2011 A values, wet biome coefficients
169 : ! for each of the 24 soil biomes [ng N/m2/s].
170 : REAL(hp), PARAMETER, PRIVATE :: A_BIOME(NBIOM) = (/&
171 : 0.00_hp, 0.00_hp, 0.00_hp, 0.00_hp, 0.00_hp, 0.06_hp, 0.09_hp, &
172 : 0.09_hp, 0.01_hp, 0.84_hp, 0.84_hp, 0.24_hp, 0.42_hp, 0.62_hp, &
173 : 0.03_hp, 0.36_hp, 0.36_hp, 0.35_hp, 1.66_hp, 0.08_hp, 0.44_hp, &
174 : 0.57_hp, 0.57_hp, 0.57_hp /)
175 :
176 : ! "A" coefficients for converting surface temp to soil temp
177 : ! for each of the 24 soil biomes
178 : REAL(hp), PARAMETER, PRIVATE :: SOILTA(NBIOM) = (/&
179 : 0.00_hp, 0.92_hp, 0.00_hp, 0.66_hp, 0.66_hp, 0.66_hp, 0.66_hp, &
180 : 0.66_hp, 0.66_hp, 0.66_hp, 0.66_hp, 0.66_hp, 0.66_hp, 0.66_hp, &
181 : 0.84_hp, 0.84_hp, 0.84_hp, 0.84_hp, 0.84_hp, 0.84_hp, 0.84_hp, &
182 : 1.03_hp, 1.03_hp, 1.03_hp /)
183 :
184 : ! "B" coefficients for converting surface temp to soil temp
185 : ! for each of the 24 soil biomes
186 : REAL(hp), PARAMETER, PRIVATE :: SOILTB(NBIOM) = (/&
187 : 0.00_hp, 4.40_hp, 0.00_hp, 8.80_hp, 8.80_hp, 8.80_hp, 8.80_hp, &
188 : 8.80_hp, 8.80_hp, 8.80_hp, 8.80_hp, 8.80_hp, 8.80_hp, 8.80_hp, &
189 : 3.60_hp, 3.60_hp, 3.60_hp, 3.60_hp, 3.60_hp, 3.60_hp, 3.60_hp, &
190 : 2.90_hp, 2.90_hp, 2.90_hp /)
191 :
192 : ! MODIS/Koppen resistance values
193 : INTEGER, PARAMETER, PRIVATE :: SNIMODIS(NBIOM) = (/&
194 : 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, &
195 : 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, &
196 : 21, 22, 23, 24 /)
197 :
198 : INTEGER, PARAMETER, PRIVATE :: SNIRI(NBIOM) = (/&
199 : 9999, 200, 9999, 9999, 9999, 9999, 200, 200, 200, 200, &
200 : 200, 200, 200, 200, 200, 200, 200, 400, 400, 200, &
201 : 200, 200, 9999, 200 /)
202 :
203 : INTEGER, PARAMETER, PRIVATE :: SNIRLU(NBIOM) = (/&
204 : 9999, 9000, 9999, 9999, 9999, 9999, 9000, 9000, 9000, 9000, &
205 : 9000, 9000, 9000, 9000, 9000, 1000, 9000, 9000, 9000, 9000, &
206 : 1000, 9000, 9999, 9000 /)
207 :
208 : INTEGER, PARAMETER, PRIVATE :: SNIRAC(NBIOM) = (/&
209 : 0, 300, 0, 0, 0, 0, 100, 100, 100, 100, &
210 : 100, 100, 100, 100, 2000, 2000, 2000, 2000, 2000, 2000, &
211 : 2000, 200, 100, 200 /)
212 :
213 : INTEGER, PARAMETER, PRIVATE :: SNIRGSS(NBIOM) = (/&
214 : 0, 0, 100, 1000, 100, 1000, 350, 350, 350, 350, &
215 : 350, 350, 350, 350, 500, 200, 500, 500, 500, 500, &
216 : 200, 150, 400, 150 /)
217 :
218 : INTEGER, PARAMETER, PRIVATE :: SNIRGSO(NBIOM) = (/&
219 : 2000, 1000, 3500, 400, 3500, 400, 200, 200, 200, 200, &
220 : 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, &
221 : 200, 150, 300, 150 /)
222 :
223 : INTEGER, PARAMETER, PRIVATE :: SNIRCLS(NBIOM) = (/&
224 : 9999, 2500, 9999, 9999, 9999, 9999, 2000, 2000, 2000, 2000, &
225 : 2000, 2000, 2000, 2000, 2000, 9999, 2000, 2000, 2000, 2000, &
226 : 9999, 2000, 9999, 2000 /)
227 :
228 : INTEGER, PARAMETER, PRIVATE :: SNIRCLO(NBIOM) = (/&
229 : 9999, 1000, 1000, 9999, 1000, 9999, 1000, 1000, 1000, 1000, &
230 : 1000, 1000, 1000, 1000, 1000, 9999, 1000, 1000, 1000, 1000, &
231 : 9999, 1000, 9999, 1000 /)
232 :
233 : INTEGER, PARAMETER, PRIVATE :: SNIVSMAX(NBIOM) = (/&
234 : 10, 100, 100, 10, 100, 10, 100, 100, 100, 100, &
235 : 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, &
236 : 100, 100, 100, 100 /)
237 :
238 : ! ! Conversion factor from kg NO to ng N
239 : ! REAL(hp), PARAMETER, PRIVATE :: kgNO_to_ngN = 4.666d11 !(14/30 * 1e12)
240 :
241 : CONTAINS
242 : !EOC
243 : !------------------------------------------------------------------------------
244 : ! Harmonized Emissions Component (HEMCO) !
245 : !------------------------------------------------------------------------------
246 : !BOP
247 : !
248 : ! !IROUTINE: HCOX_SoilNOx_Run
249 : !
250 : ! !DESCRIPTION: Subroutine HcoX\_SoilNox\_Run is the driver routine to
251 : ! calculate ship NOx emissions for the current time step. Emissions in
252 : ! [kg/m2/s] are added to the emissions array of the passed
253 : !\\
254 : !\\
255 : ! !INTERFACE:
256 : !
257 0 : SUBROUTINE HCOX_SoilNOx_Run( ExtState, HcoState, RC )
258 : !
259 : ! !USES:
260 : !
261 : USE HCO_Types_Mod, ONLY : DiagnCont
262 : USE HCO_CLOCK_MOD, ONLY : HcoClock_First
263 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Rewind
264 : USE HCO_FLuxArr_Mod, ONLY : HCO_EmisAdd
265 : USE HCO_EmisList_Mod, ONLY : HCO_GetPtr
266 : USE HCO_Calc_Mod, ONLY : HCO_EvalFld
267 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
268 : USE HCO_ExtList_Mod, ONLY : HCO_GetOpt
269 : USE HCO_Restart_Mod, ONLY : HCO_RestartGet
270 : USE HCO_Restart_Mod, ONLY : HCO_RestartWrite
271 : !
272 : ! !INPUT PARAMETERS:
273 : !
274 : TYPE(Ext_State), POINTER :: ExtState ! Module options
275 :
276 : !
277 : ! !INPUT/OUTPUT PARAMETERS:
278 : !
279 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
280 : INTEGER, INTENT(INOUT) :: RC
281 : !
282 : ! !REVISION HISTORY:
283 : ! 05 Nov 2013 - C. Keller - Initial Version
284 : ! See https://github.com/geoschem/hemco for complete history
285 : !EOP
286 : !------------------------------------------------------------------------------
287 : !BOC
288 : !
289 : ! !LOCAL VARIABLES:
290 : !
291 : INTEGER :: I, J, N
292 0 : REAL(hp), TARGET :: FLUX_2D(HcoState%NX,HcoState%NY)
293 0 : REAL(hp), TARGET :: Tmp2D (HcoState%NX,HcoState%NY)
294 0 : REAL(sp) :: Def2D (HcoState%NX,HcoState%NY)
295 : REAL(hp) :: FERTDIAG, DEP_FERT, SOILFRT
296 : REAL*4 :: TSEMIS
297 : REAL(hp) :: UNITCONV, IJFLUX
298 0 : REAL(dp), ALLOCATABLE :: VecDp(:)
299 : LOGICAL :: FIRST
300 : LOGICAL :: aIR, FOUND
301 : CHARACTER(LEN= 31) :: DiagnName
302 : CHARACTER(LEN=255) :: MSG, DMY, LOC
303 : TYPE(MyInst), POINTER :: Inst
304 :
305 : !=================================================================
306 : ! HCOX_SoilNOx_RUN begins here!
307 : !=================================================================
308 0 : LOC = 'HCOX_SoilNOx_RUN (HCOX_SOILNOX_MOD.F90)'
309 :
310 : ! Enter
311 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
312 0 : IF ( RC /= HCO_SUCCESS ) THEN
313 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
314 0 : RETURN
315 : ENDIF
316 :
317 : ! Return if extension disabled
318 0 : IF ( ExtState%SoilNOx < 0 ) RETURN
319 :
320 : ! Nullify
321 0 : Inst => NULL()
322 :
323 : ! Get Instance
324 0 : CALL InstGet ( ExtState%SoilNox, Inst, RC )
325 0 : IF ( RC /= HCO_SUCCESS ) THEN
326 0 : WRITE(MSG,*) 'Cannot find soil NOx instance Nr. ', ExtState%SoilNOx
327 0 : CALL HCO_ERROR(MSG,RC)
328 0 : RETURN
329 : ENDIF
330 :
331 : ! Conversion factor from ng N to kg NO
332 0 : UNITCONV = 1.0e-12_hp / 14.0_hp * HcoState%Spc(Inst%IDTNO)%MW_g
333 :
334 : !-----------------------------------------------------------------
335 : ! On first call, set pointers to all arrays needed by SoilNOx
336 : !-----------------------------------------------------------------
337 0 : FIRST = HcoClock_First ( HcoState%Clock, .TRUE. )
338 :
339 : !IF ( FIRST ) THEN
340 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK1', Inst%LANDTYPE(1)%VAL, RC )
341 0 : IF ( RC /= HCO_SUCCESS ) THEN
342 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
343 0 : RETURN
344 : ENDIF
345 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK2', Inst%LANDTYPE(2)%VAL, RC )
346 0 : IF ( RC /= HCO_SUCCESS ) THEN
347 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
348 0 : RETURN
349 : ENDIF
350 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK3', Inst%LANDTYPE(3)%VAL, RC )
351 0 : IF ( RC /= HCO_SUCCESS ) THEN
352 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
353 0 : RETURN
354 : ENDIF
355 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK4', Inst%LANDTYPE(4)%VAL, RC )
356 0 : IF ( RC /= HCO_SUCCESS ) THEN
357 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
358 0 : RETURN
359 : ENDIF
360 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK5', Inst%LANDTYPE(5)%VAL, RC )
361 0 : IF ( RC /= HCO_SUCCESS ) THEN
362 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
363 0 : RETURN
364 : ENDIF
365 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK6', Inst%LANDTYPE(6)%VAL, RC )
366 0 : IF ( RC /= HCO_SUCCESS ) THEN
367 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
368 0 : RETURN
369 : ENDIF
370 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK7', Inst%LANDTYPE(7)%VAL, RC )
371 0 : IF ( RC /= HCO_SUCCESS ) THEN
372 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
373 0 : RETURN
374 : ENDIF
375 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK8', Inst%LANDTYPE(8)%VAL, RC )
376 0 : IF ( RC /= HCO_SUCCESS ) THEN
377 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
378 0 : RETURN
379 : ENDIF
380 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK9', Inst%LANDTYPE(9)%VAL, RC )
381 0 : IF ( RC /= HCO_SUCCESS ) THEN
382 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
383 0 : RETURN
384 : ENDIF
385 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK10', Inst%LANDTYPE(10)%VAL, RC )
386 0 : IF ( RC /= HCO_SUCCESS ) THEN
387 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
388 0 : RETURN
389 : ENDIF
390 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK11', Inst%LANDTYPE(11)%VAL, RC )
391 0 : IF ( RC /= HCO_SUCCESS ) THEN
392 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
393 0 : RETURN
394 : ENDIF
395 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK12', Inst%LANDTYPE(12)%VAL, RC )
396 0 : IF ( RC /= HCO_SUCCESS ) THEN
397 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
398 0 : RETURN
399 : ENDIF
400 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK13', Inst%LANDTYPE(13)%VAL, RC )
401 0 : IF ( RC /= HCO_SUCCESS ) THEN
402 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
403 0 : RETURN
404 : ENDIF
405 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK14', Inst%LANDTYPE(14)%VAL, RC )
406 0 : IF ( RC /= HCO_SUCCESS ) THEN
407 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
408 0 : RETURN
409 : ENDIF
410 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK15', Inst%LANDTYPE(15)%VAL, RC )
411 0 : IF ( RC /= HCO_SUCCESS ) THEN
412 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
413 0 : RETURN
414 : ENDIF
415 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK16', Inst%LANDTYPE(16)%VAL, RC )
416 0 : IF ( RC /= HCO_SUCCESS ) THEN
417 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
418 0 : RETURN
419 : ENDIF
420 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK17', Inst%LANDTYPE(17)%VAL, RC )
421 0 : IF ( RC /= HCO_SUCCESS ) THEN
422 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
423 0 : RETURN
424 : ENDIF
425 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK18', Inst%LANDTYPE(18)%VAL, RC )
426 0 : IF ( RC /= HCO_SUCCESS ) THEN
427 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
428 0 : RETURN
429 : ENDIF
430 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK19', Inst%LANDTYPE(19)%VAL, RC )
431 0 : IF ( RC /= HCO_SUCCESS ) THEN
432 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
433 0 : RETURN
434 : ENDIF
435 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK20', Inst%LANDTYPE(20)%VAL, RC )
436 0 : IF ( RC /= HCO_SUCCESS ) THEN
437 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
438 0 : RETURN
439 : ENDIF
440 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK21', Inst%LANDTYPE(21)%VAL, RC )
441 0 : IF ( RC /= HCO_SUCCESS ) THEN
442 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
443 0 : RETURN
444 : ENDIF
445 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK22', Inst%LANDTYPE(22)%VAL, RC )
446 0 : IF ( RC /= HCO_SUCCESS ) THEN
447 0 : CALL HCO_ERROR( 'ERROR 22', RC, THISLOC=LOC )
448 0 : RETURN
449 : ENDIF
450 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK23', Inst%LANDTYPE(23)%VAL, RC )
451 0 : IF ( RC /= HCO_SUCCESS ) THEN
452 0 : CALL HCO_ERROR( 'ERROR 23', RC, THISLOC=LOC )
453 0 : RETURN
454 : ENDIF
455 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_LANDK24', Inst%LANDTYPE(24)%VAL, RC )
456 0 : IF ( RC /= HCO_SUCCESS ) THEN
457 0 : CALL HCO_ERROR( 'ERROR 24', RC, THISLOC=LOC )
458 0 : RETURN
459 : ENDIF
460 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_FERT', Inst%SOILFERT, RC )
461 0 : IF ( RC /= HCO_SUCCESS ) THEN
462 0 : CALL HCO_ERROR( 'ERROR 25', RC, THISLOC=LOC )
463 0 : RETURN
464 : ENDIF
465 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_ARID', Inst%CLIMARID, RC )
466 0 : IF ( RC /= HCO_SUCCESS ) THEN
467 0 : CALL HCO_ERROR( 'ERROR 26', RC, THISLOC=LOC )
468 0 : RETURN
469 : ENDIF
470 0 : CALL HCO_EvalFld( HcoState, 'SOILNOX_NONARID', Inst%CLIMNARID, RC )
471 0 : IF ( RC /= HCO_SUCCESS ) THEN
472 0 : CALL HCO_ERROR( 'ERROR 27', RC, THISLOC=LOC )
473 0 : RETURN
474 : ENDIF
475 :
476 0 : IF ( FIRST ) THEN
477 : ! Check if ExtState variables DRYCOEFF is defined. Otherwise, try to
478 : ! read it from settings.
479 0 : IF ( .NOT. ASSOCIATED(ExtState%DRYCOEFF) ) THEN
480 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'DRYCOEFF', &
481 0 : OptValChar=DMY, FOUND=FOUND, RC=RC )
482 0 : IF ( .NOT. FOUND ) THEN
483 0 : CALL HCO_ERROR( 'DRYCOEFF not defined', RC )
484 0 : RETURN
485 : ENDIF
486 0 : ALLOCATE(VecDp(MaxDryCoeff))
487 : CALL HCO_CharSplit( DMY, HCO_GetOpt(HcoState%Config%ExtList,'Separator'), &
488 0 : HCO_GetOpt(HcoState%Config%ExtList,'Wildcard'), VecDp, N, RC )
489 0 : IF ( RC /= HCO_SUCCESS ) THEN
490 0 : CALL HCO_ERROR( 'ERROR 28', RC, THISLOC=LOC )
491 0 : RETURN
492 : ENDIF
493 0 : ALLOCATE(Inst%DRYCOEFF(N))
494 0 : Inst%DRYCOEFF(1:N) = VecDp(1:N)
495 0 : ExtState%DRYCOEFF => Inst%DRYCOEFF
496 0 : DEALLOCATE(VecDp)
497 : ENDIF
498 : ENDIF
499 :
500 : !---------------------------------------------------------------
501 : ! Fill restart variables. Restart variables can be specified
502 : ! in the HEMCO configuration file. In an ESMF environment, they
503 : ! can also be defined as internal state fields. The internal
504 : ! state fields take precedence over fields read through the
505 : ! HEMCO interface.
506 : ! The restart variables must be read on the first time step or
507 : ! after the rewinding the clock.
508 : !---------------------------------------------------------------
509 :
510 : #if !defined ( MODEL_GEOS )
511 0 : IF ( FIRST .OR. HcoClock_Rewind( HcoState%Clock, .TRUE. ) ) THEN
512 : #else
513 : IF ( .TRUE. ) THEN
514 : #endif
515 :
516 : ! DEP_RESERVOIR. Read in kg NO/m3
517 : CALL HCO_EvalFld( HcoState, 'DEP_RESERVOIR_DEFAULT', &
518 0 : Tmp2D, RC, FOUND=FOUND )
519 0 : IF ( FOUND ) THEN
520 0 : Def2D = Tmp2D
521 : ELSE
522 0 : Def2D = 1.0e-4_sp
523 : ENDIF
524 : CALL HCO_RestartGet( HcoState, 'DEP_RESERVOIR', &
525 0 : Inst%DEP_RESERVOIR, RC, Def2D=Def2D )
526 0 : IF ( RC /= HCO_SUCCESS ) THEN
527 0 : CALL HCO_ERROR( 'ERROR 29', RC, THISLOC=LOC )
528 0 : RETURN
529 : ENDIF
530 :
531 : ! GWET_PREV [unitless]
532 : CALL HCO_RestartGet( HcoState, 'GWET_PREV', &
533 0 : Inst%GWET_PREV, RC, FILLED=FOUND )
534 0 : IF ( RC /= HCO_SUCCESS ) THEN
535 0 : CALL HCO_ERROR( 'ERROR 30', RC, THISLOC=LOC )
536 0 : RETURN
537 : ENDIF
538 0 : IF ( .NOT. FOUND ) THEN
539 0 : Inst%GWET_PREV = 0.0_sp
540 0 : IF ( HcoState%amIRoot ) THEN
541 0 : MSG = 'Cannot find GWET_PREV restart variable - initialized to 0.0!'
542 0 : CALL HCO_WARNING(HcoState%Config%Err,MSG,RC)
543 : ENDIF
544 : ENDIF
545 :
546 : ! PFACTOR [unitless]
547 : CALL HCO_RestartGet( HcoState, 'PFACTOR', &
548 0 : Inst%PFACTOR, RC, FILLED=FOUND )
549 0 : IF ( RC /= HCO_SUCCESS ) THEN
550 0 : CALL HCO_ERROR( 'ERROR 31', RC, THISLOC=LOC )
551 0 : RETURN
552 : ENDIF
553 0 : IF ( .NOT. FOUND ) THEN
554 0 : Inst%PFACTOR = 1.0_sp
555 0 : IF ( HcoState%amIRoot ) THEN
556 0 : MSG = 'Cannot find PFACTOR restart variable - initialized to 1.0!'
557 0 : CALL HCO_WARNING(HcoState%Config%Err,MSG,RC)
558 : ENDIF
559 : ENDIF
560 :
561 : ! DRYPERIOD [unitless]
562 : CALL HCO_RestartGet( HcoState, 'DRYPERIOD', &
563 0 : Inst%DRYPERIOD, RC, FILLED=FOUND )
564 0 : IF ( RC /= HCO_SUCCESS ) THEN
565 0 : CALL HCO_ERROR( 'ERROR 32', RC, THISLOC=LOC )
566 0 : RETURN
567 : ENDIF
568 0 : IF ( .NOT. FOUND ) THEN
569 0 : Inst%DRYPERIOD = 0.0_sp
570 0 : IF ( HcoState%amIRoot ) THEN
571 0 : MSG = 'Cannot find DRYPERIOD restart variable - initialized to 0.0!'
572 0 : CALL HCO_WARNING(HcoState%Config%Err,MSG,RC)
573 : ENDIF
574 : ENDIF
575 :
576 : ENDIF
577 :
578 : !---------------------------------------------------------------
579 : ! Now need to call GET_CANOPY_NOX to break ugly dependency between
580 : ! drydep and soil NOx emissions. (bmy, 6/22/09)
581 : ! Now a function of the new MODIS/Koppen biome map (J.D. Maasakkers)
582 0 : CALL GET_CANOPY_NOX( HcoState, ExtState, Inst, RC )
583 0 : IF ( RC /= HCO_SUCCESS ) THEN
584 0 : CALL HCO_ERROR( 'ERROR 33', RC, THISLOC=LOC )
585 0 : RETURN
586 : ENDIF
587 :
588 : ! Init
589 0 : TSEMIS = HcoState%TS_EMIS
590 0 : FLUX_2D = 0e+0_hp
591 :
592 : ! Loop over each land grid-box, removed loop over landpoints
593 : !$OMP PARALLEL DO &
594 : !$OMP DEFAULT( SHARED ) &
595 : !$OMP PRIVATE( I, J, Dep_Fert, SoilFrt, FertDiag, IJflux )&
596 : !$OMP COLLAPSE( 2 )
597 0 : DO J = 1, HcoState%NY
598 0 : DO I = 1, HcoState%NX
599 :
600 : ! Zero private variables for safety's sake
601 0 : Dep_Fert = 0.0_hp
602 0 : SoilFrt = 0.0_hp
603 0 : FertDiag = 0.0_hp
604 0 : IJflux = 0.0_hp
605 :
606 : ! Do not calculate soil NOx emissions if there is no soil in
607 : ! the gridbox
608 0 : IF ( Inst%LANDTYPE(1)%VAL(I,J) == 1.0_hp ) CYCLE
609 :
610 : ! Get Deposited Fertilizer DEP_FERT [kg NO/m2]
611 0 : CALL Get_Dep_N( I, J, ExtState, HcoState, Inst, Dep_Fert )
612 :
613 : ! Get N fertilizer reservoir associated with chemical and
614 : ! manure fertilizer [kg NO/m2]
615 0 : IF ( Inst%LFERTILIZERNOX ) THEN
616 0 : SOILFRT = Inst%SOILFERT( I, J )
617 : ENDIF
618 :
619 : ! Put in constraint if dry period gt 1 yr, keep at 1yr to
620 : ! avoid unrealistic pulse
621 0 : IF ( Inst%DRYPERIOD(I,J) > 8760.0_sp ) THEN
622 0 : Inst%DRYPERIOD(I,J) = 8760.0_sp
623 : ENDIF
624 :
625 : ! Return NO emissions from soils [kg NO/m2/s]
626 : CALL Soil_NOx_Emission( ExtState, Inst, &
627 : TsEmis, I, &
628 : J, SoilFrt, &
629 0 : Inst%GWET_PREV(I,J), Inst%DryPeriod(I,J), &
630 0 : Inst%PFACTOR(I,J), IJflux, &
631 : Dep_Fert, FertDiag, &
632 0 : UnitConv, Inst%CanopyNOx(I,J,:) )
633 :
634 : ! Write out
635 0 : Flux_2D(I,J) = MAX( IJflux, 0.0_hp )
636 :
637 : ! Update diagnostics
638 0 : Inst%FertNO_Diag(I,J) = FertDiag
639 :
640 : ENDDO !J
641 : ENDDO !I
642 : !$OMP END PARALLEL DO
643 :
644 : !-----------------------------------------------------------------
645 : ! EVENTUALLY ADD SCALE FACTORS
646 : !-----------------------------------------------------------------
647 :
648 : ! Eventually apply species specific scale factor
649 0 : IF ( Inst%SpcScalVal(1) /= 1.0_sp ) THEN
650 0 : FLUX_2D = FLUX_2D * Inst%SpcScalVal(1)
651 : ENDIF
652 :
653 : ! Eventually apply spatiotemporal scale factors
654 0 : CALL HCOX_SCALE ( HcoState, FLUX_2D, TRIM(Inst%SpcScalFldNme(1)), RC )
655 0 : IF ( RC /= HCO_SUCCESS ) THEN
656 0 : CALL HCO_ERROR( 'ERROR 34', RC, THISLOC=LOC )
657 0 : RETURN
658 : ENDIF
659 :
660 : !-----------------------------------------------------------------
661 : ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS
662 : !-----------------------------------------------------------------
663 :
664 : ! Add flux to emission array
665 : CALL HCO_EmisAdd( HcoState, FLUX_2D, Inst%IDTNO, &
666 0 : RC, ExtNr=Inst%ExtNr )
667 0 : IF ( RC /= HCO_SUCCESS ) THEN
668 0 : CALL HCO_ERROR( 'HCO_EmisAdd error', RC )
669 0 : RETURN
670 : ENDIF
671 :
672 : ! ----------------------------------------------------------------
673 : ! Eventually copy internal values to ESMF internal state object
674 : ! ----------------------------------------------------------------
675 :
676 : ! DEP_RESERVOIR [kg/m3]
677 0 : CALL HCO_RestartWrite( HcoState, 'DEP_RESERVOIR', Inst%DEP_RESERVOIR, RC )
678 0 : IF ( RC /= HCO_SUCCESS ) THEN
679 0 : CALL HCO_ERROR( 'ERROR 35', RC, THISLOC=LOC )
680 0 : RETURN
681 : ENDIF
682 :
683 : ! GWET_PREV [unitless]
684 0 : CALL HCO_RestartWrite( HcoState, 'GWET_PREV', Inst%GWET_PREV, RC )
685 0 : IF ( RC /= HCO_SUCCESS ) THEN
686 0 : CALL HCO_ERROR( 'ERROR 36', RC, THISLOC=LOC )
687 0 : RETURN
688 : ENDIF
689 :
690 : ! PFACTOR [unitless]
691 0 : CALL HCO_RestartWrite( HcoState, 'PFACTOR', Inst%PFACTOR, RC )
692 0 : IF ( RC /= HCO_SUCCESS ) THEN
693 0 : CALL HCO_ERROR( 'ERROR 37', RC, THISLOC=LOC )
694 0 : RETURN
695 : ENDIF
696 :
697 : ! DRYPERIOD [unitless]
698 0 : CALL HCO_RestartWrite( HcoState, 'DRYPERIOD', Inst%DRYPERIOD, RC )
699 0 : IF ( RC /= HCO_SUCCESS ) THEN
700 0 : CALL HCO_ERROR( 'ERROR 38', RC, THISLOC=LOC )
701 0 : RETURN
702 : ENDIF
703 :
704 : ! Leave w/ success
705 0 : Inst => NULL()
706 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
707 :
708 0 : END SUBROUTINE HCOX_SoilNox_Run
709 : !EOC
710 : !------------------------------------------------------------------------------
711 : ! Harmonized Emissions Component (HEMCO) !
712 : !------------------------------------------------------------------------------
713 : !BOP
714 : !
715 : ! !IROUTINE: HCOX_SoilNOx_Init
716 : !
717 : ! !DESCRIPTION: Subroutine HcoX\_SoilNox\_Init initializes the HEMCO
718 : ! SOILNOX extension.
719 : !\\
720 : !\\
721 : ! !INTERFACE:
722 : !
723 0 : SUBROUTINE HCOX_SoilNOx_Init( HcoState, ExtName, ExtState, RC )
724 : !
725 : ! !USES:
726 : !
727 : USE HCO_ExtList_Mod, ONLY : GetExtNr, GetExtOpt
728 : USE HCO_ExtList_Mod, ONLY : GetExtSpcVal
729 : USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID
730 : USE HCO_Restart_Mod, ONLY : HCO_RestartDefine
731 : !
732 : ! !ARGUMENTS:
733 : !
734 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
735 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
736 : TYPE(Ext_State), POINTER :: ExtState ! Module options
737 : INTEGER, INTENT(INOUT) :: RC
738 : !
739 : ! !REMARKS:
740 : !
741 : ! !REVISION HISTORY:
742 : ! 05 Nov 2013 - C. Keller - Initial Version
743 : ! See https://github.com/geoschem/hemco for complete history
744 : !EOP
745 : !------------------------------------------------------------------------------
746 : !BOC
747 : !
748 : ! !LOCAL VARIABLES:
749 : !
750 : INTEGER :: ExtNr
751 : CHARACTER(LEN=255) :: MSG, LOC
752 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
753 0 : INTEGER, ALLOCATABLE :: HcoIDs(:)
754 : INTEGER :: nSpc, I, J, II, AS
755 : TYPE(MyInst), POINTER :: Inst
756 :
757 : !=================================================================
758 : ! HCOX_SoilNOx_INIT begins here!
759 : !=================================================================
760 0 : LOC = 'HCOX_SoilNOx_INIT (HCOX_SOILNOX_MOD.F90)'
761 :
762 : ! Extension Nr.
763 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
764 0 : IF ( ExtNr <= 0 ) RETURN
765 :
766 : ! Enter
767 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
768 0 : IF ( RC /= HCO_SUCCESS ) THEN
769 0 : CALL HCO_ERROR( 'ERROR 39', RC, THISLOC=LOC )
770 0 : RETURN
771 : ENDIF
772 :
773 : ! Create instance
774 0 : Inst => NULL()
775 0 : CALL InstCreate ( ExtNr, ExtState%SoilNox, Inst, RC )
776 0 : IF ( RC /= HCO_SUCCESS ) THEN
777 0 : CALL HCO_ERROR ( 'Cannot create soil NOx instance', RC )
778 0 : RETURN
779 : ENDIF
780 :
781 : ! ----------------------------------------------------------------------
782 : ! Get species IDs and settings
783 : ! ----------------------------------------------------------------------
784 :
785 : ! Read settings specified in configuration file
786 : ! Note: the specified strings have to match those in
787 : ! the config. file!
788 : CALL GetExtOpt( HcoState%Config, ExtNr, 'Use fertilizer NOx', &
789 0 : OptValBool=Inst%LFERTILIZERNOX, RC=RC )
790 0 : IF ( RC /= HCO_SUCCESS ) THEN
791 0 : CALL HCO_ERROR( 'ERROR 40', RC, THISLOC=LOC )
792 0 : RETURN
793 : ENDIF
794 :
795 : ! Get global scale factor
796 0 : Inst%FERT_SCALE = HCOX_SoilNOx_GetFertScale()
797 :
798 : ! Get HEMCO species IDs
799 0 : CALL HCO_GetExtHcoID( HcoState, ExtNr, HcoIDs, SpcNames, nSpc, RC )
800 0 : IF ( RC /= HCO_SUCCESS ) THEN
801 0 : CALL HCO_ERROR( 'ERROR 41', RC, THISLOC=LOC )
802 0 : RETURN
803 : ENDIF
804 0 : IF ( nSpc /= 1 ) THEN
805 0 : MSG = 'Module soil NOx accepts only one species!'
806 0 : CALL HCO_ERROR(MSG, RC )
807 0 : RETURN
808 : ENDIF
809 0 : Inst%IDTNO = HcoIDs(1)
810 :
811 : ! Get species scale factor
812 : CALL GetExtSpcVal( HcoState%Config, ExtNr, nSpc, &
813 0 : SpcNames, 'Scaling', 1.0_sp, Inst%SpcScalVal, RC )
814 0 : IF ( RC /= HCO_SUCCESS ) THEN
815 0 : CALL HCO_ERROR( 'ERROR 42', RC, THISLOC=LOC )
816 0 : RETURN
817 : ENDIF
818 :
819 : CALL GetExtSpcVal( HcoState%Config, ExtNr, nSpc, &
820 0 : SpcNames, 'ScaleField', HCOX_NOSCALE, Inst%SpcScalFldNme, RC )
821 0 : IF ( RC /= HCO_SUCCESS ) THEN
822 0 : CALL HCO_ERROR( 'ERROR 43', RC, THISLOC=LOC )
823 0 : RETURN
824 : ENDIF
825 :
826 : ! Verbose mode
827 0 : IF ( HcoState%amIRoot ) THEN
828 0 : MSG = 'Use soil NOx emissions (extension module)'
829 0 : CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
830 :
831 0 : WRITE(MSG,*) ' - NOx species : ', TRIM(SpcNames(1)), Inst%IDTNO
832 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
833 0 : WRITE(MSG,*) ' - NOx scale factor : ', Inst%SpcScalVal(1)
834 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
835 0 : WRITE(MSG,*) ' - NOx scale field : ', TRIM(Inst%SpcScalFldNme(1))
836 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
837 0 : WRITE(MSG,*) ' - Use fertilizer NOx : ', Inst%LFERTILIZERNOX
838 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
839 0 : WRITE(MSG,*) ' - Fertilizer scale factor: ', Inst%FERT_SCALE
840 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2='-')
841 : ENDIF
842 :
843 : ! ----------------------------------------------------------------------
844 : ! Set module variables
845 : ! ----------------------------------------------------------------------
846 :
847 : ! horizontal dimensions
848 0 : I = HcoState%NX
849 0 : J = HcoState%NY
850 :
851 0 : ALLOCATE( Inst%FertNO_Diag( I, J ), STAT=AS )
852 0 : IF ( AS /= 0 ) THEN
853 0 : CALL HCO_ERROR( 'FertNO_Diag', RC )
854 0 : RETURN
855 : ENDIF
856 0 : Inst%FertNO_Diag = 0.0_sp
857 :
858 0 : ALLOCATE( Inst%DRYPERIOD( I, J ), STAT=AS )
859 0 : IF ( AS /= 0 ) THEN
860 0 : CALL HCO_ERROR( 'DRYPERIOD', RC )
861 0 : RETURN
862 : ENDIF
863 0 : Inst%DRYPERIOD = 0.0_sp
864 :
865 0 : ALLOCATE( Inst%PFACTOR( I, J ), STAT=AS )
866 0 : IF ( AS /= 0 ) THEN
867 0 : CALL HCO_ERROR( 'PFACTOR', RC )
868 0 : RETURN
869 : ENDIF
870 0 : Inst%PFACTOR = 0.0_sp
871 :
872 0 : ALLOCATE( Inst%GWET_PREV( I, J ), STAT=AS )
873 0 : IF ( AS /= 0 ) THEN
874 0 : CALL HCO_ERROR( 'GWET_PREV', RC )
875 0 : RETURN
876 : ENDIF
877 0 : Inst%GWET_PREV = 0.0_sp
878 :
879 0 : ALLOCATE( Inst%DEP_RESERVOIR( I, J ), STAT=AS )
880 0 : IF ( AS /= 0 ) THEN
881 0 : CALL HCO_ERROR( 'DEP_RESERVOIR', RC )
882 0 : RETURN
883 : ENDIF
884 0 : Inst%DEP_RESERVOIR = 0.0_sp
885 :
886 0 : ALLOCATE( Inst%CANOPYNOX( I, J, NBIOM ), STAT=AS )
887 0 : IF ( AS /= 0 ) THEN
888 0 : CALL HCO_ERROR( 'CANOPYNOX', RC )
889 0 : RETURN
890 : ENDIF
891 0 : Inst%CANOPYNOX = 0e+0_hp
892 :
893 : ! Reserve 24 pointers for land fractions for each Koppen category
894 0 : ALLOCATE ( Inst%LANDTYPE(NBIOM), STAT=AS )
895 : IF ( AS /= 0 ) THEN
896 0 : CALL HCO_ERROR( 'LANDTYPE', RC )
897 0 : RETURN
898 : ENDIF
899 0 : DO II = 1,NBIOM
900 0 : ALLOCATE( Inst%LANDTYPE(II)%VAL( I, J ), STAT=AS )
901 : IF ( AS /= 0 ) THEN
902 0 : CALL HCO_ERROR( 'LANDTYPE array', RC )
903 0 : RETURN
904 : ENDIF
905 0 : Inst%LANDTYPE(II)%Val = 0.0_hp
906 : ENDDO
907 :
908 : ALLOCATE ( Inst%SOILFERT ( I, J ), &
909 : Inst%CLIMARID ( I, J ), &
910 0 : Inst%CLIMNARID ( I, J ), STAT=AS )
911 0 : IF ( AS /= 0 ) THEN
912 0 : CALL HCO_ERROR( 'SOILFERT', RC )
913 0 : RETURN
914 : ENDIF
915 0 : Inst%SOILFERT = 0.0_hp
916 0 : Inst%CLIMARID = 0.0_hp
917 0 : Inst%CLIMNARID = 0.0_hp
918 :
919 : ! ----------------------------------------------------------------------
920 : ! Set diagnostics
921 : ! ----------------------------------------------------------------------
922 : CALL Diagn_Create( HcoState = HcoState, &
923 : cName = 'EmisNO_Fert', &
924 : ExtNr = ExtNr, &
925 : Cat = -1, &
926 : Hier = -1, &
927 : HcoID = -1, &
928 : SpaceDim = 2, &
929 : OutUnit = 'kg/m2/s', &
930 : AutoFill = 0, &
931 : Trgt2D = Inst%FertNO_Diag, &
932 0 : RC = RC )
933 0 : IF ( RC /= HCO_SUCCESS ) THEN
934 0 : CALL HCO_ERROR( 'ERROR 44', RC, THISLOC=LOC )
935 0 : RETURN
936 : ENDIF
937 :
938 : CALL HCO_RestartDefine( HcoState, 'PFACTOR', &
939 0 : Inst%PFACTOR, '1', RC )
940 0 : IF ( RC /= HCO_SUCCESS ) THEN
941 0 : CALL HCO_ERROR( 'ERROR 45', RC, THISLOC=LOC )
942 0 : RETURN
943 : ENDIF
944 :
945 : CALL HCO_RestartDefine( HcoState, 'DRYPERIOD', &
946 0 : Inst%DRYPERIOD, '1', RC )
947 0 : IF ( RC /= HCO_SUCCESS ) THEN
948 0 : CALL HCO_ERROR( 'ERROR 46', RC, THISLOC=LOC )
949 0 : RETURN
950 : ENDIF
951 :
952 : CALL HCO_RestartDefine( HcoState, 'GWET_PREV', &
953 0 : Inst%GWET_PREV, '1', RC )
954 0 : IF ( RC /= HCO_SUCCESS ) THEN
955 0 : CALL HCO_ERROR( 'ERROR 47', RC, THISLOC=LOC )
956 0 : RETURN
957 : ENDIF
958 :
959 : CALL HCO_RestartDefine( HcoState, ' DEP_RESERVOIR', &
960 0 : Inst%DEP_RESERVOIR, 'kg/m3', RC )
961 0 : IF ( RC /= HCO_SUCCESS ) THEN
962 0 : CALL HCO_ERROR( 'ERROR 48', RC, THISLOC=LOC )
963 0 : RETURN
964 : ENDIF
965 :
966 : ! ----------------------------------------------------------------------
967 : ! Set HEMCO extensions variables
968 : ! ----------------------------------------------------------------------
969 :
970 : ! Activate required met fields
971 0 : ExtState%T2M%DoUse = .TRUE.
972 0 : ExtState%GWETTOP%DoUse = .TRUE.
973 0 : ExtState%SUNCOS%DoUse = .TRUE.
974 0 : ExtState%U10M%DoUse = .TRUE.
975 0 : ExtState%V10M%DoUse = .TRUE.
976 0 : ExtState%LAI%DoUse = .TRUE.
977 0 : ExtState%FRLAND%DoUse = .TRUE.
978 0 : ExtState%FRLANDIC%DoUse = .TRUE.
979 0 : ExtState%FROCEAN%DoUse = .TRUE.
980 0 : ExtState%FRSEAICE%DoUse = .TRUE.
981 0 : ExtState%FRLAKE%DoUse = .TRUE.
982 0 : ExtState%SNODP%DoUse = .TRUE.
983 0 : ExtState%RADSWG%DoUse = .TRUE.
984 0 : ExtState%CLDFRC%DoUse = .TRUE.
985 :
986 : ! Activate required deposition parameter
987 0 : ExtState%DRY_TOTN%DoUse = .TRUE.
988 0 : ExtState%WET_TOTN%DoUse = .TRUE.
989 :
990 : ! Leave w/ success
991 0 : Inst => NULL()
992 0 : IF ( ALLOCATED(HcoIDs ) ) DEALLOCATE(HcoIDs )
993 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
994 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
995 :
996 0 : END SUBROUTINE HCOX_SoilNOx_Init
997 : !EOC
998 : !------------------------------------------------------------------------------
999 : ! Harmonized Emissions Component (HEMCO) !
1000 : !------------------------------------------------------------------------------
1001 : !BOP
1002 : !
1003 : ! !IROUTINE: HCOX_SoilNOx_Final
1004 : !
1005 : ! !DESCRIPTION: Subroutine HcoX\_SoilNOx\_Final finalizes the HEMCO
1006 : ! SOILNOX extension.
1007 : !\\
1008 : !\\
1009 : ! !INTERFACE:
1010 : !
1011 0 : SUBROUTINE HCOX_SoilNOx_Final( HcoState, ExtState, RC )
1012 : !
1013 : ! !USES
1014 : !
1015 : !
1016 : ! !INPUT PARAMETERS:
1017 : !
1018 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO State obj
1019 : TYPE(Ext_State), POINTER :: ExtState ! Extension state
1020 : !
1021 : ! !INPUT/OUTPUT PARAMETERS:
1022 : !
1023 : INTEGER, INTENT(INOUT) :: RC
1024 : !
1025 : ! !REVISION HISTORY:
1026 : ! 05 Nov 2013 - C. Keller - Initial Version
1027 : ! See https://github.com/geoschem/hemco for complete history
1028 : !EOP
1029 : !------------------------------------------------------------------------------
1030 : !BOC
1031 : !
1032 : ! !LOCAL VARIABLES:
1033 : !
1034 :
1035 : !=================================================================
1036 : ! HCOX_SoilNOx_FINAL begins here!
1037 : !=================================================================
1038 0 : CALL InstRemove ( ExtState )
1039 :
1040 0 : END SUBROUTINE HCOX_SoilNox_Final
1041 : !EOC
1042 : !------------------------------------------------------------------------------
1043 : ! Harmonized Emissions Component (HEMCO) !
1044 : !------------------------------------------------------------------------------
1045 : !BOP
1046 : !
1047 : ! !IROUTINE: HCOX_SoilNOx_GetFertScale
1048 : !
1049 : ! !DESCRIPTION: Function HCOX\_SoilNOx\_GETFERTSCALE returns the scale factor
1050 : ! applied to fertilizer NOx emissions.
1051 : !\\
1052 : !\\
1053 : ! !INTERFACE:
1054 : !
1055 0 : FUNCTION HCOX_SoilNOx_GetFertScale() RESULT ( FERT_SCALE )
1056 : !
1057 : ! !ARGUMENTS:
1058 : !
1059 : REAL(hp) :: FERT_SCALE
1060 : !
1061 : ! !REMARKS:
1062 : !
1063 : ! !REVISION HISTORY:
1064 : ! 11 Dec 2013 - C. Keller - Initial version
1065 : ! See https://github.com/geoschem/hemco for complete history
1066 : !EOP
1067 : !------------------------------------------------------------------------------
1068 : !BOC
1069 : !
1070 : ! !LOCAL VARIABLES:
1071 : !
1072 :
1073 : ! Scale factor so that fertilizer emission = 1.8 Tg N/yr
1074 : ! (Stehfest and Bouwman, 2006)
1075 : ! before canopy reduction
1076 0 : FERT_SCALE = 0.0068_hp
1077 : ! Value calculated by running the 2x2.5 model
1078 : ! For now, use this value for all resolutions since regular soil NOx
1079 : ! emissions change with resolution as well (J.D. Maasakkers)
1080 :
1081 0 : END FUNCTION HCOX_SoilNOx_GetFertScale
1082 : !EOC
1083 : !------------------------------------------------------------------------------
1084 : ! Harmonized Emissions Component (HEMCO) !
1085 : !------------------------------------------------------------------------------
1086 : !BOP
1087 : !
1088 : ! !IROUTINE: Soil_NOx_Emission
1089 : !
1090 : ! !DESCRIPTION: Subroutine Soil\_NOx\_Emission computes the emission of soil
1091 : ! and fertilizer NOx for the GEOS-Chem model.
1092 : !\\
1093 : !\\
1094 : ! !INTERFACE:
1095 : !
1096 0 : SUBROUTINE Soil_NOx_Emission( ExtState, Inst, TS_EMIS, I, &
1097 : J, SOILFRT, GWET_PREV, DRYPERIOD, &
1098 : PFACTOR, SOILNOx, DEPN, FERTDIAG, &
1099 0 : UNITCONV, R_CANOPY )
1100 : !
1101 : ! !INPUT PARAMETERS:
1102 : !
1103 : TYPE(Ext_State), POINTER :: ExtState ! Module options
1104 : TYPE(MyInst), POINTER :: Inst ! Instance object
1105 : REAL*4, INTENT(IN) :: TS_EMIS ! Emission timestep [s]
1106 : INTEGER, INTENT(IN) :: I ! grid box lon index
1107 : INTEGER, INTENT(IN) :: J ! grid box lat index
1108 : REAL(hp), INTENT(IN) :: DEPN ! Dry Dep Fert term [kg/m2]
1109 : REAL(hp), INTENT(IN) :: SOILFRT ! Fertilizer emissions [kg/m2]
1110 : REAL(hp), INTENT(IN) :: UNITCONV ! ng N to kg NO
1111 : REAL(hp), INTENT(IN) :: R_CANOPY(:)! Resist of canopy to NOx [1/s]
1112 : !
1113 : ! !OUTPUT PARAMETERS:
1114 : !
1115 : REAL(hp), INTENT(OUT) :: SOILNOx ! Soil NOx emissions [kg/m2/s]
1116 : REAL(sp), INTENT(OUT) :: GWET_PREV ! Soil Moisture Prev timestep
1117 : REAL(sp), INTENT(OUT) :: DRYPERIOD ! Dry period length in hours
1118 : REAL(sp), INTENT(OUT) :: PFACTOR ! Pulsing Factor
1119 : REAL(hp), INTENT(OUT) :: FERTDIAG ! Fert emissions [kg/m2/s]
1120 : !
1121 : ! !REMARKS:
1122 : ! R_CANOPY is computed in routine GET_CANOPY_NOX of "canopy_nox_mod.f".
1123 : ! This was originally in the GEOS-Chem dry deposition code, but was split
1124 : ! off in order to avoid an ugly code dependency between the dry deposition
1125 : ! and soil NOx codes.
1126 : !
1127 : ! As of v9-02, this module uses the MODIS/Koppen biome types instead
1128 : ! of the Olson land type / biome type, making it different from the original
1129 : ! dry deposition code (J.D. Maasakkers)
1130 : !
1131 : ! !REVISION HISTORY:
1132 : ! 31 Jan 2011 - R. Hudman - New Model added
1133 : ! See https://github.com/geoschem/hemco for complete history
1134 : !EOP
1135 : !------------------------------------------------------------------------------
1136 : !BOC
1137 : !
1138 : ! !LOCAL VARIABLES:
1139 : !
1140 : INTEGER :: K
1141 : REAL(hp) :: BASE_TERM, CRF_TERM, PULSE
1142 : REAL(hp) :: TC, TEMP_TERM, WINDSQR
1143 : REAL(hp) :: WET_TERM, A_FERT, A_BIOM
1144 : REAL(hp) :: LAI, SUNCOS, GWET
1145 : REAL(hp) :: ARID, NARID
1146 :
1147 : !=================================================================
1148 : ! Initialize
1149 : !=================================================================
1150 :
1151 : ! Initialize
1152 0 : SOILNOX = 0.0_hp
1153 0 : FERTDIAG = 0.0_hp
1154 :
1155 : ! Surface temperature [C]
1156 0 : TC = ExtState%T2M%Arr%Val(I,J) - 273.15_hp
1157 :
1158 : ! Surface wind speed, squared
1159 0 : WINDSQR = ExtState%U10M%Arr%Val(I,J)**2 + &
1160 0 : ExtState%V10M%Arr%Val(I,J)**2
1161 :
1162 : ! Leaf area index
1163 0 : LAI = ExtState%LAI%Arr%Val(I,J)
1164 :
1165 : ! Cosine of Solar Zenit Angle
1166 0 : SUNCOS = ExtState%SUNCOS%Arr%Val(I,J)
1167 :
1168 : ! Top soil wetness [unitless]
1169 0 : GWET = ExtState%GWETTOP%Arr%Val(I,J)
1170 :
1171 : !=================================================================
1172 : ! Compute soil NOx emissions
1173 : !=================================================================
1174 :
1175 : ! Cumulative multiplication factor (over baseline emissions)
1176 : ! that accounts for soil pulsing
1177 0 : PULSE = PULSING( GWET, TS_EMIS, GWET_PREV, PFACTOR, DRYPERIOD )
1178 :
1179 : ! ------Loop Over MODIS/Koppen Landtypes
1180 0 : DO K = 1, 24
1181 :
1182 : ! Temperature-dependent term of soil NOx emissions [unitless]
1183 : ! Use GWET instead of climo wet/dry
1184 0 : TEMP_TERM = SOILTEMP( K, TC, GWET )
1185 :
1186 : ! Soil moisture scaling of soil NOx emissions
1187 0 : ARID = Inst%CLIMARID(I,J)
1188 0 : NARID = Inst%CLIMNARID(I,J)
1189 0 : WET_TERM = SOILWET( GWET , ARID, NARID )
1190 :
1191 : ! Fertilizer emission [kg/m2/s]
1192 0 : A_FERT = FERTADD( SOILFRT, DEPN )
1193 :
1194 : ! Scale fertilizer emissions as specified
1195 : ! (scale needed to force fert emiss of 1.8 Tg N/yr w/o canopy uptake)
1196 0 : A_FERT = A_FERT * Inst%FERT_SCALE
1197 :
1198 : ! Canopy reduction factor
1199 0 : CRF_TERM = SOILCRF( K, LAI, R_CANOPY(K), WINDSQR, SUNCOS )
1200 :
1201 : ! Base emission. ng N/m2/s --> kg NO/m2/s
1202 0 : A_BIOM = A_BIOME(K) * UNITCONV
1203 :
1204 : ! SOILNOX includes fertilizer
1205 : SOILNOX = ( SOILNOX &
1206 : + ( A_BIOM + A_FERT ) &
1207 : * ( TEMP_TERM * WET_TERM * PULSE ) &
1208 0 : * Inst%LANDTYPE(K)%VAL(I,J) &
1209 0 : * ( 1.0_hp - CRF_TERM ) )
1210 :
1211 : ! FERTDIAG, only used for the fertilizer diagnostic
1212 : FERTDIAG = ( FERTDIAG &
1213 : + ( A_FERT ) &
1214 : * ( TEMP_TERM * WET_TERM * PULSE ) &
1215 0 : * Inst%LANDTYPE(K)%VAL(I,J) &
1216 0 : * ( 1.0_hp - CRF_TERM ) )
1217 :
1218 : ENDDO
1219 :
1220 0 : END SUBROUTINE Soil_NOx_Emission
1221 : !EOC
1222 : !------------------------------------------------------------------------------
1223 : ! Harmonized Emissions Component (HEMCO) !
1224 : !------------------------------------------------------------------------------
1225 : !BOP
1226 : !
1227 : ! !IROUTINE: Get_Canopy_NOx
1228 : !
1229 : ! !DESCRIPTION: Subroutine Get\_Canopy\_NOx computes the bulk surface
1230 : ! resistance of the canopy to NOx. This computation was originally done
1231 : ! within legacy routine DEPVEL (in "drydep\_mod.f"). Moving this computation
1232 : ! to Get\_Canopy\_NOx now allows for a totally clean separation between
1233 : ! dry deposition routines and emissions routines in GEOS-Chem.
1234 : !\\
1235 : !\\
1236 : ! !INTERFACE:
1237 : !
1238 0 : SUBROUTINE Get_Canopy_NOx( HcoState, ExtState, Inst, RC )
1239 : !
1240 : ! !USES:
1241 : !
1242 : USE Drydep_Toolbox_Mod, ONLY : BIOFIT
1243 : USE HCO_GeoTools_Mod, ONLY : HCO_LANDTYPE
1244 : !
1245 : ! !ARGUMENTS:
1246 : !
1247 : TYPE(HCO_State), POINTER :: HcoState
1248 : TYPE(Ext_State), POINTER :: ExtState
1249 : TYPE(MyInst), POINTER :: Inst
1250 : INTEGER, INTENT(INOUT) :: RC
1251 : !
1252 : ! !REMARKS:
1253 : ! For backwards compatibility, the bulk surface resistance is stored
1254 : ! in common block array CANOPYNOX in "commsoil.h". Leave it like this
1255 : ! for the time being...we'll clean it up when we fix all of the soil
1256 : ! NOx routines.
1257 : !
1258 : ! !REVISION HISTORY:
1259 : ! 14 Jun 2012 - J.D. Maasakkers - Rewritten as a function of the
1260 : ! MODIS/Koppen biometype
1261 : ! See https://github.com/geoschem/hemco for complete history
1262 : !EOP
1263 : !------------------------------------------------------------------------------
1264 : !BOC
1265 : !
1266 : ! !DEFINED PARAMETERS:
1267 : !
1268 : ! Molecular weight of water [kg]
1269 : REAL(hp), PARAMETER :: XMWH2O = 18e-3_hp
1270 :
1271 : ! Surface pressure??? [Pa]
1272 : REAL(hp), PARAMETER :: PRESS = 1.5e+5_hp
1273 : !
1274 : ! !LOCAL VARIABLES:
1275 : !
1276 : ! Scalars
1277 : INTEGER :: I, J, K, KK
1278 : INTEGER :: DCSZ
1279 : REAL(hp) :: F0, HSTAR, XMW
1280 : REAL(hp) :: DTMP1, DTMP2, DTMP3, DTMP4, GFACT, GFACI
1281 : REAL(hp) :: RT, RAD0, RIX, RIXX, RDC, RLUXX
1282 : REAL(hp) :: RGSX, RCLX, TEMPK, TEMPC
1283 : REAL(hp) :: LAI, SUNCOS, CLDFRC
1284 : REAL(hp) :: BIO_RESULT
1285 :
1286 : ! Arrays
1287 : REAL(hp) :: RI (NBIOM)
1288 : REAL(hp) :: RLU (NBIOM)
1289 : REAL(hp) :: RAC (NBIOM)
1290 : REAL(hp) :: RGSS(NBIOM)
1291 : REAL(hp) :: RGSO(NBIOM)
1292 : REAL(hp) :: RCLS(NBIOM)
1293 : REAL(hp) :: RCLO(NBIOM)
1294 :
1295 : !=================================================================
1296 : ! GET_CANOPY_NOX begins here!
1297 : !=================================================================
1298 :
1299 : ! Set physical parameters
1300 0 : HSTAR = 0.01e+0_hp ! Henry's law constant
1301 0 : F0 = 0.1e+0_hp ! Reactivity factor for biological oxidation
1302 0 : XMW = 46e-3_hp ! Molecular wt of NO2 (kg)
1303 :
1304 : ! Get size of DRYCOEFF (will be passed to routine BIOFIT)
1305 0 : DCSZ = SIZE( ExtState%DRYCOEFF )
1306 :
1307 : ! Loop over surface boxes
1308 0 : DO J = 1, HcoState%NY
1309 0 : DO I = 1, HcoState%NX
1310 :
1311 : ! Surface temperature [K] and [C]
1312 0 : TEMPK = ExtState%T2M%Arr%Val(I,J)
1313 0 : TEMPC = ExtState%T2M%Arr%Val(I,J) - 273.15_hp
1314 :
1315 : ! Compute bulk surface resistance for gases.
1316 : !
1317 : ! Adjust external surface resistances for temperature;
1318 : ! from Wesely [1989], expression given in text on p. 1296.
1319 0 : RT = 1000.0_hp * EXP( -TEMPC - 4.0_hp )
1320 :
1321 : !--------------------------------------------------------------
1322 : ! Get surface resistances - loop over biome types K
1323 : !
1324 : ! The land types within each grid square are defined using the
1325 : ! Olson land-type database. Each of the Olson land types is
1326 : ! assigned a corresponding "deposition land type" with
1327 : ! characteristic values of surface resistance components.
1328 : ! There are 74 Olson land-types but only 11 deposition
1329 : ! land-types (i.e., many of the Olson land types share the
1330 : ! same deposition characteristics). Surface resistance
1331 : ! components for the "deposition land types" are from Wesely
1332 : ! [1989] except for tropical forests [Jacob and Wofsy, 1990]
1333 : ! and for tundra [Jacob et al., 1992]. All surface resistance
1334 : ! components are normalized to a leaf area index of unity.
1335 : !--------------------------------------------------------------
1336 : !Loop over all biometypes
1337 0 : DO K = 1, NBIOM
1338 :
1339 : ! Skip if not present
1340 0 : IF ( Inst%LANDTYPE(K)%VAL(I,J) == 0.0_hp ) CYCLE
1341 :
1342 : ! Set second loop variable to K to allow snow/ice correction
1343 0 : KK = K
1344 :
1345 : ! If the surface is snow or ice, then set K=3
1346 0 : IF ( ( ExtState%SNODP%Arr%Val(I,J) > 0.2 ) .OR. &
1347 0 : ( HCO_LANDTYPE(ExtState%FRLAND%Arr%Val(I,J), &
1348 0 : ExtState%FRLANDIC%Arr%Val(I,J), &
1349 0 : ExtState%FROCEAN%Arr%Val(I,J), &
1350 0 : ExtState%FRSEAICE%Arr%Val(I,J), &
1351 0 : ExtState%FRLAKE%Arr%Val(I,J) ) == 2 ) ) KK = 3
1352 :
1353 : ! USE new MODIS/KOPPEN Biometypes to read data
1354 :
1355 : ! Read the internal resistance RI (minimum stomatal resistance
1356 : ! for water vapor, per unit area of leaf) from the IRI array;
1357 : ! a '9999' value means no deposition to stomata so we impose a
1358 : ! very large value for RI.
1359 0 : RI(K) = DBLE( SNIRI(KK) )
1360 0 : IF ( RI(K) >= 9999.e+0_hp ) RI(K)= 1.e+12_hp
1361 :
1362 : ! Cuticular resistances IRLU read in from 'drydep.table'
1363 : ! are per unit area of leaf; divide them by the leaf area index
1364 : ! to get a cuticular resistance for the bulk canopy. If IRLU is
1365 : !'9999' it means there are no cuticular surfaces on which to
1366 : ! deposit so we impose a very large value for RLU.
1367 0 : IF ( SNIRLU(KK) >= 9999 .OR. &
1368 : ExtState%LAI%Arr%Val(I,J) <= 0e+0_hp ) THEN
1369 0 : RLU(K) = 1.e+6_hp
1370 : ELSE
1371 0 : RLU(K)= DBLE(SNIRLU(KK)) / ExtState%LAI%Arr%Val(I,J) + RT
1372 : ENDIF
1373 :
1374 : ! The following are the remaining resistances for the Wesely
1375 : ! resistance-in-series model for a surface canopy
1376 : ! (see Atmos. Environ. paper, Fig.1).
1377 0 : RAC(K) = MAX( DBLE( SNIRAC(KK) ), 1e+0_hp )
1378 0 : RGSS(K) = MAX( DBLE( SNIRGSS(KK) ) + RT, 1e+0_hp )
1379 0 : RGSO(K) = MAX( DBLE( SNIRGSO(KK) ) + RT, 1e+0_hp )
1380 0 : RCLS(K) = DBLE( SNIRCLS(KK) ) + RT
1381 0 : RCLO(K) = DBLE( SNIRCLO(KK) ) + RT
1382 :
1383 0 : IF ( RAC(K) >= 9999.e+0_hp ) RAC(K) = 1e+12_hp
1384 0 : IF ( RGSS(K) >= 9999.e+0_hp ) RGSS(K) = 1e+12_hp
1385 0 : IF ( RGSO(K) >= 9999.e+0_hp ) RGSO(K) = 1e+12_hp
1386 0 : IF ( RCLS(K) >= 9999.e+0_hp ) RCLS(K) = 1e+12_hp
1387 0 : IF ( RCLO(K) >= 9999.e+0_hp ) RCLO(K) = 1e+12_hp
1388 :
1389 : !-------------------------------------------------------------
1390 : ! Adjust stomatal resistances for insolation and temperature:
1391 : !
1392 : ! Temperature adjustment is from Wesely [1989], equation (3).
1393 : !
1394 : ! Light adjustment by the function BIOFIT is described by Wang
1395 : ! [1996]. It combines:
1396 : !
1397 : ! - Local dependence of stomal resistance on the intensity I
1398 : ! of light impinging the leaf; this is expressed as a
1399 : ! multiplicative factor I/(I+b) to the stomatal resistance
1400 : ! where b = 50 W m-2
1401 : ! (equation (7) of Baldocchi et al. [1987])
1402 : ! - Radiative transfer of direct and diffuse radiation in the
1403 : ! canopy using equations (12)-(16) from Guenther et al.
1404 : ! [1995]
1405 : ! - Separate accounting of sunlit and shaded leaves using
1406 : ! equation (12) of Guenther et al. [1995]
1407 : ! - Partitioning of the radiation at the top of the canopy
1408 : ! into direct and diffuse components using a
1409 : ! parameterization to results from an atmospheric radiative
1410 : ! transfer model [Wang, 1996]
1411 : !
1412 : ! The dependent variables of the function BIOFIT are the leaf
1413 : ! area index (XYLAI), the cosine of zenith angle (SUNCOS) and
1414 : ! the fractional cloud cover (CFRAC). The factor GFACI
1415 : ! integrates the light dependence over the canopy depth; so
1416 : ! be scaled by LAI to yield a bulk canopy value because that's
1417 : ! already done in the GFACI formulation.
1418 : !-------------------------------------------------------------
1419 :
1420 : ! Radiation @ sfc [W/m2]
1421 0 : RAD0 = ExtState%RADSWG%Arr%Val(I,J)
1422 :
1423 : ! Internal resistance
1424 0 : RIX = RI(K)
1425 :
1426 : ! Skip the following block if the resistance RIX is high
1427 0 : IF ( RIX < 9999e+0_hp ) THEN
1428 0 : GFACT = 100.0e+0_hp
1429 :
1430 0 : IF ( TEMPC > 0.e+0_hp .AND. TEMPC < 40.e+0_hp) THEN
1431 0 : GFACT = 400.e+0_hp / TEMPC / ( 40.0e+0_hp - TEMPC )
1432 : ENDIF
1433 :
1434 0 : GFACI = 100.e+0_hp
1435 :
1436 0 : IF ( RAD0 > 0e+0_hp .AND. ExtState%LAI%Arr%Val(I,J) > 0e+0_hp ) THEN
1437 :
1438 0 : LAI = ExtState%LAI%Arr%Val(I,J)
1439 0 : SUNCOS = ExtState%SUNCOS%Arr%Val(I,J)
1440 0 : CLDFRC = ExtState%CLDFRC%Arr%Val(I,J)
1441 :
1442 : BIO_RESULT = BIOFIT( ExtState%DRYCOEFF, LAI, &
1443 0 : SUNCOS, CLDFRC, SIZE(ExtState%DRYCOEFF) )
1444 :
1445 0 : GFACI= 1e+0_hp / BIO_RESULT
1446 : ENDIF
1447 :
1448 0 : RIX = RIX * GFACT * GFACI
1449 : ENDIF
1450 :
1451 : ! Compute aerodynamic resistance to lower elements in lower
1452 : ! part of the canopy or structure, assuming level terrain -
1453 : ! equation (5) of Wesely [1989].
1454 0 : RDC = 100.0_hp * ( 1.0_hp + 1000.0_hp / ( RAD0 + 10.0_hp ) )
1455 :
1456 : ! Loop over species; species-dependent corrections to resistances
1457 : ! are from equations (6)-(9) of Wesely [1989].
1458 : !
1459 : ! NOTE: here we only consider NO2 (bmy, 6/22/09)
1460 : RIXX = RIX * DIFFG( TEMPK, PRESS, XMWH2O ) / &
1461 : DIFFG( TEMPK, PRESS, XMW ) &
1462 0 : + 1.e+0_hp / ( HSTAR/3000.e+0_hp + 100.e+0_hp*F0 )
1463 :
1464 0 : RLUXX = 1.e+12_hp
1465 :
1466 0 : IF ( RLU(K) < 9999.e+0_hp ) THEN
1467 0 : RLUXX = RLU(K) / ( HSTAR / 1.0e+05_hp + F0 )
1468 : ENDIF
1469 :
1470 : ! To prevent virtually zero resistance to species with huge HSTAR,
1471 : ! such as HNO3, a minimum value of RLUXX needs to be set.
1472 : ! The rationality of the existence of such a minimum is
1473 : ! demonstrated by the observed relationship between Vd(NOy-NOx)
1474 : ! and Ustar in Munger et al.[1996]; Vd(HNO3) never exceeds 2 cm/s
1475 : ! in observations. The corresponding minimum resistance is 50 s/m.
1476 : ! was introduced by J.Y. Liang on 7/9/95.
1477 0 : RGSX = 1e+0_hp / ( HSTAR/1e+5_hp/RGSS(K) + F0/RGSO(K) )
1478 0 : RCLX = 1e+0_hp / ( HSTAR/1e+5_hp/RCLS(K) + F0/RCLO(K) )
1479 :
1480 : ! Get the bulk surface resistance of the canopy
1481 : ! from the network of resistances in parallel and in series
1482 : ! (Fig. 1 of Wesely [1989])
1483 0 : DTMP1 = 1.e+0_hp / RIXX
1484 0 : DTMP2 = 1.e+0_hp / RLUXX
1485 0 : DTMP3 = 1.e+0_hp / ( RAC(K) + RGSX )
1486 0 : DTMP4 = 1.e+0_hp / ( RDC + RCLX )
1487 :
1488 : ! Save the within canopy depvel of NOx, used in calculating
1489 : ! the canopy reduction factor for soil emissions [1/s]
1490 0 : Inst%CANOPYNOX(I,J,K) = DTMP1 + DTMP2 + DTMP3 + DTMP4
1491 :
1492 : ENDDO !K
1493 : ENDDO !I
1494 : ENDDO !J
1495 :
1496 : ! Return w/ success
1497 0 : RC = HCO_SUCCESS
1498 :
1499 0 : END SUBROUTINE Get_Canopy_NOx
1500 : !EOC
1501 : !------------------------------------------------------------------------------
1502 : ! Harmonized Emissions Component (HEMCO) !
1503 : !------------------------------------------------------------------------------
1504 : !BOP
1505 : !
1506 : ! !IROUTINE: DiffG
1507 : !
1508 : ! !DESCRIPTION: Function DiffG calculates the molecular diffusivity [m2/s] in
1509 : ! air for a gas X of molecular weight XM [kg] at temperature TK [K] and
1510 : ! pressure PRESS [Pa].
1511 : !\\
1512 : !\\
1513 : ! !INTERFACE:
1514 : !
1515 0 : FUNCTION DiffG( TK, PRESS, XM ) RESULT( DIFF_G )
1516 : !
1517 : ! !INPUT PARAMETERS:
1518 : !
1519 : REAL(hp), INTENT(IN) :: TK ! Temperature [K]
1520 : REAL(hp), INTENT(IN) :: PRESS ! Pressure [hPa]
1521 : REAL(hp), INTENT(IN) :: XM ! Molecular weight of gas [kg]
1522 : !
1523 : ! !RETURN VALUE:
1524 : !
1525 : REAL(hp) :: DIFF_G ! Molecular diffusivity [m2/s]
1526 : !
1527 : ! !REMARKS:
1528 : ! We specify the molecular weight of air (XMAIR) and the hard-sphere molecular
1529 : ! radii of air (RADAIR) and of the diffusing gas (RADX). The molecular
1530 : ! radius of air is given in a Table on p. 479 of Levine [1988]. The Table
1531 : ! also gives radii for some other molecules. Rather than requesting the user
1532 : ! to supply a molecular radius we specify here a generic value of 2.E-10 m for
1533 : ! all molecules, which is good enough in terms of calculating the diffusivity
1534 : ! as long as molecule is not too big.
1535 : !
1536 : ! !REVISION HISTORY:
1537 : ! 22 Jun 2009 - R. Yantosca - Copied from "drydep_mod.f"
1538 : ! See https://github.com/geoschem/hemco for complete history
1539 : !EOP
1540 : !------------------------------------------------------------------------------
1541 : !BOC
1542 : !
1543 : ! !DEFINED PARAMETERS:
1544 : !
1545 : REAL(hp), PARAMETER :: XMAIR = 28.8e-3_hp
1546 : REAL(hp), PARAMETER :: RADAIR = 1.2e-10_hp
1547 : REAL(hp), PARAMETER :: PI = 3.14159265358979323e+0_hp
1548 : REAL(hp), PARAMETER :: RADX = 1.5e-10_hp
1549 : REAL(hp), PARAMETER :: RGAS = 8.32e+0_hp
1550 : REAL(hp), PARAMETER :: AVOGAD = 6.022140857e+23_hp
1551 : !
1552 : ! !LOCAL VARIABLES:
1553 : !
1554 : REAL(hp) :: AIRDEN, Z, DIAM, FRPATH, SPEED
1555 :
1556 : !=================================================================
1557 : ! DIFFG begins here!
1558 : !=================================================================
1559 :
1560 : ! Air density
1561 0 : AIRDEN = ( PRESS * AVOGAD ) / ( RGAS * TK )
1562 :
1563 : ! DIAM is the collision diameter for gas X with air.
1564 0 : DIAM = RADX + RADAIR
1565 :
1566 : ! Calculate the mean free path for gas X in air:
1567 : ! eq. 8.5 of Seinfeld [1986];
1568 0 : Z = XM / XMAIR
1569 0 : FRPATH = 1e+0_hp /( PI * SQRT( 1e+0_hp + Z ) * AIRDEN*( DIAM**2 ) )
1570 :
1571 : ! Calculate average speed of gas X; eq. 15.47 of Levine [1988]
1572 0 : SPEED = SQRT( 8e+0_hp * RGAS * TK / ( PI * XM ) )
1573 :
1574 : ! Calculate diffusion coefficient of gas X in air;
1575 : ! eq. 8.9 of Seinfeld [1986]
1576 0 : DIFF_G = ( 3e+0_hp * PI / 32e+0_hp ) * ( 1e+0_hp + Z ) * FRPATH * SPEED
1577 :
1578 0 : END FUNCTION DiffG
1579 : !EOC
1580 : !------------------------------------------------------------------------------
1581 : ! Harmonized Emissions Component (HEMCO) !
1582 : !------------------------------------------------------------------------------
1583 : !BOP
1584 : !
1585 : ! !IROUTINE: Get_Dep_N
1586 : !
1587 : ! !DESCRIPTION: Subroutine GET\_DEP\_N sums dry and wet deposition since prev.
1588 : ! timestep and calculates contribution to fertilizer N source. Output is in
1589 : ! kg NO/m2.
1590 : !\\
1591 : !\\
1592 : ! !INTERFACE:
1593 : !
1594 0 : SUBROUTINE Get_Dep_N( I, J, ExtState, HcoState, Inst, DEP_FERT )
1595 : !
1596 : ! !INPUT PARAMETERS:
1597 : !
1598 : INTEGER, INTENT(IN) :: I
1599 : INTEGER, INTENT(IN) :: J
1600 : TYPE(Ext_State), POINTER :: ExtState
1601 : TYPE(HCO_State), POINTER :: HcoState
1602 : TYPE(MyInst), POINTER :: Inst
1603 : !
1604 : ! !INPUT/OUTPUT PARAMETERS:
1605 : !
1606 : ! Dep emitted as Fert [kgNO/m2]
1607 : REAL(hp) , INTENT(INOUT) :: DEP_FERT
1608 : !
1609 : ! !REVISION HISTORY:
1610 : ! See https://github.com/geoschem/hemco for complete history
1611 : !EOP
1612 : !------------------------------------------------------------------------------
1613 : !BOC
1614 : !
1615 : ! !DEFINED PARAMETERS:
1616 : !
1617 : REAL(hp), PARAMETER :: TAU_MONTHS = 6.0_hp ! Decay rate of dep. N [mon]
1618 : REAL(hp), PARAMETER :: SECPERDAY = 86400.0_hp
1619 : REAL(hp), PARAMETER :: DAYSPERMONTH = 30.0_hp
1620 : !
1621 : ! !LOCAL VARIABLES:
1622 : !
1623 : REAL(hp) :: DRYN ! Dry dep. N since prev timestep
1624 : ! Units ng N/m2/s
1625 : REAL(hp) :: WETN ! Wet dep. N since prev timestep
1626 : REAL(hp) :: DEPN ! dep. N since prev timestep
1627 :
1628 : REAL(hp) :: C1
1629 : REAL(hp) :: C2
1630 : REAL(hp) :: TAU_SEC
1631 : REAL(hp) :: TS_SEC
1632 :
1633 : !Total all N species & convert molec/cm2/s --> kg NO/m2/s
1634 0 : DRYN = SOURCE_DRYN( I, J, ExtState, HcoState, Inst )
1635 :
1636 : !Total all N species & convert kg/s --> kg NO/m2/s
1637 0 : WETN = SOURCE_WETN( I, J, ExtState, HcoState )
1638 :
1639 : ! Sum wet and dry deposition [kg NO/m2/s]
1640 0 : DEPN = DRYN + WETN
1641 :
1642 : ! Emission Timestep in seconds
1643 0 : TS_SEC = HcoState%TS_EMIS
1644 :
1645 : !Do mass balance (see Intro to Atm Chem Chap. 3)
1646 : !m(t) = m(0) * exp(-t/tau) + Source * tau * (1 - exp(-t/tau))
1647 :
1648 : !convert months --> seconds (assume 30 days months)
1649 0 : TAU_SEC = TAU_MONTHS * DAYSPERMONTH * SECPERDAY
1650 :
1651 0 : C1 = EXP( -TS_SEC / TAU_SEC )
1652 0 : C2 = 1.0_hp - C1
1653 :
1654 : ! kg NO/m2
1655 : ! NOTE: DEP_RESERVOIR is stored in kg NO/m3, but we just assume
1656 : ! that this is kg NO/m2.
1657 0 : Inst%DEP_RESERVOIR(I,J) = ( Inst%DEP_RESERVOIR (I,J) * C1 ) &
1658 0 : + DEPN * TAU_SEC * C2
1659 :
1660 : ! 40% runoff.
1661 0 : DEP_FERT = Inst%DEP_RESERVOIR(I,J) * 0.6_hp
1662 :
1663 0 : END SUBROUTINE Get_Dep_N
1664 : !EOC
1665 : !------------------------------------------------------------------------------
1666 : ! Harmonized Emissions Component (HEMCO) !
1667 : !------------------------------------------------------------------------------
1668 : !BOP
1669 : !
1670 : ! !IROUTINE: Source_DryN
1671 : !
1672 : ! !DESCRIPTION: Subroutine SOURCE\_DRYN gets dry deposited Nitrogen since
1673 : ! last emission time step, converts to kg NO/m2/s.
1674 : !\\
1675 : !\\
1676 : ! !INTERFACE:
1677 : !
1678 0 : FUNCTION Source_Dryn( I, J, ExtState, HcoState, Inst ) RESULT( DRYN )
1679 : !
1680 : ! !INPUT PARAMETERS:
1681 : !
1682 : INTEGER, INTENT(IN) :: I
1683 : INTEGER, INTENT(IN) :: J
1684 : TYPE(Ext_State), POINTER :: ExtState ! Module options
1685 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
1686 : TYPE(MyInst), POINTER :: Inst
1687 : !
1688 : ! !RETURN VALUE:
1689 : !
1690 : REAL(hp) :: DRYN ! Dry dep. N since prev timestep
1691 : !
1692 : ! !REVISION HISTORY:
1693 : ! See https://github.com/geoschem/hemco for complete history
1694 : !EOP
1695 : !------------------------------------------------------------------------------
1696 : !BOC
1697 : !
1698 : ! !LOCAL VARIABLES:
1699 : !
1700 : REAL(hp), PARAMETER :: CM2_PER_M2 = 1.0e+4_hp
1701 : REAL(hp) :: NTS
1702 :
1703 : ! Divide through by number of chemistry timesteps
1704 : ! because DRY_TOTN is summed over chemistry timesteps
1705 : ! need to get average
1706 :
1707 : !Molecules/cm2/s --> kg NO/m2/s
1708 0 : NTS = HcoState%TS_EMIS / HcoState%TS_CHEM
1709 0 : DRYN = ExtState%DRY_TOTN%Arr%Val(I,J) * CM2_PER_M2 / NTS / &
1710 0 : HcoState%Phys%Avgdr * HcoState%Spc(Inst%IDTNO)%MW_g / 1000.0_hp
1711 :
1712 0 : END FUNCTION Source_DryN
1713 : !EOC
1714 : !------------------------------------------------------------------------------
1715 : ! Harmonized Emissions Component (HEMCO) !
1716 : !------------------------------------------------------------------------------
1717 : !BOP
1718 : !
1719 : ! !IROUTINE: Source_WetN
1720 : !
1721 : ! !DESCRIPTION: Subroutine Source\_WetN gets wet deposited Nitrogen since
1722 : ! last emission time step, converts to kg NO/m2/s.
1723 : !\\
1724 : !\\
1725 : ! !INTERFACE:
1726 : !
1727 0 : FUNCTION Source_WetN( I, J, ExtState, HcoState ) RESULT(WETN )
1728 : !
1729 : ! !INPUT PARAMETERS:
1730 : !
1731 : INTEGER, INTENT(IN) :: I
1732 : INTEGER, INTENT(IN) :: J
1733 : TYPE(Ext_State), POINTER :: ExtState ! Module options
1734 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
1735 : !
1736 : ! !RETURN VALUE:
1737 : !
1738 : REAL(hp) :: WETN ! Dry dep. N since prev timestep
1739 : !
1740 : ! !REVISION HISTORY:
1741 : ! See https://github.com/geoschem/hemco for complete history
1742 : !EOP
1743 : !------------------------------------------------------------------------------
1744 : !BOC
1745 : !
1746 : ! !LOCAL VARIABLES:
1747 : !
1748 : REAL(hp) :: NTS, AREA_M2
1749 :
1750 : ! Divide through by number of transport timesteps
1751 : ! because WET_TOTN is summed over transport timesteps
1752 : ! need to get average
1753 :
1754 0 : NTS = HcoState%TS_EMIS / HcoState%TS_DYN
1755 0 : AREA_M2 = HcoState%Grid%AREA_M2%Val(I,J)
1756 :
1757 : ! Total N wet dep
1758 0 : WETN = ExtState%WET_TOTN%Arr%Val(I,J) / AREA_M2 / NTS
1759 :
1760 0 : END FUNCTION Source_WetN
1761 : !EOC
1762 : !------------------------------------------------------------------------------
1763 : ! Harmonized Emissions Component (HEMCO) !
1764 : !------------------------------------------------------------------------------
1765 : !BOP
1766 : !
1767 : ! !IROUTINE: SoilTemp
1768 : !
1769 : ! !DESCRIPTION: Function SoilTemp computes the temperature-dependent term
1770 : ! of the soil NOx emissions in ng N/m2/s and converts to molec/cm2/s
1771 : !\\
1772 : !\\
1773 : ! !INTERFACE:
1774 : !
1775 0 : FUNCTION SoilTemp( NN, TC, GWET ) RESULT( SOIL_TEMP )
1776 : !
1777 : ! !INPUT PARAMETERS:
1778 : !
1779 : INTEGER, INTENT(IN) :: NN ! Soil biome type
1780 : REAL(hp), INTENT(IN) :: TC ! Surface air temperature [C]
1781 : REAL(hp), INTENT(IN) :: GWET ! Top soil moisture
1782 : !
1783 : ! !RETURN VALUE:
1784 : !
1785 : REAL(hp) :: SOIL_TEMP ! Temperature-dependent term of
1786 : ! soil NOx emissions [unitless]
1787 : !
1788 : ! !REMARKS:
1789 : ! Based on Ormeci et al., [1999] and Otter et al., [1999]
1790 : ! there exists and entirely exponential relationship between
1791 : ! temperature and soil NOx emissions at constant soil moisture
1792 : ! Therefore we use the following relationship based
1793 : ! on Yienger and Levy et al., [1995] for temperatures 0-30C:
1794 : !
1795 : !
1796 : ! f(T) = exp( 0.103+/-0.04 * T )
1797 : ! in ng N/m2/s
1798 : !
1799 : !
1800 : ! where T is the temperature in degrees Celsius....Below
1801 : ! 0 C, we assume emissions are zero because they are insignificant
1802 : ! for the purposes of this global source. ...
1803 : !
1804 : ! References:
1805 : ! ============================================================================
1806 : ! (1 ) Ormeci, B., S. L. Sanin, and J. J. Pierce, Laboratory study of
1807 : ! NO flux from agricultural soil: Effects of soil moisture, pH,
1808 : ! and temperature, J. Geophys. Res., 104 ,16211629, 1999.
1809 : ! (2 ) Otter, L. B., W. X. Yang, M. C. Scholes, and F. X. Meixner,
1810 : ! Nitric oxide emissions from a southern African savanna, J.
1811 : ! Geophys. Res., 105 , 20,69720,706, 1999.
1812 : ! (3 ) Yienger, J.J, and H. Levy, Empirical model of global soil-biogenic
1813 : ! NOx emissions, J. Geophys. Res., 100, D6, 11,447-11464, June 20, 1995.
1814 : !
1815 : ! !REVISION HISTORY:
1816 : ! 17 Aug 2009 - R. Yantosca - Initial Version
1817 : ! See https://github.com/geoschem/hemco for complete history
1818 : !EOP
1819 : !------------------------------------------------------------------------------
1820 : !BOC
1821 : !
1822 : ! !LOCAL VARIABLES
1823 : !
1824 : REAL(hp) :: TMMP
1825 :
1826 : !==============================================================
1827 : ! 1) Convert from Surface Temp --> Soil Temp
1828 : !==============================================================
1829 :
1830 : ! Save surface air temp in shadow variable TMMP
1831 0 : TMMP = TC
1832 :
1833 : ! DRY
1834 0 : IF ( GWET < 0.3_hp ) THEN
1835 :
1836 : ! Convert surface air temperature to model temperature
1837 : ! by adding 5 degrees C to model temperature
1838 0 : TMMP = TMMP + 5.0_hp
1839 :
1840 : ! WET
1841 : ELSE
1842 :
1843 0 : TMMP = SOILTA(NN) * TMMP + SOILTB(NN)
1844 :
1845 : ENDIF
1846 :
1847 : !==============================================================
1848 : ! 2) Compute Temperature Dependence
1849 : !==============================================================
1850 :
1851 : ! Compute the soil temperature dependence term according
1852 : ! to equations 9b, 9a of Yienger & Levy [1995].
1853 : ! We now assume that soil response is exponential 0-30C
1854 : ! based on latest observations, caps at 30C
1855 :
1856 0 : IF ( TMMP <= 0.0_hp ) THEN
1857 :
1858 : ! No soil emissions if temp below freezing
1859 : SOIL_TEMP = 0.0_hp
1860 :
1861 : ELSE
1862 :
1863 : ! Caps temperature response at 30C
1864 0 : IF ( TMMP >= 30.0_hp ) TMMP = 30.0_hp
1865 :
1866 0 : SOIL_TEMP = EXP( 0.103_hp * TMMP )
1867 :
1868 : ENDIF
1869 :
1870 0 : END FUNCTION SoilTemp
1871 : !EOC
1872 : !----------------------------------------------------------------------------
1873 : ! Harmonized Emissions Component (HEMCO) !
1874 : !------------------------------------------------------------------------------
1875 : !BOP
1876 : !
1877 : ! !IROUTINE: SoilWet
1878 : !
1879 : ! !DESCRIPTION: Function SoilWet returns the soil moisture scaling
1880 : ! of soil NOx emissions (values from 0-1).
1881 : !\\
1882 : !\\
1883 : ! !INTERFACE:
1884 : !
1885 0 : FUNCTION SoilWet( GWET, ARID, NONARID ) RESULT( WETSCALE )
1886 : !
1887 : ! !INPUT PARAMETERS:
1888 : !
1889 : ! Top soil wetness [unitless]
1890 : REAL(hp), INTENT(IN) :: GWET
1891 :
1892 : ! Fraction of arid & non-arid soil in the gridbox
1893 : REAL(hp), INTENT(IN) :: ARID
1894 : REAL(hp), INTENT(IN) :: NONARID
1895 : !
1896 : ! !RETURN_VALUE:
1897 : !
1898 : ! A scaling term between 0-1 based on soil moisture
1899 : REAL(hp) :: WETSCALE
1900 : !
1901 : ! !REMARKS:
1902 : ! Soil moisture and temperature and now decoupled, the temperature
1903 : ! term is scaled with a value from 0-1 based on water filled pore space
1904 : ! WFPS in top-soil.
1905 : !
1906 : ! From N.E. Moore thesis:
1907 : ! The response of SNOx is not monotonic to WFPS. SNOx are low for the
1908 : ! extreme values of WFPS (0 and 1). For low values, emissions are
1909 : ! substrate-limited. For high values, emissions are trapped and cannot
1910 : ! diffuse to the surface [Yan et al., 2005]. SNOx dependence on soil
1911 : ! moisture is best described as a Poisson function [Parsons et al., 1996;
1912 : ! Otter et al., 1999; Pierce and Aneja, 2000; Kirkman et al., 2001;
1913 : ! van Dijk and Meixner, 2001; van Dijk et al., 2002]:
1914 : !
1915 : ! scaling = a*x*exp(-b*x^2)
1916 : !
1917 : ! where the values of a and b are chosen such that the maximum value
1918 : ! (unity) occurs for WFPS=0.3, which laboratory and field measurements have
1919 : ! found to be the optimal value for emissions in most soils. The typical
1920 : ! range of values are 0.2 (arid) up to 0.45 (floodplain)
1921 : ! [Yang and Meixner, 1997; Ormeci et al., 1999].
1922 : !
1923 : ! Rice paddies no longer have to be scaled as in the Yienger & Levy model.
1924 : !
1925 : ! References:
1926 : ! ============================================================================
1927 : ! (1 ) Galbally, I. E., and R. Roy, Loss of fixed nitrogen from soils
1928 : ! by nitric oxide exhalation, Nature, 275 , 734735, 1978.
1929 : ! (2 ) Kirkman, G. A., W. X. Yang, and F. X. Meixner, Biogenic nitric
1930 : ! oxide emissions upscaling: An approach for Zimbabwe, Global
1931 : ! Biogeochemical Cycles, 15 ,1005 1020, 2001.
1932 : ! (3 ) Ormeci, B., S. L. Sanin, and J. J. Pierce, Laboratory study of NO
1933 : ! flux from agricultural soil: Effects of soil moisture, pH, and
1934 : ! temperature, J. Geophys. Res., 104 , 16211629, 1999.
1935 : ! (4 ) Otter, L. B., W. X. Yang, M. C. Scholes, and F. X. Meixner,
1936 : ! Nitric oxide emissions from a southern African savanna, J.
1937 : ! Geophys. Res., 105 , 20,69720,706, 1999.
1938 : ! (5 ) Parsons, D. A., M. C. Scholes, R. J. Scholes, and J. S. Levine,
1939 : ! Biogenic NO emissions from savanna soils as a function of fire
1940 : ! regime, soil type, soil nitrogen, and water status, J. Geophys.
1941 : ! Res., 101 , 23,68323,688, 1996.
1942 : ! (6 ) Pierce, J. J., and V. P. Aneja, Nitric oxide emissions from
1943 : ! engineered soil systems, Journal of Environmental Engineering,
1944 : ! pp. 225232, 2000.
1945 : ! (7 ) van Dijk, S. M., and J. H. Duyzer, Nitric oxide emissions from
1946 : ! forest soils, J. Geophys. Res., 104 , 15,95515,961, 1999.
1947 : ! (8 ) van Dijk, S. M., and F. X. Meixner, Production and consumption of
1948 : ! NO in forest and pasture soils from the Amazon basin, Water, Air,
1949 : ! and Soil Pollution: Focus 1 , pp. 119130, 2001.
1950 : ! (9 ) Yang, W. X., and F. X. Meixner, Gaseous Nitrogen Emissions from
1951 : ! Grasslands, CAB Int., Wallingford, UK, 1997, 67-71.
1952 : !
1953 : ! !REVISION HISTORY:
1954 : ! 31 Jan 2011 - R. Hudman - Rewrote scaling scheme
1955 : ! See https://github.com/geoschem/hemco for complete history
1956 : !EOP
1957 : !------------------------------------------------------------------------------
1958 : !BOC
1959 : !
1960 : !Scale by soil moisture
1961 0 : IF ( ARID >= NONARID .AND. ARID > 0.0_hp ) THEN
1962 : !Arid, max Poisson = 0.2
1963 0 : WETSCALE = 8.24_hp * GWET * EXP( -12.5_hp * GWET * GWET )
1964 : ELSE
1965 : !Non-arid, max Poisson = 0.3
1966 0 : WETSCALE = 5.5_hp * GWET * EXP( -5.55_hp * GWET * GWET )
1967 : ENDIF
1968 :
1969 0 : END FUNCTION SoilWet
1970 : !EOC
1971 : !------------------------------------------------------------------------------
1972 : ! Harmonized Emissions Component (HEMCO) !
1973 : !------------------------------------------------------------------------------
1974 : !BOP
1975 : !
1976 : ! !IROUTINE: SoilCrf
1977 : !
1978 : ! !DESCRIPTION: Computes the canopy reduction factor for the soil NOx
1979 : ! emissions according to Jacob \% Bakwin [1991] (and as used in Wang
1980 : ! et al [1998]).
1981 : !\\
1982 : !\\
1983 : ! !INTERFACE:
1984 : !
1985 0 : FUNCTION SoilCrf( K, LAI, CPYNOX, WINDSQR, SUNCOS ) RESULT( SOIL_CRF )
1986 : !
1987 : ! !INPUT PARAMETERS:
1988 : !
1989 : INTEGER, INTENT(IN) :: K ! Soil biome type
1990 : REAL(hp), INTENT(IN) :: LAI ! Leaf area index [cm2/cm2]
1991 : REAL(hp), INTENT(IN) :: CPYNOX ! Bulk sfc resistance to NOx [1/s]
1992 : REAL(hp), INTENT(IN) :: WINDSQR ! Square of sfc wind speed [m2/s2]
1993 : REAL(hp), INTENT(IN) :: SUNCOS ! Cosine of solar zenith angle
1994 : !
1995 : ! !RETURN_VALUE:
1996 : !
1997 : REAL(hp) :: SOIL_CRF ! Canopy reduction factor (see below)
1998 : !
1999 : ! !REMARKS:
2000 : ! Also note, CANOPYNOX (the bulk surface resistance to NOx) is computed
2001 : ! in routine GET_CANOPY_NOx (in "canopy_nox_mod.f") and is passed here
2002 : ! as an argument.
2003 : !
2004 : ! !REVISION HISTORY:
2005 : ! 17 Aug 2009 - R. Yantosca - Initial Version
2006 : ! See https://github.com/geoschem/hemco for complete history
2007 : !EOP
2008 : !------------------------------------------------------------------------------
2009 : !BOC
2010 : !
2011 : ! !DEFINED PARAMETERS:
2012 : !
2013 : ! Ventilation velocity for NOx, day & night values [m/s]
2014 : REAL(hp), PARAMETER :: VFDAY = 1.0e-2_hp
2015 : REAL(hp), PARAMETER :: VFNIGHT = 0.2e-2_hp
2016 : !
2017 : ! !LOCAL VARIABLES:
2018 : !
2019 : REAL(hp) :: VFNEW
2020 :
2021 : ! Pick proper ventilation velocity for day or night
2022 0 : IF ( SUNCOS > 0.0_hp ) THEN
2023 : VFNEW = VFDAY
2024 : ELSE
2025 0 : VFNEW = VFNIGHT
2026 : ENDIF
2027 :
2028 : ! If the leaf area index and the bulk surface resistance
2029 : ! of the canopy to NOx deposition are both nonzero ...
2030 0 : IF ( LAI > 0.0_hp .and. CPYNOX > 0.0_hp ) THEN
2031 :
2032 : ! Adjust the ventilation velocity.
2033 : ! NOTE: SOILEXC(21) is the canopy wind extinction
2034 : ! coefficient for the tropical rainforest biome.
2035 : VFNEW = ( VFNEW * SQRT( WINDSQR/9.0_hp * 7.0_hp/LAI ) &
2036 0 : * ( SOILEXC(21) / SOILEXC(K) ) )
2037 :
2038 : ! Soil canopy reduction factor
2039 0 : SOIL_CRF = CPYNOX / ( CPYNOX + VFNEW )
2040 :
2041 : ELSE
2042 :
2043 : ! Otherwise set the soil canopy reduction factor to zero
2044 : SOIL_CRF = 0.0_hp
2045 :
2046 : ENDIF
2047 :
2048 0 : END FUNCTION SoilCrf
2049 : !EOC
2050 : !-----------------------------------------------------------------------------
2051 : ! Harmonized Emissions Component (HEMCO) !
2052 : !------------------------------------------------------------------------------
2053 : !BOP
2054 : !
2055 : ! !IROUTINE: FertAdd
2056 : !
2057 : ! !DESCRIPTION: Function FertAdd computes fertilizer emissions
2058 : !\\
2059 : !\\
2060 : ! !INTERFACE:
2061 : !
2062 0 : FUNCTION FertAdd( SOILFRT, DEPN ) RESULT( FERT_ADD )
2063 : !
2064 : ! !INPUT PARAMETERS:
2065 : !
2066 : REAL(hp), INTENT(IN) :: DEPN ! N emissions from deposition
2067 : REAL(hp), INTENT(IN) :: SOILFRT ! N emissions from fertilizers
2068 : ! read in from disk and passed
2069 : ! here as an argument [ng N/m2/s]
2070 : !
2071 : ! !RETURN_VALUE:
2072 : !
2073 : REAL(hp) :: FERT_ADD ! Total Fert emissions
2074 : !
2075 : ! !REMARKS:
2076 : ! We use a new spatially explicit data set of chemical and manure fert
2077 : ! (native resolution 0.5\B0x0.5\B0) from Potter et al., [2010]
2078 : ! distributed using MODIS EVI seasonality as described in
2079 : ! N.E. Moore thesis, and Hudman et al., in prep.
2080 : !
2081 : ! In previous model, fertilizer emissions were emitted instantaneously as
2082 : ! 2.5% of applied fertilizer, independent of soil moisture/soil temperature,
2083 : ! so that they were constant over the growing season.
2084 : !
2085 : ! Similar to the YL parameterization, we now treat fertilizer emissions
2086 : ! as part of the Aw. If we treat the wet biome coefficient as a measure of
2087 : ! available N multiplied by a mean emission rate, we can treat fertilizer
2088 : ! N in the same manner.
2089 : !
2090 : ! AW = SOILAW(BinewsoilAWS_08112011_emissonlyome) + N available in soil
2091 : ! x mean emission rate
2092 : !
2093 : ! Instead of choosing an emission rate for each box equivalent to 2.5%
2094 : ! of applied N yearly as done in the YL scheme, we chose the mean emission
2095 : ! rate so that the total global above canopy SNOx due to fertilizer matches
2096 : ! observed estimates of fertilizer emissions of 1.8 Tg N yr-1 from Stehfest
2097 : ! and Bouman [2006]. This treatment allows for interannual and daily
2098 : ! variability in the strength of response to temperature and precipitation.
2099 : ! Note: this scaling must be set for each resolution.
2100 : !
2101 : ! References:
2102 : ! ============================================================================
2103 : ! (1 ) Potter, P., Ramankutty, N., Bennett, E., and Donner, S.:
2104 : ! Characterizing the Spatial Patterns of Global Fertilizer
2105 : ! Application and Manure Production, Earth Interactions,
2106 : ! in press, 2010.
2107 : ! (2 ) Stehfest, E. and L. Bouwman, N2O and NO emission from
2108 : ! agricultural fields and soils under natural vegetation:
2109 : ! summarizing available measurement data and modeling
2110 : ! of global annual emissions, Nutrient Cycling in Agroecosystems
2111 : ! (2006), 74:207-228 DOI 10.1007/s10705-006-9000-7.
2112 : !
2113 : ! !REVISION HISTORY:
2114 : ! 31 Jan 2011 - R. Hudman - Rewrote pulsing scheme
2115 : ! See https://github.com/geoschem/hemco for complete history
2116 : !EOP
2117 : !------------------------------------------------------------------------------
2118 : !BOC
2119 : !
2120 : ! Seconds per year
2121 : REAL(hp), PARAMETER :: SEC_PER_YEAR = 3.1536e+7_hp
2122 :
2123 :
2124 : ! Soil fert and dep [ kg/m2 ], a measure of N avail. in soil
2125 0 : FERT_ADD = ( SOILFRT + DEPN ) / SEC_PER_YEAR
2126 :
2127 : ! Convert [ng N/m2] --> [kg/m2/s]
2128 : ! (scale needed to force fert emiss of 1.8 Tg N/yr w/o canopy uptake)
2129 : ! FERT_ADD = FERT_ADD * FERT_SCALE
2130 :
2131 0 : END FUNCTION FERTADD
2132 : !EOC
2133 : !------------------------------------------------------------------------------
2134 : ! Harmonized Emissions Component (HEMCO) !
2135 : !------------------------------------------------------------------------------
2136 : !BOP
2137 : !
2138 : ! !IROUTINE: Pulsing
2139 : !
2140 : ! !DESCRIPTION: Function Pulsing calculates the increase (or "pulse") of
2141 : ! soil NOx emission that happens after preciptiation falls on dry soil.
2142 : ! .
2143 : ! According to Yan et al., [2005] , this pulsing process is thought to
2144 : ! be due to a release of inorganic nitrogen trapped on top of the dry soil
2145 : ! and a subsequent reactivation of water-stressed bacteria, which then
2146 : ! metabolize the excess nitrogen. This can happen in seasonally dry
2147 : ! grasslands and savannahs or over freshly fertilized fields.
2148 : !\\
2149 : !\\
2150 : ! !INTERFACE:
2151 : !
2152 0 : FUNCTION Pulsing( GWET, TS_EMIS, &
2153 : GWET_PREV, PFACTOR, DRYPERIOD ) &
2154 : RESULT( THE_PULSING )
2155 : !
2156 : ! !INPUT PARAMETERS:
2157 : !
2158 : REAL(hp), INTENT(IN) :: GWET ! Soil Moisture
2159 : REAL*4, INTENT(IN) :: TS_EMIS ! Emissions timestep [s]
2160 :
2161 : ! !INPUT/OUTPUT PARAMETERS:
2162 : !
2163 : REAL(sp), INTENT(INOUT) :: GWET_PREV ! Soil Moisture Prev timestep
2164 : REAL(sp), INTENT(INOUT) :: PFACTOR ! Pulsing Factor
2165 : REAL(sp), INTENT(INOUT) :: DRYPERIOD ! Dry period length in hours
2166 : !
2167 : ! !RETURN VALUE:
2168 : !
2169 : REAL(hp) :: THE_PULSING ! Factor to multiply baseline
2170 : ! emissions by to account for
2171 : ! soil pulsing of all types
2172 : !
2173 : ! !REMARKS:
2174 : ! Soil NOx emissions consist of baseline emissions plus discrete "pulsing"
2175 : ! episodes. We follow thw Yan et al., [2005] algorithm, where the pulse
2176 : ! (relative to the flux prewetting) is determined by the antecedent dry
2177 : ! period, with a simple logarithmic relationship,
2178 : !
2179 : ! PFACTOR = 13.01 ln ( DRYPERIOD ) - 53.6
2180 : !
2181 : ! where PFACTOR is the magnitude of peak flux relative to prewetting flux,
2182 : ! and DRYPERIOD is the length of the antecedent dry period in hours.
2183 : !
2184 : ! The pulse decays with
2185 : !
2186 : ! PFACTOR = PFACTOR * EXP( -0.068e+0_hp * DTSRCE )
2187 : !
2188 : ! References:
2189 : ! ============================================================================
2190 : ! (1 ) Yan, X., T. Ohara, and H. Akimoto (2005), Statistical modeling of
2191 : ! global soil NOx emissions, Global Biogeochem. Cycles, 19, GB3019,
2192 : ! doi:10.1029/2004GB002276.Section 2.3.3
2193 : !
2194 : ! !REVISION HISTORY:
2195 : ! 31 Jan 2011 - R. Hudman - Rewrote pulsing scheme
2196 : ! See https://github.com/geoschem/hemco for complete history
2197 : !EOP
2198 : !------------------------------------------------------------------------------
2199 : !BOC
2200 : !
2201 : ! !LOCAL VARIABLES:
2202 : !
2203 : REAL(hp) :: DTSRCE, GDIFF
2204 :
2205 : !=================================================================
2206 : ! PULSING begins here!
2207 : !=================================================================
2208 :
2209 : ! Emission timestep [s --> hours]
2210 0 : DTSRCE = TS_EMIS / 3600.0_hp
2211 :
2212 : ! If soil moisture less than 0.3 and no pulse is taking place
2213 0 : IF ( GWET < 0.3_hp .and. PFACTOR == 1.0_hp) THEN
2214 :
2215 : ! Get change in soil moisture since previous timestep
2216 0 : GDIFF = ( GWET - GWET_PREV )
2217 :
2218 : ! If change in soil moisture is > 0.01 (rains)
2219 0 : IF ( GDIFF > 0.01_hp ) THEN
2220 :
2221 : ! Initialize new pulse factor (dry period hours)
2222 0 : IF ( DRYPERIOD > 0.0_hp ) THEN
2223 0 : PFACTOR = 13.01_hp * LOG( DRYPERIOD ) - 53.6_hp
2224 : ELSE
2225 0 : PFACTOR = -53.6_hp
2226 : ENDIF
2227 :
2228 : ! If dry period < ~3 days then no pulse
2229 0 : IF ( PFACTOR < 1.0_hp ) PFACTOR = 1.0_hp
2230 :
2231 : ! Reinitialize dry period
2232 0 : DRYPERIOD = 0.0_hp
2233 :
2234 : ! If no rain (i.e., change in soil moisture is < 0.01)
2235 : ELSE
2236 :
2237 : ! Add one timestep to dry period
2238 0 : DRYPERIOD = DRYPERIOD + DTSRCE
2239 :
2240 : ENDIF
2241 :
2242 : ! If box is already pulsing , then decay pulse one timestep
2243 0 : ELSEIF ( PFACTOR /= 1.0_hp ) THEN
2244 :
2245 : ! Decay pulse
2246 0 : PFACTOR = PFACTOR * EXP( -0.068_hp * DTSRCE )
2247 :
2248 : ! Update dry period
2249 0 : IF ( GWET < 0.3_hp ) DRYPERIOD = DRYPERIOD + DTSRCE
2250 :
2251 : ! If end of pulse
2252 0 : IF ( PFACTOR < 1.0_hp ) PFACTOR = 1.0_hp
2253 :
2254 : ENDIF
2255 :
2256 : ! Update soil moisture holder for previous timestep
2257 0 : GWET_PREV = GWET
2258 :
2259 : ! Return the pulsing factor
2260 0 : THE_PULSING = PFACTOR
2261 :
2262 0 : END FUNCTION Pulsing
2263 : !EOC
2264 : !------------------------------------------------------------------------------
2265 : ! Harmonized Emissions Component (HEMCO) !
2266 : !------------------------------------------------------------------------------
2267 : !BOP
2268 : !
2269 : ! !IROUTINE: InstGet
2270 : !
2271 : ! !DESCRIPTION: Subroutine InstGet returns a pointer to the desired instance.
2272 : !\\
2273 : !\\
2274 : ! !INTERFACE:
2275 : !
2276 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
2277 : !
2278 : ! !INPUT PARAMETERS:
2279 : !
2280 : INTEGER :: Instance
2281 : TYPE(MyInst), POINTER :: Inst
2282 : INTEGER :: RC
2283 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
2284 : !
2285 : ! !REVISION HISTORY:
2286 : ! 18 Feb 2016 - C. Keller - Initial version
2287 : ! See https://github.com/geoschem/hemco for complete history
2288 : !EOP
2289 : !------------------------------------------------------------------------------
2290 : !BOC
2291 : TYPE(MyInst), POINTER :: PrvInst
2292 :
2293 : !=================================================================
2294 : ! InstGet begins here!
2295 : !=================================================================
2296 :
2297 : ! Get instance. Also archive previous instance.
2298 0 : PrvInst => NULL()
2299 0 : Inst => AllInst
2300 0 : DO WHILE ( ASSOCIATED(Inst) )
2301 0 : IF ( Inst%Instance == Instance ) EXIT
2302 0 : PrvInst => Inst
2303 0 : Inst => Inst%NextInst
2304 : END DO
2305 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
2306 0 : RC = HCO_FAIL
2307 0 : RETURN
2308 : ENDIF
2309 :
2310 : ! Pass output arguments
2311 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
2312 :
2313 : ! Cleanup & Return
2314 0 : PrvInst => NULL()
2315 0 : RC = HCO_SUCCESS
2316 :
2317 : END SUBROUTINE InstGet
2318 : !EOC
2319 : !------------------------------------------------------------------------------
2320 : ! Harmonized Emissions Component (HEMCO) !
2321 : !------------------------------------------------------------------------------
2322 : !BOP
2323 : !
2324 : ! !IROUTINE: InstCreate
2325 : !
2326 : ! !DESCRIPTION: Subroutine InstCreate adds a new instance to the list of
2327 : ! instances, assigns a unique instance number to this new instance, and
2328 : ! archives this instance number to output argument Instance.
2329 : !\\
2330 : !\\
2331 : ! !INTERFACE:
2332 : !
2333 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
2334 : !
2335 : ! !INPUT PARAMETERS:
2336 : !
2337 : INTEGER, INTENT(IN) :: ExtNr
2338 : !
2339 : ! !OUTPUT PARAMETERS:
2340 : !
2341 : INTEGER, INTENT( OUT) :: Instance
2342 : TYPE(MyInst), POINTER :: Inst
2343 : !
2344 : ! !INPUT/OUTPUT PARAMETERS:
2345 : !
2346 : INTEGER, INTENT(INOUT) :: RC
2347 : !
2348 : ! !REVISION HISTORY:
2349 : ! 18 Feb 2016 - C. Keller - Initial version
2350 : ! See https://github.com/geoschem/hemco for complete history
2351 : !EOP
2352 : !------------------------------------------------------------------------------
2353 : !BOC
2354 : TYPE(MyInst), POINTER :: TmpInst
2355 : INTEGER :: nnInst
2356 :
2357 : !=================================================================
2358 : ! InstCreate begins here!
2359 : !=================================================================
2360 :
2361 : ! ----------------------------------------------------------------
2362 : ! Generic instance initialization
2363 : ! ----------------------------------------------------------------
2364 :
2365 : ! Initialize
2366 0 : Inst => NULL()
2367 :
2368 : ! Get number of already existing instances
2369 0 : TmpInst => AllInst
2370 0 : nnInst = 0
2371 0 : DO WHILE ( ASSOCIATED(TmpInst) )
2372 0 : nnInst = nnInst + 1
2373 0 : TmpInst => TmpInst%NextInst
2374 : END DO
2375 :
2376 : ! Create new instance
2377 0 : ALLOCATE(Inst)
2378 0 : Inst%Instance = nnInst + 1
2379 0 : Inst%ExtNr = ExtNr
2380 :
2381 : ! Attach to instance list
2382 0 : Inst%NextInst => AllInst
2383 0 : AllInst => Inst
2384 :
2385 : ! Update output instance
2386 0 : Instance = Inst%Instance
2387 :
2388 : ! ----------------------------------------------------------------
2389 : ! Type specific initialization statements follow below
2390 : ! ----------------------------------------------------------------
2391 :
2392 : ! Make sure pointers are not dangling
2393 0 : Inst%DRYCOEFF => NULL()
2394 0 : Inst%CLIMARID => NULL()
2395 0 : Inst%CLIMNARID => NULL()
2396 0 : Inst%SOILFERT => NULL()
2397 0 : Inst%LANDTYPE => NULL()
2398 :
2399 : ! Return w/ success
2400 0 : RC = HCO_SUCCESS
2401 :
2402 0 : END SUBROUTINE InstCreate
2403 : !EOC
2404 : !------------------------------------------------------------------------------
2405 : ! Harmonized Emissions Component (HEMCO) !
2406 : !------------------------------------------------------------------------------
2407 : !BOP
2408 : !
2409 : ! !IROUTINE: InstRemove
2410 : !
2411 : ! !DESCRIPTION: Subroutine InstRemove removes an instance from the list of
2412 : ! instances.
2413 : !\\
2414 : !\\
2415 : ! !INTERFACE:
2416 : !
2417 0 : SUBROUTINE InstRemove ( ExtState )
2418 : !
2419 : ! !INPUT PARAMETERS:
2420 : !
2421 : TYPE(Ext_State), POINTER :: ExtState ! Extension state
2422 : !
2423 : ! !REVISION HISTORY:
2424 : ! 18 Feb 2016 - C. Keller - Initial version
2425 : ! See https://github.com/geoschem/hemco for complete history
2426 : !EOP
2427 : !------------------------------------------------------------------------------
2428 : !BOC
2429 : INTEGER :: RC
2430 : INTEGER :: I
2431 : TYPE(MyInst), POINTER :: PrevInst
2432 : TYPE(MyInst), POINTER :: Inst
2433 :
2434 : !=================================================================
2435 : ! InstRemove begins here!
2436 : !=================================================================
2437 :
2438 : ! Get instance. Also archive previous instance.
2439 0 : PrevInst => NULL()
2440 0 : Inst => NULL()
2441 0 : CALL InstGet ( ExtState%SoilNOx, Inst, RC, PrevInst=PrevInst )
2442 :
2443 : ! Instance-specific deallocation
2444 0 : IF ( ASSOCIATED(Inst) ) THEN
2445 :
2446 : !---------------------------------------------------------------------
2447 : ! Deallocate fields of Inst before popping off from the list
2448 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
2449 : !---------------------------------------------------------------------
2450 0 : IF ( ALLOCATED( Inst%PFACTOR ) ) THEN
2451 0 : DEALLOCATE( Inst%PFACTOR )
2452 : ENDIF
2453 :
2454 0 : IF ( ALLOCATED( Inst%GWET_PREV ) ) THEN
2455 0 : DEALLOCATE( Inst%GWET_PREV )
2456 : ENDIF
2457 :
2458 0 : IF ( ALLOCATED( Inst%CANOPYNOX ) ) THEN
2459 0 : DEALLOCATE( Inst%CANOPYNOX )
2460 : ENDIF
2461 :
2462 0 : IF ( ALLOCATED( Inst%DEP_RESERVOIR ) ) THEN
2463 0 : DEALLOCATE( Inst%DEP_RESERVOIR )
2464 : ENDIF
2465 :
2466 0 : IF ( ALLOCATED( Inst%SpcScalVal ) ) THEN
2467 0 : DEALLOCATE( Inst%SpcScalVal )
2468 : ENDIF
2469 :
2470 0 : IF ( ALLOCATED( Inst%SpcScalFldNme ) ) THEN
2471 0 : DEALLOCATE( Inst%SpcScalFldNme )
2472 : ENDIF
2473 :
2474 0 : IF ( ASSOCIATED( Inst%FertNO_Diag ) ) THEN
2475 0 : DEALLOCATE( Inst%FertNO_Diag )
2476 : ENDIF
2477 0 : Inst%FertNO_Diag => NULL()
2478 :
2479 0 : IF ( ASSOCIATED( Inst%CLIMARID ) ) THEN
2480 0 : DEALLOCATE( Inst%CLIMARID )
2481 : ENDIF
2482 0 : Inst%CLIMARID => NULL()
2483 :
2484 0 : IF ( ASSOCIATED( Inst%CLIMNARID ) ) THEN
2485 0 : DEALLOCATE( Inst%CLIMNARID )
2486 : ENDIF
2487 0 : Inst%CLIMNARID => NULL()
2488 :
2489 0 : IF ( ASSOCIATED( Inst%SOILFERT ) ) THEN
2490 0 : DEALLOCATE( Inst%SOILFERT )
2491 : ENDIF
2492 0 : Inst%SOILFERT => NULL()
2493 :
2494 : ! Deallocate LANDTYPE vector
2495 0 : IF ( ASSOCIATED(Inst%LANDTYPE) ) THEN
2496 0 : DO I = 1,NBIOM
2497 0 : IF ( ASSOCIATED( Inst%LANDTYPE(I)%VAL ) ) THEN
2498 0 : DEALLOCATE( Inst%LANDTYPE(I)%Val )
2499 : ENDIF
2500 0 : Inst%LANDTYPE(I)%Val => NULL()
2501 : ENDDO
2502 0 : DEALLOCATE ( Inst%LANDTYPE )
2503 :
2504 : ENDIF
2505 0 : Inst%LANDTYPE => NULL()
2506 :
2507 : ! Eventually deallocate DRYCOEFF.
2508 : ! Make sure ExtState DRYCOEFF pointer is not dangling!
2509 0 : IF ( ASSOCIATED ( Inst%DRYCOEFF ) ) THEN
2510 0 : DEALLOCATE ( Inst%DRYCOEFF )
2511 0 : ExtState%DRYCOEFF => NULL()
2512 : ENDIF
2513 0 : Inst%DRYCOEFF => NULL()
2514 :
2515 : !---------------------------------------------------------------------
2516 : ! Pop off instance from list
2517 : !---------------------------------------------------------------------
2518 0 : IF ( ASSOCIATED(PrevInst) ) THEN
2519 0 : PrevInst%NextInst => Inst%NextInst
2520 : ELSE
2521 0 : AllInst => Inst%NextInst
2522 : ENDIF
2523 0 : DEALLOCATE(Inst)
2524 : ENDIF
2525 :
2526 : ! Free pointers before exiting
2527 0 : PrevInst => NULL()
2528 0 : Inst => NULL()
2529 :
2530 0 : END SUBROUTINE InstRemove
2531 : !EOC
2532 0 : END MODULE HCOX_SoilNOx_Mod
2533 : !EOM
|
