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