| blob | 9d5651e08c5eeb3e6d140b794ffd4f096329a923 |
1 !
2 !WRF:MEDIATION_LAYER:IO
3 !
5 SUBROUTINE med_calc_model_time ( grid , config_flags )
6 ! Driver layer
7 USE module_domain
8 USE module_configure
9 ! Model layer
10 USE module_date_time
12 IMPLICIT NONE
14 ! Arguments
15 TYPE(domain) :: grid
16 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
18 ! Local data
19 REAL :: time
21 ! this is now handled by with calls to time manager
22 ! time = head_grid%dt * head_grid%total_time_steps
23 ! CALL calc_current_date (grid%id, time)
26 END SUBROUTINE med_calc_model_time
28 SUBROUTINE med_before_solve_io ( grid , config_flags )
29 ! Driver layer
30 USE module_domain
31 USE module_configure
32 ! Model layer
33 USE module_utility
35 IMPLICIT NONE
37 ! Arguments
38 TYPE(domain) :: grid
39 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
40 ! Local
41 INTEGER :: rc
42 CHARACTER*256 :: message
44 #if (EM_CORE == 1)
45 IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) .AND. &
46 (grid%dfi_write_dfi_history .OR. grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI) ) THEN
47 #else
48 IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc )) THEN
49 #endif
50 CALL med_hist_out ( grid , 0, config_flags )
51 CALL WRFU_AlarmRingerOff( grid%alarms( HISTORY_ALARM ), rc=rc )
52 ENDIF
54 IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
55 CALL med_filter_out ( grid , config_flags )
56 CALL WRFU_AlarmRingerOff( grid%alarms( INPUTOUT_ALARM ), rc=rc )
57 ENDIF
59 ! - AUX HISTORY OUTPUT
60 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST1_ALARM ), rc=rc ) ) THEN
61 CALL med_hist_out ( grid , 1, config_flags )
62 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST1_ALARM ), rc=rc )
63 ENDIF
64 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST2_ALARM ), rc=rc ) ) THEN
65 CALL med_hist_out ( grid , 2, config_flags )
66 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST2_ALARM ), rc=rc )
67 ENDIF
68 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST3_ALARM ), rc=rc ) ) THEN
69 CALL med_hist_out ( grid , 3, config_flags )
70 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST3_ALARM ), rc=rc )
71 ENDIF
72 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST4_ALARM ), rc=rc ) ) THEN
73 CALL med_hist_out ( grid , 4, config_flags )
74 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST4_ALARM ), rc=rc )
75 ENDIF
76 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST5_ALARM ), rc=rc ) ) THEN
77 CALL med_hist_out ( grid , 5, config_flags )
78 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST5_ALARM ), rc=rc )
79 ENDIF
80 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST6_ALARM ), rc=rc ) ) THEN
81 CALL med_hist_out ( grid , 6, config_flags )
82 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST6_ALARM ), rc=rc )
83 ENDIF
84 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST7_ALARM ), rc=rc ) ) THEN
85 CALL med_hist_out ( grid , 7, config_flags )
86 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST7_ALARM ), rc=rc )
87 ENDIF
88 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST8_ALARM ), rc=rc ) ) THEN
89 CALL med_hist_out ( grid , 8, config_flags )
90 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST8_ALARM ), rc=rc )
91 ENDIF
92 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST9_ALARM ), rc=rc ) ) THEN
93 CALL med_hist_out ( grid , 9, config_flags )
94 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST9_ALARM ), rc=rc )
95 ENDIF
96 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST10_ALARM ), rc=rc ) ) THEN
97 CALL med_hist_out ( grid , 10, config_flags )
98 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST10_ALARM ), rc=rc )
99 ENDIF
100 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST11_ALARM ), rc=rc ) ) THEN
101 CALL med_hist_out ( grid , 11, config_flags )
102 CALL WRFU_AlarmRingerOff( grid%alarms( AUXHIST11_ALARM ), rc=rc )
103 ENDIF
105 ! - AUX INPUT INPUT
106 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT1_ALARM ), rc=rc ) ) THEN
107 CALL med_auxinput1_in ( grid , config_flags )
108 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
109 TRIM(config_flags%auxinput1_inname) , " for domain ",grid%id
110 CALL wrf_debug ( 0 , message )
111 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT1_ALARM ), rc=rc )
112 ENDIF
113 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT2_ALARM ), rc=rc ) ) THEN
114 CALL med_auxinput2_in ( grid , config_flags )
115 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
116 TRIM(config_flags%auxinput2_inname) , " for domain ",grid%id
117 CALL wrf_debug ( 0 , message )
118 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT2_ALARM ), rc=rc )
119 ENDIF
120 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT3_ALARM ), rc=rc ) ) THEN
121 CALL med_auxinput3_in ( grid , config_flags )
122 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
123 TRIM(config_flags%auxinput3_inname) , " for domain ",grid%id
124 CALL wrf_debug ( 0 , message )
125 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT3_ALARM ), rc=rc )
126 ENDIF
127 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT4_ALARM ), rc=rc ) ) THEN
128 CALL med_auxinput4_in ( grid , config_flags )
129 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
130 TRIM(config_flags%auxinput4_inname) , " for domain ",grid%id
131 CALL wrf_debug ( 0 , message )
132 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT4_ALARM ), rc=rc )
133 ENDIF
135 ! this needs to be looked at again so we can get rid of the special
136 ! handling of AUXINPUT5 but for now...
138 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
139 ! add for wrf_chem emiss input
140 ! - Get chemistry data
141 IF( config_flags%chem_opt > 0 ) THEN
142 #ifdef WRF_CHEM
143 IF( config_flags%emiss_inpt_opt /= 0 ) THEN
144 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT5_ALARM ), rc=rc ) ) THEN
145 call wrf_debug(15,' CALL med_read_wrf_chem_emiss ')
146 CALL med_read_wrf_chem_emiss ( grid , config_flags )
147 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
148 call wrf_debug(15,' Back from CALL med_read_wrf_chem_emiss ')
149 ENDIF
150 ! IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT7_ALARM ), rc=rc ) ) THEN
151 ! call wrf_debug(00,' CALL med_read_wrf_chem_fireemiss ')
152 ! CALL med_read_wrf_chem_emissopt3 ( grid , config_flags )
153 ! CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT7_ALARM ), rc=rc )
154 ! call wrf_debug(15,' Back from CALL med_read_wrf_chem_fireemiss ')
155 ! ENDIF
156 ! IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT9_ALARM ), rc=rc ) ) THEN
157 ! call wrf_debug(00,' CALL med_read_wrf_chem_gocartbg ')
158 ! CALL med_read_wrf_chem_gocartbg ( grid , config_flags )
159 ! CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT9_ALARM ), rc=rc )
160 ! call wrf_debug(15,' Back from CALL med_read_wrf_chem_gocartbg ')
161 ! ENDIF
162 ELSE
163 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT5_ALARM ), rc=rc ) ) THEN
164 CALL med_auxinput5_in ( grid , config_flags )
165 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
166 ENDIF
167 ENDIF
168 ! end for wrf chem emiss input
169 #endif
170 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
171 ELSE
172 #ifndef WRF_CHEM
173 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT5_ALARM ), rc=rc ) ) THEN
174 CALL med_auxinput5_in ( grid , config_flags )
175 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
176 TRIM(config_flags%auxinput5_inname) , " for domain ",grid%id
177 CALL wrf_debug ( 0 , message )
178 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT5_ALARM ), rc=rc )
179 ENDIF
180 #endif
181 ENDIF
183 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT6_ALARM ), rc=rc ) ) THEN
184 CALL med_auxinput6_in ( grid , config_flags )
185 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
186 TRIM(config_flags%auxinput6_inname) , " for domain ",grid%id
187 CALL wrf_debug ( 0 , message )
188 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT6_ALARM ), rc=rc )
189 ENDIF
190 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT7_ALARM ), rc=rc ) ) THEN
191 CALL med_auxinput7_in ( grid , config_flags )
192 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
193 TRIM(config_flags%auxinput7_inname) , " for domain ",grid%id
194 CALL wrf_debug ( 0 , message )
195 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT7_ALARM ), rc=rc )
196 ENDIF
197 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT8_ALARM ), rc=rc ) ) THEN
198 CALL med_auxinput8_in ( grid , config_flags )
199 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
200 TRIM(config_flags%auxinput8_inname) , " for domain ",grid%id
201 CALL wrf_debug ( 0 , message )
202 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT8_ALARM ), rc=rc )
203 ENDIF
204 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT9_ALARM ), rc=rc ) ) THEN
205 CALL med_auxinput9_in ( grid , config_flags )
206 WRITE ( message , FMT='(A,A,A,i3)' ) "Input data processed for " , &
207 TRIM(config_flags%auxinput9_inname) , " for domain ",grid%id
208 CALL wrf_debug ( 0 , message )
209 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT9_ALARM ), rc=rc )
210 ENDIF
211 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT10_ALARM ), rc=rc ) ) THEN
212 CALL med_auxinput10_in ( grid , config_flags )
213 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT10_ALARM ), rc=rc )
214 ENDIF
215 IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT11_ALARM ), rc=rc ) ) THEN
216 #if ( EM_CORE == 1 )
217 IF( config_flags%obs_nudge_opt .EQ. 1) THEN
218 CALL med_fddaobs_in ( grid , config_flags )
219 ENDIF
220 #else
221 CALL med_auxinput11_in ( grid , config_flags )
222 #endif
223 CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT11_ALARM ), rc=rc )
224 ENDIF
226 ! - RESTART OUTPUT
227 IF( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) THEN
228 IF ( grid%id .EQ. 1 ) THEN
229 ! Only the parent initiates the restart writing. Otherwise, different
230 ! domains may be written out at different times and with different
231 ! time stamps in the file names.
232 CALL med_restart_out ( grid , config_flags )
233 ENDIF
234 CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
235 ENDIF
237 ! - Look for boundary data after writing out history and restart files
238 CALL med_latbound_in ( grid , config_flags )
240 RETURN
241 END SUBROUTINE med_before_solve_io
243 SUBROUTINE med_after_solve_io ( grid , config_flags )
244 ! Driver layer
245 USE module_domain
246 USE module_timing
247 USE module_configure
248 ! Model layer
250 IMPLICIT NONE
252 ! Arguments
253 TYPE(domain) :: grid
254 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
256 ! Compute time series variables
257 CALL calc_ts(grid)
259 RETURN
260 END SUBROUTINE med_after_solve_io
262 SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
263 ! Driver layer
264 USE module_domain
265 USE module_timing
266 USE module_io_domain
267 USE module_configure
268 ! Model layer
270 IMPLICIT NONE
272 ! Arguments
273 TYPE(domain) , POINTER :: parent
274 INTEGER, INTENT(IN) :: newid
275 TYPE (grid_config_rec_type) , INTENT(INOUT) :: config_flags
276 TYPE (grid_config_rec_type) :: nest_config_flags
278 ! Local
279 INTEGER :: itmp, fid, ierr, icnt
280 CHARACTER*256 :: rstname, message, timestr
282 TYPE(WRFU_Time) :: strt_time, cur_time
284 #ifdef MOVE_NESTS
286 CALL domain_clock_get( parent, current_timestr=timestr, start_time=strt_time, current_time=cur_time )
287 CALL construct_filename2a ( rstname , config_flags%rst_inname , newid , 2 , timestr )
289 IF ( config_flags%restart .AND. cur_time .EQ. strt_time ) THEN
290 WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading header information only'
291 CALL wrf_message ( message )
292 ! note that the parent pointer is not strictly correct, but nest is not allocated yet and
293 ! only the i/o communicator fields are used from "parent" (and those are dummies in current
294 ! implementation.
295 CALL open_r_dataset ( fid , TRIM(rstname) , parent , config_flags , "DATASET=RESTART", ierr )
296 IF ( ierr .NE. 0 ) THEN
297 WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
298 CALL WRF_ERROR_FATAL ( message )
299 ENDIF
301 ! update the values of parent_start that were read in from the namelist (nest may have moved)
302 CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' , itmp , 1 , icnt, ierr )
303 IF ( ierr .EQ. 0 ) THEN
304 config_flags%i_parent_start = itmp
305 CALL nl_set_i_parent_start ( newid , config_flags%i_parent_start )
306 ENDIF
307 CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' , itmp , 1 , icnt, ierr )
308 IF ( ierr .EQ. 0 ) THEN
309 config_flags%j_parent_start = itmp
310 CALL nl_set_j_parent_start ( newid , config_flags%j_parent_start )
311 ENDIF
313 CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
314 ENDIF
315 #endif
317 END SUBROUTINE med_pre_nest_initial
320 SUBROUTINE med_nest_initial ( parent , nest , config_flags )
321 ! Driver layer
322 USE module_domain
323 USE module_timing
324 USE module_io_domain
325 USE module_configure
326 USE module_utility
327 ! Model layer
329 IMPLICIT NONE
331 ! Arguments
332 TYPE(domain) , POINTER :: parent, nest
333 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
334 TYPE (grid_config_rec_type) :: nest_config_flags
336 #if (EM_CORE == 1)
337 ! Local
338 #ifdef MOVE_NESTS
339 TYPE (WRFU_TimeInterval) :: interval, TimeSinceStart
340 INTEGER :: vortex_interval , n
341 #endif
342 INTEGER :: idum1 , idum2 , fid, ierr
343 INTEGER :: i , j, rc
344 INTEGER :: ids , ide , jds , jde , kds , kde , &
345 ims , ime , jms , jme , kms , kme , &
346 ips , ipe , jps , jpe , kps , kpe
347 CHARACTER * 80 :: rstname , timestr
348 CHARACTER * 256 :: message
349 INTEGER :: save_itimestep ! This is a kludge, correct fix will
350 ! involve integrating the time-step
351 ! counting into the time manager.
352 ! JM 20040604
353 REAL, ALLOCATABLE, DIMENSION(:,:) :: save_acsnow &
354 ,save_acsnom &
355 ,save_cuppt &
356 ,save_rainc &
357 ,save_rainnc &
358 ,save_sfcevp &
359 ,save_sfcrunoff &
360 ,save_udrunoff &
361 ,save_mub
363 TYPE(WRFU_Time) :: strt_time, cur_time
365 INTERFACE
366 SUBROUTINE med_interp_domain ( parent , nest )
367 USE module_domain
368 TYPE(domain) , POINTER :: parent , nest
369 END SUBROUTINE med_interp_domain
371 SUBROUTINE med_initialdata_input_ptr( nest , config_flags )
372 USE module_domain
373 USE module_configure
374 TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
375 TYPE(domain) , POINTER :: nest
376 END SUBROUTINE med_initialdata_input_ptr
378 SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
379 USE module_domain
380 USE module_configure
381 TYPE (domain), POINTER :: nest , parent
382 TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
383 END SUBROUTINE med_nest_feedback
385 SUBROUTINE start_domain ( grid , allowed_to_move )
386 USE module_domain
387 TYPE(domain) :: grid
388 LOGICAL, INTENT(IN) :: allowed_to_move
389 END SUBROUTINE start_domain
391 SUBROUTINE blend_terrain ( ter_interpolated , ter_input , &
392 ids , ide , jds , jde , kds , kde , &
393 ims , ime , jms , jme , kms , kme , &
394 ips , ipe , jps , jpe , kps , kpe )
395 INTEGER :: ids , ide , jds , jde , kds , kde , &
396 ims , ime , jms , jme , kms , kme , &
397 ips , ipe , jps , jpe , kps , kpe
398 REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
399 REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
400 END SUBROUTINE blend_terrain
402 SUBROUTINE store_terrain ( ter_interpolated , ter_input , &
403 ids , ide , jds , jde , kds , kde , &
404 ims , ime , jms , jme , kms , kme , &
405 ips , ipe , jps , jpe , kps , kpe )
406 INTEGER :: ids , ide , jds , jde , kds , kde , &
407 ims , ime , jms , jme , kms , kme , &
408 ips , ipe , jps , jpe , kps , kpe
409 REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
410 REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
411 END SUBROUTINE store_terrain
413 SUBROUTINE input_terrain_rsmas ( grid , &
414 ids , ide , jds , jde , kds , kde , &
415 ims , ime , jms , jme , kms , kme , &
416 ips , ipe , jps , jpe , kps , kpe )
417 USE module_domain
418 TYPE ( domain ) :: grid
419 INTEGER :: ids , ide , jds , jde , kds , kde , &
420 ims , ime , jms , jme , kms , kme , &
421 ips , ipe , jps , jpe , kps , kpe
422 END SUBROUTINE input_terrain_rsmas
424 END INTERFACE
426 CALL domain_clock_get( parent, start_time=strt_time, current_time=cur_time )
428 IF ( .not. ( config_flags%restart .AND. strt_time .EQ. cur_time ) ) THEN
429 nest%first_force = .true.
431 ! initialize nest with interpolated data from the parent
432 nest%imask_nostag = 1
433 nest%imask_xstag = 1
434 nest%imask_ystag = 1
435 nest%imask_xystag = 1
437 #ifdef MOVE_NESTS
438 parent%nest_pos = parent%ht
439 where ( parent%nest_pos .gt. 0. ) parent%nest_pos = parent%nest_pos + 500. ! make a cliff
440 #endif
442 CALL med_interp_domain( parent, nest )
444 ! De-reference dimension information stored in the grid data structure.
445 CALL get_ijk_from_grid ( nest , &
446 ids, ide, jds, jde, kds, kde, &
447 ims, ime, jms, jme, kms, kme, &
448 ips, ipe, jps, jpe, kps, kpe )
450 ! initialize some other constants (and 1d arrays in z)
451 CALL init_domain_constants ( parent, nest )
453 ! get the nest config flags
454 CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
456 IF ( nest_config_flags%input_from_file .OR. nest_config_flags%input_from_hires ) THEN
458 WRITE(message,FMT='(A,I2,A)') '*** Initializing nest domain #',nest%id,&
459 ' from an input file. ***'
460 CALL wrf_debug ( 0 , message )
462 ! store horizontally interpolated terrain in temp location
463 CALL store_terrain ( nest%ht_int , nest%ht , &
464 ids , ide , jds , jde , 1 , 1 , &
465 ims , ime , jms , jme , 1 , 1 , &
466 ips , ipe , jps , jpe , 1 , 1 )
467 CALL store_terrain ( nest%mub_fine , nest%mub , &
468 ids , ide , jds , jde , 1 , 1 , &
469 ims , ime , jms , jme , 1 , 1 , &
470 ips , ipe , jps , jpe , 1 , 1 )
471 CALL store_terrain ( nest%phb_fine , nest%phb , &
472 ids , ide , jds , jde , kds , kde , &
473 ims , ime , jms , jme , kms , kme , &
474 ips , ipe , jps , jpe , kps , kpe )
476 IF ( nest_config_flags%input_from_file ) THEN
477 ! read input from dataset
478 CALL med_initialdata_input_ptr( nest , nest_config_flags )
479 ELSE IF ( nest_config_flags%input_from_hires ) THEN
480 ! read in high res topography
481 CALL input_terrain_rsmas ( nest, &
482 ids , ide , jds , jde , 1 , 1 , &
483 ims , ime , jms , jme , 1 , 1 , &
484 ips , ipe , jps , jpe , 1 , 1 )
485 ENDIF
487 ! save elevation and mub for temp and qv adjustment
489 allocate (save_mub(ims:ime,jms:jme))
491 CALL store_terrain ( nest%ht_fine , nest%ht , &
492 ids , ide , jds , jde , 1 , 1 , &
493 ims , ime , jms , jme , 1 , 1 , &
494 ips , ipe , jps , jpe , 1 , 1 )
495 CALL store_terrain ( nest%mub_save , nest%mub , &
496 ids , ide , jds , jde , 1 , 1 , &
497 ims , ime , jms , jme , 1 , 1 , &
498 ips , ipe , jps , jpe , 1 , 1 )
500 ! blend parent and nest fields: terrain, mub, and phb. THe mub and phb are used in start_domain.
501 CALL blend_terrain ( nest%ht_int , nest%ht , &
502 ids , ide , jds , jde , 1 , 1 , &
503 ims , ime , jms , jme , 1 , 1 , &
504 ips , ipe , jps , jpe , 1 , 1 )
505 CALL blend_terrain ( nest%mub_fine , nest%mub , &
506 ids , ide , jds , jde , 1 , 1 , &
507 ims , ime , jms , jme , 1 , 1 , &
508 ips , ipe , jps , jpe , 1 , 1 )
509 CALL blend_terrain ( nest%phb_fine , nest%phb , &
510 ids , ide , jds , jde , kds , kde , &
511 ims , ime , jms , jme , kms , kme , &
512 ips , ipe , jps , jpe , kps , kpe )
514 ! adjust temp and qv
516 CALL adjust_tempqv ( nest%mub , nest%mub_save , &
517 nest%znw , nest%p_top , &
518 nest%t_2 , nest%p , nest%moist(ims,kms,jms,P_QV) , &
519 ids , ide , jds , jde , kds , kde , &
520 ims , ime , jms , jme , kms , kme , &
521 ips , ipe , jps , jpe , kps , kpe )
523 deallocate (save_mub)
525 ELSE
526 WRITE(message,FMT='(A,I2,A,I2,A)') '*** Initializing nest domain #',nest%id,&
527 ' by horizontally interpolating parent domain #' ,parent%id, &
528 '. ***'
529 CALL wrf_debug ( 0 , message )
530 END IF
533 ! feedback, mostly for this new terrain, but it is the safe thing to do
534 parent%ht_coarse = parent%ht
536 CALL med_nest_feedback ( parent , nest , config_flags )
538 ! set some other initial fields, fill out halos, base fields; re-do parent due
539 ! to new terrain elevation from feedback
540 nest%imask_nostag = 1
541 nest%imask_xstag = 1
542 nest%imask_ystag = 1
543 nest%imask_xystag = 1
544 nest%press_adj = .TRUE.
545 CALL start_domain ( nest , .TRUE. )
546 ! kludge: 20040604
547 CALL get_ijk_from_grid ( parent , &
548 ids, ide, jds, jde, kds, kde, &
549 ims, ime, jms, jme, kms, kme, &
550 ips, ipe, jps, jpe, kps, kpe )
552 ALLOCATE( save_acsnow(ims:ime,jms:jme) )
553 ALLOCATE( save_acsnom(ims:ime,jms:jme) )
554 ALLOCATE( save_cuppt(ims:ime,jms:jme) )
555 ALLOCATE( save_rainc(ims:ime,jms:jme) )
556 ALLOCATE( save_rainnc(ims:ime,jms:jme) )
557 ALLOCATE( save_sfcevp(ims:ime,jms:jme) )
558 ALLOCATE( save_sfcrunoff(ims:ime,jms:jme) )
559 ALLOCATE( save_udrunoff(ims:ime,jms:jme) )
560 save_acsnow = parent%acsnow
561 save_acsnom = parent%acsnom
562 save_cuppt = parent%cuppt
563 save_rainc = parent%rainc
564 save_rainnc = parent%rainnc
565 save_sfcevp = parent%sfcevp
566 save_sfcrunoff = parent%sfcrunoff
567 save_udrunoff = parent%udrunoff
568 save_itimestep = parent%itimestep
569 parent%imask_nostag = 1
570 parent%imask_xstag = 1
571 parent%imask_ystag = 1
572 parent%imask_xystag = 1
574 parent%press_adj = .FALSE.
575 CALL start_domain ( parent , .TRUE. )
577 parent%acsnow = save_acsnow
578 parent%acsnom = save_acsnom
579 parent%cuppt = save_cuppt
580 parent%rainc = save_rainc
581 parent%rainnc = save_rainnc
582 parent%sfcevp = save_sfcevp
583 parent%sfcrunoff = save_sfcrunoff
584 parent%udrunoff = save_udrunoff
585 parent%itimestep = save_itimestep
586 DEALLOCATE( save_acsnow )
587 DEALLOCATE( save_acsnom )
588 DEALLOCATE( save_cuppt )
589 DEALLOCATE( save_rainc )
590 DEALLOCATE( save_rainnc )
591 DEALLOCATE( save_sfcevp )
592 DEALLOCATE( save_sfcrunoff )
593 DEALLOCATE( save_udrunoff )
594 ! end of kludge: 20040604
597 ELSE ! restart
599 CALL domain_clock_get( nest, current_timestr=timestr )
600 CALL construct_filename2a ( rstname , config_flags%rst_inname , nest%id , 2 , timestr )
602 WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading'
603 CALL wrf_message ( message )
604 CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
605 CALL open_r_dataset ( fid , TRIM(rstname) , nest , nest_config_flags , "DATASET=RESTART", ierr )
606 IF ( ierr .NE. 0 ) THEN
607 WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
608 CALL WRF_ERROR_FATAL ( message )
609 ENDIF
610 CALL input_restart ( fid, nest , nest_config_flags , ierr )
611 CALL close_dataset ( fid , nest_config_flags , "DATASET=RESTART" )
613 nest%imask_nostag = 1
614 nest%imask_xstag = 1
615 nest%imask_ystag = 1
616 nest%imask_xystag = 1
617 nest%press_adj = .FALSE.
618 CALL start_domain ( nest , .TRUE. )
619 #ifndef MOVE_NESTS
620 ! this doesn't need to be done for moving nests, since ht_coarse is part of the restart
621 parent%ht_coarse = parent%ht
622 #else
623 # if 1
624 ! In case of a restart, assume that the movement has already occurred in the previous
625 ! run and turn off the alarm for the starting time. We must impose a requirement that the
626 ! run be restarted on-interval. Test for that and print a warning if it isn't.
627 ! Note, simulation_start, etc. should be available as metadata in the restart file, and
628 ! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
629 ! using the nl_get routines below. JM 20060314
631 CALL nl_get_vortex_interval ( nest%id , vortex_interval )
632 CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
634 CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
635 n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
636 IF ( ( interval * n ) .NE. TimeSinceStart ) THEN
637 CALL wrf_message('WARNING: Restart is not on a vortex_interval time boundary.')
638 CALL wrf_message('The code will work but results will not agree exactly with a ')
639 CALL wrf_message('a run that was done straight-through, without a restart.')
640 ENDIF
641 !! In case of a restart, assume that the movement has already occurred in the previous
642 !! run and turn off the alarm for the starting time. We must impose a requirement that the
643 !! run be restarted on-interval. Test for that and print a warning if it isn't.
644 !! Note, simulation_start, etc. should be available as metadata in the restart file, and
645 !! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
646 !! using the nl_get routines below. JM 20060314
647 ! CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
649 # else
650 ! this code, currently commented out, is an attempt to have the
651 ! vortex centering interval be set according to simulation start
652 ! time (rather than run start time) in case of a restart. But
653 ! there are other problems (the WRF clock is currently using
654 ! run-start as it's start time) so the alarm still would not fire
655 ! right if the model were started off-interval. Leave it here and
656 ! enable when the clock is changed to use sim-start for start time.
657 ! JM 20060314
658 CALL nl_get_vortex_interval ( nest%id , vortex_interval )
659 CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
661 CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
663 CALL domain_alarm_create( nest, COMPUTE_VORTEX_CENTER_ALARM, interval )
664 CALL WRFU_AlarmEnable( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
665 n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
666 IF ( ( interval * n ) .EQ. TimeSinceStart ) THEN
667 CALL WRFU_AlarmRingerOn( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
668 ELSE
669 CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
670 ENDIF
671 # endif
672 #endif
674 ENDIF
676 #endif
678 #if (NMM_CORE == 1 && NMM_NEST == 1)
679 !===================================================================================
680 ! Added for the NMM core. This is gopal's doing.
681 !===================================================================================
682 ! Local
683 INTEGER :: i,j,k,idum1 , idum2 , fid, ierr
684 INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE ! gopal
685 INTEGER :: IMS,IME,JMS,JME,KMS,KME
686 INTEGER :: ITS,ITE,JTS,JTE,KTS,KTE
688 INTERFACE
690 SUBROUTINE med_nest_egrid_configure ( parent , nest )
691 USE module_domain
692 TYPE(domain) , POINTER :: parent , nest
693 END SUBROUTINE med_nest_egrid_configure
695 SUBROUTINE med_construct_egrid_weights ( parent , nest )
696 USE module_domain
697 TYPE(domain) , POINTER :: parent , nest
698 END SUBROUTINE med_construct_egrid_weights
700 SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD, &
701 PINT,T,Q,CWM, &
702 FIS,QSH,PD,PDTOP,PTOP, &
703 ETA1,ETA2, &
704 DETA1,DETA2, &
705 IDS,IDE,JDS,JDE,KDS,KDE, &
706 IMS,IME,JMS,JME,KMS,KME, &
707 ITS,ITE,JTS,JTE,KTS,KTE )
708 !
710 USE MODULE_MODEL_CONSTANTS
711 IMPLICIT NONE
712 INTEGER, INTENT(IN ) :: IDS,IDE,JDS,JDE,KDS,KDE
713 INTEGER, INTENT(IN ) :: IMS,IME,JMS,JME,KMS,KME
714 INTEGER, INTENT(IN ) :: ITS,ITE,JTS,JTE,KTS,KTE
715 REAL, INTENT(IN ) :: PDTOP,PTOP
716 REAL, DIMENSION(KMS:KME), INTENT(IN) :: ETA1,ETA2,DETA1,DETA2
717 REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: FIS,PD,QSH
718 REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(IN) :: PINT,T,Q,CWM
719 REAL, DIMENSION(KMS:KME) , INTENT(OUT):: PSTD
720 REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(OUT):: Z3d,Q3d,T3d
722 END SUBROUTINE BASE_STATE_PARENT
724 SUBROUTINE NEST_TERRAIN ( nest, config_flags )
725 USE module_domain
726 TYPE(domain) , POINTER :: nest
727 TYPE(grid_config_rec_type) , INTENT(IN) :: config_flags
728 END SUBROUTINE NEST_TERRAIN
730 SUBROUTINE med_interp_domain ( parent , nest )
731 USE module_domain
732 TYPE(domain) , POINTER :: parent , nest
733 END SUBROUTINE med_interp_domain
735 SUBROUTINE med_init_domain_constants_nmm ( parent, nest )
736 USE module_domain
737 TYPE(domain) , POINTER :: parent , nest
738 END SUBROUTINE med_init_domain_constants_nmm
740 SUBROUTINE start_domain ( grid , allowed_to_move )
741 USE module_domain
742 TYPE(domain) :: grid
743 LOGICAL, INTENT(IN) :: allowed_to_move
744 END SUBROUTINE start_domain
746 END INTERFACE
748 !----------------------------------------------------------------------------
749 ! initialize nested domain configurations including setting up wbd,sbd, etc
750 !----------------------------------------------------------------------------
752 CALL med_nest_egrid_configure ( parent , nest )
754 !-------------------------------------------------------------------------
755 ! initialize lat-lons and determine weights
756 !-------------------------------------------------------------------------
758 CALL med_construct_egrid_weights ( parent, nest )
759 !
760 !
761 ! De-reference dimension information stored in the grid data structure.
762 !
763 ! From the hybrid, construct the GPMs on isobaric surfaces and then interpolate those
764 ! values on to the nested domain. 23 standard prssure levels are assumed here. For
765 ! levels below ground, lapse rate atmosphere is assumed before the use of vertical
766 ! spline interpolation
767 !
770 IDS = parent%sd31
771 IDE = parent%ed31
772 JDS = parent%sd32
773 JDE = parent%ed32
774 KDS = parent%sd33
775 KDE = parent%ed33
777 IMS = parent%sm31
778 IME = parent%em31
779 JMS = parent%sm32
780 JME = parent%em32
781 KMS = parent%sm33
782 KME = parent%em33
784 ITS = parent%sp31
785 ITE = parent%ep31
786 JTS = parent%sp32
787 JTE = parent%ep32
788 KTS = parent%sp33
789 KTE = parent%ep33
791 CALL BASE_STATE_PARENT ( parent%Z3d,parent%Q3d,parent%T3d,parent%PSTD, &
792 parent%PINT,parent%T,parent%Q,parent%CWM, &
793 parent%FIS,parent%QSH,parent%PD,parent%pdtop,parent%pt, &
794 parent%ETA1,parent%ETA2, &
795 parent%DETA1,parent%DETA2, &
796 IDS,IDE,JDS,JDE,KDS,KDE, &
797 IMS,IME,JMS,JME,KMS,KME, &
798 ITS,ITE,JTS,JTE,KTS,KTE )
800 !
801 ! Set new terrain. Since some terrain adjustment is done within the interpolation calls
802 ! at the next step, the new terrain over the nested domain has to be called here.
803 !
804 IDS = nest%sd31
805 IDE = nest%ed31
806 JDS = nest%sd32
807 JDE = nest%ed32
808 KDS = nest%sd33
809 KDE = nest%ed33
811 IMS = nest%sm31
812 IME = nest%em31
813 JMS = nest%sm32
814 JME = nest%em32
815 KMS = nest%sm33
816 KME = nest%em33
818 ITS = nest%sp31
819 ITE = nest%ep31
820 JTS = nest%sp32
821 JTE = nest%ep32
822 KTS = nest%sp33
823 KTE = nest%ep33
826 CALL NEST_TERRAIN ( nest, config_flags )
828 ! Initialize some more constants required especially for terrain adjustment processes
830 nest%PSTD=parent%PSTD
831 nest%KZMAX=KME
832 parent%KZMAX=KME ! just for safety
834 DO J = JTS, MIN(JTE,JDE-1)
835 DO I = ITS, MIN(ITE,IDE-1)
836 nest%fis(I,J)=nest%hres_fis(I,J)
837 ENDDO
838 ENDDO
840 !--------------------------------------------------------------------------
841 ! interpolation call
842 !--------------------------------------------------------------------------
844 ! initialize nest with interpolated data from the parent
846 nest%imask_nostag = 0
847 nest%imask_xstag = 0
848 nest%imask_ystag = 0
849 nest%imask_xystag = 0
851 CALL med_interp_domain( parent, nest )
853 !------------------------------------------------------------------------------
854 ! set up constants (module_initialize_real.F for nested nmm domain)
855 !-----------------------------------------------------------------------------
857 CALL med_init_domain_constants_nmm ( parent, nest )
859 !--------------------------------------------------------------------------------------
860 ! set some other initial fields, fill out halos, etc.
861 !--------------------------------------------------------------------------------------
863 CALL start_domain ( nest, .TRUE.)
865 !===================================================================================
866 ! Added for the NMM core. End of gopal's doing.
867 !===================================================================================
868 #endif
869 RETURN
870 END SUBROUTINE med_nest_initial
872 SUBROUTINE init_domain_constants ( parent , nest )
873 USE module_domain
874 IMPLICIT NONE
875 TYPE(domain) :: parent , nest
876 #if (EM_CORE == 1)
877 CALL init_domain_constants_em ( parent, nest )
878 #endif
879 END SUBROUTINE init_domain_constants
882 SUBROUTINE med_nest_force ( parent , nest )
883 ! Driver layer
884 USE module_domain
885 USE module_timing
886 USE module_configure
887 ! Model layer
888 ! External
889 USE module_utility
891 IMPLICIT NONE
893 ! Arguments
894 TYPE(domain) , POINTER :: parent, nest
895 ! Local
896 INTEGER :: idum1 , idum2 , fid, rc
898 #if (NMM_CORE == 1 && NMM_NEST == 1)
899 INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE ! gopal
900 INTEGER :: IMS,IME,JMS,JME,KMS,KME
901 INTEGER :: ITS,ITE,JTS,JTE,KTS,KTE
902 #endif
904 INTERFACE
905 SUBROUTINE med_force_domain ( parent , nest )
906 USE module_domain
907 TYPE(domain) , POINTER :: parent , nest
908 END SUBROUTINE med_force_domain
909 SUBROUTINE med_interp_domain ( parent , nest )
910 USE module_domain
911 TYPE(domain) , POINTER :: parent , nest
912 END SUBROUTINE med_interp_domain
913 #if (NMM_CORE == 1 && NMM_NEST == 1)
914 !===================================================================================
915 ! Added for the NMM core. This is gopal's doing.
916 !===================================================================================
918 SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD, &
919 PINT,T,Q,CWM, &
920 FIS,QSH,PD,PDTOP,PTOP, &
921 ETA1,ETA2, &
922 DETA1,DETA2, &
923 IDS,IDE,JDS,JDE,KDS,KDE, &
924 IMS,IME,JMS,JME,KMS,KME, &
925 ITS,ITE,JTS,JTE,KTS,KTE )
926 !
928 USE MODULE_MODEL_CONSTANTS
929 IMPLICIT NONE
930 INTEGER, INTENT(IN ) :: IDS,IDE,JDS,JDE,KDS,KDE
931 INTEGER, INTENT(IN ) :: IMS,IME,JMS,JME,KMS,KME
932 INTEGER, INTENT(IN ) :: ITS,ITE,JTS,JTE,KTS,KTE
933 REAL, INTENT(IN ) :: PDTOP,PTOP
934 REAL, DIMENSION(KMS:KME), INTENT(IN) :: ETA1,ETA2,DETA1,DETA2
935 REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: FIS,PD,QSH
936 REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(IN) :: PINT,T,Q,CWM
937 REAL, DIMENSION(KMS:KME) , INTENT(OUT):: PSTD
938 REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(OUT):: Z3d,Q3d,T3d
940 END SUBROUTINE BASE_STATE_PARENT
942 #endif
943 END INTERFACE
945 #if (NMM_CORE == 1 && NMM_NEST == 1)
947 ! De-reference dimension information stored in the grid data structure.
949 IDS = parent%sd31
950 IDE = parent%ed31
951 JDS = parent%sd32
952 JDE = parent%ed32
953 KDS = parent%sd33
954 KDE = parent%ed33
956 IMS = parent%sm31
957 IME = parent%em31
958 JMS = parent%sm32
959 JME = parent%em32
960 KMS = parent%sm33
961 KME = parent%em33
963 ITS = parent%sp31
964 ITE = parent%ep31
965 JTS = parent%sp32
966 JTE = parent%ep32
967 KTS = parent%sp33
968 KTE = parent%ep33
971 CALL BASE_STATE_PARENT ( parent%Z3d,parent%Q3d,parent%T3d,parent%PSTD, &
972 parent%PINT,parent%T,parent%Q,parent%CWM, &
973 parent%FIS,parent%QSH,parent%PD,parent%pdtop,parent%pt, &
974 parent%ETA1,parent%ETA2, &
975 parent%DETA1,parent%DETA2, &
976 IDS,IDE,JDS,JDE,KDS,KDE, &
977 IMS,IME,JMS,JME,KMS,KME, &
978 ITS,ITE,JTS,JTE,KTS,KTE )
980 #endif
982 IF ( .NOT. WRFU_ClockIsStopTime(nest%domain_clock ,rc=rc) ) THEN
983 ! initialize nest with interpolated data from the parent
984 nest%imask_nostag = 1
985 nest%imask_xstag = 1
986 nest%imask_ystag = 1
987 nest%imask_xystag = 1
988 CALL med_force_domain( parent, nest )
989 ENDIF
991 ! might also have calls here to do input from a file into the nest
993 RETURN
994 END SUBROUTINE med_nest_force
996 SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
997 ! Driver layer
998 USE module_domain
999 USE module_timing
1000 USE module_configure
1001 ! Model layer
1002 ! External
1003 USE module_utility
1004 IMPLICIT NONE
1007 ! Arguments
1008 TYPE(domain) , POINTER :: parent, nest
1009 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1010 ! Local
1011 INTEGER :: idum1 , idum2 , fid, rc
1012 INTEGER :: ids , ide , jds , jde , kds , kde , &
1013 ims , ime , jms , jme , kms , kme , &
1014 ips , ipe , jps , jpe , kps , kpe
1015 INTEGER i,j
1017 INTERFACE
1018 SUBROUTINE med_feedback_domain ( parent , nest )
1019 USE module_domain
1020 TYPE(domain) , POINTER :: parent , nest
1021 END SUBROUTINE med_feedback_domain
1022 END INTERFACE
1024 ! feedback nest to the parent
1025 IF ( .NOT. WRFU_ClockIsStopTime(nest%domain_clock ,rc=rc) .AND. &
1026 config_flags%feedback .NE. 0 ) THEN
1027 CALL med_feedback_domain( parent, nest )
1028 #ifdef MOVE_NESTS
1029 CALL get_ijk_from_grid ( parent , &
1030 ids, ide, jds, jde, kds, kde, &
1031 ims, ime, jms, jme, kms, kme, &
1032 ips, ipe, jps, jpe, kps, kpe )
1033 ! gopal's change- added ifdef
1034 #if ( EM_CORE == 1 )
1035 DO j = jps, MIN(jpe,jde-1)
1036 DO i = ips, MIN(ipe,ide-1)
1037 IF ( parent%nest_pos(i,j) .EQ. 9021000. ) THEN
1038 parent%nest_pos(i,j) = parent%ht(i,j)*1.5 + 1000.
1039 ELSE IF ( parent%ht(i,j) .NE. 0. ) THEN
1040 parent%nest_pos(i,j) = parent%ht(i,j) + 500.
1041 ELSE
1042 parent%nest_pos(i,j) = 0.
1043 ENDIF
1044 ENDDO
1045 ENDDO
1046 #endif
1047 #endif
1048 END IF
1050 RETURN
1051 END SUBROUTINE med_nest_feedback
1053 SUBROUTINE med_last_solve_io ( grid , config_flags )
1054 ! Driver layer
1055 USE module_domain
1056 USE module_configure
1057 ! Model layer
1059 IMPLICIT NONE
1061 ! Arguments
1062 TYPE(domain) :: grid
1063 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1064 ! Local
1065 INTEGER :: rc
1067 #if (EM_CORE == 1)
1068 IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) .AND. &
1069 (grid%dfi_write_dfi_history .OR. grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI) ) THEN
1070 #else
1071 IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc )) THEN
1072 #endif
1073 CALL med_hist_out ( grid , 0 , config_flags )
1074 ENDIF
1076 IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
1077 CALL med_filter_out ( grid , config_flags )
1078 ENDIF
1080 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST1_ALARM ), rc=rc ) ) THEN
1081 CALL med_hist_out ( grid , 1 , config_flags )
1082 ENDIF
1083 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST2_ALARM ), rc=rc ) ) THEN
1084 CALL med_hist_out ( grid , 2 , config_flags )
1085 ENDIF
1086 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST3_ALARM ), rc=rc ) ) THEN
1087 CALL med_hist_out ( grid , 3 , config_flags )
1088 ENDIF
1089 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST4_ALARM ), rc=rc ) ) THEN
1090 CALL med_hist_out ( grid , 4 , config_flags )
1091 ENDIF
1092 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST5_ALARM ), rc=rc ) ) THEN
1093 CALL med_hist_out ( grid , 5 , config_flags )
1094 ENDIF
1095 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST6_ALARM ), rc=rc ) ) THEN
1096 CALL med_hist_out ( grid , 6 , config_flags )
1097 ENDIF
1098 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST7_ALARM ), rc=rc ) ) THEN
1099 CALL med_hist_out ( grid , 7 , config_flags )
1100 ENDIF
1101 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST8_ALARM ), rc=rc ) ) THEN
1102 CALL med_hist_out ( grid , 8 , config_flags )
1103 ENDIF
1104 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST9_ALARM ), rc=rc ) ) THEN
1105 CALL med_hist_out ( grid , 9 , config_flags )
1106 ENDIF
1107 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST10_ALARM ), rc=rc ) ) THEN
1108 CALL med_hist_out ( grid , 10 , config_flags )
1109 ENDIF
1110 IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST11_ALARM ), rc=rc ) ) THEN
1111 CALL med_hist_out ( grid , 11 , config_flags )
1112 ENDIF
1114 ! - RESTART OUTPUT
1115 IF( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) THEN
1116 IF ( grid%id .EQ. 1 ) THEN
1117 CALL med_restart_out ( grid , config_flags )
1118 ENDIF
1119 ENDIF
1121 ! Write out time series
1122 CALL write_ts( grid )
1124 RETURN
1125 END SUBROUTINE med_last_solve_io
1127 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1129 RECURSIVE SUBROUTINE med_restart_out ( grid , config_flags )
1130 ! Driver layer
1131 USE module_domain
1132 USE module_io_domain
1133 USE module_timing
1134 USE module_configure
1135 ! Model layer
1136 USE module_bc_time_utilities
1137 USE module_utility
1139 IMPLICIT NONE
1141 ! Arguments
1142 TYPE(domain) :: grid
1143 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1145 ! Local
1146 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1147 CHARACTER*80 :: rstname , outname
1148 INTEGER :: fid , rid, kid
1149 CHARACTER (LEN=256) :: message
1150 INTEGER :: ierr
1151 INTEGER :: myproc
1152 CHARACTER*80 :: timestr
1153 TYPE (grid_config_rec_type) :: kid_config_flags
1155 IF ( wrf_dm_on_monitor() ) THEN
1156 CALL start_timing
1157 END IF
1159 ! write out this domains restart file first
1161 CALL domain_clock_get( grid, current_timestr=timestr )
1162 CALL construct_filename2a ( rstname , config_flags%rst_outname , grid%id , 2 , timestr )
1164 WRITE( message , '("med_restart_out: opening ",A," for writing")' ) TRIM ( rstname )
1165 CALL wrf_debug( 1 , message )
1166 CALL open_w_dataset ( rid, TRIM(rstname), grid , &
1167 config_flags , output_restart , "DATASET=RESTART", ierr )
1169 IF ( ierr .NE. 0 ) THEN
1170 CALL WRF_message( message )
1171 ENDIF
1172 CALL output_restart ( rid, grid , config_flags , ierr )
1173 IF ( wrf_dm_on_monitor() ) THEN
1174 WRITE ( message , FMT = '("Writing restart for domain ",I8)' ) grid%id
1175 CALL end_timing ( TRIM(message) )
1176 END IF
1177 CALL close_dataset ( rid , config_flags , "DATASET=RESTART" )
1179 ! call recursively for children, (if any)
1180 DO kid = 1, max_nests
1181 IF ( ASSOCIATED( grid%nests(kid)%ptr ) ) THEN
1182 CALL model_to_grid_config_rec ( grid%nests(kid)%ptr%id , model_config_rec , kid_config_flags )
1183 CALL med_restart_out ( grid%nests(kid)%ptr , kid_config_flags )
1184 ENDIF
1185 ENDDO
1187 RETURN
1188 END SUBROUTINE med_restart_out
1190 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1192 SUBROUTINE med_hist_out ( grid , stream, config_flags )
1193 ! Driver layer
1194 USE module_domain
1195 USE module_timing
1196 USE module_io_domain
1197 USE module_configure
1198 USE module_bc_time_utilities
1199 USE module_utility
1201 IMPLICIT NONE
1202 ! Arguments
1203 TYPE(domain) :: grid
1204 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1205 INTEGER , INTENT(IN) :: stream
1206 ! Local
1207 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1208 CHARACTER*80 :: fname, n2
1209 CHARACTER (LEN=256) :: message
1210 INTEGER :: ierr
1212 IF ( wrf_dm_on_monitor() ) THEN
1213 CALL start_timing
1214 END IF
1216 IF ( stream .LT. 0 .OR. stream .GT. 11 ) THEN
1217 WRITE(message,*)'med_hist_out: invalid history stream ',stream
1218 CALL wrf_error_fatal( message )
1219 ENDIF
1221 SELECT CASE( stream )
1222 CASE ( 0 )
1223 CALL open_hist_w( grid, config_flags, stream, HISTORY_ALARM, &
1224 config_flags%history_outname, grid%oid, &
1225 output_history, fname, n2, ierr )
1226 CALL output_history ( grid%oid, grid , config_flags , ierr )
1227 CASE ( 1 )
1228 CALL open_hist_w( grid, config_flags, stream, AUXHIST1_ALARM, &
1229 config_flags%auxhist1_outname, grid%auxhist1_oid, &
1230 output_aux_hist1, fname, n2, ierr )
1231 CALL output_aux_hist1 ( grid%auxhist1_oid, grid , config_flags , ierr )
1232 CASE ( 2 )
1233 CALL open_hist_w( grid, config_flags, stream, AUXHIST2_ALARM, &
1234 config_flags%auxhist2_outname, grid%auxhist2_oid, &
1235 output_aux_hist2, fname, n2, ierr )
1236 CALL output_aux_hist2 ( grid%auxhist2_oid, grid , config_flags , ierr )
1237 CASE ( 3 )
1238 CALL open_hist_w( grid, config_flags, stream, AUXHIST3_ALARM, &
1239 config_flags%auxhist3_outname, grid%auxhist3_oid, &
1240 output_aux_hist3, fname, n2, ierr )
1241 CALL output_aux_hist3 ( grid%auxhist3_oid, grid , config_flags , ierr )
1242 CASE ( 4 )
1243 CALL open_hist_w( grid, config_flags, stream, AUXHIST4_ALARM, &
1244 config_flags%auxhist4_outname, grid%auxhist4_oid, &
1245 output_aux_hist4, fname, n2, ierr )
1246 CALL output_aux_hist4 ( grid%auxhist4_oid, grid , config_flags , ierr )
1247 CASE ( 5 )
1248 CALL open_hist_w( grid, config_flags, stream, AUXHIST5_ALARM, &
1249 config_flags%auxhist5_outname, grid%auxhist5_oid, &
1250 output_aux_hist5, fname, n2, ierr )
1251 CALL output_aux_hist5 ( grid%auxhist5_oid, grid , config_flags , ierr )
1252 CASE ( 6 )
1253 CALL open_hist_w( grid, config_flags, stream, AUXHIST6_ALARM, &
1254 config_flags%auxhist6_outname, grid%auxhist6_oid, &
1255 output_aux_hist6, fname, n2, ierr )
1256 CALL output_aux_hist6 ( grid%auxhist6_oid, grid , config_flags , ierr )
1257 CASE ( 7 )
1258 CALL open_hist_w( grid, config_flags, stream, AUXHIST7_ALARM, &
1259 config_flags%auxhist7_outname, grid%auxhist7_oid, &
1260 output_aux_hist7, fname, n2, ierr )
1261 CALL output_aux_hist7 ( grid%auxhist7_oid, grid , config_flags , ierr )
1262 CASE ( 8 )
1263 CALL open_hist_w( grid, config_flags, stream, AUXHIST8_ALARM, &
1264 config_flags%auxhist8_outname, grid%auxhist8_oid, &
1265 output_aux_hist8, fname, n2, ierr )
1266 CALL output_aux_hist8 ( grid%auxhist8_oid, grid , config_flags , ierr )
1267 CASE ( 9 )
1268 CALL open_hist_w( grid, config_flags, stream, AUXHIST9_ALARM, &
1269 config_flags%auxhist9_outname, grid%auxhist9_oid, &
1270 output_aux_hist9, fname, n2, ierr )
1271 CALL output_aux_hist9 ( grid%auxhist9_oid, grid , config_flags , ierr )
1272 CASE ( 10 )
1273 CALL open_hist_w( grid, config_flags, stream, AUXHIST10_ALARM, &
1274 config_flags%auxhist10_outname, grid%auxhist10_oid, &
1275 output_aux_hist10, fname, n2, ierr )
1276 CALL output_aux_hist10 ( grid%auxhist10_oid, grid , config_flags , ierr )
1277 CASE ( 11 )
1278 CALL open_hist_w( grid, config_flags, stream, AUXHIST11_ALARM, &
1279 config_flags%auxhist11_outname, grid%auxhist11_oid, &
1280 output_aux_hist11, fname, n2, ierr )
1281 CALL output_aux_hist11 ( grid%auxhist11_oid, grid , config_flags , ierr )
1282 END SELECT
1284 WRITE(message,*)'med_hist_out: opened ',TRIM(fname),' as ',TRIM(n2)
1285 CALL wrf_debug( 1, message )
1287 grid%nframes(stream) = grid%nframes(stream) + 1
1289 SELECT CASE( stream )
1290 CASE ( 0 )
1291 IF ( grid%nframes(stream) >= config_flags%frames_per_outfile ) THEN
1292 CALL close_dataset ( grid%oid , config_flags , n2 )
1293 grid%oid = 0
1294 grid%nframes(stream) = 0
1295 ENDIF
1296 CASE ( 1 )
1297 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist1 ) THEN
1298 CALL close_dataset ( grid%auxhist1_oid , config_flags , n2 )
1299 grid%auxhist1_oid = 0
1300 grid%nframes(stream) = 0
1301 ENDIF
1302 CASE ( 2 )
1303 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist2 ) THEN
1304 CALL close_dataset ( grid%auxhist2_oid , config_flags , n2 )
1305 grid%auxhist2_oid = 0
1306 grid%nframes(stream) = 0
1307 ENDIF
1308 CASE ( 3 )
1309 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist3 ) THEN
1310 CALL close_dataset ( grid%auxhist3_oid , config_flags , n2 )
1311 grid%auxhist3_oid = 0
1312 grid%nframes(stream) = 0
1313 ENDIF
1314 CASE ( 4 )
1315 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist4 ) THEN
1316 CALL close_dataset ( grid%auxhist4_oid , config_flags , n2 )
1317 grid%auxhist4_oid = 0
1318 grid%nframes(stream) = 0
1319 ENDIF
1320 CASE ( 5 )
1321 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist5 ) THEN
1322 CALL close_dataset ( grid%auxhist5_oid , config_flags , n2 )
1323 grid%auxhist5_oid = 0
1324 grid%nframes(stream) = 0
1325 ENDIF
1326 CASE ( 6 )
1327 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist6 ) THEN
1328 CALL close_dataset ( grid%auxhist6_oid , config_flags , n2 )
1329 grid%auxhist6_oid = 0
1330 grid%nframes(stream) = 0
1331 ENDIF
1332 CASE ( 7 )
1333 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist7 ) THEN
1334 CALL close_dataset ( grid%auxhist7_oid , config_flags , n2 )
1335 grid%auxhist7_oid = 0
1336 grid%nframes(stream) = 0
1337 ENDIF
1338 CASE ( 8 )
1339 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist8 ) THEN
1340 CALL close_dataset ( grid%auxhist8_oid , config_flags , n2 )
1341 grid%auxhist8_oid = 0
1342 grid%nframes(stream) = 0
1343 ENDIF
1344 CASE ( 9 )
1345 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist9 ) THEN
1346 CALL close_dataset ( grid%auxhist9_oid , config_flags , n2 )
1347 grid%auxhist9_oid = 0
1348 grid%nframes(stream) = 0
1349 ENDIF
1350 CASE ( 10 )
1351 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist10 ) THEN
1352 CALL close_dataset ( grid%auxhist10_oid , config_flags , n2 )
1353 grid%auxhist10_oid = 0
1354 grid%nframes(stream) = 0
1355 ENDIF
1356 CASE ( 11 )
1357 IF ( grid%nframes(stream) >= config_flags%frames_per_auxhist11 ) THEN
1358 CALL close_dataset ( grid%auxhist11_oid , config_flags , n2 )
1359 grid%auxhist11_oid = 0
1360 grid%nframes(stream) = 0
1361 ENDIF
1362 END SELECT
1363 IF ( wrf_dm_on_monitor() ) THEN
1364 WRITE ( message , FMT = '("Writing ",A30," for domain ",I8)' )TRIM(fname),grid%id
1365 CALL end_timing ( TRIM(message) )
1366 END IF
1368 RETURN
1369 END SUBROUTINE med_hist_out
1371 SUBROUTINE med_auxinput1_in ( grid , config_flags )
1372 USE module_domain
1373 USE module_configure
1374 IMPLICIT NONE
1375 TYPE(domain) :: grid
1376 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1377 CALL med_auxinput_in( grid , 1 , config_flags )
1378 RETURN
1379 END SUBROUTINE med_auxinput1_in
1381 SUBROUTINE med_auxinput2_in ( grid , config_flags )
1382 USE module_domain
1383 USE module_configure
1384 IMPLICIT NONE
1385 TYPE(domain) :: grid
1386 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1387 CALL med_auxinput_in( grid , 2 , config_flags )
1388 RETURN
1389 END SUBROUTINE med_auxinput2_in
1391 SUBROUTINE med_auxinput3_in ( grid , config_flags )
1392 USE module_domain
1393 USE module_configure
1394 IMPLICIT NONE
1395 TYPE(domain) :: grid
1396 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1397 CALL med_auxinput_in( grid , 3 , config_flags )
1398 RETURN
1399 END SUBROUTINE med_auxinput3_in
1401 SUBROUTINE med_auxinput4_in ( grid , config_flags )
1402 USE module_domain
1403 USE module_configure
1404 IMPLICIT NONE
1405 TYPE(domain) :: grid
1406 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1407 CALL med_auxinput_in( grid , 4 , config_flags )
1408 RETURN
1409 END SUBROUTINE med_auxinput4_in
1411 SUBROUTINE med_auxinput5_in ( grid , config_flags )
1412 USE module_domain
1413 USE module_configure
1414 IMPLICIT NONE
1415 TYPE(domain) :: grid
1416 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1417 CALL med_auxinput_in( grid , 5 , config_flags )
1418 RETURN
1419 END SUBROUTINE med_auxinput5_in
1421 SUBROUTINE med_auxinput6_in ( grid , config_flags )
1422 USE module_domain
1423 USE module_configure
1424 IMPLICIT NONE
1425 TYPE(domain) :: grid
1426 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1427 CALL med_auxinput_in( grid , 6 , config_flags )
1428 RETURN
1429 END SUBROUTINE med_auxinput6_in
1431 SUBROUTINE med_auxinput7_in ( grid , config_flags )
1432 USE module_domain
1433 USE module_configure
1434 IMPLICIT NONE
1435 TYPE(domain) :: grid
1436 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1437 CALL med_auxinput_in( grid , 7 , config_flags )
1438 RETURN
1439 END SUBROUTINE med_auxinput7_in
1441 SUBROUTINE med_auxinput8_in ( grid , config_flags )
1442 USE module_domain
1443 USE module_configure
1444 IMPLICIT NONE
1445 TYPE(domain) :: grid
1446 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1447 CALL med_auxinput_in( grid , 8 , config_flags )
1448 RETURN
1449 END SUBROUTINE med_auxinput8_in
1451 SUBROUTINE med_auxinput9_in ( grid , config_flags )
1452 USE module_domain
1453 USE module_configure
1454 IMPLICIT NONE
1455 TYPE(domain) :: grid
1456 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1457 CALL med_auxinput_in( grid , 9 , config_flags )
1458 RETURN
1459 END SUBROUTINE med_auxinput9_in
1461 SUBROUTINE med_auxinput10_in ( grid , config_flags )
1462 USE module_domain
1463 USE module_configure
1464 IMPLICIT NONE
1465 TYPE(domain) :: grid
1466 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1467 CALL med_auxinput_in( grid , 10 , config_flags )
1468 RETURN
1469 END SUBROUTINE med_auxinput10_in
1471 SUBROUTINE med_auxinput11_in ( grid , config_flags )
1472 USE module_domain
1473 USE module_configure
1474 IMPLICIT NONE
1475 TYPE(domain) :: grid
1476 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1477 CALL med_auxinput_in( grid , 11 , config_flags )
1478 RETURN
1479 END SUBROUTINE med_auxinput11_in
1481 SUBROUTINE med_fddaobs_in ( grid , config_flags )
1482 USE module_domain
1483 USE module_configure
1484 IMPLICIT NONE
1485 TYPE(domain) :: grid
1486 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1487 CALL wrf_fddaobs_in( grid, config_flags )
1488 RETURN
1489 END SUBROUTINE med_fddaobs_in
1491 SUBROUTINE med_auxinput_in ( grid , stream, config_flags )
1492 ! Driver layer
1493 USE module_domain
1494 USE module_io_domain
1495 ! Model layer
1496 USE module_configure
1497 USE module_bc_time_utilities
1498 USE module_utility
1500 IMPLICIT NONE
1501 ! Arguments
1502 TYPE(domain) :: grid
1503 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1504 INTEGER , INTENT(IN) :: stream
1505 ! Local
1506 CHARACTER (LEN=256) :: message
1507 INTEGER :: ierr
1509 IF ( stream .LT. 1 .OR. stream .GT. 11 ) THEN
1510 WRITE(message,*)'med_auxinput_in: invalid input stream ',stream
1511 CALL wrf_error_fatal( message )
1512 ENDIF
1514 SELECT CASE( stream )
1515 CASE ( 1 )
1516 CALL open_aux_u( grid, config_flags, stream, AUXINPUT1_ALARM, &
1517 config_flags%auxinput1_inname, grid%auxinput1_oid, &
1518 input_aux_model_input1, ierr )
1519 CALL input_aux_model_input1 ( grid%auxinput1_oid, grid , config_flags , ierr )
1520 CASE ( 2 )
1521 CALL open_aux_u( grid, config_flags, stream, AUXINPUT2_ALARM, &
1522 config_flags%auxinput2_inname, grid%auxinput2_oid, &
1523 input_aux_model_input2, ierr )
1524 CALL input_aux_model_input2 ( grid%auxinput2_oid, grid , config_flags , ierr )
1525 CASE ( 3 )
1526 CALL open_aux_u( grid, config_flags, stream, AUXINPUT3_ALARM, &
1527 config_flags%auxinput3_inname, grid%auxinput3_oid, &
1528 input_aux_model_input3, ierr )
1529 CALL input_aux_model_input3 ( grid%auxinput3_oid, grid , config_flags , ierr )
1530 CASE ( 4 )
1531 CALL open_aux_u( grid, config_flags, stream, AUXINPUT4_ALARM, &
1532 config_flags%auxinput4_inname, grid%auxinput4_oid, &
1533 input_aux_model_input4, ierr )
1534 CALL input_aux_model_input4 ( grid%auxinput4_oid, grid , config_flags , ierr )
1535 CASE ( 5 )
1536 CALL open_aux_u( grid, config_flags, stream, AUXINPUT5_ALARM, &
1537 config_flags%auxinput5_inname, grid%auxinput5_oid, &
1538 input_aux_model_input5, ierr )
1539 CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
1540 CASE ( 6 )
1541 CALL open_aux_u( grid, config_flags, stream, AUXINPUT6_ALARM, &
1542 config_flags%auxinput6_inname, grid%auxinput6_oid, &
1543 input_aux_model_input6, ierr )
1544 CALL input_aux_model_input6 ( grid%auxinput6_oid, grid , config_flags , ierr )
1545 CASE ( 7 )
1546 CALL open_aux_u( grid, config_flags, stream, AUXINPUT7_ALARM, &
1547 config_flags%auxinput7_inname, grid%auxinput7_oid, &
1548 input_aux_model_input7, ierr )
1549 CALL input_aux_model_input7 ( grid%auxinput7_oid, grid , config_flags , ierr )
1550 CASE ( 8 )
1551 CALL open_aux_u( grid, config_flags, stream, AUXINPUT8_ALARM, &
1552 config_flags%auxinput8_inname, grid%auxinput8_oid, &
1553 input_aux_model_input8, ierr )
1554 CALL input_aux_model_input8 ( grid%auxinput8_oid, grid , config_flags , ierr )
1555 CASE ( 9 )
1556 CALL open_aux_u( grid, config_flags, stream, AUXINPUT9_ALARM, &
1557 config_flags%auxinput9_inname, grid%auxinput9_oid, &
1558 input_aux_model_input9, ierr )
1559 CALL input_aux_model_input9 ( grid%auxinput9_oid, grid , config_flags , ierr )
1560 CASE ( 10 )
1561 CALL open_aux_u( grid, config_flags, stream, AUXINPUT10_ALARM, &
1562 config_flags%gfdda_inname, grid%auxinput10_oid, &
1563 input_aux_model_input10, ierr )
1564 CALL input_aux_model_input10 ( grid%auxinput10_oid, grid , config_flags , ierr )
1565 CASE ( 11 )
1566 CALL open_aux_u( grid, config_flags, stream, AUXINPUT11_ALARM, &
1567 config_flags%auxinput11_inname, grid%auxinput11_oid, &
1568 input_aux_model_input11, ierr )
1569 CALL input_aux_model_input11 ( grid%auxinput11_oid, grid , config_flags , ierr )
1570 END SELECT
1571 RETURN
1572 END SUBROUTINE med_auxinput_in
1574 SUBROUTINE med_filter_out ( grid , config_flags )
1575 ! Driver layer
1576 USE module_domain
1577 USE module_io_domain
1578 USE module_timing
1579 USE module_configure
1580 ! Model layer
1581 USE module_bc_time_utilities
1583 IMPLICIT NONE
1585 ! Arguments
1586 TYPE(domain) :: grid
1587 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1589 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1590 CHARACTER*80 :: rstname , outname
1591 INTEGER :: fid , rid
1592 CHARACTER (LEN=256) :: message
1593 INTEGER :: ierr
1594 INTEGER :: myproc
1595 CHARACTER*80 :: timestr
1597 IF ( config_flags%write_input ) THEN
1599 IF ( wrf_dm_on_monitor() ) THEN
1600 CALL start_timing
1601 END IF
1603 CALL domain_clock_get( grid, current_timestr=timestr )
1604 CALL construct_filename2a ( outname , config_flags%input_outname , grid%id , 2 , timestr )
1606 WRITE ( message , '("med_filter_out 1: opening ",A," for writing. ")') TRIM ( outname )
1607 CALL wrf_debug( 1, message )
1609 CALL open_w_dataset ( fid, TRIM(outname), grid , &
1610 config_flags , output_model_input , "DATASET=INPUT", ierr )
1611 IF ( ierr .NE. 0 ) THEN
1612 CALL wrf_error_fatal( message )
1613 ENDIF
1615 IF ( ierr .NE. 0 ) THEN
1616 CALL wrf_error_fatal( message )
1617 ENDIF
1619 CALL output_model_input ( fid, grid , config_flags , ierr )
1620 CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
1622 IF ( wrf_dm_on_monitor() ) THEN
1623 WRITE ( message , FMT = '("Writing filter output for domain ",I8)' ) grid%id
1624 CALL end_timing ( TRIM(message) )
1625 END IF
1626 ENDIF
1628 RETURN
1629 END SUBROUTINE med_filter_out
1631 SUBROUTINE med_latbound_in ( grid , config_flags )
1632 ! Driver layer
1633 USE module_domain
1634 USE module_io_domain
1635 USE module_timing
1636 USE module_configure
1637 ! Model layer
1638 USE module_bc_time_utilities
1639 USE module_utility
1641 IMPLICIT NONE
1643 #include <wrf_status_codes.h>
1645 ! Arguments
1646 TYPE(domain) :: grid
1647 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1649 ! Local data
1650 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1651 LOGICAL :: lbc_opened
1652 INTEGER :: idum1 , idum2 , ierr , open_status , fid, rc
1653 REAL :: bfrq
1654 CHARACTER (LEN=256) :: message
1655 CHARACTER (LEN=80) :: bdyname
1656 Type (WRFU_Time ) :: startTime, stopTime, currentTime
1657 Type (WRFU_TimeInterval ) :: stepTime
1658 integer myproc,i,j,k
1660 #include <wrf_io_flags.h>
1662 CALL wrf_debug ( 200 , 'in med_latbound_in' )
1664 #if (EM_CORE == 1)
1665 ! Avoid trying to re-read the boundary conditions if we are doing DFI integration
1666 ! and do not expect to find boundary conditions for the current time
1667 IF ( (grid%dfi_opt .EQ. DFI_DDFI .OR. grid%dfi_opt .EQ. DFI_TDFI) .AND. grid%dfi_stage .EQ. DFI_FWD ) RETURN
1668 #endif
1670 IF ( grid%id .EQ. 1 .AND. config_flags%specified .AND. config_flags%io_form_boundary .GT. 0 ) THEN
1672 CALL domain_clock_get( grid, current_time=currentTime, &
1673 start_time=startTime, &
1674 stop_time=stopTime, &
1675 time_step=stepTime )
1677 IF ( ( lbc_read_time( currentTime ) ) .AND. &
1678 ( currentTime + stepTime .GE. stopTime ) .AND. &
1679 ( currentTime .NE. startTime ) ) THEN
1680 CALL wrf_debug( 100 , 'med_latbound_in: Skipping attempt to read lateral boundary file during last time step ' )
1682 ELSE IF ( WRFU_AlarmIsRinging( grid%alarms( BOUNDARY_ALARM ), rc=rc ) ) THEN
1683 CALL wrf_debug ( 100 , 'in med_latbound_in preparing to read' )
1684 CALL WRFU_AlarmRingerOff( grid%alarms( BOUNDARY_ALARM ), rc=rc )
1685 IF ( wrf_dm_on_monitor() ) CALL start_timing
1687 ! typically a <date> wouldn't be part of the bdy_inname, so just pass a dummy
1688 CALL construct_filename2a ( bdyname , config_flags%bdy_inname , grid%id , 2 , 'dummydate' )
1690 CALL wrf_inquire_opened(head_grid%lbc_fid , TRIM(bdyname) , open_status , ierr )
1691 IF ( open_status .EQ. WRF_FILE_OPENED_FOR_READ ) THEN
1692 lbc_opened = .TRUE.
1693 ELSE
1694 lbc_opened = .FALSE.
1695 ENDIF
1696 CALL wrf_dm_bcast_bytes ( lbc_opened , LWORDSIZE )
1697 IF ( .NOT. lbc_opened ) THEN
1698 CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 )
1699 CALL open_r_dataset ( head_grid%lbc_fid, TRIM(bdyname) , grid , config_flags , "DATASET=BOUNDARY", ierr )
1700 IF ( ierr .NE. 0 ) THEN
1701 WRITE( message, * ) 'med_latbound_in: error opening ',TRIM(bdyname), ' for reading. IERR = ',ierr
1702 CALL WRF_ERROR_FATAL( message )
1703 ENDIF
1704 ELSE
1705 CALL wrf_debug( 100 , bdyname // 'already opened' )
1706 ENDIF
1707 CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
1708 CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
1710 #if (EM_CORE == 1)
1711 IF ( (config_flags%dfi_opt .NE. DFI_NODFI) .AND. (head_grid%dfi_stage .NE. DFI_FST) ) THEN
1712 CALL close_dataset ( head_grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
1713 END IF
1714 #endif
1716 CALL domain_clock_get( grid, current_time=currentTime )
1717 DO WHILE (currentTime .GE. grid%next_bdy_time ) ! next_bdy_time is set by input_boundary from bdy file
1718 CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
1719 CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
1720 ENDDO
1721 CALL WRFU_AlarmSet( grid%alarms( BOUNDARY_ALARM ), RingTime=grid%next_bdy_time, rc=rc )
1723 IF ( ierr .NE. 0 .and. ierr .NE. WRF_WARN_NETCDF ) THEN
1724 WRITE( message, * ) 'med_latbound_in: error reading ',TRIM(bdyname), ' IERR = ',ierr
1725 CALL WRF_ERROR_FATAL( message )
1726 ENDIF
1727 IF ( currentTime .EQ. grid%this_bdy_time ) grid%dtbc = 0.
1729 IF ( wrf_dm_on_monitor() ) THEN
1730 WRITE ( message , FMT = '("processing lateral boundary for domain ",I8)' ) grid%id
1731 CALL end_timing ( TRIM(message) )
1732 ENDIF
1733 ENDIF
1734 ENDIF
1735 RETURN
1736 END SUBROUTINE med_latbound_in
1738 SUBROUTINE med_setup_step ( grid , config_flags )
1739 ! Driver layer
1740 USE module_domain
1741 USE module_configure
1742 ! Model layer
1744 IMPLICIT NONE
1745 !<DESCRIPTION>
1746 !
1747 !The driver layer routine integrate() calls this mediation layer routine
1748 !prior to initiating a time step on the domain specified by the argument
1749 !grid. This provides the model-layer contributor an opportunity to make
1750 !any pre-time-step initializations that pertain to a particular model
1751 !domain. In WRF, this routine is used to call
1752 !set_scalar_indices_from_config for the specified domain.
1753 !
1754 !</DESCRIPTION>
1756 ! Arguments
1757 TYPE(domain) :: grid
1758 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1759 ! Local
1760 INTEGER :: idum1 , idum2
1762 CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
1764 RETURN
1766 END SUBROUTINE med_setup_step
1768 SUBROUTINE med_endup_step ( grid , config_flags )
1769 ! Driver layer
1770 USE module_domain
1771 USE module_configure
1772 ! Model layer
1774 IMPLICIT NONE
1775 !<DESCRIPTION>
1776 !
1777 !The driver layer routine integrate() calls this mediation layer routine
1778 !prior to initiating a time step on the domain specified by the argument
1779 !grid. This provides the model-layer contributor an opportunity to make
1780 !any pre-time-step initializations that pertain to a particular model
1781 !domain. In WRF, this routine is used to call
1782 !set_scalar_indices_from_config for the specified domain.
1783 !
1784 !</DESCRIPTION>
1786 ! Arguments
1787 TYPE(domain) :: grid
1788 TYPE (grid_config_rec_type) , INTENT(OUT) :: config_flags
1789 ! Local
1790 INTEGER :: idum1 , idum2
1792 IF ( grid%id .EQ. 1 ) THEN
1793 ! turn off the restart flag after the first mother-domain step is finished
1794 model_config_rec%restart = .FALSE.
1795 config_flags%restart = .FALSE.
1796 CALL nl_set_restart(1, .FALSE.)
1798 ENDIF
1800 RETURN
1802 END SUBROUTINE med_endup_step
1804 SUBROUTINE open_aux_u ( grid , config_flags, stream, alarm_id, &
1805 auxinput_inname, oid, insub, ierr )
1806 ! Driver layer
1807 USE module_domain
1808 USE module_io_domain
1809 ! Model layer
1810 USE module_configure
1811 USE module_bc_time_utilities
1812 USE module_utility
1814 IMPLICIT NONE
1815 ! Arguments
1816 TYPE(domain) :: grid
1817 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1818 INTEGER , INTENT(IN) :: stream
1819 INTEGER , INTENT(IN) :: alarm_id
1820 CHARACTER*(*) , INTENT(IN) :: auxinput_inname
1821 INTEGER , INTENT(INOUT) :: oid
1822 EXTERNAL insub
1823 INTEGER , INTENT(OUT) :: ierr
1824 ! Local
1825 CHARACTER*80 :: fname, n2
1826 CHARACTER (LEN=256) :: message
1827 CHARACTER*80 :: timestr
1828 TYPE(WRFU_Time) :: ST,CT
1829 LOGICAL :: adjust
1831 IF ( stream .LT. 1 .OR. stream .GT. 11 ) THEN
1832 WRITE(message,*)'open_aux_u: invalid input stream ',stream
1833 CALL wrf_error_fatal( message )
1834 ENDIF
1836 ierr = 0
1838 IF ( oid .eq. 0 ) THEN
1839 CALL domain_clock_get( grid, current_time=CT, start_time=ST, &
1840 current_timestr=timestr )
1841 CALL nl_get_adjust_input_times( grid%id, adjust )
1842 IF ( adjust ) THEN
1843 CALL adjust_io_timestr( grid%io_intervals( alarm_id ), CT, ST, timestr )
1844 ENDIF
1845 CALL construct_filename2a ( fname , auxinput_inname, &
1846 grid%id , 2 , timestr )
1847 IF ( stream .EQ. 10 ) THEN
1848 WRITE(n2,'("DATASET=AUXINPUT10")')
1849 ELSE IF ( stream .EQ. 11 ) THEN
1850 WRITE(n2,'("DATASET=AUXINPUT11")')
1851 ELSE
1852 WRITE(n2,'("DATASET=AUXINPUT",I1)')stream
1853 ENDIF
1854 WRITE ( message , '("open_aux_u : opening ",A," for reading. ")') TRIM ( fname )
1855 CALL wrf_debug( 1, message )
1856 !<DESCRIPTION>
1857 !
1858 !Open_u_dataset is called rather than open_r_dataset to allow interfaces
1859 !that can do blending or masking to update an existing field. (MCEL IO does this).
1860 !No effect for other interfaces; open_u_dataset is equivalent to open_r_dataset
1861 !in those cases.
1862 !
1863 !</DESCRIPTION>
1864 CALL open_u_dataset ( oid, TRIM(fname), grid , &
1865 config_flags , insub , n2, ierr )
1866 ENDIF
1867 IF ( ierr .NE. 0 ) THEN
1868 WRITE ( message , '("open_aux_u : error opening ",A," for reading. ",I3)') &
1869 TRIM ( fname ), ierr
1870 CALL wrf_message( message )
1871 ENDIF
1872 RETURN
1873 END SUBROUTINE open_aux_u
1875 SUBROUTINE open_hist_w ( grid , config_flags, stream, alarm_id, &
1876 hist_outname, oid, outsub, fname, n2, ierr )
1877 ! Driver layer
1878 USE module_domain
1879 USE module_io_domain
1880 ! Model layer
1881 USE module_configure
1882 USE module_bc_time_utilities
1883 USE module_utility
1885 IMPLICIT NONE
1886 ! Arguments
1887 TYPE(domain) :: grid
1888 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1889 INTEGER , INTENT(IN) :: stream
1890 INTEGER , INTENT(IN) :: alarm_id
1891 CHARACTER*(*) , INTENT(IN) :: hist_outname
1892 INTEGER , INTENT(INOUT) :: oid
1893 EXTERNAL outsub
1894 CHARACTER*(*) , INTENT(OUT) :: fname, n2
1895 INTEGER , INTENT(OUT) :: ierr
1896 ! Local
1897 INTEGER :: len_n2
1898 CHARACTER (LEN=256) :: message
1899 CHARACTER*80 :: timestr
1900 TYPE(WRFU_Time) :: ST,CT
1901 LOGICAL :: adjust
1903 IF ( stream .LT. 0 .OR. stream .GT. 11 ) THEN
1904 WRITE(message,*)'open_hist_w: invalid history stream ',stream
1905 CALL wrf_error_fatal( message )
1906 ENDIF
1908 ierr = 0
1910 ! Note that computation of fname and n2 are outside of the oid IF statement
1911 ! since they are OUT args and may be used by callers even if oid/=0.
1912 CALL domain_clock_get( grid, current_time=CT, start_time=ST, &
1913 current_timestr=timestr )
1914 CALL nl_get_adjust_output_times( grid%id, adjust )
1915 IF ( adjust ) THEN
1916 CALL adjust_io_timestr( grid%io_intervals( alarm_id ), CT, ST, timestr )
1917 ENDIF
1918 CALL construct_filename2a ( fname , hist_outname, &
1919 grid%id , 2 , timestr )
1920 IF ( stream .EQ. 10 ) THEN
1921 WRITE(n2,'("DATASET=AUXHIST10")')
1922 ELSE IF ( stream .EQ. 11 ) THEN
1923 WRITE(n2,'("DATASET=AUXHIST11")')
1924 ELSE IF ( stream .EQ. 0 ) THEN
1925 WRITE(n2,'("DATASET=HISTORY")')
1926 ELSE
1927 WRITE(n2,'("DATASET=AUXHIST",I1)')stream
1928 ENDIF
1929 #if (DA_CORE == 1)
1930 len_n2 = LEN_TRIM(n2)
1931 WRITE(n2(len_n2+1:len_n2+19),'(",REAL_OUTPUT_SIZE=4")')
1932 #endif
1933 IF ( oid .eq. 0 ) THEN
1934 WRITE ( message , '("open_hist_w : opening ",A," for writing. ")') TRIM ( fname )
1935 CALL wrf_debug( 1, message )
1936 !<DESCRIPTION>
1937 !
1938 !Open_u_dataset is called rather than open_r_dataset to allow interfaces
1939 !that can do blending or masking to update an existing field. (MCEL IO does this).
1940 !No effect for other interfaces; open_u_dataset is equivalent to open_r_dataset
1941 !in those cases.
1942 !
1943 !</DESCRIPTION>
1944 CALL open_w_dataset ( oid, TRIM(fname), grid , &
1945 config_flags , outsub , n2, ierr )
1946 ENDIF
1947 IF ( ierr .NE. 0 ) THEN
1948 WRITE ( message , '("open_hist_w : error opening ",A," for writing. ",I3)') &
1949 TRIM ( fname ), ierr
1950 CALL wrf_message( message )
1951 ENDIF
1952 RETURN
1953 END SUBROUTINE open_hist_w
1956 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1958 #ifdef WRF_CHEM
1959 !------------------------------------------------------------------------
1960 ! Chemistry emissions input control. Three options are available and are
1961 ! set via the namelist variable io_style_emissions:
1962 !
1963 ! 0 = Emissions are not read in from a file. They will contain their
1964 ! default values, which can be set in the Registry.
1965 ! (Intended for debugging of chem code)
1966 !
1967 ! 1 = Emissions are read in from two 12 hour files that are cycled.
1968 ! With this choice, emi_inname and emi_outname should be set to
1969 ! the value "wrfchemi_d<domain>". The value of frames_per_emissfile
1970 ! is ignored.
1971 !
1972 ! 2 = Emissions are read in from files identified by date and that have
1973 ! a length defined by frames_per_emissfile (in hours). Both
1974 ! emi_inname and emi_outname should be set to
1975 ! "wrfchemi_d<domain>_<date>".
1976 !------------------------------------------------------------------------
1977 SUBROUTINE med_read_wrf_chem_emiss ( grid , config_flags )
1978 ! Driver layer
1979 USE module_domain
1980 USE module_io_domain
1981 USE module_timing
1982 USE module_configure
1983 ! Model layer
1984 USE module_bc_time_utilities
1985 #ifdef DM_PARALLEL
1986 USE module_dm
1987 #endif
1988 USE module_date_time
1989 USE module_utility
1991 IMPLICIT NONE
1993 ! Arguments
1994 TYPE(domain) :: grid
1996 ! TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
1997 TYPE (grid_config_rec_type) :: config_flags
1998 Type (WRFU_Time ) :: stopTime, currentTime
1999 Type (WRFU_TimeInterval ) :: stepTime
2001 ! Local data
2002 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2004 INTEGER :: ierr, efid
2005 REAL :: time, tupdate
2006 real, allocatable :: dumc0(:,:,:)
2007 CHARACTER (LEN=256) :: message, current_date_char, date_string
2008 CHARACTER (LEN=80) :: inpname
2010 #include <wrf_io_flags.h>
2012 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
2014 ! This "if" should be commented out when using emission files for nested
2015 ! domains. Also comment out the "ENDIF" line noted below.
2016 ! IF ( grid%id .EQ. 1 ) THEN
2018 CALL domain_clock_get( grid, current_time=currentTime, &
2019 current_timestr=current_date_char, &
2020 stop_time=stopTime, &
2021 time_step=stepTime )
2023 time = float(grid%itimestep) * grid%dt
2025 !---
2026 ! io_style_emissions option 0: no emissions read in...
2027 !---
2028 if( config_flags%io_style_emissions == 0 ) then
2029 ! Do nothing.
2030 !---
2031 ! io_style_emissions option 1: cycle through two 12 hour input files...
2032 !---
2033 else if( config_flags%io_style_emissions == 1 ) then
2035 tupdate = mod( time, (12. * 3600.) )
2036 IF( tupdate .LT. grid%dt ) THEN
2037 tupdate = 0.
2038 ENDIF
2039 IF( currentTime + stepTime .GE. stopTime .AND. &
2040 grid%auxinput5_oid .NE. 0 ) THEN
2041 CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2042 tupdate = 1.
2043 ENDIF
2045 ! write(message,FMT='(A,F10.1,A)') ' EMISSIONS UPDATE TIME ',time,TRIM(current_date_char(12:13))
2046 ! CALL wrf_message( TRIM(message) )
2048 IF ( tupdate .EQ. 0. .AND. current_date_char(12:13) .EQ. '00' ) THEN
2049 CALL construct_filename1 ( inpname , 'wrfchemi_00z' , grid%id , 2 )
2050 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
2051 CALL wrf_message( TRIM(message) )
2053 if( grid%auxinput5_oid .NE. 0 ) then
2054 CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2055 endif
2057 CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
2058 "DATASET=AUXINPUT5", ierr )
2059 IF ( ierr .NE. 0 ) THEN
2060 WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
2061 CALL wrf_error_fatal( TRIM( message ) )
2062 ENDIF
2063 ELSE IF ( tupdate .EQ. 0. .AND. current_date_char(12:13) .EQ. '12' ) THEN
2064 CALL construct_filename1 ( inpname , 'wrfchemi_12z' , grid%id , 2 )
2065 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
2066 CALL wrf_message( TRIM(message) )
2068 if( grid%auxinput5_oid .NE. 0 ) then
2069 CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2070 endif
2072 CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
2073 "DATASET=AUXINPUT5", ierr )
2074 IF ( ierr .NE. 0 ) THEN
2075 WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
2076 CALL wrf_error_fatal( TRIM( message ) )
2077 ENDIF
2078 ENDIF
2080 WRITE( message, '(A,2F10.1)' ) ' HOURLY EMISSIONS UPDATE TIME ',time,mod(time,3600.)
2081 CALL wrf_message( TRIM(message) )
2082 !
2083 ! hourly updates to emissions
2084 IF ( ( mod( time, 3600. ) .LT. grid%dt ) .AND. &
2085 ( currentTime + stepTime .LT. stopTime ) ) THEN
2086 ! IF ( wrf_dm_on_monitor() ) CALL start_timing
2088 WRITE(message,'(A,A)')'mediation_integrate: med_read_wrf_chem_emissions: Read emissions for time ',TRIM(current_date_char)
2089 CALL wrf_message( TRIM(message) )
2091 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input5' )
2092 CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
2093 ELSE
2094 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: Do not read emissions' )
2095 ENDIF
2098 !---
2099 ! io_style_emissions option 2: use dated emission files whose length is
2100 ! set via frames_per_emissfile...
2101 !---
2102 else if( config_flags%io_style_emissions == 2 ) then
2103 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Read emissions for time ',TRIM(current_date_char)
2104 CALL wrf_message( TRIM(message) )
2105 !
2106 ! Code to read hourly emission files...
2107 !
2108 if( grid%auxinput5_oid == 0 ) then
2109 CALL construct_filename2a(inpname , grid%emi_inname, grid%id , 2, current_date_char)
2110 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
2111 CALL wrf_message( TRIM(message) )
2112 CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
2113 "DATASET=AUXINPUT5", ierr )
2114 IF ( ierr .NE. 0 ) THEN
2115 WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
2116 CALL wrf_error_fatal( TRIM( message ) )
2117 ENDIF
2118 end if
2119 !
2120 ! Read the emissions data.
2121 !
2122 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input5' )
2123 CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
2124 !
2125 ! If reached the indicated number of frames in the emissions file, close it.
2126 !
2127 grid%emissframes = grid%emissframes + 1
2128 IF ( grid%emissframes >= config_flags%frames_per_emissfile ) THEN
2129 CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2130 grid%emissframes = 0
2131 grid%auxinput5_oid = 0
2132 ENDIF
2134 !---
2135 ! unknown io_style_emissions option...
2136 !---
2137 else
2138 call wrf_error_fatal("Unknown emission style selected via io_style_emissions.")
2139 end if
2141 ! The following line should be commented out when using emission files
2142 ! for nested domains. Also comment out the "if" noted above.
2143 ! ENDIF
2145 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: exit' )
2147 END SUBROUTINE med_read_wrf_chem_emiss
2149 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2150 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2152 SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags )
2153 ! Driver layer
2154 USE module_domain
2155 USE module_io_domain
2156 USE module_timing
2157 USE module_configure
2158 ! Model layer
2159 USE module_bc_time_utilities
2160 #ifdef DM_PARALLEL
2161 USE module_dm
2162 #endif
2163 USE module_date_time
2164 USE module_utility
2166 IMPLICIT NONE
2168 ! Arguments
2169 TYPE(domain) :: grid
2171 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2173 ! Local data
2174 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2176 INTEGER :: ierr, efid
2177 REAL :: time, tupdate
2178 real, allocatable :: dumc0(:,:,:)
2179 CHARACTER (LEN=256) :: message, current_date_char, date_string
2180 CHARACTER (LEN=80) :: inpname
2182 #include <wrf_io_flags.h>
2183 ! IF ( grid%id .EQ. 1 ) THEN
2185 CALL domain_clock_get( grid, current_timestr=current_date_char )
2187 CALL construct_filename1 ( inpname , 'wrfbiochemi' , grid%id , 2 )
2188 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_bioemissions: Open file ',TRIM(inpname)
2189 CALL wrf_message( TRIM(message) )
2191 if( grid%auxinput4_oid .NE. 0 ) then
2192 CALL close_dataset ( grid%auxinput4_oid , config_flags , "DATASET=AUXINPUT4" )
2193 endif
2195 CALL open_r_dataset ( grid%auxinput4_oid, TRIM(inpname) , grid , config_flags, &
2196 "DATASET=AUXINPUT4", ierr )
2197 IF ( ierr .NE. 0 ) THEN
2198 WRITE( message , * ) 'med_read_wrf_chem_bioemissions: error opening ', TRIM( inpname )
2199 CALL wrf_error_fatal( TRIM( message ) )
2200 ENDIF
2202 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_bioemissions: Read biogenic emissions at time ',&
2203 TRIM(current_date_char)
2204 CALL wrf_message( TRIM(message) )
2206 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input4' )
2207 CALL input_aux_model_input4 ( grid%auxinput4_oid, grid , config_flags , ierr )
2209 CALL close_dataset ( grid%auxinput4_oid , config_flags , "DATASET=AUXINPUT4" )
2211 ! ENDIF
2212 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_bioemissions: exit' )
2214 END SUBROUTINE med_read_wrf_chem_bioemiss
2216 SUBROUTINE med_read_wrf_chem_gocartbg ( grid , config_flags )
2217 ! Driver layer
2218 USE module_domain
2219 USE module_io_domain
2220 USE module_timing
2221 USE module_configure
2222 ! Model layer
2223 USE module_bc_time_utilities
2224 #ifdef DM_PARALLEL
2225 USE module_dm
2226 #endif
2227 USE module_date_time
2228 USE module_utility
2230 IMPLICIT NONE
2232 ! Arguments
2233 TYPE(domain) :: grid
2235 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2237 ! Local data
2238 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2240 INTEGER :: ierr, efid
2241 REAL :: time, tupdate
2242 real, allocatable :: dumc0(:,:,:)
2243 CHARACTER (LEN=256) :: message, current_date_char, date_string
2244 CHARACTER (LEN=80) :: inpname
2246 #include <wrf_io_flags.h>
2247 ! IF ( grid%id .EQ. 1 ) THEN
2249 CALL domain_clock_get( grid, current_timestr=current_date_char )
2251 CALL construct_filename1 ( inpname , 'wrfchemi_gocart_bg' , grid%id , 2 )
2252 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_gocartbg: Open file ',TRIM(inpname)
2253 CALL wrf_message( TRIM(message) )
2255 if( grid%auxinput9_oid .NE. 0 ) then
2256 CALL close_dataset ( grid%auxinput9_oid , config_flags , "DATASET=AUXINPUT9" )
2257 endif
2259 CALL open_r_dataset ( grid%auxinput9_oid, TRIM(inpname) , grid , config_flags, &
2260 "DATASET=AUXINPUT9", ierr )
2261 IF ( ierr .NE. 0 ) THEN
2262 WRITE( message , * ) 'med_read_wrf_chem_gocartbg error opening ', TRIM( inpname )
2263 CALL wrf_error_fatal( TRIM( message ) )
2264 ENDIF
2266 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_gocartbg: Read fire emissions at time ',&
2267 TRIM(current_date_char)
2268 CALL wrf_message( TRIM(message) )
2270 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input9' )
2271 CALL input_aux_model_input9 ( grid%auxinput9_oid, grid , config_flags , ierr )
2273 CALL close_dataset ( grid%auxinput9_oid , config_flags , "DATASET=AUXINPUT9" )
2275 ! ENDIF
2276 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_gocartbg: exit' )
2278 END SUBROUTINE med_read_wrf_chem_gocartbg
2279 SUBROUTINE med_read_wrf_chem_emissopt3 ( grid , config_flags )
2280 ! Driver layer
2281 USE module_domain
2282 USE module_io_domain
2283 USE module_timing
2284 USE module_configure
2285 ! Model layer
2286 USE module_bc_time_utilities
2287 #ifdef DM_PARALLEL
2288 USE module_dm
2289 #endif
2290 USE module_date_time
2291 USE module_utility
2293 IMPLICIT NONE
2295 ! Arguments
2296 TYPE(domain) :: grid
2298 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2300 ! Local data
2301 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2303 INTEGER :: ierr, efid
2304 REAL :: time, tupdate
2305 real, allocatable :: dumc0(:,:,:)
2306 CHARACTER (LEN=256) :: message, current_date_char, date_string
2307 CHARACTER (LEN=80) :: inpname
2309 #include <wrf_io_flags.h>
2310 ! IF ( grid%id .EQ. 1 ) THEN
2312 CALL domain_clock_get( grid, current_timestr=current_date_char )
2314 CALL construct_filename1 ( inpname , 'wrffirechemi' , grid%id , 2 )
2315 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_fireemissions: Open file ',TRIM(inpname)
2316 CALL wrf_message( TRIM(message) )
2318 if( grid%auxinput7_oid .NE. 0 ) then
2319 CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2320 endif
2322 CALL open_r_dataset ( grid%auxinput7_oid, TRIM(inpname) , grid , config_flags, &
2323 "DATASET=AUXINPUT7", ierr )
2324 IF ( ierr .NE. 0 ) THEN
2325 WRITE( message , * ) 'med_read_wrf_chem_fireemissions: error opening ', TRIM( inpname )
2326 CALL wrf_error_fatal( TRIM( message ) )
2327 ENDIF
2329 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_fireemissions: Read fire emissions at time ',&
2330 TRIM(current_date_char)
2331 CALL wrf_message( TRIM(message) )
2333 CALL wrf_debug (00 , 'mediation_integrate: calling input_aux_model_input7' )
2334 CALL input_aux_model_input7 ( grid%auxinput7_oid, grid , config_flags , ierr )
2336 CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2338 ! ENDIF
2339 CALL wrf_debug (00 , 'mediation_integrate: med_read_wrf_chem_fireemissions: exit' )
2341 END SUBROUTINE med_read_wrf_chem_emissopt3
2342 SUBROUTINE med_read_wrf_chem_emissopt4 ( grid , config_flags )
2343 ! Driver layer
2344 USE module_domain
2345 USE module_io_domain
2346 USE module_timing
2347 USE module_configure
2348 ! Model layer
2349 USE module_bc_time_utilities
2350 #ifdef DM_PARALLEL
2351 USE module_dm
2352 #endif
2353 USE module_date_time
2354 USE module_utility
2356 IMPLICIT NONE
2358 ! Arguments
2359 TYPE(domain) :: grid
2361 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2363 ! Local data
2364 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2366 INTEGER :: ierr, efid
2367 REAL :: time, tupdate
2368 real, allocatable :: dumc0(:,:,:)
2369 CHARACTER (LEN=256) :: message, current_date_char, date_string
2370 CHARACTER (LEN=80) :: inpname
2372 #include <wrf_io_flags.h>
2373 ! IF ( grid%id .EQ. 1 ) THEN
2375 CALL domain_clock_get( grid, current_timestr=current_date_char )
2377 CALL construct_filename1 ( inpname , 'wrfchemi' , grid%id , 2 )
2378 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
2379 CALL wrf_message( TRIM(message) )
2381 if( grid%auxinput5_oid .NE. 0 ) then
2382 CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2383 endif
2385 CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
2386 "DATASET=AUXINPUT5", ierr )
2387 IF ( ierr .NE. 0 ) THEN
2388 WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
2389 CALL wrf_error_fatal( TRIM( message ) )
2390 ENDIF
2392 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Read biogenic emissions at time ',&
2393 TRIM(current_date_char)
2394 CALL wrf_message( TRIM(message) )
2396 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input5' )
2397 CALL input_aux_model_input5 ( grid%auxinput5_oid, grid , config_flags , ierr )
2399 CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2401 ! ENDIF
2402 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: exit' )
2404 END SUBROUTINE med_read_wrf_chem_emissopt4
2406 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2407 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2409 SUBROUTINE med_read_wrf_chem_dust_emiss ( grid , config_flags )
2410 ! Driver layer
2411 USE module_domain
2412 USE module_io_domain
2413 USE module_timing
2414 USE module_configure
2415 ! Model layer
2416 USE module_bc_time_utilities
2417 #ifdef DM_PARALLEL
2418 USE module_dm
2419 #endif
2420 USE module_date_time
2421 USE module_utility
2423 IMPLICIT NONE
2425 ! Arguments
2426 TYPE(domain) :: grid
2428 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2430 ! Local data
2431 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2433 INTEGER :: ierr, efid
2434 REAL :: time, tupdate
2435 real, allocatable :: dumc0(:,:,:)
2436 CHARACTER (LEN=256) :: message, current_date_char, date_string
2437 CHARACTER (LEN=80) :: inpname
2439 #include <wrf_io_flags.h>
2440 ! IF ( grid%id .EQ. 1 ) THEN
2442 CALL domain_clock_get( grid, current_timestr=current_date_char )
2444 CALL construct_filename1 ( inpname , 'wrfchemi_dust' , grid%id , 2 )
2445 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_dust_emiss: Open file ',TRIM(inpname)
2446 CALL wrf_message( TRIM(message) )
2448 if( grid%auxinput8_oid .NE. 0 ) then
2449 CALL close_dataset ( grid%auxinput8_oid , config_flags , "DATASET=AUXINPUT8" )
2450 endif
2452 CALL open_r_dataset ( grid%auxinput8_oid, TRIM(inpname) , grid , config_flags, &
2453 "DATASET=AUXINPUT8", ierr )
2454 IF ( ierr .NE. 0 ) THEN
2455 WRITE( message , * ) 'med_read_wrf_chem_dust_emiss: error opening ', TRIM( inpname )
2456 CALL wrf_error_fatal( TRIM( message ) )
2457 ENDIF
2459 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_dust_emiss: Read dust errosion factor at time ',&
2460 TRIM(current_date_char)
2461 CALL wrf_message( TRIM(message) )
2463 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input8' )
2464 CALL input_aux_model_input8 ( grid%auxinput8_oid, grid , config_flags , ierr )
2466 CALL close_dataset ( grid%auxinput8_oid , config_flags , "DATASET=AUXINPUT8" )
2468 ! ENDIF
2469 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_dust_emiss: exit' )
2471 END SUBROUTINE med_read_wrf_chem_dust_emiss
2473 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2474 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2476 SUBROUTINE med_read_wrf_chem_dms_emiss ( grid , config_flags )
2477 ! Driver layer
2478 USE module_domain
2479 USE module_io_domain
2480 USE module_timing
2481 USE module_configure
2482 ! Model layer
2483 USE module_bc_time_utilities
2484 #ifdef DM_PARALLEL
2485 USE module_dm
2486 #endif
2487 USE module_date_time
2488 USE module_utility
2490 IMPLICIT NONE
2492 ! Arguments
2493 TYPE(domain) :: grid
2495 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2497 ! Local data
2498 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2500 INTEGER :: ierr, efid
2501 REAL :: time, tupdate
2502 real, allocatable :: dumc0(:,:,:)
2503 CHARACTER (LEN=256) :: message, current_date_char, date_string
2504 CHARACTER (LEN=80) :: inpname
2506 #include <wrf_io_flags.h>
2507 ! IF ( grid%id .EQ. 1 ) THEN
2509 CALL domain_clock_get( grid, current_timestr=current_date_char )
2511 CALL construct_filename1 ( inpname , 'wrfchemi_dms' , grid%id , 2 )
2512 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_dms_emiss: Open file ',TRIM(inpname)
2513 CALL wrf_message( TRIM(message) )
2515 if( grid%auxinput7_oid .NE. 0 ) then
2516 CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2517 endif
2519 CALL open_r_dataset ( grid%auxinput7_oid, TRIM(inpname) , grid , config_flags, &
2520 "DATASET=AUXINPUT7", ierr )
2521 IF ( ierr .NE. 0 ) THEN
2522 WRITE( message , * ) 'med_read_wrf_chem_dms_emiss: error opening ', TRIM( inpname )
2523 CALL wrf_error_fatal( TRIM( message ) )
2524 ENDIF
2526 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_dms_emiss: Read dms reference fields',&
2527 TRIM(current_date_char)
2528 CALL wrf_message( TRIM(message) )
2530 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input7' )
2531 CALL input_aux_model_input7 ( grid%auxinput7_oid, grid , config_flags , ierr )
2533 CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2535 ! ENDIF
2536 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_dms_emiss: exit' )
2538 END SUBROUTINE med_read_wrf_chem_dms_emiss
2540 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2541 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2543 SUBROUTINE med_read_wrf_chem_gocart_bg ( grid , config_flags )
2544 ! Driver layer
2545 USE module_domain
2546 USE module_io_domain
2547 USE module_timing
2548 USE module_configure
2549 ! Model layer
2550 USE module_bc_time_utilities
2551 #ifdef DM_PARALLEL
2552 USE module_dm
2553 #endif
2554 USE module_date_time
2555 USE module_utility
2557 IMPLICIT NONE
2559 ! Arguments
2560 TYPE(domain) :: grid
2562 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
2564 ! Local data
2565 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
2567 INTEGER :: ierr, efid
2568 REAL :: time, tupdate
2569 real, allocatable :: dumc0(:,:,:)
2570 CHARACTER (LEN=256) :: message, current_date_char, date_string
2571 CHARACTER (LEN=80) :: inpname
2573 #include <wrf_io_flags.h>
2574 ! IF ( grid%id .EQ. 1 ) THEN
2576 CALL domain_clock_get( grid, current_timestr=current_date_char )
2578 CALL construct_filename1 ( inpname , 'wrfchemi_gocart_bg' , grid%id , 2 )
2579 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_gocart_bg: Open file ',TRIM(inpname)
2580 CALL wrf_message( TRIM(message) )
2582 if( grid%auxinput9_oid .NE. 0 ) then
2583 CALL close_dataset ( grid%auxinput9_oid , config_flags , "DATASET=AUXINPUT9" )
2584 endif
2586 CALL open_r_dataset ( grid%auxinput9_oid, TRIM(inpname) , grid , config_flags, &
2587 "DATASET=AUXINPUT9", ierr )
2588 IF ( ierr .NE. 0 ) THEN
2589 WRITE( message , * ) 'med_read_wrf_chem_gocart_bg: error opening ', TRIM( inpname )
2590 CALL wrf_error_fatal( TRIM( message ) )
2591 ENDIF
2593 WRITE(message,*)'mediation_integrate: med_read_wrf_chem_gocart_bg: Read gocart_bg at time ',&
2594 TRIM(current_date_char)
2595 CALL wrf_message( TRIM(message) )
2597 CALL wrf_debug (100 , 'mediation_integrate: calling input_aux_model_input9' )
2598 CALL input_aux_model_input9 ( grid%auxinput9_oid, grid , config_flags , ierr )
2600 CALL close_dataset ( grid%auxinput9_oid , config_flags , "DATASET=AUXINPUT9" )
2602 !
2603 ! CALL wrf_global_to_patch_real ( backg_no3_io , grid%backg_no3 , grid%domdesc, ' ' , 'xyz' , &
2604 ! ids, ide-1 , jds , jde-1 , kds , kde-1, &
2605 ! ims, ime , jms , jme , kms , kme , &
2606 ! ips, ipe , jps , jpe , kps , kpe )
2607 !
2608 ! ENDIF
2609 CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_gocart_bg: exit' )
2611 END SUBROUTINE med_read_wrf_chem_gocart_bg
2613 #endif
2615 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!