Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

real_nmm.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 60.1 KB

Line
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	USE module_check_a_mundo
14	#ifdef WRF_CHEM
15	USE module_input_chem_data
16	USE module_input_chem_bioemiss
17	#endif
18	USE module_utility
19	#ifdef DM_PARALLEL
20	USE module_dm
21	#endif
22
23	IMPLICIT NONE
24
25	REAL :: time , bdyfrq
26
27	INTEGER :: loop , levels_to_process , debug_level
28
29
30	TYPE(domain) , POINTER :: null_domain
31	TYPE(domain) , POINTER :: grid
32	TYPE (grid_config_rec_type) :: config_flags
33	INTEGER :: number_at_same_level
34
35	INTEGER :: max_dom, domain_id
36	INTEGER :: idum1, idum2
37	#ifdef DM_PARALLEL
38	INTEGER :: nbytes
39	! INTEGER, PARAMETER :: configbuflen = 2*1024
40	INTEGER, PARAMETER :: configbuflen = 4*CONFIG_BUF_LEN
41	INTEGER :: configbuf( configbuflen )
42	LOGICAL , EXTERNAL :: wrf_dm_on_monitor
43	#endif
44
45	INTEGER :: ids , ide , jds , jde , kds , kde
46	INTEGER :: ims , ime , jms , jme , kms , kme
47	INTEGER :: ips , ipe , jps , jpe , kps , kpe
48	INTEGER :: ijds , ijde , spec_bdy_width
49	INTEGER :: i , j , k , idts
50
51	#ifdef DEREF_KLUDGE
52	! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
53	INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
54	INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
55	INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
56	#endif
57
58	CHARACTER (LEN=80) :: message
59
60	INTEGER :: start_year , start_month , start_day
61	INTEGER :: start_hour , start_minute , start_second
62	INTEGER :: end_year , end_month , end_day , &
63	end_hour , end_minute , end_second
64	INTEGER :: interval_seconds , real_data_init_type
65	INTEGER :: time_loop_max , time_loop, rc
66	REAL :: t1,t2
67
68	#include "version_decl"
69
70	INTERFACE
71	SUBROUTINE Setup_Timekeeping( grid )
72	USE module_domain
73	TYPE(domain), POINTER :: grid
74	END SUBROUTINE Setup_Timekeeping
75	END INTERFACE
76
77	! Define the name of this program (program_name defined in module_domain)
78
79	program_name = "REAL_NMM " // TRIM(release_version) // " PREPROCESSOR"
80
81	#ifdef DM_PARALLEL
82	CALL disable_quilting
83	#endif
84
85	! CALL start()
86
87	! Initialize the modules used by the WRF system.
88	! Many of the CALLs made from the
89	! init_modules routine are NO-OPs. Typical initializations
90	! are: the size of a
91	! REAL, setting the file handles to a pre-use value, defining moisture and
92	! chemistry indices, etc.
93
94	CALL wrf_debug ( 100 , 'real_nmm: calling init_modules ' )
95
96	!!!! CALL 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	write(message,*) 'call initial_config'
106	CALL wrf_message ( message )
107	CALL initial_config
108	ENDIF
109	CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
110	CALL wrf_dm_bcast_bytes( configbuf, nbytes )
111	CALL set_config_as_buffer( configbuf, configbuflen )
112	CALL wrf_dm_initialize
113	#else
114	CALL initial_config
115	#endif
116
117	CALL check_nml_consistency
118	CALL set_physics_rconfigs
119
120	CALL nl_get_debug_level ( 1, debug_level )
121	CALL set_wrf_debug_level ( debug_level )
122
123	CALL wrf_message ( program_name )
124
125	! Allocate the space for the mother of all domains.
126
127	NULLIFY( null_domain )
128	CALL wrf_debug ( 100 , 'real_nmm: calling alloc_and_configure_domain ' )
129	CALL alloc_and_configure_domain ( domain_id = 1 , &
130	grid = head_grid , &
131	parent = null_domain , &
132	kid = -1 )
133
134	grid => head_grid
135
136	#include "deref_kludge.h"
137	CALL Setup_Timekeeping ( grid )
138	CALL domain_clock_set( grid, &
139	time_step_seconds=model_config_rec%interval_seconds )
140	CALL wrf_debug ( 100 , 'real_nmm: calling set_scalar_indices_from_config ' )
141	CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
142
143	CALL wrf_debug ( 100 , 'real_nmm: calling model_to_grid_config_rec ' )
144
145	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
146
147	write(message,*) 'after model_to_grid_config_rec, e_we, e_sn are: ', &
148	config_flags%e_we, config_flags%e_sn
149	CALL wrf_message(message)
150
151	! Initialize the WRF IO: open files, init file handles, etc.
152
153	CALL wrf_debug ( 100 , 'real_nmm: calling init_wrfio' )
154	CALL init_wrfio
155
156	! Some of the configuration values may have been modified from the initial READ
157	! of the NAMELIST, so we re-broadcast the configuration records.
158
159	#ifdef DM_PARALLEL
160	CALL wrf_debug ( 100 , 'real_nmm: re-broadcast the configuration records' )
161	CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
162	CALL wrf_dm_bcast_bytes( configbuf, nbytes )
163	CALL set_config_as_buffer( configbuf, configbuflen )
164	#endif
165
166	! No looping in this layer.
167
168	CALL med_sidata_input ( grid , config_flags )
169
170	! We are done.
171
172	CALL wrf_debug ( 0 , 'real_nmm: SUCCESS COMPLETE REAL_NMM INIT' )
173
174	#ifdef DM_PARALLEL
175	CALL wrf_dm_shutdown
176	#endif
177
178	CALL WRFU_Finalize( rc=rc )
179
180	END PROGRAM real_data
181
182	SUBROUTINE med_sidata_input ( grid , config_flags )
183	! Driver layer
184	USE module_domain
185	USE module_io_domain
186	! Model layer
187	USE module_configure
188	USE module_bc_time_utilities
189	USE module_initialize_real
190	USE module_optional_input
191	#ifdef WRF_CHEM
192	USE module_input_chem_data
193	USE module_input_chem_bioemiss
194	#endif
195
196	USE module_si_io_nmm
197
198	USE module_date_time
199
200	IMPLICIT NONE
201
202
203	! Interface
204	INTERFACE
205	SUBROUTINE start_domain ( grid , allowed_to_read )
206	USE module_domain
207	TYPE (domain) grid
208	LOGICAL, INTENT(IN) :: allowed_to_read
209	END SUBROUTINE start_domain
210	END INTERFACE
211
212	! Arguments
213	TYPE(domain) :: grid
214	TYPE (grid_config_rec_type) :: config_flags
215	! Local
216	INTEGER :: time_step_begin_restart
217	INTEGER :: idsi , ierr , myproc
218	CHARACTER (LEN=80) :: si_inpname
219	CHARACTER (LEN=132) :: message
220
221	CHARACTER(LEN=19) :: start_date_char , end_date_char , &
222	current_date_char , next_date_char
223
224	INTEGER :: time_loop_max , loop
225	INTEGER :: julyr , julday , LEN
226
227	INTEGER :: io_form_auxinput1
228	INTEGER, EXTERNAL :: use_package
229
230	LOGICAL :: using_binary_wrfsi
231
232	REAL :: gmt
233	REAL :: t1,t2
234
235	INTEGER :: numx_sm_levels_input,numx_st_levels_input
236	REAL,DIMENSION(100) :: smx_levels_input,stx_levels_input
237
238
239	#ifdef DEREF_KLUDGE
240	! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
241	INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
242	INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
243	INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
244	#endif
245
246	#if defined(HWRF)
247	! Sam Says:
248
249	! The *INIT arrays are used to read init data written out by hwrf_prep_hybrid
250	REAL,ALLOCATABLE,DIMENSION(:,:,:)::TINIT,UINIT,VINIT,QINIT,CWMINIT
251	REAL,ALLOCATABLE,DIMENSION(:,:,:)::PINIT
252	REAL,ALLOCATABLE,DIMENSION(:,:)::PDINIT
253
254	! The *B arrays are used to read boundary data written out by hwrf_prep_hybrid
255	REAL,ALLOCATABLE,DIMENSION(:,:,:)::TB,UB,VB,QB,CWMB
256	REAL,ALLOCATABLE,DIMENSION(:,:)::PDB
257
258	INTEGER :: KB, LM, IM, JM, iunit_gfs, N
259
260	integer :: i,j,k
261	LOGICAL,EXTERNAL :: WRF_DM_ON_MONITOR
262	integer :: ids,ide, jds,jde, kds,kde
263	integer :: ims,ime, jms,jme, kms,kme
264	integer :: its,ite, jts,jte, kts,kte
265
266	integer :: ioerror
267	#endif
268
269	#include "deref_kludge.h"
270
271
272	grid%input_from_file = .true.
273	grid%input_from_file = .false.
274
275	CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
276	model_config_rec%start_month (grid%id) , &
277	model_config_rec%start_day (grid%id) , &
278	model_config_rec%start_hour (grid%id) , &
279	model_config_rec%start_minute(grid%id) , &
280	model_config_rec%start_second(grid%id) , &
281	model_config_rec% end_year (grid%id) , &
282	model_config_rec% end_month (grid%id) , &
283	model_config_rec% end_day (grid%id) , &
284	model_config_rec% end_hour (grid%id) , &
285	model_config_rec% end_minute(grid%id) , &
286	model_config_rec% end_second(grid%id) , &
287	model_config_rec%interval_seconds , &
288	model_config_rec%real_data_init_type , &
289	start_date_char , end_date_char , time_loop_max )
290
291	! Here we define the initial time to process, for later use by the code.
292
293	current_date_char = start_date_char
294	! start_date = start_date_char // '.0000'
295	start_date = start_date_char
296	current_date = start_date
297
298	CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
299
300	! Loop over each time period to process.
301
302	write(message,*) 'time_loop_max: ', time_loop_max
303	CALL wrf_message(message)
304	DO loop = 1 , time_loop_max
305
306	internal_time_loop=loop
307
308	write(message,*) 'loop=', loop
309	CALL wrf_message(message)
310
311	write(message,*) '-----------------------------------------------------------'
312	CALL wrf_message(message)
313
314	write(message,*) ' '
315	CALL wrf_message(message)
316	write(message,'(A,A,A,I2,A,I2)') ' Current date being processed: ', &
317	current_date, ', which is loop #',loop,' out of ',time_loop_max
318	CALL wrf_message(message)
319
320	! After current_date has been set, fill in the julgmt stuff.
321
322	CALL geth_julgmt ( config_flags%julyr , config_flags%julday , &
323	config_flags%gmt )
324
325	! Now that the specific Julian info is available,
326	! save these in the model config record.
327
328	CALL nl_set_gmt (grid%id, config_flags%gmt)
329	CALL nl_set_julyr (grid%id, config_flags%julyr)
330	CALL nl_set_julday (grid%id, config_flags%julday)
331
332	CALL nl_get_io_form_auxinput1( 1, io_form_auxinput1 )
333	using_binary_wrfsi=.false.
334
335
336	write(message,*) 'TRIM(config_flags%auxinput1_inname): ', TRIM(config_flags%auxinput1_inname)
337	CALL wrf_message(message)
338
339	#if defined(HWRF)
340	ifph_onlyfirst: if(.not.grid%use_prep_hybrid .or. loop==1) then
341	#endif
342	IF (config_flags%auxinput1_inname(1:10) .eq. 'real_input') THEN
343	using_binary_wrfsi=.true.
344	ENDIF
345
346	SELECT CASE ( use_package(io_form_auxinput1) )
347	#ifdef NETCDF
348	CASE ( IO_NETCDF )
349
350	! Open the wrfinput file.
351
352	current_date_char(11:11)='_'
353
354	WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
355	CALL wrf_debug ( 100 , wrf_err_message )
356	IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
357	CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
358	config_flags%io_form_auxinput1 )
359	ELSE
360	CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
361	END IF
362	CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
363
364	IF ( ierr .NE. 0 ) THEN
365	CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
366	ENDIF
367
368	! Input data.
369
370	CALL wrf_debug (100, 'med_sidata_input: call input_auxinput1_wrf')
371
372	CALL input_auxinput1 ( idsi, grid, config_flags, ierr )
373
374	! Possible optional SI input. This sets flags used by init_domain.
375
376	IF ( loop .EQ. 1 ) THEN
377	CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
378	CALL init_module_optional_input ( grid , config_flags )
379	CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
380	!
381	CALL optional_input ( grid , idsi , config_flags )
382	write(0,*) 'maxval st_input(1) within real_nmm: ', maxval(st_input(:,1,:))
383	END IF
384	!
385	CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
386
387	#endif
388	#ifdef INTIO
389	CASE ( IO_INTIO )
390
391	! Possible optional SI input. This sets flags used by init_domain.
392
393	IF ( loop .EQ. 1 ) THEN
394	CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
395	CALL init_module_optional_input ( grid , config_flags )
396	END IF
397
398	IF (using_binary_wrfsi) THEN
399
400	current_date_char(11:11)='_'
401	CALL read_si ( grid, current_date_char )
402	current_date_char(11:11)='T'
403
404	ELSE
405
406	write(message,*) 'binary WPS branch'
407	CALL wrf_message(message)
408	current_date_char(11:11)='_'
409	CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
410	config_flags%io_form_auxinput1 )
411	CALL read_wps ( grid, trim(si_inpname), current_date_char, config_flags%num_metgrid_levels )
412	!!! bogus set some flags??
413	flag_metgrid=1
414	flag_soilhgt=1
415
416
417	ENDIF
418
419	#endif
420	CASE DEFAULT
421	CALL wrf_error_fatal('real: not valid io_form_auxinput1')
422	END SELECT
423	#if defined(HWRF)
424	endif ifph_onlyfirst
425	#endif
426
427	grid%islope=1
428	grid%vegfra=grid%vegfrc
429	grid%dfrlg=grid%dfl/9.81
430
431	grid%isurban=1
432	grid%isoilwater=14
433
434	! Initialize the mother domain for this time period with input data.
435
436	CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
437	grid%input_from_file = .true.
438
439	CALL init_domain ( grid )
440
441	#if defined(HWRF)
442	read_phinit: if(grid%use_prep_hybrid) then
443	#if defined(DM_PARALLEL)
444	if(.not. wrf_dm_on_monitor()) then
445	call wrf_error_fatal('real: in use_prep_hybrid mode, threading and mpi are forbidden.')
446	endif
447	#endif
448
449	ph_loop1: if(loop==1) then
450
451	! determine kds, ids, jds
452	SELECT CASE ( model_data_order )
453	CASE ( DATA_ORDER_ZXY )
454	kds = grid%sd31 ; kde = grid%ed31 ;
455	ids = grid%sd32 ; ide = grid%ed32 ;
456	jds = grid%sd33 ; jde = grid%ed33 ;
457
458	kms = grid%sm31 ; kme = grid%em31 ;
459	ims = grid%sm32 ; ime = grid%em32 ;
460	jms = grid%sm33 ; jme = grid%em33 ;
461
462	kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
463	its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
464	jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
465
466	CASE ( DATA_ORDER_XYZ )
467	ids = grid%sd31 ; ide = grid%ed31 ;
468	jds = grid%sd32 ; jde = grid%ed32 ;
469	kds = grid%sd33 ; kde = grid%ed33 ;
470
471	ims = grid%sm31 ; ime = grid%em31 ;
472	jms = grid%sm32 ; jme = grid%em32 ;
473	kms = grid%sm33 ; kme = grid%em33 ;
474
475	its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
476	jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
477	kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
478
479	CASE ( DATA_ORDER_XZY )
480	ids = grid%sd31 ; ide = grid%ed31 ;
481	kds = grid%sd32 ; kde = grid%ed32 ;
482	jds = grid%sd33 ; jde = grid%ed33 ;
483
484	ims = grid%sm31 ; ime = grid%em31 ;
485	kms = grid%sm32 ; kme = grid%em32 ;
486	jms = grid%sm33 ; jme = grid%em33 ;
487
488	its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
489	kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
490	jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
491
492	END SELECT
493	! Allocate 3D initialization arrays:
494	call wrf_message('ALLOCATE PREP_HYBRID INIT ARRAYS')
495	ALLOCATE ( TINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
496	ALLOCATE ( PINIT (ids:(ide-1),kds:kde ,jds:(jde-1)) )
497	ALLOCATE ( UINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
498	ALLOCATE ( VINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
499	ALLOCATE ( QINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
500	ALLOCATE ( CWMINIT(ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
501	ALLOCATE ( PDINIT (ids:(ide-1), jds:(jde-1)) )
502
503	REWIND 900
504	READ(900,iostat=ioerror) PDINIT,TINIT,QINIT,CWMINIT,UINIT,VINIT,PINIT
505	if(ioerror/=0) then
506	call wrf_error_fatal('Unable to read MAKBND output from unit 900.')
507	endif
508	WRITE(0,*) 'U V T AT 10 10 10 ',UINIT(10,10,10),VINIT(10,10,10),TINIT(10,10,10)
509	! Switch from IKJ to IJK ordering
510	DO I = ids,ide-1
511	DO J = jds,jde-1
512	grid%pd(I,J) = PDINIT(I,J)
513	DO K = kds,kde-1
514	grid%q2(I,J,K) = 0
515	grid%u(I,J,K) = UINIT(I,K,J)
516	grid%v(I,J,K) = VINIT(I,K,J)
517	grid%t(I,J,K) = TINIT(I,K,J)
518	grid%q(I,J,K) = QINIT(I,K,J)
519	grid%cwm(I,J,K) = CWMINIT(I,K,J)
520	ENDDO
521	! Was commented out in original V2 HWRF too:
522	! DO K = kds,kde
523	! grid%nmm_pint(I,J,K) = pinit(I,K,J)
524	! ENDDO
525	ENDDO
526	ENDDO
527
528	call wrf_message('DEALLOCATE PREP_HYBRID INIT ARRAYS')
529	deallocate(TINIT,PINIT,UINIT,VINIT,QINIT,CWMINIT,PDINIT)
530	end if ph_loop1
531	end if read_phinit
532	#endif
533
534	CALL model_to_grid_config_rec ( grid%id, model_config_rec, config_flags )
535
536	! Close this file that is output from the SI and input to this pre-proc.
537
538	CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
539
540
541	!!! not sure about this, but doesnt seem like needs to be called each time
542	IF ( loop .EQ. 1 ) THEN
543	CALL start_domain ( grid , .TRUE.)
544	END IF
545
546	#ifdef WRF_CHEM
547	IF ( loop == 1 ) THEN
548	! IF ( ( grid%chem_opt .EQ. RADM2 ) .OR. &
549	! ( grid%chem_opt .EQ. RADM2SORG ) .OR. &
550	! ( grid%chem_opt .EQ. RACM ) .OR. &
551	! ( grid%chem_opt .EQ. RACMSORG ) ) THEN
552	IF( grid%chem_opt > 0 ) then
553	! Read the chemistry data from a previous wrf forecast (wrfout file)
554	IF(grid%chem_in_opt == 1 ) THEN
555	message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
556	CALL wrf_message ( message )
557
558	CALL input_ext_chem_file( grid )
559
560	IF(grid%bio_emiss_opt == BEIS311 ) THEN
561	message = 'READING BEIS3.11 EMISSIONS DATA'
562	CALL wrf_message ( message )
563	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
564	else IF(grid%bio_emiss_opt == 3 ) THEN !shc
565	message = 'READING MEGAN 2 EMISSIONS DATA'
566	CALL wrf_message ( message )
567	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
568	END IF
569
570	ELSEIF(grid%chem_in_opt == 0)then
571	! Generate chemistry data from a idealized vertical profile
572	message = 'STARTING WITH BACKGROUND CHEMISTRY '
573	CALL wrf_message ( message )
574
575	write(message,*)' ETA1 '
576	CALL wrf_message ( message )
577	! write(message,*) grid%eta1
578	! CALL wrf_message ( message )
579
580	CALL input_chem_profile ( grid )
581
582	IF(grid%bio_emiss_opt == BEIS311 ) THEN
583	message = 'READING BEIS3.11 EMISSIONS DATA'
584	CALL wrf_message ( message )
585	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
586	else IF(grid%bio_emiss_opt == 3 ) THEN !shc
587	message = 'READING MEGAN 2 EMISSIONS DATA'
588	CALL wrf_message ( message )
589	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
590	END IF
591
592	ELSE
593	message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
594	CALL wrf_message ( message )
595	ENDIF
596	ENDIF
597	ENDIF
598	#endif
599
600	config_flags%isurban=1
601	config_flags%isoilwater=14
602
603	CALL assemble_output ( grid , config_flags , loop , time_loop_max )
604
605	! Here we define the next time that we are going to process.
606
607	CALL geth_newdate ( current_date_char , start_date_char , &
608	loop * model_config_rec%interval_seconds )
609	current_date = current_date_char // '.0000'
610
611	CALL domain_clock_set( grid, current_date(1:19) )
612
613	write(message,*) 'current_date= ', current_date
614	CALL wrf_message(message)
615
616	END DO
617	END SUBROUTINE med_sidata_input
618
619	SUBROUTINE compute_si_start_and_end ( &
620	start_year, start_month, start_day, start_hour, &
621	start_minute, start_second, &
622	end_year , end_month , end_day , end_hour , &
623	end_minute , end_second , &
624	interval_seconds , real_data_init_type , &
625	start_date_char , end_date_char , time_loop_max )
626
627	USE module_date_time
628
629	IMPLICIT NONE
630
631	INTEGER :: start_year , start_month , start_day , &
632	start_hour , start_minute , start_second
633	INTEGER :: end_year , end_month , end_day , &
634	end_hour , end_minute , end_second
635	INTEGER :: interval_seconds , real_data_init_type
636	INTEGER :: time_loop_max , time_loop
637
638	CHARACTER(LEN=132) :: message
639	CHARACTER(LEN=19) :: current_date_char , start_date_char , &
640	end_date_char , next_date_char
641
642	! WRITE ( start_date_char , FMT = &
643	! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
644	! start_year,start_month,start_day,start_hour,start_minute,start_second
645	! WRITE ( end_date_char , FMT = &
646	! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
647	! end_year, end_month, end_day, end_hour, end_minute, end_second
648
649	WRITE ( start_date_char , FMT = &
650	'(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
651	start_year,start_month,start_day,start_hour,start_minute,start_second
652	WRITE ( end_date_char , FMT = &
653	'(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
654	end_year, end_month, end_day, end_hour, end_minute, end_second
655
656	! start_date = start_date_char // '.0000'
657
658	! Figure out our loop count for the processing times.
659
660	time_loop = 1
661	PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
662	' to process = ',start_date_char,'.'
663	current_date_char = start_date_char
664	loop_count : DO
665	CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
666	IF ( next_date_char .LT. end_date_char ) THEN
667	time_loop = time_loop + 1
668	PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
669	' to process = ',next_date_char,'.'
670	current_date_char = next_date_char
671	ELSE IF ( next_date_char .EQ. end_date_char ) THEN
672	time_loop = time_loop + 1
673	PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
674	' to process = ',next_date_char,'.'
675	PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
676	time_loop_max = time_loop
677	EXIT loop_count
678	ELSE IF ( next_date_char .GT. end_date_char ) THEN
679	PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
680	time_loop_max = time_loop
681	EXIT loop_count
682	END IF
683	END DO loop_count
684	write(message,*) 'done in si_start_and_end'
685	CALL wrf_message(message)
686	END SUBROUTINE compute_si_start_and_end
687
688	SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
689
690	!!! replace with something? USE module_big_step_utilities_em
691
692	USE module_domain
693	USE module_io_domain
694	USE module_configure
695	USE module_date_time
696	USE module_bc
697	IMPLICIT NONE
698
699	#if defined(HWRF)
700	external get_wrf_debug_level
701	integer :: debug
702	#endif
703
704	TYPE(domain) :: grid
705	TYPE (grid_config_rec_type) :: config_flags
706	INTEGER , INTENT(IN) :: loop , time_loop_max
707
708	INTEGER :: ids , ide , jds , jde , kds , kde
709	INTEGER :: ims , ime , jms , jme , kms , kme
710	INTEGER :: ips , ipe , jps , jpe , kps , kpe
711	INTEGER :: ijds , ijde , spec_bdy_width
712	INTEGER :: inc_h,inc_v
713	INTEGER :: i , j , k , idts
714
715	INTEGER :: id1 , interval_seconds , ierr, rc, sst_update
716	INTEGER , SAVE :: id ,id4
717	CHARACTER (LEN=80) :: inpname , bdyname
718	CHARACTER(LEN= 4) :: loop_char
719	CHARACTER(LEN=132) :: message
720	character *19 :: temp19
721	character *24 :: temp24 , temp24b
722
723	REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
724	tbdy3dtemp1 , &
725	cwmbdy3dtemp1 , qbdy3dtemp1,&
726	q2bdy3dtemp1 , pdbdy2dtemp1
727	REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
728	tbdy3dtemp2 , &
729	cwmbdy3dtemp2 , qbdy3dtemp2, &
730	q2bdy3dtemp2, pdbdy2dtemp2
731	REAL :: t1,t2
732
733	#ifdef DEREF_KLUDGE
734	! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
735	INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
736	INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
737	INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
738	#endif
739
740	#if defined(HWRF)
741	! Sam says:
742
743	! The *B arrays are used to read boundary data written out by hwrf_prep_hybrid
744	REAL,ALLOCATABLE,DIMENSION(:,:,:)::TB,UB,VB,QB,CWMB
745	REAL,ALLOCATABLE,DIMENSION(:,:)::PDB
746
747	! Dimensions and looping variables:
748	INTEGER :: KB, LM, IM, JM, N
749
750	! Unit number to read boundary data from (changes each time)
751	INTEGER :: iunit_gfs
752
753	! Did we allocate the prep_hybrid input arrays?
754	LOGICAL :: alloc_ph_arrays
755
756	integer :: ioerror
757	#endif
758
759	#include "deref_kludge.h"
760
761	#if defined(HWRF)
762	alloc_ph_arrays=.false.
763	call get_wrf_debug_level(debug)
764	#endif
765
766	! Various sizes that we need to be concerned about.
767
768	ids = grid%sd31
769	ide = grid%ed31-1 ! 030730tst
770	jds = grid%sd32
771	jde = grid%ed32-1 ! 030730tst
772	kds = grid%sd33
773	kde = grid%ed33-1 ! 030730tst
774
775	ims = grid%sm31
776	ime = grid%em31
777	jms = grid%sm32
778	jme = grid%em32
779	kms = grid%sm33
780	kme = grid%em33
781
782	ips = grid%sp31
783	ipe = grid%ep31-1 ! 030730tst
784	jps = grid%sp32
785	jpe = grid%ep32-1 ! 030730tst
786	kps = grid%sp33
787	kpe = grid%ep33-1 ! 030730tst
788
789	if (IPE .ne. IDE) IPE=IPE+1
790	if (JPE .ne. JDE) JPE=JPE+1
791
792	write(message,*) 'assemble output (ids,ide): ', ids,ide
793	CALL wrf_message(message)
794	write(message,*) 'assemble output (ims,ime): ', ims,ime
795	CALL wrf_message(message)
796	write(message,*) 'assemble output (ips,ipe): ', ips,ipe
797	CALL wrf_message(message)
798
799	write(message,*) 'assemble output (jds,jde): ', jds,jde
800	CALL wrf_message(message)
801	write(message,*) 'assemble output (jms,jme): ', jms,jme
802	CALL wrf_message(message)
803	write(message,*) 'assemble output (jps,jpe): ', jps,jpe
804	CALL wrf_message(message)
805
806	write(message,*) 'assemble output (kds,kde): ', kds,kde
807	CALL wrf_message(message)
808	write(message,*) 'assemble output (kms,kme): ', kms,kme
809	CALL wrf_message(message)
810	write(message,*) 'assemble output (kps,kpe): ', kps,kpe
811	CALL wrf_message(message)
812
813	ijds = MIN ( ids , jds )
814	!mptest030805 ijde = MAX ( ide , jde )
815	ijde = MAX ( ide , jde ) + 1 ! to make stuff_bdy dimensions consistent with alloc
816
817	! Boundary width, scalar value.
818
819	spec_bdy_width = model_config_rec%spec_bdy_width
820	interval_seconds = model_config_rec%interval_seconds
821	sst_update = model_config_rec%sst_update
822
823	!-----------------------------------------------------------------------
824	!
825	main_loop_test: IF ( loop .EQ. 1 ) THEN
826	!
827	!-----------------------------------------------------------------------
828
829	IF ( time_loop_max .NE. 1 ) THEN
830	IF(sst_update .EQ. 1)THEN
831	CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
832	CALL open_w_dataset ( id4, TRIM(inpname) , grid , config_flags , output_auxinput4 , "DATASET=AUXINPUT4", ierr )
833	IF ( ierr .NE. 0 ) THEN
834	CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
835	END IF
836	CALL output_auxinput4 ( id4, grid , config_flags , ierr )
837	END IF
838	END IF
839
840
841	! This is the space needed to save the current 3d data for use in computing
842	! the lateral boundary tendencies.
843
844	ALLOCATE ( ubdy3dtemp1(ims:ime,jms:jme,kms:kme) )
845	ALLOCATE ( vbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
846	ALLOCATE ( tbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
847	ALLOCATE ( qbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
848	ALLOCATE ( cwmbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
849	ALLOCATE ( q2bdy3dtemp1(ims:ime,jms:jme,kms:kme) )
850	ALLOCATE ( pdbdy2dtemp1(ims:ime,jms:jme,1:1) )
851
852	ubdy3dtemp1=0.
853	vbdy3dtemp1=0.
854	tbdy3dtemp1=0.
855	qbdy3dtemp1=0.
856	cwmbdy3dtemp1=0.
857	q2bdy3dtemp1=0.
858	pdbdy2dtemp1=0.
859
860	ALLOCATE ( ubdy3dtemp2(ims:ime,jms:jme,kms:kme) )
861	ALLOCATE ( vbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
862	ALLOCATE ( tbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
863	ALLOCATE ( qbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
864	ALLOCATE ( cwmbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
865	ALLOCATE ( q2bdy3dtemp2(ims:ime,jms:jme,kms:kme) )
866	ALLOCATE ( pdbdy2dtemp2(ims:ime,jms:jme,1:1) )
867
868	ubdy3dtemp2=0.
869	vbdy3dtemp2=0.
870	tbdy3dtemp2=0.
871	qbdy3dtemp2=0.
872	cwmbdy3dtemp2=0.
873	q2bdy3dtemp2=0.
874	pdbdy2dtemp2=0.
875
876	! Open the wrfinput file. From this program, this is an output file.
877
878	CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
879
880	CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
881	output_input , "DATASET=INPUT", ierr )
882
883	IF ( ierr .NE. 0 ) THEN
884	CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
885	ENDIF
886
887	! CALL calc_current_date ( grid%id , 0. )
888	! grid%write_metadata = .true.
889
890	write(message,*) 'making call to output_input'
891	CALL wrf_message(message)
892
893	CALL output_input ( id1, grid , config_flags , ierr )
894
895	!***
896	!*** CLOSE THE WRFINPUT DATASET
897	!***
898	CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
899
900	! We need to save the 3d data to compute a
901	! difference during the next loop.
902
903	!
904	!-----------------------------------------------------------------------
905	!*** SOUTHERN BOUNDARY
906	!-----------------------------------------------------------------------
907	!
908
909	IF(JPS==JDS)THEN
910	J=1
911	DO k = kps , MIN(kde,kpe)
912	DO i = ips , MIN(ide,ipe)
913	ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
914	vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
915	tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
916	qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
917	cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
918	q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
919	END DO
920	END DO
921
922	DO i = ips , MIN(ide,ipe)
923	pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
924	END DO
925	ENDIF
926
927	!
928	!-----------------------------------------------------------------------
929	!*** NORTHERN BOUNDARY
930	!-----------------------------------------------------------------------
931	!
932	IF(JPE==JDE)THEN
933	J=MIN(JDE,JPE)
934	DO k = kps , MIN(kde,kpe)
935	DO i = ips , MIN(ide,ipe)
936	ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
937	vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
938	tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
939	qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
940	cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
941	q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
942	END DO
943	END DO
944
945	DO i = ips , MIN(ide,ipe)
946	pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
947	END DO
948	ENDIF
949
950	!
951	!-----------------------------------------------------------------------
952	!*** WESTERN BOUNDARY
953	!-----------------------------------------------------------------------
954	!
955	write(message,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
956	CALL wrf_message(message)
957
958	IF(IPS==IDS)THEN
959	I=1
960	DO k = kps , MIN(kde,kpe)
961	inc_h=mod(jps+1,2)
962	DO j = jps+inc_h, min(jde,jpe),2
963
964	if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
965	tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
966	qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
967	cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
968	q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
969	if(k==1)then
970	write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
971	CALL wrf_debug(10,message)
972	endif
973	endif
974	END DO
975	END DO
976
977	DO k = kps , MIN(kde,kpe)
978	inc_v=mod(jps,2)
979	DO j = jps+inc_v, min(jde,jpe),2
980	if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
981	ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
982	vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
983	endif
984	END DO
985	END DO
986	!
987	inc_h=mod(jps+1,2)
988	DO j = jps+inc_h, min(jde,jpe),2
989	if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
990	pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
991	write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
992	CALL wrf_debug(10,message)
993	endif
994	END DO
995	ENDIF
996	!
997	!-----------------------------------------------------------------------
998	!*** EASTERN BOUNDARY
999	!-----------------------------------------------------------------------
1000	!
1001	IF(IPE==IDE)THEN
1002	I=MIN(IDE,IPE)
1003	!
1004	DO k = kps , MIN(kde,kpe)
1005	!
1006	!*** Make sure the J loop is on the global boundary
1007	!
1008	inc_h=mod(jps+1,2)
1009	DO j = jps+inc_h, min(jde,jpe),2
1010	if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
1011	tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
1012	qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
1013	cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
1014	q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
1015	endif
1016	END DO
1017	END DO
1018
1019	DO k = kps , MIN(kde,kpe)
1020	inc_v=mod(jps,2)
1021	DO j = jps+inc_v, min(jde,jpe),2
1022	if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
1023	ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
1024	vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
1025	endif
1026	END DO
1027	END DO
1028	!
1029	inc_h=mod(jps+1,2)
1030	DO j = jps+inc_h, min(jde,jpe),2
1031	if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
1032	pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
1033	endif
1034	END DO
1035	ENDIF
1036
1037
1038	! There are 2 components to the lateral boundaries.
1039	! First, there is the starting
1040	! point of this time period - just the outer few rows and columns.
1041
1042
1043	CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
1044	grid%u_bys, grid%u_bye, &
1045	'N', spec_bdy_width , &
1046	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1047	ims , ime , jms , jme , kms , kme , &
1048	ips , ipe , jps , jpe , kps , kpe+1 )
1049
1050	CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
1051	grid%v_bys, grid%v_bye, &
1052	'N', spec_bdy_width , &
1053	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1054	ims , ime , jms , jme , kms , kme , &
1055	ips , ipe , jps , jpe , kps , kpe+1 )
1056
1057	CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
1058	grid%t_bys, grid%t_bye, &
1059	'N', spec_bdy_width , &
1060	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1061	ims , ime , jms , jme , kms , kme , &
1062	ips , ipe , jps , jpe , kps , kpe+1 )
1063
1064	CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
1065	grid%cwm_bys, grid%cwm_bye, &
1066	'N', spec_bdy_width , &
1067	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1068	ims , ime , jms , jme , kms , kme , &
1069	ips , ipe , jps , jpe , kps , kpe+1 )
1070
1071	CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
1072	grid%q_bys, grid%q_bye, &
1073	'N', spec_bdy_width , &
1074	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1075	ims , ime , jms , jme , kms , kme , &
1076	ips , ipe , jps , jpe , kps , kpe+1 )
1077
1078	CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
1079	grid%q2_bys, grid%q2_bye, &
1080	'N', spec_bdy_width , &
1081	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1082	ims , ime , jms , jme , kms , kme , &
1083	ips , ipe , jps , jpe , kps , kpe+1 )
1084
1085
1086	CALL stuff_bdy_ijk (pdbdy2dtemp1, grid%pd_bxs, grid%pd_bxe, &
1087	grid%pd_bys, grid%pd_bye, &
1088	'M', spec_bdy_width, &
1089	ids , ide+1 , jds , jde+1 , 1 , 1 , &
1090	ims , ime , jms , jme , 1 , 1 , &
1091	ips , ipe , jps , jpe , 1 , 1 )
1092
1093	!-----------------------------------------------------------------------
1094	!
1095	ELSE IF ( loop .GT. 1 ) THEN
1096	!
1097	!-----------------------------------------------------------------------
1098
1099	call wrf_debug(1,'LOOP>1, so start making non-init boundary conditions')
1100	#if defined(HWRF)
1101
1102	bdytmp_useph: if(grid%use_prep_hybrid) then
1103	call wrf_debug(1,'ALLOCATE PREP_HYBRID BOUNDARY ARRAYS')
1104	!! When running in prep_hybrid mode, we must read in the data here.
1105
1106	! Allocate boundary arrays:
1107	KB = 2*IDE + JDE - 3
1108	LM = KDE
1109	IM = IDE
1110	JM = JDE
1111	ALLOCATE(TB(KB,LM,2))
1112	ALLOCATE(QB(KB,LM,2))
1113	ALLOCATE(CWMB(KB,LM,2))
1114	ALLOCATE(UB(KB,LM,2))
1115	ALLOCATE(VB(KB,LM,2))
1116	ALLOCATE(PDB(KB,2))
1117	alloc_ph_arrays=.true.
1118
1119	! Read in the data:
1120	IUNIT_GFS = 900 + LOOP - 1
1121	READ(IUNIT_GFS,iostat=ioerror) PDB,TB,QB,CWMB,UB,VB
1122	if(ioerror/=0) then
1123	call wrf_error_fatal('Unable to read MAKBND output from unit 900.')
1124	endif
1125
1126	! Now copy the data into the temporary boundary arrays, and
1127	! switch from IKJ to IJK while we do it.
1128
1129	!! Southern boundary
1130
1131	IF(JPS.EQ.JDS)THEN
1132	J=1
1133
1134	DO k = kps , MIN(kde,kpe)
1135	N=1
1136	DO i = ips , MIN(ide,ipe)
1137	tbdy3dtemp2(i,j,k) = TB(N,k,1)
1138	qbdy3dtemp2(i,j,k) = QB(N,k,1)
1139	cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
1140	q2bdy3dtemp2(i,j,k) = 0.0 !KWON
1141	write(message,*)'southtend t',k,i,n,tbdy3dtemp2(i,j,k)
1142	call wrf_debug(10,message)
1143	write(message,*)'southtend q',k,i,n,qbdy3dtemp2(i,j,k)
1144	call wrf_debug(10,message)
1145	if (K .eq. 1 ) then
1146	write(0,*) 'S boundary values T,Q : ', I,tbdy3dtemp2(i,j,k), &
1147	qbdy3dtemp2(i,j,k)
1148	endif
1149	N=N+1
1150	END DO
1151	END DO
1152
1153	DO k = kps , MIN(kde,kpe)
1154	N=1
1155	DO i = ips , MIN(ide,ipe)
1156	ubdy3dtemp2(i,j,k) = UB(N,k,1)
1157	vbdy3dtemp2(i,j,k) = VB(N,k,1)
1158	N=N+1
1159	ENDDO
1160	END DO
1161
1162	N=1
1163	DO i = ips , MIN(ide,ipe)
1164	pdbdy2dtemp2(i,j,1) = PDB(N,1)
1165	write(message,*)'southtend p',i,n,pdbdy2dtemp1(i,j,1)
1166	call wrf_debug(10,message)
1167	N=N+1
1168	END DO
1169
1170	ENDIF
1171
1172	! Northern boundary
1173
1174	IF(JPE.EQ.JDE)THEN
1175
1176	J=MIN(JDE,JPE)
1177	DO k = kps , MIN(kde,kpe)
1178	N=IM+1
1179	DO i = ips , MIN(ide,ipe)
1180	tbdy3dtemp2(i,j,k) = TB(N,k,1)
1181	qbdy3dtemp2(i,j,k) = QB(N,k,1)
1182	cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
1183	q2bdy3dtemp2(i,j,k) = 0.0 !KWON
1184	write(message,*)'northtend t',k,i,n,tbdy3dtemp2(i,j,k)
1185	call wrf_debug(10,message)
1186	write(message,*)'northtend q',k,i,n,qbdy3dtemp2(i,j,k)
1187	call wrf_debug(10,message)
1188	N=N+1
1189	END DO
1190	END DO
1191
1192	DO k = kps , MIN(kde,kpe)
1193	N=IM
1194	DO i = ips , MIN(ide,ipe)
1195	ubdy3dtemp2(i,j,k) = UB(N,k,1)
1196	vbdy3dtemp2(i,j,k) = VB(N,k,1)
1197	N=N+1
1198	END DO
1199	END DO
1200
1201	N=IM+1
1202	DO i = ips , MIN(ide,ipe)
1203	pdbdy2dtemp2(i,j,1) = PDB(N,1)
1204	write(message,*)'northtend p',i,n,pdbdy2dtemp1(i,j,1)
1205	call wrf_debug(10,message)
1206	N=N+1
1207	END DO
1208
1209	ENDIF
1210
1211	!! Western boundary
1212
1213	IF(IPS.EQ.IDS)THEN
1214	I=1
1215	DO k = kps , MIN(kde,kpe)
1216	N=2*IM+1
1217	inc_h=mod(jps+1,2)
1218	DO j = jps+inc_h, MIN(jde,jpe),2
1219	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1220	tbdy3dtemp2(i,j,k) = TB(N,k,1)
1221	qbdy3dtemp2(i,j,k) = QB(N,k,1)
1222	cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
1223	q2bdy3dtemp2(i,j,k) = 0.0 !KWON
1224	write(message,*)'westtend t',k,j,n,tbdy3dtemp2(i,j,k)
1225	call wrf_debug(10,message)
1226	write(message,*)'westtend q',k,j,n,qbdy3dtemp2(i,j,k)
1227	call wrf_debug(10,message)
1228	N=N+1
1229	endif
1230	END DO
1231	END DO
1232
1233	DO k = kps , MIN(kde,kpe)
1234	N=2*IM-1
1235	inc_v=mod(jps,2)
1236	DO j = jps+inc_v, MIN(jde,jpe),2
1237	if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1238	ubdy3dtemp2(i,j,k) = UB(N,k,1)
1239	vbdy3dtemp2(i,j,k) = VB(N,k,1)
1240	N=N+1
1241	endif
1242	END DO
1243	END DO
1244
1245	N=2*IM+1
1246	inc_h=mod(jps+1,2)
1247	DO j = jps+inc_h, MIN(jde,jpe),2
1248	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1249	pdbdy2dtemp2(i,j,1) = PDB(N,1)
1250	write(message,*)'westtend p',j,n,pdbdy2dtemp1(i,j,1)
1251	call wrf_debug(10,message)
1252	N=N+1
1253	endif
1254	END DO
1255
1256	ENDIF
1257
1258	!! Eastern boundary
1259
1260	IF(IPE.EQ.IDE)THEN
1261
1262	I=MIN(IDE,IPE)
1263
1264	DO k = kps , MIN(kde,kpe)
1265	N=2*IM+(JM/2)
1266	inc_h=mod(jps+1,2)
1267	DO j = jps+inc_h, MIN(jde,jpe),2
1268	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1269	tbdy3dtemp2(i,j,k) = TB(N,k,1)
1270	qbdy3dtemp2(i,j,k) = QB(N,k,1)
1271	cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
1272	q2bdy3dtemp2(i,j,k) = 0.0 !KWON
1273	write(message,*)'easttend t',k,j,n,tbdy3dtemp2(i,j,k)
1274	call wrf_debug(10,message)
1275	write(message,*)'easttend q',k,j,n,qbdy3dtemp2(i,j,k)
1276	call wrf_debug(10,message)
1277	N=N+1
1278	endif
1279	END DO
1280	END DO
1281
1282	DO k = kps , MIN(kde,kpe)
1283	N=2*IM+(JM/2)-1
1284	inc_v=mod(jps,2)
1285	DO j = jps+inc_v, MIN(jde,jpe),2
1286	if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1287	ubdy3dtemp2(i,j,k) = UB(N,k,1)
1288	vbdy3dtemp2(i,j,k) = VB(N,k,1)
1289	N=N+1
1290	endif
1291	END DO
1292	END DO
1293
1294	N=2*IM+(JM/2)
1295	inc_h=mod(jps+1,2)
1296	DO j = jps+inc_h, MIN(jde,jpe),2
1297	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1298	pdbdy2dtemp2(i,j,1) = PDB(N,1)
1299	write(message,*)'easttend p',j,n,pdbdy2dtemp1(i,j,1)
1300	call wrf_debug(10,message)
1301	N=N+1
1302	endif
1303	END DO
1304
1305	ENDIF
1306	else
1307	#endif
1308
1309	CALL output_auxinput4 ( id4, grid , config_flags , ierr )
1310
1311	#if defined( HWRF)
1312	endif bdytmp_useph
1313	#endif
1314
1315	write(message,*)' assemble_output loop=',loop,' in IF block'
1316	call wrf_message(message)
1317
1318	! Open the boundary file.
1319
1320	IF ( loop .eq. 2 ) THEN
1321	CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
1322	CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
1323	output_boundary , "DATASET=BOUNDARY", ierr )
1324	IF ( ierr .NE. 0 ) THEN
1325	CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
1326	ENDIF
1327	! grid%write_metadata = .true.
1328	ELSE
1329	! what's this do?
1330	! grid%write_metadata = .true.
1331	! grid%write_metadata = .false.
1332	CALL domain_clockadvance( grid )
1333	END IF
1334
1335	#if defined(HWRF)
1336	bdytmp_notph: if(.not.grid%use_prep_hybrid) then
1337	#endif
1338	!-----------------------------------------------------------------------
1339	!*** SOUTHERN BOUNDARY
1340	!-----------------------------------------------------------------------
1341	!
1342	IF(JPS==JDS)THEN
1343	J=1
1344	DO k = kps , MIN(kde,kpe)
1345	DO i = ips , MIN(ide,ipe)
1346	ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1347	vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1348	tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1349	qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1350	cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1351	q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1352	END DO
1353	END DO
1354	!
1355	DO i = ips , MIN(ide,ipe)
1356	pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1357	END DO
1358	ENDIF
1359
1360	!
1361	!-----------------------------------------------------------------------
1362	!*** NORTHERN BOUNDARY
1363	!-----------------------------------------------------------------------
1364	!
1365	IF(JPE==JDE)THEN
1366	J=MIN(JDE,JPE)
1367	DO k = kps , MIN(kde,kpe)
1368	DO i = ips , MIN(ide,ipe)
1369	ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1370	vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1371	tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1372	qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1373	cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1374	q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1375	END DO
1376	END DO
1377
1378	DO i = ips , MIN(ide,ipe)
1379	pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1380	END DO
1381	ENDIF
1382	!
1383	!-----------------------------------------------------------------------
1384	!*** WESTERN BOUNDARY
1385	!-----------------------------------------------------------------------
1386	!
1387	IF(IPS==IDS)THEN
1388	I=1
1389	DO k = kps , MIN(kde,kpe)
1390	inc_h=mod(jps+1,2)
1391	if(k==1)then
1392	write(message,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
1393	call wrf_debug(10,message)
1394	endif
1395	DO j = jps+inc_h, MIN(jde,jpe),2
1396	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1397	tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1398	if(k==1)then
1399	write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
1400	call wrf_debug(10,message)
1401	endif
1402	qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1403	cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1404	q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1405	endif
1406	END DO
1407	END DO
1408	!
1409	DO k = kps , MIN(kde,kpe)
1410	inc_v=mod(jps,2)
1411	DO j = jps+inc_v, MIN(jde,jpe),2
1412	if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1413	ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1414	vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1415	endif
1416	END DO
1417	END DO
1418
1419	inc_h=mod(jps+1,2)
1420	DO j = jps+inc_h, MIN(jde,jpe),2
1421	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1422	pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1423	write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
1424	CALL wrf_debug(10,message)
1425	endif
1426	END DO
1427	ENDIF
1428	!
1429	!-----------------------------------------------------------------------
1430	!*** EASTERN BOUNDARY
1431	!-----------------------------------------------------------------------
1432	!
1433	IF(IPE==IDE)THEN
1434	I=MIN(IDE,IPE)
1435
1436	DO k = kps , MIN(kde,kpe)
1437	inc_h=mod(jps+1,2)
1438	DO j = jps+inc_h, MIN(jde,jpe),2
1439	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1440	tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1441	qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1442	cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1443	q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1444	endif
1445	END DO
1446	END DO
1447
1448	DO k = kps , MIN(kde,kpe)
1449	inc_v=mod(jps,2)
1450	DO j = jps+inc_v, MIN(jde,jpe),2
1451	if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1452	ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1453	vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1454	endif
1455	END DO
1456	END DO
1457
1458	inc_h=mod(jps+1,2)
1459	DO j = jps+inc_h, MIN(jde,jpe),2
1460	if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1461	pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1462	endif
1463	END DO
1464	ENDIF
1465	#if defined(HWRF)
1466	endif bdytmp_notph
1467	#endif
1468	!-----------------------------------------------------------------------
1469	! During all of the loops after the first loop,
1470	! we first compute the boundary
1471	! tendencies with the current data values
1472	! (*bdy3dtemp2 arrays) and the previously
1473	! saved information stored in the *bdy3dtemp1 arrays.
1474
1475
1476	CALL stuff_bdytend_ijk ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds),&
1477	grid%u_btxs, grid%u_btxe, &
1478	grid%u_btys, grid%u_btye, &
1479	'N', spec_bdy_width , &
1480	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1481	ims , ime , jms , jme , kms , kme , &
1482	ips , ipe , jps , jpe , kps , kpe+1 )
1483
1484	CALL stuff_bdytend_ijk ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds),&
1485	grid%v_btxs, grid%v_btxe, &
1486	grid%v_btys, grid%v_btye, &
1487	'N', spec_bdy_width , &
1488	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1489	ims , ime , jms , jme , kms , kme , &
1490	ips , ipe , jps , jpe , kps , kpe+1 )
1491
1492	CALL stuff_bdytend_ijk ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds),&
1493	grid%t_btxs, grid%t_btxe, &
1494	grid%t_btys, grid%t_btye, &
1495	'N', spec_bdy_width , &
1496	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1497	ims , ime , jms , jme , kms , kme , &
1498	ips , ipe , jps , jpe , kps , kpe+1 )
1499
1500	CALL stuff_bdytend_ijk ( cwmbdy3dtemp2 , cwmbdy3dtemp1 , REAL(interval_seconds),&
1501	grid%cwm_btxs, grid%cwm_btxe, &
1502	grid%cwm_btys, grid%cwm_btye, &
1503	'N', spec_bdy_width , &
1504	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1505	ims , ime , jms , jme , kms , kme , &
1506	ips , ipe , jps , jpe , kps , kpe+1 )
1507
1508	CALL stuff_bdytend_ijk ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds),&
1509	grid%q_btxs, grid%q_btxe, &
1510	grid%q_btys, grid%q_btye, &
1511	'N', spec_bdy_width , &
1512	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1513	ims , ime , jms , jme , kms , kme , &
1514	ips , ipe , jps , jpe , kps , kpe+1 )
1515
1516	CALL stuff_bdytend_ijk ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds),&
1517	grid%q2_btxs, grid%q2_btxe, &
1518	grid%q2_btys, grid%q2_btye, &
1519	'N', spec_bdy_width , &
1520	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1521	ims , ime , jms , jme , kms , kme , &
1522	ips , ipe , jps , jpe , kps , kpe+1 )
1523
1524	CALL stuff_bdytend_ijk( pdbdy2dtemp2 , pdbdy2dtemp1, REAL(interval_seconds),&
1525	grid%pd_btxs, grid%pd_btxe, &
1526	grid%pd_btys, grid%pd_btye, &
1527	'M', spec_bdy_width , &
1528	ids , ide+1 , jds , jde+1 , 1 , 1 , &
1529	ims , ime , jms , jme , 1 , 1 , &
1530	ips , ipe , jps , jpe , 1 , 1 )
1531
1532
1533
1534	! Both pieces of the boundary data are now
1535	! available to be written (initial time and tendency).
1536	! This looks ugly, these date shifting things.
1537	! What's it for? We want the "Times" variable
1538	! in the lateral BDY file to have the valid times
1539	! of when the initial fields are written.
1540	! That's what the loop-2 thingy is for with the start date.
1541	! We increment the start_date so
1542	! that the starting time in the attributes is the
1543	! second time period. Why you may ask. I
1544	! agree, why indeed.
1545
1546	temp24= current_date
1547	temp24b=start_date
1548	start_date = current_date
1549	CALL geth_newdate ( temp19 , temp24b(1:19) , &
1550	(loop-2) * model_config_rec%interval_seconds )
1551	current_date = temp19 // '.0000'
1552	CALL domain_clock_set( grid, current_date(1:19) )
1553	write(message,*) 'LBC valid between these times ',current_date, ' ',start_date
1554	CALL wrf_message(message)
1555
1556	CALL output_boundary ( id, grid , config_flags , ierr )
1557	current_date = temp24
1558	start_date = temp24b
1559
1560	! OK, for all of the loops, we output the initialzation
1561	! data, which would allow us to
1562	! start the model at any of the available analysis time periods.
1563
1564	! WRITE ( loop_char , FMT = '(I4.4)' ) loop
1565	! CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_input , "DATASET=INPUT", ierr )
1566	! IF ( ierr .NE. 0 ) THEN
1567	! CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
1568	! ENDIF
1569	! grid%write_metadata = .true.
1570
1571	! CALL calc_current_date ( grid%id , 0. )
1572	! CALL output_input ( id1, grid , config_flags , ierr )
1573	! CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1574
1575	! Is this or is this not the last time time? We can remove some unnecessary
1576	! stores if it is not.
1577
1578	IF ( loop .LT. time_loop_max ) THEN
1579
1580	! We need to save the 3d data to compute a
1581	! difference during the next loop. Couple the
1582	! 3d fields with total mu (mub + mu_2) and the
1583	! stagger-specific map scale factor.
1584	! We load up the boundary data again for use in the next loop.
1585
1586
1587	!mp change these limits?????????
1588
1589	DO k = kps , kpe
1590	DO j = jps , jpe
1591	DO i = ips , ipe
1592	ubdy3dtemp1(i,j,k) = ubdy3dtemp2(i,j,k)
1593	vbdy3dtemp1(i,j,k) = vbdy3dtemp2(i,j,k)
1594	tbdy3dtemp1(i,j,k) = tbdy3dtemp2(i,j,k)
1595	cwmbdy3dtemp1(i,j,k) = cwmbdy3dtemp2(i,j,k)
1596	qbdy3dtemp1(i,j,k) = qbdy3dtemp2(i,j,k)
1597	q2bdy3dtemp1(i,j,k) = q2bdy3dtemp2(i,j,k)
1598	END DO
1599	END DO
1600	END DO
1601
1602	!mp change these limits?????????
1603
1604	DO j = jps , jpe
1605	DO i = ips , ipe
1606	pdbdy2dtemp1(i,j,1) = pdbdy2dtemp2(i,j,1)
1607	END DO
1608	END DO
1609
1610	! There are 2 components to the lateral boundaries.
1611	! First, there is the starting
1612	! point of this time period - just the outer few rows and columns.
1613
1614	CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
1615	grid%u_bys, grid%u_bye, &
1616	'N', spec_bdy_width , &
1617	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1618	ims , ime , jms , jme , kms , kme , &
1619	ips , ipe , jps , jpe , kps , kpe+1 )
1620
1621	CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
1622	grid%v_bys, grid%v_bye, &
1623	'N', spec_bdy_width , &
1624	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1625	ims , ime , jms , jme , kms , kme , &
1626	ips , ipe , jps , jpe , kps , kpe+1 )
1627
1628	CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
1629	grid%t_bys, grid%t_bye, &
1630	'N', spec_bdy_width , &
1631	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1632	ims , ime , jms , jme , kms , kme , &
1633	ips , ipe , jps , jpe , kps , kpe+1 )
1634
1635	CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
1636	grid%cwm_bys, grid%cwm_bye, &
1637	'N', spec_bdy_width , &
1638	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1639	ims , ime , jms , jme , kms , kme , &
1640	ips , ipe , jps , jpe , kps , kpe+1 )
1641
1642	CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
1643	grid%q_bys, grid%q_bye, &
1644	'N', spec_bdy_width , &
1645	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1646	ims , ime , jms , jme , kms , kme , &
1647	ips , ipe , jps , jpe , kps , kpe+1 )
1648
1649	CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
1650	grid%q2_bys, grid%q2_bye, &
1651	'N', spec_bdy_width , &
1652	ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1653	ims , ime , jms , jme , kms , kme , &
1654	ips , ipe , jps , jpe , kps , kpe+1 )
1655
1656	CALL stuff_bdy_ijk (pdbdy2dtemp1,grid%pd_bxs, grid%pd_bxe, &
1657	grid%pd_bys, grid%pd_bye, &
1658	'M', spec_bdy_width , &
1659	ids , ide+1 , jds , jde+1 , 1 , 1 , &
1660	ims , ime , jms , jme , 1 , 1 , &
1661	ips , ipe , jps , jpe , 1 , 1 )
1662
1663	ELSE IF ( loop .EQ. time_loop_max ) THEN
1664
1665	! If this is the last time through here, we need to close the files.
1666
1667	CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1668
1669	END IF
1670
1671	END IF main_loop_test
1672
1673	#if defined(HWRF)
1674	if(alloc_ph_arrays) then
1675	call wrf_debug(1,'DEALLOCATE PREP_HYBRID BOUNARY ARRAYS')
1676	deallocate(TB,QB,CWMB,UB,VB,PDB)
1677	endif
1678	#endif
1679
1680	END SUBROUTINE assemble_output

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format