Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

real_em.F @ 3553

Last change on this file since 3553 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: 53.0 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 Eulerian, mass-based coordinate.
	3	PROGRAM real_data
	4
	5	USE module_machine
	6	USE module_domain, ONLY : domain, alloc_and_configure_domain, &
	7	domain_clock_set, head_grid, program_name, domain_clockprint
	8	USE module_initialize_real, ONLY : wrfu_initialize, find_my_parent
	9	USE module_initialize_real
	10	USE module_io_domain
	11	USE module_driver_constants
	12	USE module_configure, ONLY : grid_config_rec_type, model_config_rec, &
	13	initial_config, get_config_as_buffer, set_config_as_buffer
	14	USE module_timing
	15	USE module_state_description, ONLY : realonly
	16	USE module_symbols_util, ONLY: wrfu_cal_gregorian
	17	#ifdef WRF_CHEM
	18	USE module_input_chem_data
	19	USE module_input_chem_bioemiss
	20	USE module_input_chem_emissopt3
	21	#endif
	22	USE module_utility, ONLY : WRFU_finalize
	23
	24	IMPLICIT NONE
	25
	26	#ifdef WRF_CHEM
	27	! interface
	28	INTERFACE
	29	! mediation-supplied
	30	SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
	31	USE module_domain
	32	TYPE (domain) grid
	33	TYPE (grid_config_rec_type) config_flags
	34	END SUBROUTINE med_read_wrf_chem_bioemiss
	35	END INTERFACE
	36	#endif
	37
	38	REAL :: time , bdyfrq
	39
	40	INTEGER :: loop , levels_to_process , debug_level
	41
	42
	43	TYPE(domain) , POINTER :: null_domain
	44	TYPE(domain) , POINTER :: grid , another_grid
	45	TYPE(domain) , POINTER :: grid_ptr , grid_ptr2
	46	TYPE (grid_config_rec_type) :: config_flags
	47	INTEGER :: number_at_same_level
	48
	49	INTEGER :: max_dom, domain_id , grid_id , parent_id , parent_id1 , id
	50	INTEGER :: e_we , e_sn , i_parent_start , j_parent_start
	51	INTEGER :: idum1, idum2
	52	#ifdef DM_PARALLEL
	53	INTEGER :: nbytes
	54	INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
	55	INTEGER :: configbuf( configbuflen )
	56	LOGICAL , EXTERNAL :: wrf_dm_on_monitor
	57	#endif
	58	LOGICAL found_the_id
	59
	60	INTEGER :: ids , ide , jds , jde , kds , kde
	61	INTEGER :: ims , ime , jms , jme , kms , kme
	62	INTEGER :: ips , ipe , jps , jpe , kps , kpe
	63	INTEGER :: ijds , ijde , spec_bdy_width
	64	INTEGER :: i , j , k , idts, rc
	65	INTEGER :: sibling_count , parent_id_hold , dom_loop
	66
	67	CHARACTER (LEN=80) :: message
	68
	69	INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
	70	INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
	71	INTEGER :: interval_seconds , real_data_init_type
	72	INTEGER :: time_loop_max , time_loop
	73	real::t1,t2
	74	INTERFACE
	75	SUBROUTINE Setup_Timekeeping( grid )
	76	USE module_domain, ONLY : domain
	77	TYPE(domain), POINTER :: grid
	78	END SUBROUTINE Setup_Timekeeping
	79	END INTERFACE
	80
	81	#include "version_decl"
	82
	83	! Define the name of this program (program_name defined in module_domain)
	84
	85	! NOTE: share/input_wrf.F tests first 7 chars of this name to decide
	86	! whether to read P_TOP as metadata from the SI (yes, if .eq. REAL_EM)
	87
	88	program_name = "REAL_EM " // TRIM(release_version) // " PREPROCESSOR"
	89
	90	#ifdef DM_PARALLEL
	91	CALL disable_quilting
	92	#endif
	93
	94	! Initialize the modules used by the WRF system. Many of the CALLs made from the
	95	! init_modules routine are NO-OPs. Typical initializations are: the size of a
	96	! REAL, setting the file handles to a pre-use value, defining moisture and
	97	! chemistry indices, etc.
	98
	99	CALL wrf_debug ( 100 , 'real_em: calling init_modules ' )
	100	CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
	101	CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
	102	CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
	103
	104	! The configuration switches mostly come from the NAMELIST input.
	105
	106	#ifdef DM_PARALLEL
	107	IF ( wrf_dm_on_monitor() ) THEN
	108	CALL initial_config
	109	END IF
	110	CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
	111	CALL wrf_dm_bcast_bytes( configbuf, nbytes )
	112	CALL set_config_as_buffer( configbuf, configbuflen )
	113	CALL wrf_dm_initialize
	114	#else
	115	CALL initial_config
	116	#endif
	117
	118	CALL nl_get_debug_level ( 1, debug_level )
	119	CALL set_wrf_debug_level ( debug_level )
	120
	121	CALL wrf_message ( program_name )
	122
	123	! There are variables in the Registry that are only required for the real
	124	! program, fields that come from the WPS package. We define the run-time
	125	! flag that says to allocate space for these input-from-WPS-only arrays.
	126
	127	CALL nl_set_use_wps_input ( 1 , REALONLY )
	128
	129	! Allocate the space for the mother of all domains.
	130
	131	NULLIFY( null_domain )
	132	CALL wrf_debug ( 100 , 'real_em: calling alloc_and_configure_domain ' )
	133	CALL alloc_and_configure_domain ( domain_id = 1 , &
	134	grid = head_grid , &
	135	parent = null_domain , &
	136	kid = -1 )
	137
	138	grid => head_grid
	139	CALL nl_get_max_dom ( 1 , max_dom )
	140
	141	IF ( model_config_rec%interval_seconds .LE. 0 ) THEN
	142	CALL wrf_error_fatal( 'namelist value for interval_seconds must be > 0')
	143	END IF
	144
	145	all_domains : DO domain_id = 1 , max_dom
	146
	147	IF ( ( model_config_rec%input_from_file(domain_id) ) .OR. &
	148	( domain_id .EQ. 1 ) ) THEN
	149
	150	IF ( domain_id .GT. 1 ) THEN
	151
	152	CALL nl_get_grid_id ( domain_id, grid_id )
	153	CALL nl_get_parent_id ( domain_id, parent_id )
	154	CALL nl_get_e_we ( domain_id, e_we )
	155	CALL nl_get_e_sn ( domain_id, e_sn )
	156	CALL nl_get_i_parent_start ( domain_id, i_parent_start )
	157	CALL nl_get_j_parent_start ( domain_id, j_parent_start )
	158	WRITE (message,FMT='(A,2I3,2I4,2I3)') &
	159	'new allocated domain: id, par id, dims i/j, start i/j =', &
	160	grid_id, parent_id, e_we, e_sn, i_parent_start, j_parent_start
	161
	162	CALL wrf_debug ( 100 , message )
	163	CALL nl_get_grid_id ( parent_id, grid_id )
	164	CALL nl_get_parent_id ( parent_id, parent_id1 )
	165	CALL nl_get_e_we ( parent_id, e_we )
	166	CALL nl_get_e_sn ( parent_id, e_sn )
	167	CALL nl_get_i_parent_start ( parent_id, i_parent_start )
	168	CALL nl_get_j_parent_start ( parent_id, j_parent_start )
	169	WRITE (message,FMT='(A,2I3,2I4,2I3)') &
	170	'parent domain: id, par id, dims i/j, start i/j =', &
	171	grid_id, parent_id1, e_we, e_sn, i_parent_start, j_parent_start
	172	CALL wrf_debug ( 100 , message )
	173
	174	CALL nl_get_grid_id ( domain_id, grid_id )
	175	CALL nl_get_parent_id ( domain_id, parent_id )
	176	CALL nl_get_e_we ( domain_id, e_we )
	177	CALL nl_get_e_sn ( domain_id, e_sn )
	178	CALL nl_get_i_parent_start ( domain_id, i_parent_start )
	179	CALL nl_get_j_parent_start ( domain_id, j_parent_start )
	180	grid_ptr2 => head_grid
	181	found_the_id = .FALSE.
	182	CALL find_my_parent ( grid_ptr2 , grid_ptr , domain_id , parent_id , found_the_id )
	183	IF ( found_the_id ) THEN
	184
	185	sibling_count = 0
	186	DO dom_loop = 2 , domain_id
	187	CALL nl_get_parent_id ( dom_loop, parent_id_hold )
	188	IF ( parent_id_hold .EQ. parent_id ) THEN
	189	sibling_count = sibling_count + 1
	190	END IF
	191	END DO
	192	CALL alloc_and_configure_domain ( domain_id = domain_id , &
	193	grid = another_grid , &
	194	parent = grid_ptr , &
	195	kid = sibling_count )
	196	grid => another_grid
	197	ELSE
	198	CALL wrf_error_fatal( 'real_em.F: Could not find the parent domain')
	199	END IF
	200	END IF
	201
	202	CALL Setup_Timekeeping ( grid )
	203	CALL set_current_grid_ptr( grid )
	204	CALL domain_clockprint ( 150, grid, &
	205	'DEBUG real: clock after Setup_Timekeeping,' )
	206	CALL domain_clock_set( grid, &
	207	time_step_seconds=model_config_rec%interval_seconds )
	208	CALL domain_clockprint ( 150, grid, &
	209	'DEBUG real: clock after timeStep set,' )
	210
	211
	212	CALL wrf_debug ( 100 , 'real_em: calling set_scalar_indices_from_config ' )
	213	CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
	214
	215	CALL wrf_debug ( 100 , 'real_em: calling model_to_grid_config_rec ' )
	216	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
	217
	218	! Initialize the WRF IO: open files, init file handles, etc.
	219
	220	CALL wrf_debug ( 100 , 'real_em: calling init_wrfio' )
	221	CALL init_wrfio
	222
	223	! Some of the configuration values may have been modified from the initial READ
	224	! of the NAMELIST, so we re-broadcast the configuration records.
	225
	226	#ifdef DM_PARALLEL
	227	CALL wrf_debug ( 100 , 'real_em: re-broadcast the configuration records' )
	228	CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
	229	CALL wrf_dm_bcast_bytes( configbuf, nbytes )
	230	CALL set_config_as_buffer( configbuf, configbuflen )
	231	#endif
	232
	233	! No looping in this layer.
	234
	235	CALL wrf_debug ( 100 , 'calling med_sidata_input' )
	236	CALL med_sidata_input ( grid , config_flags )
	237	CALL wrf_debug ( 100 , 'backfrom med_sidata_input' )
	238
	239	ELSE
	240	CYCLE all_domains
	241	END IF
	242
	243	END DO all_domains
	244
	245	CALL set_current_grid_ptr( head_grid )
	246
	247	! We are done.
	248
	249	CALL wrf_debug ( 0 , 'real_em: SUCCESS COMPLETE REAL_EM INIT' )
	250
	251	CALL wrf_shutdown
	252
	253	CALL WRFU_Finalize( rc=rc )
	254
	255	END PROGRAM real_data
	256
	257	SUBROUTINE med_sidata_input ( grid , config_flags )
	258	! Driver layer
	259	USE module_domain
	260	USE module_io_domain
	261	! Model layer
	262	USE module_configure
	263	USE module_bc_time_utilities
	264	USE module_initialize_real
	265	USE module_optional_input
	266	#ifdef WRF_CHEM
	267	USE module_input_chem_data
	268	USE module_input_chem_bioemiss
	269	USE module_input_chem_emissopt3
	270	#endif
	271
	272	USE module_date_time
	273	USE module_utility
	274
	275	IMPLICIT NONE
	276
	277
	278	! Interface
	279	INTERFACE
	280	SUBROUTINE start_domain ( grid , allowed_to_read ) ! comes from module_start in appropriate dyn_ directory
	281	USE module_domain
	282	TYPE (domain) grid
	283	LOGICAL, INTENT(IN) :: allowed_to_read
	284	END SUBROUTINE start_domain
	285	END INTERFACE
	286
	287	! Arguments
	288	TYPE(domain) :: grid
	289	TYPE (grid_config_rec_type) :: config_flags
	290	! Local
	291	INTEGER :: time_step_begin_restart
	292	INTEGER :: idsi , ierr , myproc
	293	CHARACTER (LEN=80) :: si_inpname
	294	CHARACTER (LEN=80) :: message
	295
	296	CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
	297
	298	INTEGER :: time_loop_max , loop, rc
	299	INTEGER :: julyr , julday
	300	REAL :: gmt
	301	real::t1,t2,t3,t4
	302
	303	grid%input_from_file = .true.
	304	grid%input_from_file = .false.
	305
	306	CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
	307	model_config_rec%start_month (grid%id) , &
	308	model_config_rec%start_day (grid%id) , &
	309	model_config_rec%start_hour (grid%id) , &
	310	model_config_rec%start_minute(grid%id) , &
	311	model_config_rec%start_second(grid%id) , &
	312	model_config_rec% end_year (grid%id) , &
	313	model_config_rec% end_month (grid%id) , &
	314	model_config_rec% end_day (grid%id) , &
	315	model_config_rec% end_hour (grid%id) , &
	316	model_config_rec% end_minute(grid%id) , &
	317	model_config_rec% end_second(grid%id) , &
	318	model_config_rec%interval_seconds , &
	319	model_config_rec%real_data_init_type , &
	320	start_date_char , end_date_char , time_loop_max )
	321
	322	! Override stop time with value computed above.
	323	CALL domain_clock_set( grid, stop_timestr=end_date_char )
	324
	325	! TBH: for now, turn off stop time and let it run data-driven
	326	CALL WRFU_ClockStopTimeDisable( grid%domain_clock, rc=rc )
	327	CALL wrf_check_error( WRFU_SUCCESS, rc, &
	328	'WRFU_ClockStopTimeDisable(grid%domain_clock) FAILED', &
	329	__FILE__ , &
	330	__LINE__ )
	331	CALL domain_clockprint ( 150, grid, &
	332	'DEBUG med_sidata_input: clock after stopTime set,' )
	333
	334	! Here we define the initial time to process, for later use by the code.
	335
	336	current_date_char = start_date_char
	337	start_date = start_date_char // '.0000'
	338	current_date = start_date
	339
	340	CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
	341
	342	!!!!!!! Loop over each time period to process.
	343
	344	CALL cpu_time ( t1 )
	345	DO loop = 1 , time_loop_max
	346
	347	internal_time_loop = loop
	348	IF ( ( grid%id .GT. 1 ) .AND. ( loop .GT. 1 ) .AND. &
	349	( model_config_rec%grid_fdda(grid%id) .EQ. 0 ) .AND. &
	350	( model_config_rec%sst_update .EQ. 0 ) ) EXIT
	351
	352	print *,' '
	353	print *,'-----------------------------------------------------------------------------'
	354	print *,' '
	355	print '(A,I2,A,A,A,I4,A,I4)' , &
	356	' Domain ',grid%id,': Current date being processed: ',current_date, ', which is loop #',loop,' out of ',time_loop_max
	357
	358	! After current_date has been set, fill in the julgmt stuff.
	359
	360	CALL geth_julgmt ( config_flags%julyr , config_flags%julday , config_flags%gmt )
	361
	362	print *,'configflags%julyr, %julday, %gmt:',config_flags%julyr, config_flags%julday, config_flags%gmt
	363	! Now that the specific Julian info is available, save these in the model config record.
	364
	365	CALL nl_set_gmt (grid%id, config_flags%gmt)
	366	CALL nl_set_julyr (grid%id, config_flags%julyr)
	367	CALL nl_set_julday (grid%id, config_flags%julday)
	368
	369	! Open the input file for real. This is either the "new" one or the "old" one. The "new" one could have
	370	! a suffix for the type of the data format. Check to see if either is around.
	371
	372	CALL cpu_time ( t3 )
	373	WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ', &
	374	TRIM(config_flags%auxinput1_inname)
	375	CALL wrf_debug ( 100 , wrf_err_message )
	376	IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
	377	CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
	378	current_date_char , config_flags%io_form_auxinput1 )
	379	ELSE
	380	CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
	381	current_date_char )
	382	END IF
	383	CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
	384	IF ( ierr .NE. 0 ) THEN
	385	CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // &
	386	' for input; bad date in namelist or file not in directory' )
	387	END IF
	388
	389	! Input data.
	390
	391	CALL wrf_debug ( 100 , 'med_sidata_input: calling input_aux_model_input1' )
	392	CALL input_aux_model_input1 ( idsi , grid , config_flags , ierr )
	393	CALL cpu_time ( t4 )
	394	WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for input ',NINT(t4-t3) ,' s.'
	395	CALL wrf_debug( 0, wrf_err_message )
	396
	397	! Possible optional SI input. This sets flags used by init_domain.
	398
	399	CALL cpu_time ( t3 )
	400	IF ( loop .EQ. 1 ) THEN
	401	already_been_here = .FALSE.
	402	CALL wrf_debug ( 100 , 'med_sidata_input: calling init_module_optional_input' )
	403	CALL init_module_optional_input ( grid , config_flags )
	404	END IF
	405	CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
	406	CALL optional_input ( grid , idsi )
	407
	408	! Initialize the mother domain for this time period with input data.
	409
	410	CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
	411	grid%input_from_file = .true.
	412	CALL init_domain ( grid )
	413	CALL cpu_time ( t4 )
	414	WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for processing ',NINT(t4-t3) ,' s.'
	415	CALL wrf_debug( 0, wrf_err_message )
	416	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
	417
	418	! Close this file that is output from the SI and input to this pre-proc.
	419
	420	CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
	421	CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
	422
	423	#ifdef WRF_CHEM
	424	IF ( loop == 1 ) THEN
	425	IF( grid%chem_opt > 0 ) then
	426	! Read the chemistry data from a previous wrf forecast (wrfout file)
	427	IF(grid%chem_in_opt == 1 ) THEN
	428	message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
	429	CALL wrf_message ( message )
	430
	431	CALL input_ext_chem_file( grid )
	432	IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC &
	433	.or. grid%biomass_burn_opt == BIOMASSB) THEN
	434	message = 'READING EMISSIONS DATA OPT 3'
	435	CALL wrf_message ( message )
	436	! CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
	437	CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
	438	END IF
	439
	440	IF(grid%bio_emiss_opt == 2 ) THEN
	441	message = 'READING BEIS3.11 EMISSIONS DATA'
	442	CALL wrf_message ( message )
	443	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
	444	else IF(grid%bio_emiss_opt == 3 ) THEN !shc
	445	message = 'READING MEGAN 2 EMISSIONS DATA'
	446	CALL wrf_message ( message )
	447	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
	448	END IF
	449
	450	IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
	451	message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
	452	CALL wrf_message ( message )
	453	CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
	454	END IF
	455
	456	ELSEIF(grid%chem_in_opt == 0)then
	457	! Generate chemistry data from a idealized vertical profile
	458	message = 'STARTING WITH BACKGROUND CHEMISTRY '
	459	CALL wrf_message ( message )
	460
	461	CALL input_chem_profile ( grid )
	462
	463	IF(grid%bio_emiss_opt == 2 ) THEN
	464	message = 'READING BEIS3.11 EMISSIONS DATA'
	465	CALL wrf_message ( message )
	466	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
	467	else IF(grid%bio_emiss_opt == 3 ) THEN !shc
	468	message = 'READING MEGAN 2 EMISSIONS DATA'
	469	CALL wrf_message ( message )
	470	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
	471	END IF
	472	IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC &
	473	.or. grid%biomass_burn_opt == BIOMASSB) THEN
	474	message = 'READING EMISSIONS DATA OPT 3'
	475	CALL wrf_message ( message )
	476	! CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
	477	CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
	478	END IF
	479
	480	IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
	481	message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
	482	CALL wrf_message ( message )
	483	CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
	484	END IF
	485
	486	ELSE
	487	message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
	488	CALL wrf_message ( message )
	489	END IF
	490	END IF
	491	END IF
	492	#endif
	493
	494	CALL cpu_time ( t3 )
	495	CALL assemble_output ( grid , config_flags , loop , time_loop_max )
	496	CALL cpu_time ( t4 )
	497	WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for output ',NINT(t4-t3) ,' s.'
	498	CALL wrf_debug( 0, wrf_err_message )
	499	CALL cpu_time ( t2 )
	500	WRITE ( wrf_err_message , FMT='(A,I4,A,I10,A)' ) 'Timing for loop # ',loop,' = ',NINT(t2-t1) ,' s.'
	501	CALL wrf_debug( 0, wrf_err_message )
	502
	503	! If this is not the last time, we define the next time that we are going to process.
	504
	505	IF ( loop .NE. time_loop_max ) THEN
	506	CALL geth_newdate ( current_date_char , start_date_char , loop * model_config_rec%interval_seconds )
	507	current_date = current_date_char // '.0000'
	508	CALL domain_clockprint ( 150, grid, &
	509	'DEBUG med_sidata_input: clock before current_date set,' )
	510	WRITE (wrf_err_message,*) &
	511	'DEBUG med_sidata_input: before currTime set, current_date = ',TRIM(current_date)
	512	CALL wrf_debug ( 150 , wrf_err_message )
	513	CALL domain_clock_set( grid, current_date(1:19) )
	514	CALL domain_clockprint ( 150, grid, &
	515	'DEBUG med_sidata_input: clock after current_date set,' )
	516	END IF
	517	CALL cpu_time ( t1 )
	518	END DO
	519
	520	END SUBROUTINE med_sidata_input
	521
	522	SUBROUTINE compute_si_start_and_end ( &
	523	start_year , start_month , start_day , start_hour , start_minute , start_second , &
	524	end_year , end_month , end_day , end_hour , end_minute , end_second , &
	525	interval_seconds , real_data_init_type , &
	526	start_date_char , end_date_char , time_loop_max )
	527
	528	USE module_date_time
	529
	530	IMPLICIT NONE
	531
	532	INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
	533	INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
	534	INTEGER :: interval_seconds , real_data_init_type
	535	INTEGER :: time_loop_max , time_loop
	536
	537	CHARACTER(LEN=19) :: current_date_char , start_date_char , end_date_char , next_date_char
	538
	539	#ifdef PLANET
	540	WRITE ( start_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
	541	start_year,start_day,start_hour,start_minute,start_second
	542	WRITE ( end_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
	543	end_year, end_day, end_hour, end_minute, end_second
	544	#else
	545	WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
	546	start_year,start_month,start_day,start_hour,start_minute,start_second
	547	WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
	548	end_year, end_month, end_day, end_hour, end_minute, end_second
	549	#endif
	550
	551	IF ( end_date_char .LT. start_date_char ) THEN
	552	CALL wrf_error_fatal( 'Ending date in namelist ' // end_date_char // ' prior to beginning date ' // start_date_char )
	553	END IF
	554
	555	! start_date = start_date_char // '.0000'
	556
	557	! Figure out our loop count for the processing times.
	558
	559	time_loop = 1
	560	PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',start_date_char,'.'
	561	current_date_char = start_date_char
	562	loop_count : DO
	563	CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
	564	IF ( next_date_char .LT. end_date_char ) THEN
	565	time_loop = time_loop + 1
	566	PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
	567	current_date_char = next_date_char
	568	ELSE IF ( next_date_char .EQ. end_date_char ) THEN
	569	time_loop = time_loop + 1
	570	PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
	571	PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
	572	time_loop_max = time_loop
	573	EXIT loop_count
	574	ELSE IF ( next_date_char .GT. end_date_char ) THEN
	575	PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
	576	time_loop_max = time_loop
	577	EXIT loop_count
	578	END IF
	579	END DO loop_count
	580	END SUBROUTINE compute_si_start_and_end
	581
	582	SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
	583
	584	USE module_big_step_utilities_em
	585	USE module_domain
	586	USE module_io_domain
	587	USE module_configure
	588	USE module_date_time
	589	USE module_bc
	590	IMPLICIT NONE
	591
	592	TYPE(domain) :: grid
	593	TYPE (grid_config_rec_type) :: config_flags
	594	INTEGER , INTENT(IN) :: loop , time_loop_max
	595
	596	INTEGER :: ids , ide , jds , jde , kds , kde
	597	INTEGER :: ims , ime , jms , jme , kms , kme
	598	INTEGER :: ips , ipe , jps , jpe , kps , kpe
	599	INTEGER :: ijds , ijde , spec_bdy_width
	600	INTEGER :: i , j , k , idts
	601
	602	INTEGER :: id1 , interval_seconds , ierr, rc, sst_update, grid_fdda
	603	INTEGER , SAVE :: id, id2, id4
	604	CHARACTER (LEN=80) :: inpname , bdyname
	605	CHARACTER(LEN= 4) :: loop_char
	606	character *19 :: temp19
	607	character *24 :: temp24 , temp24b
	608
	609	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
	610	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp1
	611	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
	612	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp2
	613	real::t1,t2
	614
	615	! Various sizes that we need to be concerned about.
	616
	617	ids = grid%sd31
	618	ide = grid%ed31
	619	kds = grid%sd32
	620	kde = grid%ed32
	621	jds = grid%sd33
	622	jde = grid%ed33
	623
	624	ims = grid%sm31
	625	ime = grid%em31
	626	kms = grid%sm32
	627	kme = grid%em32
	628	jms = grid%sm33
	629	jme = grid%em33
	630
	631	ips = grid%sp31
	632	ipe = grid%ep31
	633	kps = grid%sp32
	634	kpe = grid%ep32
	635	jps = grid%sp33
	636	jpe = grid%ep33
	637
	638	ijds = MIN ( ids , jds )
	639	ijde = MAX ( ide , jde )
	640
	641	! Boundary width, scalar value.
	642
	643	spec_bdy_width = model_config_rec%spec_bdy_width
	644	interval_seconds = model_config_rec%interval_seconds
	645	sst_update = model_config_rec%sst_update
	646	grid_fdda = model_config_rec%grid_fdda(grid%id)
	647
	648
	649	IF ( loop .EQ. 1 ) THEN
	650
	651	IF ( ( time_loop_max .EQ. 1 ) .OR. ( config_flags%polar ) ) THEN
	652
	653	! No need to allocate space since we do not need the lateral boundary data yet
	654	! or at all (in case of the polar flag).
	655
	656	ELSE
	657
	658	! This is the space needed to save the current 3d data for use in computing
	659	! the lateral boundary tendencies.
	660
	661	IF ( ALLOCATED ( ubdy3dtemp1 ) ) DEALLOCATE ( ubdy3dtemp1 )
	662	IF ( ALLOCATED ( vbdy3dtemp1 ) ) DEALLOCATE ( vbdy3dtemp1 )
	663	IF ( ALLOCATED ( tbdy3dtemp1 ) ) DEALLOCATE ( tbdy3dtemp1 )
	664	IF ( ALLOCATED ( pbdy3dtemp1 ) ) DEALLOCATE ( pbdy3dtemp1 )
	665	IF ( ALLOCATED ( qbdy3dtemp1 ) ) DEALLOCATE ( qbdy3dtemp1 )
	666	IF ( ALLOCATED ( mbdy2dtemp1 ) ) DEALLOCATE ( mbdy2dtemp1 )
	667	IF ( ALLOCATED ( ubdy3dtemp2 ) ) DEALLOCATE ( ubdy3dtemp2 )
	668	IF ( ALLOCATED ( vbdy3dtemp2 ) ) DEALLOCATE ( vbdy3dtemp2 )
	669	IF ( ALLOCATED ( tbdy3dtemp2 ) ) DEALLOCATE ( tbdy3dtemp2 )
	670	IF ( ALLOCATED ( pbdy3dtemp2 ) ) DEALLOCATE ( pbdy3dtemp2 )
	671	IF ( ALLOCATED ( qbdy3dtemp2 ) ) DEALLOCATE ( qbdy3dtemp2 )
	672	IF ( ALLOCATED ( mbdy2dtemp2 ) ) DEALLOCATE ( mbdy2dtemp2 )
	673
	674	ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
	675	ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
	676	ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
	677	ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
	678	ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
	679	ALLOCATE ( mbdy2dtemp1(ims:ime,1:1, jms:jme) )
	680	ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
	681	ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
	682	ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
	683	ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
	684	ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
	685	ALLOCATE ( mbdy2dtemp2(ims:ime,1:1, jms:jme) )
	686
	687	END IF
	688
	689	! Open the wrfinput file. From this program, this is an output file.
	690
	691	CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
	692	CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
	693	IF ( ierr .NE. 0 ) THEN
	694	CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
	695	END IF
	696	CALL output_model_input ( id1, grid , config_flags , ierr )
	697	CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
	698
	699	IF ( time_loop_max .NE. 1 ) THEN
	700	IF(sst_update .EQ. 1)THEN
	701	CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
	702	CALL open_w_dataset ( id4, TRIM(inpname) , grid , config_flags , output_aux_model_input4 , "DATASET=AUXINPUT4", ierr )
	703	IF ( ierr .NE. 0 ) THEN
	704	CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
	705	END IF
	706	CALL output_aux_model_input4 ( id4, grid , config_flags , ierr )
	707	END IF
	708	END IF
	709
	710	IF ( ( time_loop_max .EQ. 1 ) .OR. ( config_flags%polar ) ) THEN
	711
	712	! No need to couple data since no lateral BCs required.
	713
	714	ELSE
	715
	716	! We need to save the 3d data to compute a difference during the next loop. Couple the
	717	! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
	718
	719	! u, theta, h, scalars coupled with my; v coupled with mx
	720	CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp1 , grid%u_2 , 'u' , grid%msfuy , &
	721	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	722	CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp1 , grid%v_2 , 'v' , grid%msfvx , &
	723	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	724	CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp1 , grid%t_2 , 't' , grid%msfty , &
	725	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	726	CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp1 , grid%ph_2 , 'h' , grid%msfty , &
	727	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	728	CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , &
	729	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	730
	731	DO j = jps , MIN(jde-1,jpe)
	732	DO i = ips , MIN(ide-1,ipe)
	733	mbdy2dtemp1(i,1,j) = grid%mu_2(i,j)
	734	END DO
	735	END DO
	736
	737	END IF
	738
	739	IF(grid_fdda .EQ. 1)THEN
	740	DO j = jps , jpe
	741	DO k = kps , kpe
	742	DO i = ips , ipe
	743	grid%fdda3d(i,k,j,p_u_ndg_old) = grid%u_2(i,k,j)
	744	grid%fdda3d(i,k,j,p_v_ndg_old) = grid%v_2(i,k,j)
	745	grid%fdda3d(i,k,j,p_t_ndg_old) = grid%t_2(i,k,j)
	746	grid%fdda3d(i,k,j,p_q_ndg_old) = grid%moist(i,k,j,P_QV)
	747	grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%ph_2(i,k,j)
	748	END DO
	749	END DO
	750	END DO
	751
	752	DO j = jps , jpe
	753	DO i = ips , ipe
	754	grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%mu_2(i,j)
	755	grid%fdda2d(i,1,j,p_t2_ndg_old) = grid%t2(i,j)
	756	grid%fdda2d(i,1,j,p_q2_ndg_old) = grid%q2(i,j)
	757	grid%fdda2d(i,1,j,p_sn_ndg_old) = grid%snow(i,j)
	758	END DO
	759	END DO
	760	END IF
	761
	762	IF ( ( time_loop_max .EQ. 1 ) .OR. ( config_flags%polar ) ) THEN
	763
	764	! No need to build boundary arrays, since no lateral BCs are being generated.
	765
	766	ELSE
	767
	768	! There are 2 components to the lateral boundaries. First, there is the starting
	769	! point of this time period - just the outer few rows and columns.
	770
	771	CALL stuff_bdy ( ubdy3dtemp1 , grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
	772	'U' , spec_bdy_width , &
	773	ids , ide , jds , jde , kds , kde , &
	774	ims , ime , jms , jme , kms , kme , &
	775	ips , ipe , jps , jpe , kps , kpe )
	776	CALL stuff_bdy ( vbdy3dtemp1 , grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
	777	'V' , spec_bdy_width , &
	778	ids , ide , jds , jde , kds , kde , &
	779	ims , ime , jms , jme , kms , kme , &
	780	ips , ipe , jps , jpe , kps , kpe )
	781	CALL stuff_bdy ( tbdy3dtemp1 , grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
	782	'T' , spec_bdy_width , &
	783	ids , ide , jds , jde , kds , kde , &
	784	ims , ime , jms , jme , kms , kme , &
	785	ips , ipe , jps , jpe , kps , kpe )
	786	CALL stuff_bdy ( pbdy3dtemp1 , grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
	787	'W' , spec_bdy_width , &
	788	ids , ide , jds , jde , kds , kde , &
	789	ims , ime , jms , jme , kms , kme , &
	790	ips , ipe , jps , jpe , kps , kpe )
	791	CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV), &
	792	grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV), &
	793	'T' , spec_bdy_width , &
	794	ids , ide , jds , jde , kds , kde , &
	795	ims , ime , jms , jme , kms , kme , &
	796	ips , ipe , jps , jpe , kps , kpe )
	797	CALL stuff_bdy ( mbdy2dtemp1 , grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
	798	'M' , spec_bdy_width , &
	799	ids , ide , jds , jde , 1 , 1 , &
	800	ims , ime , jms , jme , 1 , 1 , &
	801	ips , ipe , jps , jpe , 1 , 1 )
	802	END IF
	803
	804
	805	ELSE IF ( loop .GT. 1 ) THEN
	806
	807	IF(sst_update .EQ. 1)THEN
	808	CALL output_aux_model_input4 ( id4, grid , config_flags , ierr )
	809	END IF
	810
	811	! Open the boundary and the fdda file.
	812
	813	IF ( loop .eq. 2 ) THEN
	814	IF ( (grid%id .eq. 1) .and. ( .NOT. config_flags%polar ) ) THEN
	815	CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
	816	CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
	817	IF ( ierr .NE. 0 ) THEN
	818	CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
	819	END IF
	820	END IF
	821	IF(grid_fdda .EQ. 1)THEN
	822	CALL construct_filename1( inpname , 'wrffdda' , grid%id , 2 )
	823	CALL open_w_dataset ( id2, TRIM(inpname) , grid , config_flags , output_aux_model_input10 , "DATASET=AUXINPUT10", ierr )
	824	IF ( ierr .NE. 0 ) THEN
	825	CALL wrf_error_fatal( 'real: error opening wrffdda for writing' )
	826	END IF
	827	END IF
	828	ELSE
	829	IF ( .NOT. domain_clockisstoptime(grid) ) THEN
	830	CALL domain_clockadvance( grid )
	831	CALL domain_clockprint ( 150, grid, &
	832	'DEBUG assemble_output: clock after ClockAdvance,' )
	833	END IF
	834	END IF
	835
	836	IF ( config_flags%polar ) THEN
	837
	838	! No need to couple fields, since no lateral BCs are required.
	839
	840	ELSE
	841
	842	! Couple this time period's data with total mu, and save it in the *bdy3dtemp2 arrays.
	843
	844	! u, theta, h, scalars coupled with my; v coupled with mx
	845	CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp2 , grid%u_2 , 'u' , grid%msfuy , &
	846	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	847	CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp2 , grid%v_2 , 'v' , grid%msfvx , &
	848	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	849	CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp2 , grid%t_2 , 't' , grid%msfty , &
	850	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	851	CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp2 , grid%ph_2 , 'h' , grid%msfty , &
	852	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	853	CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , &
	854	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
	855
	856	DO j = jps , jpe
	857	DO i = ips , ipe
	858	mbdy2dtemp2(i,1,j) = grid%mu_2(i,j)
	859	END DO
	860	END DO
	861
	862	END IF
	863
	864	IF(grid_fdda .EQ. 1)THEN
	865	DO j = jps , jpe
	866	DO k = kps , kpe
	867	DO i = ips , ipe
	868	grid%fdda3d(i,k,j,p_u_ndg_new) = grid%u_2(i,k,j)
	869	grid%fdda3d(i,k,j,p_v_ndg_new) = grid%v_2(i,k,j)
	870	grid%fdda3d(i,k,j,p_t_ndg_new) = grid%t_2(i,k,j)
	871	grid%fdda3d(i,k,j,p_q_ndg_new) = grid%moist(i,k,j,P_QV)
	872	grid%fdda3d(i,k,j,p_ph_ndg_new) = grid%ph_2(i,k,j)
	873	END DO
	874	END DO
	875	END DO
	876
	877	DO j = jps , jpe
	878	DO i = ips , ipe
	879	grid%fdda2d(i,1,j,p_mu_ndg_new) = grid%mu_2(i,j)
	880	grid%fdda2d(i,1,j,p_t2_ndg_new) = grid%t2(i,j)
	881	grid%fdda2d(i,1,j,p_q2_ndg_new) = grid%q2(i,j)
	882	grid%fdda2d(i,1,j,p_sn_ndg_new) = grid%snow(i,j)
	883	END DO
	884	END DO
	885	END IF
	886
	887	IF ( config_flags%polar ) THEN
	888
	889	! No need to build boundary arrays, since no lateral BCs are being generated.
	890
	891	ELSE
	892
	893	! During all of the loops after the first loop, we first compute the boundary
	894	! tendencies with the current data values (*bdy3dtemp2 arrays) and the previously
	895	! saved information stored in the *bdy3dtemp1 arrays.
	896
	897	CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds) , &
	898	grid%u_btxs, grid%u_btxe, &
	899	grid%u_btys, grid%u_btye, &
	900	'U' , &
	901	spec_bdy_width , &
	902	ids , ide , jds , jde , kds , kde , &
	903	ims , ime , jms , jme , kms , kme , &
	904	ips , ipe , jps , jpe , kps , kpe )
	905	CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds) , &
	906	grid%v_btxs, grid%v_btxe, &
	907	grid%v_btys, grid%v_btye, &
	908	'V' , &
	909	spec_bdy_width , &
	910	ids , ide , jds , jde , kds , kde , &
	911	ims , ime , jms , jme , kms , kme , &
	912	ips , ipe , jps , jpe , kps , kpe )
	913	CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds) , &
	914	grid%t_btxs, grid%t_btxe, &
	915	grid%t_btys, grid%t_btye, &
	916	'T' , &
	917	spec_bdy_width , &
	918	ids , ide , jds , jde , kds , kde , &
	919	ims , ime , jms , jme , kms , kme , &
	920	ips , ipe , jps , jpe , kps , kpe )
	921	CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , REAL(interval_seconds) , &
	922	grid%ph_btxs, grid%ph_btxe, &
	923	grid%ph_btys, grid%ph_btye, &
	924	'W' , &
	925	spec_bdy_width , &
	926	ids , ide , jds , jde , kds , kde , &
	927	ims , ime , jms , jme , kms , kme , &
	928	ips , ipe , jps , jpe , kps , kpe )
	929	CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , &
	930	grid%moist_btxs(:,:,:,P_QV), grid%moist_btxe(:,:,:,P_QV), &
	931	grid%moist_btys(:,:,:,P_QV), grid%moist_btye(:,:,:,P_QV), &
	932	'T' , &
	933	spec_bdy_width , &
	934	ids , ide , jds , jde , kds , kde , &
	935	ims , ime , jms , jme , kms , kme , &
	936	ips , ipe , jps , jpe , kps , kpe )
	937	CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , REAL(interval_seconds) , &
	938	grid%mu_btxs, grid%mu_btxe, &
	939	grid%mu_btys, grid%mu_btye, &
	940	'M' , &
	941	spec_bdy_width , &
	942	ids , ide , jds , jde , 1 , 1 , &
	943	ims , ime , jms , jme , 1 , 1 , &
	944	ips , ipe , jps , jpe , 1 , 1 )
	945	END IF
	946
	947	! Both pieces of the boundary data are now available to be written (initial time and tendency).
	948	! This looks ugly, these date shifting things. What's it for? We want the "Times" variable
	949	! in the lateral BDY file to have the valid times of when the initial fields are written.
	950	! That's what the loop-2 thingy is for with the start date. We increment the start_date so
	951	! that the starting time in the attributes is the second time period. Why you may ask. I
	952	! agree, why indeed.
	953
	954	CALL domain_clockprint ( 150, grid, &
	955	'DEBUG assemble_output: clock before 1st current_date set,' )
	956	WRITE (wrf_err_message,*) &
	957	'DEBUG assemble_output: before 1st currTime set, current_date = ',TRIM(current_date)
	958	CALL wrf_debug ( 150 , wrf_err_message )
	959	CALL domain_clock_set( grid, current_date(1:19) )
	960	CALL domain_clockprint ( 150, grid, &
	961	'DEBUG assemble_output: clock after 1st current_date set,' )
	962
	963	temp24= current_date
	964	temp24b=start_date
	965	start_date = current_date
	966	CALL geth_newdate ( temp19 , temp24b(1:19) , (loop-2) * model_config_rec%interval_seconds )
	967	current_date = temp19 // '.0000'
	968	CALL domain_clockprint ( 150, grid, &
	969	'DEBUG assemble_output: clock before 2nd current_date set,' )
	970	WRITE (wrf_err_message,*) &
	971	'DEBUG assemble_output: before 2nd currTime set, current_date = ',TRIM(current_date)
	972	CALL wrf_debug ( 150 , wrf_err_message )
	973	CALL domain_clock_set( grid, current_date(1:19) )
	974	CALL domain_clockprint ( 150, grid, &
	975	'DEBUG assemble_output: clock after 2nd current_date set,' )
	976
	977	IF ( config_flags%polar ) THEN
	978
	979	! No need to ouput boundary data for polar cases.
	980
	981	ELSE
	982
	983	! Output boundary file.
	984
	985	IF(grid%id .EQ. 1)THEN
	986	print *,'LBC valid between these times ',current_date, ' ',start_date
	987	CALL output_boundary ( id, grid , config_flags , ierr )
	988	END IF
	989
	990	END IF
	991
	992	! Output gridded/analysis FDDA file.
	993
	994	IF(grid_fdda .EQ. 1) THEN
	995	CALL output_aux_model_input10 ( id2, grid , config_flags , ierr )
	996	END IF
	997
	998	current_date = temp24
	999	start_date = temp24b
	1000	CALL domain_clockprint ( 150, grid, &
	1001	'DEBUG assemble_output: clock before 3rd current_date set,' )
	1002	WRITE (wrf_err_message,*) &
	1003	'DEBUG assemble_output: before 3rd currTime set, current_date = ',TRIM(current_date)
	1004	CALL wrf_debug ( 150 , wrf_err_message )
	1005	CALL domain_clock_set( grid, current_date(1:19) )
	1006	CALL domain_clockprint ( 150, grid, &
	1007	'DEBUG assemble_output: clock after 3rd current_date set,' )
	1008
	1009	! OK, for all of the loops, we output the initialzation data, which would allow us to
	1010	! start the model at any of the available analysis time periods.
	1011
	1012	IF ( config_flags%all_ic_times ) THEN
	1013	CALL construct_filename2a ( inpname , 'wrfinput_d<domain>.<date>' , grid%id , 2 , TRIM(current_date) )
	1014	CALL open_w_dataset ( id1, inpname , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
	1015	IF ( ierr .NE. 0 ) THEN
	1016	CALL wrf_error_fatal( 'real: error opening' // inpname // ' for writing' )
	1017	END IF
	1018	CALL output_model_input ( id1, grid , config_flags , ierr )
	1019	CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
	1020	END IF
	1021
	1022	! Is this or is this not the last time time? We can remove some unnecessary
	1023	! stores if it is not.
	1024
	1025	IF ( loop .LT. time_loop_max ) THEN
	1026
	1027	IF ( config_flags%polar ) THEN
	1028
	1029	! No need to swap old for new for the boundary data, it is not required.
	1030
	1031	ELSE
	1032
	1033	! We need to save the 3d data to compute a difference during the next loop. Couple the
	1034	! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
	1035	! We load up the boundary data again for use in the next loop.
	1036
	1037	DO j = jps , jpe
	1038	DO k = kps , kpe
	1039	DO i = ips , ipe
	1040	ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
	1041	vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
	1042	tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
	1043	pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
	1044	qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
	1045	END DO
	1046	END DO
	1047	END DO
	1048
	1049	DO j = jps , jpe
	1050	DO i = ips , ipe
	1051	mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
	1052	END DO
	1053	END DO
	1054
	1055	END IF
	1056
	1057	IF(grid_fdda .EQ. 1)THEN
	1058	DO j = jps , jpe
	1059	DO k = kps , kpe
	1060	DO i = ips , ipe
	1061	grid%fdda3d(i,k,j,p_u_ndg_old) = grid%fdda3d(i,k,j,p_u_ndg_new)
	1062	grid%fdda3d(i,k,j,p_v_ndg_old) = grid%fdda3d(i,k,j,p_v_ndg_new)
	1063	grid%fdda3d(i,k,j,p_t_ndg_old) = grid%fdda3d(i,k,j,p_t_ndg_new)
	1064	grid%fdda3d(i,k,j,p_q_ndg_old) = grid%fdda3d(i,k,j,p_q_ndg_new)
	1065	grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%fdda3d(i,k,j,p_ph_ndg_new)
	1066	END DO
	1067	END DO
	1068	END DO
	1069
	1070	DO j = jps , jpe
	1071	DO i = ips , ipe
	1072	grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%fdda2d(i,1,j,p_mu_ndg_new)
	1073	grid%fdda2d(i,1,j,p_t2_ndg_old) = grid%fdda2d(i,1,j,p_t2_ndg_new)
	1074	grid%fdda2d(i,1,j,p_q2_ndg_old) = grid%fdda2d(i,1,j,p_q2_ndg_new)
	1075	grid%fdda2d(i,1,j,p_sn_ndg_old) = grid%fdda2d(i,1,j,p_sn_ndg_new)
	1076	END DO
	1077	END DO
	1078	END IF
	1079
	1080	IF ( config_flags%polar ) THEN
	1081
	1082	! No need to build boundary arrays, since no lateral BCs are being generated.
	1083
	1084	ELSE
	1085
	1086	! There are 2 components to the lateral boundaries. First, there is the starting
	1087	! point of this time period - just the outer few rows and columns.
	1088
	1089	CALL stuff_bdy ( ubdy3dtemp1 , grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
	1090	'U' , spec_bdy_width , &
	1091	ids , ide , jds , jde , kds , kde , &
	1092	ims , ime , jms , jme , kms , kme , &
	1093	ips , ipe , jps , jpe , kps , kpe )
	1094	CALL stuff_bdy ( vbdy3dtemp1 , grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
	1095	'V' , spec_bdy_width , &
	1096	ids , ide , jds , jde , kds , kde , &
	1097	ims , ime , jms , jme , kms , kme , &
	1098	ips , ipe , jps , jpe , kps , kpe )
	1099	CALL stuff_bdy ( tbdy3dtemp1 , grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
	1100	'T' , spec_bdy_width , &
	1101	ids , ide , jds , jde , kds , kde , &
	1102	ims , ime , jms , jme , kms , kme , &
	1103	ips , ipe , jps , jpe , kps , kpe )
	1104	CALL stuff_bdy ( pbdy3dtemp1 , grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
	1105	'W' , spec_bdy_width , &
	1106	ids , ide , jds , jde , kds , kde , &
	1107	ims , ime , jms , jme , kms , kme , &
	1108	ips , ipe , jps , jpe , kps , kpe )
	1109	CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV), &
	1110	grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV), &
	1111	'T' , spec_bdy_width , &
	1112	ids , ide , jds , jde , kds , kde , &
	1113	ims , ime , jms , jme , kms , kme , &
	1114	ips , ipe , jps , jpe , kps , kpe )
	1115	CALL stuff_bdy ( mbdy2dtemp1 , grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
	1116	'M' , spec_bdy_width , &
	1117	ids , ide , jds , jde , 1 , 1 , &
	1118	ims , ime , jms , jme , 1 , 1 , &
	1119	ips , ipe , jps , jpe , 1 , 1 )
	1120
	1121	END IF
	1122
	1123	ELSE IF ( loop .EQ. time_loop_max ) THEN
	1124
	1125	! If this is the last time through here, we need to close the files.
	1126
	1127	IF ( config_flags%polar ) THEN
	1128
	1129	! No need to close the boundary file, it was never used.
	1130
	1131	ELSE
	1132	IF(grid%id .EQ. 1) THEN
	1133	CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
	1134	END IF
	1135	END IF
	1136
	1137	IF(grid_fdda .EQ. 1) THEN
	1138	CALL close_dataset ( id2 , config_flags , "DATASET=AUXINPUT10" )
	1139	END IF
	1140
	1141	IF(sst_update .EQ. 1)THEN
	1142	CALL close_dataset ( id4 , config_flags , "DATASET=AUXINPUT4" )
	1143	END IF
	1144
	1145	END IF
	1146
	1147	END IF
	1148
	1149	END SUBROUTINE assemble_output

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

Download in other formats:

Original Format