Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

start_em.F @ 3094

Last change on this file since 3094 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: 44.7 KB

Rev	Line
[2759]	1	!-------------------------------------------------------------------
	2
	3	SUBROUTINE start_domain_em ( grid, allowed_to_read &
	4	! Actual arguments generated from Registry
	5	# include "dummy_new_args.inc"
	6	!
	7	)
	8
	9	USE module_domain, ONLY : domain, wrfu_timeinterval, get_ijk_from_grid, &
	10	domain_setgmtetc
	11	USE module_state_description
	12	USE module_model_constants
	13	USE module_bc, ONLY : boundary_condition_check, set_physical_bc2d
	14	USE module_bc_em
	15	USE module_configure, ONLY : grid_config_rec_type
	16	USE module_tiles, ONLY : set_tiles
	17	USE module_dm, ONLY : wrf_dm_min_real
	18
	19	USE module_physics_init
	20	#ifdef WRF_CHEM
	21	USE module_aerosols_sorgam, ONLY: sum_pm_sorgam
	22	USE module_gocart_aerosols, ONLY: sum_pm_gocart
	23	USE module_mosaic_driver, ONLY: sum_pm_mosaic
	24	#endif
	25
	26	!!debug
	27	!USE module_compute_geop
	28
	29	USE module_model_constants
	30	IMPLICIT NONE
	31	! Input data.
	32	TYPE (domain) :: grid
	33
	34	LOGICAL , INTENT(IN) :: allowed_to_read
	35
	36	! Definitions of dummy arguments to this routine (generated from Registry).
	37	# include "dummy_new_decl.inc"
	38
	39	! Structure that contains run-time configuration (namelist) data for domain
	40	TYPE (grid_config_rec_type) :: config_flags
	41
	42	! Local data
	43	INTEGER :: &
	44	ids, ide, jds, jde, kds, kde, &
	45	ims, ime, jms, jme, kms, kme, &
	46	ips, ipe, jps, jpe, kps, kpe, &
	47	its, ite, jts, jte, kts, kte, &
	48	ij,i,j,k,ii,jj,kk,loop,error,l
	49
	50	INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
	51	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
	52	imsy, imey, jmsy, jmey, kmsy, kmey, &
	53	ipsy, ipey, jpsy, jpey, kpsy, kpey
	54
	55	INTEGER :: i_m
	56
	57	REAL :: p00, t00, a, p_surf, pd_surf
	58	#ifdef WRF_CHEM
	59	REAL RGASUNIV ! universal gas constant [ J/mol-K ]
	60	PARAMETER ( RGASUNIV = 8.314510 )
	61	REAL,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: &
	62	z_at_w,convfac
	63	REAL :: tempfac
	64	#endif
	65
	66	REAL :: qvf1, qvf2, qvf
	67	REAL :: MPDT
	68	REAL :: spongeweight
	69	LOGICAL :: first_trip_for_this_domain, start_of_simulation
	70	#ifndef WRF_CHEM
	71	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: cldfra_old
	72	#endif
	73
	74	REAL :: lat1 , lat2 , lat3 , lat4
	75	REAL :: lon1 , lon2 , lon3 , lon4
	76	INTEGER :: num_points_lat_lon , iloc , jloc
	77	CHARACTER (LEN=132) :: message
	78	TYPE(WRFU_TimeInterval) :: stepTime
	79	REAL, DIMENSION(:,:), ALLOCATABLE :: clat_glob
	80
	81	INTEGER :: idex, jdex
	82
	83	CALL get_ijk_from_grid ( grid , &
	84	ids, ide, jds, jde, kds, kde, &
	85	ims, ime, jms, jme, kms, kme, &
	86	ips, ipe, jps, jpe, kps, kpe, &
	87	imsx, imex, jmsx, jmex, kmsx, kmex, &
	88	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
	89	imsy, imey, jmsy, jmey, kmsy, kmey, &
	90	ipsy, ipey, jpsy, jpey, kpsy, kpey )
	91
	92	kts = kps ; kte = kpe ! note that tile is entire patch
	93	its = ips ; ite = ipe ! note that tile is entire patch
	94	jts = jps ; jte = jpe ! note that tile is entire patch
	95	#ifndef WRF_CHEM
	96	ALLOCATE(CLDFRA_OLD(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_OLD = 0.
	97	#endif
	98	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
	99
	100	IF ( ( MOD (ide-ids,config_flags%parent_grid_ratio) .NE. 0 ) .OR. &
	101	( MOD (jde-jds,config_flags%parent_grid_ratio) .NE. 0 ) ) THEN
	102	WRITE(message, FMT='("Nested dimensions are illegal for domain ",I2,": Both &
	103	&MOD(",I4,"-",I1,",",I2,") and MOD(",I4,"-",I1,",",I2,") must = 0" )') &
	104	grid%id,ide,ids,config_flags%parent_grid_ratio,jde,jds,config_flags%parent_grid_ratio
	105	CALL wrf_error_fatal ( message )
	106	END IF
	107
	108	IF ( config_flags%polar ) THEN
	109	!write(0,*)__FILE__,__LINE__,' clat ',ips,ipe,jps,jpe
	110	!do j = jps,jpe
	111	!write(0,*)__FILE__,__LINE__,' clat ',ids,j,grid%clat(ips,j)
	112	!enddo
	113
	114	#ifdef DM_PARALLEL
	115	! WARNING: this might present scaling issues on very large numbers of processors
	116	ALLOCATE( clat_glob(ids:ide,jds:jde) )
	117
	118	CALL wrf_patch_to_global_real ( grid%clat, clat_glob, grid%domdesc, 'xy', 'xy', &
	119	ids, ide, jds, jde, 1, 1, &
	120	ims, ime, jms, jme, 1, 1, &
	121	its, ite, jts, jte, 1, 1 )
	122
	123	CALL wrf_dm_bcast_real ( clat_glob , (ide-ids+1)*(jde-jds+1) )
	124
	125	grid%clat_xxx(ipsx:ipex,jpsx:jpex) = clat_glob(ipsx:ipex,jpsx:jpex)
	126
	127	DEALLOCATE( clat_glob )
	128	#endif
	129	ENDIF
	130
	131	! here we check to see if the boundary conditions are set properly
	132
	133	CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
	134
	135	!kludge - need to stop CG from resetting precip and phys tendencies to zero
	136	! when we are in here due to a nest being spawned, we want to still
	137	! recompute the base state, but that is about it
	138	! This is temporary and will need to be changed when grid%itimestep is removed.
	139
	140	IF ( grid%itimestep .EQ. 0 ) THEN
	141	first_trip_for_this_domain = .TRUE.
	142	ELSE
	143	first_trip_for_this_domain = .FALSE.
	144	END IF
	145
	146	IF ( .not. ( config_flags%restart .or. grid%moved ) ) THEN
	147	grid%itimestep=0
	148	ENDIF
	149
	150	IF ( config_flags%restart .or. grid%moved ) THEN
	151	first_trip_for_this_domain = .TRUE.
	152	ENDIF
	153
	154	! wig: Add a combined exponential+linear weight on the mother boundaries
	155	! following code changes by Ruby Leung. For the nested grid, there
	156	! appears to be some problems when a sponge is used. The points where
	157	! processors meet have problematic values.
	158
	159	CALL lbc_fcx_gcx ( grid%fcx , grid%gcx , grid%spec_bdy_width , &
	160	grid%spec_zone , grid%relax_zone , grid%dt , config_flags%spec_exp , &
	161	config_flags%specified , config_flags%nested )
	162
	163	IF ( config_flags%nested ) THEN
	164	grid%dtbc = 0.
	165	ENDIF
	166
	167	IF ( ( grid%id .NE. 1 ) .AND. ( .NOT. config_flags%input_from_file ) ) THEN
	168
	169	! Every time a domain starts or every time a domain moves, this routine is called. We want
	170	! the center (middle) lat/lon of the grid for the metacode. The lat/lon values are
	171	! defined at mass points. Depending on the even/odd points in the SN and WE directions,
	172	! we end up with the middle point as either 1 point or an average of either 2 or 4 points.
	173	! Add to this, the need to make sure that we are on the correct patch to retrieve the
	174	! value of the lat/lon, AND that the lat/lons (for an average) may not all be on the same
	175	! patch. Once we find the correct value for lat lon, we need to keep it around on all patches,
	176	! which is where the wrf_dm_min_real calls come in.
	177	! If this is the most coarse domain, we do not go in here. Also, if there is an input file
	178	! (which has the right values for the middle lat/lon) we do not go in this IF test.
	179
	180	IF ( ( MOD(ide,2) .EQ. 0 ) .AND. ( MOD(jde,2) .EQ. 0 ) ) THEN
	181	num_points_lat_lon = 1
	182	iloc = ide/2
	183	jloc = jde/2
	184	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	185	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	186	lat1 = grid%xlat (iloc,jloc)
	187	lon1 = grid%xlong(iloc,jloc)
	188	ELSE
	189	lat1 = 99999.
	190	lon1 = 99999.
	191	END IF
	192	lat1 = wrf_dm_min_real ( lat1 )
	193	lon1 = wrf_dm_min_real ( lon1 )
	194	CALL nl_set_cen_lat ( grid%id , lat1 )
	195	CALL nl_set_cen_lon ( grid%id , lon1 )
	196	ELSE IF ( ( MOD(ide,2) .NE. 0 ) .AND. ( MOD(jde,2) .EQ. 0 ) ) THEN
	197	num_points_lat_lon = 2
	198	iloc = (ide-1)/2
	199	jloc = jde /2
	200	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	201	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	202	lat1 = grid%xlat (iloc,jloc)
	203	lon1 = grid%xlong(iloc,jloc)
	204	ELSE
	205	lat1 = 99999.
	206	lon1 = 99999.
	207	END IF
	208	lat1 = wrf_dm_min_real ( lat1 )
	209	lon1 = wrf_dm_min_real ( lon1 )
	210
	211	iloc = (ide+1)/2
	212	jloc = jde /2
	213	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	214	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	215	lat2 = grid%xlat (iloc,jloc)
	216	lon2 = grid%xlong(iloc,jloc)
	217	ELSE
	218	lat2 = 99999.
	219	lon2 = 99999.
	220	END IF
	221	lat2 = wrf_dm_min_real ( lat2 )
	222	lon2 = wrf_dm_min_real ( lon2 )
	223
	224	CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 ) * 0.50 )
	225	CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 ) * 0.50 )
	226	ELSE IF ( ( MOD(ide,2) .EQ. 0 ) .AND. ( MOD(jde,2) .NE. 0 ) ) THEN
	227	num_points_lat_lon = 2
	228	iloc = ide /2
	229	jloc = (jde-1)/2
	230	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	231	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	232	lat1 = grid%xlat (iloc,jloc)
	233	lon1 = grid%xlong(iloc,jloc)
	234	ELSE
	235	lat1 = 99999.
	236	lon1 = 99999.
	237	END IF
	238	lat1 = wrf_dm_min_real ( lat1 )
	239	lon1 = wrf_dm_min_real ( lon1 )
	240
	241	iloc = ide /2
	242	jloc = (jde+1)/2
	243	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	244	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	245	lat2 = grid%xlat (iloc,jloc)
	246	lon2 = grid%xlong(iloc,jloc)
	247	ELSE
	248	lat2 = 99999.
	249	lon2 = 99999.
	250	END IF
	251	lat2 = wrf_dm_min_real ( lat2 )
	252	lon2 = wrf_dm_min_real ( lon2 )
	253
	254	CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 ) * 0.50 )
	255	CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 ) * 0.50 )
	256	ELSE IF ( ( MOD(ide,2) .NE. 0 ) .AND. ( MOD(jde,2) .NE. 0 ) ) THEN
	257	num_points_lat_lon = 4
	258	iloc = (ide-1)/2
	259	jloc = (jde-1)/2
	260	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	261	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	262	lat1 = grid%xlat (iloc,jloc)
	263	lon1 = grid%xlong(iloc,jloc)
	264	ELSE
	265	lat1 = 99999.
	266	lon1 = 99999.
	267	END IF
	268	lat1 = wrf_dm_min_real ( lat1 )
	269	lon1 = wrf_dm_min_real ( lon1 )
	270
	271	iloc = (ide+1)/2
	272	jloc = (jde-1)/2
	273	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	274	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	275	lat2 = grid%xlat (iloc,jloc)
	276	lon2 = grid%xlong(iloc,jloc)
	277	ELSE
	278	lat2 = 99999.
	279	lon2 = 99999.
	280	END IF
	281	lat2 = wrf_dm_min_real ( lat2 )
	282	lon2 = wrf_dm_min_real ( lon2 )
	283
	284	iloc = (ide-1)/2
	285	jloc = (jde+1)/2
	286	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	287	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	288	lat3 = grid%xlat (iloc,jloc)
	289	lon3 = grid%xlong(iloc,jloc)
	290	ELSE
	291	lat3 = 99999.
	292	lon3 = 99999.
	293	END IF
	294	lat3 = wrf_dm_min_real ( lat3 )
	295	lon3 = wrf_dm_min_real ( lon3 )
	296
	297	iloc = (ide+1)/2
	298	jloc = (jde+1)/2
	299	IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
	300	( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
	301	lat4 = grid%xlat (iloc,jloc)
	302	lon4 = grid%xlong(iloc,jloc)
	303	ELSE
	304	lat4 = 99999.
	305	lon4 = 99999.
	306	END IF
	307	lat4 = wrf_dm_min_real ( lat4 )
	308	lon4 = wrf_dm_min_real ( lon4 )
	309
	310	CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 + lat3 + lat4 ) * 0.25 )
	311	CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 + lon3 + lon4 ) * 0.25 )
	312	END IF
	313	END IF
	314
	315	IF ( .NOT. config_flags%restart .AND. &
	316	(( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ))) THEN
	317
	318	IF ( config_flags%map_proj .EQ. 0 ) THEN
	319	CALL wrf_error_fatal ( 'start_domain: Idealized case cannot have a separate nested input file' )
	320	END IF
	321
	322	CALL nl_get_base_pres ( 1 , p00 )
	323	CALL nl_get_base_temp ( 1 , t00 )
	324	CALL nl_get_base_lapse ( 1 , a )
	325
	326	! Base state potential temperature and inverse density (alpha = 1/rho) from
	327	! the half eta levels and the base-profile surface pressure. Compute 1/rho
	328	! from equation of state. The potential temperature is a perturbation from t0.
	329
	330	DO j = jts, MIN(jte,jde-1)
	331	DO i = its, MIN(ite,ide-1)
	332
	333	! Base state pressure is a function of eta level and terrain, only, plus
	334	! the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
	335	! temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
	336
	337	p_surf = p00 * EXP ( -t00/a + ( (t00/a)*2 - 2.ggrid%ht(i,j)/a/r_d ) *0.5 )
	338
	339	DO k = 1, kte-1
	340	grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
	341	grid%t_init(i,k,j) = (t00 + ALOG(grid%pb(i,k,j)/p00))(p00/grid%pb(i,k,j))**(r_d/cp) - t0
	342	grid%alb(i,k,j) = (r_d/p1000mb)(grid%t_init(i,k,j)+t0)(grid%pb(i,k,j)/p1000mb)**cvpm
	343	END DO
	344
	345	! Base state mu is defined as base state surface pressure minus grid%p_top
	346
	347	grid%mub(i,j) = p_surf - grid%p_top
	348
	349	! Integrate base geopotential, starting at terrain elevation. This assures that
	350	! the base state is in exact hydrostatic balance with respect to the model equations.
	351	! This field is on full levels.
	352
	353	grid%phb(i,1,j) = grid%ht(i,j) * g
	354	DO k = 2,kte
	355	grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)grid%mub(i,j)grid%alb(i,k-1,j)
	356	END DO
	357	END DO
	358	END DO
	359
	360	ENDIF
	361
	362	IF(.not.config_flags%restart)THEN
	363
	364	! if this is for a nested domain, the defined/interpolated fields are the _2
	365
	366	IF ( first_trip_for_this_domain ) THEN
	367
	368	! data that is expected to be zero must be explicitly initialized as such
	369	! grid%h_diabatic = 0.
	370
	371	DO j = jts,min(jte,jde-1)
	372	DO k = kts,kte-1
	373	DO i = its, min(ite,ide-1)
	374	IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
	375	grid%t_1(i,k,j)=grid%t_2(i,k,j)
	376	ENDIF
	377	ENDDO
	378	ENDDO
	379	ENDDO
	380
	381	DO j = jts,min(jte,jde-1)
	382	DO i = its, min(ite,ide-1)
	383	IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
	384	grid%mu_1(i,j)=grid%mu_2(i,j)
	385	ENDIF
	386	ENDDO
	387	ENDDO
	388	END IF
	389
	390	! reconstitute base-state fields
	391
	392	IF(config_flags%max_dom .EQ. 1)THEN
	393	! with single domain, grid%t_init from wrfinput is OK to use
	394	DO j = jts,min(jte,jde-1)
	395	DO k = kts,kte-1
	396	DO i = its, min(ite,ide-1)
	397	IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
	398	grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top
	399	grid%alb(i,k,j) = (r_d/p1000mb)(grid%t_init(i,k,j)+t0)(grid%pb(i,k,j)/p1000mb)**cvpm
	400	ENDIF
	401	ENDDO
	402	ENDDO
	403	ENDDO
	404	ELSE
	405	! with nests, grid%t_init generally needs recomputations (since it is not interpolated)
	406	DO j = jts,min(jte,jde-1)
	407	DO k = kts,kte-1
	408	DO i = its, min(ite,ide-1)
	409	IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
	410	grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top
	411	grid%alb(i,k,j) = -grid%rdnw(k)*(grid%phb(i,k+1,j)-grid%phb(i,k,j))/grid%mub(i,j)
	412	grid%t_init(i,k,j) = grid%alb(i,k,j)(p1000mb/r_d)/((grid%pb(i,k,j)/p1000mb)*cvpm) - t0
	413	ENDIF
	414	ENDDO
	415	ENDDO
	416	ENDDO
	417	ENDIF
	418
	419	DO j = jts,min(jte,jde-1)
	420
	421	k = kte-1
	422	DO i = its, min(ite,ide-1)
	423	IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
	424	qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV))
	425	qvf2 = 1./(1.+qvf1)
	426	qvf1 = qvf1*qvf2
	427	grid%p(i,k,j) = - 0.5(grid%mu_1(i,j)+qvf1grid%mub(i,j))/grid%rdnw(k)/qvf2
	428	qvf = 1. + rvovrd*moist(i,k,j,P_QV)
	429	grid%alt(i,k,j) = (r_d/p1000mb)(grid%t_1(i,k,j)+t0)qvf(((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)*cvpm)
	430	grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j)
	431	ENDIF
	432	ENDDO
	433
	434	DO k = kte-2, 1, -1
	435	DO i = its, min(ite,ide-1)
	436	IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
	437	qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV))
	438	qvf2 = 1./(1.+qvf1)
	439	qvf1 = qvf1*qvf2
	440	grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_1(i,j) + qvf1*grid%mub(i,j))/qvf2/grid%rdn(k+1)
	441	qvf = 1. + rvovrd*moist(i,k,j,P_QV)
	442	grid%alt(i,k,j) = (r_d/p1000mb)(grid%t_1(i,k,j)+t0)qvf* &
	443	(((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm)
	444	grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j)
	445	ENDIF
	446	ENDDO
	447	ENDDO
	448
	449	ENDDO
	450
	451	ENDIF
	452
	453	IF ( grid%press_adj .and. ( grid%id .NE. 1 ) .AND. .NOT. ( config_flags%restart ) .AND. &
	454	( ( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ) ) ) THEN
	455	DO j = jts, MIN(jte,jde-1)
	456	DO i = its, MIN(ite,ide-1)
	457	grid%mu_2(i,j) = grid%mu_2(i,j) + grid%al(i,1,j) / ( grid%alt(i,1,j) * grid%alb(i,1,j) ) * &
	458	g * ( grid%ht(i,j) - grid%ht_fine(i,j) )
	459	END DO
	460	END DO
	461	DO j = jts,min(jte,jde-1)
	462	DO i = its, min(ite,ide-1)
	463	grid%mu_1(i,j)=grid%mu_2(i,j)
	464	ENDDO
	465	ENDDO
	466
	467	END IF
	468
	469	IF ( first_trip_for_this_domain ) THEN
	470
	471	CALL wrf_debug ( 100 , 'start_domain_em: Before call to phy_init' )
	472
	473	! namelist MPDT does not exist yet, so set it here
	474	! MPDT is the call frequency for microphysics in minutes (0 means every step)
	475	MPDT = 0.
	476
	477	! set GMT outside of phy_init because phy_init may not be called on this
	478	! process if, for example, it is a moving nest and if this part of the domain is not
	479	! being initialized (not the leading edge).
	480	CALL domain_setgmtetc( grid, start_of_simulation )
	481
	482	!-----------------------------------------------------------------------------
	483	! Adaptive time step: Added by T. Hutchinson, WSI 11/6/07
	484	!
	485	!
	486
	487	IF ( ( grid%use_adaptive_time_step ) .AND. &
	488	( ( grid%dfi_opt .EQ. DFI_NODFI ) .OR. ( grid%dfi_stage .EQ. DFI_FST ) ) ) THEN
	489
	490	! Calculate any variables that were not set
	491
	492	if (grid%starting_time_step == -1) then
	493	grid%starting_time_step = NINT(6 * MIN(grid%dx,grid%dy) / 1000)
	494	endif
	495
	496	if (grid%max_time_step == -1) then
	497	grid%max_time_step = 3*grid%starting_time_step
	498	endif
	499
	500	if (grid%min_time_step == -1) then
	501	grid%min_time_step = 0.5*grid%starting_time_step
	502	endif
	503
	504	! Set a starting timestep.
	505
	506	grid%dt = grid%starting_time_step / grid%parent_time_step_ratio
	507
	508	! Check to assure that time_step_sound is to be dynamically set.
	509
	510	CALL nl_set_time_step_sound ( 1 , 0 )
	511	grid%time_step_sound = 0
	512
	513	grid%max_msftx=MAXVAL(grid%msftx)
	514	grid%max_msfty=MAXVAL(grid%msfty)
	515	#ifdef DM_PARALLEL
	516	CALL wrf_dm_maxval(grid%max_msftx, idex, jdex)
	517	CALL wrf_dm_maxval(grid%max_msfty, idex, jdex)
	518	#endif
	519
	520	! This first call just initializes variables.
	521
	522	CALL adapt_timestep(grid, config_flags)
	523
	524	END IF
	525
	526	! End of adaptive time step modifications
	527	!-----------------------------------------------------------------------------
	528
	529
	530	CALL set_tiles ( grid , grid%imask_nostag, ims, ime, jms, jme, ips, ipe, jps, jpe )
	531	!
	532	! Phy init can do reads and broadcasts when initializing physics -- landuse for example. However, if
	533	! we're running on a reduced mesh (that is, some tasks don't have any work) we have to at least let them
	534	! pass through this code so the broadcasts don't hang on the other, active tasks. Set the number of
	535	! tiles to a minimum of 1 and assume that the backwards patch ranges (ips=0, ipe=-1) will prevent
	536	! anything else from happening on the blank tasks. JM 20080605
	537	!
	538	if ( allowed_to_read ) grid%num_tiles = max(1,grid%num_tiles)
	539	!
	540	! Phy_init is not necessarily thread-safe; do not multi-thread this loop.
	541	! The tiling is to handle the fact that we may be masking off part of the computation.
	542	!
	543	DO ij = 1, grid%num_tiles
	544
	545	CALL phy_init ( grid%id , config_flags, grid%DT, grid%RESTART, grid%znw, grid%znu, &
	546	grid%p_top, grid%tsk, grid%RADT,grid%BLDT,grid%CUDT, MPDT, &
	547	grid%rthcuten, grid%rqvcuten, grid%rqrcuten, &
	548	grid%rqccuten, grid%rqscuten, grid%rqicuten, &
	549	grid%rublten,grid%rvblten,grid%rthblten, &
	550	grid%rqvblten,grid%rqcblten,grid%rqiblten, &
	551	grid%rthraten,grid%rthratenlw,grid%rthratensw, &
	552	grid%stepbl,grid%stepra,grid%stepcu, &
	553	grid%w0avg, grid%rainnc, grid%rainc, grid%raincv, grid%rainncv, &
	554	grid%nca,grid%swrad_scat, &
	555	grid%cldefi,grid%lowlyr, &
	556	grid%mass_flux, &
	557	grid%rthften, grid%rqvften, &
	558	grid%cldfra, &
	559	#ifdef WRF_CHEM
	560	grid%cldfra_old, &
	561	#endif
	562	#ifndef WRF_CHEM
	563	cldfra_old, &
	564	#endif
	565	grid%glw,grid%gsw,grid%emiss,grid%embck, &
	566	grid%lu_index, &
	567	grid%landuse_ISICE, grid%landuse_LUCATS, &
	568	grid%landuse_LUSEAS, grid%landuse_ISN, &
	569	grid%lu_state, &
	570	grid%xlat,grid%xlong,grid%albedo,grid%albbck,grid%GMT,grid%JULYR,grid%JULDAY, &
	571	grid%levsiz, num_ozmixm, num_aerosolc, grid%paerlev, &
	572	grid%tmn,grid%xland,grid%znt,grid%z0,grid%ust,grid%mol,grid%pblh,grid%tke_myj, &
	573	grid%exch_h,grid%thc,grid%snowc,grid%mavail,grid%hfx,grid%qfx,grid%rainbl, &
	574	grid%tslb,grid%zs,grid%dzs,config_flags%num_soil_layers,grid%warm_rain, &
	575	grid%adv_moist_cond, &
	576	grid%apr_gr,grid%apr_w,grid%apr_mc,grid%apr_st,grid%apr_as, &
	577	grid%apr_capma,grid%apr_capme,grid%apr_capmi, &
	578	grid%xice,grid%xicem,grid%vegfra,grid%snow,grid%canwat,grid%smstav, &
	579	grid%smstot, grid%sfcrunoff,grid%udrunoff,grid%grdflx,grid%acsnow, &
	580	grid%acsnom,grid%ivgtyp,grid%isltyp, grid%sfcevp,grid%smois, &
	581	grid%sh2o, grid%snowh, grid%smfr3d, &
	582	grid%DX,grid%DY,grid%f_ice_phy,grid%f_rain_phy,grid%f_rimef_phy, &
	583	grid%mp_restart_state,grid%tbpvs_state,grid%tbpvs0_state,&
	584	allowed_to_read, grid%moved, start_of_simulation, &
	585	ids, ide, jds, jde, kds, kde, &
	586	ims, ime, jms, jme, kms, kme, &
	587	grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), kts, kte, &
	588	ozmixm,grid%pin, & ! Optional
	589	grid%m_ps_1,grid%m_ps_2,grid%m_hybi,aerosolc_1,aerosolc_2,& ! Optional
	590	grid%rundgdten,grid%rvndgdten,grid%rthndgdten, & ! Optional
	591	grid%rqvndgdten,grid%rmundgdten, & ! Optional
	592	grid%FGDT,grid%stepfg, & ! Optional
	593	grid%cugd_tten,grid%cugd_ttens,grid%cugd_qvten, & ! Optional
	594	grid%cugd_qvtens,grid%cugd_qcten, & ! Optional
	595	grid%DZR, grid%DZB, grid%DZG, & !Optional urban
	596	grid%TR_URB2D,grid%TB_URB2D,grid%TG_URB2D,grid%TC_URB2D, & !Optional urban
	597	grid%QC_URB2D, grid%XXXR_URB2D,grid%XXXB_URB2D, & !Optional urban
	598	grid%XXXG_URB2D, grid%XXXC_URB2D, & !Optional urban
	599	grid%TRL_URB3D, grid%TBL_URB3D, grid%TGL_URB3D, & !Optional urban
	600	grid%SH_URB2D, grid%LH_URB2D, grid%G_URB2D, grid%RN_URB2D, & !Optional urban
	601	grid%TS_URB2D, grid%FRC_URB2D, grid%UTYPE_URB2D, & !Optional urban
	602	grid%TML,grid%T0ML,grid%HML,grid%H0ML,grid%HUML,grid%HVML, & !Optional oml
	603	itimestep=grid%itimestep, fdob=grid%fdob &
	604	)
	605
	606	ENDDO
	607
	608
	609
	610	CALL wrf_debug ( 100 , 'start_domain_em: After call to phy_init' )
	611
	612	#ifdef MCELIO
	613	grid%LU_MASK = 0.
	614	WHERE ( grid%lu_index .EQ. 16 ) grid%LU_MASK = 1.
	615	#endif
	616
	617	END IF
	618
	619	#if 0
	620	#include "CYCLE_TEST.inc"
	621	#endif
	622
	623	!
	624	!
	625
	626	! set physical boundary conditions for all initialized variables
	627
	628	!-----------------------------------------------------------------------
	629	! Stencils for patch communications (WCS, 29 June 2001)
	630	! Note: the size of this halo exchange reflects the
	631	! fact that we are carrying the uncoupled variables
	632	! as state variables in the mass coordinate model, as
	633	! opposed to the coupled variables as in the height
	634	! coordinate model.
	635	!
	636	! * * * * *
	637	! * * * * * * * * *
	638	! * + * * + * * * + * *
	639	! * * * * * * * * *
	640	! * * * * *
	641	!
	642	!j grid%u_1 x
	643	!j grid%u_2 x
	644	!j grid%v_1 x
	645	!j grid%v_2 x
	646	!j grid%w_1 x
	647	!j grid%w_2 x
	648	!j grid%t_1 x
	649	!j grid%t_2 x
	650	!j grid%ph_1 x
	651	!j grid%ph_2 x
	652	!
	653	!j grid%t_init x
	654	!
	655	!j grid%phb x
	656	!j grid%ph0 x
	657	!j grid%php x
	658	!j grid%pb x
	659	!j grid%al x
	660	!j grid%alt x
	661	!j grid%alb x
	662	!
	663	! the following are 2D (xy) variables
	664	!
	665	!j grid%mu_1 x
	666	!j grid%mu_2 x
	667	!j grid%mub x
	668	!j grid%mu0 x
	669	!j grid%ht x
	670	!j grid%msftx x
	671	!j grid%msfty x
	672	!j grid%msfux x
	673	!j grid%msfuy x
	674	!j grid%msfvx x
	675	!j grid%msfvy x
	676	!j grid%sina x
	677	!j grid%cosa x
	678	!j grid%e x
	679	!j grid%f x
	680	!
	681	! 4D variables
	682	!
	683	! moist x
	684	! chem x
	685	!scalar x
	686
	687	!--------------------------------------------------------------
	688
	689	#ifdef DM_PARALLEL
	690	# include "HALO_EM_INIT_1.inc"
	691	# include "HALO_EM_INIT_2.inc"
	692	# include "HALO_EM_INIT_3.inc"
	693	# include "HALO_EM_INIT_4.inc"
	694	# include "HALO_EM_INIT_5.inc"
	695	# include "PERIOD_BDY_EM_INIT.inc"
	696	# include "PERIOD_BDY_EM_MOIST.inc"
	697	# include "PERIOD_BDY_EM_CHEM.inc"
	698	#endif
	699
	700
	701	CALL set_physical_bc3d( grid%u_1 , 'U' , config_flags , &
	702	ids , ide , jds , jde , kds , kde , &
	703	ims , ime , jms , jme , kms , kme , &
	704	its , ite , jts , jte , kts , kte , &
	705	its , ite , jts , jte , kts , kte )
	706	CALL set_physical_bc3d( grid%u_2 , 'U' , config_flags , &
	707	ids , ide , jds , jde , kds , kde , &
	708	ims , ime , jms , jme , kms , kme , &
	709	its , ite , jts , jte , kts , kte , &
	710	its , ite , jts , jte , kts , kte )
	711
	712	CALL set_physical_bc3d( grid%v_1 , 'V' , config_flags , &
	713	ids , ide , jds , jde , kds , kde , &
	714	ims , ime , jms , jme , kms , kme , &
	715	its , ite , jts , jte , kts , kte , &
	716	its , ite , jts , jte , kts , kte )
	717	CALL set_physical_bc3d( grid%v_2 , 'V' , config_flags , &
	718	ids , ide , jds , jde , kds , kde , &
	719	ims , ime , jms , jme , kms , kme , &
	720	its , ite , jts , jte , kts , kte , &
	721	its , ite , jts , jte , kts , kte )
	722
	723	! set kinematic condition for w
	724
	725	CALL set_physical_bc2d( grid%ht , 'r' , config_flags , &
	726	ids , ide , jds , jde , &
	727	ims , ime , jms , jme , &
	728	its , ite , jts , jte , &
	729	its , ite , jts , jte )
	730
	731	IF ( .not. config_flags%restart ) THEN
	732	CALL set_w_surface( config_flags, grid%znw, &
	733	grid%w_1, grid%ht, grid%u_1, grid%v_1, grid%cf1, &
	734	grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
	735	ids, ide, jds, jde, kds, kde, &
	736	ips, ipe, jps, jpe, kps, kpe, &
	737	its, ite, jts, jte, kts, kte, &
	738	ims, ime, jms, jme, kms, kme )
	739	CALL set_w_surface( config_flags, grid%znw, &
	740	grid%w_2, grid%ht, grid%u_2, grid%v_2, grid%cf1, &
	741	grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
	742	ids, ide, jds, jde, kds, kde, &
	743	ips, ipe, jps, jpe, kps, kpe, &
	744	its, ite, jts, jte, kts, kte, &
	745	ims, ime, jms, jme, kms, kme )
	746	END IF
	747
	748	! finished setting kinematic condition for w at the surface
	749
	750	CALL set_physical_bc3d( grid%w_1 , 'W' , config_flags , &
	751	ids , ide , jds , jde , kds , kde , &
	752	ims , ime , jms , jme , kms , kme , &
	753	its , ite , jts , jte , kts , kte , &
	754	its , ite , jts , jte , kts , kte )
	755	CALL set_physical_bc3d( grid%w_2 , 'W' , config_flags , &
	756	ids , ide , jds , jde , kds , kde , &
	757	ims , ime , jms , jme , kms , kme , &
	758	its , ite , jts , jte , kts , kte , &
	759	its , ite , jts , jte , kts , kte )
	760
	761	CALL set_physical_bc3d( grid%ph_1 , 'W' , config_flags , &
	762	ids , ide , jds , jde , kds , kde , &
	763	ims , ime , jms , jme , kms , kme , &
	764	its , ite , jts , jte , kts , kte , &
	765	its , ite , jts , jte , kts , kte )
	766
	767	CALL set_physical_bc3d( grid%ph_2 , 'W' , config_flags , &
	768	ids , ide , jds , jde , kds , kde , &
	769	ims , ime , jms , jme , kms , kme , &
	770	its , ite , jts , jte , kts , kte , &
	771	its , ite , jts , jte , kts , kte )
	772
	773	CALL set_physical_bc3d( grid%t_1 , 't' , config_flags , &
	774	ids , ide , jds , jde , kds , kde , &
	775	ims , ime , jms , jme , kms , kme , &
	776	its , ite , jts , jte , kts , kte , &
	777	its , ite , jts , jte , kts , kte )
	778
	779	CALL set_physical_bc3d( grid%t_2 , 't' , config_flags , &
	780	ids , ide , jds , jde , kds , kde , &
	781	ims , ime , jms , jme , kms , kme , &
	782	its , ite , jts , jte , kts , kte , &
	783	its , ite , jts , jte , kts , kte )
	784
	785	CALL set_physical_bc2d( grid%mu_1, 't' , config_flags , &
	786	ids , ide , jds , jde , &
	787	ims , ime , jms , jme , &
	788	its , ite , jts , jte , &
	789	its , ite , jts , jte )
	790	CALL set_physical_bc2d( grid%mu_2, 't' , config_flags , &
	791	ids , ide , jds , jde , &
	792	ims , ime , jms , jme , &
	793	its , ite , jts , jte , &
	794	its , ite , jts , jte )
	795	CALL set_physical_bc2d( grid%mub , 't' , config_flags , &
	796	ids , ide , jds , jde , &
	797	ims , ime , jms , jme , &
	798	its , ite , jts , jte , &
	799	its , ite , jts , jte )
	800	CALL set_physical_bc2d( grid%mu0 , 't' , config_flags , &
	801	ids , ide , jds , jde , &
	802	ims , ime , jms , jme , &
	803	its , ite , jts , jte , &
	804	its , ite , jts , jte )
	805
	806
	807	CALL set_physical_bc3d( grid%phb , 'W' , config_flags , &
	808	ids , ide , jds , jde , kds , kde , &
	809	ims , ime , jms , jme , kms , kme , &
	810	its , ite , jts , jte , kts , kte , &
	811	its , ite , jts , jte , kts , kte )
	812	CALL set_physical_bc3d( grid%ph0 , 'W' , config_flags , &
	813	ids , ide , jds , jde , kds , kde , &
	814	ims , ime , jms , jme , kms , kme , &
	815	its , ite , jts , jte , kts , kte , &
	816	its , ite , jts , jte , kts , kte )
	817	CALL set_physical_bc3d( grid%php , 'W' , config_flags , &
	818	ids , ide , jds , jde , kds , kde , &
	819	ims , ime , jms , jme , kms , kme , &
	820	its , ite , jts , jte , kts , kte , &
	821	its , ite , jts , jte , kts , kte )
	822
	823	CALL set_physical_bc3d( grid%pb , 't' , config_flags , &
	824	ids , ide , jds , jde , kds , kde , &
	825	ims , ime , jms , jme , kms , kme , &
	826	its , ite , jts , jte , kts , kte , &
	827	its , ite , jts , jte , kts , kte )
	828	CALL set_physical_bc3d( grid%al , 't' , config_flags , &
	829	ids , ide , jds , jde , kds , kde , &
	830	ims , ime , jms , jme , kms , kme , &
	831	its , ite , jts , jte , kts , kte , &
	832	its , ite , jts , jte , kts , kte )
	833	CALL set_physical_bc3d( grid%alt , 't' , config_flags , &
	834	ids , ide , jds , jde , kds , kde , &
	835	ims , ime , jms , jme , kms , kme , &
	836	its , ite , jts , jte , kts , kte , &
	837	its , ite , jts , jte , kts , kte )
	838	CALL set_physical_bc3d( grid%alb , 't' , config_flags , &
	839	ids , ide , jds , jde , kds , kde , &
	840	ims , ime , jms , jme , kms , kme , &
	841	its , ite , jts , jte , kts , kte , &
	842	its , ite , jts , jte , kts , kte )
	843	CALL set_physical_bc3d(grid%t_init, 't' , config_flags , &
	844	ids , ide , jds , jde , kds , kde , &
	845	ims , ime , jms , jme , kms , kme , &
	846	its , ite , jts , jte , kts , kte , &
	847	its , ite , jts , jte , kts , kte )
	848
	849	IF (num_moist > 0) THEN
	850
	851	! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
	852
	853	loop_3d_m : DO loop = 1 , num_moist
	854	CALL set_physical_bc3d( moist(:,:,:,loop) , 'r' , config_flags , &
	855	ids , ide , jds , jde , kds , kde , &
	856	ims , ime , jms , jme , kms , kme , &
	857	its , ite , jts , jte , kts , kte , &
	858	its , ite , jts , jte , kts , kte )
	859	END DO loop_3d_m
	860
	861	ENDIF
	862
	863	!wig 17-Oct-2006, begin: I think the following should be here...
	864	IF (num_scalar > 0) THEN
	865
	866	! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
	867
	868	loop_3d_s : DO loop = 1 , num_scalar
	869	CALL set_physical_bc3d( scalar(:,:,:,loop) , 'r' , config_flags , &
	870	ids , ide , jds , jde , kds , kde , &
	871	ims , ime , jms , jme , kms , kme , &
	872	its , ite , jts , jte , kts , kte , &
	873	its , ite , jts , jte , kts , kte )
	874	END DO loop_3d_s
	875
	876	ENDIF
	877	!wig end.
	878
	879
	880	#ifdef WRF_CHEM
	881	!
	882	! we do this here, so we only have one chem_init routine for either core....
	883	!
	884	do j=jts,min(jte,jde-1)
	885	do i=its,min(ite,ide-1)
	886	do k=kts,kte
	887	z_at_w(i,k,j)=(grid%ph_2(i,k,j)+grid%phb(i,k,j))/g
	888	enddo
	889	do k=kts,min(kte,kde-1)
	890	tempfac=(grid%t_1(i,k,j) + t0)((grid%p(i,k,j) + grid%pb(i,k,j))/p1000mb)*rcp
	891	convfac(i,k,j) = (grid%p(i,k,j)+grid%pb(i,k,j))/rgasuniv/tempfac
	892	enddo
	893	enddo
	894	enddo
	895
	896	CALL chem_init (grid%id,chem,emis_ant,scalar,grid%dt,grid%bioemdt,grid%photdt, &
	897	grid%chemdt, &
	898	grid%stepbioe,grid%stepphot,grid%stepchem,grid%stepfirepl, &
	899	grid%plumerisefire_frq,z_at_w,grid%xlat,grid%xlong,g, &
	900	grid%aerwrf,config_flags, &
	901	grid%alt,grid%t_1,grid%p,convfac,grid%ttday,grid%tcosz, &
	902	grid%julday,grid%gmt,&
	903	grid%gd_cloud, grid%gd_cloud2,grid%raincv_a,grid%raincv_b, &
	904	grid%gd_cloud_a, grid%gd_cloud2_a, &
	905	grid%gd_cloud_b, grid%gd_cloud2_b, &
	906	grid%tauaer1,grid%tauaer2,grid%tauaer3,grid%tauaer4, &
	907	grid%gaer1,grid%gaer2,grid%gaer3,grid%gaer4, &
	908	grid%waer1,grid%waer2,grid%waer3,grid%waer4, &
	909	grid%l2aer,grid%l3aer,grid%l4aer,grid%l5aer,grid%l6aer,grid%l7aer, &
	910	grid%pm2_5_dry,grid%pm2_5_water,grid%pm2_5_dry_ec, &
	911	grid%chem_in_opt,grid%kemit, &
	912	ids , ide , jds , jde , kds , kde , &
	913	ims , ime , jms , jme , kms , kme , &
	914	its , ite , jts , jte , kts , kte )
	915
	916	!
	917	! calculate initial pm
	918	!
	919	! print *,'calculating initial pm'
	920	select case (config_flags%chem_opt)
	921	case (GOCART_SIMPLE,GOCARTRACM_KPP)
	922	call sum_pm_gocart ( &
	923	grid%alt, chem, grid%pm2_5_dry, grid%pm2_5_dry_ec,grid%pm10,&
	924	ids,ide, jds,jde, kds,kde, &
	925	ims,ime, jms,jme, kms,kme, &
	926	its,ite, jts,jte, kts,kte-1 )
	927	case (RADM2SORG, RACMSORG)
	928	call sum_pm_sorgam ( &
	929	grid%alt, chem, grid%h2oaj, grid%h2oai, &
	930	grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10, &
	931	ids,ide, jds,jde, kds,kde, &
	932	ims,ime, jms,jme, kms,kme, &
	933	its,ite, jts,jte, kts,kte-1 )
	934
	935	case (CBMZ_MOSAIC_4BIN,CBMZ_MOSAIC_8BIN,CBMZ_MOSAIC_4BIN_AQ,CBMZ_MOSAIC_8BIN_AQ)
	936	call sum_pm_mosaic ( &
	937	grid%alt, chem, &
	938	grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10, &
	939	ids,ide, jds,jde, kds,kde, &
	940	ims,ime, jms,jme, kms,kme, &
	941	its,ite, jts,jte, kts,kte-1 )
	942
	943	case default
	944	do j=jts,min(jte,jde-1)
	945	do k=kts,min(kte,kde-1)
	946	do i=its,min(ite,ide-1)
	947	grid%pm2_5_dry(i,k,j) = 0.
	948	grid%pm2_5_water(i,k,j) = 0.
	949	grid%pm2_5_dry_ec(i,k,j) = 0.
	950	grid%pm10(i,k,j) = 0.
	951	enddo
	952	enddo
	953	enddo
	954	end select
	955	#endif
	956
	957	IF (num_chem >= PARAM_FIRST_SCALAR ) THEN
	958	! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
	959
	960	loop_3d_c : DO loop = PARAM_FIRST_SCALAR , num_chem
	961	CALL set_physical_bc3d( chem(:,:,:,loop) , 'r' , config_flags , &
	962	ids , ide , jds , jde , kds , kde , &
	963	ims , ime , jms , jme , kms , kme , &
	964	its , ite , jts , jte , kts , kte , &
	965	its , ite , jts , jte , kts , kte )
	966	END DO loop_3d_c
	967
	968	ENDIF
	969
	970	CALL set_physical_bc2d( grid%msftx , 'r' , config_flags , &
	971	ids , ide , jds , jde , &
	972	ims , ime , jms , jme , &
	973	its , ite , jts , jte , &
	974	its , ite , jts , jte )
	975	CALL set_physical_bc2d( grid%msfty , 'r' , config_flags , &
	976	ids , ide , jds , jde , &
	977	ims , ime , jms , jme , &
	978	its , ite , jts , jte , &
	979	its , ite , jts , jte )
	980	CALL set_physical_bc2d( grid%msfux , 'x' , config_flags , &
	981	ids , ide , jds , jde , &
	982	ims , ime , jms , jme , &
	983	its , ite , jts , jte , &
	984	its , ite , jts , jte )
	985	CALL set_physical_bc2d( grid%msfuy , 'x' , config_flags , &
	986	ids , ide , jds , jde , &
	987	ims , ime , jms , jme , &
	988	its , ite , jts , jte , &
	989	its , ite , jts , jte )
	990	CALL set_physical_bc2d( grid%msfvx , 'y' , config_flags , &
	991	ids , ide , jds , jde , &
	992	ims , ime , jms , jme , &
	993	its , ite , jts , jte , &
	994	its , ite , jts , jte )
	995	CALL set_physical_bc2d( grid%msfvy , 'y' , config_flags , &
	996	ids , ide , jds , jde , &
	997	ims , ime , jms , jme , &
	998	its , ite , jts , jte , &
	999	its , ite , jts , jte )
	1000	CALL set_physical_bc2d( grid%sina , 'r' , config_flags , &
	1001	ids , ide , jds , jde , &
	1002	ims , ime , jms , jme , &
	1003	its , ite , jts , jte , &
	1004	its , ite , jts , jte )
	1005	CALL set_physical_bc2d( grid%cosa , 'r' , config_flags , &
	1006	ids , ide , jds , jde , &
	1007	ims , ime , jms , jme , &
	1008	its , ite , jts , jte , &
	1009	its , ite , jts , jte )
	1010	CALL set_physical_bc2d( grid%e , 'r' , config_flags , &
	1011	ids , ide , jds , jde , &
	1012	ims , ime , jms , jme , &
	1013	its , ite , jts , jte , &
	1014	its , ite , jts , jte )
	1015	CALL set_physical_bc2d( grid%f , 'r' , config_flags , &
	1016	ids , ide , jds , jde , &
	1017	ims , ime , jms , jme , &
	1018	its , ite , jts , jte , &
	1019	its , ite , jts , jte )
	1020
	1021	#ifndef WRF_CHEM
	1022	DEALLOCATE(CLDFRA_OLD)
	1023	#endif
	1024	#ifdef DM_PARALLEL
	1025	# include "HALO_EM_INIT_1.inc"
	1026	# include "HALO_EM_INIT_2.inc"
	1027	# include "HALO_EM_INIT_3.inc"
	1028	# include "HALO_EM_INIT_4.inc"
	1029	# include "HALO_EM_INIT_5.inc"
	1030	# include "PERIOD_BDY_EM_INIT.inc"
	1031	# include "PERIOD_BDY_EM_MOIST.inc"
	1032	# include "PERIOD_BDY_EM_CHEM.inc"
	1033	#endif
	1034
	1035	CALL wrf_debug ( 100 , 'start_domain_em: Returning' )
	1036
	1037	RETURN
	1038
	1039	END SUBROUTINE start_domain_em
	1040

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

Download in other formats:

Original Format