convert_bioemiss_megan2.F
References to this file elsewhere.
1 ! This is a program that converts biobenic emissions data
2 ! into WRF input data.
3 !
4
5 PROGRAM convert_bioemiss
6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7
8 USE module_machine
9 USE module_domain
10 USE module_initialize_real
11 USE module_integrate
12 USE module_driver_constants
13 USE module_configure
14 USE module_io_wrf
15 USE module_io_domain
16 USE module_timing
17 USE module_utility
18 USE module_wrf_error
19 USE module_input_chem_bioemiss
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 CHARACTER (LEN=80) :: message
60
61 CHARACTER(LEN=24) :: previous_date , this_date , next_date
62 CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
63 CHARACTER(LEN= 4) :: loop_char
64
65 INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
66 INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
67 INTEGER :: interval_seconds , real_data_init_type
68 INTEGER :: time_loop_max , time_loop
69
70 REAL :: cen_lat, cen_lon, moad_cen_lat, truelat1, truelat2, gmt, stand_lon, dum1
71 INTEGER :: map_proj, julyr, julday, iswater, isice, isurban, isoilwater
72 CHARACTER(LEN= 8) :: chlanduse
73
74
75 CHARACTER (LEN=80) :: inpname , eminame, dum_str, wrfinname
76
77 ! these are needed on some compilers, eg compaq/alpha, to
78 ! permit pass by reference through the registry generated
79 ! interface to med_read_emissions, below
80 #ifdef DEREF_KLUDGE
81 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
82 #endif
83
84 ! Get the NAMELIST data for input.
85
86 ! Define the name of this program (program_name defined in module_domain)
87
88 program_name = "WRF V2.1.2 BIOGENIC EMISSIONS PREPROCESSOR"
89
90 #ifdef DM_PARALLEL
91 CALL disable_quilting
92 #endif
93
94 ! CALL init_modules
95 CALL wrf_debug ( 100 , 'convert_emiss_megan2: calling init_modules ' )
96 CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
97 CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
98 CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
99
100
101 #ifdef DM_PARALLEL
102 IF ( wrf_dm_on_monitor() ) THEN
103 CALL initial_config
104 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
105 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
106 CALL set_config_as_buffer( configbuf, configbuflen )
107 ENDIF
108 CALL wrf_dm_initialize
109 #else
110 CALL initial_config
111 #endif
112
113 CALL wrf_message ( program_name )
114
115 CALL init_wrfio
116
117 ! ! Get the grid info from the wrfinput file
118
119 write(message,FMT='(A)') ' allocate for wrfinput_d01 '
120 CALL wrf_message ( program_name )
121 NULLIFY( null_domain )
122 CALL alloc_and_configure_domain ( domain_id = 1 , &
123 grid = head_grid , &
124 parent = null_domain , &
125 kid = -1 )
126 write(message,FMT='(A)') ' pointer for wrfinput_d01 '
127 CALL wrf_debug ( 100, message )
128 grid => head_grid
129 write(message,FMT='(A)') ' set scalars for wrfinput_d01 '
130 CALL wrf_debug ( 100, message )
131 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
132
133 write(message,FMT='(A)') ' construct filename for wrfinput_d01 '
134 CALL wrf_debug ( 100, message )
135 CALL construct_filename1( wrfinname , 'wrfinput' , grid%id , 2 )
136
137 write(message,FMT='(A,A)') ' open file ',TRIM(wrfinname)
138 CALL wrf_message ( message )
139 CALL open_r_dataset ( fid, TRIM(wrfinname) , grid , config_flags , "DATASET=INPUT", ierr )
140
141
142 write(message,FMT='(A)') ' wrfinput open error check '
143 CALL wrf_debug ( 100, message )
144 IF ( ierr .NE. 0 ) THEN
145 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) &
146 'program convert_emiss: error opening ',TRIM(wrfinname),' for reading ierr=',ierr
147 CALL WRF_ERROR_FATAL ( wrf_err_message )
148 ENDIF
149 write(message,FMT='(A)') ' past opening wrfinput_d01 '
150 CALL wrf_debug ( 100, message )
151
152 CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , map_proj , 1 , idum1 , ierr )
153 CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , cen_lat , 1 , idum1 , ierr )
154 CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , cen_lon , 1 , idum1 , ierr )
155 CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , idum1 , ierr )
156 CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' , stand_lon , 1 , idum1 , ierr )
157 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' , truelat1 , 1 , idum1 , ierr )
158 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' , truelat2 , 1 , idum1 , ierr )
159 CALL wrf_get_dom_ti_real ( fid , 'GMT' , gmt , 1 , idum1 , ierr )
160 CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , julyr , 1 , idum1 , ierr )
161 CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , julday , 1 , idum1 , ierr )
162 CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , iswater , 1 , idum1 , ierr )
163 CALL wrf_get_dom_ti_integer ( fid , 'ISICE ' , isice , 1 , idum1 , ierr )
164 CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' , isurban , 1 , idum1 , ierr )
165 CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' , isoilwater , 1 , idum1 , ierr )
166 CALL wrf_get_dom_ti_char ( fid , 'MMINLU' , chlanduse , ierr )
167
168 CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
169
170 config_flags%cen_lat = cen_lat
171 config_flags%cen_lon = cen_lon
172
173
174 ! An available simple timer from the timing module.
175
176 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
177
178 CALL Setup_Timekeeping ( grid )
179 CALL domain_clock_set( grid, &
180 time_step_seconds=model_config_rec%interval_seconds )
181 CALL domain_clock_get ( grid, current_timestr=message )
182 write(message,FMT='(A,A)') ' current_time ',Trim(message)
183 CALL wrf_debug ( 100, message )
184
185 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
186
187 ! print *,'start date=',model_config_rec%start_year(grid%id),model_config_rec%start_month(grid%id),&
188 ! model_config_rec%start_day(grid%id),model_config_rec%start_hour(grid%id)
189 ! print *,'end date=',model_config_rec%end_year(grid%id),model_config_rec%end_month(grid%id),&
190 ! model_config_rec%end_day(grid%id),model_config_rec%end_hour(grid%id)
191 ! print *,'interval =',model_config_rec%interval_seconds
192 ! print *,'init_typ =',model_config_rec%real_data_init_type
193
194 ! Figure out the starting and ending dates in a character format.
195
196 start_year = model_config_rec%start_year (grid%id)
197 start_month = model_config_rec%start_month (grid%id)
198 start_day = model_config_rec%start_day (grid%id)
199 start_hour = model_config_rec%start_hour (grid%id)
200 start_minute = model_config_rec%start_minute(grid%id)
201 start_second = model_config_rec%start_second(grid%id)
202
203 end_year = model_config_rec% end_year (grid%id)
204 end_month = model_config_rec% end_month (grid%id)
205 end_day = model_config_rec% end_day (grid%id)
206 end_hour = model_config_rec% end_hour (grid%id)
207 end_minute = model_config_rec% end_minute(grid%id)
208 end_second = model_config_rec% end_second(grid%id)
209
210 interval_seconds = 3600
211 real_data_init_type = model_config_rec%real_data_init_type
212
213 WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
214 start_year,start_month,start_day,start_hour,start_minute,start_second
215 WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
216 end_year, end_month, end_day, end_hour, end_minute, end_second
217
218 ! these are needed on some compilers, eg compaq/alpha, to
219 ! permit pass by reference through the registry generated
220 ! interface to med_read_emissions, below
221 #ifdef DEREF_KLUDGE
222 sm31 = grid%sm31
223 em31 = grid%em31
224 sm32 = grid%sm32
225 em32 = grid%em32
226 sm33 = grid%sm33
227 em33 = grid%em33
228 #endif
229
230 ihour = start_hour
231 write(message,FMT='(A)') ' READ BIOGENIC EMISSIONS '
232 CALL wrf_debug ( 100, message )
233 CALL input_ext_chem_megan2_file ( grid )
234 write(message,FMT='(A)') ' PAST READ BIOGENIC EMISSIONS '
235 CALL wrf_debug ( 100, message )
236
237 grid%input_from_file = .false.
238
239 write(message,FMT='(A)') ' OPEN BIOGENIC EMISSIONS WRF file'
240 CALL wrf_debug ( 100, message )
241
242 CALL construct_filename1( inpname , 'wrfbiochemi' , grid%id , 2 )
243 CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_aux_model_input4 , "DATASET=AUXINPUT4", ierr )
244 write(message,FMT='(A,A)') ' BIOGENIC EMISSIONS file name: ',TRIM(inpname)
245 CALL wrf_message ( message )
246
247 IF ( ierr .NE. 0 ) THEN
248 CALL wrf_error_fatal( 'real: error opening wrfchem emissions file for writing' )
249 ENDIF
250
251 write(message,FMT='(A)') ' PAST OPEN BIOGENIC EMISSIONS WRF file '
252 CALL wrf_debug ( 100, message )
253
254 CALL calc_current_date ( grid%id , 0. )
255 CALL geth_newdate ( current_date_char, current_date, 3600 )
256 current_date = current_date_char // '.0000'
257
258 if( stand_lon == 0. ) then
259 stand_lon = cen_lon
260 endif
261
262 if( moad_cen_lat == 0. ) then
263 moad_cen_lat = cen_lat
264 endif
265
266
267 config_flags%cen_lat = cen_lat
268 config_flags%cen_lon = cen_lon
269 config_flags%map_proj = map_proj
270 config_flags%cen_lat = cen_lat
271 config_flags%cen_lon = cen_lon
272 config_flags%moad_cen_lat = moad_cen_lat
273 config_flags%stand_lon = stand_lon
274 config_flags%truelat1 = truelat1
275 config_flags%truelat2 = truelat2
276 config_flags%gmt = gmt
277 config_flags%julyr = julyr
278 config_flags%julday = julday
279 config_flags%iswater = iswater
280 config_flags%isice = isice
281 config_flags%isurban = isurban
282 config_flags%isoilwater = isoilwater
283
284
285 CALL output_aux_model_input4 ( id1 , grid , config_flags , ierr )
286
287 write(message,FMT='(A)') ' BIOGENIC EMISSIONS: fix global attributes '
288 CALL wrf_debug ( 100, message )
289
290 ! write global atributes into wrf emissions file
291
292 !shc idum1 = 1
293 !shc call wrf_put_dom_ti_char ( id1 , 'START_DATE' ,TRIM(start_date_char) , ierr )
294 !shc print*,'ierr, start_date = ', ierr, trim(start_date_char)
295 !shc CALL wrf_put_dom_ti_integer ( id1 , 'MAP_PROJ' , map_proj , idum1 , ierr )
296 !shc print*,'ierr, map_proj =',ierr, map_proj
297 !shc CALL wrf_put_dom_ti_real ( id1 , 'MOAD_CEN_LAT' , moad_cen_lat, idum1 , ierr )
298 !shc CALL wrf_put_dom_ti_real ( id1 , 'CEN_LAT' , cen_lat , 1 , ierr )
299 !shc CALL wrf_put_dom_ti_real ( id1 , 'CEN_LON' , cen_lon , 1 , ierr )
300 !shc CALL wrf_put_dom_ti_real ( id1 , 'STAND_LON' , stand_lon , 1 , ierr )
301 !shc CALL wrf_put_dom_ti_real ( id1 , 'TRUELAT1' , truelat1 , 1 , ierr )
302 !shc CALL wrf_put_dom_ti_real ( id1 , 'TRUELAT2' , truelat2 , 1 , ierr )
303 !shc CALL wrf_put_dom_ti_real ( id1 , 'GMT' , gmt , 1 , ierr )
304 !shc CALL wrf_put_dom_ti_integer ( id1 , 'JULYR' , julyr , 1 , ierr )
305 !shc CALL wrf_put_dom_ti_integer ( id1 , 'JULDAY' , julday , 1 , ierr )
306 !shc CALL wrf_put_dom_ti_integer ( id1 , 'CHEM_OPT' , 6 , 1 , ierr )
307 !shc CALL wrf_put_dom_ti_integer ( id1 , 'ISWATER' , iswater , 1 , ierr )
308 !shc CALL wrf_put_dom_ti_integer ( id1 , 'ISICE ' , isice , 1 , ierr )
309 !shc CALL wrf_put_dom_ti_integer ( id1 , 'ISURBAN' , isurban , 1 , ierr )
310 !shc CALL wrf_put_dom_ti_integer ( id1 , 'ISOILWATER' , isoilwater , 1 , ierr )
311 !shc CALL wrf_put_dom_ti_char ( id1 , 'MMINLU' , TRIM(chlanduse) , ierr )
312
313
314 CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT4" )
315
316 write(message,FMT='(A)') ' BIOGENIC EMISSIONS: end of program '
317 CALL wrf_message ( message )
318
319
320 CALL wrf_shutdown
321 CALL WRFU_Finalize( rc=rc )
322
323 !#ifdef DM_PARALLEL
324 ! CALL wrf_dm_shutdown
325 !#endif
326
327 STOP
328
329 END PROGRAM convert_bioemiss