Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

start_domain_nmm.F @ 3026

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

Rev	Line
[2759]	1	!#define NO_RESTRICT_ACCEL
	2	!#define NO_GFDLETAINIT
	3	!#define NO_UPSTREAM_ADVECTION
	4	!----------------------------------------------------------------------
	5	!
	6	SUBROUTINE START_DOMAIN_NMM(GRID, allowed_to_read &
	7	!
	8	#include <dummy_args.inc>
	9	!
	10	& )
	11	!----------------------------------------------------------------------
	12	!
	13	USE MODULE_DOMAIN
	14	USE MODULE_DRIVER_CONSTANTS
	15	USE module_model_constants
	16	USE MODULE_CONFIGURE
	17	USE MODULE_WRF_ERROR
	18	USE MODULE_MPP
	19	USE MODULE_CTLBLK
	20	USE MODULE_DM
	21	!
	22	USE MODULE_IGWAVE_ADJUST,ONLY: PDTE, PFDHT, DDAMP
	23	USE MODULE_ADVECTION, ONLY: ADVE, VAD2, HAD2
	24	USE MODULE_NONHY_DYNAM, ONLY: VADZ, HADZ
	25	USE MODULE_DIFFUSION_NMM,ONLY: HDIFF
	26	USE MODULE_BNDRY_COND, ONLY: BOCOH, BOCOV
	27	USE MODULE_PHYSICS_INIT
	28	! USE MODULE_RA_GFDLETA
	29	!
	30	USE MODULE_EXT_INTERNAL
	31	!
	32	#ifdef WRF_CHEM
	33	USE MODULE_AEROSOLS_SORGAM, ONLY: SUM_PM_SORGAM
	34	USE MODULE_MOSAIC_DRIVER, ONLY: SUM_PM_MOSAIC
	35	#endif
	36	!
	37	!----------------------------------------------------------------------
	38	!
	39	IMPLICIT NONE
	40	!
	41	!----------------------------------------------------------------------
	42	!***
	43	!*** Arguments
	44	!***
	45	TYPE(DOMAIN),INTENT(INOUT) :: GRID
	46	LOGICAL , INTENT(IN) :: allowed_to_read
	47	!
	48	#include <dummy_decl.inc>
	49	!
	50	TYPE(GRID_CONFIG_REC_TYPE) :: CONFIG_FLAGS
	51	!
	52	#ifdef WRF_CHEM
	53	REAL RGASUNIV ! universal gas constant [ J/mol-K ]
	54	PARAMETER ( RGASUNIV = 8.314510 )
	55	#endif
	56	!
	57	!***
	58	!*** LOCAL DATA
	59	!***
	60	INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE &
	61	& ,IMS,IME,JMS,JME,KMS,KME &
	62	& ,IPS,IPE,JPS,JPE,KPS,KPE
	63	!
	64	INTEGER :: ERROR,LOOP
	65
	66	REAL,ALLOCATABLE,DIMENSION(:) :: PHALF
	67	!
	68	REAL :: EPSB=0.1,EPSIN=9.8
	69	!
	70	INTEGER :: JHL=7
	71	!
	72	INTEGER :: I,IEND,IER,IFE,IFS,IHH,IHL,IHRSTB,II,IRTN &
	73	& ,ISIZ1,ISIZ2,ISTART,ISTAT,IX,J,J00,JFE,JFS,JHH,JJ &
	74	& ,JM1,JM2,JM3,JP1,JP2,JP3,JX,KK &
	75	& ,K,K400,KBI,KBI2,KCCO2,KNT,KNTI &
	76	& ,LB,LRECBC,L &
	77	& ,N,NMAP,NRADLH,NRADSH,NREC,NS,RECL,STAT &
	78	& ,STEPBL,STEPCU,STEPRA
	79	!
	80	INTEGER :: MY_E,MY_N,MY_S,MY_W &
	81	& ,MY_NE,MY_NW,MY_SE,MY_SW,MYI,MYJ,NPE
	82	!
	83	INTEGER :: I_M
	84	!
	85	INTEGER :: ILPAD2,IRPAD2,JBPAD2,JTPAD2
	86	INTEGER :: ITS,ITE,JTS,JTE,KTS,KTE
	87	!
	88	INTEGER,DIMENSION(3) :: LPTOP
	89	!
	90	REAL :: ADDL,APELM,APELMNW,APEM1,CAPA,CLOGES,DPLM,DZLM,EPS,ESE &
	91	& ,FAC1,FAC2,PDIF,PLM,PM1,PSFCK,PSS,PSUM,QLM,RANG &
	92	& ,SLPM,TERM1,THLM,TIME,TLM,TSFCK,ULM,VLM
	93	!
	94	!!! REAL :: BLDT,CWML,EXNSFC,G_INV,PLYR,PSFC,ROG,SFCZ,THSIJ,TL
	95	REAL :: CWML,EXNSFC,G_INV,PLYR,PSURF,ROG,SFCZ,THSIJ,TL
	96	REAL :: TEND
	97
	98	!
	99	!!! REAL,ALLOCATABLE,DIMENSION(:,:) :: RAINBL,RAINNC,RAINNC &
	100	INTEGER,ALLOCATABLE,DIMENSION(:,:) :: ITEMP,LOWLYR
	101	REAL,ALLOCATABLE,DIMENSION(:) :: SFULL,SMID
	102	REAL,ALLOCATABLE,DIMENSION(:) :: DZS,ZS
	103	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: RQCBLTEN,RQIBLTEN &
	104	& ,RQVBLTEN,RTHBLTEN &
	105	& ,RUBLTEN,RVBLTEN &
	106	& ,RQCCUTEN,RQICUTEN,RQRCUTEN &
	107	& ,RQSCUTEN,RQVCUTEN,RTHCUTEN &
	108	& ,RTHRATEN &
	109	& ,RTHRATENLW,RTHRATENSW
	110	REAL,ALLOCATABLE,DIMENSION(:,:) :: EMISS,EMTEMP,GLW,HFX &
	111	& ,NCA &
	112	& ,QFX,RAINBL,RAINC,RAINNC &
	113	& ,RAINNCV &
	114	& ,SNOWC,THC,TMN,TSFC
	115
	116	REAL,ALLOCATABLE,DIMENSION(:,:) :: Z0_DUM, ALBEDO_DUM
	117	!
	118	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINT,RRI,CONVFAC,ZMID
	119	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: T_TRANS,PINT_TRANS
	120	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CLDFRA_TRANS
	121	#ifndef WRF_CHEM
	122	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CLDFRA_OLD
	123	#endif
	124	#if 0
	125	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: W0AVG
	126	#endif
	127	LOGICAL :: E_BDY,N_BDY,S_BDY,W_BDY,WARM_RAIN,ADV_MOIST_COND
	128	LOGICAL :: START_OF_SIMULATION
	129	integer :: jam,retval
	130	character(20) :: seeout="hi08.t00z.nhbmeso"
	131	real :: dummyx(791)
	132	integer myproc
	133	real :: dsig,dsigsum,pdbot,pdtot,rpdtot
	134	real :: fisx,ht,prodx,rg
	135	integer :: i_t=096,j_t=195,n_t=11
	136	integer :: i_u=49,j_u=475,n_u=07
	137	integer :: i_v=49,j_v=475,n_v=07
	138	integer :: num_ozmixm, num_aerosolc
	139	!Rogers GMT
	140	INTEGER :: hr, mn, sec, ms, rc
	141	TYPE(WRFU_Time) :: currentTime
	142
	143	! z0base new
	144
	145	REAL,DIMENSION(0:30) :: VZ0TBL_24
	146	VZ0TBL_24= (/0., &
	147	& 1.00, 0.07, 0.07, 0.07, 0.07, 0.15, &
	148	& 0.08, 0.03, 0.05, 0.86, 0.80, 0.85, &
	149	& 2.65, 1.09, 0.80, 0.001, 0.04, 0.05, &
	150	& 0.01, 0.04, 0.06, 0.05, 0.03, 0.001, &
	151	& 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
	152
	153	! end z0base new
	154	!
	155	!----------------------------------------------------------------------
	156	#define COPY_IN
	157	#include <scalar_derefs.inc>
	158	!----------------------------------------------------------------------
	159	!**********************************************************************
	160	!----------------------------------------------------------------------
	161	!
	162	CALL GET_IJK_FROM_GRID(GRID, &
	163	& IDS,IDE,JDS,JDE,KDS,KDE, &
	164	& IMS,IME,JMS,JME,KMS,KME, &
	165	& IPS,IPE,JPS,JPE,KPS,KPE)
	166	!
	167	ITS=IPS
	168	ITE=IPE
	169	JTS=JPS
	170	JTE=JPE
	171	KTS=KPS
	172	KTE=KPE
	173
	174	CALL model_to_grid_config_rec(grid%id,model_config_rec &
	175	& ,config_flags)
	176	!
	177	RESTRT=config_flags%restart
	178	! write(0,*) 'set RESTRT to: ', RESTRT
	179
	180	#if 1
	181	IF(IME>NMM_MAX_DIM )THEN
	182	WRITE(wrf_err_message,*) &
	183	'start_domain_nmm ime (',ime,') > ',NMM_MAX_DIM, &
	184	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
	185	CALL WRF_ERROR_FATAL(wrf_err_message)
	186	ENDIF
	187	!
	188	IF(JME>NMM_MAX_DIM )THEN
	189	WRITE(wrf_err_message,*) &
	190	'start_domain_nmm jme (',jme,') > ',NMM_MAX_DIM, &
	191	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
	192	CALL WRF_ERROR_FATAL(wrf_err_message)
	193	ENDIF
	194	#else
	195	IF(IMS>-2.OR.IME>NMM_MAX_DIM )THEN
	196	WRITE(wrf_err_message,*) &
	197	'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, &
	198	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
	199	CALL WRF_ERROR_FATAL(wrf_err_message)
	200	ENDIF
	201	!
	202	IF(JMS>-2.OR.JME>NMM_MAX_DIM )THEN
	203	WRITE(wrf_err_message,*) &
	204	'start_domain_nmm jms(',jms,' > -2 or jme (',jme,') > ',NMM_MAX_DIM, &
	205	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
	206	CALL WRF_ERROR_FATAL(wrf_err_message)
	207	ENDIF
	208	#endif
	209	!
	210	!----------------------------------------------------------------------
	211	!
	212	WRITE(0,196)IHRST,IDAT
	213	WRITE(LIST,196)IHRST,IDAT
	214	196 FORMAT(' FORECAST BEGINS ',I2,' GMT ',2(I2,'/'),I4)
	215	!!!!!!tlb
	216	!!!! For now, set NPES to 1
	217	NPES=1
	218	!!!!!!tlb
	219	MY_IS_GLB=IPS
	220	MY_IE_GLB=IPE-1
	221	MY_JS_GLB=JPS
	222	MY_JE_GLB=JPE-1
	223	!
	224	IM=IPE-1
	225	JM=JPE-1
	226	!!!!!!!!!
	227	!! All "my" variables defined below have had the IDE or JDE specification
	228	!! reduced by 1
	229	!!!!!!!!!!!
	230
	231	MYIS=MAX(IDS,IPS)
	232	MYIE=MIN(IDE-1,IPE)
	233	MYJS=MAX(JDS,JPS)
	234	MYJE=MIN(JDE-1,JPE)
	235
	236	MYIS1 =MAX(IDS+1,IPS)
	237	MYIE1 =MIN(IDE-2,IPE)
	238	MYJS2 =MAX(JDS+2,JPS)
	239	MYJE2 =MIN(JDE-3,JPE)
	240	!
	241	MYIS_P1=MAX(IDS,IPS-1)
	242	MYIE_P1=MIN(IDE-1,IPE+1)
	243	MYIS_P2=MAX(IDS,IPS-2)
	244	MYIE_P2=MIN(IDE-1,IPE+2)
	245	MYIS_P3=MAX(IDS,IPS-3)
	246	MYIE_P3=MIN(IDE-1,IPE+3)
	247	MYJS_P3=MAX(JDS,JPS-3)
	248	MYJE_P3=MIN(JDE-1,JPE+3)
	249	MYIS_P4=MAX(IDS,IPS-4)
	250	MYIE_P4=MIN(IDE-1,IPE+4)
	251	MYJS_P4=MAX(JDS,JPS-4)
	252	MYJE_P4=MIN(JDE-1,JPE+4)
	253	MYIS_P5=MAX(IDS,IPS-5)
	254	MYIE_P5=MIN(IDE-1,IPE+5)
	255	MYJS_P5=MAX(JDS,JPS-5)
	256	MYJE_P5=MIN(JDE-1,JPE+5)
	257	!
	258	MYIS1_P1=MAX(IDS+1,IPS-1)
	259	MYIE1_P1=MIN(IDE-2,IPE+1)
	260	MYIS1_P2=MAX(IDS+1,IPS-2)
	261	MYIE1_P2=MIN(IDE-2,IPE+2)
	262	!
	263	MYJS1_P1=MAX(JDS+1,JPS-1)
	264	MYJS2_P1=MAX(JDS+2,JPS-1)
	265	MYJE1_P1=MIN(JDE-2,JPE+1)
	266	MYJE2_P1=MIN(JDE-3,JPE+1)
	267	MYJS1_P2=MAX(JDS+1,JPS-2)
	268	MYJE1_P2=MIN(JDE-2,JPE+2)
	269	MYJS2_P2=MAX(JDS+2,JPS-2)
	270	MYJE2_P2=MIN(JDE-3,JPE+2)
	271	MYJS1_P3=MAX(JDS+1,JPS-3)
	272	MYJE1_P3=MIN(JDE-2,JPE+3)
	273	MYJS2_P3=MAX(JDS+2,JPS-3)
	274	MYJE2_P3=MIN(JDE-3,JPE+3)
	275	!!!!!!!!!!!
	276	!
	277	#ifdef DM_PARALLEL
	278
	279	CALL WRF_GET_MYPROC(MYPROC)
	280	MYPE=MYPROC
	281
	282	!
	283	!----------------------------------------------------------------------
	284	!*** Let each task determine who its eight neighbors are because we
	285	!*** will need to know that for the halo exchanges. The direction
	286	!*** to each neighbor will be designated by the following integers:
	287	!
	288	!*** north: 1
	289	!*** east: 2
	290	!*** south: 3
	291	!*** west: 4
	292	!*** northeast: 5
	293	!*** southeast: 6
	294	!*** southwest: 7
	295	!*** northwest: 8
	296	!
	297	!*** If a task has no neighbor in a particular direction because of
	298	!*** the presence of the global domain boundary then that element
	299	!*** of my_neb is set to -1.
	300	!-----------------------------------------------------------------------
	301	!
	302	call wrf_get_nprocx(inpes)
	303	call wrf_get_nprocy(jnpes)
	304	!
	305	allocate(itemp(inpes,jnpes),stat=istat)
	306	npe=0
	307	!
	308	do j=1,jnpes
	309	do i=1,inpes
	310	itemp(i,j)=npe
	311	if(npe==mype)then
	312	myi=i
	313	myj=j
	314	endif
	315	npe=npe+1
	316	enddo
	317	enddo
	318	!
	319	my_n=-1
	320	if(myj+1<=jnpes)my_n=itemp(myi,myj+1)
	321	!
	322	my_e=-1
	323	if(myi+1<=inpes)my_e=itemp(myi+1,myj)
	324	!
	325	my_s=-1
	326	if(myj-1>=1)my_s=itemp(myi,myj-1)
	327	!
	328	my_w=-1
	329	if(myi-1>=1)my_w=itemp(myi-1,myj)
	330	!
	331	my_ne=-1
	332	if((myi+1<=inpes).and.(myj+1<=jnpes)) &
	333	my_ne=itemp(myi+1,myj+1)
	334	!
	335	my_se=-1
	336	if((myi+1<=inpes).and.(myj-1>=1)) &
	337	my_se=itemp(myi+1,myj-1)
	338	!
	339	my_sw=-1
	340	if((myi-1>=1).and.(myj-1>=1)) &
	341	my_sw=itemp(myi-1,myj-1)
	342	!
	343	my_nw=-1
	344	if((myi-1>=1).and.(myj+1<=jnpes)) &
	345	my_nw=itemp(myi-1,myj+1)
	346	!
	347	! my_neb(1)=my_n
	348	! my_neb(2)=my_e
	349	! my_neb(3)=my_s
	350	! my_neb(4)=my_w
	351	! my_neb(5)=my_ne
	352	! my_neb(6)=my_se
	353	! my_neb(7)=my_sw
	354	! my_neb(8)=my_nw
	355	!
	356	deallocate(itemp)
	357	# include <HALO_NMM_INIT_1.inc>
	358	# include <HALO_NMM_INIT_2.inc>
	359	# include <HALO_NMM_INIT_3.inc>
	360	# include <HALO_NMM_INIT_4.inc>
	361	# include <HALO_NMM_INIT_5.inc>
	362	# include <HALO_NMM_INIT_6.inc>
	363	# include <HALO_NMM_INIT_7.inc>
	364	# include <HALO_NMM_INIT_8.inc>
	365	# include <HALO_NMM_INIT_9.inc>
	366	# include <HALO_NMM_INIT_10.inc>
	367	# include <HALO_NMM_INIT_11.inc>
	368	# include <HALO_NMM_INIT_12.inc>
	369	# include <HALO_NMM_INIT_13.inc>
	370	# include <HALO_NMM_INIT_14.inc>
	371	# include <HALO_NMM_INIT_15.inc>
	372	# include <HALO_NMM_INIT_16.inc>
	373	# include <HALO_NMM_INIT_17.inc>
	374	# include <HALO_NMM_INIT_18.inc>
	375	# include <HALO_NMM_INIT_19.inc>
	376	# include <HALO_NMM_INIT_20.inc>
	377	# include <HALO_NMM_INIT_21.inc>
	378	# include <HALO_NMM_INIT_22.inc>
	379	# include <HALO_NMM_INIT_23.inc>
	380	# include <HALO_NMM_INIT_24.inc>
	381	# include <HALO_NMM_INIT_25.inc>
	382	# include <HALO_NMM_INIT_26.inc>
	383	# include <HALO_NMM_INIT_27.inc>
	384	# include <HALO_NMM_INIT_28.inc>
	385	# include <HALO_NMM_INIT_29.inc>
	386	# include <HALO_NMM_INIT_30.inc>
	387	# include <HALO_NMM_INIT_31.inc>
	388	# include <HALO_NMM_INIT_32.inc>
	389	# include <HALO_NMM_INIT_33.inc>
	390	# include <HALO_NMM_INIT_34.inc>
	391	# include <HALO_NMM_INIT_35.inc>
	392	# include <HALO_NMM_INIT_36.inc>
	393	# include <HALO_NMM_INIT_37.inc>
	394	# include <HALO_NMM_INIT_38.inc>
	395	# include <HALO_NMM_INIT_39.inc>
	396	#endif
	397	!
	398	DO J=MYJS_P4,MYJE_P4
	399	IHEG(J)=MOD(J+1,2)
	400	IHWG(J)=IHEG(J)-1
	401	IVEG(J)=MOD(J,2)
	402	IVWG(J)=IVEG(J)-1
	403	ENDDO
	404	!
	405	DO J=MYJS_P4,MYJE_P4
	406	IVW(J)=IVWG(J)
	407	IVE(J)=IVEG(J)
	408	IHE(J)=IHEG(J)
	409	IHW(J)=IHWG(J)
	410	ENDDO
	411	!
	412	CAPA=R_D/CP
	413	LM=KPE-KPS+1
	414	!
	415	IFS=IPS
	416	JFS=JPS
	417	JFE=MIN(JPE,JDE-1)
	418	IFE=MIN(IPE,IDE-1)
	419	!
	420	IF(.NOT.RESTRT)THEN
	421	DO J=JFS,JFE
	422	DO I=IFS,IFE
	423	PDSL(I,J) =PD(I,J)*RES(I,J)
	424	PREC(I,J) =0.
	425	ACPREC(I,J)=0.
	426	CUPREC(I,J)=0.
	427	rg=1./g
	428	ht=fis(i,j)*rg
	429	!!! fisx=ht*g
	430	! fisx=max(fis(i,j),0.)
	431	! prodx=Z0(I,J)*Z0MAX
	432	! Z0(I,J) =SM(I,J)Z0SEA+(1.-SM(I,J)) &
	433	! & (Z0(I,J)Z0MAX+FISx FCM+Z0LAND)
	434	!!! & (prodx +FISx *FCM+Z0LAND)
	435	QSH(I,J) =0.
	436	AKMS(I,J) =0.
	437	AKHS(I,J) =0.
	438	TWBS(I,J) =0.
	439	QWBS(I,J) =0.
	440	CLDEFI(I,J)=1.
	441	HTOP(I,J) =REAL(KTS)
	442	HTOPD(I,J) =REAL(KTS)
	443	HTOPS(I,J) =REAL(KTS)
	444	HBOT(I,J) =REAL(KTE)
	445	HBOTD(I,J) =REAL(KTE)
	446	HBOTS(I,J) =REAL(KTE)
	447	!***
	448	!*** AT THIS POINT, WE MUST CALCULATE THE INITIAL POTENTIAL TEMPERATURE
	449	!*** OF THE SURFACE AND OF THE SUBGROUND.
	450	!*** EXTRAPOLATE DOWN FOR INITIAL SURFACE POTENTIAL TEMPERATURE.
	451	!*** ALSO DO THE SHELTER PRESSURE.
	452	!***
	453	PM1=AETA1(KTS)PDTOP+AETA2(KTS)PDSL(I,J)+PT
	454	APEM1=(1.E5/PM1)**CAPA
	455
	456	IF(NMM_TSK(I,J)>=200.)THEN ! have a specific skin temp, use it
	457	THS(I,J)=NMM_TSK(I,J)*APEM1
	458	TSFCK=NMM_TSK(I,J)
	459	ELSE ! use lowest layer as a proxy
	460	THS(I,J)=T(I,J,KTS)*APEM1
	461	TSFCK=T(I,J,KTS)
	462	ENDIF
	463
	464	! if (I .eq. IFE/2 .and. J .eq. JFE/2) then
	465	! write(6,*) 'I,J,T(I,KOFF+1,J),NMM_TSK(I,J):: ', I,J,T(I,KOFF+1,J),NMM_TSK(I,J)
	466	! write(6,*) 'THS(I,J): ', THS(I,J)
	467	! endif
	468
	469	PSFCK=PD(I,J)+PDTOP+PT
	470	!
	471	IF(SM(I,J)<0.5) THEN
	472	QSH(I,J)=PQ0/PSFCKEXP(A2(TSFCK-A3)/(TSFCK-A4))
	473	ELSEIF(SM(I,J)>0.5) THEN
	474	THS(I,J)=SST(I,J)(1.E5/(PD(I,J)+PDTOP+PT))*CAPA
	475	ENDIF
	476	!
	477	TERM1=-0.068283/T(I,J,KTS)
	478	PSHLTR(I,J)=(PD(I,J)+PDTOP+PT)*EXP(TERM1)
	479	!
	480	USTAR(I,J)=0.1
	481	THZ0(I,J)=THS(I,J)
	482	QZ0(I,J)=QSH(I,J)
	483	UZ0(I,J)=0.
	484	VZ0(I,J)=0.
	485	!
	486	ENDDO
	487	ENDDO
	488
	489	!***
	490	!*** INITIALIZE CLOUD FIELDS
	491	!***
	492	IF (MAXVAL(CWM) .gt. 0. .and. MAXVAL(CWM) .lt. 1.) then
	493	write(0,*) 'appear to have CWM values...do not zero'
	494	ELSE
	495	write(0,*) 'zeroing CWM'
	496	DO K=KPS,KPE
	497	DO J=JFS,JFE
	498	DO I=IFS,IFE
	499	CWM(I,J,K)=0.
	500	ENDDO
	501	ENDDO
	502	ENDDO
	503	ENDIF
	504	!***
	505	!*** INITIALIZE ACCUMULATOR ARRAYS TO ZERO.
	506	!***
	507	ARDSW=0.0
	508	ARDLW=0.0
	509	ASRFC=0.0
	510	AVRAIN=0.0
	511	AVCNVC=0.0
	512	!
	513	DO J=JFS,JFE
	514	DO I=IFS,IFE
	515	ACFRCV(I,J)=0.
	516	NCFRCV(I,J)=0
	517	ACFRST(I,J)=0.
	518	NCFRST(I,J)=0
	519	ACSNOW(I,J)=0.
	520	ACSNOM(I,J)=0.
	521	SSROFF(I,J)=0.
	522	BGROFF(I,J)=0.
	523	ALWIN(I,J) =0.
	524	ALWOUT(I,J)=0.
	525	ALWTOA(I,J)=0.
	526	ASWIN(I,J) =0.
	527	ASWOUT(I,J)=0.
	528	ASWTOA(I,J)=0.
	529	SFCSHX(I,J)=0.
	530	SFCLHX(I,J)=0.
	531	SUBSHX(I,J)=0.
	532	SNOPCX(I,J)=0.
	533	SFCUVX(I,J)=0.
	534	SFCEVP(I,J)=0.
	535	POTEVP(I,J)=0.
	536	POTFLX(I,J)=0.
	537	ENDDO
	538	ENDDO
	539	!***
	540	!*** INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER.
	541	!***
	542	EPS=R_D/R_V
	543	!
	544	DO J=JFS,JFE
	545	DO I=IFS,IFE
	546	IF(SM(I,J)>0.5)THEN
	547	CLOGES =-CM1/SST(I,J)-CM2*ALOG10(SST(I,J))+CM3
	548	ESE = 10.**(CLOGES+2.)
	549	QSH(I,J)= SM(I,J)EPSESE/(PD(I,J)+PDTOP+PT-ESE*(1.-EPS))
	550	ENDIF
	551	ENDDO
	552	ENDDO
	553	!***
	554	!*** INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL
	555	!*** VALUE (EPSQ2) ABOVE GROUND. SET TKE TO ZERO IN THE
	556	!*** THE LOWEST MODEL LAYER. IN THE LOWEST TWO ATMOSPHERIC
	557	!*** ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI).
	558	!***
	559	!***EROGERS: add check for realistic values of q2
	560	!
	561	IF (MAXVAL(Q2) .gt. epsq2 .and. MAXVAL(Q2) .lt. 200.) then
	562	write(0,*) 'appear to have Q2 values...do not zero'
	563	ELSE
	564	write(0,*) 'zeroing Q2'
	565	DO K=KPS,KPE-1
	566	DO J=JFS,JFE
	567	DO I=IFS,IFE
	568	Q2(I,J,K)=HBM2(I,J)*EPSQ2
	569	ENDDO
	570	ENDDO
	571	ENDDO
	572	!
	573	DO J=JFS,JFE
	574	DO I=IFS,IFE
	575	Q2(I,J,LM) = 0.
	576	Q2(I,J,KTE-2)= HBM2(I,J)*Q2INI
	577	Q2(I,J,KTE-1)= HBM2(I,J)*Q2INI
	578	ENDDO
	579	ENDDO
	580	ENDIF
	581	!***
	582	!*** PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL.
	583	!*** INITIALIZE LATENT HEATING ACCUMULATION ARRAYS.
	584	!***
	585	DO K=KPS,KPE
	586	DO J=JFS,JFE
	587	DO I=IFS,IFE
	588	IF(Q(I,J,K)<EPSQ)Q(I,J,K)=EPSQ
	589	TRAIN(I,J,K)=0.
	590	TCUCN(I,J,K)=0.
	591	ENDDO
	592	ENDDO
	593	ENDDO
	594	!
	595	!***
	596	!*** INITIALIZE MAX/MIN TEMPERATURES.
	597	!***
	598	DO J=JFS,JFE
	599	DO I=IFS,IFE
	600	TLMAX(I,J)=T(I,J,KPS)
	601	TLMIN(I,J)=T(I,J,KPS)
	602	ENDDO
	603	ENDDO
	604	!
	605	!----------------------------------------------------------------------
	606	!*** END OF SCRATCH START INITIALIZATION BLOCK.
	607	!----------------------------------------------------------------------
	608	!
	609	CALL wrf_message('INIT: INITIALIZED ARRAYS FOR CLEAN START')
	610	ENDIF ! <--- (not restart)
	611
	612	IF(NEST)THEN
	613	DO J=JFS,JFE
	614	DO I=IFS,IFE
	615	!
	616	IF(T(I,J,KTS)==0.)THEN
	617	T(I,J,KTS)=T(I,J,KTS+1)
	618	ENDIF
	619	!
	620	TERM1=-0.068283/T(I,J,KTS)
	621	PSHLTR(I,J)=(PD(I,J)+PDTOP+PT)*EXP(TERM1)
	622	ENDDO
	623	ENDDO
	624	ENDIF
	625	!
	626	!----------------------------------------------------------------------
	627	!*** RESTART INITIALIZING. CHECK TO SEE IF WE NEED TO ZERO
	628	!*** ACCUMULATION ARRAYS.
	629	!----------------------------------------------------------------------
	630
	631	TSPH=3600./GRID%DT ! needed?
	632	NPHS0=GRID%NPHS
	633
	634	IF(MYPE==0)THEN
	635	write(0,*)' start_nmm TSTART=',grid%tstart
	636	write(0,*)' start_nmm TPREC=',grid%tprec
	637	write(0,*)' start_nmm THEAT=',grid%theat
	638	write(0,*)' start_nmm TCLOD=',grid%tclod
	639	write(0,*)' start_nmm TRDSW=',grid%trdsw
	640	write(0,*)' start_nmm TRDLW=',grid%trdlw
	641	write(0,*)' start_nmm TSRFC=',grid%tsrfc
	642	write(0,*)' start_nmm PCPFLG=',grid%pcpflg
	643	ENDIF
	644
	645	NSTART = INT(grid%TSTART*TSPH+0.5)
	646	!
	647	NTSD = NSTART
	648
	649
	650	!! want non-zero values for NPREC, NHEAT type vars to avoid problems
	651	!! with mod statements below.
	652
	653	NPREC = INT(grid%TPREC *TSPH+0.5)
	654	NHEAT = INT(grid%THEAT *TSPH+0.5)
	655	NCLOD = INT(grid%TCLOD *TSPH+0.5)
	656	NRDSW = INT(grid%TRDSW *TSPH+0.5)
	657	NRDLW = INT(grid%TRDLW *TSPH+0.5)
	658	NSRFC = INT(grid%TSRFC *TSPH+0.5)
	659	!
	660	!----------------------------------------------------------------------
	661	!
	662	!*** FLAG FOR INITIALIZING ARRAYS, LOOKUP TABLES, & CONSTANTS USED IN
	663	!*** MICROPHYSICS AND RADIATION
	664	!
	665	!----------------------------------------------------------------------
	666	!
	667	MICRO_START=.TRUE.
	668	!
	669	!----------------------------------------------------------------------
	670	!***
	671	!*** INITIALIZE ADVECTION TENDENCIES TO ZERO SO THAT
	672	!*** BOUNDARY POINTS WILL ALWAYS BE ZERO
	673	!***
	674	DO J=JFS,JFE
	675	DO I=IFS,IFE
	676	ADT(I,J)=0.
	677	ADU(I,J)=0.
	678	ADV(I,J)=0.
	679	ENDDO
	680	ENDDO
	681	!----------------------------------------------------------------------
	682	!***
	683	!*** SET INDEX ARRAYS FOR UPSTREAM ADVECTION
	684	!***
	685	!----------------------------------------------------------------------
	686	DO J=JFS,JFE
	687	N_IUP_H(J)=0
	688	N_IUP_V(J)=0
	689	N_IUP_ADH(J)=0
	690	N_IUP_ADV(J)=0
	691	!
	692	DO I=IFS,IFE
	693	IUP_H(I,J)=-999
	694	IUP_V(I,J)=-999
	695	IUP_ADH(I,J)=-999
	696	IUP_ADV(I,J)=-999
	697	ENDDO
	698	!
	699	ENDDO
	700
	701	#ifndef NO_UPSTREAM_ADVECTION
	702	!
	703	!*** N_IUP_H HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
	704	!*** FOR UPSTREAM ADVECTION (FULL ROWS IN THE 3RD THROUGH 7TH
	705	!*** ROWS FROM THE SOUTH AND NORTH GLOBAL BOUNDARIES AND
	706	!*** FOUR POINTS ADJACENT TO THE WEST AND EAST GLOBAL BOUNDARIES
	707	!*** ON ALL OTHER INTERNAL ROWS). SIMILARLY FOR N_IUP_V.
	708	!*** BECAUSE OF HORIZONTAL OPERATIONS, THESE POINTS EXTEND OUTSIDE
	709	!*** OF THE UPSTREAM REGION SOMEWHAT.
	710	!*** N_IUP_ADH HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
	711	!*** FOR THE COMPUTATION OF THE TENDENCIES THEMSELVES (ADT, ADQ2M
	712	!*** AND ADQ2L); SPECIFICALLY THESE TENDENCIES ARE ONLY DONE IN
	713	!*** THE UPSTREAM REGION.
	714	!*** N_IUP_ADV HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
	715	!*** FOR THE VELOCITY POINT TENDENCIES.
	716	!*** IUP_H AND IUP_V HOLD THE ACTUAL I VALUES USED IN EACH ROW.
	717	!*** LIKEWISE FOR IUP_ADH AND IUP_ADV.
	718	!*** ALSO, SET UPSTRM FOR THOSE TASKS AROUND THE GLOBAL EDGE.
	719	!
	720	UPSTRM=.FALSE.
	721	!
	722	S_BDY=(JPS==JDS)
	723	N_BDY=(JPE==JDE)
	724	W_BDY=(IPS==IDS)
	725	E_BDY=(IPE==IDE)
	726	!
	727	JTPAD2=2
	728	JBPAD2=2
	729	IRPAD2=2
	730	ILPAD2=2
	731	!
	732	IF(S_BDY)THEN
	733	UPSTRM=.TRUE.
	734	JBPAD2=0
	735	!
	736	DO JJ=1,7
	737	J=JJ ! -MY_JS_GLB+1
	738	KNTI=0
	739	DO I=MYIS_P2,MYIE_P2
	740	IUP_H(IMS+KNTI,J)=I
	741	IUP_V(IMS+KNTI,J)=I
	742	KNTI=KNTI+1
	743	ENDDO
	744	N_IUP_H(J)=KNTI
	745	N_IUP_V(J)=KNTI
	746	ENDDO
	747	!
	748	DO JJ=3,5
	749	J=JJ ! -MY_JS_GLB+1
	750	KNTI=0
	751	ISTART=MYIS1_P2
	752	IEND=MYIE1_P2
	753	IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
	754	DO I=ISTART,IEND
	755	IUP_ADH(IMS+KNTI,J)=I
	756	KNTI=KNTI+1
	757	ENDDO
	758	N_IUP_ADH(J)=KNTI
	759	!
	760	KNTI=0
	761	ISTART=MYIS1_P2
	762	IEND=MYIE1_P2
	763	IF(E_BDY)IEND=IEND-MOD(JJ,2)
	764	DO I=ISTART,IEND
	765	IUP_ADV(IMS+KNTI,J)=I
	766	KNTI=KNTI+1
	767	ENDDO
	768	N_IUP_ADV(J)=KNTI
	769	ENDDO
	770	ENDIF
	771	!
	772	IF(N_BDY)THEN
	773	UPSTRM=.TRUE.
	774	JTPAD2=0
	775	!
	776	DO JJ=JDE-7, JDE-1 ! JM-6,JM
	777	J=JJ ! -MY_JS_GLB+1
	778	KNTI=0
	779	DO I=MYIS_P2,MYIE_P2
	780	IUP_H(IMS+KNTI,J)=I
	781	IUP_V(IMS+KNTI,J)=I
	782	KNTI=KNTI+1
	783	ENDDO
	784	N_IUP_H(J)=KNTI
	785	N_IUP_V(J)=KNTI
	786	ENDDO
	787	!
	788	DO JJ=JDE-5, JDE-3 ! JM-4,JM-2
	789	J=JJ ! -MY_JS_GLB+1
	790	KNTI=0
	791	ISTART=MYIS1_P2
	792	IEND=MYIE1_P2
	793	IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
	794	DO I=ISTART,IEND
	795	IUP_ADH(IMS+KNTI,J)=I
	796	KNTI=KNTI+1
	797	ENDDO
	798	N_IUP_ADH(J)=KNTI
	799	!
	800	KNTI=0
	801	ISTART=MYIS1_P2
	802	IEND=MYIE1_P2
	803	IF(E_BDY)IEND=IEND-MOD(JJ,2)
	804	DO I=ISTART,IEND
	805	IUP_ADV(IMS+KNTI,J)=I
	806	KNTI=KNTI+1
	807	ENDDO
	808	N_IUP_ADV(J)=KNTI
	809	ENDDO
	810	ENDIF
	811	!
	812	IF(W_BDY)THEN
	813	UPSTRM=.TRUE.
	814	ILPAD2=0
	815	DO JJ=8,JDE-8 ! JM-7
	816	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	817	J=JJ ! -MY_JS_GLB+1
	818	!
	819	DO I=1,4
	820	IUP_H(IMS+I-1,J)=I
	821	IUP_V(IMS+I-1,J)=I
	822	ENDDO
	823	N_IUP_H(J)=4
	824	N_IUP_V(J)=4
	825	ENDIF
	826	ENDDO
	827	!
	828	DO JJ=6,JDE-6 ! JM-5
	829	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	830	J=JJ ! -MY_JS_GLB+1
	831	KNTI=0
	832	IEND=2+MOD(JJ,2)
	833	DO I=2,IEND
	834	IUP_ADH(IMS+KNTI,J)=I
	835	KNTI=KNTI+1
	836	ENDDO
	837	N_IUP_ADH(J)=KNTI
	838	!
	839	KNTI=0
	840	IEND=2+MOD(JJ+1,2)
	841	DO I=2,IEND
	842	IUP_ADV(IMS+KNTI,J)=I
	843	KNTI=KNTI+1
	844	ENDDO
	845	N_IUP_ADV(J)=KNTI
	846	!
	847	ENDIF
	848	ENDDO
	849	ENDIF
	850	!
	851	CALL WRF_GET_NPROCX(INPES)
	852	!
	853	IF(E_BDY)THEN
	854	UPSTRM=.TRUE.
	855	IRPAD2=0
	856	DO JJ=8,JDE-8 ! JM-7
	857	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	858	J=JJ ! -MY_JS_GLB+1
	859	IEND=IM-MOD(JJ+1,2)
	860	ISTART=IEND-3
	861	!
	862	!*** IN CASE THERE IS ONLY A SINGLE GLOBAL TASK IN THE
	863	!*** I DIRECTION THEN WE MUST ADD THE WESTSIDE UPSTREAM
	864	!*** POINTS TO THE EASTSIDE POINTS IN EACH ROW.
	865	!
	866	KNTI=0
	867	IF(INPES.EQ.1)KNTI=N_IUP_H(J)
	868	!
	869	DO II=ISTART,IEND
	870	I=II ! -MY_IS_GLB+1
	871	IUP_H(IMS+KNTI,J)=I
	872	KNTI=KNTI+1
	873	ENDDO
	874	N_IUP_H(J)=KNTI
	875	ENDIF
	876	ENDDO
	877	!
	878	DO JJ=6,JDE-6 ! JM-5
	879	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	880	J=JJ ! -MY_JS_GLB+1
	881	IEND=IM-1-MOD(JJ+1,2)
	882	ISTART=IEND-MOD(JJ,2)
	883	KNTI=0
	884	IF(INPES==1)KNTI=N_IUP_ADH(J)
	885	DO II=ISTART,IEND
	886	I=II ! -MY_IS_GLB+1
	887	IUP_ADH(IMS+KNTI,J)=I
	888	KNTI=KNTI+1
	889	ENDDO
	890	N_IUP_ADH(J)=KNTI
	891	ENDIF
	892	ENDDO
	893	!***
	894	DO JJ=8,JDE-8 ! JM-7
	895	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	896	J=JJ ! -MY_JS_GLB+1
	897	IEND=IM-MOD(JJ,2)
	898	ISTART=IEND-3
	899	KNTI=0
	900	IF(INPES==1)KNTI=N_IUP_V(J)
	901	!
	902	DO II=ISTART,IEND
	903	I=II ! -MY_IS_GLB+1
	904	IUP_V(IMS+KNTI,J)=I
	905	KNTI=KNTI+1
	906	ENDDO
	907	N_IUP_V(J)=KNTI
	908	ENDIF
	909	ENDDO
	910	!
	911	DO JJ=6,JDE-6 ! JM-5
	912	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	913	J=JJ ! -MY_JS_GLB+1
	914	IEND=IM-1-MOD(JJ,2)
	915	ISTART=IEND-MOD(JJ+1,2)
	916	KNTI=0
	917	IF(INPES==1)KNTI=N_IUP_ADV(J)
	918	DO II=ISTART,IEND
	919	I=II ! -MY_IS_GLB+1
	920	IUP_ADV(IMS+KNTI,J)=I
	921	KNTI=KNTI+1
	922	ENDDO
	923	N_IUP_ADV(J)=KNTI
	924	ENDIF
	925	ENDDO
	926	ENDIF
	927	!----------------------------------------------------------------------
	928	!!!!!!!!!!!!!!!!!!!!tlb
	929	!!!Read in EM and EMT from the original NMM nhb file
	930	!!! call int_get_fresh_handle( retval )
	931	!!! close(retval)
	932	!!! open(unit=retval,file=seeout,form='UNFORMATTED',iostat=ier)
	933	!!!!!!do j=1,128
	934	!!! read(seeout)
	935	!!!!!! read(55)
	936	!!!!!!enddo
	937	!!! read(seeout)dummyx,em,emt
	938	!!!!!!read(55)dummyx,em,emt
	939	!!! close(retval)
	940	jam=6+2*(JDE-JDS-1-9)
	941	! read(55)(em(j),j=1,jam),(emt(j),j=1,jam)
	942	!!!!!!!!!!!!!!!!!!!!tlb
	943	!
	944	!*** EXTRACT EM AND EMT FOR THE LOCAL SUBDOMAINS
	945	!
	946	DO J=MYJS_P5,MYJE_P5
	947	EM_LOC(J)=-9.E9
	948	EMT_LOC(J)=-9.E9
	949	ENDDO
	950	!!! IF(IBROW==1)THEN
	951	IF(S_BDY)THEN
	952	DO J=3,5
	953	EM_LOC(J)=EM(J-2)
	954	EMT_LOC(J)=EMT(J-2)
	955	ENDDO
	956	ENDIF
	957	!!! IF(ITROW==1)THEN
	958	IF(N_BDY)THEN
	959	KNT=3
	960	DO JJ=JDE-5,JDE-3 ! JM-4,JM-2
	961	KNT=KNT+1
	962	J=JJ ! -MY_JS_GLB+1
	963	EM_LOC(J)=EM(KNT)
	964	EMT_LOC(J)=EMT(KNT)
	965	ENDDO
	966	ENDIF
	967	!!! IF(ILCOL==1)THEN
	968	IF(W_BDY)THEN
	969	KNT=6
	970	DO JJ=6,JDE-6 ! JM-5
	971	KNT=KNT+1
	972	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	973	J=JJ ! -MY_JS_GLB+1
	974	EM_LOC(J)=EM(KNT)
	975	EMT_LOC(J)=EMT(KNT)
	976	ENDIF
	977	ENDDO
	978	ENDIF
	979	!!! IF(IRCOL==1)THEN
	980	IF(E_BDY)THEN
	981	KNT=6+JDE-11 ! JM-10
	982	DO JJ=6,JDE-6 ! JM-5
	983	KNT=KNT+1
	984	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
	985	J=JJ ! -MY_JS_GLB+1
	986	EM_LOC(J)=EM(KNT)
	987	EMT_LOC(J)=EMT(KNT)
	988	ENDIF
	989	ENDDO
	990	ENDIF
	991	#else
	992	CALL wrf_message( 'start_domain_nmm: upstream advection commented out')
	993	#endif
	994	!
	995	!***
	996	!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
	997	!***
	998	IF(NSTART.EQ.0)THEN
	999	!
	1000	GRID%NSOIL= GRID%NUM_SOIL_LAYERS
	1001	DO J=JFS,JFE
	1002	DO I=IFS,IFE
	1003	PCTSNO(I,J)=-999.0
	1004	IF(SM(I,J)<0.5)THEN
	1005	CMC(I,J)=0.0
	1006	! CMC(I,J)=canwat(i,j) ! tgs
	1007	IF(SICE(I,J)>0.5)THEN
	1008	!***
	1009	!*** SEA-ICE CASE
	1010	!***
	1011	SMSTAV(I,J)=1.0
	1012	SMSTOT(I,J)=1.0
	1013	SSROFF(I,J)=0.0
	1014	BGROFF(I,J)=0.0
	1015	CMC(I,J)=0.0
	1016	DO NS=1,GRID%NSOIL
	1017	SMC(I,NS,J)=1.0
	1018	! SH2O(I,NS,J)=0.05
	1019	SH2O(I,NS,J)=1.0
	1020	ENDDO
	1021	ENDIF
	1022	ELSE
	1023	!***
	1024	!*** WATER CASE
	1025	!***
	1026	SMSTAV(I,J)=1.0
	1027	SMSTOT(I,J)=1.0
	1028	SSROFF(I,J)=0.0
	1029	BGROFF(I,J)=0.0
	1030	SOILTB(I,J)=273.16
	1031	GRNFLX(I,J)=0.
	1032	SUBSHX(I,J)=0.0
	1033	ACSNOW(I,J)=0.0
	1034	ACSNOM(I,J)=0.0
	1035	SNOPCX(I,J)=0.0
	1036	CMC(I,J)=0.0
	1037	SNO(I,J)=0.0
	1038	DO NS=1,GRID%NSOIL
	1039	SMC(I,NS,J)=1.0
	1040	STC(I,NS,J)=273.16
	1041	! SH2O(I,NS,J)=0.05
	1042	SH2O(I,NS,J)=1.0
	1043	ENDDO
	1044	ENDIF
	1045	!
	1046	ENDDO
	1047	ENDDO
	1048	!
	1049	APHTIM=0.0
	1050	ARATIM=0.0
	1051	ACUTIM=0.0
	1052	!
	1053	ENDIF
	1054	!
	1055	!----------------------------------------------------------------------
	1056	!*** INITIALIZE RADTN VARIABLES
	1057	!*** CALCULATE THE NUMBER OF STEPS AT EACH POINT.
	1058	!*** THE ARRAY 'LVL' WILL COORDINATE VERTICAL LOCATIONS BETWEEN
	1059	!*** THE LIFTED WORKING ARRAYS AND THE FUNDAMENTAL MODEL ARRAYS.
	1060	!*** LVL HOLDS THE HEIGHT (IN MODEL LAYERS) OF THE TOPOGRAPHY AT
	1061	!*** EACH GRID POINT.
	1062	!----------------------------------------------------------------------
	1063	!
	1064	DO J=JFS,JFE
	1065	DO I=IFS,IFE
	1066	LVL(I,J)=LM-KTE
	1067	ENDDO
	1068	ENDDO
	1069	!***
	1070	!*** DETERMINE MODEL LAYER LIMITS FOR HIGH(3), MIDDLE(2),
	1071	!*** AND LOW(1) CLOUDS. ALSO FIND MODEL LAYER THAT IS JUST BELOW
	1072	!*** (HEIGHT-WISE) 400 MB. (K400)
	1073	!***
	1074	K400=0
	1075	PSUM=PT
	1076	SLPM=101325.
	1077	PDIF=SLPM-PT
	1078	DO K=1,LM
	1079	PSUM=PSUM+DETA(K)*PDIF
	1080	IF(LPTOP(3)==0)THEN
	1081	IF(PSUM>PHITP)LPTOP(3)=K
	1082	ELSEIF(LPTOP(2)==0)THEN
	1083	IF(PSUM>PMDHI)LPTOP(2)=K
	1084	ELSEIF(K400==0)THEN
	1085	IF(PSUM>P400)K400=K
	1086	ELSEIF(LPTOP(1)==0)THEN
	1087	IF(PSUM>PLOMD)LPTOP(1)=K
	1088	ENDIF
	1089	ENDDO
	1090	!***
	1091	!*** CALL GRADFS ONCE TO CALC. CONSTANTS AND GET O3 DATA
	1092	!***
	1093	KCCO2=0
	1094	!***
	1095	!*** CALCULATE THE MIDLAYER PRESSURES IN THE STANDARD ATMOSPHERE
	1096	!***
	1097	PSS=101325.
	1098	PDIF=PSS-PT
	1099	!
	1100	ALLOCATE(PHALF(LM+1),STAT=I)
	1101	!
	1102	DO K=KPS,KPE-1
	1103	PHALF(K+1)=AETA(K)*PDIF+PT
	1104	ENDDO
	1105
	1106	!
	1107	PHALF(1)=0.
	1108	PHALF(LM+1)=PSS
	1109	!***
	1110	!!! CALL GRADFS(PHALF,KCCO2,NUNIT_CO2)
	1111	!***
	1112	!*** CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE
	1113	!***
	1114	!!! IF(MYPE==0)CALL SOLARD(SUN_DIST)
	1115	!!! CALL MPI_BCAST(SUN_DIST,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
	1116
	1117	!***
	1118	!*** CALL ZENITH SIMPLY TO GET THE DAY OF THE YEAR FOR
	1119	!*** THE SETUP OF THE OZONE DATA
	1120	!***
	1121	TIME=(NTSD-1)*GRID%DT
	1122	!
	1123	!!! CALL ZENITH(TIME,DAYI,HOUR)
	1124	!
	1125	ADDL=0.
	1126	IF(MOD(IDAT(3),4)==0)ADDL=1.
	1127	!
	1128	!!! CALL O3CLIM
	1129	!
	1130	!
	1131	DEALLOCATE(PHALF)
	1132	!----------------------------------------------------------------------
	1133	!*** SOME INITIAL VALUES RELATED TO TURBULENCE SCHEME
	1134	!----------------------------------------------------------------------
	1135	!
	1136	DO J=JFS,JFE
	1137	DO I=IFS,IFE
	1138	!***
	1139	!*** TRY A SIMPLE LINEAR INTERP TO GET 2/10 M VALUES
	1140	!***
	1141	PDSL(I,J)=PD(I,J)*RES(I,J)
	1142	!
	1143	ULM=U(I,J,KTS)
	1144	VLM=V(I,J,KTS)
	1145	TLM=T(I,J,KTS)
	1146	QLM=Q(I,J,KTS)
	1147	PLM=AETA1(KTS)PDTOP+AETA2(KTS)PDSL(I,J)+PT
	1148	APELM=(1.0E5/PLM)**CAPA
	1149	APELMNW=(1.0E5/PSHLTR(I,J))**CAPA
	1150	THLM=TLM*APELM
	1151	DPLM=(DETA1(KTS)PDTOP+DETA2(KTS)PDSL(I,J))*0.5
	1152	DZLM=R_DDPLMTLM(1.+P608QLM)/(G*PLM)
	1153	FAC1=10./DZLM
	1154	FAC2=(DZLM-10.)/DZLM
	1155	IF(DZLM<=10.)THEN
	1156	FAC1=1.
	1157	FAC2=0.
	1158	ENDIF
	1159	!
	1160	IF(.NOT.RESTRT)THEN
	1161	TH10(I,J)=FAC2THS(I,J)+FAC1THLM
	1162	Q10(I,J)=FAC2QSH(I,J)+FAC1QLM
	1163	U10(I,J)=ULM
	1164	V10(I,J)=VLM
	1165	ENDIF
	1166	!
	1167	! FAC1=2./DZLM
	1168	! FAC2=(DZLM-2.)/DZLM
	1169	! IF(DZLM.LE.2.)THEN
	1170	! FAC1=1.
	1171	! FAC2=0.
	1172	! ENDIF
	1173	!
	1174	IF(.NOT.RESTRT.OR.NEST)THEN
	1175	!
	1176	IF ( (THLM-THS(I,J))>2.0) THEN ! weight differently in different scenarios
	1177	FAC1=0.3
	1178	FAC2=0.7
	1179	ELSE
	1180	FAC1=0.8
	1181	FAC2=0.2
	1182	ENDIF
	1183
	1184	TSHLTR(I,J)=FAC2THS(I,J)+FAC1THLM
	1185	! TSHLTR(I,J)=0.2THS(I,J)+0.8THLM
	1186	QSHLTR(I,J)=FAC2QSH(I,J)+FAC1QLM
	1187	! QSHLTR(I,J)=0.2QSH(I,J)+0.8QLM
	1188	ENDIF
	1189	!***
	1190	!*** NEED TO CONVERT TO THETA IF IS THE RESTART CASE
	1191	!*** AS CHKOUT.f WILL CONVERT TO TEMPERATURE
	1192	!***
	1193	!EROGERS: COMMENT OUT IN WRF-NMM
	1194	!***
	1195	! IF(RESTRT)THEN
	1196	! TSHLTR(I,J)=TSHLTR(I,J)*APELMNW
	1197	! ENDIF
	1198	ENDDO
	1199	ENDDO
	1200	!
	1201	!----------------------------------------------------------------------
	1202	!*** INITIALIZE TAU-1 VALUES FOR ADAMS-BASHFORTH
	1203	!----------------------------------------------------------------------
	1204	!
	1205	IF(.NOT.RESTRT)THEN
	1206	DO K=KPS,KPE
	1207	DO J=JFS,JFE
	1208	DO I=ifs,ife
	1209	TOLD(I,J,K)=T(I,J,K) ! T AT TAU-1
	1210	UOLD(I,J,K)=U(I,J,K) ! U AT TAU-1
	1211	VOLD(I,J,K)=V(I,J,K) ! V AT TAU-1
	1212	ENDDO
	1213	ENDDO
	1214	ENDDO
	1215	ENDIF
	1216	!
	1217	!----------------------------------------------------------------------
	1218	!*** INITIALIZE NONHYDROSTATIC QUANTITIES
	1219	!----------------------------------------------------------------------
	1220	!
	1221	!!!! SHOULD DWDT BE REDEFINED IF RESTRT?
	1222
	1223	IF(.NOT.RESTRT.OR.NEST)THEN
	1224	DO K=KPS,KPE
	1225	DO J=JFS,JFE
	1226	DO I=IFS,IFE
	1227	DWDT(I,J,K)=1.
	1228	ENDDO
	1229	ENDDO
	1230	ENDDO
	1231	ENDIF
	1232	!***
	1233	IF(GRID%SIGMA==1)THEN
	1234	DO J=JFS,JFE
	1235	DO I=IFS,IFE
	1236	PDSL(I,J)=PD(I,J)
	1237	ENDDO
	1238	ENDDO
	1239	ELSE
	1240	DO J=JFS,JFE
	1241	DO I=IFS,IFE
	1242	PDSL(I,J)=RES(I,J)*PD(I,J)
	1243	ENDDO
	1244	ENDDO
	1245	ENDIF
	1246	!
	1247	!***
	1248	!
	1249	!
	1250	!!!! SHOULD PINT,Z,W BE REDEFINED IF RESTRT?
	1251
	1252	write(0,*)' restrt=',restrt,' nest=',nest
	1253	write(0,*)' ifs=',ifs,' ife=',ife
	1254	write(0,*)' jfs=',jfs,' jfe=',jfe
	1255	write(0,*)' kps=',kps,' kpe=',kpe
	1256	write(0,*)' pdtop=',pdtop,' pt=',pt
	1257	IF(.NOT.RESTRT.OR.NEST)THEN
	1258	DO K=KPS,KPE
	1259	DO J=JFS,JFE
	1260	DO I=IFS,IFE
	1261	PINT(I,J,K)=ETA1(K)PDTOP+ETA2(K)PDSL(I,J)+PT
	1262	Z(I,J,K)=PINT(I,J,K)
	1263	W(I,J,K)=0.
	1264	ENDDO
	1265	ENDDO
	1266	ENDDO
	1267	ENDIF
	1268
	1269	#ifndef NO_RESTRICT_ACCEL
	1270	!----------------------------------------------------------------------
	1271	!*** RESTRICTING THE ACCELERATION ALONG THE BOUNDARIES
	1272	!----------------------------------------------------------------------
	1273	!
	1274	DO J=JFS,JFE
	1275	DO I=IFS,IFE
	1276	DWDTMN(I,J)=-EPSIN
	1277	DWDTMX(I,J)= EPSIN
	1278	ENDDO
	1279	ENDDO
	1280	!
	1281	!***
	1282	IF(JHL>1)THEN
	1283	JHH=JDE-1-JHL+1 ! JM-JHL+1
	1284	IHL=JHL/2+1
	1285	!
	1286	DO J=1,JHL
	1287	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
	1288	JX=J ! -MY_JS_GLB+1
	1289	DO I=1,IDE-1 ! IM
	1290	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
	1291	IX=I ! -MY_IS_GLB+1
	1292	DWDTMN(IX,JX)=-EPSB
	1293	DWDTMX(IX,JX)= EPSB
	1294	ENDIF
	1295	ENDDO
	1296	ENDIF
	1297	ENDDO
	1298	!
	1299	DO J=JHH,JDE-1 ! JM
	1300	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
	1301	JX=J ! -MY_JS_GLB+1
	1302	DO I=1,IDE-1 ! IM
	1303	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
	1304	IX=I ! -MY_IS_GLB+1
	1305	DWDTMN(IX,JX)=-EPSB
	1306	DWDTMX(IX,JX)= EPSB
	1307	ENDIF
	1308	ENDDO
	1309	ENDIF
	1310	ENDDO
	1311	!
	1312	DO J=1,JDE-1 ! JM
	1313	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
	1314	JX=J ! -MY_JS_GLB+1
	1315	DO I=1,IHL
	1316	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
	1317	IX=I ! -MY_IS_GLB+1
	1318	DWDTMN(IX,JX)=-EPSB
	1319	DWDTMX(IX,JX)= EPSB
	1320	ENDIF
	1321	ENDDO
	1322	ENDIF
	1323	ENDDO
	1324	!
	1325	DO J=1,JDE-1 ! JM
	1326	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
	1327	JX=J ! -MY_JS_GLB+1
	1328	! moved this line to inside the J-loop, 20030429, jm
	1329	IHH=IDE-1-IHL+MOD(J,2) ! IM-IHL+MOD(J,2)
	1330	DO I=IHH,IDE-1 ! IM
	1331	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
	1332	IX=I ! -MY_IS_GLB+1
	1333	DWDTMN(IX,JX)=-EPSB
	1334	DWDTMX(IX,JX)= EPSB
	1335	ENDIF
	1336	ENDDO
	1337	ENDIF
	1338	ENDDO
	1339	!
	1340	ENDIF
	1341
	1342	#else
	1343	CALL wrf_message('start_domain_nmm: NO_RESTRICT_ACCEL')
	1344	#endif
	1345
	1346	!-----------------------------------------------------------------------
	1347	!*** CALL THE GENERAL PHYSICS INITIALIZATION
	1348	!-----------------------------------------------------------------------
	1349	!
	1350
	1351	ALLOCATE(SFULL(KMS:KME),STAT=I) ; SFULL = 0.
	1352	ALLOCATE(SMID(KMS:KME),STAT=I) ; SMID = 0.
	1353	ALLOCATE(EMISS(IMS:IME,JMS:JME),STAT=I) ; EMISS = 0.
	1354	ALLOCATE(EMTEMP(IMS:IME,JMS:JME),STAT=I) ; EMTEMP = 0.
	1355	ALLOCATE(GLW(IMS:IME,JMS:JME),STAT=I) ; GLW = 0.
	1356	ALLOCATE(HFX(IMS:IME,JMS:JME),STAT=I) ; HFX = 0.
	1357	ALLOCATE(LOWLYR(IMS:IME,JMS:JME),STAT=I) ; LOWLYR = 0.
	1358	! ALLOCATE(MAVAIL(IMS:IME,JMS:JME),STAT=I) ; MAVAIL = 0.
	1359	ALLOCATE(NCA(IMS:IME,JMS:JME),STAT=I) ; NCA = 0.
	1360	ALLOCATE(QFX(IMS:IME,JMS:JME),STAT=I) ; QFX = 0.
	1361	ALLOCATE(RAINBL(IMS:IME,JMS:JME),STAT=I) ; RAINBL = 0.
	1362	ALLOCATE(RAINC(IMS:IME,JMS:JME),STAT=I) ; RAINC = 0.
	1363	ALLOCATE(RAINNC(IMS:IME,JMS:JME),STAT=I) ; RAINNC = 0.
	1364	ALLOCATE(RAINNCV(IMS:IME,JMS:JME),STAT=I) ; RAINNCV = 0.
	1365
	1366	ALLOCATE(ZS(KMS:KME),STAT=I) ; ZS = 0.
	1367	ALLOCATE(SNOWC(IMS:IME,JMS:JME),STAT=I) ; SNOWC = 0.
	1368	ALLOCATE(THC(IMS:IME,JMS:JME),STAT=I) ; THC = 0.
	1369	ALLOCATE(TMN(IMS:IME,JMS:JME),STAT=I) ; TMN = 0.
	1370	ALLOCATE(TSFC(IMS:IME,JMS:JME),STAT=I) ; TSFC = 0.
	1371	ALLOCATE(Z0_DUM(IMS:IME,JMS:JME),STAT=I) ; Z0_DUM = 0.
	1372	ALLOCATE(ALBEDO_DUM(IMS:IME,JMS:JME),STAT=I) ; ALBEDO_DUM = 0.
	1373
	1374	ALLOCATE(DZS(KMS:KME),STAT=I) ; DZS = 0.
	1375	ALLOCATE(RQCBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCBLTEN = 0.
	1376	ALLOCATE(RQIBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQIBLTEN = 0.
	1377	ALLOCATE(RQVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVBLTEN = 0.
	1378	ALLOCATE(RTHBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHBLTEN = 0.
	1379	ALLOCATE(RUBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RUBLTEN = 0.
	1380	ALLOCATE(RVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RVBLTEN = 0.
	1381	ALLOCATE(RQCCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCCUTEN = 0.
	1382	ALLOCATE(RQICUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQICUTEN = 0.
	1383	ALLOCATE(RQRCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQRCUTEN = 0.
	1384	ALLOCATE(RQSCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQSCUTEN = 0.
	1385	ALLOCATE(RQVCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVCUTEN = 0.
	1386	ALLOCATE(RTHCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHCUTEN = 0.
	1387	ALLOCATE(RTHRATEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATEN = 0.
	1388	ALLOCATE(RTHRATENLW(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATENLW = 0.
	1389	ALLOCATE(RTHRATENSW(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATENSW = 0.
	1390	ALLOCATE(ZINT(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; ZINT = 0.
	1391	ALLOCATE(CONVFAC(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CONVFAC = 0.
	1392	ALLOCATE(PINT_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; PINT_TRANS = 0.
	1393	ALLOCATE(T_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; T_TRANS = 0.
	1394	ALLOCATE(RRI(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RRI = 0.
	1395	ALLOCATE(CLDFRA_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_TRANS = 0.
	1396	#ifndef WRF_CHEM
	1397	ALLOCATE(CLDFRA_OLD(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_OLD = 0.
	1398	#endif
	1399	#if 0
	1400	ALLOCATE(W0AVG(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; W0AVG = 0.
	1401	#endif
	1402	!-----------------------------------------------------------------------
	1403	!jm added set of g_inv
	1404	G_INV=1./G
	1405	ROG=R_D*G_INV
	1406	GRID%RADT=GRID%NRADS*GRID%DT/60.
	1407	GRID%BLDT=GRID%NPHS*GRID%DT/60.
	1408	GRID%CUDT=GRID%NCNVC*GRID%DT/60.
	1409	GRID%GSMDT=GRID%NPHS*GRID%DT/60.
	1410	!
	1411	DO J=MYJS,MYJE
	1412	DO I=MYIS,MYIE
	1413	SFCZ=FIS(I,J)*G_INV
	1414	ZINT(I,KTS,J)=SFCZ
	1415	PDSL(I,J)=PD(I,J)*RES(I,J)
	1416	PSURF=PINT(I,J,KTS)
	1417	EXNSFC=(1.E5/PSURF)**CAPA
	1418	XLAND(I,J)=SM(I,J)+1.
	1419	THSIJ=(SST(I,J)EXNSFC)(XLAND(I,J)-1.) &
	1420	& +THS(I,J)*(2.-SM(I,J))
	1421	TSFC(I,J)=THSIJ/EXNSFC
	1422	!
	1423	DO K=KTS,KTE-1
	1424	PLYR=(PINT(I,J,K)+PINT(I,J,K+1))*0.5
	1425	TL=T(I,J,K)
	1426	CWML=CWM(I,J,K)
	1427	RRI(I,K,J)=R_DTL(1.+P608*Q(I,J,K))/PLYR
	1428	ZINT(I,K+1,J)=ZINT(I,K,J)+TL/PLYR &
	1429	(DETA1(K)PDTOP+DETA2(K)PDSL(I,J))ROG &
	1430	(Q(I,J,K)P608-CWML+1.)
	1431	ENDDO
	1432	!
	1433	! DO K=KTS,KTE
	1434	!!! ZMID(I,K,J)=0.5*(ZINT(I,K,J)+ZINT(I,K+1,J))
	1435	! ENDDO
	1436	ENDDO
	1437	ENDDO
	1438	!
	1439	!-----------------------------------------------------------------------
	1440	!*** RECREATE SIGMA VALUES AT LAYER INTERFACES FOR THE FULL VERTICAL
	1441	!*** DOMAIN FROM THICKNESS VALUES FOR THE TWO SUBDOMAINS.
	1442	!*** NOTE: KTE=NUMBER OF LAYERS PLUS ONE
	1443	!-----------------------------------------------------------------------
	1444	!
	1445	write(0,*)' start_domain kte=',kte
	1446	PDTOT=101325.-PT
	1447	RPDTOT=1./PDTOT
	1448	PDBOT=PDTOT-PDTOP
	1449	SFULL(KTS)=1.
	1450	SFULL(KTE)=0.
	1451	DSIGSUM = 0.
	1452	DO K=KTS+1,KTE
	1453	DSIG=(DETA1(K-1)PDTOP+DETA2(K-1)PDBOT)*RPDTOT
	1454	DSIGSUM=DSIGSUM+DSIG
	1455	SFULL(K)=SFULL(K-1)-DSIG
	1456	SMID(K-1)=0.5*(SFULL(K-1)+SFULL(K))
	1457	ENDDO
	1458	DSIG=(DETA1(KTE-1)PDTOP+DETA2(KTE-1)PDBOT)*RPDTOT
	1459	DSIGSUM=DSIGSUM+DSIG
	1460	SMID(KTE-1)=0.5*(SFULL(KTE-1)+SFULL(KTE))
	1461	!
	1462	!-----------------------------------------------------------------------
	1463
	1464	LU_INDEX=IVGTYP
	1465
	1466	IF(.NOT.RESTRT)THEN
	1467	DO J=MYJS,MYJE
	1468	DO I=MYIS,MYIE
	1469	Z0_DUM(I,J)=Z0(I,J) ! hold
	1470	ALBEDO_DUM(I,J)=ALBEDO(I,J) ! Save albedos
	1471	ENDDO
	1472	ENDDO
	1473	ENDIF
	1474	!
	1475	!*** Always define the quantity Z0BASE
	1476
	1477	IF(.NOT.RESTRT)THEN
	1478	DO J=MYJS,MYJE
	1479	DO I=MYIS,MYIE
	1480	!
	1481	IF(SM(I,J)==0)then
	1482	Z0BASE(I,J)=VZ0TBL_24(IVGTYP(I,J))+Z0LAND
	1483	ELSE
	1484	Z0BASE(I,J)=VZ0TBL_24(IVGTYP(I,J))+Z0SEA
	1485	ENDIF
	1486	!
	1487	ENDDO
	1488	ENDDO
	1489	ENDIF
	1490	!
	1491	! when allocating CAM radiation 4d arrays (ozmixm, aerosolc) these are not needed
	1492	num_ozmixm=1
	1493	num_aerosolc=1
	1494
	1495	! Set GMT, JULDAY, and JULYR outside of phy_init because it is no longer
	1496	! called inside phy_init due to moving nest changes. (When nests move
	1497	! phy_init may not be called on a process if, for example, it is a moving
	1498	! nest and if this part of the domain is not being initialized (not the
	1499	! leading edge).) Calling domain_setgmtetc() here will avoid this problem
	1500	! when NMM moves to moving nests.
	1501	CALL domain_setgmtetc( GRID, START_OF_SIMULATION )
	1502
	1503	if(restrt) then
	1504	CALL domain_clock_get( grid, current_time=currentTime )
	1505	CALL WRFU_TimeGet( currentTime, YY=grid%julyr, dayOfYear=grid%julday, &
	1506	H=hr, M=mn, S=sec, MS=ms, rc=rc)
	1507	grid%gmt=hr+real(mn)/60.+real(sec)/3600.+real(ms)/(1000*3600)
	1508	WRITE( wrf_err_message , * ) 'DEBUG start_domain_nmm(): gmt = ',grid%gmt
	1509	CALL wrf_debug( 150, TRIM(wrf_err_message) )
	1510	endif
	1511
	1512	! Several arguments are RCONFIG entries in Registry.NMM. Registry no longer
	1513	! includes these as dummy arguments or declares them. Access them from
	1514	! GRID. JM 20050819
	1515
	1516	CALL PHY_INIT(GRID%ID,CONFIG_FLAGS,GRID%DT,GRID%RESTART,SFULL,SMID &
	1517	& ,PT,TSFC,GRID%RADT,GRID%BLDT,GRID%CUDT,GRID%GSMDT &
	1518	& ,RTHCUTEN, RQVCUTEN, RQRCUTEN &
	1519	& ,RQCCUTEN, RQSCUTEN, RQICUTEN &
	1520	& ,RUBLTEN,RVBLTEN,RTHBLTEN &
	1521	& ,RQVBLTEN,RQCBLTEN,RQIBLTEN &
	1522	& ,RTHRATEN,RTHRATENLW,RTHRATENSW &
	1523	& ,STEPBL,STEPRA,STEPCU &
	1524	& ,W0AVG, RAINNC, RAINC, RAINCV, RAINNCV &
	1525	& ,NCA,GRID%SWRAD_SCAT &
	1526	& ,CLDEFI,LOWLYR &
	1527	& ,MASS_FLUX &
	1528	& ,RTHFTEN, RQVFTEN &
	1529	& ,CLDFRA_TRANS,CLDFRA_OLD,GLW,GSW,EMISS,EMTEMP,LU_INDEX&
	1530	& ,GRID%LANDUSE_ISICE, GRID%LANDUSE_LUCATS &
	1531	& ,GRID%LANDUSE_LUSEAS, GRID%LANDUSE_ISN &
	1532	& ,GRID%LU_STATE &
	1533	& ,XLAT,XLONG,ALBEDO,ALBBCK &
	1534	& ,GRID%GMT,GRID%JULYR,GRID%JULDAY &
	1535	& ,GRID%LEVSIZ, NUM_OZMIXM, NUM_AEROSOLC, GRID%PAERLEV &
	1536	& ,TMN,XLAND,ZNT,Z0,USTAR,MOL,PBLH,TKE_MYJ &
	1537	& ,EXCH_H,THC,SNOWC,MAVAIL,HFX,QFX,RAINBL &
	1538	& ,STC,ZS,DZS,GRID%NUM_SOIL_LAYERS,WARM_RAIN &
	1539	& ,ADV_MOIST_COND &
	1540	& ,APR_GR,APR_W,APR_MC,APR_ST,APR_AS &
	1541	& ,APR_CAPMA,APR_CAPME,APR_CAPMI &
	1542	& ,XICE,XICE,VEGFRA,SNOW,CANWAT,SMSTAV &
	1543	& ,SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW &
	1544	& ,ACSNOM,IVGTYP,ISLTYP,SFCEVP,SMC &
	1545	& ,SH2O, SNOWH, SMFR3D & ! temporary
	1546	& ,GRID%DX,GRID%DY,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY &
	1547	& ,MP_RESTART_STATE,TBPVS_STATE,TBPVS0_STATE &
	1548	& ,.TRUE.,.FALSE.,START_OF_SIMULATION &
	1549	& ,IDS, IDE, JDS, JDE, KDS, KDE &
	1550	& ,IMS, IME, JMS, JME, KMS, KME &
	1551	& ,ITS, ITE, JTS, JTE, KTS, KTE &
	1552	& )
	1553
	1554	!-----------------------------------------------------------------------
	1555	!
	1556	IF(NSTART==0)THEN
	1557
	1558	DO J=JMS,JME
	1559	DO I=IMS,IME
	1560	Z0(I,J)=Z0BASE(I,J)
	1561	ENDDO
	1562	ENDDO
	1563
	1564	DO K=KMS,KME
	1565	DO J=JMS,JME
	1566	DO I=IMS,IME
	1567	CLDFRA(I,J,K)=CLDFRA_TRANS(I,K,J)
	1568	ENDDO
	1569	ENDDO
	1570	ENDDO
	1571
	1572	ENDIF
	1573
	1574	!
	1575	!
	1576	!mp replace F*_PHY with values defined in module_initialize_real.F?
	1577
	1578	IF (.NOT. RESTRT) THEN
	1579	! Added by Greg Thompson, NCAR-RAL, for initializing water vapor
	1580	! mixing ratio (from NMM's specific humidity var) into moist array.
	1581
	1582	write(0,*) 'Initializng moist(:,:,:, Qv) from Q'
	1583	DO K=KPS,KPE
	1584	DO J=JFS,JFE
	1585	DO I=IFS,IFE
	1586	moist(I,J,K,P_QV) = Q(I,J,K) / (1.-Q(I,J,K))
	1587	enddo
	1588	enddo
	1589	enddo
	1590
	1591	! Also sum cloud water, ice, rain, snow, graupel into Ferrier CWM
	1592	! array (if any hydrometeors found and non-zero from initialization
	1593	! package). Then, determine fractions ice and rain from species.
	1594
	1595	IF (.not. (MAXVAL(CWM).gt.0. .and. MAXVAL(CWM).lt.1.) ) then
	1596	do i_m = 2, num_moist
	1597	if (i_m.ne.p_qv) &
	1598	& write(0,*) ' summing moist(:,:,:,',i_m,') into CWM array'
	1599	DO K=KPS,KPE
	1600	DO J=JFS,JFE
	1601	DO I=IFS,IFE
	1602	IF ( (moist(I,J,K,i_m).gt.EPSQ) .and. (i_m.ne.p_qv) ) THEN
	1603	CWM(I,J,K) = CWM(I,J,K) + moist(I,J,K,i_m)
	1604	ENDIF
	1605	enddo
	1606	enddo
	1607	enddo
	1608	enddo
	1609
	1610	IF (.not. ( (maxval(F_ICE)+maxval(F_RAIN)) .gt. EPSQ) ) THEN
	1611	write(0,*) ' computing F_ICE'
	1612	do i_m = 2, num_moist
	1613	DO J=JFS,JFE
	1614	DO K=KPS,KPE
	1615	DO I=IFS,IFE
	1616	IF ( (moist(I,J,K,i_m).gt.EPSQ) .and. &
	1617	& ( (i_m.eq.p_qi).or.(i_m.eq.p_qs).or.(i_m.eq.p_qg) ) ) THEN
	1618	F_ICE(I,K,J) = F_ICE(I,K,J) + moist(I,J,K,i_m)
	1619	ENDIF
	1620	if (model_config_rec%mp_physics(grid%id).EQ.ETAMPNEW) then
	1621	if ((i_m.eq.p_qi).or.(i_m.eq.p_qg) ) then
	1622	moist(I,J,K,p_qs)=moist(I,J,K,p_qs)+moist(I,J,K,i_m)
	1623	moist(I,J,K,i_m) =0.
	1624	endif
	1625	endif
	1626	enddo
	1627	enddo
	1628	enddo
	1629	enddo
	1630	write(0,*) ' computing F_RAIN'
	1631	!
	1632	DO J=JFS,JFE
	1633	DO K=KPS,KPE
	1634	DO I=IFS,IFE
	1635	IF(F_ICE(i,k,j)<=EPSQ)THEN
	1636	F_ICE(I,K,J)=0.
	1637	ELSE
	1638	F_ICE(I,K,J) = F_ICE(I,K,J)/CWM(I,J,K)
	1639	ENDIF
	1640	IF ( (moist(I,J,K,p_qr)+moist(I,J,K,p_qc)).gt.EPSQ) THEN
	1641	IF(moist(i,j,k,p_qr)<=EPSQ)THEN
	1642	F_RAIN(I,K,J)=0.
	1643	ELSE
	1644	F_RAIN(I,K,J) = moist(i,j,k,p_qr) &
	1645	& / (moist(i,j,k,p_qr)+moist(i,j,k,p_qc))
	1646	ENDIF
	1647	ENDIF
	1648	enddo
	1649	enddo
	1650	enddo
	1651	ENDIF
	1652	ENDIF
	1653	! End addition by Greg Thompson
	1654
	1655	IF (maxval(F_ICE) .gt. 0.) THEN
	1656	write(0,*) 'F_ICE > 0'
	1657	do J=JMS,JME
	1658	do K=KMS,KME
	1659	do I=IMS,IME
	1660	F_ICE_PHY(I,K,J)=F_ICE(I,K,J)
	1661	enddo
	1662	enddo
	1663	enddo
	1664	ENDIF
	1665
	1666	IF (maxval(F_RAIN) .gt. 0.) THEN
	1667	write(0,*) 'F_RAIN > 0'
	1668	do J=JMS,JME
	1669	do K=KMS,KME
	1670	do I=IMS,IME
	1671	F_RAIN_PHY(I,K,J)=F_RAIN(I,K,J)
	1672	enddo
	1673	enddo
	1674	enddo
	1675	ENDIF
	1676
	1677	IF (maxval(F_RIMEF) .gt. 0.) THEN
	1678	write(0,*) 'F_RIMEF > 0'
	1679	do J=JMS,JME
	1680	do K=KMS,KME
	1681	do I=IMS,IME
	1682	F_RIMEF_PHY(I,K,J)=F_RIMEF(I,K,J)
	1683	enddo
	1684	enddo
	1685	enddo
	1686	ENDIF
	1687	ENDIF
	1688	!
	1689	IF (.NOT. RESTRT) THEN
	1690	!-- Replace albedos if original albedos are nonzero
	1691	IF(MAXVAL(ALBEDO_DUM)>0.)THEN
	1692	DO J=JMS,JME
	1693	DO I=IMS,IME
	1694	ALBEDO(I,J)=ALBEDO_DUM(I,J)
	1695	ENDDO
	1696	ENDDO
	1697	ENDIF
	1698	ENDIF
	1699
	1700	IF(.NOT.RESTRT)THEN
	1701	DO J=JMS,JME
	1702	DO I=IMS,IME
	1703	APREC(I,J)=RAINNC(I,J)*1.E-3
	1704	CUPREC(I,J)=RAINCV(I,J)*1.E-3
	1705	ENDDO
	1706	ENDDO
	1707	ENDIF
	1708	!following will need mods Sep06
	1709	!
	1710	#ifdef WRF_CHEM
	1711	DO J=JTS,JTE
	1712	JJ=MIN(JDE-1,J)
	1713	DO K=KTS,KTE-1
	1714	KK=MIN(KDE-1,K)
	1715	DO I=ITS,ITE
	1716	II=MIN(IDE-1,I)
	1717	CONVFAC(I,K,J) = PINT(II,JJ,KK)/RGASUNIV/T(II,JJ,KK)
	1718	ENDDO
	1719	ENDDO
	1720	ENDDO
	1721
	1722	DO J=JMS,JME
	1723	DO K=KMS,KME
	1724	DO I=IMS,IME
	1725	PINT_TRANS(I,K,J)=PINT(I,J,K)
	1726	T_TRANS(I,K,J)=T(I,J,K)
	1727	ENDDO
	1728	ENDDO
	1729	ENDDO
	1730	CALL CHEM_INIT (GRID%ID,CHEM,GRID%DT,GRID%BIOEMDT,GRID%PHOTDT,GRID%CHEMDT, &
	1731	STEPBIOE,STEPPHOT,STEPCHEM,STEPFIREPL,GRID%PLUMERISEFIRE_FRQ, &
	1732	ZINT,G,AERWRF,CONFIG_FLAGS, &
	1733	RRI,T_TRANS,PINT_TRANS,CONVFAC, &
	1734	GD_CLOUD,GD_CLOUD2,GD_CLOUD_B,GD_CLOUD2_B, &
	1735	TAUAER1,TAUAER2,TAUAER3,TAUAER4, &
	1736	GAER1,GAER2,GAER3,GAER4, &
	1737	WAER1,WAER2,WAER3,WAER4, &
	1738	PM2_5_DRY,PM2_5_WATER,PM2_5_DRY_EC,GRID%CHEM_IN_OPT, &
	1739	GRID%KEMIT, &
	1740	IDS , IDE , JDS , JDE , KDS , KDE , &
	1741	IMS , IME , JMS , JME , KMS , KME , &
	1742	ITS , ITE , JTS , JTE , KTS , KTE )
	1743
	1744	!
	1745	! calculate initial pm
	1746	!
	1747	SELECT CASE (CONFIG_FLAGS%CHEM_OPT)
	1748	CASE (RADM2SORG, RACMSORG,RACMSORG_KPP)
	1749	CALL SUM_PM_SORGAM ( &
	1750	RRI, CHEM, H2OAJ, H2OAI, &
	1751	PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC, PM10, &
	1752	IDS,IDE, JDS,JDE, KDS,KDE, &
	1753	IMS,IME, JMS,JME, KMS,KME, &
	1754	ITS,ITE, JTS,JTE, KTS,KTE-1 )
	1755
	1756	CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
	1757	CALL SUM_PM_MOSAIC ( &
	1758	RRI, CHEM, &
	1759	PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC, PM10, &
	1760	IDS,IDE, JDS,JDE, KDS,KDE, &
	1761	IMS,IME, JMS,JME, KMS,KME, &
	1762	ITS,ITE, JTS,JTE, KTS,KTE-1 )
	1763
	1764	CASE DEFAULT
	1765	DO J=JTS,MIN(JTE,JDE-1)
	1766	DO K=KTS,MIN(KTE,KDE-1)
	1767	DO I=ITS,MIN(ITE,IDE-1)
	1768	PM2_5_DRY(I,K,J) = 0.
	1769	PM2_5_WATER(I,K,J) = 0.
	1770	PM2_5_DRY_EC(I,K,J) = 0.
	1771	PM10(I,K,J) = 0.
	1772	ENDDO
	1773	ENDDO
	1774	ENDDO
	1775	END SELECT
	1776	#endif
	1777	DEALLOCATE(SFULL)
	1778	DEALLOCATE(SMID)
	1779	DEALLOCATE(DZS)
	1780	DEALLOCATE(EMISS)
	1781	DEALLOCATE(EMTEMP)
	1782	DEALLOCATE(GLW)
	1783	DEALLOCATE(HFX)
	1784	DEALLOCATE(LOWLYR)
	1785	! DEALLOCATE(MAVAIL)
	1786	DEALLOCATE(NCA)
	1787	DEALLOCATE(QFX)
	1788	DEALLOCATE(RAINBL)
	1789	DEALLOCATE(RAINC)
	1790	DEALLOCATE(RAINNC)
	1791	DEALLOCATE(RAINNCV)
	1792	DEALLOCATE(RQCBLTEN)
	1793	DEALLOCATE(RQIBLTEN)
	1794	DEALLOCATE(RQVBLTEN)
	1795	DEALLOCATE(RTHBLTEN)
	1796	DEALLOCATE(RUBLTEN)
	1797	DEALLOCATE(RVBLTEN)
	1798	DEALLOCATE(RQCCUTEN)
	1799	DEALLOCATE(RQICUTEN)
	1800	DEALLOCATE(RQRCUTEN)
	1801	DEALLOCATE(RQSCUTEN)
	1802	DEALLOCATE(RQVCUTEN)
	1803	DEALLOCATE(RTHCUTEN)
	1804	DEALLOCATE(RTHRATEN)
	1805	DEALLOCATE(RTHRATENLW)
	1806	DEALLOCATE(RTHRATENSW)
	1807	DEALLOCATE(ZINT)
	1808	DEALLOCATE(CONVFAC)
	1809	DEALLOCATE(RRI)
	1810	DEALLOCATE(SNOWC)
	1811	DEALLOCATE(THC)
	1812	DEALLOCATE(TMN)
	1813	DEALLOCATE(TSFC)
	1814	DEALLOCATE(ZS)
	1815	DEALLOCATE(PINT_TRANS)
	1816	DEALLOCATE(T_TRANS)
	1817	DEALLOCATE(CLDFRA_TRANS)
	1818	#ifndef WRF_CHEM
	1819	DEALLOCATE(CLDFRA_OLD)
	1820	#endif
	1821	#if 0
	1822	DEALLOCATE(W0AVG)
	1823	#endif
	1824	!-----------------------------------------------------------------------
	1825	!----------------------------------------------------------------------
	1826	DO J=jfs,jfe
	1827	DO I=ifs,ife
	1828	DWDTMN(I,J)=DWDTMN(I,J)*HBM3(I,J)
	1829	DWDTMX(I,J)=DWDTMX(I,J)*HBM3(I,J)
	1830	ENDDO
	1831	ENDDO
	1832	!----------------------------------------------------------------------
	1833
	1834	#ifdef DM_PARALLEL
	1835	# include <HALO_NMM_INIT_1.inc>
	1836	# include <HALO_NMM_INIT_2.inc>
	1837	# include <HALO_NMM_INIT_3.inc>
	1838	# include <HALO_NMM_INIT_4.inc>
	1839	# include <HALO_NMM_INIT_5.inc>
	1840	# include <HALO_NMM_INIT_6.inc>
	1841	# include <HALO_NMM_INIT_7.inc>
	1842	# include <HALO_NMM_INIT_8.inc>
	1843	# include <HALO_NMM_INIT_9.inc>
	1844	# include <HALO_NMM_INIT_10.inc>
	1845	# include <HALO_NMM_INIT_11.inc>
	1846	# include <HALO_NMM_INIT_12.inc>
	1847	# include <HALO_NMM_INIT_13.inc>
	1848	# include <HALO_NMM_INIT_14.inc>
	1849	# include <HALO_NMM_INIT_15.inc>
	1850	# include <HALO_NMM_INIT_15B.inc>
	1851	# include <HALO_NMM_INIT_16.inc>
	1852	# include <HALO_NMM_INIT_17.inc>
	1853	# include <HALO_NMM_INIT_18.inc>
	1854	# include <HALO_NMM_INIT_19.inc>
	1855	# include <HALO_NMM_INIT_20.inc>
	1856	# include <HALO_NMM_INIT_21.inc>
	1857	# include <HALO_NMM_INIT_22.inc>
	1858	# include <HALO_NMM_INIT_23.inc>
	1859	# include <HALO_NMM_INIT_24.inc>
	1860	# include <HALO_NMM_INIT_25.inc>
	1861	# include <HALO_NMM_INIT_26.inc>
	1862	# include <HALO_NMM_INIT_27.inc>
	1863	# include <HALO_NMM_INIT_28.inc>
	1864	# include <HALO_NMM_INIT_29.inc>
	1865	# include <HALO_NMM_INIT_30.inc>
	1866	# include <HALO_NMM_INIT_31.inc>
	1867	# include <HALO_NMM_INIT_32.inc>
	1868	# include <HALO_NMM_INIT_33.inc>
	1869	# include <HALO_NMM_INIT_34.inc>
	1870	# include <HALO_NMM_INIT_35.inc>
	1871	# include <HALO_NMM_INIT_36.inc>
	1872	# include <HALO_NMM_INIT_37.inc>
	1873	# include <HALO_NMM_INIT_38.inc>
	1874	# include <HALO_NMM_INIT_39.inc>
	1875	#endif
	1876	#define COPY_OUT
	1877	#include <scalar_derefs.inc>
	1878
	1879	RETURN
	1880
	1881
	1882	END SUBROUTINE START_DOMAIN_NMM
	1883

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

Download in other formats:

Original Format