module_bioemi_simple.F
References to this file elsewhere.
1 MODULE module_bioemi_simple
2 ! ..
3 ! make sure that whatever you put in here agrees with dry_dep_simple
4 ! and met model luse stuff. This should be improved, but currently,
5 ! there is only usgs in wrf
6 !
7 USE module_data_radm2
8 INTEGER, PARAMETER :: nlu = 25, &
9 iswater_temp = 16,isice_temp = 24
10 REAL :: aefiso(nlu), aefmter(nlu), aefovoc(nlu), aef_n(nlu)
11 CHARACTER (4),PARAMETER :: mminlu_loc = 'USGS'
12 INTEGER :: ixxxlu(nlu)
13
14
15 CONTAINS
16 SUBROUTINE bio_emissions(id,ktau,dtstep,DX, &
17 config_flags, &
18 gmt,julday,t_phy,moist,p8w,t8w, &
19 e_bio,p_phy,chem,rho_phy,dz8w,ne_area, &
20 ivgtyp,gsw,vegfra,rmol,ust,znt,xlat,xlong,z_at_w, &
21 ids,ide, jds,jde, kds,kde, &
22 ims,ime, jms,jme, kms,kme, &
23 its,ite, jts,jte, kts,kte )
24 USE module_configure
25 USE module_state_description
26 IMPLICIT NONE
27 INTEGER, INTENT(IN ) :: id,julday, ne_area, &
28 ids,ide, jds,jde, kds,kde, &
29 ims,ime, jms,jme, kms,kme, &
30 its,ite, jts,jte, kts,kte
31 INTEGER, INTENT(IN ) :: &
32 ktau
33 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
34 INTENT(IN ) :: moist
35 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
36 INTENT(INOUT ) :: chem
37 REAL, DIMENSION( ims:ime, jms:jme, ne_area ), &
38 INTENT(INOUT ) :: e_bio
39 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
40 INTENT(IN ) :: &
41 t_phy, &
42 p_phy, &
43 dz8w, &
44 t8w,p8w,z_at_w , &
45 rho_phy
46 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
47 INTENT(IN ) :: &
48 ivgtyp
49 REAL, DIMENSION( ims:ime , jms:jme ) , &
50 INTENT(IN ) :: &
51 gsw, &
52 vegfra, &
53 rmol, &
54 ust, &
55 xlat, &
56 xlong, &
57 znt
58 REAL, INTENT(IN ) :: &
59 dtstep,dx,gmt
60 !--- deposition and emissions stuff
61 ! .. Parameters ..
62 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
63
64 ! ..
65 ! .. Local Arrays ..
66 ! .. Parameters ..
67 ! INTEGER, PARAMETER :: nlu = 25, &
68 ! nseason = 1, nseasons = 2
69 ! REAL :: aefiso(nlu), aefmter(nlu), aefovoc(nlu), aef_n(nlu)
70 REAL :: emiss_bio(ne_area) !wig, 1-May-2007: switched to ne_area from numgas to make more general
71 LOGICAL :: highnh3, rainflag, vegflag, wetflag
72 CHARACTER (4) :: luse_typ
73 ! ..
74 ! .. Local Scalars ..
75 REAL :: clwchem,eiso,eisoc,emter,emterc,eovoc,eovocc,e_n,e_nn, &
76 pa,rad, rhchem, ta, ustar, vegfrac, vocsc, xtimin, z1,zntt
77 INTEGER :: i,j,iland, iprt, iseason, n, nr, ipr,jpr,nvr
78
79
80 ! .. Intrinsic Functions ..
81 INTRINSIC max, min
82 !
83 luse_typ=mminlu_loc
84 ! print *,'luse_typ,iswater',luse_typ,iswater_temp
85 iseason=1
86 if(julday.lt.90.or.julday.gt.270)then
87 iseason=2
88 CALL wrf_debug(100,'setting iseason in bio_emi to 2')
89 endif
90
91
92 ! test program to test chemics stuff in 1-d
93
94 ! first prepare for biogenic emissions
95
96 CALL bioemiin(iseason,luse_typ,vegflag)
97 do 100 j=jts,jte
98 do 100 i=its,ite
99 iland = ivgtyp(i,j)
100 ta = t_phy(i,kts,j)
101 rad = gsw(i,j)
102 vegfrac = vegfra(i,j)
103 pa = .01*p_phy(i,kts,j)
104 clwchem = moist(i,kts,j,p_qc)
105 ustar = ust(i,j)
106 zntt = znt(i,j)
107 z1 = z_at_w(i,kts+1,j)-z_at_w(i,kts,j)
108
109 ! Set logical default values
110 rainflag = .FALSE.
111 wetflag = .FALSE.
112 highnh3 = .FALSE.
113
114 if(moist(i,kts,j,p_qr).gt.0.)rainflag = .true.
115 ! if(raincv(i,kts,j).gt.0. .and. rainncv(i,kts,j).gt.0. )rainflag = .true.
116
117 ! qvs = 380.*exp(17.27*(tair-273.)/(tair-36.))/pressure
118 rhchem = MIN( 100.,100. * moist(i,kts,j,p_qv) / &
119 (3.80*exp(17.27*(t_phy(i,kts,j)-273.)/(t_phy(i,kts,j)-36.))/pa))
120 rhchem = max(rhchem,5.)
121 if (rhchem >= 95.) wetflag = .true.
122 ! print *,chem(i,kts,j,p_nh3),chem(i,kts,j,p_so2)
123 if(chem(i,kts,j,p_nh3).gt.2.*chem(i,kts,j,p_so2))highnh3 = .true.
124 iseason = 1
125 !--- biogenic emissions
126 emiss_bio=0.
127 CALL biogen(iland,ta,rad,eiso,emter,eovoc,e_n,vocsc,eisoc,emterc,eovocc, &
128 e_nn,pa,luse_typ,iseason,vegflag)
129 ! if(i.eq.5.and.j.eq.5)then
130 ! print *,iland
131 ! print *,ta,rad,vocsc,pa,luse_typ,aefiso,aefovoc,aefmter, &
132 ! aef_n,ixxxlu,vegflag,isice_temp,iswater_temp
133 ! PRINT *, eiso, emter, eovoc, e_n, eisoc, eovocc
134 ! endif
135
136 ! PRINT *, eiso, emter, eovoc, e_n, eisoc, eovocc
137 CALL biosplit(iland,eiso,emter,eovoc,e_n,emiss_bio,ne_area,vegfrac, &
138 luse_typ,vegflag)
139 ! PRINT *, 'emiss_bio(liso) emiss_bio(lald) emiss_bio(lhcho) ', &
140 ! ' emiss_bio(lhc3)'
141 ! PRINT *, emiss_bio(liso), emiss_bio(lald), emiss_bio(lhcho), &
142 ! emiss_bio(lhc3)
143 DO n = 1, ne_area-2
144 e_bio(i,j,n) = emiss_bio(n)
145 ! if(i.eq.5.and.j.eq.5)print *,emiss_bio(n)
146 END DO
147 100 continue
148 END SUBROUTINE bio_emissions
149 ! **********************************************************************
150 ! ********************** SUBROUTINE BIOEMIIN **************************
151 ! **********************************************************************
152 SUBROUTINE bioemiin(isn,mminlu,vegflag)
153 !**********************************************************************
154 ! THIS SUBROUTINE INITIALIZES THE EMISSION FACTORS
155 ! AND THE SIMPLIFIED LANDUSE SCHEME
156 ! FOR THE BIOGENIC EMISSION AND DEPOSITION SUBROUTINES
157 ! WRITTEN BY: WINFRIED SEIDL (MARCH 2000)
158 ! CALLED BY:
159 ! CALLS: -
160 !**********************************************************************
161 !**********************************************************************
162 ! REFERENCES FOR EMISSION FACTORS:
163 ! (S+R) T. Schoenemeyer and K. Richter
164 ! (S95) D. Simpson, A. Guenther, C. N. Hewitt, and R. Steinbrecher
165 ! J. Geophysical Research 100D (1995), 22875-22890
166 ! (G94) A. Guenther, P. Zimmerman and M. Wildermuth
167 ! Atmospheric Environment 28 (1994), 1197-1210
168 ! (Z88) P. R. Zimmerman, J. P. Greenberg, and C. E. Westberg
169 ! J. Geophysical Research 93D (1988), 1407-1416
170 ! (K88) W. A. Kaplan, S. C. Wofsy, M. Keller, and J. M. da Costa
171 ! J. Geophysical Research 93D (1988), 1389-1395
172 ! (K94) L. F. Klinger, P. R. Zimmermann, J. P. Greenberg, L. E. Hei
173 ! and A. B. Guenther
174 ! J. Geophysical Research 99D (1994), 1469-1494
175 ! ---------------------------------------------------------
176 ! PCU/NCAR landuse categories:
177 ! 1 Highrise urban area
178 ! 2 Agricultural land
179 ! 3 Grassland, rangeland
180 ! 4 Deciduous forest
181 ! 5 Coniferous forest
182 ! 6 Mixed forest (including wetland)
183 ! 7 Water
184 ! 8 Wet rangeland, nonforested wetland
185 ! 9 Desert
186 ! 10 Tundra
187 ! 11 Permanent ice
188 ! 12 Tropical forest land
189 ! 13 Savannah
190 ! ---------------------------------------------------------
191 ! USGS landuse categories:
192 ! 1 Urban and built-up land
193 ! 2 Dryland cropland and pasture
194 ! 3 Irrigated cropland and pasture
195 ! 4 Mix. dry/irrg. cropland and pasture
196 ! 5 Cropland/grassland mosaic
197 ! 6 Cropland/woodland mosaic
198 ! 7 Grassland
199 ! 8 Shrubland
200 ! 9 Mixed shrubland/grassland
201 ! 10 Savanna
202 ! 11 Deciduous broadleaf forest
203 ! 12 Deciduous needleleaf forest
204 ! 13 Evergreen broadleaf forest
205 ! 14 Evergreen needleleaf forest
206 ! 15 Mixed Forest
207 ! 16 Water Bodies
208 ! 17 Herbaceous wetland
209 ! 18 Wooded wetland
210 ! 19 Barren or sparsely vegetated
211 ! 20 Herbaceous Tundra
212 ! 21 Wooded Tundra
213 ! 22 Mixed Tundra
214 ! 23 Bare Ground Tundra
215 ! 24 Snow or Ice
216 ! 25 No data
217 ! ---------------------------------------------------------
218 ! SiB landuse categories:
219 ! 1 Evergreen broadleaf trees
220 ! 2 Broadleaf deciduous trees
221 ! 3 Deciduous and evergreen trees
222 ! 4 Evergreen needleleaf trees
223 ! 5 Deciduous needleleaf trees
224 ! 6 Ground cover with trees and shrubs
225 ! 7 Ground cover only
226 ! 8 Broadleaf shrub with Perennial ground cover
227 ! 9 Broadleaf shrub with bare soil
228 ! 10 Groundcover with dwarf trees and shrubs
229 ! 11 Bare soil
230 ! 12 Agriculture or C3 grassland
231 ! 13 Persistent Wetland
232 ! 14 Dry coastal complexes
233 ! 15 Water
234 ! 16 Ice cap and glacier
235 ! 17 No data
236 !--------------------------------------------------------------
237 ! .. Scalar Arguments ..
238 LOGICAL :: vegflag
239 CHARACTER (4) :: mminlu
240 INTEGER :: isn
241 ! ..
242 ! .. Array Arguments ..
243 ! REAL :: aefiso(nlu), aefmter(nlu), aefovoc(nlu), aef_n(nlu)
244 ! INTEGER :: ixxxlu(nlu)
245 ! ..
246 ! .. Local Scalars ..
247 ! INTEGER :: nseas
248 INTEGER :: sum
249 ! ..
250 !**********************************************************************
251 ! Emission Factors for Isoprene in ug C/(m*m*h)
252 ! PRINT *, 'mminlu = ', mminlu
253 IF (mminlu=='OLD ') THEN
254 ! urban
255 aefiso(1) = 0.
256 ! agriculture (S+R)
257 aefiso(2) = 8.
258 ! grassland (S+R)
259 aefiso(3) = 0.
260 ! deciduous (G94)
261 aefiso(4) = 4400.
262 ! coniferous (G94)
263 aefiso(5) = 780.
264 ! mixed forest (G94)
265 aefiso(6) = 5775.
266 ! water
267 aefiso(7) = 0.
268 ! wetland, emission unknown
269 aefiso(8) = 0.
270 ! desert
271 aefiso(9) = 0.
272 ! tundra (K94)
273 aefiso(10) = 70.
274 ! ice
275 aefiso(11) = 0.
276 ! tropical forest (Z88)
277 aefiso(12) = 3100.
278 ! savanna (Z88)
279 aefiso(13) = 0
280 END IF
281 IF (mminlu=='USGS') THEN
282 ! urban
283 aefiso(1) = 0.
284 ! agriculture (S+R)
285 aefiso(2) = 8.
286 ! agriculture (S+R)
287 aefiso(3) = 8.
288 ! agriculture (S+R)
289 aefiso(4) = 8.
290 ! half agriculture/grassland assumed
291 aefiso(5) = 4.
292 ! half agriculture/deciduous assumed
293 aefiso(6) = 2204.
294 ! grassland (S+R)
295 aefiso(7) = 0.
296 ! grassland assumed
297 aefiso(8) = 0.
298 ! grassland assumed
299 aefiso(9) = 0.
300 ! savanna (Z88)
301 aefiso(10) = 0.
302 ! deciduous (G94)
303 aefiso(11) = 4400.
304 ! coniferous (G94)
305 aefiso(12) = 780.
306 ! deciduous (G94)
307 aefiso(13) = 4400.
308 ! coniferous (G94)
309 aefiso(14) = 780.
310 ! mixed forest (G94)
311 aefiso(15) = 5775.
312 ! water
313 aefiso(16) = 0.
314 ! wetland emission unknown
315 aefiso(17) = 0.
316 ! mixed forest assumed
317 aefiso(18) = 5775.
318 ! barren
319 aefiso(19) = 0.
320 ! tundra (K94) assumed
321 aefiso(20) = 70.
322 ! tundra (K94) assumed
323 aefiso(21) = 70.
324 ! tundra (K94) assumed
325 aefiso(22) = 70.
326 ! barren tundra
327 aefiso(23) = 0.
328 ! ice
329 aefiso(24) = 0.
330 ! no data
331 aefiso(25) = 0.
332 END IF
333 IF (mminlu=='SiB ') THEN
334 ! deciduous (G94)
335 aefiso(1) = 4400.
336 ! deciduous (G94)
337 aefiso(2) = 4400.
338 ! deciduous (G94)
339 aefiso(3) = 4400.
340 ! coniferous (G94)
341 aefiso(4) = 780.
342 ! coniferous (G94)
343 aefiso(5) = 780.
344 ! grassland assumed
345 aefiso(6) = 0.
346 ! grassland assumed
347 aefiso(7) = 0.
348 ! grassland assumed
349 aefiso(8) = 0.
350 ! grassland assumed
351 aefiso(9) = 0.
352 ! grassland assumed
353 aefiso(10) = 0.
354 ! bare soil
355 aefiso(11) = 0.
356 ! agriculture (S+R)
357 aefiso(12) = 8.
358 ! wetland, emission unknown
359 aefiso(13) = 0.
360 ! dry, coastal
361 aefiso(14) = 0.
362 ! water
363 aefiso(15) = 0.
364 ! ice
365 aefiso(16) = 0.
366 ! no data
367 aefiso(17) = 0.
368 END IF
369 ! ---------------------------------------------------------
370 ! Emission Factors for Monoterpenes in ug C/(m*m*h)
371
372 IF (mminlu=='OLD ') THEN
373 ! urban
374 aefmter(1) = 0.
375 ! agriculture (S+R)
376 aefmter(2) = 20.
377 ! grassland (S+R)
378 aefmter(3) = 20.
379 ! deciduous (G94)
380 aefmter(4) = 385.
381 ! coniferous (G94)
382 aefmter(5) = 1380.
383 ! mixed forest (G94)
384 aefmter(6) = 1001.
385 ! water
386 aefmter(7) = 0.
387 ! wetland, emission unknown
388 aefmter(8) = 0.
389 ! desert
390 aefmter(9) = 0.
391 ! tundra (K94)
392 aefmter(10) = 0.
393 ! ice
394 aefmter(11) = 0.
395 ! tropical forest (Z88)
396 aefmter(12) = 270.
397 ! savanna (Z88)
398 aefmter(13) = 0
399 END IF
400 IF (mminlu=='USGS') THEN
401 ! urban
402 aefmter(1) = 0.
403 ! agriculture (S+R)
404 aefmter(2) = 20.
405 ! agriculture (S+R)
406 aefmter(3) = 20.
407 ! agriculture (S+R)
408 aefmter(4) = 20.
409 ! half agriculture/grassland assumed
410 aefmter(5) = 20.
411 ! half agriculture/deciduous assumed
412 aefmter(6) = 202.5
413 ! grassland (S+R)
414 aefmter(7) = 20.
415 ! grassland assumed
416 aefmter(8) = 20.
417 ! grassland assumed
418 aefmter(9) = 20.
419 ! savanna (Z88)
420 aefmter(10) = 0
421 ! deciduous (G94)
422 aefmter(11) = 385.
423 ! coniferous (G94)
424 aefmter(12) = 1380.
425 ! deciduous (G94)
426 aefmter(13) = 385.
427 ! coniferous (G94)
428 aefmter(14) = 1380.
429 ! mixed forest (G94)
430 aefmter(15) = 1001.
431 ! water
432 aefmter(16) = 0.
433 ! wetland emission unknown
434 aefmter(17) = 0.
435 ! mixed forest assumed
436 aefmter(18) = 1001.
437 ! barren
438 aefmter(19) = 0.
439 ! tundra (K94) assumed
440 aefmter(20) = 0.
441 ! tundra (K94) assumed
442 aefmter(21) = 0.
443 ! tundra (K94) assumed
444 aefmter(22) = 0.
445 ! barren tundra
446 aefmter(23) = 0.
447 ! ice
448 aefmter(24) = 0.
449 ! no data
450 aefmter(25) = 0.
451 END IF
452 IF (mminlu=='SiB ') THEN
453 ! deciduous (G94)
454 aefmter(1) = 385.
455 ! deciduous (G94)
456 aefmter(2) = 385.
457 ! deciduous (G94)
458 aefmter(3) = 385.
459 ! coniferous (G94)
460 aefmter(4) = 1380.
461 ! coniferous (G94)
462 aefmter(5) = 1380.
463 ! grassland assumed
464 aefmter(6) = 20.
465 ! grassland assumed
466 aefmter(7) = 20.
467 ! grassland assumed
468 aefmter(8) = 20.
469 ! grassland assumed
470 aefmter(9) = 20.
471 ! grassland assumed
472 aefmter(10) = 20.
473 ! bare soil
474 aefmter(11) = 0.
475 ! agriculture (S+R)
476 aefmter(12) = 20.
477 ! wetland, emission unknown
478 aefmter(13) = 0.
479 ! dry, coastal
480 aefmter(14) = 0.
481 ! water
482 aefmter(15) = 0.
483 ! ice
484 aefmter(16) = 0.
485 ! no data
486 aefmter(17) = 0.
487 END IF
488 ! ---------------------------------------------------------
489 ! Emission Factors for Other VOCs in ug C/(m*m*h)
490
491 IF (mminlu=='OLD ') THEN
492 ! urban
493 aefovoc(1) = 0.
494 ! agriculture (S+R)
495 aefovoc(2) = 12.
496 ! grassland (S+R)
497 aefovoc(3) = 80.
498 ! deciduous (G94)
499 aefovoc(4) = 715.
500 ! coniferous (G94)
501 aefovoc(5) = 840.
502 ! mixed forest (G94)
503 aefovoc(6) = 924.
504 ! water
505 aefovoc(7) = 0.
506 ! wetland, emission unknown
507 aefovoc(8) = 0.
508 ! desert
509 aefovoc(9) = 0.
510 ! tundra (K94)
511 aefovoc(10) = 0.
512 ! ice
513 aefovoc(11) = 0.
514 ! tropical forest (Z88)
515 aefovoc(12) = 0.
516 ! savanna (Z88)
517 aefovoc(13) = 0
518 END IF
519 IF (mminlu=='USGS') THEN
520 ! urban
521 aefovoc(1) = 0.
522 ! agriculture (S+R)
523 aefovoc(2) = 12.
524 ! agriculture (S+R)
525 aefovoc(3) = 12.
526 ! agriculture (S+R)
527 aefovoc(4) = 12.
528 ! half agriculture/grassland assumed
529 aefovoc(5) = 46.
530 ! half agriculture/deciduous assumed
531 aefovoc(6) = 363.5
532 ! grassland (S+R)
533 aefovoc(7) = 80.
534 ! grassland assumed
535 aefovoc(8) = 80.
536 ! grassland assumed
537 aefovoc(9) = 80.
538 ! savanna (Z88)
539 aefovoc(10) = 0
540 ! deciduous (G94)
541 aefovoc(11) = 715.
542 ! coniferous (G94)
543 aefovoc(12) = 840.
544 ! deciduous (G94)
545 aefovoc(13) = 715.
546 ! coniferous (G94)
547 aefovoc(14) = 840.
548 ! mixed forest (G94)
549 aefovoc(15) = 924.
550 ! water
551 aefovoc(16) = 0.
552 ! wetland emission unknown
553 aefovoc(17) = 0.
554 ! mixed forest assumed
555 aefovoc(18) = 924.
556 ! barren
557 aefovoc(19) = 0.
558 ! tundra (K94) assumed
559 aefovoc(20) = 0.
560 ! tundra (K94) assumed
561 aefovoc(21) = 0.
562 ! tundra (K94) assumed
563 aefovoc(22) = 0.
564 ! barren tundra
565 aefovoc(23) = 0.
566 ! ice
567 aefovoc(24) = 0.
568 ! no data
569 aefovoc(25) = 0.
570 END IF
571 IF (mminlu=='SiB ') THEN
572 ! deciduous (G94)
573 aefovoc(1) = 715.
574 ! deciduous (G94)
575 aefovoc(2) = 715.
576 ! deciduous (G94)
577 aefovoc(3) = 715.
578 ! coniferous (G94)
579 aefovoc(4) = 840.
580 ! coniferous (G94)
581 aefovoc(5) = 840.
582 ! grassland assumed
583 aefovoc(6) = 80.
584 ! grassland assumed
585 aefovoc(7) = 80.
586 ! grassland assumed
587 aefovoc(8) = 80.
588 ! grassland assumed
589 aefovoc(9) = 80.
590 ! grassland assumed
591 aefovoc(10) = 80.
592 ! bare soil
593 aefovoc(11) = 0.
594 ! agriculture (S+R)
595 aefovoc(12) = 12.
596 ! wetland, emission unknown
597 aefovoc(13) = 0.
598 ! dry, coastal
599 aefovoc(14) = 0.
600 ! water
601 aefovoc(15) = 0.
602 ! ice
603 aefovoc(16) = 0.
604 ! no data
605 aefovoc(17) = 0.
606 END IF
607 ! ---------------------------------------------------------
608 ! Emission Factors for Nitrogen in ng N /(m*m*sec)
609
610 IF (mminlu=='OLD ') THEN
611 ! urban
612 aef_n(1) = 0.
613 ! agriculture (S+R)
614 aef_n(2) = 9.
615 ! grassland (S+R)
616 aef_n(3) = 0.9
617 ! deciduous (G94)
618 aef_n(4) = 0.07
619 ! coniferous (G94)
620 aef_n(5) = 0.07
621 ! mixed forest (G94)
622 aef_n(6) = 0.07
623 ! water
624 aef_n(7) = 0.
625 ! wetland, emission unknown
626 aef_n(8) = 0.
627 ! desert
628 aef_n(9) = 0.
629 ! tundra (K94)
630 aef_n(10) = 0.
631 ! ice
632 aef_n(11) = 0.
633 ! tropical forest (Z88)
634 aef_n(12) = 1.78
635 ! savanna (Z88)
636 aef_n(13) = 0
637 END IF
638 IF (mminlu=='USGS') THEN
639 ! urban
640 aef_n(1) = 0.
641 ! agriculture (S+R)
642 aef_n(2) = 9.
643 ! agriculture (S+R)
644 aef_n(3) = 9.
645 ! agriculture (S+R)
646 aef_n(4) = 9.
647 ! half agriculture/grassland assumed
648 aef_n(5) = 4.95
649 ! half agriculture/deciduous assumed
650 aef_n(6) = 4.535
651 ! grassland (S+R)
652 aef_n(7) = 0.9
653 ! grassland assumed
654 aef_n(8) = 0.07
655 ! grassland assumed
656 aef_n(9) = 0.07
657 ! savanna (Z88)
658 aef_n(10) = 0.
659 ! deciduous (G94)
660 aef_n(11) = 0.07
661 ! coniferous (G94)
662 aef_n(12) = 0.07
663 ! deciduous (G94)
664 aef_n(13) = 0.07
665 ! coniferous (G94)
666 aef_n(14) = 0.07
667 ! mixed forest (G94)
668 aef_n(15) = 0.07
669 ! water
670 aef_n(16) = 0.
671 ! wetland emission unknown
672 aef_n(17) = 0.
673 ! mixed forest assumed
674 aef_n(18) = 0.07
675 ! barren
676 aef_n(19) = 0.
677 ! tundra (K94) assumed
678 aef_n(20) = 0.
679 ! tundra (K94) assumed
680 aef_n(21) = 0.
681 ! tundra (K94) assumed
682 aef_n(22) = 0.
683 ! barren tundra
684 aef_n(23) = 0.
685 ! ice
686 aef_n(24) = 0.
687 ! no data
688 aef_n(25) = 0.
689 END IF
690 IF (mminlu=='SiB ') THEN
691 ! deciduous (G94)
692 aef_n(1) = 0.07
693 ! deciduous (G94)
694 aef_n(2) = 0.07
695 ! deciduous (G94)
696 aef_n(3) = 0.07
697 ! coniferous (G94)
698 aef_n(4) = 0.07
699 ! coniferous (G94)
700 aef_n(5) = 0.07
701 ! natural vegetation assumed
702 aef_n(6) = 0.07
703 ! grassland assumed
704 aef_n(7) = 0.9
705 ! natural vegetation assumed
706 aef_n(8) = 0.07
707 ! natural vegetation assumed
708 aef_n(9) = 0.07
709 ! natural vegetation assumed
710 aef_n(10) = 0.07
711 ! bare soil
712 aef_n(11) = 0.
713 ! agriculture (S+R)
714 aef_n(12) = 9.
715 ! wetland, emission unknown
716 aef_n(13) = 0.
717 ! dry, coastal
718 aef_n(14) = 0.
719 ! water
720 aef_n(15) = 0.
721 ! ice
722 aef_n(16) = 0.
723 ! no data
724 aef_n(17) = 0.
725 END IF
726 ! *********************************************************
727
728 ! Simplified landuse scheme for deposition and biogenic emission
729 ! subroutines
730 ! (ISWATER and ISICE are already defined elsewhere,
731 ! therefore water and ice are not considered here)
732
733 ! 1 urban or bare soil
734 ! 2 agricultural
735 ! 3 grassland
736 ! 4 deciduous forest
737 ! 5 coniferous and mixed forest
738 ! 6 other natural landuse categories
739
740
741 IF (mminlu=='OLD ') THEN
742 ixxxlu(1) = 1
743 ixxxlu(2) = 2
744 ixxxlu(3) = 3
745 ixxxlu(4) = 4
746 ixxxlu(5) = 5
747 ixxxlu(6) = 5
748 ixxxlu(7) = 0
749 ixxxlu(8) = 6
750 ixxxlu(9) = 1
751 ixxxlu(10) = 6
752 ixxxlu(11) = 0
753 ixxxlu(12) = 4
754 ixxxlu(13) = 6
755 END IF
756 IF (mminlu=='USGS') THEN
757 ixxxlu(1) = 1
758 ixxxlu(2) = 2
759 ixxxlu(3) = 2
760 ixxxlu(4) = 2
761 ixxxlu(5) = 2
762 ixxxlu(6) = 4
763 ixxxlu(7) = 3
764 ixxxlu(8) = 6
765 ixxxlu(9) = 3
766 ixxxlu(10) = 6
767 ixxxlu(11) = 4
768 ixxxlu(12) = 5
769 ixxxlu(13) = 4
770 ixxxlu(14) = 5
771 ixxxlu(15) = 5
772 ixxxlu(16) = 0
773 ixxxlu(17) = 6
774 ixxxlu(18) = 4
775 ixxxlu(19) = 1
776 ixxxlu(20) = 6
777 ixxxlu(21) = 4
778 ixxxlu(22) = 6
779 ixxxlu(23) = 1
780 ixxxlu(24) = 0
781 ixxxlu(25) = 1
782 END IF
783 IF (mminlu=='SiB ') THEN
784 ixxxlu(1) = 4
785 ixxxlu(2) = 4
786 ixxxlu(3) = 4
787 ixxxlu(4) = 5
788 ixxxlu(5) = 5
789 ixxxlu(6) = 6
790 ixxxlu(7) = 3
791 ixxxlu(8) = 6
792 ixxxlu(9) = 6
793 ixxxlu(10) = 6
794 ixxxlu(11) = 1
795 ixxxlu(12) = 2
796 ixxxlu(13) = 6
797 ixxxlu(14) = 1
798 ixxxlu(15) = 0
799 ixxxlu(16) = 0
800 ixxxlu(17) = 1
801 END IF
802
803
804 !**********************************************************************
805 ! Calculation of seasonal dependence of emissions
806 !**********************************************************************
807 ! (if the season is variable during the model run,
808 ! this section should be placed in the beginning of subroutine BIOGEN)
809 !**********************************************************************
810
811
812 IF (mminlu=='OLD ') THEN
813 ! WINTER
814 IF (isn==2) THEN
815 ! agriculture
816 aefiso(2) = 0.
817 ! deciduous
818 aefiso(4) = 0.
819 ! mixed forest
820 aefiso(6) = 5775./2.
821 ! tundra
822 aefiso(10) = 0.
823 ! agriculture
824 aefmter(2) = 0.
825 ! deciduous
826 aefmter(4) = 0.
827 ! mixed forest
828 aefmter(6) = 1001./2.
829 ! agriculture
830 aefovoc(2) = 0.
831 ! deciduous
832 aefovoc(4) = 0.
833 ! mixed forest
834 aefovoc(6) = 924./2.
835 END IF
836 END IF
837
838 IF (mminlu=='USGS') THEN
839 ! DOES VEGETATION FRACTION EXIST?
840 sum = 0.
841 ! DO J=1,jl-1
842 ! DO I=1,il-1
843 ! SUM=SUM+VEGFRC(I,J)
844 ! END DO
845 ! END DO
846 IF (sum>1) THEN
847 vegflag = .TRUE.
848 ELSE
849 vegflag = .FALSE.
850 END IF
851 ! VEGFLAG=.FALSE.
852 IF (( .NOT. vegflag) .AND. (isn==2)) THEN
853 ! IF ((.NOT.VEGFLAG)) THEN
854 ! VEGETATION FRACTION DOES NOT EXIST,
855 ! CORRECTION FOR WINTER SEASON
856 ! agriculture
857 aefiso(2) = 0.
858 ! agriculture
859 aefiso(3) = 0.
860 ! agriculture
861 aefiso(4) = 0.
862 ! half agriculture/grassland assumed
863 aefiso(5) = 0.
864 ! half agriculture/deciduous assumed
865 aefiso(6) = 0.
866 ! deciduous broadleaf
867 aefiso(11) = 0.
868 ! deciduous needleleaf
869 aefiso(12) = 0.
870 ! mixed forest
871 aefiso(15) = 5775./2.
872 ! mixed forest assumed
873 aefiso(18) = 5775./2.
874 ! tundra
875 aefiso(20) = 0.
876 ! tundra
877 aefiso(21) = 0.
878 ! tundra
879 aefiso(22) = 0.
880 ! agriculture
881 aefmter(2) = 0.
882 ! agriculture
883 aefmter(3) = 0.
884 ! agriculture
885 aefmter(4) = 0.
886 ! half agriculture/grassland assumed
887 aefmter(5) = 10.
888 ! half agriculture/deciduous assumed
889 aefmter(6) = 0.
890 ! deciduous broadleaf
891 aefmter(11) = 0.
892 ! deciduous needleleaf
893 aefmter(12) = 0.
894 ! mixed forest
895 aefmter(15) = 1001./2.
896 ! mixed forest assumed
897 aefmter(18) = 1001./2.
898 ! agriculture
899 aefovoc(2) = 0.
900 ! agriculture
901 aefovoc(3) = 0.
902 ! agriculture
903 aefovoc(4) = 0.
904 ! half agriculture/grassland assumed
905 aefovoc(5) = 40.
906 ! half agriculture/deciduous assumed
907 aefovoc(6) = 0.
908 ! deciduous broadleaf
909 aefovoc(11) = 0.
910 ! deciduous needleleaf
911 aefovoc(12) = 0.
912 ! mixed forest
913 aefovoc(15) = 924./2.
914 ! mixed forest assumed
915 aefovoc(18) = 924./2.
916 END IF
917 END IF
918
919 IF (mminlu=='SiB ') THEN
920 ! WINTER
921 IF (isn==2) THEN
922 ! deciduous
923 aefiso(1) = 0.
924 ! deciduous
925 aefiso(2) = 0.
926 ! deciduous
927 aefiso(3) = 0.
928 ! agriculture
929 aefiso(12) = 0.
930 ! deciduous
931 aefmter(1) = 0.
932 ! deciduous
933 aefmter(2) = 0.
934 ! deciduous
935 aefmter(3) = 0.
936 ! agriculture
937 aefmter(12) = 0.
938 ! deciduous
939 aefovoc(1) = 0.
940 ! deciduous
941 aefovoc(2) = 0.
942 ! deciduous
943 aefovoc(3) = 0.
944 ! agriculture
945 aefovoc(12) = 0.
946 END IF
947 END IF
948
949 END SUBROUTINE bioemiin
950 ! **********************************************************************
951 ! *********************** SUBROUTINE BIOGEN **************************
952 ! **********************************************************************
953 SUBROUTINE biogen(iland,ta,rad,eiso,emter,eovoc,e_n,vocsc,eisoc,emterc, &
954 eovocc,e_nn,pa,mminlu,isn,vegflag)
955
956 ! THIS PROGRAMM COMPUTES THE ACTUAL BIOGENIC EMISSION RATE FOR
957 ! ISOPRENE, MONTERPENES, OTHER ORGANIC COMPOUNDS, AND NITROGEN FOR
958 ! EACH GRID CELL DEPENDING ON TEMPERATURE AND GLOBAL RADIATION
959 !***********************************************************************
960 ! PROGRAM DEVELOPED BY:- THOMAS SCHOENEMEYER (5 JANUARY 1995)
961 ! MODIFIED BY: - THOMAS SCHOENEMEYER (21 AUGUST 1996)
962 ! UND KLAUS RICHTER
963 ! NACH SIMPSON ET AL.
964 ! - WINFRIED SEIDL (JUNE 1997)
965 ! ADAPTATION FOR USE IN MM5
966 ! - WINFRIED SEIDL (MARCH 2000)
967 ! MODIFICATION FOR MM5 VERSION 3
968 ! - Georg Grell (March 2002) for f90 and WRF
969 !***********************************************************************
970 !...PROGRAM VARIABLES...
971 ! ILAND - Land use category
972 ! TA - Air temperature in K
973 ! RAD - Solare global radiation in W/m2
974 ! EISO - Emission von Isopren in ppm*m/min
975 ! EMTER - Emission von Monoterpenen in ppm*m/min
976 ! EOVOC - Emission sonstiger fluechtiger Kohlenwasserstoffe
977 ! in ppm*m/min
978 ! E_N - Emission von Stickstoff in ppm*m/min
979 ! AEFISO(NLU) - Emissionsfaktor fuer Isopren fuer die Land-
980 ! nutzungsart K, standardisiert auf 303 K und
981 ! voller Sonneneinstrahlung in ug C /(m*m*h)
982 ! AEFOVOC(NLU)- Emissionsfaktor fuer sonstige fluechtige
983 ! Kohlenwasserstoffe in ug C /(m*m*h)
984 ! AEFMTER(NLU)- Emissionsfaktor fuer MONOTERPENE
985 ! in ug C /(m*m*h)
986 ! AEF_N(NLU) - Emissionsfaktor fuer Stickstoff
987 ! in ng N /(m*m*sec)
988 ! ECF_ISO - dimensionsloser Korrekturfaktor fuer Isopren,
989 ! abhaengig von Temperatur und Strahlung
990 ! ECF_OVOC dimensionsloser Korrekturfaktor fuer die
991 ! sonstigen fluechtigen Kohlenwasserstoffe
992 ! ECF_MTER dimensionsloser Korrekturfaktor fuer die
993 ! MONOTERPENE
994 ! ECF_N - dimensionsloser Korrekturfaktor fuer
995 ! Stickstoff
996 ! .. Scalar Arguments ..
997 REAL :: eiso, eisoc, emter, emterc, eovoc, eovocc, e_n, e_nn, pa, rad, &
998 ta, vocsc
999 INTEGER :: iland, isn
1000 LOGICAL :: vegflag
1001 CHARACTER (4) :: mminlu
1002 ! ..
1003 ! .. Array Arguments ..
1004 ! REAL :: aefiso(nlu), aefmter(nlu), aefovoc(nlu), aef_n(nlu)
1005 ! INTEGER :: ixxxlu(nlu)
1006 ! ..
1007 ! .. Local Scalars ..
1008 REAL :: alpha, beta, cl, cl1, coniso, conn, conovoc, conter, ct, ct1, &
1009 ct2, ecf_iso, ecf_mter, ecf_n, ecf_ovoc, par, r, rat, tm, ts, tsoil
1010 ! ..
1011 ! .. Intrinsic Functions ..
1012 INTRINSIC exp, sqrt
1013 ! ..
1014 ! empirischer Koeffizient
1015 alpha = 0.0027
1016 ! empirischer Koeffizient
1017 cl1 = 1.066
1018 ! Gaskonstante in J/(K*mol)
1019 r = 8.314
1020 ! empirischer Koeffizient in J/mol
1021 ct1 = 95000
1022 ! empirischer Koeffizient in J/mol
1023 ct2 = 230000
1024 ! empirischer Koeffizient in K
1025 tm = 314.
1026 ! faktoren bestimmt werden
1027 ts = 303.
1028 ! Standardtemperatur bei der Emissions-
1029 beta = 0.09
1030 !**********************************************************************
1031 !**********************************************************************
1032 ! Temperature and Radiation Dependent Correction Factors
1033 ! for Emissions
1034 !**********************************************************************
1035 !**********************************************************************
1036
1037
1038 ! *****************************************************************
1039 ! Forest land use categories
1040
1041 ! empirischer TemperaturKoeffizient
1042 IF ((ixxxlu(iland)==4) .OR. (ixxxlu(iland)==5)) THEN
1043 ! ! = photosynthetisch aktive Strahlung;
1044 par = 2.0*rad
1045 ! ! Umrechnungsfaktor: 2.0 uE/J (beruecksich
1046 ! auch, dass PAR ein kleinerer Wellenlaeng
1047 ! bereich ist als die Globalstrahlung.
1048 ! Langholz und Haeckl, 1985, Met. Rundscha
1049
1050 ! PAR flux in Mikromol je m**2 und s
1051 cl = alpha*cl1*par/sqrt(1+alpha*alpha*par*par)
1052 ct = exp(ct1*(ta-ts)/(r*ts*ta))/(1+exp(ct2*(ta-tm)/(r*ts*ta)))
1053
1054 ecf_iso = cl*ct
1055 ! Korrekturfaktor fuer Isopr
1056 ecf_mter = exp(beta*(ta-ts)) ! Korrekturfaktor fuer MTER
1057 ecf_ovoc = ecf_mter
1058 ! Korrekturfaktor fuer OVOC
1059 tsoil = 0.84*(ta-273.15) + 3.6
1060 ecf_n = exp(0.071*tsoil)
1061 ! Korrekturfaktor fuer N
1062 END IF
1063
1064 ! *****************************************************************
1065 ! Agricultural land use category
1066
1067 IF (ixxxlu(iland)==2) THEN
1068 ecf_iso = exp(0.1*(ta-30.-273.15)) ! vgl. Hahn et al.
1069 ecf_mter = ecf_iso
1070 ecf_ovoc = ecf_iso
1071
1072 tsoil = 0.72*(ta-273.15) + 5.8
1073 ecf_n = exp(0.071*tsoil)
1074 END IF
1075
1076 ! *****************************************************************
1077 ! Grassland and natural nonforested land use categories
1078
1079 IF ((ixxxlu(iland)==3) .OR. (ixxxlu(iland)==6)) THEN
1080 ecf_iso = exp(0.1*(ta-30.-273.15)) ! vgl. Hahn et al.
1081 ecf_mter = ecf_iso
1082 ecf_ovoc = ecf_iso
1083
1084 tsoil = 0.66*(ta-273.15) + 8.8
1085 ecf_n = exp(0.071*tsoil)
1086 END IF
1087
1088 ! *****************************************************************
1089 ! Non-emitting land use categories
1090
1091 IF ((ixxxlu(iland)==1) .OR. (iland==iswater_temp) .OR. (iland==isice_temp)) THEN
1092 ecf_iso = 0.
1093 ecf_mter = 0.
1094 ecf_ovoc = 0.
1095 ecf_n = 0.
1096 END IF
1097 !**********************************************************************
1098 !**********************************************************************
1099 ! Calculation of Emissions
1100 !**********************************************************************
1101 !**********************************************************************
1102
1103 ! CONVERSION FROM MICROGRAM C/M2/H TO PPM*M/MIN
1104 ! CORRECTION TERM FOR TEMP(K) AND PRESSURE
1105 ! K = (T/P) *R)/(MW*60)
1106 ! R = 8.3143E-2 m3 mbar/(K mole)
1107
1108 rat = ta/pa
1109 ! *****************************************************************
1110 ! Isopren:
1111
1112 coniso = rat*2.3095E-5
1113 eisoc = aefiso(iland)*ecf_iso
1114 eiso = coniso*eisoc
1115
1116 ! *****************************************************************
1117 ! Monoterpenes:
1118
1119 conter = rat*1.1548E-5
1120 emterc = aefmter(iland)*ecf_mter
1121 emter = conter*emterc
1122
1123 ! *****************************************************************
1124 ! Other VOCs:
1125
1126 ! as 3-hexenyl-acetate (C=96g/mole)
1127
1128 conovoc = rat*1.4435E-5
1129 eovocc = aefovoc(iland)*ecf_ovoc
1130 eovoc = conovoc*eovocc
1131 ! *****************************************************************
1132 ! SUM OF ALL VOCS
1133
1134 vocsc = eisoc + emterc + eovocc
1135
1136 ! *****************************************************************
1137 ! Nitrogen:
1138
1139 ! CONVERSION FROM NANOGRAM N/M2/SEC TO PPM*M/MIN
1140 ! CORRECTION TERM FOR TEMP(K) AND PRESSURE
1141 ! INVENTORY AS N
1142 ! INPUT TO THE MODEL ASSUMED AS NO
1143 ! K = (T/P) *R*60)/(MW*1000)
1144 ! R = 8.3143E-2 m3 mbar/(K mole)
1145
1146 conn = rat*3.5633E-4
1147 e_nn = aef_n(iland)*ecf_n
1148 e_n = conn*e_nn
1149
1150
1151 END SUBROUTINE biogen
1152 ! **********************************************************************
1153 ! *********************** SUBROUTINE BIOSPLIT *************************
1154 ! **********************************************************************
1155 SUBROUTINE biosplit(iland,eiso,emter,eovoc,e_n,emiss_bio,ne_area, &
1156 vegfrc,mminlu,vegflag)
1157 ! THIS PROGRAMM SPLITS THE BIOGENIC EMISSION RATES FOR
1158 ! MONOTERPENES AND OTHER ORGANIC COMPOUNDS INTO THE
1159 ! COMPOUND CLASSES OF THE CHEMISTRY MODEL
1160 ! --- VERSION FOR RADM2 AND RACM CHEMISTRY ---
1161 !***********************************************************************
1162 ! PROGRAM DEVELOPED BY:- WINFRIED SEIDL (JULY 1997)
1163 ! MODIFIED BY: - WINFRIED SEIDL (JULY 1998)
1164 ! FOR RACM-CHEMISTRY
1165 ! - WINFRIED SEIDL (MARCH 2000)
1166 ! FOR MM5 VERSION 3
1167 !***********************************************************************
1168 !...PROGRAM VARIABLES...
1169 ! ILAND - Land use category
1170 ! EISO - Emission von Isopren in ppm*m/min
1171 ! EMTER - Emission von Monoterpenen in ppm*m/min
1172 ! EOVOC - Emission sonstiger fluechtiger Kohlenwasserstoffe
1173 ! in ppm*m/min
1174 ! E_N - Emission von Stickstoff in ppm*m/min
1175 !***********************************************************************
1176 !...Comments...
1177 ! The split of the monoterpenes and the other VOCs into RADM clas
1178 ! is mostly rather uncertain. Every plant species emitts a differ
1179 ! mix of chemical substances. So e.g. different types of deciduou
1180 ! trees show totally different emissions. By taking the MM5
1181 ! land use categories, the kind of biogenic emissions can be
1182 ! estimated only roughly. Especially for the other VOCs little
1183 ! is known, so the splits presented here have to be regarded as
1184 ! a preliminary assumption.
1185 ! Some literature on this field:
1186 ! Arey et al., J. Geophys. Res. 96D (1991), 9329-9336
1187 ! Arey et al., Atmospheric Environment 25A (1991), 1063-1075
1188 ! Koenig et al., Atmospheric Environment 29 (1995), 861-874
1189 ! Isidorov et al., Atmospheric Environment 19 (1985), 1-8
1190 ! Martin et al., Abstract Air & Waste Management Association''s
1191 ! 90th Annual Meeting & Exhibition, Toronto 1997, Paper 97-RP139.
1192 ! Winer et al., Final Report 1983, California Air Resources Bord,
1193 ! Contract No. AO-056-32
1194 ! For the RADM 2 chemistry, most of the monoterpenes are grouped
1195 ! into the OLI class
1196 ! (Middleton et al., Atmospheric Environment 24A (1990), 1107-113
1197 ! with a few exceptions:
1198 ! ISO -- myrcene, ocimene
1199 ! XYL -- p-cymene
1200 ! For the RACM chemistry, the monoterpenes are split
1201 ! between the API, LIM, ISO and XYL classes:
1202 ! API -- a-pinene, b-pinene, D3-carene, sabinene, camphene,
1203 ! 1,8-cineole, a-terpineole, thujene
1204 ! LIM -- limonene, terpinene, phellandrene, terpinolene
1205 ! ISO -- myrcene, ocimene
1206 ! XYL -- p-cymene
1207 ! The other VOCs are grouped according to Middleton et al. (1990)
1208 !***********************************************************************
1209 ! .. Scalar Arguments ..
1210 REAL :: eiso, emter, eovoc, e_n, vegfrc
1211 INTEGER :: iland, ne_area
1212 ! INTEGER :: lald, lhc3, lhc5, lhc8, lhcho, liso, lket, lno, &
1213 ! loli, lolt, lora1, lora2, lxyl
1214 ! ..
1215 ! .. Array Arguments ..
1216 REAL :: emiss_bio(ne_area)
1217 ! INTEGER :: ixxxlu(nlu)
1218 ! ..
1219 ! .. Local Scalars ..
1220 LOGICAL :: vegflag
1221 CHARACTER (4) :: mminlu
1222 ! ..
1223 ! *****************************************************************
1224 ! Correction for vegetation fraction
1225 IF ((mminlu=='USGS') .AND. (vegflag)) THEN
1226 eiso = eiso*vegfrc/100.
1227 emter = emter*vegfrc/100.
1228 eovoc = eovoc*vegfrc/100.
1229 END IF
1230
1231 ! *****************************************************************
1232 ! Isoprene and NO
1233
1234 emiss_bio(liso) = eiso
1235 emiss_bio(lno) = emiss_bio(lno) + e_n
1236
1237 ! *****************************************************************
1238 ! Agricultural land
1239
1240 IF (ixxxlu(iland)==2) THEN
1241 emiss_bio(loli) = emiss_bio(loli) + 0.80*emter
1242 emiss_bio(liso) = emiss_bio(liso) + 0.20*emter
1243 emiss_bio(lhc5) = emiss_bio(lhc5) + 0.16*eovoc
1244 emiss_bio(lhc8) = emiss_bio(lhc8) + 0.27*eovoc
1245 emiss_bio(lolt) = emiss_bio(lolt) + 0.05*eovoc
1246 emiss_bio(loli) = emiss_bio(loli) + 0.37*eovoc
1247 emiss_bio(lket) = emiss_bio(lket) + 0.03*eovoc
1248 emiss_bio(lald) = emiss_bio(lald) + 0.12*eovoc
1249 END IF
1250
1251 ! *****************************************************************
1252 ! Grassland
1253
1254 IF (ixxxlu(iland)==3) THEN
1255 emiss_bio(loli) = emiss_bio(loli) + 0.98*emter
1256 emiss_bio(liso) = emiss_bio(liso) + 0.02*emter
1257 emiss_bio(lhc5) = emiss_bio(lhc5) + 0.09*eovoc
1258 emiss_bio(lolt) = emiss_bio(lolt) + 0.07*eovoc
1259 emiss_bio(loli) = emiss_bio(loli) + 0.51*eovoc
1260 emiss_bio(lket) = emiss_bio(lket) + 0.15*eovoc
1261 emiss_bio(lald) = emiss_bio(lald) + 0.18*eovoc
1262 END IF
1263
1264 ! *****************************************************************
1265 ! Deciduous forest
1266
1267 IF (ixxxlu(iland)==4) THEN
1268 emiss_bio(loli) = emiss_bio(loli) + 0.94*emter
1269 emiss_bio(liso) = emiss_bio(liso) + 0.02*emter
1270 emiss_bio(lhcho) = emiss_bio(lhcho) + 0.19*eovoc
1271 emiss_bio(lald) = emiss_bio(lald) + 0.13*eovoc
1272 emiss_bio(lxyl) = emiss_bio(lxyl) + 0.04*emter
1273 emiss_bio(lhc5) = emiss_bio(lhc5) + 0.03*eovoc
1274 emiss_bio(loli) = emiss_bio(loli) + 0.07*eovoc
1275 emiss_bio(lora1) = emiss_bio(lora1) + 0.23*eovoc
1276 emiss_bio(lora2) = emiss_bio(lora2) + 0.35*eovoc
1277 END IF
1278
1279 ! *****************************************************************
1280 ! Coniferous forest and mixed forest
1281
1282
1283 IF (ixxxlu(iland)==5) THEN
1284 emiss_bio(loli) = emiss_bio(loli) + 0.85*emter
1285 emiss_bio(liso) = emiss_bio(liso) + 0.15*emter
1286 emiss_bio(lhcho) = emiss_bio(lhcho) + 0.04*eovoc
1287 emiss_bio(lald) = emiss_bio(lald) + 0.14*eovoc
1288 emiss_bio(lhc3) = emiss_bio(lhc3) + 0.07*eovoc
1289 emiss_bio(lhc5) = emiss_bio(lhc5) + 0.07*eovoc
1290 emiss_bio(lolt) = emiss_bio(lolt) + 0.07*eovoc
1291 emiss_bio(loli) = emiss_bio(loli) + 0.50*eovoc
1292 emiss_bio(lket) = emiss_bio(lket) + 0.03*eovoc
1293 emiss_bio(lora1) = emiss_bio(lora1) + 0.03*eovoc
1294 emiss_bio(lora2) = emiss_bio(lora2) + 0.05*eovoc
1295 END IF
1296
1297 ! *****************************************************************
1298 ! Tropical forest (not available in SiB and USGS)
1299
1300 IF ((mminlu=='OLD ') .AND. (iland==12)) THEN
1301 emiss_bio(loli) = emiss_bio(loli) + emter
1302 END IF
1303
1304 END SUBROUTINE biosplit
1305
1306 END MODULE module_bioemi_simple