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