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