real_nmm.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 NMM core.
3
4 PROGRAM real_data
5
6 USE module_machine
7 USE module_domain
8 USE module_initialize
9 USE module_io_domain
10 USE module_driver_constants
11 USE module_configure
12 USE module_timing
13 #ifdef WRF_CHEM
14 USE module_input_chem_data
15 USE module_input_chem_bioemiss
16 #endif
17 USE module_utility
18 #ifdef DM_PARALLEL
19 USE module_dm
20 #endif
21
22 IMPLICIT NONE
23
24 REAL :: time , bdyfrq
25
26 INTEGER :: loop , levels_to_process , debug_level
27
28
29 TYPE(domain) , POINTER :: null_domain
30 TYPE(domain) , POINTER :: grid
31 TYPE (grid_config_rec_type) :: config_flags
32 INTEGER :: number_at_same_level
33
34 INTEGER :: max_dom, domain_id
35 INTEGER :: idum1, idum2
36 #ifdef DM_PARALLEL
37 INTEGER :: nbytes
38 ! INTEGER, PARAMETER :: configbuflen = 2*1024
39 INTEGER, PARAMETER :: configbuflen = 4*CONFIG_BUF_LEN
40 INTEGER :: configbuf( configbuflen )
41 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
42 #endif
43
44 INTEGER :: ids , ide , jds , jde , kds , kde
45 INTEGER :: ims , ime , jms , jme , kms , kme
46 INTEGER :: ips , ipe , jps , jpe , kps , kpe
47 INTEGER :: ijds , ijde , spec_bdy_width
48 INTEGER :: i , j , k , idts
49
50 #ifdef DEREF_KLUDGE
51 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
52 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
53 INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
54 INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
55 #endif
56
57 CHARACTER (LEN=80) :: message
58
59 INTEGER :: start_year , start_month , start_day
60 INTEGER :: start_hour , start_minute , start_second
61 INTEGER :: end_year , end_month , end_day , &
62 end_hour , end_minute , end_second
63 INTEGER :: interval_seconds , real_data_init_type
64 INTEGER :: time_loop_max , time_loop, rc
65 REAL :: t1,t2
66
67 #include "version_decl"
68
69 INTERFACE
70 SUBROUTINE Setup_Timekeeping( grid )
71 USE module_domain
72 TYPE(domain), POINTER :: grid
73 END SUBROUTINE Setup_Timekeeping
74 END INTERFACE
75
76 ! Define the name of this program (program_name defined in module_domain)
77
78 program_name = "REAL_NMM " // TRIM(release_version) // " PREPROCESSOR"
79
80 #ifdef DM_PARALLEL
81 CALL disable_quilting
82 #endif
83
84 ! CALL start()
85
86 ! Initialize the modules used by the WRF system.
87 ! Many of the CALLs made from the
88 ! init_modules routine are NO-OPs. Typical initializations
89 ! are: the size of a
90 ! REAL, setting the file handles to a pre-use value, defining moisture and
91 ! chemistry indices, etc.
92
93 CALL wrf_debug ( 100 , 'real_nmm: calling init_modules ' )
94
95 !!!! CALL init_modules
96 CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
97 CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
98 CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
99
100 ! The configuration switches mostly come from the NAMELIST input.
101
102 #ifdef DM_PARALLEL
103 IF ( wrf_dm_on_monitor() ) THEN
104 write(message,*) 'call initial_config'
105 CALL wrf_message ( message )
106 CALL initial_config
107 ENDIF
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
117 CALL nl_get_debug_level ( 1, debug_level )
118 CALL set_wrf_debug_level ( debug_level )
119
120 CALL wrf_message ( program_name )
121
122 ! Allocate the space for the mother of all domains.
123
124 NULLIFY( null_domain )
125 CALL wrf_debug ( 100 , 'real_nmm: calling alloc_and_configure_domain ' )
126 CALL alloc_and_configure_domain ( domain_id = 1 , &
127 grid = head_grid , &
128 parent = null_domain , &
129 kid = -1 )
130
131 grid => head_grid
132
133 #include "deref_kludge.h"
134 CALL Setup_Timekeeping ( grid )
135 CALL domain_clock_set( grid, &
136 time_step_seconds=model_config_rec%interval_seconds )
137 CALL wrf_debug ( 100 , 'real_nmm: calling set_scalar_indices_from_config ' )
138 CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
139
140 CALL wrf_debug ( 100 , 'real_nmm: calling model_to_grid_config_rec ' )
141
142 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
143
144 write(message,*) 'after model_to_grid_config_rec, e_we, e_sn are: ', &
145 config_flags%e_we, config_flags%e_sn
146 CALL wrf_message(message)
147
148 ! Initialize the WRF IO: open files, init file handles, etc.
149
150 CALL wrf_debug ( 100 , 'real_nmm: calling init_wrfio' )
151 CALL init_wrfio
152
153 ! Some of the configuration values may have been modified from the initial READ
154 ! of the NAMELIST, so we re-broadcast the configuration records.
155
156 #ifdef DM_PARALLEL
157 CALL wrf_debug ( 100 , 'real_nmm: re-broadcast the configuration records' )
158 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
159 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
160 CALL set_config_as_buffer( configbuf, configbuflen )
161 #endif
162
163 ! No looping in this layer.
164
165 CALL med_sidata_input ( grid , config_flags )
166
167 ! We are done.
168
169 CALL wrf_debug ( 0 , 'real_nmm: SUCCESS COMPLETE REAL_NMM INIT' )
170
171 #ifdef DM_PARALLEL
172 CALL wrf_dm_shutdown
173 #endif
174
175 CALL WRFU_Finalize( rc=rc )
176
177 END PROGRAM real_data
178
179 SUBROUTINE med_sidata_input ( grid , config_flags )
180 ! Driver layer
181 USE module_domain
182 USE module_io_domain
183 ! Model layer
184 USE module_configure
185 USE module_bc_time_utilities
186 USE module_initialize
187 USE module_optional_si_input
188 #ifdef WRF_CHEM
189 USE module_input_chem_data
190 USE module_input_chem_bioemiss
191 #endif
192
193 USE module_si_io_nmm
194
195 USE module_date_time
196
197 IMPLICIT NONE
198
199
200 ! Interface
201 INTERFACE
202 SUBROUTINE start_domain ( grid , allowed_to_read )
203 USE module_domain
204 TYPE (domain) grid
205 LOGICAL, INTENT(IN) :: allowed_to_read
206 END SUBROUTINE start_domain
207 END INTERFACE
208
209 ! Arguments
210 TYPE(domain) :: grid
211 TYPE (grid_config_rec_type) :: config_flags
212 ! Local
213 INTEGER :: time_step_begin_restart
214 INTEGER :: idsi , ierr , myproc
215 CHARACTER (LEN=80) :: si_inpname
216 CHARACTER (LEN=132) :: message
217
218 CHARACTER(LEN=19) :: start_date_char , end_date_char , &
219 current_date_char , next_date_char
220
221 INTEGER :: time_loop_max , loop
222 INTEGER :: julyr , julday , LEN
223
224 INTEGER :: io_form_auxinput1
225 INTEGER, EXTERNAL :: use_package
226
227 LOGICAL :: using_binary_wrfsi
228
229 REAL :: gmt
230 REAL :: t1,t2
231
232 INTEGER :: numx_sm_levels_input,numx_st_levels_input
233 REAL,DIMENSION(100) :: smx_levels_input,stx_levels_input
234
235
236 #ifdef DEREF_KLUDGE
237 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
238 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
239 INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
240 INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
241 #endif
242
243 #include "deref_kludge.h"
244
245
246 grid%input_from_file = .true.
247 grid%input_from_file = .false.
248
249 CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
250 model_config_rec%start_month (grid%id) , &
251 model_config_rec%start_day (grid%id) , &
252 model_config_rec%start_hour (grid%id) , &
253 model_config_rec%start_minute(grid%id) , &
254 model_config_rec%start_second(grid%id) , &
255 model_config_rec% end_year (grid%id) , &
256 model_config_rec% end_month (grid%id) , &
257 model_config_rec% end_day (grid%id) , &
258 model_config_rec% end_hour (grid%id) , &
259 model_config_rec% end_minute(grid%id) , &
260 model_config_rec% end_second(grid%id) , &
261 model_config_rec%interval_seconds , &
262 model_config_rec%real_data_init_type , &
263 start_date_char , end_date_char , time_loop_max )
264
265 ! Here we define the initial time to process, for later use by the code.
266
267 current_date_char = start_date_char
268 ! start_date = start_date_char // '.0000'
269 start_date = start_date_char
270 current_date = start_date
271
272 CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
273
274 ! Loop over each time period to process.
275
276 write(message,*) 'time_loop_max: ', time_loop_max
277 CALL wrf_message(message)
278 DO loop = 1 , time_loop_max
279
280 internal_time_loop=loop
281
282 write(message,*) 'loop=', loop
283 CALL wrf_message(message)
284
285 write(message,*) '-----------------------------------------------------------'
286 CALL wrf_message(message)
287
288 write(message,*) ' '
289 CALL wrf_message(message)
290 write(message,'(A,A,A,I2,A,I2)') ' Current date being processed: ', &
291 current_date, ', which is loop #',loop,' out of ',time_loop_max
292 CALL wrf_message(message)
293
294 ! After current_date has been set, fill in the julgmt stuff.
295
296 CALL geth_julgmt ( config_flags%julyr , config_flags%julday , &
297 config_flags%gmt )
298
299 ! Now that the specific Julian info is available,
300 ! save these in the model config record.
301
302 CALL nl_set_gmt (grid%id, config_flags%gmt)
303 CALL nl_set_julyr (grid%id, config_flags%julyr)
304 CALL nl_set_julday (grid%id, config_flags%julday)
305
306 CALL nl_get_io_form_auxinput1( 1, io_form_auxinput1 )
307
308 using_binary_wrfsi=.false.
309
310
311 IF ( grid%dyn_opt .EQ. dyn_nmm ) THEN
312
313 write(message,*) 'TRIM(config_flags%auxinput1_inname): ', TRIM(config_flags%auxinput1_inname)
314 CALL wrf_message(message)
315
316 IF (config_flags%auxinput1_inname(1:10) .eq. 'real_input') THEN
317 using_binary_wrfsi=.true.
318 ENDIF
319
320 SELECT CASE ( use_package(io_form_auxinput1) )
321 #ifdef NETCDF
322 CASE ( IO_NETCDF )
323
324 ! Open the wrfinput file.
325
326 current_date_char(11:11)='_'
327
328 WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
329 CALL wrf_debug ( 100 , wrf_err_message )
330 IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
331 CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
332 config_flags%io_form_auxinput1 )
333 ELSE
334 CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
335 END IF
336 CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
337 IF ( ierr .NE. 0 ) THEN
338 CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
339 ENDIF
340
341
342 ! Input data.
343
344 CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
345 CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
346
347 ! Possible optional SI input. This sets flags used by init_domain.
348
349 IF ( loop .EQ. 1 ) THEN
350 CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
351 CALL init_module_optional_si_input ( grid , config_flags )
352 !mp END IF
353 CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
354 CALL optional_si_input ( grid , idsi )
355
356 ENDIF
357
358 !
359 CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
360
361 #endif
362 #ifdef INTIO
363 CASE ( IO_INTIO )
364
365 ! Possible optional SI input. This sets flags used by init_domain.
366
367 IF ( loop .EQ. 1 ) THEN
368 CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
369 CALL init_module_optional_si_input ( grid , config_flags )
370 END IF
371
372 IF (using_binary_wrfsi) THEN
373
374 current_date_char(11:11)='_'
375 CALL read_si ( grid, current_date_char )
376 current_date_char(11:11)='T'
377
378 ELSE
379
380 write(message,*) 'binary WPS branch'
381 CALL wrf_message(message)
382 CALL wrf_error_fatal("binary WPS support deferred for initial release")
383
384 ! WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
385 ! CALL wrf_debug ( 100 , wrf_err_message )
386 ! CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , config_flags%io_form_auxinput1 )
387 ! CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
388
389 ! IF ( ierr .NE. 0 ) THEN
390 ! CALL wrf_debug( 1 , 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
391 ! CALL wrf_debug( 1 , 'will try again without the extension' )
392 ! CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
393 ! CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
394 ! IF ( ierr .NE. 0 ) THEN
395 ! CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
396 ! ENDIF
397 ! ENDIF
398
399 ! Input data.
400
401 !!! believe problematic as binary data from WPS will be XYZ ordered, while this
402 !!! version of WRF will read in as XZY. OR read all fields in as unique
403 !!! Registry items that are XYZ, then swap. More memory, and more overhead, but
404 !!! better than having a stand alone "read_si" type code??
405
406 ! CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
407 ! CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
408
409 ! Possible optional SI input. This sets flags used by init_domain.
410
411 ! IF ( loop .EQ. 1 ) THEN
412 ! CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
413 ! CALL init_module_optional_si_input ( grid , config_flags )
414 ! END IF
415 ! CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
416 !
417 ! CALL optional_si_input ( grid , idsi )
418 ! flag_metgrid=1
419
420 !
421 ! CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
422
423 ENDIF
424 #endif
425 CASE DEFAULT
426 CALL wrf_error_fatal('real: not valid io_form_auxinput1')
427 END SELECT
428
429 ELSE
430 call wrf_error_fatal("WRONG DYNAMICAL CORE SELECTED FOR THIS VERSION OF REAL - CHECK dyn_opt in namelist.input file")
431 ENDIF
432
433 grid%nmm_islope=1
434 grid%vegfra=grid%nmm_vegfrc
435 grid%nmm_dfrlg=grid%nmm_dfl/9.81
436
437 grid%isurban=1
438 grid%isoilwater=14
439
440 ! Initialize the mother domain for this time period with input data.
441
442 CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
443 grid%input_from_file = .true.
444
445 CALL init_domain ( grid )
446
447 CALL model_to_grid_config_rec ( grid%id, model_config_rec, config_flags )
448
449 ! Close this file that is output from the SI and input to this pre-proc.
450
451 CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
452
453
454 !!! not sure about this, but doesnt seem like needs to be called each time
455 IF ( loop .EQ. 1 ) THEN
456 CALL start_domain ( grid , .TRUE.)
457 END IF
458
459 #ifdef WRF_CHEM
460 IF ( loop == 1 ) THEN
461 IF ( ( grid%chem_opt .EQ. RADM2 ) .OR. &
462 ( grid%chem_opt .EQ. RADM2SORG ) .OR. &
463 ( grid%chem_opt .EQ. RACM ) .OR. &
464 ( grid%chem_opt .EQ. RACMSORG ) ) THEN
465 ! Read the chemistry data from a previous wrf forecast (wrfout file)
466 IF(grid%chem_in_opt == 1 ) THEN
467 message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
468 CALL wrf_message ( message )
469
470 CALL input_ext_chem_file( grid )
471
472 IF(grid%bio_emiss_opt == BEIS311 ) THEN
473 message = 'READING BEIS3.11 EMISSIONS DATA'
474 CALL wrf_message ( message )
475 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
476 END IF
477
478 ELSEIF(grid%chem_in_opt == 0)then
479 ! Generate chemistry data from a idealized vertical profile
480 message = 'STARTING WITH BACKGROUND CHEMISTRY '
481 CALL wrf_message ( message )
482
483 write(message,*)' ETA1 '
484 CALL wrf_message ( message )
485 write(message,*) grid%nmm_eta1
486 CALL wrf_message ( message )
487
488 CALL input_chem_profile ( grid )
489
490 IF(grid%bio_emiss_opt == BEIS311 ) THEN
491 message = 'READING BEIS3.11 EMISSIONS DATA'
492 CALL wrf_message ( message )
493 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
494 END IF
495
496 ELSE
497 message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
498 CALL wrf_message ( message )
499 ENDIF
500 ENDIF
501 ENDIF
502 #endif
503
504 config_flags%isurban=1
505 config_flags%isoilwater=14
506
507 CALL assemble_output ( grid , config_flags , loop , time_loop_max )
508
509 ! Here we define the next time that we are going to process.
510
511 CALL geth_newdate ( current_date_char , start_date_char , &
512 loop * model_config_rec%interval_seconds )
513 current_date = current_date_char // '.0000'
514
515 CALL domain_clock_set( grid, current_date(1:19) )
516
517 write(message,*) 'current_date= ', current_date
518 CALL wrf_message(message)
519
520 END DO
521 END SUBROUTINE med_sidata_input
522
523 SUBROUTINE compute_si_start_and_end ( &
524 start_year, start_month, start_day, start_hour, &
525 start_minute, start_second, &
526 end_year , end_month , end_day , end_hour , &
527 end_minute , end_second , &
528 interval_seconds , real_data_init_type , &
529 start_date_char , end_date_char , time_loop_max )
530
531 USE module_date_time
532
533 IMPLICIT NONE
534
535 INTEGER :: start_year , start_month , start_day , &
536 start_hour , start_minute , start_second
537 INTEGER :: end_year , end_month , end_day , &
538 end_hour , end_minute , end_second
539 INTEGER :: interval_seconds , real_data_init_type
540 INTEGER :: time_loop_max , time_loop
541
542 CHARACTER(LEN=132) :: message
543 CHARACTER(LEN=19) :: current_date_char , start_date_char , &
544 end_date_char , next_date_char
545
546 ! WRITE ( start_date_char , FMT = &
547 ! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
548 ! start_year,start_month,start_day,start_hour,start_minute,start_second
549 ! WRITE ( end_date_char , FMT = &
550 ! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
551 ! end_year, end_month, end_day, end_hour, end_minute, end_second
552
553 WRITE ( start_date_char , FMT = &
554 '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
555 start_year,start_month,start_day,start_hour,start_minute,start_second
556 WRITE ( end_date_char , FMT = &
557 '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
558 end_year, end_month, end_day, end_hour, end_minute, end_second
559
560 ! start_date = start_date_char // '.0000'
561
562 ! Figure out our loop count for the processing times.
563
564 time_loop = 1
565 PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
566 ' to process = ',start_date_char,'.'
567 current_date_char = start_date_char
568 loop_count : DO
569 CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
570 IF ( next_date_char .LT. end_date_char ) THEN
571 time_loop = time_loop + 1
572 PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
573 ' to process = ',next_date_char,'.'
574 current_date_char = next_date_char
575 ELSE IF ( next_date_char .EQ. end_date_char ) THEN
576 time_loop = time_loop + 1
577 PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
578 ' to process = ',next_date_char,'.'
579 PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
580 time_loop_max = time_loop
581 EXIT loop_count
582 ELSE IF ( next_date_char .GT. end_date_char ) THEN
583 PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
584 time_loop_max = time_loop
585 EXIT loop_count
586 END IF
587 END DO loop_count
588 write(message,*) 'done in si_start_and_end'
589 CALL wrf_message(message)
590 END SUBROUTINE compute_si_start_and_end
591
592 SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
593
594 !!! replace with something? USE module_big_step_utilities_em
595
596 USE module_domain
597 USE module_io_domain
598 USE module_configure
599 USE module_date_time
600 USE module_bc
601 IMPLICIT NONE
602
603 TYPE(domain) :: grid
604 TYPE (grid_config_rec_type) :: config_flags
605 INTEGER , INTENT(IN) :: loop , time_loop_max
606
607 INTEGER :: ids , ide , jds , jde , kds , kde
608 INTEGER :: ims , ime , jms , jme , kms , kme
609 INTEGER :: ips , ipe , jps , jpe , kps , kpe
610 INTEGER :: ijds , ijde , spec_bdy_width
611 INTEGER :: inc_h,inc_v
612 INTEGER :: i , j , k , idts
613
614 INTEGER :: id1 , interval_seconds , ierr, rc
615 INTEGER , SAVE :: id
616 CHARACTER (LEN=80) :: inpname , bdyname
617 CHARACTER(LEN= 4) :: loop_char
618 CHARACTER(LEN=132) :: message
619 character *19 :: temp19
620 character *24 :: temp24 , temp24b
621
622 REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
623 tbdy3dtemp1 , &
624 cwmbdy3dtemp1 , qbdy3dtemp1,&
625 q2bdy3dtemp1 , pdbdy2dtemp1
626 REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
627 tbdy3dtemp2 , &
628 cwmbdy3dtemp2 , qbdy3dtemp2, &
629 q2bdy3dtemp2, pdbdy2dtemp2
630 REAL :: t1,t2
631
632 #ifdef DEREF_KLUDGE
633 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
634 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
635 INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
636 INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
637 #endif
638
639 #include "deref_kludge.h"
640
641
642 ! Various sizes that we need to be concerned about.
643
644 ids = grid%sd31
645 ide = grid%ed31-1 ! 030730tst
646 kds = grid%sd32
647 kde = grid%ed32-1 ! 030730tst
648 jds = grid%sd33
649 jde = grid%ed33-1 ! 030730tst
650
651 ims = grid%sm31
652 ime = grid%em31
653 kms = grid%sm32
654 kme = grid%em32
655 jms = grid%sm33
656 jme = grid%em33
657
658 ips = grid%sp31
659 ipe = grid%ep31-1 ! 030730tst
660 kps = grid%sp32
661 kpe = grid%ep32-1 ! 030730tst
662 jps = grid%sp33
663 jpe = grid%ep33-1 ! 030730tst
664
665 if (IPE .ne. IDE) IPE=IPE+1
666 if (JPE .ne. JDE) JPE=JPE+1
667
668 write(message,*) 'assemble output (ids,ide): ', ids,ide
669 CALL wrf_message(message)
670 write(message,*) 'assemble output (ims,ime): ', ims,ime
671 CALL wrf_message(message)
672 write(message,*) 'assemble output (ips,ipe): ', ips,ipe
673 CALL wrf_message(message)
674
675 write(message,*) 'assemble output (jds,jde): ', jds,jde
676 CALL wrf_message(message)
677 write(message,*) 'assemble output (jms,jme): ', jms,jme
678 CALL wrf_message(message)
679 write(message,*) 'assemble output (jps,jpe): ', jps,jpe
680 CALL wrf_message(message)
681
682 write(message,*) 'assemble output (kds,kde): ', kds,kde
683 CALL wrf_message(message)
684 write(message,*) 'assemble output (kms,kme): ', kms,kme
685 CALL wrf_message(message)
686 write(message,*) 'assemble output (kps,kpe): ', kps,kpe
687 CALL wrf_message(message)
688
689 ijds = MIN ( ids , jds )
690 !mptest030805 ijde = MAX ( ide , jde )
691 ijde = MAX ( ide , jde ) + 1 ! to make stuff_bdy dimensions consistent with alloc
692
693 ! Boundary width, scalar value.
694
695 spec_bdy_width = model_config_rec%spec_bdy_width
696 interval_seconds = model_config_rec%interval_seconds
697
698 !-----------------------------------------------------------------------
699 !
700 main_loop_test: IF ( loop .EQ. 1 ) THEN
701 !
702 !-----------------------------------------------------------------------
703
704 ! This is the space needed to save the current 3d data for use in computing
705 ! the lateral boundary tendencies.
706
707 ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
708 ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
709 ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
710 ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
711 ALLOCATE ( cwmbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
712 ALLOCATE ( q2bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
713 ALLOCATE ( pdbdy2dtemp1(ims:ime, 1:1 ,jms:jme) )
714
715 ubdy3dtemp1=0.
716 vbdy3dtemp1=0.
717 tbdy3dtemp1=0.
718 qbdy3dtemp1=0.
719 cwmbdy3dtemp1=0.
720 q2bdy3dtemp1=0.
721 pdbdy2dtemp1=0.
722
723 ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
724 ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
725 ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
726 ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
727 ALLOCATE ( cwmbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
728 ALLOCATE ( q2bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
729 ALLOCATE ( pdbdy2dtemp2(ims:ime, 1:1 ,jms:jme) )
730
731 ubdy3dtemp2=0.
732 vbdy3dtemp2=0.
733 tbdy3dtemp2=0.
734 qbdy3dtemp2=0.
735 cwmbdy3dtemp2=0.
736 q2bdy3dtemp2=0.
737 pdbdy2dtemp2=0.
738
739 ! Open the wrfinput file. From this program, this is an *output* file.
740
741 CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
742
743 CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
744 output_model_input , "DATASET=INPUT", ierr )
745
746 IF ( ierr .NE. 0 ) THEN
747 CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
748 ENDIF
749
750 ! CALL calc_current_date ( grid%id , 0. )
751 ! grid%write_metadata = .true.
752
753 write(message,*) 'making call to output_model_input'
754 CALL wrf_message(message)
755
756 CALL output_model_input ( id1, grid , config_flags , ierr )
757
758 !***
759 !*** CLOSE THE WRFINPUT DATASET
760 !***
761 CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
762
763 ! We need to save the 3d data to compute a
764 ! difference during the next loop.
765
766 !
767 !-----------------------------------------------------------------------
768 !*** SOUTHERN BOUNDARY
769 !-----------------------------------------------------------------------
770 !
771
772 IF(JPS==JDS)THEN
773 J=1
774 DO k = kps , MIN(kde,kpe)
775 DO i = ips , MIN(ide,ipe)
776 ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
777 vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
778 tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
779 qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
780 cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
781 q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
782 END DO
783 END DO
784
785 DO i = ips , MIN(ide,ipe)
786 pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
787 END DO
788 ENDIF
789
790 !
791 !-----------------------------------------------------------------------
792 !*** NORTHERN BOUNDARY
793 !-----------------------------------------------------------------------
794 !
795 IF(JPE==JDE)THEN
796 J=MIN(JDE,JPE)
797 DO k = kps , MIN(kde,kpe)
798 DO i = ips , MIN(ide,ipe)
799 ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
800 vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
801 tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
802 qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
803 cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
804 q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
805 END DO
806 END DO
807
808 DO i = ips , MIN(ide,ipe)
809 pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
810 END DO
811 ENDIF
812
813 !
814 !-----------------------------------------------------------------------
815 !*** WESTERN BOUNDARY
816 !-----------------------------------------------------------------------
817 !
818 write(message,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
819 CALL wrf_message(message)
820 IF(IPS==IDS)THEN
821 I=1
822 DO k = kps , MIN(kde,kpe)
823 inc_h=mod(jps+1,2)
824 DO j = jps+inc_h, min(jde,jpe),2
825
826 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
827 tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
828 qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
829 cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
830 q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
831 if(k==1)then
832 write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,k,j)=',tbdy3dtemp1(i,k,j)
833 CALL wrf_debug(10,message)
834 endif
835 endif
836 END DO
837 END DO
838
839 DO k = kps , MIN(kde,kpe)
840 inc_v=mod(jps,2)
841 DO j = jps+inc_v, min(jde,jpe),2
842 if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
843 ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
844 vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
845 endif
846 END DO
847 END DO
848 !
849 inc_h=mod(jps+1,2)
850 DO j = jps+inc_h, min(jde,jpe),2
851 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
852 pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
853 write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,1,j)=',pdbdy2dtemp1(i,1,j)
854 CALL wrf_debug(10,message)
855 endif
856 END DO
857 ENDIF
858 !
859 !-----------------------------------------------------------------------
860 !*** EASTERN BOUNDARY
861 !-----------------------------------------------------------------------
862 !
863 IF(IPE==IDE)THEN
864 I=MIN(IDE,IPE)
865 !
866 DO k = kps , MIN(kde,kpe)
867 !
868 !*** Make sure the J loop is on the global boundary
869 !
870 inc_h=mod(jps+1,2)
871 DO j = jps+inc_h, min(jde,jpe),2
872 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
873 tbdy3dtemp1(i,k,j) = grid%nmm_t(i,k,j)
874 qbdy3dtemp1(i,k,j) = grid%nmm_q(i,k,j)
875 cwmbdy3dtemp1(i,k,j) = grid%nmm_cwm(i,k,j)
876 q2bdy3dtemp1(i,k,j) = grid%nmm_q2(i,k,j)
877 endif
878 END DO
879 END DO
880
881 DO k = kps , MIN(kde,kpe)
882 inc_v=mod(jps,2)
883 DO j = jps+inc_v, min(jde,jpe),2
884 if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
885 ubdy3dtemp1(i,k,j) = grid%nmm_u(i,k,j)
886 vbdy3dtemp1(i,k,j) = grid%nmm_v(i,k,j)
887 endif
888 END DO
889 END DO
890 !
891 inc_h=mod(jps+1,2)
892 DO j = jps+inc_h, min(jde,jpe),2
893 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
894 pdbdy2dtemp1(i,1,j) = grid%nmm_pd(i,j)
895 endif
896 END DO
897 ENDIF
898
899
900 ! There are 2 components to the lateral boundaries.
901 ! First, there is the starting
902 ! point of this time period - just the outer few rows and columns.
903
904
905 CALL stuff_bdy (ubdy3dtemp1, grid%nmm_u_b, 'N', ijds, ijde, spec_bdy_width , &
906 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
907 ims , ime , jms , jme , kms , kme , &
908 ips , ipe , jps , jpe , kps , kpe+1 )
909 CALL stuff_bdy ( vbdy3dtemp1, grid%nmm_v_b, 'N', ijds, ijde, spec_bdy_width, &
910 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
911 ims , ime , jms , jme , kms , kme , &
912 ips , ipe , jps , jpe , kps , kpe+1 )
913 CALL stuff_bdy ( tbdy3dtemp1, grid%nmm_t_b, 'N', ijds, ijde, spec_bdy_width, &
914 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
915 ims , ime , jms , jme , kms , kme , &
916 ips , ipe , jps , jpe , kps , kpe+1 )
917
918 CALL stuff_bdy ( cwmbdy3dtemp1,grid%nmm_cwm_b,'N',ijds,ijde, spec_bdy_width, &
919 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
920 ims , ime , jms , jme , kms , kme , &
921 ips , ipe , jps , jpe , kps , kpe+1 )
922
923 CALL stuff_bdy ( qbdy3dtemp1, grid%nmm_q_b, 'N', ijds, ijde, spec_bdy_width, &
924 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
925 ims , ime , jms , jme , kms , kme , &
926 ips , ipe , jps , jpe , kps , kpe+1 )
927
928 CALL stuff_bdy ( q2bdy3dtemp1,grid%nmm_q2_b,'N', ijds, ijde, spec_bdy_width, &
929 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
930 ims , ime , jms , jme , kms , kme , &
931 ips , ipe , jps , jpe , kps , kpe+1 )
932
933 CALL stuff_bdy ( pdbdy2dtemp1,grid%nmm_pd_b,'M', ijds,ijde, spec_bdy_width, &
934 ids , ide+1 , jds , jde+1 , 1 , 1 , &
935 ims , ime , jms , jme , 1 , 1 , &
936 ips , ipe , jps , jpe , 1 , 1 )
937
938 !-----------------------------------------------------------------------
939 !
940 ELSE IF ( loop .GT. 1 ) THEN
941 !
942 !-----------------------------------------------------------------------
943
944 write(message,*)' assemble_output loop=',loop,' in IF block'
945 call wrf_message(message)
946
947 ! Open the boundary file.
948
949 IF ( loop .eq. 2 ) THEN
950 CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
951 CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
952 output_boundary , "DATASET=BOUNDARY", ierr )
953 IF ( ierr .NE. 0 ) THEN
954 CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
955 ENDIF
956 ! grid%write_metadata = .true.
957 ELSE
958 ! what's this do?
959 ! grid%write_metadata = .true.
960 ! grid%write_metadata = .false.
961 CALL domain_clockadvance( grid )
962 END IF
963
964 !
965 !-----------------------------------------------------------------------
966 !*** SOUTHERN BOUNDARY
967 !-----------------------------------------------------------------------
968 !
969 IF(JPS==JDS)THEN
970 J=1
971 DO k = kps , MIN(kde,kpe)
972 DO i = ips , MIN(ide,ipe)
973 ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
974 vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
975 tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
976 qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
977 cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
978 q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
979 END DO
980 END DO
981 !
982 DO i = ips , MIN(ide,ipe)
983 pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
984 END DO
985 ENDIF
986
987 !
988 !-----------------------------------------------------------------------
989 !*** NORTHERN BOUNDARY
990 !-----------------------------------------------------------------------
991 !
992 IF(JPE==JDE)THEN
993 J=MIN(JDE,JPE)
994 DO k = kps , MIN(kde,kpe)
995 DO i = ips , MIN(ide,ipe)
996 ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
997 vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
998 tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
999 qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
1000 cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
1001 q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
1002 END DO
1003 END DO
1004
1005 DO i = ips , MIN(ide,ipe)
1006 pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
1007 END DO
1008 ENDIF
1009 !
1010 !-----------------------------------------------------------------------
1011 !*** WESTERN BOUNDARY
1012 !-----------------------------------------------------------------------
1013 !
1014 IF(IPS==IDS)THEN
1015 I=1
1016 DO k = kps , MIN(kde,kpe)
1017 inc_h=mod(jps+1,2)
1018 if(k==1)then
1019 write(message,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
1020 call wrf_debug(10,message)
1021 endif
1022 DO j = jps+inc_h, MIN(jde,jpe),2
1023 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1024 tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
1025 if(k==1)then
1026 write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,k,j)=',tbdy3dtemp1(i,k,j)
1027 call wrf_debug(10,message)
1028 endif
1029 qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
1030 cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
1031 q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
1032 endif
1033 END DO
1034 END DO
1035 !
1036 DO k = kps , MIN(kde,kpe)
1037 inc_v=mod(jps,2)
1038 DO j = jps+inc_v, MIN(jde,jpe),2
1039 if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1040 ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
1041 vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
1042 endif
1043 END DO
1044 END DO
1045
1046 inc_h=mod(jps+1,2)
1047 DO j = jps+inc_h, MIN(jde,jpe),2
1048 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1049 pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
1050 write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,1,j)=',pdbdy2dtemp1(i,1,j)
1051 CALL wrf_debug(10,message)
1052 endif
1053 END DO
1054 ENDIF
1055 !
1056 !-----------------------------------------------------------------------
1057 !*** EASTERN BOUNDARY
1058 !-----------------------------------------------------------------------
1059 !
1060 IF(IPE==IDE)THEN
1061 I=MIN(IDE,IPE)
1062
1063 DO k = kps , MIN(kde,kpe)
1064 inc_h=mod(jps+1,2)
1065 DO j = jps+inc_h, MIN(jde,jpe),2
1066 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1067 tbdy3dtemp2(i,k,j) = grid%nmm_t(i,k,j)
1068 qbdy3dtemp2(i,k,j) = grid%nmm_q(i,k,j)
1069 cwmbdy3dtemp2(i,k,j) = grid%nmm_cwm(i,k,j)
1070 q2bdy3dtemp2(i,k,j) = grid%nmm_q2(i,k,j)
1071 endif
1072 END DO
1073 END DO
1074
1075 DO k = kps , MIN(kde,kpe)
1076 inc_v=mod(jps,2)
1077 DO j = jps+inc_v, MIN(jde,jpe),2
1078 if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1079 ubdy3dtemp2(i,k,j) = grid%nmm_u(i,k,j)
1080 vbdy3dtemp2(i,k,j) = grid%nmm_v(i,k,j)
1081 endif
1082 END DO
1083 END DO
1084
1085 inc_h=mod(jps+1,2)
1086 DO j = jps+inc_h, MIN(jde,jpe),2
1087 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1088 pdbdy2dtemp2(i,1,j) = grid%nmm_pd(i,j)
1089 endif
1090 END DO
1091 ENDIF
1092 !-----------------------------------------------------------------------
1093 ! During all of the loops after the first loop,
1094 ! we first compute the boundary
1095 ! tendencies with the current data values
1096 ! (*bdy3dtemp2 arrays) and the previously
1097 ! saved information stored in the *bdy3dtemp1 arrays.
1098
1099
1100 CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds),&
1101 grid%nmm_u_bt , 'N' , &
1102 ijds , ijde , spec_bdy_width , &
1103 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1104 ims , ime , jms , jme , kms , kme , &
1105 ips , ipe , jps , jpe , kps , kpe+1 )
1106 CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds),&
1107 grid%nmm_v_bt , 'N' , &
1108 ijds , ijde , spec_bdy_width , &
1109 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1110 ims , ime , jms , jme , kms , kme , &
1111 ips , ipe , jps , jpe , kps , kpe+1 )
1112 CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds),&
1113 grid%nmm_t_bt , 'N' , &
1114 ijds , ijde , spec_bdy_width , &
1115 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1116 ims , ime , jms , jme , kms , kme , &
1117 ips , ipe , jps , jpe , kps , kpe+1 )
1118
1119 CALL stuff_bdytend ( cwmbdy3dtemp2,cwmbdy3dtemp1,REAL(interval_seconds),&
1120 grid%nmm_cwm_bt , 'N' , &
1121 ijds , ijde , spec_bdy_width , &
1122 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1123 ims , ime , jms , jme , kms , kme , &
1124 ips , ipe , jps , jpe , kps , kpe+1 )
1125
1126 CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds),&
1127 grid%nmm_q_bt , 'N' , &
1128 ijds , ijde , spec_bdy_width , &
1129 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1130 ims , ime , jms , jme , kms , kme , &
1131 ips , ipe , jps , jpe , kps , kpe+1 )
1132
1133 CALL stuff_bdytend ( q2bdy3dtemp2, q2bdy3dtemp1 , REAL(interval_seconds),&
1134 grid%nmm_q2_bt , 'N' , &
1135 ijds , ijde , spec_bdy_width , &
1136 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1137 ims , ime , jms , jme , kms , kme , &
1138 ips , ipe , jps , jpe , kps , kpe+1 )
1139
1140 CALL stuff_bdytend( pdbdy2dtemp2 , pdbdy2dtemp1, REAL(interval_seconds),&
1141 grid%nmm_pd_bt , 'M' , &
1142 ijds , ijde , spec_bdy_width , &
1143 ids , ide+1 , jds , jde+1 , 1 , 1 , &
1144 ims , ime , jms , jme , 1 , 1 , &
1145 ips , ipe , jps , jpe , 1 , 1 )
1146
1147 ! Both pieces of the boundary data are now
1148 ! available to be written (initial time and tendency).
1149 ! This looks ugly, these date shifting things.
1150 ! What's it for? We want the "Times" variable
1151 ! in the lateral BDY file to have the valid times
1152 ! of when the initial fields are written.
1153 ! That's what the loop-2 thingy is for with the start date.
1154 ! We increment the start_date so
1155 ! that the starting time in the attributes is the
1156 ! second time period. Why you may ask. I
1157 ! agree, why indeed.
1158
1159 temp24= current_date
1160 temp24b=start_date
1161 start_date = current_date
1162 CALL geth_newdate ( temp19 , temp24b(1:19) , &
1163 (loop-2) * model_config_rec%interval_seconds )
1164 current_date = temp19 // '.0000'
1165 CALL domain_clock_set( grid, current_date(1:19) )
1166 write(message,*) 'LBC valid between these times ',current_date, ' ',start_date
1167 CALL wrf_message(message)
1168
1169 CALL output_boundary ( id, grid , config_flags , ierr )
1170 current_date = temp24
1171 start_date = temp24b
1172
1173 ! OK, for all of the loops, we output the initialzation
1174 ! data, which would allow us to
1175 ! start the model at any of the available analysis time periods.
1176
1177 ! WRITE ( loop_char , FMT = '(I4.4)' ) loop
1178 ! CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
1179 ! IF ( ierr .NE. 0 ) THEN
1180 ! CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
1181 ! ENDIF
1182 ! grid%write_metadata = .true.
1183
1184 ! CALL calc_current_date ( grid%id , 0. )
1185 ! CALL output_model_input ( id1, grid , config_flags , ierr )
1186 ! CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1187
1188 ! Is this or is this not the last time time? We can remove some unnecessary
1189 ! stores if it is not.
1190
1191 IF ( loop .LT. time_loop_max ) THEN
1192
1193 ! We need to save the 3d data to compute a
1194 ! difference during the next loop. Couple the
1195 ! 3d fields with total mu (mub + mu_2) and the
1196 ! stagger-specific map scale factor.
1197 ! We load up the boundary data again for use in the next loop.
1198
1199
1200 !mp change these limits?????????
1201
1202 DO j = jps , jpe
1203 DO k = kps , kpe
1204 DO i = ips , ipe
1205 ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
1206 vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
1207 tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
1208 cwmbdy3dtemp1(i,k,j) = cwmbdy3dtemp2(i,k,j)
1209 qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
1210 q2bdy3dtemp1(i,k,j) = q2bdy3dtemp2(i,k,j)
1211 END DO
1212 END DO
1213 END DO
1214
1215 !mp change these limits?????????
1216
1217 DO j = jps , jpe
1218 DO i = ips , ipe
1219 pdbdy2dtemp1(i,1,j) = pdbdy2dtemp2(i,1,j)
1220 END DO
1221 END DO
1222
1223 ! There are 2 components to the lateral boundaries.
1224 ! First, there is the starting
1225 ! point of this time period - just the outer few rows and columns.
1226
1227
1228 CALL stuff_bdy ( ubdy3dtemp1 , grid%nmm_u_b , 'N' ,&
1229 ijds , ijde , spec_bdy_width , &
1230 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1231 ims , ime , jms , jme , kms , kme , &
1232 ips , ipe , jps , jpe , kps , kpe+1 )
1233 CALL stuff_bdy ( vbdy3dtemp1 , grid%nmm_v_b , 'N' , &
1234 ijds , ijde , spec_bdy_width , &
1235 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1236 ims , ime , jms , jme , kms , kme , &
1237 ips , ipe , jps , jpe , kps , kpe+1 )
1238 CALL stuff_bdy ( tbdy3dtemp1 , grid%nmm_t_b , 'N' , &
1239 ijds , ijde , spec_bdy_width , &
1240 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1241 ims , ime , jms , jme , kms , kme , &
1242 ips , ipe , jps , jpe , kps , kpe+1 )
1243
1244 CALL stuff_bdy ( cwmbdy3dtemp1 , grid%nmm_cwm_b , 'N' , &
1245 ijds , ijde , spec_bdy_width , &
1246 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1247 ims , ime , jms , jme , kms , kme , &
1248 ips , ipe , jps , jpe , kps , kpe+1 )
1249
1250 CALL stuff_bdy ( qbdy3dtemp1 , grid%nmm_q_b , 'N' ,&
1251 ijds , ijde , spec_bdy_width , &
1252 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1253 ims , ime , jms , jme , kms , kme , &
1254 ips , ipe , jps , jpe , kps , kpe+1 )
1255
1256 CALL stuff_bdy ( q2bdy3dtemp1 , grid%nmm_q2_b, 'N' ,&
1257 ijds , ijde , spec_bdy_width , &
1258 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1259 ims , ime , jms , jme , kms , kme , &
1260 ips , ipe , jps , jpe , kps , kpe+1 )
1261
1262 CALL stuff_bdy ( pdbdy2dtemp1 , grid%nmm_pd_b , 'M' ,&
1263 ijds , ijde , spec_bdy_width , &
1264 ids , ide+1 , jds , jde+1 , 1 , 1 , &
1265 ims , ime , jms , jme , 1 , 1 , &
1266 ips , ipe , jps , jpe , 1 , 1 )
1267
1268 ELSE IF ( loop .EQ. time_loop_max ) THEN
1269
1270 ! If this is the last time through here, we need to close the files.
1271
1272 CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1273
1274 END IF
1275
1276 END IF main_loop_test
1277
1278 END SUBROUTINE assemble_output