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_real
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_real
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 using_binary_wrfsi=.false.
308
309
310 IF ( grid%dyn_opt .EQ. dyn_nmm ) THEN
311
312 write(message,*) 'TRIM(config_flags%auxinput1_inname): ', TRIM(config_flags%auxinput1_inname)
313 CALL wrf_message(message)
314
315 IF (config_flags%auxinput1_inname(1:10) .eq. 'real_input') THEN
316 using_binary_wrfsi=.true.
317 ENDIF
318
319 SELECT CASE ( use_package(io_form_auxinput1) )
320 #ifdef NETCDF
321 CASE ( IO_NETCDF )
322
323 ! Open the wrfinput file.
324
325 current_date_char(11:11)='_'
326
327 WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
328 CALL wrf_debug ( 100 , wrf_err_message )
329 IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
330 CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
331 config_flags%io_form_auxinput1 )
332 ELSE
333 CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
334 END IF
335 CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
336
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 ! Input data.
342
343 CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
344
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 CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
353 !
354 CALL optional_si_input ( grid , idsi )
355 write(0,*) 'maxval st_input(1) within real_nmm: ', maxval(st_input(:,1,:))
356 END IF
357 !
358 CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
359
360 #endif
361 #ifdef INTIO
362 CASE ( IO_INTIO )
363
364 ! Possible optional SI input. This sets flags used by init_domain.
365
366 IF ( loop .EQ. 1 ) THEN
367 CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
368 CALL init_module_optional_si_input ( grid , config_flags )
369 END IF
370
371 IF (using_binary_wrfsi) THEN
372
373 current_date_char(11:11)='_'
374 CALL read_si ( grid, current_date_char )
375 current_date_char(11:11)='T'
376
377 ELSE
378
379 write(message,*) 'binary WPS branch'
380 CALL wrf_message(message)
381 CALL wrf_error_fatal("binary WPS support deferred for initial release")
382
383 ! WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
384 ! CALL wrf_debug ( 100 , wrf_err_message )
385 ! CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , config_flags%io_form_auxinput1 )
386 ! CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
387
388 ! IF ( ierr .NE. 0 ) THEN
389 ! CALL wrf_debug( 1 , 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
390 ! CALL wrf_debug( 1 , 'will try again without the extension' )
391 ! CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
392 ! CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
393 ! IF ( ierr .NE. 0 ) THEN
394 ! CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
395 ! ENDIF
396 ! ENDIF
397
398 ! Input data.
399
400 !!! believe problematic as binary data from WPS will be XYZ ordered, while this
401 !!! version of WRF will read in as XZY. OR read all fields in as unique
402 !!! Registry items that are XYZ, then swap. More memory, and more overhead, but
403 !!! better than having a stand alone "read_si" type code??
404
405 ! CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
406 ! CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
407
408 ! Possible optional SI input. This sets flags used by init_domain.
409
410 ! IF ( loop .EQ. 1 ) THEN
411 ! CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_si_input' )
412 ! CALL init_module_optional_si_input ( grid , config_flags )
413 ! END IF
414 ! CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_si_input' )
415 !
416 ! CALL optional_si_input ( grid , idsi )
417 ! flag_metgrid=1
418
419 !
420 ! CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
421
422 ENDIF
423
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 IF( grid%chem_opt > 0 ) then
466 ! Read the chemistry data from a previous wrf forecast (wrfout file)
467 IF(grid%chem_in_opt == 1 ) THEN
468 message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
469 CALL wrf_message ( message )
470
471 CALL input_ext_chem_file( grid )
472
473 IF(grid%bio_emiss_opt == BEIS311 ) THEN
474 message = 'READING BEIS3.11 EMISSIONS DATA'
475 CALL wrf_message ( message )
476 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
477 else IF(grid%bio_emiss_opt == 3 ) THEN !shc
478 message = 'READING MEGAN 2 EMISSIONS DATA'
479 CALL wrf_message ( message )
480 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
481 END IF
482
483 ELSEIF(grid%chem_in_opt == 0)then
484 ! Generate chemistry data from a idealized vertical profile
485 message = 'STARTING WITH BACKGROUND CHEMISTRY '
486 CALL wrf_message ( message )
487
488 write(message,*)' ETA1 '
489 CALL wrf_message ( message )
490 ! write(message,*) grid%nmm_eta1
491 ! CALL wrf_message ( message )
492
493 CALL input_chem_profile ( grid )
494
495 IF(grid%bio_emiss_opt == BEIS311 ) THEN
496 message = 'READING BEIS3.11 EMISSIONS DATA'
497 CALL wrf_message ( message )
498 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
499 else IF(grid%bio_emiss_opt == 3 ) THEN !shc
500 message = 'READING MEGAN 2 EMISSIONS DATA'
501 CALL wrf_message ( message )
502 CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
503 END IF
504
505 ELSE
506 message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
507 CALL wrf_message ( message )
508 ENDIF
509 ENDIF
510 ENDIF
511 #endif
512
513 config_flags%isurban=1
514 config_flags%isoilwater=14
515
516 CALL assemble_output ( grid , config_flags , loop , time_loop_max )
517
518 ! Here we define the next time that we are going to process.
519
520 CALL geth_newdate ( current_date_char , start_date_char , &
521 loop * model_config_rec%interval_seconds )
522 current_date = current_date_char // '.0000'
523
524 CALL domain_clock_set( grid, current_date(1:19) )
525
526 write(message,*) 'current_date= ', current_date
527 CALL wrf_message(message)
528
529 END DO
530 END SUBROUTINE med_sidata_input
531
532 SUBROUTINE compute_si_start_and_end ( &
533 start_year, start_month, start_day, start_hour, &
534 start_minute, start_second, &
535 end_year , end_month , end_day , end_hour , &
536 end_minute , end_second , &
537 interval_seconds , real_data_init_type , &
538 start_date_char , end_date_char , time_loop_max )
539
540 USE module_date_time
541
542 IMPLICIT NONE
543
544 INTEGER :: start_year , start_month , start_day , &
545 start_hour , start_minute , start_second
546 INTEGER :: end_year , end_month , end_day , &
547 end_hour , end_minute , end_second
548 INTEGER :: interval_seconds , real_data_init_type
549 INTEGER :: time_loop_max , time_loop
550
551 CHARACTER(LEN=132) :: message
552 CHARACTER(LEN=19) :: current_date_char , start_date_char , &
553 end_date_char , next_date_char
554
555 ! WRITE ( start_date_char , FMT = &
556 ! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
557 ! start_year,start_month,start_day,start_hour,start_minute,start_second
558 ! WRITE ( end_date_char , FMT = &
559 ! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
560 ! end_year, end_month, end_day, end_hour, end_minute, end_second
561
562 WRITE ( start_date_char , FMT = &
563 '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
564 start_year,start_month,start_day,start_hour,start_minute,start_second
565 WRITE ( end_date_char , FMT = &
566 '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
567 end_year, end_month, end_day, end_hour, end_minute, end_second
568
569 ! start_date = start_date_char // '.0000'
570
571 ! Figure out our loop count for the processing times.
572
573 time_loop = 1
574 PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
575 ' to process = ',start_date_char,'.'
576 current_date_char = start_date_char
577 loop_count : DO
578 CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
579 IF ( next_date_char .LT. end_date_char ) THEN
580 time_loop = time_loop + 1
581 PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
582 ' to process = ',next_date_char,'.'
583 current_date_char = next_date_char
584 ELSE IF ( next_date_char .EQ. end_date_char ) THEN
585 time_loop = time_loop + 1
586 PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
587 ' to process = ',next_date_char,'.'
588 PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
589 time_loop_max = time_loop
590 EXIT loop_count
591 ELSE IF ( next_date_char .GT. end_date_char ) THEN
592 PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
593 time_loop_max = time_loop
594 EXIT loop_count
595 END IF
596 END DO loop_count
597 write(message,*) 'done in si_start_and_end'
598 CALL wrf_message(message)
599 END SUBROUTINE compute_si_start_and_end
600
601 SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
602
603 !!! replace with something? USE module_big_step_utilities_em
604
605 USE module_domain
606 USE module_io_domain
607 USE module_configure
608 USE module_date_time
609 USE module_bc
610 IMPLICIT NONE
611
612 TYPE(domain) :: grid
613 TYPE (grid_config_rec_type) :: config_flags
614 INTEGER , INTENT(IN) :: loop , time_loop_max
615
616 INTEGER :: ids , ide , jds , jde , kds , kde
617 INTEGER :: ims , ime , jms , jme , kms , kme
618 INTEGER :: ips , ipe , jps , jpe , kps , kpe
619 INTEGER :: ijds , ijde , spec_bdy_width
620 INTEGER :: inc_h,inc_v
621 INTEGER :: i , j , k , idts
622
623 INTEGER :: id1 , interval_seconds , ierr, rc
624 INTEGER , SAVE :: id
625 CHARACTER (LEN=80) :: inpname , bdyname
626 CHARACTER(LEN= 4) :: loop_char
627 CHARACTER(LEN=132) :: message
628 character *19 :: temp19
629 character *24 :: temp24 , temp24b
630
631 REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
632 tbdy3dtemp1 , &
633 cwmbdy3dtemp1 , qbdy3dtemp1,&
634 q2bdy3dtemp1 , pdbdy2dtemp1
635 REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
636 tbdy3dtemp2 , &
637 cwmbdy3dtemp2 , qbdy3dtemp2, &
638 q2bdy3dtemp2, pdbdy2dtemp2
639 REAL :: t1,t2
640
641 #ifdef DEREF_KLUDGE
642 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
643 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
644 INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
645 INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
646 #endif
647
648 #include "deref_kludge.h"
649
650
651 ! Various sizes that we need to be concerned about.
652
653 ids = grid%sd31
654 ide = grid%ed31-1 ! 030730tst
655 jds = grid%sd32
656 jde = grid%ed32-1 ! 030730tst
657 kds = grid%sd33
658 kde = grid%ed33-1 ! 030730tst
659
660 ims = grid%sm31
661 ime = grid%em31
662 jms = grid%sm32
663 jme = grid%em32
664 kms = grid%sm33
665 kme = grid%em33
666
667 ips = grid%sp31
668 ipe = grid%ep31-1 ! 030730tst
669 jps = grid%sp32
670 jpe = grid%ep32-1 ! 030730tst
671 kps = grid%sp33
672 kpe = grid%ep33-1 ! 030730tst
673
674 if (IPE .ne. IDE) IPE=IPE+1
675 if (JPE .ne. JDE) JPE=JPE+1
676
677 write(message,*) 'assemble output (ids,ide): ', ids,ide
678 CALL wrf_message(message)
679 write(message,*) 'assemble output (ims,ime): ', ims,ime
680 CALL wrf_message(message)
681 write(message,*) 'assemble output (ips,ipe): ', ips,ipe
682 CALL wrf_message(message)
683
684 write(message,*) 'assemble output (jds,jde): ', jds,jde
685 CALL wrf_message(message)
686 write(message,*) 'assemble output (jms,jme): ', jms,jme
687 CALL wrf_message(message)
688 write(message,*) 'assemble output (jps,jpe): ', jps,jpe
689 CALL wrf_message(message)
690
691 write(message,*) 'assemble output (kds,kde): ', kds,kde
692 CALL wrf_message(message)
693 write(message,*) 'assemble output (kms,kme): ', kms,kme
694 CALL wrf_message(message)
695 write(message,*) 'assemble output (kps,kpe): ', kps,kpe
696 CALL wrf_message(message)
697
698 ijds = MIN ( ids , jds )
699 !mptest030805 ijde = MAX ( ide , jde )
700 ijde = MAX ( ide , jde ) + 1 ! to make stuff_bdy dimensions consistent with alloc
701
702 ! Boundary width, scalar value.
703
704 spec_bdy_width = model_config_rec%spec_bdy_width
705 interval_seconds = model_config_rec%interval_seconds
706
707 !-----------------------------------------------------------------------
708 !
709 main_loop_test: IF ( loop .EQ. 1 ) THEN
710 !
711 !-----------------------------------------------------------------------
712
713 ! This is the space needed to save the current 3d data for use in computing
714 ! the lateral boundary tendencies.
715
716 ALLOCATE ( ubdy3dtemp1(ims:ime,jms:jme,kms:kme) )
717 ALLOCATE ( vbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
718 ALLOCATE ( tbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
719 ALLOCATE ( qbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
720 ALLOCATE ( cwmbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
721 ALLOCATE ( q2bdy3dtemp1(ims:ime,jms:jme,kms:kme) )
722 ALLOCATE ( pdbdy2dtemp1(ims:ime,jms:jme,1:1) )
723
724 ubdy3dtemp1=0.
725 vbdy3dtemp1=0.
726 tbdy3dtemp1=0.
727 qbdy3dtemp1=0.
728 cwmbdy3dtemp1=0.
729 q2bdy3dtemp1=0.
730 pdbdy2dtemp1=0.
731
732 ALLOCATE ( ubdy3dtemp2(ims:ime,jms:jme,kms:kme) )
733 ALLOCATE ( vbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
734 ALLOCATE ( tbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
735 ALLOCATE ( qbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
736 ALLOCATE ( cwmbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
737 ALLOCATE ( q2bdy3dtemp2(ims:ime,jms:jme,kms:kme) )
738 ALLOCATE ( pdbdy2dtemp2(ims:ime,jms:jme,1:1) )
739
740 ubdy3dtemp2=0.
741 vbdy3dtemp2=0.
742 tbdy3dtemp2=0.
743 qbdy3dtemp2=0.
744 cwmbdy3dtemp2=0.
745 q2bdy3dtemp2=0.
746 pdbdy2dtemp2=0.
747
748 ! Open the wrfinput file. From this program, this is an *output* file.
749
750 CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
751
752 CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
753 output_model_input , "DATASET=INPUT", ierr )
754
755 IF ( ierr .NE. 0 ) THEN
756 CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
757 ENDIF
758
759 ! CALL calc_current_date ( grid%id , 0. )
760 ! grid%write_metadata = .true.
761
762 write(message,*) 'making call to output_model_input'
763 CALL wrf_message(message)
764
765 CALL output_model_input ( id1, grid , config_flags , ierr )
766
767 !***
768 !*** CLOSE THE WRFINPUT DATASET
769 !***
770 CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
771
772 ! We need to save the 3d data to compute a
773 ! difference during the next loop.
774
775 !
776 !-----------------------------------------------------------------------
777 !*** SOUTHERN BOUNDARY
778 !-----------------------------------------------------------------------
779 !
780
781 IF(JPS==JDS)THEN
782 J=1
783 DO k = kps , MIN(kde,kpe)
784 DO i = ips , MIN(ide,ipe)
785 ubdy3dtemp1(i,j,k) = grid%nmm_u(i,j,k)
786 vbdy3dtemp1(i,j,k) = grid%nmm_v(i,j,k)
787 tbdy3dtemp1(i,j,k) = grid%nmm_t(i,j,k)
788 qbdy3dtemp1(i,j,k) = grid%nmm_q(i,j,k)
789 cwmbdy3dtemp1(i,j,k) = grid%nmm_cwm(i,j,k)
790 q2bdy3dtemp1(i,j,k) = grid%nmm_q2(i,j,k)
791 END DO
792 END DO
793
794 DO i = ips , MIN(ide,ipe)
795 pdbdy2dtemp1(i,j,1) = grid%nmm_pd(i,j)
796 END DO
797 ENDIF
798
799 !
800 !-----------------------------------------------------------------------
801 !*** NORTHERN BOUNDARY
802 !-----------------------------------------------------------------------
803 !
804 IF(JPE==JDE)THEN
805 J=MIN(JDE,JPE)
806 DO k = kps , MIN(kde,kpe)
807 DO i = ips , MIN(ide,ipe)
808 ubdy3dtemp1(i,j,k) = grid%nmm_u(i,j,k)
809 vbdy3dtemp1(i,j,k) = grid%nmm_v(i,j,k)
810 tbdy3dtemp1(i,j,k) = grid%nmm_t(i,j,k)
811 qbdy3dtemp1(i,j,k) = grid%nmm_q(i,j,k)
812 cwmbdy3dtemp1(i,j,k) = grid%nmm_cwm(i,j,k)
813 q2bdy3dtemp1(i,j,k) = grid%nmm_q2(i,j,k)
814 END DO
815 END DO
816
817 DO i = ips , MIN(ide,ipe)
818 pdbdy2dtemp1(i,j,1) = grid%nmm_pd(i,j)
819 END DO
820 ENDIF
821
822 !
823 !-----------------------------------------------------------------------
824 !*** WESTERN BOUNDARY
825 !-----------------------------------------------------------------------
826 !
827 write(message,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
828 CALL wrf_message(message)
829
830 IF(IPS==IDS)THEN
831 I=1
832 DO k = kps , MIN(kde,kpe)
833 inc_h=mod(jps+1,2)
834 DO j = jps+inc_h, min(jde,jpe),2
835
836 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
837 tbdy3dtemp1(i,j,k) = grid%nmm_t(i,j,k)
838 qbdy3dtemp1(i,j,k) = grid%nmm_q(i,j,k)
839 cwmbdy3dtemp1(i,j,k) = grid%nmm_cwm(i,j,k)
840 q2bdy3dtemp1(i,j,k) = grid%nmm_q2(i,j,k)
841 if(k==1)then
842 write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
843 CALL wrf_debug(10,message)
844 endif
845 endif
846 END DO
847 END DO
848
849 DO k = kps , MIN(kde,kpe)
850 inc_v=mod(jps,2)
851 DO j = jps+inc_v, min(jde,jpe),2
852 if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
853 ubdy3dtemp1(i,j,k) = grid%nmm_u(i,j,k)
854 vbdy3dtemp1(i,j,k) = grid%nmm_v(i,j,k)
855 endif
856 END DO
857 END DO
858 !
859 inc_h=mod(jps+1,2)
860 DO j = jps+inc_h, min(jde,jpe),2
861 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
862 pdbdy2dtemp1(i,j,1) = grid%nmm_pd(i,j)
863 write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
864 CALL wrf_debug(10,message)
865 endif
866 END DO
867 ENDIF
868 !
869 !-----------------------------------------------------------------------
870 !*** EASTERN BOUNDARY
871 !-----------------------------------------------------------------------
872 !
873 IF(IPE==IDE)THEN
874 I=MIN(IDE,IPE)
875 !
876 DO k = kps , MIN(kde,kpe)
877 !
878 !*** Make sure the J loop is on the global boundary
879 !
880 inc_h=mod(jps+1,2)
881 DO j = jps+inc_h, min(jde,jpe),2
882 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
883 tbdy3dtemp1(i,j,k) = grid%nmm_t(i,j,k)
884 qbdy3dtemp1(i,j,k) = grid%nmm_q(i,j,k)
885 cwmbdy3dtemp1(i,j,k) = grid%nmm_cwm(i,j,k)
886 q2bdy3dtemp1(i,j,k) = grid%nmm_q2(i,j,k)
887 endif
888 END DO
889 END DO
890
891 DO k = kps , MIN(kde,kpe)
892 inc_v=mod(jps,2)
893 DO j = jps+inc_v, min(jde,jpe),2
894 if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
895 ubdy3dtemp1(i,j,k) = grid%nmm_u(i,j,k)
896 vbdy3dtemp1(i,j,k) = grid%nmm_v(i,j,k)
897 endif
898 END DO
899 END DO
900 !
901 inc_h=mod(jps+1,2)
902 DO j = jps+inc_h, min(jde,jpe),2
903 if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
904 pdbdy2dtemp1(i,j,1) = grid%nmm_pd(i,j)
905 endif
906 END DO
907 ENDIF
908
909
910 ! There are 2 components to the lateral boundaries.
911 ! First, there is the starting
912 ! point of this time period - just the outer few rows and columns.
913
914
915 CALL stuff_bdy_ijk (ubdy3dtemp1, grid%nmm_u_bxs, grid%nmm_u_bxe, &
916 grid%nmm_u_bys, grid%nmm_u_bye, &
917 'N', spec_bdy_width , &
918 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
919 ims , ime , jms , jme , kms , kme , &
920 ips , ipe , jps , jpe , kps , kpe+1 )
921
922 CALL stuff_bdy_ijk (vbdy3dtemp1, grid%nmm_v_bxs, grid%nmm_v_bxe, &
923 grid%nmm_v_bys, grid%nmm_v_bye, &
924 'N', spec_bdy_width , &
925 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
926 ims , ime , jms , jme , kms , kme , &
927 ips , ipe , jps , jpe , kps , kpe+1 )
928
929 CALL stuff_bdy_ijk (tbdy3dtemp1, grid%nmm_t_bxs, grid%nmm_t_bxe, &
930 grid%nmm_t_bys, grid%nmm_t_bye, &
931 'N', spec_bdy_width , &
932 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
933 ims , ime , jms , jme , kms , kme , &
934 ips , ipe , jps , jpe , kps , kpe+1 )
935
936 CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%nmm_cwm_bxs, grid%nmm_cwm_bxe, &
937 grid%nmm_cwm_bys, grid%nmm_cwm_bye, &
938 'N', spec_bdy_width , &
939 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
940 ims , ime , jms , jme , kms , kme , &
941 ips , ipe , jps , jpe , kps , kpe+1 )
942
943 CALL stuff_bdy_ijk (qbdy3dtemp1, grid%nmm_q_bxs, grid%nmm_q_bxe, &
944 grid%nmm_q_bys, grid%nmm_q_bye, &
945 'N', spec_bdy_width , &
946 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
947 ims , ime , jms , jme , kms , kme , &
948 ips , ipe , jps , jpe , kps , kpe+1 )
949
950 CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%nmm_q2_bxs, grid%nmm_q2_bxe, &
951 grid%nmm_q2_bys, grid%nmm_q2_bye, &
952 'N', spec_bdy_width , &
953 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
954 ims , ime , jms , jme , kms , kme , &
955 ips , ipe , jps , jpe , kps , kpe+1 )
956
957
958 CALL stuff_bdy_ijk (pdbdy2dtemp1, grid%nmm_pd_bxs, grid%nmm_pd_bxe, &
959 grid%nmm_pd_bys, grid%nmm_pd_bye, &
960 'M', spec_bdy_width, &
961 ids , ide+1 , jds , jde+1 , 1 , 1 , &
962 ims , ime , jms , jme , 1 , 1 , &
963 ips , ipe , jps , jpe , 1 , 1 )
964
965 !-----------------------------------------------------------------------
966 !
967 ELSE IF ( loop .GT. 1 ) THEN
968 !
969 !-----------------------------------------------------------------------
970
971 write(message,*)' assemble_output loop=',loop,' in IF block'
972 call wrf_message(message)
973
974 ! Open the boundary file.
975
976 IF ( loop .eq. 2 ) THEN
977 CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
978 CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
979 output_boundary , "DATASET=BOUNDARY", ierr )
980 IF ( ierr .NE. 0 ) THEN
981 CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
982 ENDIF
983 ! grid%write_metadata = .true.
984 ELSE
985 ! what's this do?
986 ! grid%write_metadata = .true.
987 ! grid%write_metadata = .false.
988 CALL domain_clockadvance( grid )
989 END IF
990
991 !
992 !-----------------------------------------------------------------------
993 !*** SOUTHERN BOUNDARY
994 !-----------------------------------------------------------------------
995 !
996 IF(JPS==JDS)THEN
997 J=1
998 DO k = kps , MIN(kde,kpe)
999 DO i = ips , MIN(ide,ipe)
1000 ubdy3dtemp2(i,j,k) = grid%nmm_u(i,j,k)
1001 vbdy3dtemp2(i,j,k) = grid%nmm_v(i,j,k)
1002 tbdy3dtemp2(i,j,k) = grid%nmm_t(i,j,k)
1003 qbdy3dtemp2(i,j,k) = grid%nmm_q(i,j,k)
1004 cwmbdy3dtemp2(i,j,k) = grid%nmm_cwm(i,j,k)
1005 q2bdy3dtemp2(i,j,k) = grid%nmm_q2(i,j,k)
1006 END DO
1007 END DO
1008 !
1009 DO i = ips , MIN(ide,ipe)
1010 pdbdy2dtemp2(i,j,1) = grid%nmm_pd(i,j)
1011 END DO
1012 ENDIF
1013
1014 !
1015 !-----------------------------------------------------------------------
1016 !*** NORTHERN BOUNDARY
1017 !-----------------------------------------------------------------------
1018 !
1019 IF(JPE==JDE)THEN
1020 J=MIN(JDE,JPE)
1021 DO k = kps , MIN(kde,kpe)
1022 DO i = ips , MIN(ide,ipe)
1023 ubdy3dtemp2(i,j,k) = grid%nmm_u(i,j,k)
1024 vbdy3dtemp2(i,j,k) = grid%nmm_v(i,j,k)
1025 tbdy3dtemp2(i,j,k) = grid%nmm_t(i,j,k)
1026 qbdy3dtemp2(i,j,k) = grid%nmm_q(i,j,k)
1027 cwmbdy3dtemp2(i,j,k) = grid%nmm_cwm(i,j,k)
1028 q2bdy3dtemp2(i,j,k) = grid%nmm_q2(i,j,k)
1029 END DO
1030 END DO
1031
1032 DO i = ips , MIN(ide,ipe)
1033 pdbdy2dtemp2(i,j,1) = grid%nmm_pd(i,j)
1034 END DO
1035 ENDIF
1036 !
1037 !-----------------------------------------------------------------------
1038 !*** WESTERN BOUNDARY
1039 !-----------------------------------------------------------------------
1040 !
1041 IF(IPS==IDS)THEN
1042 I=1
1043 DO k = kps , MIN(kde,kpe)
1044 inc_h=mod(jps+1,2)
1045 if(k==1)then
1046 write(message,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
1047 call wrf_debug(10,message)
1048 endif
1049 DO j = jps+inc_h, MIN(jde,jpe),2
1050 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1051 tbdy3dtemp2(i,j,k) = grid%nmm_t(i,j,k)
1052 if(k==1)then
1053 write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
1054 call wrf_debug(10,message)
1055 endif
1056 qbdy3dtemp2(i,j,k) = grid%nmm_q(i,j,k)
1057 cwmbdy3dtemp2(i,j,k) = grid%nmm_cwm(i,j,k)
1058 q2bdy3dtemp2(i,j,k) = grid%nmm_q2(i,j,k)
1059 endif
1060 END DO
1061 END DO
1062 !
1063 DO k = kps , MIN(kde,kpe)
1064 inc_v=mod(jps,2)
1065 DO j = jps+inc_v, MIN(jde,jpe),2
1066 if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1067 ubdy3dtemp2(i,j,k) = grid%nmm_u(i,j,k)
1068 vbdy3dtemp2(i,j,k) = grid%nmm_v(i,j,k)
1069 endif
1070 END DO
1071 END DO
1072
1073 inc_h=mod(jps+1,2)
1074 DO j = jps+inc_h, MIN(jde,jpe),2
1075 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1076 pdbdy2dtemp2(i,j,1) = grid%nmm_pd(i,j)
1077 write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
1078 CALL wrf_debug(10,message)
1079 endif
1080 END DO
1081 ENDIF
1082 !
1083 !-----------------------------------------------------------------------
1084 !*** EASTERN BOUNDARY
1085 !-----------------------------------------------------------------------
1086 !
1087 IF(IPE==IDE)THEN
1088 I=MIN(IDE,IPE)
1089
1090 DO k = kps , MIN(kde,kpe)
1091 inc_h=mod(jps+1,2)
1092 DO j = jps+inc_h, MIN(jde,jpe),2
1093 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1094 tbdy3dtemp2(i,j,k) = grid%nmm_t(i,j,k)
1095 qbdy3dtemp2(i,j,k) = grid%nmm_q(i,j,k)
1096 cwmbdy3dtemp2(i,j,k) = grid%nmm_cwm(i,j,k)
1097 q2bdy3dtemp2(i,j,k) = grid%nmm_q2(i,j,k)
1098 endif
1099 END DO
1100 END DO
1101
1102 DO k = kps , MIN(kde,kpe)
1103 inc_v=mod(jps,2)
1104 DO j = jps+inc_v, MIN(jde,jpe),2
1105 if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1106 ubdy3dtemp2(i,j,k) = grid%nmm_u(i,j,k)
1107 vbdy3dtemp2(i,j,k) = grid%nmm_v(i,j,k)
1108 endif
1109 END DO
1110 END DO
1111
1112 inc_h=mod(jps+1,2)
1113 DO j = jps+inc_h, MIN(jde,jpe),2
1114 if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1115 pdbdy2dtemp2(i,j,1) = grid%nmm_pd(i,j)
1116 endif
1117 END DO
1118 ENDIF
1119 !-----------------------------------------------------------------------
1120 ! During all of the loops after the first loop,
1121 ! we first compute the boundary
1122 ! tendencies with the current data values
1123 ! (*bdy3dtemp2 arrays) and the previously
1124 ! saved information stored in the *bdy3dtemp1 arrays.
1125
1126
1127 write(0,*) 'ubdy3dtemp2(1,2,1),ubdy3dtemp1(1,2,1): ', ubdy3dtemp2(1,2,1),ubdy3dtemp1(1,2,1)
1128 CALL stuff_bdytend_ijk ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds),&
1129 grid%nmm_u_btxs, grid%nmm_u_btxe, &
1130 grid%nmm_u_btys, grid%nmm_u_btye, &
1131 'N', spec_bdy_width , &
1132 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1133 ims , ime , jms , jme , kms , kme , &
1134 ips , ipe , jps , jpe , kps , kpe+1 )
1135
1136 CALL stuff_bdytend_ijk ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds),&
1137 grid%nmm_v_btxs, grid%nmm_v_btxe, &
1138 grid%nmm_v_btys, grid%nmm_v_btye, &
1139 'N', spec_bdy_width , &
1140 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1141 ims , ime , jms , jme , kms , kme , &
1142 ips , ipe , jps , jpe , kps , kpe+1 )
1143
1144 CALL stuff_bdytend_ijk ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds),&
1145 grid%nmm_t_btxs, grid%nmm_t_btxe, &
1146 grid%nmm_t_btys, grid%nmm_t_btye, &
1147 'N', spec_bdy_width , &
1148 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1149 ims , ime , jms , jme , kms , kme , &
1150 ips , ipe , jps , jpe , kps , kpe+1 )
1151
1152 CALL stuff_bdytend_ijk ( cwmbdy3dtemp2 , cwmbdy3dtemp1 , REAL(interval_seconds),&
1153 grid%nmm_cwm_btxs, grid%nmm_cwm_btxe, &
1154 grid%nmm_cwm_btys, grid%nmm_cwm_btye, &
1155 'N', spec_bdy_width , &
1156 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1157 ims , ime , jms , jme , kms , kme , &
1158 ips , ipe , jps , jpe , kps , kpe+1 )
1159
1160 CALL stuff_bdytend_ijk ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds),&
1161 grid%nmm_q_btxs, grid%nmm_q_btxe, &
1162 grid%nmm_q_btys, grid%nmm_q_btye, &
1163 'N', spec_bdy_width , &
1164 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1165 ims , ime , jms , jme , kms , kme , &
1166 ips , ipe , jps , jpe , kps , kpe+1 )
1167
1168 CALL stuff_bdytend_ijk ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds),&
1169 grid%nmm_q2_btxs, grid%nmm_q2_btxe, &
1170 grid%nmm_q2_btys, grid%nmm_q2_btye, &
1171 'N', spec_bdy_width , &
1172 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1173 ims , ime , jms , jme , kms , kme , &
1174 ips , ipe , jps , jpe , kps , kpe+1 )
1175
1176 CALL stuff_bdytend_ijk( pdbdy2dtemp2 , pdbdy2dtemp1, REAL(interval_seconds),&
1177 grid%nmm_pd_btxs, grid%nmm_pd_btxe, &
1178 grid%nmm_pd_btys, grid%nmm_pd_btye, &
1179 'M', spec_bdy_width , &
1180 ids , ide+1 , jds , jde+1 , 1 , 1 , &
1181 ims , ime , jms , jme , 1 , 1 , &
1182 ips , ipe , jps , jpe , 1 , 1 )
1183
1184
1185
1186 ! Both pieces of the boundary data are now
1187 ! available to be written (initial time and tendency).
1188 ! This looks ugly, these date shifting things.
1189 ! What's it for? We want the "Times" variable
1190 ! in the lateral BDY file to have the valid times
1191 ! of when the initial fields are written.
1192 ! That's what the loop-2 thingy is for with the start date.
1193 ! We increment the start_date so
1194 ! that the starting time in the attributes is the
1195 ! second time period. Why you may ask. I
1196 ! agree, why indeed.
1197
1198 temp24= current_date
1199 temp24b=start_date
1200 start_date = current_date
1201 CALL geth_newdate ( temp19 , temp24b(1:19) , &
1202 (loop-2) * model_config_rec%interval_seconds )
1203 current_date = temp19 // '.0000'
1204 CALL domain_clock_set( grid, current_date(1:19) )
1205 write(message,*) 'LBC valid between these times ',current_date, ' ',start_date
1206 CALL wrf_message(message)
1207
1208 CALL output_boundary ( id, grid , config_flags , ierr )
1209 current_date = temp24
1210 start_date = temp24b
1211
1212 ! OK, for all of the loops, we output the initialzation
1213 ! data, which would allow us to
1214 ! start the model at any of the available analysis time periods.
1215
1216 ! WRITE ( loop_char , FMT = '(I4.4)' ) loop
1217 ! CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
1218 ! IF ( ierr .NE. 0 ) THEN
1219 ! CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
1220 ! ENDIF
1221 ! grid%write_metadata = .true.
1222
1223 ! CALL calc_current_date ( grid%id , 0. )
1224 ! CALL output_model_input ( id1, grid , config_flags , ierr )
1225 ! CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1226
1227 ! Is this or is this not the last time time? We can remove some unnecessary
1228 ! stores if it is not.
1229
1230 IF ( loop .LT. time_loop_max ) THEN
1231
1232 ! We need to save the 3d data to compute a
1233 ! difference during the next loop. Couple the
1234 ! 3d fields with total mu (mub + mu_2) and the
1235 ! stagger-specific map scale factor.
1236 ! We load up the boundary data again for use in the next loop.
1237
1238
1239 !mp change these limits?????????
1240
1241 DO k = kps , kpe
1242 DO j = jps , jpe
1243 DO i = ips , ipe
1244 ubdy3dtemp1(i,j,k) = ubdy3dtemp2(i,j,k)
1245 vbdy3dtemp1(i,j,k) = vbdy3dtemp2(i,j,k)
1246 tbdy3dtemp1(i,j,k) = tbdy3dtemp2(i,j,k)
1247 cwmbdy3dtemp1(i,j,k) = cwmbdy3dtemp2(i,j,k)
1248 qbdy3dtemp1(i,j,k) = qbdy3dtemp2(i,j,k)
1249 q2bdy3dtemp1(i,j,k) = q2bdy3dtemp2(i,j,k)
1250 END DO
1251 END DO
1252 END DO
1253
1254 !mp change these limits?????????
1255
1256 DO j = jps , jpe
1257 DO i = ips , ipe
1258 pdbdy2dtemp1(i,j,1) = pdbdy2dtemp2(i,j,1)
1259 if (J .eq. jpe) write(0,*) 'I,J, PDBDy2dtemp1(i,j,1):' , I,J, PDBDy2dtemp1(i,j,1)
1260 END DO
1261 END DO
1262
1263 ! There are 2 components to the lateral boundaries.
1264 ! First, there is the starting
1265 ! point of this time period - just the outer few rows and columns.
1266
1267 CALL stuff_bdy_ijk (ubdy3dtemp1, grid%nmm_u_bxs, grid%nmm_u_bxe, &
1268 grid%nmm_u_bys, grid%nmm_u_bye, &
1269 'N', spec_bdy_width , &
1270 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1271 ims , ime , jms , jme , kms , kme , &
1272 ips , ipe , jps , jpe , kps , kpe+1 )
1273
1274 CALL stuff_bdy_ijk (vbdy3dtemp1, grid%nmm_v_bxs, grid%nmm_v_bxe, &
1275 grid%nmm_v_bys, grid%nmm_v_bye, &
1276 'N', spec_bdy_width , &
1277 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1278 ims , ime , jms , jme , kms , kme , &
1279 ips , ipe , jps , jpe , kps , kpe+1 )
1280
1281 CALL stuff_bdy_ijk (tbdy3dtemp1, grid%nmm_t_bxs, grid%nmm_t_bxe, &
1282 grid%nmm_t_bys, grid%nmm_t_bye, &
1283 'N', spec_bdy_width , &
1284 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1285 ims , ime , jms , jme , kms , kme , &
1286 ips , ipe , jps , jpe , kps , kpe+1 )
1287
1288 CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%nmm_cwm_bxs, grid%nmm_cwm_bxe, &
1289 grid%nmm_cwm_bys, grid%nmm_cwm_bye, &
1290 'N', spec_bdy_width , &
1291 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1292 ims , ime , jms , jme , kms , kme , &
1293 ips , ipe , jps , jpe , kps , kpe+1 )
1294
1295 CALL stuff_bdy_ijk (qbdy3dtemp1, grid%nmm_q_bxs, grid%nmm_q_bxe, &
1296 grid%nmm_q_bys, grid%nmm_q_bye, &
1297 'N', spec_bdy_width , &
1298 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1299 ims , ime , jms , jme , kms , kme , &
1300 ips , ipe , jps , jpe , kps , kpe+1 )
1301
1302 CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%nmm_q2_bxs, grid%nmm_q2_bxe, &
1303 grid%nmm_q2_bys, grid%nmm_q2_bye, &
1304 'N', spec_bdy_width , &
1305 ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1306 ims , ime , jms , jme , kms , kme , &
1307 ips , ipe , jps , jpe , kps , kpe+1 )
1308
1309 CALL stuff_bdy_ijk (pdbdy2dtemp1,grid%nmm_pd_bxs, grid%nmm_pd_bxe, &
1310 grid%nmm_pd_bys, grid%nmm_pd_bye, &
1311 'M', spec_bdy_width , &
1312 ids , ide+1 , jds , jde+1 , 1 , 1 , &
1313 ims , ime , jms , jme , 1 , 1 , &
1314 ips , ipe , jps , jpe , 1 , 1 )
1315
1316 ELSE IF ( loop .EQ. time_loop_max ) THEN
1317
1318 ! If this is the last time through here, we need to close the files.
1319
1320 CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1321
1322 END IF
1323
1324 END IF main_loop_test
1325
1326 END SUBROUTINE assemble_output