Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

real_nmm.F @ 7

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

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 60.1 KB

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

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

Download in other formats:

Original Format