real_em.F
References to this file elsewhere.
1 ! Create an initial data set for the WRF model based on real data. This
2 ! program is specifically set up for the Eulerian, mass-based coordinate.
3 PROGRAM real_data
4
5 USE module_machine
6 USE module_domain
7 USE module_initialize_real
8 USE module_io_domain
9 USE module_driver_constants
10 USE module_configure
11 USE module_timing
12 #ifdef WRF_CHEM
13 USE module_input_chem_data
14 USE module_input_chem_bioemiss
15 USE module_input_chem_emissopt3
16 #endif
17 USE module_utility
18 #ifdef DM_PARALLEL
19 USE module_dm
20 #endif
21
22 IMPLICIT NONE
23
24 #ifdef WRF_CHEM
25 ! interface
26 INTERFACE
27 ! mediation-supplied
28 SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
29 USE module_domain
30 TYPE (domain) grid
31 TYPE (grid_config_rec_type) config_flags
32 END SUBROUTINE med_read_wrf_chem_bioemiss
33 END INTERFACE
34 #endif
35
36 REAL :: time , bdyfrq
37
38 INTEGER :: loop , levels_to_process , debug_level
39
40
41 TYPE(domain) , POINTER :: null_domain
42 TYPE(domain) , POINTER :: grid , another_grid
43 TYPE(domain) , POINTER :: grid_ptr , grid_ptr2
44 TYPE (grid_config_rec_type) :: config_flags
45 INTEGER :: number_at_same_level
46
47 INTEGER :: max_dom, domain_id , grid_id , parent_id , parent_id1 , id
48 INTEGER :: e_we , e_sn , i_parent_start , j_parent_start
49 INTEGER :: idum1, idum2
50 #ifdef DM_PARALLEL
51 INTEGER :: nbytes
52 INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
53 INTEGER :: configbuf( configbuflen )
54 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
55 #endif
56 LOGICAL found_the_id
57
58 INTEGER :: ids , ide , jds , jde , kds , kde
59 INTEGER :: ims , ime , jms , jme , kms , kme
60 INTEGER :: ips , ipe , jps , jpe , kps , kpe
61 INTEGER :: ijds , ijde , spec_bdy_width
62 INTEGER :: i , j , k , idts, rc
63 INTEGER :: sibling_count , parent_id_hold , dom_loop
64
65 CHARACTER (LEN=80) :: message
66
67 INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
68 INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
69 INTEGER :: interval_seconds , real_data_init_type
70 INTEGER :: time_loop_max , time_loop
71 real::t1,t2
72 INTERFACE
73 SUBROUTINE Setup_Timekeeping( grid )
74 USE module_domain
75 TYPE(domain), POINTER :: grid
76 END SUBROUTINE Setup_Timekeeping
77 END INTERFACE
78
79 #include "version_decl"
80
81 ! Define the name of this program (program_name defined in module_domain)
82
83 ! NOTE: share/input_wrf.F tests first 7 chars of this name to decide
84 ! whether to read P_TOP as metadata from the SI (yes, if .eq. REAL_EM)
85
86 program_name = "REAL_EM " // TRIM(release_version) // " PREPROCESSOR"
87
88 #ifdef DM_PARALLEL
89 CALL disable_quilting
90 #endif
91
92 ! Initialize the modules used by the WRF system. Many of the CALLs made from the
93 ! init_modules routine are NO-OPs. Typical initializations are: the size of a
94 ! REAL, setting the file handles to a pre-use value, defining moisture and
95 ! chemistry indices, etc.
96
97 CALL wrf_debug ( 100 , 'real_em: calling init_modules ' )
98 CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
99 CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
100 CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
101
102 ! The configuration switches mostly come from the NAMELIST input.
103
104 #ifdef DM_PARALLEL
105 IF ( wrf_dm_on_monitor() ) THEN
106 CALL initial_config
107 END IF
108 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
109 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
110 CALL set_config_as_buffer( configbuf, configbuflen )
111 CALL wrf_dm_initialize
112 #else
113 CALL initial_config
114 #endif
115
116 CALL nl_get_debug_level ( 1, debug_level )
117 CALL set_wrf_debug_level ( debug_level )
118
119 CALL wrf_message ( program_name )
120
121 ! Allocate the space for the mother of all domains.
122
123 NULLIFY( null_domain )
124 CALL wrf_debug ( 100 , 'real_em: calling alloc_and_configure_domain ' )
125 CALL alloc_and_configure_domain ( domain_id = 1 , &
126 grid = head_grid , &
127 parent = null_domain , &
128 kid = -1 )
129
130 grid => head_grid
131 CALL nl_get_max_dom ( 1 , max_dom )
132
133 IF ( model_config_rec%interval_seconds .LE. 0 ) THEN
134 CALL wrf_error_fatal( 'namelist value for interval_seconds must be > 0')
135 END IF
136
137 all_domains : DO domain_id = 1 , max_dom
138
139 IF ( ( model_config_rec%input_from_file(domain_id) ) .OR. &
140 ( domain_id .EQ. 1 ) ) THEN
141
142 IF ( domain_id .GT. 1 ) THEN
143
144 CALL nl_get_grid_id ( domain_id, grid_id )
145 CALL nl_get_parent_id ( domain_id, parent_id )
146 CALL nl_get_e_we ( domain_id, e_we )
147 CALL nl_get_e_sn ( domain_id, e_sn )
148 CALL nl_get_i_parent_start ( domain_id, i_parent_start )
149 CALL nl_get_j_parent_start ( domain_id, j_parent_start )
150 WRITE (message,FMT='(A,2I3,2I4,2I3)') &
151 'new allocated domain: id, par id, dims i/j, start i/j =', &
152 grid_id, parent_id, e_we, e_sn, i_parent_start, j_parent_start
153
154 CALL wrf_debug ( 100 , message )
155 CALL nl_get_grid_id ( parent_id, grid_id )
156 CALL nl_get_parent_id ( parent_id, parent_id1 )
157 CALL nl_get_e_we ( parent_id, e_we )
158 CALL nl_get_e_sn ( parent_id, e_sn )
159 CALL nl_get_i_parent_start ( parent_id, i_parent_start )
160 CALL nl_get_j_parent_start ( parent_id, j_parent_start )
161 WRITE (message,FMT='(A,2I3,2I4,2I3)') &
162 'parent domain: id, par id, dims i/j, start i/j =', &
163 grid_id, parent_id1, e_we, e_sn, i_parent_start, j_parent_start
164 CALL wrf_debug ( 100 , message )
165
166 CALL nl_get_grid_id ( domain_id, grid_id )
167 CALL nl_get_parent_id ( domain_id, parent_id )
168 CALL nl_get_e_we ( domain_id, e_we )
169 CALL nl_get_e_sn ( domain_id, e_sn )
170 CALL nl_get_i_parent_start ( domain_id, i_parent_start )
171 CALL nl_get_j_parent_start ( domain_id, j_parent_start )
172 grid_ptr2 => head_grid
173 found_the_id = .FALSE.
174 CALL find_my_parent ( grid_ptr2 , grid_ptr , domain_id , parent_id , found_the_id )
175 IF ( found_the_id ) THEN
176
177 sibling_count = 0
178 DO dom_loop = 2 , domain_id
179 CALL nl_get_parent_id ( dom_loop, parent_id_hold )
180 IF ( parent_id_hold .EQ. parent_id ) THEN
181 sibling_count = sibling_count + 1
182 END IF
183 END DO
184 CALL alloc_and_configure_domain ( domain_id = domain_id , &
185 grid = another_grid , &
186 parent = grid_ptr , &
187 kid = sibling_count )
188 grid => another_grid
189 ELSE
190 CALL wrf_error_fatal( 'real_em.F: Could not find the parent domain')
191 END IF
192 END IF
193
194 CALL Setup_Timekeeping ( grid )
195 CALL set_current_grid_ptr( grid )
196 CALL domain_clockprint ( 150, grid, &
197 'DEBUG real: clock after Setup_Timekeeping,' )
198 CALL domain_clock_set( grid, &
199 time_step_seconds=model_config_rec%interval_seconds )
200 CALL domain_clockprint ( 150, grid, &
201 'DEBUG real: clock after timeStep set,' )
202
203
204 CALL wrf_debug ( 100 , 'real_em: calling set_scalar_indices_from_config ' )
205 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
206
207 CALL wrf_debug ( 100 , 'real_em: calling model_to_grid_config_rec ' )
208 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
209
210 ! Initialize the WRF IO: open files, init file handles, etc.
211
212 CALL wrf_debug ( 100 , 'real_em: calling init_wrfio' )
213 CALL init_wrfio
214
215 ! Some of the configuration values may have been modified from the initial READ
216 ! of the NAMELIST, so we re-broadcast the configuration records.
217
218 #ifdef DM_PARALLEL
219 CALL wrf_debug ( 100 , 'real_em: re-broadcast the configuration records' )
220 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
221 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
222 CALL set_config_as_buffer( configbuf, configbuflen )
223 #endif
224
225 ! No looping in this layer.
226
227 CALL wrf_debug ( 100 , 'calling med_sidata_input' )
228 CALL med_sidata_input ( grid , config_flags )
229 CALL wrf_debug ( 100 , 'backfrom med_sidata_input' )
230
231 ELSE
232 CYCLE all_domains
233 END IF
234
235 END DO all_domains
236
237 CALL set_current_grid_ptr( head_grid )
238
239 ! We are done.
240
241 CALL wrf_debug ( 0 , 'real_em: SUCCESS COMPLETE REAL_EM INIT' )
242
243 CALL wrf_shutdown
244
245 CALL WRFU_Finalize( rc=rc )
246
247 END PROGRAM real_data
248
249 SUBROUTINE med_sidata_input ( grid , config_flags )
250 ! Driver layer
251 USE module_domain
252 USE module_io_domain
253 ! Model layer
254 USE module_configure
255 USE module_bc_time_utilities
256 USE module_initialize_real
257 USE module_optional_si_input
258 #ifdef WRF_CHEM
259 USE module_input_chem_data
260 USE module_input_chem_bioemiss
261 USE module_input_chem_emissopt3
262 #endif
263
264 USE module_date_time
265 USE module_utility
266
267 IMPLICIT NONE
268
269
270 ! Interface
271 INTERFACE
272 SUBROUTINE start_domain ( grid , allowed_to_read ) ! comes from module_start in appropriate dyn_ directory
273 USE module_domain
274 TYPE (domain) grid
275 LOGICAL, INTENT(IN) :: allowed_to_read
276 END SUBROUTINE start_domain
277 END INTERFACE
278
279 ! Arguments
280 TYPE(domain) :: grid
281 TYPE (grid_config_rec_type) :: config_flags
282 ! Local
283 INTEGER :: time_step_begin_restart
284 INTEGER :: idsi , ierr , myproc
285 CHARACTER (LEN=80) :: si_inpname
286 CHARACTER (LEN=80) :: message
287
288 CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
289
290 INTEGER :: time_loop_max , loop, rc
291 INTEGER :: julyr , julday
292 REAL :: gmt
293 real::t1,t2,t3,t4
294
295 grid%input_from_file = .true.
296 grid%input_from_file = .false.
297
298 CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
299 model_config_rec%start_month (grid%id) , &
300 model_config_rec%start_day (grid%id) , &
301 model_config_rec%start_hour (grid%id) , &
302 model_config_rec%start_minute(grid%id) , &
303 model_config_rec%start_second(grid%id) , &
304 model_config_rec% end_year (grid%id) , &
305 model_config_rec% end_month (grid%id) , &
306 model_config_rec% end_day (grid%id) , &
307 model_config_rec% end_hour (grid%id) , &
308 model_config_rec% end_minute(grid%id) , &
309 model_config_rec% end_second(grid%id) , &
310 model_config_rec%interval_seconds , &
311 model_config_rec%real_data_init_type , &
312 start_date_char , end_date_char , time_loop_max )
313
314 ! Override stop time with value computed above.
315 CALL domain_clock_set( grid, stop_timestr=end_date_char )
316
317 ! TBH: for now, turn off stop time and let it run data-driven
318 CALL WRFU_ClockStopTimeDisable( grid%domain_clock, rc=rc )
319 CALL wrf_check_error( WRFU_SUCCESS, rc, &
320 'WRFU_ClockStopTimeDisable(grid%domain_clock) FAILED', &
321 __FILE__ , &
322 __LINE__ )
323 CALL domain_clockprint ( 150, grid, &
324 'DEBUG med_sidata_input: clock after stopTime set,' )
325
326 ! Here we define the initial time to process, for later use by the code.
327
328 current_date_char = start_date_char
329 start_date = start_date_char // '.0000'
330 current_date = start_date
331
332 CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
333
334 !!!!!!! Loop over each time period to process.
335
336 CALL cpu_time ( t1 )
337 DO loop = 1 , time_loop_max
338
339 internal_time_loop = loop
340 IF ( ( grid%id .GT. 1 ) .AND. ( loop .GT. 1 ) .AND. &
341 ( model_config_rec%grid_fdda(grid%id) .EQ. 0 ) .AND. &
342 ( model_config_rec%sst_update .EQ. 0 ) ) EXIT
343
344 print *,' '
345 print *,'-----------------------------------------------------------------------------'
346 print *,' '
347 print '(A,I2,A,A,A,I4,A,I4)' , &
348 ' Domain ',grid%id,': Current date being processed: ',current_date, ', which is loop #',loop,' out of ',time_loop_max
349
350 ! After current_date has been set, fill in the julgmt stuff.
351
352 CALL geth_julgmt ( config_flags%julyr , config_flags%julday , config_flags%gmt )
353
354 print *,'configflags%julyr, %julday, %gmt:',config_flags%julyr, config_flags%julday, config_flags%gmt
355 ! Now that the specific Julian info is available, save these in the model config record.
356
357 CALL nl_set_gmt (grid%id, config_flags%gmt)
358 CALL nl_set_julyr (grid%id, config_flags%julyr)
359 CALL nl_set_julday (grid%id, config_flags%julday)
360
361 ! Open the input file for real. This is either the "new" one or the "old" one. The "new" one could have
362 ! a suffix for the type of the data format. Check to see if either is around.
363
364 CALL cpu_time ( t3 )
365 IF ( grid%dyn_opt .EQ. dyn_em ) THEN
366 WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ', &
367 TRIM(config_flags%auxinput1_inname)
368 CALL wrf_debug ( 100 , wrf_err_message )
369 IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
370 CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
371 current_date_char , config_flags%io_form_auxinput1 )
372 ELSE
373 CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
374 current_date_char )
375 END IF
376 CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
377 IF ( ierr .NE. 0 ) THEN
378 CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // &
379 ' for input; bad date in namelist or file not in directory' )
380 END IF
381 END IF
382
383 ! Input data.
384
385 CALL wrf_debug ( 100 , 'med_sidata_input: calling input_aux_model_input1' )
386 CALL input_aux_model_input1 ( idsi , grid , config_flags , ierr )
387 CALL cpu_time ( t4 )
388 WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for input ',NINT(t4-t3) ,' s.'
389 CALL wrf_debug( 0, wrf_err_message )
390
391 ! Possible optional SI input. This sets flags used by init_domain.
392
393 CALL cpu_time ( t3 )
394 IF ( loop .EQ. 1 ) THEN
395 already_been_here = .FALSE.
396 CALL wrf_debug ( 100 , 'med_sidata_input: calling init_module_optional_si_input' )
397 CALL init_module_optional_si_input ( grid , config_flags )
398 END IF
399 CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
400 CALL optional_si_input ( grid , idsi )
401
402 ! Initialize the mother domain for this time period with input data.
403
404 CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
405 grid%input_from_file = .true.
406 CALL init_domain ( grid )
407 CALL cpu_time ( t4 )
408 WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for processing ',NINT(t4-t3) ,' s.'
409 CALL wrf_debug( 0, wrf_err_message )
410 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
411
412 ! Close this file that is output from the SI and input to this pre-proc.
413
414 CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
415 CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
416
417 ! CALL start_domain ( grid , .TRUE. )
418
419 #ifdef WRF_CHEM
420 IF ( loop == 1 ) THEN
421 IF( grid%chem_opt > 0 ) then
422 ! Read the chemistry data from a previous wrf forecast (wrfout file)
423 IF(grid%chem_in_opt == 1 ) THEN
424 message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
425 CALL wrf_message ( message )
426
427 CALL input_ext_chem_file( grid )
428 ! IF(grid%emiss_inpt_opt == 3 ) THEN
429 ! message = 'READING EMISSIONS DATA OPT 3'
430 ! CALL wrf_message ( message )
431 ! CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
432 ! END IF
433
434 IF(grid%bio_emiss_opt == 2 ) THEN
435 message = 'READING BEIS3.11 EMISSIONS DATA'
436 CALL wrf_message ( message )
437 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
438 else IF(grid%bio_emiss_opt == 3 ) THEN !shc
439 message = 'READING MEGAN 2 EMISSIONS DATA'
440 CALL wrf_message ( message )
441 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
442 END IF
443
444 ELSEIF(grid%chem_in_opt == 0)then
445 ! Generate chemistry data from a idealized vertical profile
446 message = 'STARTING WITH BACKGROUND CHEMISTRY '
447 CALL wrf_message ( message )
448
449 CALL input_chem_profile ( grid )
450
451 IF(grid%bio_emiss_opt == 2 ) THEN
452 message = 'READING BEIS3.11 EMISSIONS DATA'
453 CALL wrf_message ( message )
454 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
455 else IF(grid%bio_emiss_opt == 3 ) THEN !shc
456 message = 'READING MEGAN 2 EMISSIONS DATA'
457 CALL wrf_message ( message )
458 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
459 END IF
460 ! IF(grid%emiss_inpt_opt == 3 ) THEN
461 ! message = 'READING EMISSIONS DATA OPT 3'
462 ! CALL wrf_message ( message )
463 ! CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
464 ! END IF
465
466 ELSE
467 message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
468 CALL wrf_message ( message )
469 END IF
470 END IF
471 END IF
472 #endif
473
474 CALL cpu_time ( t3 )
475 CALL assemble_output ( grid , config_flags , loop , time_loop_max )
476 CALL cpu_time ( t4 )
477 WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for output ',NINT(t4-t3) ,' s.'
478 CALL wrf_debug( 0, wrf_err_message )
479 CALL cpu_time ( t2 )
480 WRITE ( wrf_err_message , FMT='(A,I4,A,I10,A)' ) 'Timing for loop # ',loop,' = ',NINT(t2-t1) ,' s.'
481 CALL wrf_debug( 0, wrf_err_message )
482
483 ! If this is not the last time, we define the next time that we are going to process.
484
485 IF ( loop .NE. time_loop_max ) THEN
486 CALL geth_newdate ( current_date_char , start_date_char , loop * model_config_rec%interval_seconds )
487 current_date = current_date_char // '.0000'
488 CALL domain_clockprint ( 150, grid, &
489 'DEBUG med_sidata_input: clock before current_date set,' )
490 WRITE (wrf_err_message,*) &
491 'DEBUG med_sidata_input: before currTime set, current_date = ',TRIM(current_date)
492 CALL wrf_debug ( 150 , wrf_err_message )
493 CALL domain_clock_set( grid, current_date(1:19) )
494 CALL domain_clockprint ( 150, grid, &
495 'DEBUG med_sidata_input: clock after current_date set,' )
496 END IF
497 CALL cpu_time ( t1 )
498 END DO
499
500 END SUBROUTINE med_sidata_input
501
502 SUBROUTINE compute_si_start_and_end ( &
503 start_year , start_month , start_day , start_hour , start_minute , start_second , &
504 end_year , end_month , end_day , end_hour , end_minute , end_second , &
505 interval_seconds , real_data_init_type , &
506 start_date_char , end_date_char , time_loop_max )
507
508 USE module_date_time
509
510 IMPLICIT NONE
511
512 INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
513 INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
514 INTEGER :: interval_seconds , real_data_init_type
515 INTEGER :: time_loop_max , time_loop
516
517 CHARACTER(LEN=19) :: current_date_char , start_date_char , end_date_char , next_date_char
518
519 #ifdef PLANET
520 WRITE ( start_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
521 start_year,start_day,start_hour,start_minute,start_second
522 WRITE ( end_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
523 end_year, end_day, end_hour, end_minute, end_second
524 #else
525 WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
526 start_year,start_month,start_day,start_hour,start_minute,start_second
527 WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
528 end_year, end_month, end_day, end_hour, end_minute, end_second
529 #endif
530
531 IF ( end_date_char .LT. start_date_char ) THEN
532 CALL wrf_error_fatal( 'Ending date in namelist ' // end_date_char // ' prior to beginning date ' // start_date_char )
533 END IF
534
535 ! start_date = start_date_char // '.0000'
536
537 ! Figure out our loop count for the processing times.
538
539 time_loop = 1
540 PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',start_date_char,'.'
541 current_date_char = start_date_char
542 loop_count : DO
543 CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
544 IF ( next_date_char .LT. end_date_char ) THEN
545 time_loop = time_loop + 1
546 PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
547 current_date_char = next_date_char
548 ELSE IF ( next_date_char .EQ. end_date_char ) THEN
549 time_loop = time_loop + 1
550 PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
551 PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
552 time_loop_max = time_loop
553 EXIT loop_count
554 ELSE IF ( next_date_char .GT. end_date_char ) THEN
555 PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
556 time_loop_max = time_loop
557 EXIT loop_count
558 END IF
559 END DO loop_count
560 END SUBROUTINE compute_si_start_and_end
561
562 SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
563
564 USE module_big_step_utilities_em
565 USE module_domain
566 USE module_io_domain
567 USE module_configure
568 USE module_date_time
569 USE module_bc
570 IMPLICIT NONE
571
572 TYPE(domain) :: grid
573 TYPE (grid_config_rec_type) :: config_flags
574 INTEGER , INTENT(IN) :: loop , time_loop_max
575
576 INTEGER :: ids , ide , jds , jde , kds , kde
577 INTEGER :: ims , ime , jms , jme , kms , kme
578 INTEGER :: ips , ipe , jps , jpe , kps , kpe
579 INTEGER :: ijds , ijde , spec_bdy_width
580 INTEGER :: i , j , k , idts
581
582 INTEGER :: id1 , interval_seconds , ierr, rc, sst_update, grid_fdda
583 INTEGER , SAVE :: id, id2, id4
584 CHARACTER (LEN=80) :: inpname , bdyname
585 CHARACTER(LEN= 4) :: loop_char
586 character *19 :: temp19
587 character *24 :: temp24 , temp24b
588
589 REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
590 REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp1
591 REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
592 REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp2
593 real::t1,t2
594
595 ! Various sizes that we need to be concerned about.
596
597 ids = grid%sd31
598 ide = grid%ed31
599 kds = grid%sd32
600 kde = grid%ed32
601 jds = grid%sd33
602 jde = grid%ed33
603
604 ims = grid%sm31
605 ime = grid%em31
606 kms = grid%sm32
607 kme = grid%em32
608 jms = grid%sm33
609 jme = grid%em33
610
611 ips = grid%sp31
612 ipe = grid%ep31
613 kps = grid%sp32
614 kpe = grid%ep32
615 jps = grid%sp33
616 jpe = grid%ep33
617
618 ijds = MIN ( ids , jds )
619 ijde = MAX ( ide , jde )
620
621 ! Boundary width, scalar value.
622
623 spec_bdy_width = model_config_rec%spec_bdy_width
624 interval_seconds = model_config_rec%interval_seconds
625 sst_update = model_config_rec%sst_update
626 grid_fdda = model_config_rec%grid_fdda(grid%id)
627
628
629 IF ( loop .EQ. 1 ) THEN
630
631 IF ( time_loop_max .NE. 1 ) THEN
632
633 ! This is the space needed to save the current 3d data for use in computing
634 ! the lateral boundary tendencies.
635
636 IF ( ALLOCATED ( ubdy3dtemp1 ) ) DEALLOCATE ( ubdy3dtemp1 )
637 IF ( ALLOCATED ( vbdy3dtemp1 ) ) DEALLOCATE ( vbdy3dtemp1 )
638 IF ( ALLOCATED ( tbdy3dtemp1 ) ) DEALLOCATE ( tbdy3dtemp1 )
639 IF ( ALLOCATED ( pbdy3dtemp1 ) ) DEALLOCATE ( pbdy3dtemp1 )
640 IF ( ALLOCATED ( qbdy3dtemp1 ) ) DEALLOCATE ( qbdy3dtemp1 )
641 IF ( ALLOCATED ( mbdy2dtemp1 ) ) DEALLOCATE ( mbdy2dtemp1 )
642 IF ( ALLOCATED ( ubdy3dtemp2 ) ) DEALLOCATE ( ubdy3dtemp2 )
643 IF ( ALLOCATED ( vbdy3dtemp2 ) ) DEALLOCATE ( vbdy3dtemp2 )
644 IF ( ALLOCATED ( tbdy3dtemp2 ) ) DEALLOCATE ( tbdy3dtemp2 )
645 IF ( ALLOCATED ( pbdy3dtemp2 ) ) DEALLOCATE ( pbdy3dtemp2 )
646 IF ( ALLOCATED ( qbdy3dtemp2 ) ) DEALLOCATE ( qbdy3dtemp2 )
647 IF ( ALLOCATED ( mbdy2dtemp2 ) ) DEALLOCATE ( mbdy2dtemp2 )
648
649 ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
650 ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
651 ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
652 ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
653 ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
654 ALLOCATE ( mbdy2dtemp1(ims:ime,1:1, jms:jme) )
655 ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
656 ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
657 ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
658 ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
659 ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
660 ALLOCATE ( mbdy2dtemp2(ims:ime,1:1, jms:jme) )
661
662 END IF
663
664 ! Open the wrfinput file. From this program, this is an *output* file.
665
666 CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
667 CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
668 IF ( ierr .NE. 0 ) THEN
669 CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
670 END IF
671 CALL output_model_input ( id1, grid , config_flags , ierr )
672 CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
673
674 IF ( time_loop_max .NE. 1 ) THEN
675 IF(sst_update .EQ. 1)THEN
676 CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
677 CALL open_w_dataset ( id4, TRIM(inpname) , grid , config_flags , output_aux_model_input4 , "DATASET=AUXINPUT4", ierr )
678 IF ( ierr .NE. 0 ) THEN
679 CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
680 END IF
681 CALL output_aux_model_input4 ( id4, grid , config_flags , ierr )
682 END IF
683 END IF
684
685 IF ( time_loop_max .NE. 1 ) THEN
686
687 ! We need to save the 3d data to compute a difference during the next loop. Couple the
688 ! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
689
690 ! u, theta, h, scalars coupled with my; v coupled with mx
691 CALL couple ( grid%em_mu_2 , grid%em_mub , ubdy3dtemp1 , grid%em_u_2 , 'u' , grid%msfuy , &
692 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
693 CALL couple ( grid%em_mu_2 , grid%em_mub , vbdy3dtemp1 , grid%em_v_2 , 'v' , grid%msfvx , &
694 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
695 CALL couple ( grid%em_mu_2 , grid%em_mub , tbdy3dtemp1 , grid%em_t_2 , 't' , grid%msfty , &
696 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
697 CALL couple ( grid%em_mu_2 , grid%em_mub , pbdy3dtemp1 , grid%em_ph_2 , 'h' , grid%msfty , &
698 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
699 CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , &
700 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
701
702 DO j = jps , MIN(jde-1,jpe)
703 DO i = ips , MIN(ide-1,ipe)
704 mbdy2dtemp1(i,1,j) = grid%em_mu_2(i,j)
705 END DO
706 END DO
707
708 END IF
709
710 IF(grid_fdda .EQ. 1)THEN
711 DO j = jps , jpe
712 DO k = kps , kpe
713 DO i = ips , ipe
714 grid%fdda3d(i,k,j,p_u_ndg_old) = grid%em_u_2(i,k,j)
715 grid%fdda3d(i,k,j,p_v_ndg_old) = grid%em_v_2(i,k,j)
716 grid%fdda3d(i,k,j,p_t_ndg_old) = grid%em_t_2(i,k,j)
717 grid%fdda3d(i,k,j,p_q_ndg_old) = grid%moist(i,k,j,P_QV)
718 grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%em_ph_2(i,k,j)
719 END DO
720 END DO
721 END DO
722
723 DO j = jps , jpe
724 DO i = ips , ipe
725 grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%em_mu_2(i,j)
726 END DO
727 END DO
728 END IF
729
730 IF ( time_loop_max .NE. 1 ) THEN
731
732 ! There are 2 components to the lateral boundaries. First, there is the starting
733 ! point of this time period - just the outer few rows and columns.
734
735 CALL stuff_bdy ( ubdy3dtemp1 , grid%em_u_bxs, grid%em_u_bxe, grid%em_u_bys, grid%em_u_bye, &
736 'U' , spec_bdy_width , &
737 ids , ide , jds , jde , kds , kde , &
738 ims , ime , jms , jme , kms , kme , &
739 ips , ipe , jps , jpe , kps , kpe )
740 CALL stuff_bdy ( vbdy3dtemp1 , grid%em_v_bxs, grid%em_v_bxe, grid%em_v_bys, grid%em_v_bye, &
741 'V' , spec_bdy_width , &
742 ids , ide , jds , jde , kds , kde , &
743 ims , ime , jms , jme , kms , kme , &
744 ips , ipe , jps , jpe , kps , kpe )
745 CALL stuff_bdy ( tbdy3dtemp1 , grid%em_t_bxs, grid%em_t_bxe, grid%em_t_bys, grid%em_t_bye, &
746 'T' , spec_bdy_width , &
747 ids , ide , jds , jde , kds , kde , &
748 ims , ime , jms , jme , kms , kme , &
749 ips , ipe , jps , jpe , kps , kpe )
750 CALL stuff_bdy ( pbdy3dtemp1 , grid%em_ph_bxs, grid%em_ph_bxe, grid%em_ph_bys, grid%em_ph_bye, &
751 'W' , spec_bdy_width , &
752 ids , ide , jds , jde , kds , kde , &
753 ims , ime , jms , jme , kms , kme , &
754 ips , ipe , jps , jpe , kps , kpe )
755 CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV), &
756 grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV), &
757 'T' , spec_bdy_width , &
758 ids , ide , jds , jde , kds , kde , &
759 ims , ime , jms , jme , kms , kme , &
760 ips , ipe , jps , jpe , kps , kpe )
761 CALL stuff_bdy ( mbdy2dtemp1 , grid%em_mu_bxs, grid%em_mu_bxe, grid%em_mu_bys, grid%em_mu_bye, &
762 'M' , spec_bdy_width , &
763 ids , ide , jds , jde , 1 , 1 , &
764 ims , ime , jms , jme , 1 , 1 , &
765 ips , ipe , jps , jpe , 1 , 1 )
766 END IF
767
768
769 ELSE IF ( loop .GT. 1 ) THEN
770
771 IF(sst_update .EQ. 1)THEN
772 CALL output_aux_model_input4 ( id4, grid , config_flags , ierr )
773 END IF
774
775 ! Open the boundary and the fdda file.
776
777 IF ( loop .eq. 2 ) THEN
778 IF(grid%id .eq. 1)THEN
779 CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
780 CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
781 IF ( ierr .NE. 0 ) THEN
782 CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
783 END IF
784 END IF
785 IF(grid_fdda .EQ. 1)THEN
786 CALL construct_filename1( inpname , 'wrffdda' , grid%id , 2 )
787 CALL open_w_dataset ( id2, TRIM(inpname) , grid , config_flags , output_aux_model_input10 , "DATASET=AUXINPUT10", ierr )
788 IF ( ierr .NE. 0 ) THEN
789 CALL wrf_error_fatal( 'real: error opening wrffdda for writing' )
790 END IF
791 END IF
792 ELSE
793 IF ( .NOT. domain_clockisstoptime(grid) ) THEN
794 CALL domain_clockadvance( grid )
795 CALL domain_clockprint ( 150, grid, &
796 'DEBUG assemble_output: clock after ClockAdvance,' )
797 END IF
798 END IF
799
800
801 ! Couple this time period's data with total mu, and save it in the *bdy3dtemp2 arrays.
802
803 ! u, theta, h, scalars coupled with my; v coupled with mx
804 CALL couple ( grid%em_mu_2 , grid%em_mub , ubdy3dtemp2 , grid%em_u_2 , 'u' , grid%msfuy , &
805 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
806 CALL couple ( grid%em_mu_2 , grid%em_mub , vbdy3dtemp2 , grid%em_v_2 , 'v' , grid%msfvx , &
807 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
808 CALL couple ( grid%em_mu_2 , grid%em_mub , tbdy3dtemp2 , grid%em_t_2 , 't' , grid%msfty , &
809 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
810 CALL couple ( grid%em_mu_2 , grid%em_mub , pbdy3dtemp2 , grid%em_ph_2 , 'h' , grid%msfty , &
811 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
812 CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , &
813 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
814
815 DO j = jps , jpe
816 DO i = ips , ipe
817 mbdy2dtemp2(i,1,j) = grid%em_mu_2(i,j)
818 END DO
819 END DO
820
821 IF(grid_fdda .EQ. 1)THEN
822 DO j = jps , jpe
823 DO k = kps , kpe
824 DO i = ips , ipe
825 grid%fdda3d(i,k,j,p_u_ndg_new) = grid%em_u_2(i,k,j)
826 grid%fdda3d(i,k,j,p_v_ndg_new) = grid%em_v_2(i,k,j)
827 grid%fdda3d(i,k,j,p_t_ndg_new) = grid%em_t_2(i,k,j)
828 grid%fdda3d(i,k,j,p_q_ndg_new) = grid%moist(i,k,j,P_QV)
829 grid%fdda3d(i,k,j,p_ph_ndg_new) = grid%em_ph_2(i,k,j)
830 END DO
831 END DO
832 END DO
833
834 DO j = jps , jpe
835 DO i = ips , ipe
836 grid%fdda2d(i,1,j,p_mu_ndg_new) = grid%em_mu_2(i,j)
837 END DO
838 END DO
839 END IF
840
841 ! During all of the loops after the first loop, we first compute the boundary
842 ! tendencies with the current data values (*bdy3dtemp2 arrays) and the previously
843 ! saved information stored in the *bdy3dtemp1 arrays.
844
845 CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds) , &
846 grid%em_u_btxs, grid%em_u_btxe, &
847 grid%em_u_btys, grid%em_u_btye, &
848 'U' , &
849 spec_bdy_width , &
850 ids , ide , jds , jde , kds , kde , &
851 ims , ime , jms , jme , kms , kme , &
852 ips , ipe , jps , jpe , kps , kpe )
853 CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds) , &
854 grid%em_v_btxs, grid%em_v_btxe, &
855 grid%em_v_btys, grid%em_v_btye, &
856 'V' , &
857 spec_bdy_width , &
858 ids , ide , jds , jde , kds , kde , &
859 ims , ime , jms , jme , kms , kme , &
860 ips , ipe , jps , jpe , kps , kpe )
861 CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds) , &
862 grid%em_t_btxs, grid%em_t_btxe, &
863 grid%em_t_btys, grid%em_t_btye, &
864 'T' , &
865 spec_bdy_width , &
866 ids , ide , jds , jde , kds , kde , &
867 ims , ime , jms , jme , kms , kme , &
868 ips , ipe , jps , jpe , kps , kpe )
869 CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , REAL(interval_seconds) , &
870 grid%em_ph_btxs, grid%em_ph_btxe, &
871 grid%em_ph_btys, grid%em_ph_btye, &
872 'W' , &
873 spec_bdy_width , &
874 ids , ide , jds , jde , kds , kde , &
875 ims , ime , jms , jme , kms , kme , &
876 ips , ipe , jps , jpe , kps , kpe )
877 CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , &
878 grid%moist_btxs(:,:,:,P_QV), grid%moist_btxe(:,:,:,P_QV), &
879 grid%moist_btys(:,:,:,P_QV), grid%moist_btye(:,:,:,P_QV), &
880 'T' , &
881 spec_bdy_width , &
882 ids , ide , jds , jde , kds , kde , &
883 ims , ime , jms , jme , kms , kme , &
884 ips , ipe , jps , jpe , kps , kpe )
885 CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , REAL(interval_seconds) , &
886 grid%em_mu_btxs, grid%em_mu_btxe, &
887 grid%em_mu_btys, grid%em_mu_btye, &
888 'M' , &
889 spec_bdy_width , &
890 ids , ide , jds , jde , 1 , 1 , &
891 ims , ime , jms , jme , 1 , 1 , &
892 ips , ipe , jps , jpe , 1 , 1 )
893
894 ! Both pieces of the boundary data are now available to be written (initial time and tendency).
895 ! This looks ugly, these date shifting things. What's it for? We want the "Times" variable
896 ! in the lateral BDY file to have the valid times of when the initial fields are written.
897 ! That's what the loop-2 thingy is for with the start date. We increment the start_date so
898 ! that the starting time in the attributes is the second time period. Why you may ask. I
899 ! agree, why indeed.
900
901 CALL domain_clockprint ( 150, grid, &
902 'DEBUG assemble_output: clock before 1st current_date set,' )
903 WRITE (wrf_err_message,*) &
904 'DEBUG assemble_output: before 1st currTime set, current_date = ',TRIM(current_date)
905 CALL wrf_debug ( 150 , wrf_err_message )
906 CALL domain_clock_set( grid, current_date(1:19) )
907 CALL domain_clockprint ( 150, grid, &
908 'DEBUG assemble_output: clock after 1st current_date set,' )
909
910 temp24= current_date
911 temp24b=start_date
912 start_date = current_date
913 CALL geth_newdate ( temp19 , temp24b(1:19) , (loop-2) * model_config_rec%interval_seconds )
914 current_date = temp19 // '.0000'
915 CALL domain_clockprint ( 150, grid, &
916 'DEBUG assemble_output: clock before 2nd current_date set,' )
917 WRITE (wrf_err_message,*) &
918 'DEBUG assemble_output: before 2nd currTime set, current_date = ',TRIM(current_date)
919 CALL wrf_debug ( 150 , wrf_err_message )
920 CALL domain_clock_set( grid, current_date(1:19) )
921 CALL domain_clockprint ( 150, grid, &
922 'DEBUG assemble_output: clock after 2nd current_date set,' )
923
924 ! Output boundary file.
925
926 IF(grid%id .EQ. 1)THEN
927 print *,'LBC valid between these times ',current_date, ' ',start_date
928 CALL output_boundary ( id, grid , config_flags , ierr )
929 END IF
930
931 ! Output gridded/analysis FDDA file.
932
933 IF(grid_fdda .EQ. 1) THEN
934 CALL output_aux_model_input10 ( id2, grid , config_flags , ierr )
935 END IF
936
937 current_date = temp24
938 start_date = temp24b
939 CALL domain_clockprint ( 150, grid, &
940 'DEBUG assemble_output: clock before 3rd current_date set,' )
941 WRITE (wrf_err_message,*) &
942 'DEBUG assemble_output: before 3rd currTime set, current_date = ',TRIM(current_date)
943 CALL wrf_debug ( 150 , wrf_err_message )
944 CALL domain_clock_set( grid, current_date(1:19) )
945 CALL domain_clockprint ( 150, grid, &
946 'DEBUG assemble_output: clock after 3rd current_date set,' )
947
948 ! OK, for all of the loops, we output the initialzation data, which would allow us to
949 ! start the model at any of the available analysis time periods.
950
951 ! WRITE ( loop_char , FMT = '(I4.4)' ) loop
952 ! CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
953 ! IF ( ierr .NE. 0 ) THEN
954 ! CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
955 ! END IF
956
957 ! CALL calc_current_date ( grid%id , 0. )
958 ! CALL output_model_input ( id1, grid , config_flags , ierr )
959 ! CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
960
961 ! Is this or is this not the last time time? We can remove some unnecessary
962 ! stores if it is not.
963
964 IF ( loop .LT. time_loop_max ) THEN
965
966 ! We need to save the 3d data to compute a difference during the next loop. Couple the
967 ! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
968 ! We load up the boundary data again for use in the next loop.
969
970 DO j = jps , jpe
971 DO k = kps , kpe
972 DO i = ips , ipe
973 ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
974 vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
975 tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
976 pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
977 qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
978 END DO
979 END DO
980 END DO
981
982 DO j = jps , jpe
983 DO i = ips , ipe
984 mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
985 END DO
986 END DO
987
988 IF(grid_fdda .EQ. 1)THEN
989 DO j = jps , jpe
990 DO k = kps , kpe
991 DO i = ips , ipe
992 grid%fdda3d(i,k,j,p_u_ndg_old) = grid%fdda3d(i,k,j,p_u_ndg_new)
993 grid%fdda3d(i,k,j,p_v_ndg_old) = grid%fdda3d(i,k,j,p_v_ndg_new)
994 grid%fdda3d(i,k,j,p_t_ndg_old) = grid%fdda3d(i,k,j,p_t_ndg_new)
995 grid%fdda3d(i,k,j,p_q_ndg_old) = grid%fdda3d(i,k,j,p_q_ndg_new)
996 grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%fdda3d(i,k,j,p_ph_ndg_new)
997 END DO
998 END DO
999 END DO
1000
1001 DO j = jps , jpe
1002 DO i = ips , ipe
1003 grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%fdda2d(i,1,j,p_mu_ndg_new)
1004 END DO
1005 END DO
1006 END IF
1007
1008 ! There are 2 components to the lateral boundaries. First, there is the starting
1009 ! point of this time period - just the outer few rows and columns.
1010
1011 CALL stuff_bdy ( ubdy3dtemp1 , grid%em_u_bxs, grid%em_u_bxe, grid%em_u_bys, grid%em_u_bye, &
1012 'U' , spec_bdy_width , &
1013 ids , ide , jds , jde , kds , kde , &
1014 ims , ime , jms , jme , kms , kme , &
1015 ips , ipe , jps , jpe , kps , kpe )
1016 CALL stuff_bdy ( vbdy3dtemp1 , grid%em_v_bxs, grid%em_v_bxe, grid%em_v_bys, grid%em_v_bye, &
1017 'V' , spec_bdy_width , &
1018 ids , ide , jds , jde , kds , kde , &
1019 ims , ime , jms , jme , kms , kme , &
1020 ips , ipe , jps , jpe , kps , kpe )
1021 CALL stuff_bdy ( tbdy3dtemp1 , grid%em_t_bxs, grid%em_t_bxe, grid%em_t_bys, grid%em_t_bye, &
1022 'T' , spec_bdy_width , &
1023 ids , ide , jds , jde , kds , kde , &
1024 ims , ime , jms , jme , kms , kme , &
1025 ips , ipe , jps , jpe , kps , kpe )
1026 CALL stuff_bdy ( pbdy3dtemp1 , grid%em_ph_bxs, grid%em_ph_bxe, grid%em_ph_bys, grid%em_ph_bye, &
1027 'W' , spec_bdy_width , &
1028 ids , ide , jds , jde , kds , kde , &
1029 ims , ime , jms , jme , kms , kme , &
1030 ips , ipe , jps , jpe , kps , kpe )
1031 CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV), &
1032 grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV), &
1033 'T' , spec_bdy_width , &
1034 ids , ide , jds , jde , kds , kde , &
1035 ims , ime , jms , jme , kms , kme , &
1036 ips , ipe , jps , jpe , kps , kpe )
1037 CALL stuff_bdy ( mbdy2dtemp1 , grid%em_mu_bxs, grid%em_mu_bxe, grid%em_mu_bys, grid%em_mu_bye, &
1038 'M' , spec_bdy_width , &
1039 ids , ide , jds , jde , 1 , 1 , &
1040 ims , ime , jms , jme , 1 , 1 , &
1041 ips , ipe , jps , jpe , 1 , 1 )
1042
1043 ELSE IF ( loop .EQ. time_loop_max ) THEN
1044
1045 ! If this is the last time through here, we need to close the files.
1046
1047 IF(grid%id .EQ. 1) THEN
1048 CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1049 END IF
1050
1051 IF(grid_fdda .EQ. 1) THEN
1052 CALL close_dataset ( id2 , config_flags , "DATASET=AUXINPUT10" )
1053 END IF
1054
1055 IF(sst_update .EQ. 1)THEN
1056 CALL close_dataset ( id4 , config_flags , "DATASET=AUXINPUT4" )
1057 END IF
1058
1059 END IF
1060
1061 END IF
1062
1063 END SUBROUTINE assemble_output