module_input_chem_bioemiss.F
References to this file elsewhere.
1 !dis
2 !dis Open Source License/Disclaimer, Forecast Systems Laboratory
3 !dis NOAA/OAR/FSL, 325 Broadway Boulder, CO 80305
4 !dis
5 !dis This software is distributed under the Open Source Definition,
6 !dis which may be found at http://www.opensource.org/osd.html.
7 !dis
8 !dis In particular, redistribution and use in source and binary forms,
9 !dis with or without modification, are permitted provided that the
10 !dis following conditions are met:
11 !dis
12 !dis - Redistributions of source code must retain this notice, this
13 !dis list of conditions and the following disclaimer.
14 !dis
15 !dis - Redistributions in binary form must provide access to this
16 !dis notice, this list of conditions and the following disclaimer, and
17 !dis the underlying source code.
18 !dis
19 !dis - All modifications to this software must be clearly documented,
20 !dis and are solely the responsibility of the agent making the
21 !dis modifications.
22 !dis
23 !dis - If significant modifications or enhancements are made to this
24 !dis software, the FSL Software Policy Manager
25 !dis (softwaremgr@fsl.noaa.gov) should be notified.
26 !dis
27 !dis THIS SOFTWARE AND ITS DOCUMENTATION ARE IN THE PUBLIC DOMAIN
28 !dis AND ARE FURNISHED "AS IS." THE AUTHORS, THE UNITED STATES
29 !dis GOVERNMENT, ITS INSTRUMENTALITIES, OFFICERS, EMPLOYEES, AND
30 !dis AGENTS MAKE NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE USEFULNESS
31 !dis OF THE SOFTWARE AND DOCUMENTATION FOR ANY PURPOSE. THEY ASSUME
32 !dis NO RESPONSIBILITY (1) FOR THE USE OF THE SOFTWARE AND
33 !dis DOCUMENTATION; OR (2) TO PROVIDE TECHNICAL SUPPORT TO USERS.
34 !dis
35 !dis
36
37 !WRF:PACKAGE:IO
38
39 MODULE module_input_chem_bioemiss
40
41 USE module_io_domain
42 USE module_domain
43 USE module_driver_constants
44 USE module_state_description
45 USE module_configure
46 USE module_date_time
47 USE module_wrf_error
48 USE module_timing
49 USE module_data_radm2
50 USE module_aerosols_sorgam
51 USE module_get_file_names
52
53
54 CONTAINS
55 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
56
57 SUBROUTINE input_ext_chem_beis3_file (grid)
58 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
59
60 IMPLICIT NONE
61
62 TYPE(domain) :: grid
63
64 INTEGER :: i,j,n,numfil,status,system
65
66 INTEGER :: ids, ide, jds, jde, kds, kde, &
67 ims, ime, jms, jme, kms, kme, &
68 ips, ipe, jps, jpe, kps, kpe
69
70 REAL, ALLOCATABLE, DIMENSION(:,:) :: emiss
71
72
73
74 ! Number of reference emission and LAI files to open
75 PARAMETER(numfil=19)
76
77 CHARACTER (LEN=80) :: message
78
79 TYPE (grid_config_rec_type) :: config_flags
80
81 ! Normalized biogenic emissions for standard conditions (moles compound/km^2/hr)
82 ! REAL, DIMENSION(i,j) :: &
83 ! sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
84 ! sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
85 ! sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
86 ! noag_grow,noag_nongrow,nononag
87
88 ! Leaf area index for isoprene
89 ! REAL, DIMENSION(i,j) :: slai
90
91 ! Filenames of reference emissions and LAI
92 CHARACTER*100 onefil
93 CHARACTER*12 emfil(numfil)
94 DATA emfil/'ISO','OLI','API','LIM','XYL','HC3','ETE','OLT', &
95 'KET','ALD','HCHO','ETH','ORA2','CO','NR', &
96 'NOAG_GROW','NOAG_NONGROW','NONONAG','ISOP'/
97
98 !!!!!-------------------------------------------------------------------
99
100 ! Get grid dimensions
101 CALL get_ijk_from_grid ( grid , &
102 ids, ide, jds, jde, kds, kde, &
103 ims, ime, jms, jme, kms, kme, &
104 ips, ipe, jps, jpe, kps, kpe )
105
106 WRITE( message , FMT='(A,4I5)' ) ' DIMS: ',ids,ide-1,jds,jde-1
107 CALL wrf_message ( message )
108
109 ALLOCATE( emiss(ids:ide-1,jds:jde-1) )
110
111
112 ! Loop over the file names
113 DO n=1,numfil
114
115 ! Remove scratch unzipped file
116 status=system('rm -f scratem*')
117
118 ! All reference emissions except NO
119 IF(n.LE.15)THEN
120 onefil='../../run/BIOREF_'// &
121 TRIM(ADJUSTL(emfil(n)))//'.gz'
122 ! NO reference emissions
123 ELSE IF(n.GE.16.AND.n.LE.18)THEN
124 onefil='../../run/AVG_'// &
125 TRIM(ADJUSTL(emfil(n)))//'.gz'
126 ! LAI
127 ELSE
128 onefil='../../run/LAI_'// &
129 TRIM(ADJUSTL(emfil(n)))//'S.gz'
130 ENDIF
131
132 ! Copy selected file to scratch
133 status=system('cp '//TRIM(ADJUSTL(onefil))//' scratem.gz')
134
135 ! Unzip scratch
136 status=system('gunzip scratem')
137
138 ! Open scratch and read into appropriate array
139 OPEN(26,FILE='scratem',FORM='FORMATTED')
140 IF(n.EQ. 1) then
141 READ(26,'(12E9.2)') emiss
142 grid%sebio_iso(ids:ide-1,jds:jde-1) = emiss
143 ENDIF
144 IF(n.EQ. 2)then
145 READ(26,'(12E9.2)') emiss
146 grid%sebio_oli(ids:ide-1,jds:jde-1) = emiss
147 ENDIF
148 IF(n.EQ. 3)then
149 READ(26,'(12E9.2)') emiss
150 grid%sebio_api(ids:ide-1,jds:jde-1) = emiss
151 ENDIF
152 IF(n.EQ. 4)then
153 READ(26,'(12E9.2)') emiss
154 grid%sebio_lim(ids:ide-1,jds:jde-1) = emiss
155 ENDIF
156 IF(n.EQ. 5)then
157 READ(26,'(12E9.2)') emiss
158 grid%sebio_xyl(ids:ide-1,jds:jde-1) = emiss
159 ENDIF
160 IF(n.EQ. 6)then
161 READ(26,'(12E9.2)') emiss
162 grid%sebio_hc3(ids:ide-1,jds:jde-1) = emiss
163 ENDIF
164 IF(n.EQ. 7)then
165 READ(26,'(12E9.2)') emiss
166 grid%sebio_ete(ids:ide-1,jds:jde-1) = emiss
167 ENDIF
168 IF(n.EQ. 8)then
169 READ(26,'(12E9.2)') emiss
170 grid%sebio_olt(ids:ide-1,jds:jde-1) = emiss
171 ENDIF
172 IF(n.EQ. 9)then
173 READ(26,'(12E9.2)') emiss
174 grid%sebio_ket(ids:ide-1,jds:jde-1) = emiss
175 ENDIF
176 IF(n.EQ.10)then
177 READ(26,'(12E9.2)') emiss
178 grid%sebio_ald(ids:ide-1,jds:jde-1) = emiss
179 ENDIF
180 IF(n.EQ.11)then
181 READ(26,'(12E9.2)') emiss
182 grid%sebio_hcho(ids:ide-1,jds:jde-1) = emiss
183 ENDIF
184 IF(n.EQ.12)then
185 READ(26,'(12E9.2)') emiss
186 grid%sebio_eth(ids:ide-1,jds:jde-1) = emiss
187 ENDIF
188 IF(n.EQ.13)then
189 READ(26,'(12E9.2)') emiss
190 grid%sebio_ora2(ids:ide-1,jds:jde-1) = emiss
191 ENDIF
192 IF(n.EQ.14)then
193 READ(26,'(12E9.2)') emiss
194 grid%sebio_co(ids:ide-1,jds:jde-1) = emiss
195 ENDIF
196 IF(n.EQ.15)then
197 READ(26,'(12E9.2)') emiss
198 grid%sebio_nr(ids:ide-1,jds:jde-1) = emiss
199 ENDIF
200 IF(n.EQ.16)then
201 READ(26,'(12E9.2)') emiss
202 grid%noag_grow(ids:ide-1,jds:jde-1) = emiss
203 ENDIF
204 IF(n.EQ.17)then
205 READ(26,'(12E9.2)') emiss
206 grid%noag_nongrow(ids:ide-1,jds:jde-1) = emiss
207 ENDIF
208 IF(n.EQ.18)then
209 READ(26,'(12E9.2)') emiss
210 grid%nononag(ids:ide-1,jds:jde-1) = emiss
211 ENDIF
212 IF(n.EQ.19)then
213 READ(26,'(12E9.2)') emiss
214 grid%slai(ids:ide-1,jds:jde-1) = emiss
215 ENDIF
216 CLOSE(26)
217
218 ENDDO
219 ! End of loop over file names
220
221 DEALLOCATE( emiss )
222
223 END SUBROUTINE input_ext_chem_beis3_file
224 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
225
226 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
227 SUBROUTINE input_ext_chem_megan2_file (grid)
228
229 !
230 ! This subroutine reads in an ASCII file of variables that are needed
231 ! as input for biogenic emissions model MEGAN version 2. The
232 ! variables are:
233 !
234 ! Isoprene emissions at referenece tempperature and
235 ! light conditions [=] moles/km2/hr
236 ! Leaf area index (one each month)
237 ! Plant functional groups
238 ! Broadleaf trees
239 ! Needleleave trees
240 ! Shrubs and Bushes
241 ! Herbs
242 ! "Climatological" variables:
243 ! Monthly surface air temperature [=] K
244 ! Monthly downward solar radiation [=] W/m2
245 !
246 ! April, 2007 Serena H. Chung and Christine Wiedinmyer
247 !
248
249
250
251 IMPLICIT NONE
252
253 TYPE(domain) :: grid
254
255 INTEGER :: i,j,v,status,system, itmp, jtmp
256
257 INTEGER :: ids, ide, jds, jde, kds, kde, &
258 ims, ime, jms, jme, kms, kme, &
259 ips, ipe, jps, jpe, kps, kpe
260
261 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: emiss
262
263 CHARACTER (LEN=80) :: message
264
265 TYPE (grid_config_rec_type) :: config_flags
266
267
268 ! Variables "Pointers"
269 ! The order must follow that of the ASCII input file
270 integer, parameter :: n_mgnin = 41
271 integer, parameter :: & ! Pointer for :
272 & mgnin_isop = 1 & ! isoprene reference emissions
273 & ,mgnin_lai01 = 2 & ! Leaf area index for January
274 & ,mgnin_lai02 = 3 & ! February
275 & ,mgnin_lai03 = 4 & ! March
276 & ,mgnin_lai04 = 5 & ! April
277 & ,mgnin_lai05 = 6 & ! May
278 & ,mgnin_lai06 = 7 & ! June
279 & ,mgnin_lai07 = 8 & ! July
280 & ,mgnin_lai08 = 9 & ! August
281 & ,mgnin_lai09 = 10 & ! September
282 & ,mgnin_lai10 = 11 & ! October
283 & ,mgnin_lai11 = 12 & ! November
284 & ,mgnin_lai12 = 13 & ! December
285 & ,mgnin_pftp_bt = 14 & ! plant functional type % for broadleaf trees
286 & ,mgnin_pftp_nt = 15 & ! needleleaf trees
287 & ,mgnin_pftp_sb = 16 & ! shrubs and bushes
288 & ,mgnin_pftp_hb = 17 & ! herbs
289 & ,mgnin_tsa01 = 18 & ! monthly-mean surface air temperature for January
290 & ,mgnin_tsa02 = 19 & ! February
291 & ,mgnin_tsa03 = 20 & ! March
292 & ,mgnin_tsa04 = 21 & ! April
293 & ,mgnin_tsa05 = 22 & ! May
294 & ,mgnin_tsa06 = 23 & ! June
295 & ,mgnin_tsa07 = 24 & ! July
296 & ,mgnin_tsa08 = 25 & ! August
297 & ,mgnin_tsa09 = 26 & ! September
298 & ,mgnin_tsa10 = 27 & ! October
299 & ,mgnin_tsa11 = 28 & ! November
300 & ,mgnin_tsa12 = 29 & ! December
301 & ,mgnin_swdown01 = 30 & ! monthl-mean solar irradiance at surface for January
302 & ,mgnin_swdown02 = 31 & ! February
303 & ,mgnin_swdown03 = 32 & ! March
304 & ,mgnin_swdown04 = 33 & ! April
305 & ,mgnin_swdown05 = 34 & ! May
306 & ,mgnin_swdown06 = 35 & ! June
307 & ,mgnin_swdown07 = 36 & ! July
308 & ,mgnin_swdown08 = 37 & ! August
309 & ,mgnin_swdown09 = 38 & ! September
310 & ,mgnin_swdown10 = 39 & ! October
311 & ,mgnin_swdown11 = 40 & ! November
312 & ,mgnin_swdown12 = 41 ! December
313
314 CHARACTER*100 onefil
315
316 !!!!!-------------------------------------------------------------------
317
318 ! Get grid dimensions
319 CALL get_ijk_from_grid ( grid , &
320 ids, ide, jds, jde, kds, kde, &
321 ims, ime, jms, jme, kms, kme, &
322 ips, ipe, jps, jpe, kps, kpe )
323
324 WRITE( message , FMT='(A,4I5)' ) ' in input_ext_chem_megan2_file, DIMS: ',ids,ide-1,jds,jde-1
325 CALL wrf_message ( message )
326
327 ALLOCATE( emiss(ids:ide-1,jds:jde-1,n_mgnin) )
328
329 ! Remove scratch file
330 ! status=system('rm -f scratem*')
331
332
333 ! Copy selected file to scratch
334 onefil='MEGAN_input_WRFchem.txt'
335 ! status=system('cp '//TRIM(ADJUSTL(onefil))//' scratem')
336
337 ! Open scratch and read into appropriate array
338 ! OPEN(26,FILE='scratem',FORM='FORMATTED', status='old')
339 OPEN(26,FILE=trim(onefil),FORM='FORMATTED', status='old')
340
341 ! The following follows the file format provided by Christine Wiedinmyer
342
343 do i = ids, ide-1
344 do j = jds, jde-1
345 read (26, FMT='(2(I5,1x),41(ES11.2,1x))') itmp, jtmp, (emiss(i,j,v),v=1,n_mgnin)
346 ! redundant to be sure
347 if ( (i /= itmp) .or. j /= jtmp ) then
348 WRITE( message , FMT='(A,I3,I3,A,I3,I3)' ) 'Something is wrong (i,j) = ',i,j,"itmp, jtmp = ",itmp,jtmp
349 call wrf_error_fatal(message)
350 end if
351 end do
352 end do
353
354
355 ! Isoprene emissions at standard conditions [=] mol/km2/hr
356 grid%msebio_isop(ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_isop)
357 ! Leaf area index for each month
358 grid%mlai (ids:ide-1,jds:jde-1,01) = emiss(ids:ide-1,jds:jde-1,mgnin_lai01)
359 grid%mlai (ids:ide-1,jds:jde-1,02) = emiss(ids:ide-1,jds:jde-1,mgnin_lai02)
360 grid%mlai (ids:ide-1,jds:jde-1,03) = emiss(ids:ide-1,jds:jde-1,mgnin_lai03)
361 grid%mlai (ids:ide-1,jds:jde-1,04) = emiss(ids:ide-1,jds:jde-1,mgnin_lai04)
362 grid%mlai (ids:ide-1,jds:jde-1,05) = emiss(ids:ide-1,jds:jde-1,mgnin_lai05)
363 grid%mlai (ids:ide-1,jds:jde-1,06) = emiss(ids:ide-1,jds:jde-1,mgnin_lai06)
364 grid%mlai (ids:ide-1,jds:jde-1,07) = emiss(ids:ide-1,jds:jde-1,mgnin_lai07)
365 grid%mlai (ids:ide-1,jds:jde-1,08) = emiss(ids:ide-1,jds:jde-1,mgnin_lai08)
366 grid%mlai (ids:ide-1,jds:jde-1,09) = emiss(ids:ide-1,jds:jde-1,mgnin_lai09)
367 grid%mlai (ids:ide-1,jds:jde-1,10) = emiss(ids:ide-1,jds:jde-1,mgnin_lai10)
368 grid%mlai (ids:ide-1,jds:jde-1,11) = emiss(ids:ide-1,jds:jde-1,mgnin_lai11)
369 grid%mlai (ids:ide-1,jds:jde-1,12) = emiss(ids:ide-1,jds:jde-1,mgnin_lai12)
370 ! Plant functional group percentage
371 grid%pftp_bt (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_bt)
372 grid%pftp_nt (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_nt)
373 grid%pftp_sb (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_sb)
374 grid%pftp_hb (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_hb)
375 ! "Climatological" monthly mean surface air temperature [=] K
376 ! (Note: The height of surface air temperature is not considered important;
377 ! this is not needed if online 24-hour average values are used
378 grid%mtsa (ids:ide-1,jds:jde-1,01) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa01)
379 grid%mtsa (ids:ide-1,jds:jde-1,02) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa02)
380 grid%mtsa (ids:ide-1,jds:jde-1,03) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa03)
381 grid%mtsa (ids:ide-1,jds:jde-1,04) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa04)
382 grid%mtsa (ids:ide-1,jds:jde-1,05) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa05)
383 grid%mtsa (ids:ide-1,jds:jde-1,06) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa06)
384 grid%mtsa (ids:ide-1,jds:jde-1,07) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa07)
385 grid%mtsa (ids:ide-1,jds:jde-1,08) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa08)
386 grid%mtsa (ids:ide-1,jds:jde-1,09) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa09)
387 grid%mtsa (ids:ide-1,jds:jde-1,10) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa10)
388 grid%mtsa (ids:ide-1,jds:jde-1,11) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa11)
389 grid%mtsa (ids:ide-1,jds:jde-1,12) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa12)
390 ! "Climatological" monthly mean downward irradiance at the surface [=] W/m2
391 ! This is not needed if online 24-hour average values are used
392 grid%mswdown (ids:ide-1,jds:jde-1,01) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown01)
393 grid%mswdown (ids:ide-1,jds:jde-1,02) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown02)
394 grid%mswdown (ids:ide-1,jds:jde-1,03) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown03)
395 grid%mswdown (ids:ide-1,jds:jde-1,04) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown04)
396 grid%mswdown (ids:ide-1,jds:jde-1,05) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown05)
397 grid%mswdown (ids:ide-1,jds:jde-1,06) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown06)
398 grid%mswdown (ids:ide-1,jds:jde-1,07) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown07)
399 grid%mswdown (ids:ide-1,jds:jde-1,08) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown08)
400 grid%mswdown (ids:ide-1,jds:jde-1,09) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown09)
401 grid%mswdown (ids:ide-1,jds:jde-1,10) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown10)
402 grid%mswdown (ids:ide-1,jds:jde-1,11) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown11)
403 grid%mswdown (ids:ide-1,jds:jde-1,12) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown12)
404
405
406
407
408 DEALLOCATE( emiss )
409
410 end SUBROUTINE input_ext_chem_megan2_file
411
412 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
413
414
415 END MODULE module_input_chem_bioemiss
416