convert_emiss.F
References to this file elsewhere.
1 ! This is a program that converts emissions data into WRF input data.
2 !
3
4 PROGRAM convert_emiss
5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6
7 USE module_machine
8 USE module_domain
9 USE module_io
10 USE module_wrf_error
11 USE module_io_wrf
12 USE module_initialize
13 USE module_integrate
14 USE module_driver_constants
15 USE module_state_description
16 USE module_configure
17 USE module_timing
18 USE module_utility
19 USE module_input_chem_data
20 #ifdef DM_PARALLEL
21 USE module_dm
22 #endif
23
24 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
25 IMPLICIT NONE
26
27 INTERFACE
28 SUBROUTINE Setup_Timekeeping( grid )
29 USE module_domain
30 TYPE(domain), POINTER :: grid
31 END SUBROUTINE Setup_Timekeeping
32 END INTERFACE
33
34 REAL :: time
35
36 INTEGER :: loop , levels_to_process
37 INTEGER :: rc
38
39 TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid, ingrid
40 TYPE (grid_config_rec_type) :: config_flags, config_flags_in
41 INTEGER :: number_at_same_level
42
43 INTEGER :: max_dom, domain_id
44 INTEGER :: id1 , id , fid, ierr
45 INTEGER :: idum1, idum2 , ihour
46 #ifdef DM_PARALLEL
47 INTEGER :: nbytes
48 INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
49 INTEGER :: configbuf( configbuflen )
50 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
51 #endif
52
53 REAL :: dt_from_file, tstart_from_file, tend_from_file
54 INTEGER :: ids , ide , jds , jde , kds , kde
55 INTEGER :: ims , ime , jms , jme , kms , kme
56 INTEGER :: i , j , k , idts, ntsd, emi_frame, nemi_frames
57 INTEGER :: debug_level = 0
58
59 INTEGER ibuf(1)
60 REAL rbuf(1)
61
62 CHARACTER (LEN=80) :: message
63
64 CHARACTER(LEN=24) :: previous_date , this_date , next_date
65 CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
66 CHARACTER(LEN= 4) :: loop_char
67
68 INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
69 INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
70 INTEGER :: interval_seconds , real_data_init_type
71 INTEGER :: time_loop_max , time_loop
72
73 REAL :: cen_lat, cen_lon, moad_cen_lat, truelat1, truelat2, gmt, stand_lon, dum1
74 INTEGER :: map_proj, julyr, julday, iswater, isice, isurban, isoilwater
75 CHARACTER(LEN= 8) :: chlanduse
76
77
78 CHARACTER (LEN=80) :: inpname , eminame, dum_str, wrfinname
79
80 ! these are needed on some compilers, eg compaq/alpha, to
81 ! permit pass by reference through the registry generated
82 ! interface to med_read_emissions, below
83 #ifdef DEREF_KLUDGE
84 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
85 #endif
86
87 ! Get the NAMELIST data for input.
88
89 ! Define the name of this program (program_name defined in module_domain)
90
91 program_name = "WRF V2.1.2 EMISSIONS PREPROCESSOR "
92
93 #ifdef DM_PARALLEL
94 CALL disable_quilting
95 #endif
96
97 ! CALL init_modules
98 CALL wrf_debug ( 100 , 'convert_emiss: calling init_modules ' )
99 CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
100 CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
101 CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
102
103 #ifdef DM_PARALLEL
104 IF ( wrf_dm_on_monitor() ) THEN
105 CALL initial_config
106 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
107 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
108 CALL set_config_as_buffer( configbuf, configbuflen )
109 ENDIF
110 CALL wrf_dm_initialize
111 #else
112 CALL initial_config
113 #endif
114
115 CALL nl_get_debug_level ( 1, debug_level )
116 CALL set_wrf_debug_level ( debug_level )
117
118 CALL wrf_message ( program_name )
119
120 CALL init_wrfio
121
122 ! ! Get the grid info from the wrfinput file
123
124 write(message,FMT='(A)') ' allocate for wrfinput_d01 '
125 CALL wrf_debug ( 100, message )
126 NULLIFY( null_domain )
127 CALL alloc_and_configure_domain ( domain_id = 1 , &
128 grid = head_grid , &
129 parent = null_domain , &
130 kid = -1 )
131 write(message,FMT='(A)') ' pointer for wrfinput_d01 '
132 CALL wrf_debug ( 100, message )
133 grid => head_grid
134 write(message,FMT='(A)') ' set scalars for wrfinput_d01 '
135 CALL wrf_debug ( 100, message )
136 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
137
138 write(message,FMT='(A)') ' construct filename for wrfinput_d01 '
139 CALL wrf_debug ( 100, message )
140 CALL construct_filename1( wrfinname , 'wrfinput' , grid%id , 2 )
141
142 write(message,FMT='(A,A)')' open file ',TRIM(wrfinname)
143 CALL wrf_debug ( 100, message )
144 CALL open_r_dataset ( fid, TRIM(wrfinname) , grid , config_flags , "DATASET=INPUT", ierr )
145
146 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
147
148
149 write(message,FMT='(A)') ' wrfinput open error check '
150 CALL wrf_debug ( 100, message )
151 IF ( ierr .NE. 0 ) THEN
152 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) &
153 'program convert_emiss: error opening ',TRIM(wrfinname),' for reading ierr=',ierr
154 CALL WRF_ERROR_FATAL ( wrf_err_message )
155 ENDIF
156 write(message,FMT='(A)') ' past opening wrfinput_d01 '
157 CALL wrf_debug ( 100, message )
158
159 CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , map_proj , 1 , idum1 , ierr )
160 CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , cen_lat , 1 , idum1 , ierr )
161 CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , cen_lon , 1 , idum1 , ierr )
162 CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , idum1 , ierr )
163 CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' , stand_lon , 1 , idum1 , ierr )
164 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' , truelat1 , 1 , idum1 , ierr )
165 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' , truelat2 , 1 , idum1 , ierr )
166 CALL wrf_get_dom_ti_real ( fid , 'GMT' , gmt , 1 , idum1 , ierr )
167 CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , julyr , 1 , idum1 , ierr )
168 CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , julday , 1 , idum1 , ierr )
169 CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , iswater , 1 , idum1 , ierr )
170 CALL wrf_get_dom_ti_integer ( fid , 'ISICE ' , isice , 1 , idum1 , ierr )
171 CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' , isurban , 1 , idum1 , ierr )
172 CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' , isoilwater , 1 , idum1 , ierr )
173 CALL wrf_get_dom_ti_char ( fid , 'MMINLU' , chlanduse , ierr )
174
175 CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
176
177
178 ! An available simple timer from the timing module.
179
180 ! NULLIFY( null_domain )
181 ! CALL alloc_and_configure_domain ( domain_id = 1 , &
182 ! grid = head_grid , &
183 ! parent = null_domain , &
184 ! kid = -1 )
185
186 ! grid => head_grid
187 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
188
189
190 CALL Setup_Timekeeping ( grid )
191 CALL domain_clockprint ( 150, grid, &
192 'DEBUG emissions_convert: clock after Setup_Timekeeping,' )
193 CALL domain_clock_set( grid, &
194 time_step_seconds=model_config_rec%interval_seconds )
195 CALL domain_clockprint ( 150, grid, &
196 'DEBUG emissions_convert: clock after timeStep set,' )
197
198 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
199
200 ! print *,'start date=',model_config_rec%start_year(grid%id),model_config_rec%start_month(grid%id),&
201 ! model_config_rec%start_day(grid%id),model_config_rec%start_hour(grid%id)
202 ! print *,'end date=',model_config_rec%end_year(grid%id),model_config_rec%end_month(grid%id),&
203 ! model_config_rec%end_day(grid%id),model_config_rec%end_hour(grid%id)
204 ! print *,'interval =',model_config_rec%interval_seconds
205 ! print *,'init_typ =',model_config_rec%real_data_init_type
206
207 ! Figure out the starting and ending dates in a character format.
208
209 start_year = model_config_rec%start_year (grid%id)
210 start_month = model_config_rec%start_month (grid%id)
211 start_day = model_config_rec%start_day (grid%id)
212 start_hour = model_config_rec%start_hour (grid%id)
213 start_minute = model_config_rec%start_minute(grid%id)
214 start_second = model_config_rec%start_second(grid%id)
215
216 end_year = model_config_rec% end_year (grid%id)
217 end_month = model_config_rec% end_month (grid%id)
218 end_day = model_config_rec% end_day (grid%id)
219 end_hour = model_config_rec% end_hour (grid%id)
220 end_minute = model_config_rec% end_minute(grid%id)
221 end_second = model_config_rec% end_second(grid%id)
222
223 interval_seconds = 3600
224 real_data_init_type = model_config_rec%real_data_init_type
225
226 WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
227 start_year,start_month,start_day,start_hour,start_minute,start_second
228 WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
229 end_year, end_month, end_day, end_hour, end_minute, end_second
230
231
232 ! Figure out our loop count for the processing times.
233
234 time_loop = 1
235 write(message,FMT='(A,I4,A,A)') 'Time period #',time_loop,' to process = ',start_date_char
236 CALL wrf_message ( message )
237 current_date_char = start_date_char
238 loop_count : DO
239 CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
240 IF ( next_date_char .LT. end_date_char ) THEN
241 time_loop = time_loop + 1
242 write(message,FMT='(A,I4,A,A)') 'Time period #',time_loop,' to process = ',next_date_char
243 CALL wrf_message ( message )
244 current_date_char = next_date_char
245 ELSE IF ( next_date_char .EQ. end_date_char ) THEN
246 time_loop = time_loop + 1
247 write(message,FMT='(A,I4,A,A)') 'Time period #',time_loop,' to process = ',next_date_char
248 CALL wrf_message ( message )
249 write(message,FMT='(A,I4)') 'Total analysis times to input = ',time_loop
250 CALL wrf_message ( message )
251 time_loop_max = time_loop
252 EXIT loop_count
253 ELSE IF ( next_date_char .GT. end_date_char ) THEN
254 write(message,FMT='(A,I4)') 'Total analysis times to input = ',time_loop
255 CALL wrf_message ( message )
256 time_loop_max = time_loop
257 EXIT loop_count
258 END IF
259 END DO loop_count
260 write(message,FMT='(A,I4,A,I4)') 'Total number of times to input = ',time_loop,' ',time_loop_max
261 CALL wrf_message ( message )
262
263 ! Here we define the initial time to process, for later use by the code.
264
265 current_date_char = start_date_char
266 start_date = start_date_char // '.0000'
267 current_date = start_date
268
269 ! these are needed on some compilers, eg compaq/alpha, to
270 ! permit pass by reference through the registry generated
271 ! interface to med_read_emissions, below
272 #ifdef DEREF_KLUDGE
273 sm31 = grid%sm31
274 em31 = grid%em31
275 sm32 = grid%sm32
276 em32 = grid%em32
277 sm33 = grid%sm33
278 em33 = grid%em33
279 #endif
280
281 ihour = start_hour
282 write(message,FMT='(A)') ' READ EMISSIONS 1'
283 CALL wrf_debug ( 100, message )
284 CALL med_read_bin_chem_emiss ( grid , config_flags, ihour, time_loop )
285 write(message,FMT='(A)') ' PAST READ EMISSIONS 1'
286 CALL wrf_debug ( 100, message )
287
288 grid%input_from_file = .false.
289
290 write(message,FMT='(A)') ' OPEN EMISSIONS WRF file '
291 CALL wrf_debug ( 100, message )
292
293 CALL construct_filename1( inpname , 'wrfchemi' , grid%id , 2 )
294 CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_aux_model_input5 , "DATASET=AUXINPUT5", ierr )
295 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
296 write(message,FMT='(A,A)') ' EMISSIONS file name: ',TRIM(inpname)
297 CALL wrf_message ( message )
298 IF ( ierr .NE. 0 ) THEN
299 CALL wrf_error_fatal( 'real: error opening wrfchem emissions file for writing' )
300 ENDIF
301
302 write(message,FMT='(A)') ' PAST OPEN EMISSIONS WRF file '
303 CALL wrf_debug ( 100, message )
304
305 CALL calc_current_date ( grid%id , 0. )
306 CALL geth_newdate ( current_date_char, current_date, 3600 )
307 current_date = current_date_char // '.0000'
308
309 if( stand_lon == 0. ) then
310 stand_lon = cen_lon
311 endif
312
313 if( moad_cen_lat == 0. ) then
314 moad_cen_lat = cen_lat
315 endif
316
317 ! CALL output_aux_model_input5 ( id1 , grid , config_flags , ierr )
318
319 ! write global atributes into wrf emissions file
320
321 ! grid%map_proj = map_proj
322 ! grid%cen_lat = cen_lat
323 ! grid%cen_lon = cen_lon
324 config_flags%map_proj = map_proj
325 config_flags%cen_lat = cen_lat
326 config_flags%cen_lon = cen_lon
327 config_flags%stand_lon = stand_lon
328 config_flags%truelat1 = truelat1
329 config_flags%truelat2 = truelat2
330 config_flags%gmt = gmt
331 config_flags%julyr = julyr
332 config_flags%julday = julday
333 config_flags%iswater = iswater
334 config_flags%isice = isice
335 config_flags%isurban = isurban
336 config_flags%isoilwater = isoilwater
337 config_flags%moad_cen_lat = moad_cen_lat
338 ! config_flags%mminlu = TRIM(chlanduse)
339
340 CALL output_aux_model_input5 ( id1 , grid , config_flags, ierr )
341
342 current_date_char = start_date_char
343 current_date = current_date_char
344
345 nemi_frames = time_loop
346 if( debug_level >= -100) print *,'NEMI_FRAMES ', nemi_frames,time_loop
347
348 DO emi_frame = 2,nemi_frames
349 write(message,FMT='(A,I4)') 'emi_frame: ',emi_frame
350 CALL wrf_debug ( 100, message )
351 CALL domain_clock_get ( grid, current_timestr=message )
352 write(message,FMT='(A,A)') ' Current time ',Trim(message)
353 CALL wrf_debug ( 100, message )
354
355 current_date_char = current_date(1:19)
356 CALL geth_newdate ( next_date_char, current_date_char, int(interval_seconds) )
357 current_date = next_date_char // '.0000'
358
359 write(message,FMT='(A,A)') ' Date & time ',Trim(current_date)
360 CALL wrf_message ( message )
361
362 CALL domain_clockadvance( grid )
363
364 write(message,FMT='(A,I4)') ' Read emissions ',emi_frame
365 CALL wrf_debug ( 100, message )
366 ihour = mod(ihour + 1,24)
367 CALL med_read_bin_chem_emiss ( grid , config_flags, ihour, nemi_frames-1 )
368
369 ! write global atributes into wrf emissions file
370
371 write(message,FMT='(A)') ' Output emissions '
372 CALL wrf_debug ( 100, message )
373 CALL output_aux_model_input5 ( id1 , grid , config_flags , ierr )
374
375 ! idum1 = 1
376 ! CALL wrf_put_dom_ti_char ( id1 , 'START_DATE' ,TRIM(start_date_char) , ierr )
377 ! CALL wrf_put_dom_ti_integer ( id1 , 'MAP_PROJ' , map_proj , 1 , ierr )
378 ! CALL wrf_put_dom_ti_real ( id1 , 'MOAD_CEN_LAT' , moad_cen_lat, 1 , ierr )
379 ! CALL wrf_put_dom_ti_real ( id1 , 'CEN_LAT' , cen_lat , 1 , ierr )
380 ! CALL wrf_put_dom_ti_real ( id1 , 'CEN_LON' , cen_lon , 1 , ierr )
381 ! CALL wrf_put_dom_ti_real ( id1 , 'STAND_LON' , stand_lon , 1 , ierr )
382 ! CALL wrf_put_dom_ti_real ( id1 , 'TRUELAT1' , truelat1 , 1 , ierr )
383 ! CALL wrf_put_dom_ti_real ( id1 , 'TRUELAT2' , truelat2 , 1 , ierr )
384 ! CALL wrf_put_dom_ti_real ( id1 , 'GMT' , gmt , 1 , ierr )
385 ! CALL wrf_put_dom_ti_integer ( id1 , 'MAP_PROJ' , map_proj , 1 , ierr )
386 ! CALL wrf_put_dom_ti_integer ( id1 , 'JULYR' , julyr , 1 , ierr )
387 ! CALL wrf_put_dom_ti_integer ( id1 , 'JULDAY' , julday , 1 , ierr )
388 ! CALL wrf_put_dom_ti_integer ( id1 , 'ISWATER' , iswater , 1 , ierr )
389 ! CALL wrf_put_dom_ti_integer ( id1 , 'ISICE ' , isice , 1 , ierr )
390 ! CALL wrf_put_dom_ti_integer ( id1 , 'ISURBAN' , isurban , 1 , ierr )
391 ! CALL wrf_put_dom_ti_integer ( id1 , 'ISOILWATER' , isoilwater , 1 , ierr )
392 ! CALL wrf_put_dom_ti_char ( id1 , 'MMINLU' , TRIM(chlanduse) , ierr )
393
394
395 ! print *,' map_proj ', config_flags%map_proj, map_proj
396 ! print *,' cen_lat ', config_flags%cen_lat , cen_lat
397 ! print *,' cen_lon ', config_flags%cen_lon , cen_lon
398
399 END DO
400
401 CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT5" )
402
403 write(message,FMT='(A)') 'CONVERT EMISSIONS: end of program '
404 CALL wrf_message ( message )
405
406 CALL wrf_shutdown
407 CALL WRFU_Finalize( rc=rc )
408
409 !#ifdef DM_PARALLEL
410 ! CALL wrf_dm_shutdown
411 !#endif
412 STOP
413
414 END PROGRAM convert_emiss