1 ! This is a program that converts biobenic emissions data
5 PROGRAM convert_bioemiss
6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
12 USE module_driver_constants
19 USE module_input_chem_bioemiss
24 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28 SUBROUTINE Setup_Timekeeping( grid )
30 TYPE(domain), POINTER :: grid
31 END SUBROUTINE Setup_Timekeeping
36 INTEGER :: loop , levels_to_process
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
43 INTEGER :: max_dom, domain_id
44 INTEGER :: id1 , id , fid, ierr
45 INTEGER :: idum1, idum2 , ihour
48 INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
49 INTEGER :: configbuf( configbuflen )
50 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
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
59 CHARACTER (LEN=80) :: message
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
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
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
75 CHARACTER (LEN=80) :: inpname , eminame, dum_str, wrfinname
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
81 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
84 ! Get the NAMELIST data for input.
86 ! Define the name of this program (program_name defined in module_domain)
88 program_name = "WRF V2.1.2 BIOGENIC EMISSIONS PREPROCESSOR"
95 CALL wrf_debug ( 100 , 'convert_emiss: 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)
102 IF ( wrf_dm_on_monitor() ) THEN
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 )
108 CALL wrf_dm_initialize
113 CALL wrf_message ( program_name )
117 ! ! Get the grid info from the wrfinput file
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 , &
124 parent = null_domain , &
126 write(message,FMT='(A)') ' pointer for wrfinput_d01 '
127 CALL wrf_debug ( 100, message )
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 )
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 )
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 )
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 )
149 write(message,FMT='(A)') ' past opening wrfinput_d01 '
150 CALL wrf_debug ( 100, message )
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 )
168 CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
171 ! An available simple timer from the timing module.
173 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
175 CALL Setup_Timekeeping ( grid )
176 CALL domain_clock_set( grid, &
177 time_step_seconds=model_config_rec%interval_seconds )
178 CALL domain_clock_get ( grid, current_timestr=message )
179 write(message,FMT='(A,A)') ' current_time ',Trim(message)
180 CALL wrf_debug ( 100, message )
182 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
184 ! print *,'start date=',model_config_rec%start_year(grid%id),model_config_rec%start_month(grid%id),&
185 ! model_config_rec%start_day(grid%id),model_config_rec%start_hour(grid%id)
186 ! print *,'end date=',model_config_rec%end_year(grid%id),model_config_rec%end_month(grid%id),&
187 ! model_config_rec%end_day(grid%id),model_config_rec%end_hour(grid%id)
188 ! print *,'interval =',model_config_rec%interval_seconds
189 ! print *,'init_typ =',model_config_rec%real_data_init_type
191 ! Figure out the starting and ending dates in a character format.
193 start_year = model_config_rec%start_year (grid%id)
194 start_month = model_config_rec%start_month (grid%id)
195 start_day = model_config_rec%start_day (grid%id)
196 start_hour = model_config_rec%start_hour (grid%id)
197 start_minute = model_config_rec%start_minute(grid%id)
198 start_second = model_config_rec%start_second(grid%id)
200 end_year = model_config_rec% end_year (grid%id)
201 end_month = model_config_rec% end_month (grid%id)
202 end_day = model_config_rec% end_day (grid%id)
203 end_hour = model_config_rec% end_hour (grid%id)
204 end_minute = model_config_rec% end_minute(grid%id)
205 end_second = model_config_rec% end_second(grid%id)
207 interval_seconds = 3600
208 real_data_init_type = model_config_rec%real_data_init_type
210 WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
211 start_year,start_month,start_day,start_hour,start_minute,start_second
212 WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
213 end_year, end_month, end_day, end_hour, end_minute, end_second
215 ! these are needed on some compilers, eg compaq/alpha, to
216 ! permit pass by reference through the registry generated
217 ! interface to med_read_emissions, below
228 write(message,FMT='(A)') ' READ BIOGENIC EMISSIONS '
229 CALL wrf_debug ( 100, message )
230 CALL input_ext_chem_beis3_file ( grid )
231 write(message,FMT='(A)') ' PAST READ BIOGENIC EMISSIONS '
232 CALL wrf_debug ( 100, message )
234 grid%input_from_file = .false.
236 write(message,FMT='(A)') ' OPEN BIOGENIC EMISSIONS WRF file'
237 CALL wrf_debug ( 100, message )
239 CALL construct_filename1( inpname , 'wrfbiochemi' , grid%id , 2 )
240 CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_aux_model_input4 , "DATASET=AUXINPUT4", ierr )
241 write(message,FMT='(A,A)') ' BIOGENIC EMISSIONS file name: ',TRIM(inpname)
242 CALL wrf_message ( message )
244 IF ( ierr .NE. 0 ) THEN
245 CALL wrf_error_fatal( 'real: error opening wrfchem emissions file for writing' )
248 write(message,FMT='(A)') ' PAST OPEN BIOGENIC EMISSIONS WRF file '
249 CALL wrf_debug ( 100, message )
251 CALL calc_current_date ( grid%id , 0. )
252 CALL geth_newdate ( current_date_char, current_date, 3600 )
253 current_date = current_date_char // '.0000'
255 if( stand_lon == 0. ) then
259 if( moad_cen_lat == 0. ) then
260 moad_cen_lat = cen_lat
263 CALL output_aux_model_input4 ( id1 , grid , config_flags , ierr )
265 write(message,FMT='(A)') ' BIOGENIC EMISSIONS: fix global attributes '
266 CALL wrf_debug ( 100, message )
268 ! write global atributes into wrf emissions file
271 call wrf_put_dom_ti_char ( id1 , 'START_DATE' ,TRIM(start_date_char) , ierr )
272 CALL wrf_put_dom_ti_integer ( id1 , 'MAP_PROJ' , map_proj , 1 , ierr )
273 CALL wrf_put_dom_ti_real ( id1 , 'MOAD_CEN_LAT' , moad_cen_lat, 1 , ierr )
274 CALL wrf_put_dom_ti_real ( id1 , 'CEN_LAT' , cen_lat , 1 , ierr )
275 CALL wrf_put_dom_ti_real ( id1 , 'CEN_LON' , cen_lon , 1 , ierr )
276 CALL wrf_put_dom_ti_real ( id1 , 'STAND_LON' , stand_lon , 1 , ierr )
277 CALL wrf_put_dom_ti_real ( id1 , 'TRUELAT1' , truelat1 , 1 , ierr )
278 CALL wrf_put_dom_ti_real ( id1 , 'TRUELAT2' , truelat2 , 1 , ierr )
279 CALL wrf_put_dom_ti_real ( id1 , 'GMT' , gmt , 1 , ierr )
280 CALL wrf_put_dom_ti_integer ( id1 , 'JULYR' , julyr , 1 , ierr )
281 CALL wrf_put_dom_ti_integer ( id1 , 'JULDAY' , julday , 1 , ierr )
282 ! CALL wrf_put_dom_ti_integer ( id1 , 'CHEM_OPT' , chem_opt , 1 , ierr )
283 CALL wrf_put_dom_ti_integer ( id1 , 'ISWATER' , iswater , 1 , ierr )
284 CALL wrf_put_dom_ti_integer ( id1 , 'ISICE ' , isice , 1 , ierr )
285 CALL wrf_put_dom_ti_integer ( id1 , 'ISURBAN' , isurban , 1 , ierr )
286 CALL wrf_put_dom_ti_integer ( id1 , 'ISOILWATER' , isoilwater , 1 , ierr )
287 CALL wrf_put_dom_ti_char ( id1 , 'MMINLU' , TRIM(chlanduse) , ierr )
290 CALL close_dataset ( id1 , config_flags , "DATASET=AUXOUTPUT4" )
292 write(message,FMT='(A)') ' BIOGENIC EMISSIONS: end of program '
293 CALL wrf_message ( message )
297 CALL WRFU_Finalize( rc=rc )
300 ! CALL wrf_dm_shutdown
305 END PROGRAM convert_bioemiss