Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

real_nmm.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 49.5 KB

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

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

Download in other formats:

Original Format