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