Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

real_nmm.F @ 1198

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

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

Download in other formats:

Original Format