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