Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

start_domain_nmm.F @ 1

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

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 71.4 KB

Line
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_new_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	#ifdef DM_PARALLEL
21	USE MODULE_DM, ONLY : LOCAL_COMMUNICATOR &
22	,MYTASK,NTASKS,NTASKS_X &
23	,NTASKS_Y
24	USE MODULE_COMM_DM
25	#else
26	USE MODULE_DM
27	#endif
28	!
29	USE MODULE_IGWAVE_ADJUST,ONLY: PDTE, PFDHT, DDAMP
30	USE MODULE_ADVECTION, ONLY: ADVE, VAD2, HAD2
31	USE MODULE_NONHY_DYNAM, ONLY: VADZ, HADZ
32	USE MODULE_DIFFUSION_NMM,ONLY: HDIFF
33	USE MODULE_BNDRY_COND, ONLY: BOCOH, BOCOV
34	USE MODULE_PHYSICS_INIT
35	USE MODULE_GWD
36	! USE MODULE_RA_GFDLETA
37	!
38	USE MODULE_EXT_INTERNAL
39	!
40	#ifdef WRF_CHEM
41	USE MODULE_AEROSOLS_SORGAM, ONLY: SUM_PM_SORGAM
42	USE MODULE_GOCART_AEROSOLS, ONLY: SUM_PM_GOCART
43	USE MODULE_MOSAIC_DRIVER, ONLY: SUM_PM_MOSAIC
44	#endif
45	!
46	!----------------------------------------------------------------------
47	!
48	IMPLICIT NONE
49	!
50	!----------------------------------------------------------------------
51	!***
52	!*** Arguments
53	!***
54	TYPE(DOMAIN),INTENT(INOUT) :: GRID
55	LOGICAL , INTENT(IN) :: allowed_to_read
56	!
57	#include <dummy_new_decl.inc>
58	!
59	TYPE(GRID_CONFIG_REC_TYPE) :: CONFIG_FLAGS
60	!
61	#ifdef WRF_CHEM
62	REAL RGASUNIV ! universal gas constant [ J/mol-K ]
63	PARAMETER ( RGASUNIV = 8.314510 )
64	#endif
65	!
66	!***
67	!*** LOCAL DATA
68	!***
69	#ifdef HWRF
70	LOGICAL :: ANAL !zhang's doing, added for analysis option
71	#endif
72	INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE &
73	& ,IMS,IME,JMS,JME,KMS,KME &
74	& ,IPS,IPE,JPS,JPE,KPS,KPE
75	!
76	INTEGER :: ERROR,LOOP
77
78	REAL,ALLOCATABLE,DIMENSION(:) :: PHALF
79	!
80	REAL :: EPSB=0.1,EPSIN=9.8
81	!
82	INTEGER :: JHL=7
83	!
84	INTEGER :: I,IEND,IER,IFE,IFS,IHH,IHL,IHRSTB,II,IRTN &
85	& ,ISIZ1,ISIZ2,ISTART,ISTAT,IX,J,J00,JFE,JFS,JHH,JJ &
86	& ,JM1,JM2,JM3,JP1,JP2,JP3,JX,KK &
87	& ,K,K400,KBI,KBI2,KCCO2,KNT,KNTI &
88	& ,LB,LRECBC,L &
89	& ,N,NMAP,NRADLH,NRADSH,NREC,NS,RECL,STAT &
90	& ,STEPBL,STEPCU,STEPRA
91	!
92	INTEGER :: MY_E,MY_N,MY_S,MY_W &
93	& ,MY_NE,MY_NW,MY_SE,MY_SW,MYI,MYJ,NPE
94	!
95	INTEGER :: I_M
96	!
97	INTEGER :: ILPAD2,IRPAD2,JBPAD2,JTPAD2
98	INTEGER :: ITS,ITE,JTS,JTE,KTS,KTE
99	!
100	INTEGER,DIMENSION(3) :: LPTOP
101	!
102	REAL :: ADDL,APELM,APELMNW,APEM1,CAPA,CLOGES,DPLM,DZLM,EPS,ESE &
103	& ,FAC1,FAC2,PDIF,PLM,PM1,PSFCK,PSS,PSUM,QLM,RANG &
104	& ,SLPM,TERM1,THLM,TIME,TLM,TSFCK,ULM,VLM
105	!
106	!!! REAL :: BLDT,CWML,EXNSFC,G_INV,PLYR,PSFC,ROG,SFCZ,THSIJ,TL
107	REAL :: CWML,EXNSFC,G_INV,PLYR,PSURF,ROG,SFCZ,THSIJ,TL,ZOQING
108	REAL :: TEND
109	#ifdef HWRF
110	!zhang's doing
111	REAL :: TSTART
112	!zhang's doing ends
113	#endif
114	#ifdef HWRFX
115	! gopal's doing for the moving nest (MSLP computation)
116	!-----------------------------------------------------------------------------------------------------
117	REAL, PARAMETER :: LAPSR=6.5E-3, GI=1./G,D608=0.608
118	REAL, PARAMETER :: COEF3=287.05GILAPSR, COEF2=-1./COEF3
119	REAL, PARAMETER :: TRG=2.0R_DGI,LAPSI=1.0/LAPSR
120	REAL :: RTOPP,APELP,DZ,SFCT,A
121	!-----------------------------------------------------------------------------------------------------
122	#endif
123
124	!
125	!!! REAL,ALLOCATABLE,DIMENSION(:,:) :: RAINBL,RAINNC,RAINNC &
126	INTEGER,ALLOCATABLE,DIMENSION(:,:) :: ITEMP,LOWLYR
127	REAL,ALLOCATABLE,DIMENSION(:) :: SFULL,SMID
128	REAL,ALLOCATABLE,DIMENSION(:) :: DZS,ZS
129	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: RQCBLTEN,RQIBLTEN &
130	& ,RQVBLTEN,RTHBLTEN &
131	& ,RUBLTEN,RVBLTEN &
132	& ,RQCCUTEN,RQICUTEN,RQRCUTEN &
133	& ,RQSCUTEN,RQVCUTEN,RTHCUTEN &
134	& ,RUSHTEN,RVSHTEN &
135	& ,RQCSHTEN,RQISHTEN,RQRSHTEN &
136	& ,RQSSHTEN,RQVSHTEN,RTHSHTEN &
137	& ,RQGSHTEN &
138	& ,RTHRATEN &
139	& ,RTHRATENLW,RTHRATENSW
140	REAL,ALLOCATABLE,DIMENSION(:,:) :: EMISS,EMTEMP,GLW,HFX &
141	& ,NCA &
142	& ,QFX,RAINBL,RAINC,RAINNC &
143	& ,RAINNCV &
144	& ,SNOWNC,SNOWNCV &
145	& ,GRAUPELNC,GRAUPELNCV &
146	& ,SNOWC,THC,TMN,TSFC
147
148	REAL,ALLOCATABLE,DIMENSION(:,:) :: Z0_DUM, ALBEDO_DUM
149	!
150	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINT,RRI,CONVFAC,ZMID
151	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: T_TRANS,PINT_TRANS
152	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CLDFRA_TRANS
153	#ifndef WRF_CHEM
154	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CLDFRA_OLD
155	#endif
156	#if 0
157	REAL,ALLOCATABLE,DIMENSION(:,:,:) :: w0avg
158	#endif
159	LOGICAL :: E_BDY,N_BDY,S_BDY,W_BDY,WARM_RAIN,ADV_MOIST_COND
160	LOGICAL :: START_OF_SIMULATION
161	LOGICAL :: LRESTART
162
163
164	integer :: jam,retval
165	CHARACTER(LEN=255) :: message
166	integer myproc
167	real :: dsig,dsigsum,pdbot,pdtot,rpdtot
168	real :: fisx,ht,prodx,rg
169	integer :: i_t=096,j_t=195,n_t=11
170	integer :: i_u=49,j_u=475,n_u=07
171	integer :: i_v=49,j_v=475,n_v=07
172	integer :: num_ozmixm, num_aerosolc
173	real :: cen_lat,cen_lon,dtphs ! GWD
174	integer :: num_urban_layers
175	!Rogers GMT
176	INTEGER :: hr, mn, sec, ms, rc
177	TYPE(WRFU_Time) :: currentTime
178
179	INTEGER :: interval_seconds, restart_interval
180
181	! z0base new
182
183	REAL,DIMENSION(0:30) :: VZ0TBL_24
184	VZ0TBL_24= (/0., &
185	& 1.00, 0.07, 0.07, 0.07, 0.07, 0.15, &
186	& 0.08, 0.03, 0.05, 0.86, 0.80, 0.85, &
187	& 2.65, 1.09, 0.80, 0.001, 0.04, 0.05, &
188	& 0.01, 0.04, 0.06, 0.05, 0.03, 0.001, &
189	& 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
190
191	! end z0base new
192	!
193	!----------------------------------------------------------------------
194	!#define COPY_IN
195	!#include <scalar_derefs.inc>
196	!----------------------------------------------------------------------
197	!**********************************************************************
198	!----------------------------------------------------------------------
199	!
200
201	CALL GET_IJK_FROM_GRID(GRID, &
202	& IDS,IDE,JDS,JDE,KDS,KDE, &
203	& IMS,IME,JMS,JME,KMS,KME, &
204	& IPS,IPE,JPS,JPE,KPS,KPE)
205	!
206	ITS=IPS
207	ITE=IPE
208	JTS=JPS
209	JTE=JPE
210	KTS=KPS
211	KTE=KPE
212
213	CALL model_to_grid_config_rec(grid%id,model_config_rec &
214	& ,config_flags)
215	!
216	RESTRT=config_flags%restart
217	#ifdef HWRF
218	!zhang's doing added for analysis option
219	ANAL=config_flags%analysis ! gopal's doing
220	!zhang's doing ends
221	#endif
222
223	#if 1
224	IF(IME>NMM_MAX_DIM )THEN
225	WRITE(wrf_err_message,*) &
226	'start_domain_nmm ime (',ime,') > ',NMM_MAX_DIM, &
227	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
228	CALL WRF_ERROR_FATAL(wrf_err_message)
229	ENDIF
230	!
231	IF(JME>NMM_MAX_DIM )THEN
232	WRITE(wrf_err_message,*) &
233	'start_domain_nmm jme (',jme,') > ',NMM_MAX_DIM, &
234	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
235	CALL WRF_ERROR_FATAL(wrf_err_message)
236	ENDIF
237	#else
238	IF(IMS>-2.OR.IME>NMM_MAX_DIM )THEN
239	WRITE(wrf_err_message,*) &
240	'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, &
241	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
242	CALL WRF_ERROR_FATAL(wrf_err_message)
243	ENDIF
244	!
245	IF(JMS>-2.OR.JME>NMM_MAX_DIM )THEN
246	WRITE(wrf_err_message,*) &
247	'start_domain_nmm jms(',jms,' > -2 or jme (',jme,') > ',NMM_MAX_DIM, &
248	'. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
249	CALL WRF_ERROR_FATAL(wrf_err_message)
250	ENDIF
251	#endif
252	!
253	!----------------------------------------------------------------------
254	!
255	WRITE(message,196)IHRST,IDAT
256	CALL wrf_message(trim(message))
257	196 FORMAT(' FORECAST BEGINS ',I2,' GMT ',2(I2,'/'),I4)
258
259
260	!! Restarts must be made from times for which boundary data is available
261
262	CALL nl_get_interval_seconds(GRID%ID, interval_seconds)
263	CALL nl_get_restart_interval(GRID%ID, restart_interval)
264	IF (MOD(restart_interval*60,interval_seconds) /= 0) THEN
265	WRITE(wrf_err_message,*)' restart_interval is not integer multiplier of interval_seconds'
266	CALL WRF_ERROR_FATAL(wrf_err_message)
267	END IF
268
269	!!!!!!tlb
270	!!!! For now, set NPES to 1
271	NPES=1
272	!!!!!!tlb
273	MY_IS_GLB=IPS
274	MY_IE_GLB=IPE-1
275	MY_JS_GLB=JPS
276	MY_JE_GLB=JPE-1
277	!
278	IM=IPE-1
279	JM=JPE-1
280	!!!!!!!!!
281	!! All "my" variables defined below have had the IDE or JDE specification
282	!! reduced by 1
283	!!!!!!!!!!!
284
285	MYIS=MAX(IDS,IPS)
286	MYIE=MIN(IDE-1,IPE)
287	MYJS=MAX(JDS,JPS)
288	MYJE=MIN(JDE-1,JPE)
289
290	MYIS1 =MAX(IDS+1,IPS)
291	MYIE1 =MIN(IDE-2,IPE)
292	MYJS2 =MAX(JDS+2,JPS)
293	MYJE2 =MIN(JDE-3,JPE)
294	!
295	MYIS_P1=MAX(IDS,IPS-1)
296	MYIE_P1=MIN(IDE-1,IPE+1)
297	MYIS_P2=MAX(IDS,IPS-2)
298	MYIE_P2=MIN(IDE-1,IPE+2)
299	MYIS_P3=MAX(IDS,IPS-3)
300	MYIE_P3=MIN(IDE-1,IPE+3)
301	MYJS_P3=MAX(JDS,JPS-3)
302	MYJE_P3=MIN(JDE-1,JPE+3)
303	MYIS_P4=MAX(IDS,IPS-4)
304	MYIE_P4=MIN(IDE-1,IPE+4)
305	MYJS_P4=MAX(JDS,JPS-4)
306	MYJE_P4=MIN(JDE-1,JPE+4)
307	MYIS_P5=MAX(IDS,IPS-5)
308	MYIE_P5=MIN(IDE-1,IPE+5)
309	MYJS_P5=MAX(JDS,JPS-5)
310	MYJE_P5=MIN(JDE-1,JPE+5)
311	!
312	MYIS1_P1=MAX(IDS+1,IPS-1)
313	MYIE1_P1=MIN(IDE-2,IPE+1)
314	MYIS1_P2=MAX(IDS+1,IPS-2)
315	MYIE1_P2=MIN(IDE-2,IPE+2)
316	!
317	MYJS1_P1=MAX(JDS+1,JPS-1)
318	MYJS2_P1=MAX(JDS+2,JPS-1)
319	MYJE1_P1=MIN(JDE-2,JPE+1)
320	MYJE2_P1=MIN(JDE-3,JPE+1)
321	MYJS1_P2=MAX(JDS+1,JPS-2)
322	MYJE1_P2=MIN(JDE-2,JPE+2)
323	MYJS2_P2=MAX(JDS+2,JPS-2)
324	MYJE2_P2=MIN(JDE-3,JPE+2)
325	MYJS1_P3=MAX(JDS+1,JPS-3)
326	MYJE1_P3=MIN(JDE-2,JPE+3)
327	MYJS2_P3=MAX(JDS+2,JPS-3)
328	MYJE2_P3=MIN(JDE-3,JPE+3)
329	!!!!!!!!!!!
330	!
331	#ifdef DM_PARALLEL
332
333	CALL WRF_GET_MYPROC(MYPROC)
334	MYPE=MYPROC
335
336	!
337	!----------------------------------------------------------------------
338	!*** Let each task determine who its eight neighbors are because we
339	!*** will need to know that for the halo exchanges. The direction
340	!*** to each neighbor will be designated by the following integers:
341	!
342	!*** north: 1
343	!*** east: 2
344	!*** south: 3
345	!*** west: 4
346	!*** northeast: 5
347	!*** southeast: 6
348	!*** southwest: 7
349	!*** northwest: 8
350	!
351	!*** If a task has no neighbor in a particular direction because of
352	!*** the presence of the global domain boundary then that element
353	!*** of my_neb is set to -1.
354	!-----------------------------------------------------------------------
355	!
356	call wrf_get_nprocx(inpes)
357	call wrf_get_nprocy(jnpes)
358	!
359	allocate(itemp(inpes,jnpes),stat=istat)
360	npe=0
361	!
362	do j=1,jnpes
363	do i=1,inpes
364	itemp(i,j)=npe
365	if(npe==mype)then
366	myi=i
367	myj=j
368	endif
369	npe=npe+1
370	enddo
371	enddo
372	!
373	my_n=-1
374	if(myj+1<=jnpes)my_n=itemp(myi,myj+1)
375	!
376	my_e=-1
377	if(myi+1<=inpes)my_e=itemp(myi+1,myj)
378	!
379	my_s=-1
380	if(myj-1>=1)my_s=itemp(myi,myj-1)
381	!
382	my_w=-1
383	if(myi-1>=1)my_w=itemp(myi-1,myj)
384	!
385	my_ne=-1
386	if((myi+1<=inpes).and.(myj+1<=jnpes)) &
387	my_ne=itemp(myi+1,myj+1)
388	!
389	my_se=-1
390	if((myi+1<=inpes).and.(myj-1>=1)) &
391	my_se=itemp(myi+1,myj-1)
392	!
393	my_sw=-1
394	if((myi-1>=1).and.(myj-1>=1)) &
395	my_sw=itemp(myi-1,myj-1)
396	!
397	my_nw=-1
398	if((myi-1>=1).and.(myj+1<=jnpes)) &
399	my_nw=itemp(myi-1,myj+1)
400	!
401	! my_neb(1)=my_n
402	! my_neb(2)=my_e
403	! my_neb(3)=my_s
404	! my_neb(4)=my_w
405	! my_neb(5)=my_ne
406	! my_neb(6)=my_se
407	! my_neb(7)=my_sw
408	! my_neb(8)=my_nw
409	!
410	deallocate(itemp)
411	# include <HALO_NMM_INIT_1.inc>
412	# include <HALO_NMM_INIT_2.inc>
413	# include <HALO_NMM_INIT_3.inc>
414	# include <HALO_NMM_INIT_4.inc>
415	# include <HALO_NMM_INIT_5.inc>
416	# include <HALO_NMM_INIT_6.inc>
417	# include <HALO_NMM_INIT_7.inc>
418	# include <HALO_NMM_INIT_8.inc>
419	# include <HALO_NMM_INIT_9.inc>
420	# include <HALO_NMM_INIT_10.inc>
421	# include <HALO_NMM_INIT_11.inc>
422	# include <HALO_NMM_INIT_12.inc>
423	# include <HALO_NMM_INIT_13.inc>
424	# include <HALO_NMM_INIT_14.inc>
425	# include <HALO_NMM_INIT_15.inc>
426	# include <HALO_NMM_INIT_16.inc>
427	# include <HALO_NMM_INIT_17.inc>
428	# include <HALO_NMM_INIT_18.inc>
429	# include <HALO_NMM_INIT_19.inc>
430	# include <HALO_NMM_INIT_20.inc>
431	# include <HALO_NMM_INIT_21.inc>
432	# include <HALO_NMM_INIT_22.inc>
433	# include <HALO_NMM_INIT_23.inc>
434	# include <HALO_NMM_INIT_24.inc>
435	# include <HALO_NMM_INIT_25.inc>
436	# include <HALO_NMM_INIT_26.inc>
437	# include <HALO_NMM_INIT_27.inc>
438	# include <HALO_NMM_INIT_28.inc>
439	# include <HALO_NMM_INIT_29.inc>
440	# include <HALO_NMM_INIT_30.inc>
441	# include <HALO_NMM_INIT_31.inc>
442	# include <HALO_NMM_INIT_32.inc>
443	# include <HALO_NMM_INIT_33.inc>
444	# include <HALO_NMM_INIT_34.inc>
445	# include <HALO_NMM_INIT_35.inc>
446	# include <HALO_NMM_INIT_36.inc>
447	# include <HALO_NMM_INIT_37.inc>
448	# include <HALO_NMM_INIT_38.inc>
449	# include <HALO_NMM_INIT_39.inc>
450	#endif
451	!
452	DO J=MYJS_P4,MYJE_P4
453	grid%iheg(J)=MOD(J+1,2)
454	grid%ihwg(J)=grid%iheg(J)-1
455	grid%iveg(J)=MOD(J,2)
456	grid%ivwg(J)=grid%iveg(J)-1
457	ENDDO
458	!
459	DO J=MYJS_P4,MYJE_P4
460	grid%ivw(J)=grid%ivwg(J)
461	grid%ive(J)=grid%iveg(J)
462	grid%ihe(J)=grid%iheg(J)
463	grid%ihw(J)=grid%ihwg(J)
464	ENDDO
465	!
466	CAPA=R_D/CP
467	LM=KPE-KPS+1
468	!
469	IFS=IPS
470	JFS=JPS
471	JFE=MIN(JPE,JDE-1)
472	IFE=MIN(IPE,IDE-1)
473	!
474	#ifdef HWRF
475	!zhang's doing
476	IF((.NOT.RESTRT .AND. .NOT.ANAL) .OR. .NOT.allowed_to_read)THEN
477	!end of zhang's doing
478	#else
479	IF(.NOT.RESTRT)THEN
480	#endif
481	DO J=JFS,JFE
482	DO I=IFS,IFE
483	grid%pdsl(I,J) =grid%pd(I,J)*grid%res(I,J)
484	grid%prec(I,J) =0.
485	IF(allowed_to_read)grid%acprec(I,J)=0. ! This is gopal's inclusion for moving nest
486	grid%cuprec(I,J)=0.
487	rg=1./g
488	ht=grid%fis(i,j)*rg
489	!!! fisx=ht*g
490	! fisx=max(grid%fis(i,j),0.)
491	! prodx=grid%z0(I,J)*Z0MAX
492	! grid%z0(I,J) =grid%sm(I,J)Z0SEA+(1.-grid%sm(I,J)) &
493	! & (grid%z0(I,J)Z0MAX+FISx FCM+Z0LAND)
494	!!! & (prodx +FISx *FCM+Z0LAND)
495	grid%qsh(I,J) =0.
496	grid%akms(I,J) =0.
497	grid%akhs(I,J) =0.
498	grid%twbs(I,J) =0.
499	grid%qwbs(I,J) =0.
500	IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
501	grid%cldefi(I,J)=1.
502	grid%htop(I,J) =REAL(KTS)
503	grid%htopd(I,J) =REAL(KTS)
504	grid%htops(I,J) =REAL(KTS)
505	grid%hbot(I,J) =REAL(KTE)
506	grid%hbotd(I,J) =REAL(KTE)
507	grid%hbots(I,J) =REAL(KTE)
508	ENDIF
509	!***
510	!*** AT THIS POINT, WE MUST CALCULATE THE INITIAL POTENTIAL TEMPERATURE
511	!*** OF THE SURFACE AND OF THE SUBGROUND.
512	!*** EXTRAPOLATE DOWN FOR INITIAL SURFACE POTENTIAL TEMPERATURE.
513	!*** ALSO DO THE SHELTER PRESSURE.
514	!***
515	!
516	!*** BECAUSE WE REINITIALIZE TOPOGRAPHY, LAND SEA MASK AND FIND THE TEMPERATURE
517	!*** FIELD OVER THE NEW TOPOGRAPHY, AFTER THE MOVE, I THINK IT MORE APPROPRIATE
518	!*** TO USE grid%nmm_tsk OR grid%sst TO RE-DERIVE grid%ths AND QS (AND CONSEQUENTLY grid%thz0 AND grid%qz0).
519	!*** THIS MAY BE MORE CONSISTENT WITH THE PSEUDO-HYDROSTATIC BALANCING THAT IS
520	!*** DONE OVER THE NEW TERRAIN (AND WITH NEW grid%sm). gopal!
521	!***
522	!***
523
524	IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
525
526	PM1=grid%aeta1(KTS)grid%pdtop+grid%aeta2(KTS)grid%pdsl(I,J)+grid%pt
527	APEM1=(1.E5/PM1)**CAPA
528
529	IF(grid%nmm_tsk(I,J)>=200.)THEN ! have a specific skin temp, use it
530	#ifdef HWRF
531	grid%ths(I,J)=grid%nmm_tsk(I,J)(1.+P608grid%q(I,J,KTS+1))*APEM1
532	TSFCK=grid%nmm_tsk(I,J)(1.+P608grid%q(I,J,KTS+1))
533	#else
534	grid%ths(I,J)=grid%nmm_tsk(I,J)*APEM1
535	TSFCK=grid%nmm_tsk(I,J)
536	#endif
537
538	ELSE ! use lowest layer as a proxy
539	#ifdef HWRF
540	grid%ths(I,J)=grid%t(I,J,KTS)(1.+P608grid%q(I,J,KTS+1))*APEM1
541	TSFCK=grid%t(I,J,KTS)(1.+P608grid%q(I,J,KTS+1))
542	#else
543	grid%ths(I,J)=grid%t(I,J,KTS)*APEM1
544	TSFCK=grid%t(I,J,KTS)
545	#endif
546	ENDIF
547
548	PSFCK=grid%pd(I,J)+grid%pdtop+grid%pt
549	!
550	IF(grid%sm(I,J)<0.5) THEN
551	grid%qsh(I,J)=PQ0/PSFCKEXP(A2(TSFCK-A3)/(TSFCK-A4))
552	ELSEIF(grid%sm(I,J)>0.5) THEN
553	grid%ths(I,J)=grid%sst(I,J)(1.E5/(grid%pd(I,J)+grid%pdtop+grid%pt))*CAPA
554	ENDIF
555	!
556	TERM1=-0.068283/grid%t(I,J,KTS)
557	grid%pshltr(I,J)=(grid%pd(I,J)+grid%pdtop+grid%pt)*EXP(TERM1)
558	!
559	grid%ustar(I,J)=0.1
560	grid%thz0(I,J)=grid%ths(I,J)
561	grid%qz0(I,J)=grid%qsh(I,J)
562	grid%uz0(I,J)=0.
563	grid%vz0(I,J)=0.
564
565	ENDIF ! endif for allowed to read
566	!
567	ENDDO
568	ENDDO
569
570	!***
571	!*** INITIALIZE CLOUD FIELDS
572	!***
573	IF (MAXVAL(grid%cwm) .gt. 0. .and. MAXVAL(grid%cwm) .lt. 1.) then
574	CALL wrf_message('appear to have grid%cwm values...do not zero')
575	ELSE
576	IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
577	CALL wrf_message('zeroing grid%cwm')
578	DO K=KPS,KPE
579	DO J=JFS,JFE
580	DO I=IFS,IFE
581	grid%cwm(I,J,K)=0.
582	ENDDO
583	ENDDO
584	ENDDO
585	ENDIF
586	ENDIF
587	!***
588	!*** INITIALIZE ACCUMULATOR ARRAYS TO ZERO.
589	!***
590	grid%ardsw=0.0
591	grid%ardlw=0.0
592	grid%asrfc=0.0
593	grid%avrain=0.0
594	grid%avcnvc=0.0
595	!
596	DO J=JFS,JFE
597	DO I=IFS,IFE
598	grid%acfrcv(I,J)=0.
599	grid%ncfrcv(I,J)=0
600	grid%acfrst(I,J)=0.
601	grid%ncfrst(I,J)=0
602	grid%acsnow(I,J)=0.
603	grid%acsnom(I,J)=0.
604	grid%ssroff(I,J)=0.
605	grid%bgroff(I,J)=0.
606	grid%alwin(I,J) =0.
607	grid%alwout(I,J)=0.
608	grid%alwtoa(I,J)=0.
609	grid%aswin(I,J) =0.
610	grid%aswout(I,J)=0.
611	grid%aswtoa(I,J)=0.
612	grid%sfcshx(I,J)=0.
613	grid%sfclhx(I,J)=0.
614	grid%subshx(I,J)=0.
615	grid%snopcx(I,J)=0.
616	grid%sfcuvx(I,J)=0.
617	grid%sfcevp(I,J)=0.
618	grid%potevp(I,J)=0.
619	grid%potflx(I,J)=0.
620	ENDDO
621	ENDDO
622	!***
623	!*** INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER.
624	!***
625	EPS=R_D/R_V
626	!
627	IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
628	DO J=JFS,JFE
629	DO I=IFS,IFE
630	IF(grid%sm(I,J)>0.5)THEN
631	CLOGES =-CM1/grid%sst(I,J)-CM2*ALOG10(grid%sst(I,J))+CM3
632	ESE = 10.**(CLOGES+2.)
633	grid%qsh(I,J)= grid%sm(I,J)EPSESE/(grid%pd(I,J)+grid%pdtop+grid%pt-ESE*(1.-EPS))
634	ENDIF
635	ENDDO
636	ENDDO
637	ENDIF
638	!***
639	!*** INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL
640	!*** VALUE (EPSQ2) ABOVE GROUND. SET TKE TO ZERO IN THE
641	!*** THE LOWEST MODEL LAYER. IN THE LOWEST TWO ATMOSPHERIC
642	!*** ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI).
643	!***
644	!***EROGERS: add check for realistic values of grid%q2
645	!
646	IF (MAXVAL(grid%q2) .gt. epsq2 .and. MAXVAL(grid%q2) .lt. 200.) then
647	CALL wrf_message('appear to have grid%q2 values...do not zero')
648	ELSE
649	IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
650	CALL wrf_message('zeroing grid%q2')
651	DO K=KPS,KPE-1
652	DO J=JFS,JFE
653	DO I=IFS,IFE
654	#ifdef HWRF
655	grid%q2(I,J,K)=0.
656	#else
657	grid%q2(I,J,K)=grid%hbm2(I,J)*EPSQ2
658	#endif
659	ENDDO
660	ENDDO
661	ENDDO
662	!
663	DO J=JFS,JFE
664	DO I=IFS,IFE
665	grid%q2(I,J,LM) = 0.
666	#ifdef HWRF
667	grid%q2(I,J,KTE-2)= 0.
668	grid%q2(I,J,KTE-1)= 0.
669	#else
670	grid%q2(I,J,KTE-2)= grid%hbm2(I,J)*Q2INI
671	grid%q2(I,J,KTE-1)= grid%hbm2(I,J)*Q2INI
672	#endif
673	ENDDO
674	ENDDO
675	ENDIF
676	ENDIF
677	!***
678	!*** PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL.
679	!*** INITIALIZE LATENT HEATING ACCUMULATION ARRAYS.
680	!***
681	DO K=KPS,KPE
682	DO J=JFS,JFE
683	DO I=IFS,IFE
684	IF(grid%q(I,J,K)<EPSQ)grid%q(I,J,K)=EPSQ
685	grid%train(I,J,K)=0.
686	grid%tcucn(I,J,K)=0.
687	ENDDO
688	ENDDO
689	ENDDO
690	!
691	!***
692	!*** INITIALIZE MAX/MIN TEMPERATURES.
693	!***
694	DO J=JFS,JFE
695	DO I=IFS,IFE
696	grid%tlmax(I,J)=grid%t(I,J,KPS)
697	grid%tlmin(I,J)=grid%t(I,J,KPS)
698	ENDDO
699	ENDDO
700	!
701	!----------------------------------------------------------------------
702	!*** END OF SCRATCH START INITIALIZATION BLOCK.
703	!----------------------------------------------------------------------
704	!
705	CALL wrf_message('INIT: INITIALIZED ARRAYS FOR CLEAN START')
706	ENDIF ! <--- (not restart)
707
708	IF(NEST)THEN
709	DO J=JFS,JFE
710	DO I=IFS,IFE
711	!
712	IF(grid%t(I,J,KTS)==0.)THEN
713	grid%t(I,J,KTS)=grid%t(I,J,KTS+1)
714	ENDIF
715	!
716	TERM1=-0.068283/grid%t(I,J,KTS)
717	grid%pshltr(I,J)=(grid%pd(I,J)+grid%pdtop+grid%pt)*EXP(TERM1)
718	ENDDO
719	ENDDO
720	ENDIF
721	!
722	!----------------------------------------------------------------------
723	!*** RESTART INITIALIZING. CHECK TO SEE IF WE NEED TO ZERO
724	!*** ACCUMULATION ARRAYS.
725	!----------------------------------------------------------------------
726
727	TSPH=3600./GRID%DT ! needed?
728	grid%nphs0=GRID%NPHS
729	#ifdef HWRF
730	!zhang's doing
731	tstart = grid%TSTART
732	!zhang's doing ends
733	#endif
734
735	IF(MYPE==0)THEN
736	WRITE( wrf_err_message, * )' start_nmm TSTART=',grid%tstart
737	CALL wrf_debug( 1, TRIM(wrf_err_message) )
738	WRITE( wrf_err_message, * )' start_nmm TPREC=',grid%tprec
739	CALL wrf_debug( 1, TRIM(wrf_err_message) )
740	WRITE( wrf_err_message, * )' start_nmm THEAT=',grid%theat
741	CALL wrf_debug( 1, TRIM(wrf_err_message) )
742	WRITE( wrf_err_message, * )' start_nmm TCLOD=',grid%tclod
743	CALL wrf_debug( 1, TRIM(wrf_err_message) )
744	WRITE( wrf_err_message, * )' start_nmm TRDSW=',grid%trdsw
745	CALL wrf_debug( 1, TRIM(wrf_err_message) )
746	WRITE( wrf_err_message, * )' start_nmm TRDLW=',grid%trdlw
747	CALL wrf_debug( 1, TRIM(wrf_err_message) )
748	WRITE( wrf_err_message, * )' start_nmm TSRFC=',grid%tsrfc
749	CALL wrf_debug( 1, TRIM(wrf_err_message) )
750	WRITE( wrf_err_message, * )' start_nmm PCPFLG=',grid%pcpflg
751	CALL wrf_debug( 1, TRIM(wrf_err_message) )
752	ENDIF
753
754	NSTART = INT(grid%TSTART*TSPH+0.5)
755	!
756	grid%ntsd = NSTART
757
758
759	!! want non-zero values for grid%nprec, grid%nheat type vars to avoid problems
760	!! with mod statements below.
761
762	grid%nprec = INT(grid%TPREC *TSPH+0.5)
763	grid%nheat = INT(grid%THEAT *TSPH+0.5)
764	grid%nclod = INT(grid%TCLOD *TSPH+0.5)
765	grid%nrdsw = INT(grid%TRDSW *TSPH+0.5)
766	grid%nrdlw = INT(grid%TRDLW *TSPH+0.5)
767	grid%nsrfc = INT(grid%TSRFC *TSPH+0.5)
768	#ifdef HWRF
769	!zhang's dong for analysis option:
770	grid%NCNVC0 = grid%NCNVC
771	grid%NPHS0 = grid%NPHS
772	#endif
773	!
774	!----------------------------------------------------------------------
775	!
776	!*** FLAG FOR INITIALIZING ARRAYS, LOOKUP TABLES, & CONSTANTS USED IN
777	!*** MICROPHYSICS AND RADIATION
778	!
779	!----------------------------------------------------------------------
780	!
781	grid%micro_start=.TRUE.
782	!
783	!----------------------------------------------------------------------
784	!***
785	!*** INITIALIZE ADVECTION TENDENCIES TO ZERO SO THAT
786	!*** BOUNDARY POINTS WILL ALWAYS BE ZERO
787	!***
788	DO J=JFS,JFE
789	DO I=IFS,IFE
790	grid%adt(I,J)=0.
791	grid%adu(I,J)=0.
792	grid%adv(I,J)=0.
793	ENDDO
794	ENDDO
795	!----------------------------------------------------------------------
796	!***
797	!*** SET INDEX ARRAYS FOR UPSTREAM ADVECTION
798	!***
799	!----------------------------------------------------------------------
800	DO J=JFS,JFE
801	grid%n_iup_h(J)=0
802	grid%n_iup_v(J)=0
803	grid%n_iup_adh(J)=0
804	grid%n_iup_adv(J)=0
805	!
806	DO I=IFS,IFE
807	grid%iup_h(I,J)=-999
808	grid%iup_v(I,J)=-999
809	grid%iup_adh(I,J)=-999
810	grid%iup_adv(I,J)=-999
811	ENDDO
812	!
813	ENDDO
814
815	#ifndef NO_UPSTREAM_ADVECTION
816	!
817	!*** n_iup_h HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
818	!*** FOR UPSTREAM ADVECTION (FULL ROWS IN THE 3RD THROUGH 7TH
819	!*** ROWS FROM THE SOUTH AND NORTH GLOBAL BOUNDARIES AND
820	!*** FOUR POINTS ADJACENT TO THE WEST AND EAST GLOBAL BOUNDARIES
821	!*** ON ALL OTHER INTERNAL ROWS). SIMILARLY FOR n_iup_v.
822	!*** BECAUSE OF HORIZONTAL OPERATIONS, THESE POINTS EXTEND OUTSIDE
823	!*** OF THE UPSTREAM REGION SOMEWHAT.
824	!*** n_iup_adh HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
825	!*** FOR THE COMPUTATION OF THE TENDENCIES THEMSELVES (adt, ADQ2M
826	!*** AND ADQ2L); SPECIFICALLY THESE TENDENCIES ARE ONLY DONE IN
827	!*** THE UPSTREAM REGION.
828	!*** n_iup_adv HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
829	!*** FOR THE VELOCITY POINT TENDENCIES.
830	!*** iup_h AND iup_v HOLD THE ACTUAL I VALUES USED IN EACH ROW.
831	!*** LIKEWISE FOR iup_adh AND iup_adv.
832	!*** ALSO, SET upstrm FOR THOSE TASKS AROUND THE GLOBAL EDGE.
833	!
834	grid%upstrm=.FALSE.
835	!
836	S_BDY=(JPS==JDS)
837	N_BDY=(JPE==JDE)
838	W_BDY=(IPS==IDS)
839	E_BDY=(IPE==IDE)
840	!
841	JTPAD2=2
842	JBPAD2=2
843	IRPAD2=2
844	ILPAD2=2
845	!
846	IF(S_BDY)THEN
847	grid%upstrm=.TRUE.
848	JBPAD2=0
849	!
850	DO JJ=1,7
851	J=JJ ! -MY_JS_GLB+1
852	KNTI=0
853	DO I=MYIS_P2,MYIE_P2
854	grid%iup_h(IMS+KNTI,J)=I
855	grid%iup_v(IMS+KNTI,J)=I
856	KNTI=KNTI+1
857	ENDDO
858	grid%n_iup_h(J)=KNTI
859	grid%n_iup_v(J)=KNTI
860	ENDDO
861	!
862	DO JJ=3,5
863	J=JJ ! -MY_JS_GLB+1
864	KNTI=0
865	ISTART=MYIS1_P2
866	IEND=MYIE1_P2
867	IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
868	DO I=ISTART,IEND
869	grid%iup_adh(IMS+KNTI,J)=I
870	KNTI=KNTI+1
871	ENDDO
872	grid%n_iup_adh(J)=KNTI
873	!
874	KNTI=0
875	ISTART=MYIS1_P2
876	IEND=MYIE1_P2
877	IF(E_BDY)IEND=IEND-MOD(JJ,2)
878	DO I=ISTART,IEND
879	grid%iup_adv(IMS+KNTI,J)=I
880	KNTI=KNTI+1
881	ENDDO
882	grid%n_iup_adv(J)=KNTI
883	ENDDO
884	ENDIF
885	!
886	IF(N_BDY)THEN
887	grid%upstrm=.TRUE.
888	JTPAD2=0
889	!
890	DO JJ=JDE-7, JDE-1 ! JM-6,JM
891	J=JJ ! -MY_JS_GLB+1
892	KNTI=0
893	DO I=MYIS_P2,MYIE_P2
894	grid%iup_h(IMS+KNTI,J)=I
895	grid%iup_v(IMS+KNTI,J)=I
896	KNTI=KNTI+1
897	ENDDO
898	grid%n_iup_h(J)=KNTI
899	grid%n_iup_v(J)=KNTI
900	ENDDO
901	!
902	DO JJ=JDE-5, JDE-3 ! JM-4,JM-2
903	J=JJ ! -MY_JS_GLB+1
904	KNTI=0
905	ISTART=MYIS1_P2
906	IEND=MYIE1_P2
907	IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
908	DO I=ISTART,IEND
909	grid%iup_adh(IMS+KNTI,J)=I
910	KNTI=KNTI+1
911	ENDDO
912	grid%n_iup_adh(J)=KNTI
913	!
914	KNTI=0
915	ISTART=MYIS1_P2
916	IEND=MYIE1_P2
917	IF(E_BDY)IEND=IEND-MOD(JJ,2)
918	DO I=ISTART,IEND
919	grid%iup_adv(IMS+KNTI,J)=I
920	KNTI=KNTI+1
921	ENDDO
922	grid%n_iup_adv(J)=KNTI
923	ENDDO
924	ENDIF
925	!
926	IF(W_BDY)THEN
927	grid%upstrm=.TRUE.
928	ILPAD2=0
929	DO JJ=8,JDE-8 ! JM-7
930	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
931	J=JJ ! -MY_JS_GLB+1
932	!
933	DO I=1,4
934	grid%iup_h(IMS+I-1,J)=I
935	grid%iup_v(IMS+I-1,J)=I
936	ENDDO
937	grid%n_iup_h(J)=4
938	grid%n_iup_v(J)=4
939	ENDIF
940	ENDDO
941	!
942	DO JJ=6,JDE-6 ! JM-5
943	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
944	J=JJ ! -MY_JS_GLB+1
945	KNTI=0
946	IEND=2+MOD(JJ,2)
947	DO I=2,IEND
948	grid%iup_adh(IMS+KNTI,J)=I
949	KNTI=KNTI+1
950	ENDDO
951	grid%n_iup_adh(J)=KNTI
952	!
953	KNTI=0
954	IEND=2+MOD(JJ+1,2)
955	DO I=2,IEND
956	grid%iup_adv(IMS+KNTI,J)=I
957	KNTI=KNTI+1
958	ENDDO
959	grid%n_iup_adv(J)=KNTI
960	!
961	ENDIF
962	ENDDO
963	ENDIF
964	!
965	CALL WRF_GET_NPROCX(INPES)
966	!
967	IF(E_BDY)THEN
968	grid%upstrm=.TRUE.
969	IRPAD2=0
970	DO JJ=8,JDE-8 ! JM-7
971	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
972	J=JJ ! -MY_JS_GLB+1
973	IEND=IM-MOD(JJ+1,2)
974	ISTART=IEND-3
975	!
976	!*** IN CASE THERE IS ONLY A SINGLE GLOBAL TASK IN THE
977	!*** I DIRECTION THEN WE MUST ADD THE WESTSIDE UPSTREAM
978	!*** POINTS TO THE EASTSIDE POINTS IN EACH ROW.
979	!
980	KNTI=0
981	IF(INPES.EQ.1)KNTI=grid%n_iup_h(J)
982	!
983	DO II=ISTART,IEND
984	I=II ! -MY_IS_GLB+1
985	grid%iup_h(IMS+KNTI,J)=I
986	KNTI=KNTI+1
987	ENDDO
988	grid%n_iup_h(J)=KNTI
989	ENDIF
990	ENDDO
991	!
992	DO JJ=6,JDE-6 ! JM-5
993	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
994	J=JJ ! -MY_JS_GLB+1
995	IEND=IM-1-MOD(JJ+1,2)
996	ISTART=IEND-MOD(JJ,2)
997	KNTI=0
998	IF(INPES==1)KNTI=grid%n_iup_adh(J)
999	DO II=ISTART,IEND
1000	I=II ! -MY_IS_GLB+1
1001	grid%iup_adh(IMS+KNTI,J)=I
1002	KNTI=KNTI+1
1003	ENDDO
1004	grid%n_iup_adh(J)=KNTI
1005	ENDIF
1006	ENDDO
1007	!***
1008	DO JJ=8,JDE-8 ! JM-7
1009	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1010	J=JJ ! -MY_JS_GLB+1
1011	IEND=IM-MOD(JJ,2)
1012	ISTART=IEND-3
1013	KNTI=0
1014	IF(INPES==1)KNTI=grid%n_iup_v(J)
1015	!
1016	DO II=ISTART,IEND
1017	I=II ! -MY_IS_GLB+1
1018	grid%iup_v(IMS+KNTI,J)=I
1019	KNTI=KNTI+1
1020	ENDDO
1021	grid%n_iup_v(J)=KNTI
1022	ENDIF
1023	ENDDO
1024	!
1025	DO JJ=6,JDE-6 ! JM-5
1026	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1027	J=JJ ! -MY_JS_GLB+1
1028	IEND=IM-1-MOD(JJ,2)
1029	ISTART=IEND-MOD(JJ+1,2)
1030	KNTI=0
1031	IF(INPES==1)KNTI=grid%n_iup_adv(J)
1032	DO II=ISTART,IEND
1033	I=II ! -MY_IS_GLB+1
1034	grid%iup_adv(IMS+KNTI,J)=I
1035	KNTI=KNTI+1
1036	ENDDO
1037	grid%n_iup_adv(J)=KNTI
1038	ENDIF
1039	ENDDO
1040	ENDIF
1041	!----------------------------------------------------------------------
1042	jam=6+2*(JDE-JDS-1-9)
1043	!
1044	!*** EXTRACT em AND emt FOR THE LOCAL SUBDOMAINS
1045	!
1046	DO J=MYJS_P5,MYJE_P5
1047	grid%em_loc(J)=-9.E9
1048	grid%emt_loc(J)=-9.E9
1049	ENDDO
1050	!!! IF(IBROW==1)THEN
1051	IF(S_BDY)THEN
1052	DO J=3,5
1053	grid%em_loc(J)=grid%em(J-2)
1054	grid%emt_loc(J)=grid%emt(J-2)
1055	ENDDO
1056	ENDIF
1057	!!! IF(ITROW==1)THEN
1058	IF(N_BDY)THEN
1059	KNT=3
1060	DO JJ=JDE-5,JDE-3 ! JM-4,JM-2
1061	KNT=KNT+1
1062	J=JJ ! -MY_JS_GLB+1
1063	grid%em_loc(J)=grid%em(KNT)
1064	grid%emt_loc(J)=grid%emt(KNT)
1065	ENDDO
1066	ENDIF
1067	!!! IF(ILCOL==1)THEN
1068	IF(W_BDY)THEN
1069	KNT=6
1070	DO JJ=6,JDE-6 ! JM-5
1071	KNT=KNT+1
1072	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1073	J=JJ ! -MY_JS_GLB+1
1074	grid%em_loc(J)=grid%em(KNT)
1075	grid%emt_loc(J)=grid%emt(KNT)
1076	ENDIF
1077	ENDDO
1078	ENDIF
1079	!!! IF(IRCOL==1)THEN
1080	IF(E_BDY)THEN
1081	KNT=6+JDE-11 ! JM-10
1082	DO JJ=6,JDE-6 ! JM-5
1083	KNT=KNT+1
1084	IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1085	J=JJ ! -MY_JS_GLB+1
1086	grid%em_loc(J)=grid%em(KNT)
1087	grid%emt_loc(J)=grid%emt(KNT)
1088	ENDIF
1089	ENDDO
1090	ENDIF
1091	#else
1092	CALL wrf_message( 'start_domain_nmm: upstream advection commented out')
1093	#endif
1094	!
1095	!***
1096	!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
1097	!***
1098	#ifdef HWRF
1099	!zhang'sdoing IF(NSTART.EQ.0)THEN
1100	IF(NSTART.EQ.0 .or. .not.allowed_to_read )THEN
1101	!zhang's doing ends
1102	#else
1103	IF(NSTART.EQ.0)THEN
1104	#endif
1105	!
1106	GRID%NSOIL= GRID%NUM_SOIL_LAYERS
1107	DO J=JFS,JFE
1108	DO I=IFS,IFE
1109	grid%pctsno(I,J)=-999.0
1110	IF(grid%sm(I,J)<0.5)THEN
1111	grid%cmc(I,J)=0.0
1112	! grid%cmc(I,J)=grid%canwat(i,j) ! tgs
1113	IF(grid%sice(I,J)>0.5)THEN
1114	!***
1115	!*** SEA-ICE CASE
1116	!***
1117	grid%smstav(I,J)=1.0
1118	grid%smstot(I,J)=1.0
1119	grid%ssroff(I,J)=0.0
1120	grid%bgroff(I,J)=0.0
1121	grid%cmc(I,J)=0.0
1122	DO NS=1,GRID%NSOIL
1123	grid%smc(I,NS,J)=1.0
1124	! grid%sh2o(I,NS,J)=0.05
1125	grid%sh2o(I,NS,J)=1.0
1126	ENDDO
1127	ENDIF
1128	ELSE
1129	!***
1130	!*** WATER CASE
1131	!***
1132	grid%smstav(I,J)=1.0
1133	grid%smstot(I,J)=1.0
1134	grid%ssroff(I,J)=0.0
1135	grid%bgroff(I,J)=0.0
1136	grid%soiltb(I,J)=273.16
1137	grid%grnflx(I,J)=0.
1138	grid%subshx(I,J)=0.0
1139	grid%acsnow(I,J)=0.0
1140	grid%acsnom(I,J)=0.0
1141	grid%snopcx(I,J)=0.0
1142	grid%cmc(I,J)=0.0
1143	grid%sno(I,J)=0.0
1144	DO NS=1,GRID%NSOIL
1145	grid%smc(I,NS,J)=1.0
1146	grid%stc(I,NS,J)=273.16
1147	! grid%sh2o(I,NS,J)=0.05
1148	grid%sh2o(I,NS,J)=1.0
1149	ENDDO
1150	ENDIF
1151	!
1152	ENDDO
1153	ENDDO
1154	!
1155	grid%aphtim=0.0
1156	grid%aratim=0.0
1157	grid%acutim=0.0
1158	!
1159	ENDIF
1160	!
1161	!----------------------------------------------------------------------
1162	!*** INITIALIZE RADTN VARIABLES
1163	!*** CALCULATE THE NUMBER OF STEPS AT EACH POINT.
1164	!*** THE ARRAY 'lvl' WILL COORDINATE VERTICAL LOCATIONS BETWEEN
1165	!*** THE LIFTED WORKING ARRAYS AND THE FUNDAMENTAL MODEL ARRAYS.
1166	!*** lvl HOLDS THE HEIGHT (IN MODEL LAYERS) OF THE TOPOGRAPHY AT
1167	!*** EACH GRID POINT.
1168	!----------------------------------------------------------------------
1169	!
1170	DO J=JFS,JFE
1171	DO I=IFS,IFE
1172	grid%lvl(I,J)=LM-KTE
1173	ENDDO
1174	ENDDO
1175	!***
1176	!*** DETERMINE MODEL LAYER LIMITS FOR HIGH(3), MIDDLE(2),
1177	!*** AND LOW(1) CLOUDS. ALSO FIND MODEL LAYER THAT IS JUST BELOW
1178	!*** (HEIGHT-WISE) 400 MB. (K400)
1179	!***
1180	K400=0
1181	PSUM=grid%pt
1182	SLPM=101325.
1183	PDIF=SLPM-grid%pt
1184	DO K=1,LM
1185	PSUM=PSUM+grid%deta(K)*PDIF
1186	IF(LPTOP(3)==0)THEN
1187	IF(PSUM>PHITP)LPTOP(3)=K
1188	ELSEIF(LPTOP(2)==0)THEN
1189	IF(PSUM>PMDHI)LPTOP(2)=K
1190	ELSEIF(K400==0)THEN
1191	IF(PSUM>P400)K400=K
1192	ELSEIF(LPTOP(1)==0)THEN
1193	IF(PSUM>PLOMD)LPTOP(1)=K
1194	ENDIF
1195	ENDDO
1196	!***
1197	!*** CALL GRADFS ONCE TO CALC. CONSTANTS AND GET O3 DATA
1198	!***
1199	KCCO2=0
1200	!***
1201	!*** CALCULATE THE MIDLAYER PRESSURES IN THE STANDARD ATMOSPHERE
1202	!***
1203	PSS=101325.
1204	PDIF=PSS-grid%pt
1205	!
1206	ALLOCATE(PHALF(LM+1),STAT=I)
1207	!
1208	DO K=KPS,KPE-1
1209	PHALF(K+1)=grid%aeta(K)*PDIF+grid%pt
1210	ENDDO
1211
1212	!
1213	PHALF(1)=0.
1214	PHALF(LM+1)=PSS
1215	!***
1216	!!! CALL GRADFS(PHALF,KCCO2,NUNIT_CO2)
1217	!***
1218	!*** CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE
1219	!***
1220	!!! IF(MYPE==0)CALL SOLARD(SUN_DIST)
1221	!!! CALL MPI_BCAST(SUN_DIST,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
1222
1223	!***
1224	!*** CALL ZENITH SIMPLY TO GET THE DAY OF THE YEAR FOR
1225	!*** THE SETUP OF THE OZONE DATA
1226	!***
1227	TIME=(grid%ntsd-1)*GRID%DT
1228	!
1229	!!! CALL ZENITH(TIME,DAYI,HOUR)
1230	!
1231	ADDL=0.
1232	IF(MOD(IDAT(3),4)==0)ADDL=1.
1233	!
1234	!!! CALL O3CLIM
1235	!
1236	!
1237	DEALLOCATE(PHALF)
1238	!----------------------------------------------------------------------
1239	!*** SOME INITIAL VALUES RELATED TO TURBULENCE SCHEME
1240	!----------------------------------------------------------------------
1241	!
1242	IF(allowed_to_read.and.(.NOT.RESTRT))THEN ! This is gopal's inclusion for moving nest
1243
1244	DO J=JFS,JFE
1245	DO I=IFS,IFE
1246	!***
1247	!*** TRY A SIMPLE LINEAR INTERP TO GET 2/10 M VALUES
1248	!***
1249	#ifdef HWRF
1250	!zhang's doing
1251	IF(.NOT.RESTRT .OR. .NOT.allowed_to_read) then
1252	grid%PDSL(I,J)=grid%PD(I,J)*grid%RES(I,J)
1253	endif
1254	!end of zhang's doing
1255	#else
1256	grid%PDSL(I,J)=grid%PD(I,J)*grid%RES(I,J)
1257	#endif
1258	!
1259	ULM=grid%u(I,J,KTS)
1260	VLM=grid%v(I,J,KTS)
1261	TLM=grid%t(I,J,KTS)
1262	QLM=grid%q(I,J,KTS)
1263	PLM=grid%aeta1(KTS)grid%pdtop+grid%aeta2(KTS)grid%pdsl(I,J)+grid%pt
1264	APELM=(1.0E5/PLM)**CAPA
1265	TERM1=-0.068283/grid%t(I,J,KTS)
1266	grid%pshltr(I,J)=(grid%pd(I,J)+grid%pdtop+grid%pt)*EXP(TERM1)
1267	APELMNW=(1.0E5/grid%pshltr(I,J))**CAPA
1268	THLM=TLM*APELM
1269	DPLM=(grid%deta1(KTS)grid%pdtop+grid%deta2(KTS)grid%pdsl(I,J))*0.5
1270	DZLM=R_DDPLMTLM(1.+P608QLM)/(G*PLM)
1271	FAC1=10./DZLM
1272	FAC2=(DZLM-10.)/DZLM
1273	IF(DZLM<=10.)THEN
1274	FAC1=1.
1275	FAC2=0.
1276	ENDIF
1277	!
1278	#ifdef HWRF
1279	!zhang's doing
1280	IF(.NOT.RESTRT .OR. .NOT.allowed_to_read)THEN
1281	!end of zhang's doing
1282	#else
1283	IF(.NOT.RESTRT)THEN
1284	#endif
1285	grid%th10(I,J)=FAC2grid%ths(I,J)+FAC1THLM
1286	grid%q10(I,J)=FAC2grid%qsh(I,J)+FAC1QLM
1287	#ifdef HWRF
1288	IF(grid%sm(I,J).LT.0.5)THEN
1289	grid%u10(I,J)=ULM*(log(10./grid%z0(I,J))/log(DZLM/grid%z0(I,J))) ! this is all Qingfu's doing
1290	grid%v10(I,J)=VLM*(log(10./grid%z0(I,J))/log(DZLM/grid%z0(I,J)))
1291	ZOQING=1.944SQRT(grid%u10(I,J)grid%u10(I,J)+grid%v10(I,J)*grid%v10(I,J))
1292	IF(ZOQING.GT.60.)THEN
1293	grid%u10(I,J)=grid%u10(I,J)*(1.12-7.2/ZOQING)
1294	grid%v10(I,J)=grid%v10(I,J)*(1.12-7.2/ZOQING)
1295	ENDIF
1296	ELSE
1297	ZOQING=(0.074SQRT(ULMULM+VLMVLM)-0.58)1.0e-3
1298	ZOQING=MAX(ZOQING,grid%z0(I,J)) ! for winds greater than 12.5 m/s
1299	grid%u10(I,J)=ULM*(log(10./ZOQING))/log(DZLM/ZOQING) ! this is all Qingfu's doing
1300	grid%v10(I,J)=VLM*(log(10./ZOQING))/log(DZLM/ZOQING)
1301	ZOQING=1.944SQRT(grid%u10(I,J)grid%u10(I,J)+grid%v10(I,J)*grid%v10(I,J))
1302	IF(ZOQING.GT.60.)THEN
1303	grid%u10(I,J)=grid%u10(I,J)*(1.12-7.2/ZOQING)
1304	grid%v10(I,J)=grid%v10(I,J)*(1.12-7.2/ZOQING)
1305	END IF
1306	ENDIF
1307	#else
1308	grid%u10(I,J)=ULM
1309	grid%v10(I,J)=VLM
1310	#endif
1311	ENDIF
1312	!
1313	! FAC1=2./DZLM
1314	! FAC2=(DZLM-2.)/DZLM
1315	! IF(DZLM.LE.2.)THEN
1316	! FAC1=1.
1317	! FAC2=0.
1318	! ENDIF
1319	!
1320	IF(.NOT.RESTRT.OR.NEST)THEN
1321	!
1322	IF ( (THLM-grid%ths(I,J))>2.0) THEN ! weight differently in different scenarios
1323	FAC1=0.3
1324	FAC2=0.7
1325	ELSE
1326	FAC1=0.8
1327	FAC2=0.2
1328	ENDIF
1329
1330	#ifdef HWRF
1331	grid%tshltr(I,J)=0.2grid%ths(I,J)+0.8THLM
1332	grid%qshltr(I,J)=0.2grid%qsh(I,J)+0.8QLM
1333	#else
1334	grid%tshltr(I,J)=FAC2grid%ths(I,J)+FAC1THLM
1335	grid%qshltr(I,J)=FAC2grid%qsh(I,J)+FAC1QLM
1336	#endif
1337	ENDIF
1338	!***
1339	!*** NEED TO CONVERT TO THETA IF IS THE RESTART CASE
1340	!*** AS CHKOUT.f WILL CONVERT TO TEMPERATURE
1341	!***
1342	!EROGERS: COMMENT OUT IN WRF-NMM
1343	!***
1344	! IF(RESTRT)THEN
1345	! grid%tshltr(I,J)=grid%tshltr(I,J)*APELMNW
1346	! ENDIF
1347	ENDDO
1348	ENDDO
1349
1350	END IF ! IF(allowed_to_read)THEN
1351	!
1352	!----------------------------------------------------------------------
1353	!*** INITIALIZE TAU-1 VALUES FOR ADAMS-BASHFORTH
1354	!----------------------------------------------------------------------
1355	!
1356	#ifdef HWRF
1357	!zhang's doing
1358	IF(.NOT.RESTRT .OR. .NOT.allowed_to_read)THEN !zhang's doing
1359	#else
1360	IF(.NOT.RESTRT)THEN
1361	#endif
1362	DO K=KPS,KPE
1363	DO J=JFS,JFE
1364	DO I=ifs,ife
1365	grid%told(I,J,K)=grid%t(I,J,K) ! grid%t AT TAU-1
1366	grid%uold(I,J,K)=grid%u(I,J,K) ! grid%u AT TAU-1
1367	grid%vold(I,J,K)=grid%v(I,J,K) ! grid%v AT TAU-1
1368	ENDDO
1369	ENDDO
1370	ENDDO
1371	ENDIF
1372	!
1373	!----------------------------------------------------------------------
1374	!*** INITIALIZE NONHYDROSTATIC QUANTITIES
1375	!----------------------------------------------------------------------
1376	!
1377	!!!! SHOULD grid%dwdt BE REDEFINED IF RESTRT?
1378
1379	IF((.NOT.RESTRT.OR.NEST).AND. allowed_to_read)THEN ! This is gopal's inclusion for moving nest
1380	DO K=KPS,KPE
1381	DO J=JFS,JFE
1382	DO I=IFS,IFE
1383	grid%dwdt(I,J,K)=1.
1384	ENDDO
1385	ENDDO
1386	ENDDO
1387	ENDIF
1388	!***
1389	#ifdef HWRF
1390	IF(.NOT.RESTRT .OR. .NOT.allowed_to_read) THEN !zhang's doing
1391	#endif
1392	IF(GRID%SIGMA==1)THEN
1393	DO J=JFS,JFE
1394	DO I=IFS,IFE
1395	grid%pdsl(I,J)=grid%pd(I,J)
1396	ENDDO
1397	ENDDO
1398	ELSE
1399	DO J=JFS,JFE
1400	DO I=IFS,IFE
1401	grid%pdsl(I,J)=grid%res(I,J)*grid%pd(I,J)
1402	ENDDO
1403	ENDDO
1404	ENDIF
1405	#ifdef HWRF
1406	ENDIF !zhang's doing
1407	#endif
1408	!
1409	!***
1410	!
1411	!
1412	!!!! SHOULD pint,z,w BE REDEFINED IF RESTRT?
1413
1414	WRITE( wrf_err_message, * )' restrt=',restrt,' nest=',nest
1415	CALL wrf_debug( 0, TRIM(wrf_err_message) )
1416	WRITE( wrf_err_message, * )' grid%pdtop=',grid%pdtop,' grid%pt=',grid%pt
1417	CALL wrf_debug( 0, TRIM(wrf_err_message) )
1418	#ifdef HWRF
1419	!zhang's doing
1420	IF(.NOT.RESTRT.OR.NEST .OR. .NOT.allowed_to_read)THEN
1421	!end of zhang's doing
1422	#else
1423	IF(.NOT.RESTRT.OR.NEST)THEN
1424	#endif
1425	DO K=KPS,KPE
1426	DO J=JFS,JFE
1427	DO I=IFS,IFE
1428	grid%pint(I,J,K)=grid%eta1(K)grid%pdtop+grid%eta2(K)grid%pdsl(I,J)+grid%pt
1429	grid%z(I,J,K)=grid%pint(I,J,K)
1430	grid%w(I,J,K)=0.
1431	ENDDO
1432	ENDDO
1433	ENDDO
1434	ENDIF
1435	#ifdef HWRF
1436	!zhang's doing
1437	IF(.NOT.RESTRT.OR.NEST .OR. .NOT.allowed_to_read)THEN
1438	#endif
1439
1440	DO K=KTS,KTE-1
1441	DO J=JFS,JFE
1442	DO I=IFS,IFE
1443	grid%rtop(I,J,K)=(grid%q(I,J,K)P608-grid%cwm(I,J,K)+1.)grid%t(I,J,K)*R_D/ &
1444	((grid%pint(I,J,K+1)+grid%pint(I,J,K))*0.5)
1445	ENDDO
1446	ENDDO
1447	ENDDO
1448	#ifdef HWRF
1449	ENDIF !zhang
1450	#endif
1451
1452	#ifdef HWRFX
1453	! XUEJIN's doing
1454	! add to output MSLP at the initial time
1455	!
1456	! COMPUTATION OF MSLP ! This is gopal's doing
1457	!
1458
1459
1460	DO J=JFS,JFE
1461	DO I=IFS,IFE
1462	grid%Z(I,J,1)=grid%FIS(I,J)*GI
1463	ENDDO
1464	ENDDO
1465
1466	DO K=KPS,2
1467	DO J=JFS,JFE
1468	DO I=IFS,IFE
1469	APELP = (grid%PINT(I,J,K+1)+grid%PINT(I,J,K))
1470	RTOPP = TRGgrid%T(I,J,K)(1.0+grid%Q(I,J,K)*P608)/APELP
1471	DZ = RTOPP(grid%DETA1(K)grid%PDTOP+grid%DETA2(K)*grid%PD(I,J))
1472	grid%Z(I,J,K+1) = grid%Z(I,J,K) + DZ
1473	ENDDO
1474	ENDDO
1475	ENDDO
1476
1477	grid%MSLP=-9999.99
1478	DO J=JFS,JFE
1479	DO I=IFS,IFE
1480	SFCT = grid%T(I,J,1)(1.+D608grid%Q(I,J,1)) + LAPSR(grid%Z(I,J,1)+grid%Z(I,J,2))0.5
1481	A = LAPSR*grid%Z(I,J,1)/SFCT
1482	grid%MSLP(I,J) = grid%PINT(I,J,1)(1-A)*COEF2
1483	ENDDO
1484	ENDDO
1485
1486	! SET BACK Z AS IN ORIGINAL CODE
1487
1488	DO K=KPS,KPE
1489	DO J=JFS,JFE
1490	DO I=IFS,IFE
1491	grid%Z(I,J,K)=grid%PINT(I,J,K)
1492	ENDDO
1493	ENDDO
1494	ENDDO
1495
1496	#endif
1497
1498
1499	#ifndef NO_RESTRICT_ACCEL
1500	!----------------------------------------------------------------------
1501	!*** RESTRICTING THE ACCELERATION ALONG THE BOUNDARIES
1502	!----------------------------------------------------------------------
1503	!
1504	DO J=JFS,JFE
1505	DO I=IFS,IFE
1506	grid%dwdtmn(I,J)=-EPSIN
1507	grid%dwdtmx(I,J)= EPSIN
1508	ENDDO
1509	ENDDO
1510	!
1511	!***
1512	IF(JHL>1)THEN
1513	JHH=JDE-1-JHL+1 ! JM-JHL+1
1514	IHL=JHL/2+1
1515	!
1516	DO J=1,JHL
1517	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1518	JX=J ! -MY_JS_GLB+1
1519	DO I=1,IDE-1 ! IM
1520	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1521	IX=I ! -MY_IS_GLB+1
1522	grid%dwdtmn(IX,JX)=-EPSB
1523	grid%dwdtmx(IX,JX)= EPSB
1524	ENDIF
1525	ENDDO
1526	ENDIF
1527	ENDDO
1528	!
1529	DO J=JHH,JDE-1 ! JM
1530	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1531	JX=J ! -MY_JS_GLB+1
1532	DO I=1,IDE-1 ! IM
1533	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1534	IX=I ! -MY_IS_GLB+1
1535	grid%dwdtmn(IX,JX)=-EPSB
1536	grid%dwdtmx(IX,JX)= EPSB
1537	ENDIF
1538	ENDDO
1539	ENDIF
1540	ENDDO
1541	!
1542	DO J=1,JDE-1 ! JM
1543	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1544	JX=J ! -MY_JS_GLB+1
1545	DO I=1,IHL
1546	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1547	IX=I ! -MY_IS_GLB+1
1548	grid%dwdtmn(IX,JX)=-EPSB
1549	grid%dwdtmx(IX,JX)= EPSB
1550	ENDIF
1551	ENDDO
1552	ENDIF
1553	ENDDO
1554	!
1555	DO J=1,JDE-1 ! JM
1556	IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1557	JX=J ! -MY_JS_GLB+1
1558	! moved this line to inside the J-loop, 20030429, jm
1559	IHH=IDE-1-IHL+MOD(J,2) ! IM-IHL+MOD(J,2)
1560	DO I=IHH,IDE-1 ! IM
1561	IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1562	IX=I ! -MY_IS_GLB+1
1563	grid%dwdtmn(IX,JX)=-EPSB
1564	grid%dwdtmx(IX,JX)= EPSB
1565	ENDIF
1566	ENDDO
1567	ENDIF
1568	ENDDO
1569	!
1570	ENDIF
1571
1572	#else
1573	CALL wrf_message('start_domain_nmm: NO_RESTRICT_ACCEL')
1574	#endif
1575
1576	!-----------------------------------------------------------------------
1577	!*** CALL THE GENERAL PHYSICS INITIALIZATION
1578	!-----------------------------------------------------------------------
1579	!
1580
1581	ALLOCATE(SFULL(KMS:KME),STAT=I) ; SFULL = 0.
1582	ALLOCATE(SMID(KMS:KME),STAT=I) ; SMID = 0.
1583	ALLOCATE(EMISS(IMS:IME,JMS:JME),STAT=I) ; EMISS = 0.
1584	ALLOCATE(EMTEMP(IMS:IME,JMS:JME),STAT=I) ; EMTEMP = 0.
1585	ALLOCATE(GLW(IMS:IME,JMS:JME),STAT=I) ; GLW = 0.
1586	ALLOCATE(HFX(IMS:IME,JMS:JME),STAT=I) ; HFX = 0.
1587	ALLOCATE(LOWLYR(IMS:IME,JMS:JME),STAT=I) ; LOWLYR = 0.
1588	! ALLOCATE(grid%mavail(IMS:IME,JMS:JME),STAT=I) ; grid%mavail = 0.
1589	ALLOCATE(NCA(IMS:IME,JMS:JME),STAT=I) ; NCA = 0.
1590	ALLOCATE(QFX(IMS:IME,JMS:JME),STAT=I) ; QFX = 0.
1591	ALLOCATE(RAINBL(IMS:IME,JMS:JME),STAT=I) ; RAINBL = 0.
1592	ALLOCATE(RAINC(IMS:IME,JMS:JME),STAT=I) ; RAINC = 0.
1593	ALLOCATE(RAINNC(IMS:IME,JMS:JME),STAT=I) ; RAINNC = 0.
1594	ALLOCATE(RAINNCV(IMS:IME,JMS:JME),STAT=I) ; RAINNCV = 0.
1595	ALLOCATE(SNOWNC(IMS:IME,JMS:JME),STAT=I) ; SNOWNC = 0.
1596	ALLOCATE(SNOWNCV(IMS:IME,JMS:JME),STAT=I) ; SNOWNCV = 0.
1597	ALLOCATE(GRAUPELNC(IMS:IME,JMS:JME),STAT=I) ; GRAUPELNC = 0.
1598	ALLOCATE(GRAUPELNCV(IMS:IME,JMS:JME),STAT=I) ; GRAUPELNCV = 0.
1599
1600	ALLOCATE(ZS(KMS:KME),STAT=I) ; ZS = 0.
1601	ALLOCATE(SNOWC(IMS:IME,JMS:JME),STAT=I) ; SNOWC = 0.
1602	ALLOCATE(THC(IMS:IME,JMS:JME),STAT=I) ; THC = 0.
1603	ALLOCATE(TMN(IMS:IME,JMS:JME),STAT=I) ; TMN = 0.
1604	ALLOCATE(TSFC(IMS:IME,JMS:JME),STAT=I) ; TSFC = 0.
1605	ALLOCATE(Z0_DUM(IMS:IME,JMS:JME),STAT=I) ; Z0_DUM = 0.
1606	ALLOCATE(ALBEDO_DUM(IMS:IME,JMS:JME),STAT=I) ; ALBEDO_DUM = 0.
1607
1608	ALLOCATE(DZS(KMS:KME),STAT=I) ; DZS = 0.
1609	ALLOCATE(RQCBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCBLTEN = 0.
1610	ALLOCATE(RQIBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQIBLTEN = 0.
1611	ALLOCATE(RQVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVBLTEN = 0.
1612	ALLOCATE(RTHBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHBLTEN = 0.
1613	ALLOCATE(RUBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RUBLTEN = 0.
1614	ALLOCATE(RVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RVBLTEN = 0.
1615	ALLOCATE(RQCCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCCUTEN = 0.
1616	ALLOCATE(RQICUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQICUTEN = 0.
1617	ALLOCATE(RQRCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQRCUTEN = 0.
1618	ALLOCATE(RQSCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQSCUTEN = 0.
1619	ALLOCATE(RQVCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVCUTEN = 0.
1620	ALLOCATE(RTHCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHCUTEN = 0.
1621	ALLOCATE(RUSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RUSHTEN = 0.
1622	ALLOCATE(RVSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RVSHTEN = 0.
1623	ALLOCATE(RQCSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCSHTEN = 0.
1624	ALLOCATE(RQISHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQISHTEN = 0.
1625	ALLOCATE(RQRSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQRSHTEN = 0.
1626	ALLOCATE(RQSSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQSSHTEN = 0.
1627	ALLOCATE(RQGSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQGSHTEN = 0.
1628	ALLOCATE(RQVSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVSHTEN = 0.
1629	ALLOCATE(RTHSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHSHTEN = 0.
1630	ALLOCATE(RTHRATEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATEN = 0.
1631	ALLOCATE(RTHRATENLW(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATENLW = 0.
1632	ALLOCATE(RTHRATENSW(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATENSW = 0.
1633	ALLOCATE(ZINT(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; ZINT = 0.
1634	ALLOCATE(CONVFAC(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CONVFAC = 0.
1635	ALLOCATE(PINT_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; PINT_TRANS = 0.
1636	ALLOCATE(T_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; T_TRANS = 0.
1637	ALLOCATE(RRI(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RRI = 0.
1638	ALLOCATE(CLDFRA_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_TRANS = 0.
1639	#ifndef WRF_CHEM
1640	ALLOCATE(CLDFRA_OLD(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_OLD = 0.
1641	#endif
1642	#if 0
1643	ALLOCATE(w0avg(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; w0avg = 0.
1644	#endif
1645	!-----------------------------------------------------------------------
1646	!jm added set of g_inv
1647	G_INV=1./G
1648	ROG=R_D*G_INV
1649	GRID%RADT=GRID%NRADS*GRID%DT/60.
1650	GRID%BLDT=GRID%NPHS*GRID%DT/60.
1651	GRID%CUDT=GRID%NCNVC*GRID%DT/60.
1652	GRID%GSMDT=GRID%NPHS*GRID%DT/60.
1653	!
1654	DO J=MYJS,MYJE
1655	DO I=MYIS,MYIE
1656	SFCZ=grid%fis(I,J)*G_INV
1657	ZINT(I,KTS,J)=SFCZ
1658	#ifdef HWRF
1659	!zhang's doing
1660	IF(.NOT.RESTRT .OR. .NOT.allowed_to_read) then
1661	grid%PDSL(I,J)=grid%PD(I,J)*grid%RES(I,J)
1662	endif
1663	!end of zhang's doing
1664	#else
1665	grid%pdsl(I,J)=grid%pd(I,J)*grid%res(I,J)
1666	#endif
1667	PSURF=grid%pint(I,J,KTS)
1668	EXNSFC=(1.E5/PSURF)**CAPA
1669	grid%xland(I,J)=grid%sm(I,J)+1.
1670	THSIJ=(grid%sst(I,J)EXNSFC)(grid%xland(I,J)-1.) &
1671	& +grid%ths(I,J)*(2.-grid%sm(I,J))
1672	TSFC(I,J)=THSIJ/EXNSFC
1673	!
1674	DO K=KTS,KTE-1
1675	PLYR=(grid%pint(I,J,K)+grid%pint(I,J,K+1))*0.5
1676	TL=grid%t(I,J,K)
1677	CWML=grid%cwm(I,J,K)
1678	RRI(I,K,J)=R_DTL(1.+P608*grid%q(I,J,K))/PLYR
1679	ZINT(I,K+1,J)=ZINT(I,K,J)+TL/PLYR &
1680	(grid%deta1(K)grid%pdtop+grid%deta2(K)grid%pdsl(I,J))ROG &
1681	(grid%q(I,J,K)P608-CWML+1.)
1682	ENDDO
1683	!
1684	! DO K=KTS,KTE
1685	!!! ZMID(I,K,J)=0.5*(ZINT(I,K,J)+ZINT(I,K+1,J))
1686	! ENDDO
1687	ENDDO
1688	ENDDO
1689	!
1690	!-----------------------------------------------------------------------
1691	!*** RECREATE SIGMA VALUES AT LAYER INTERFACES FOR THE FULL VERTICAL
1692	!*** DOMAIN FROM THICKNESS VALUES FOR THE TWO SUBDOMAINS.
1693	!*** NOTE: KTE=NUMBER OF LAYERS PLUS ONE
1694	!-----------------------------------------------------------------------
1695	!
1696	PDTOT=101325.-grid%pt
1697	RPDTOT=1./PDTOT
1698	PDBOT=PDTOT-grid%pdtop
1699	SFULL(KTS)=1.
1700	SFULL(KTE)=0.
1701	DSIGSUM = 0.
1702	DO K=KTS+1,KTE
1703	DSIG=(grid%deta1(K-1)grid%pdtop+grid%deta2(K-1)PDBOT)*RPDTOT
1704	DSIGSUM=DSIGSUM+DSIG
1705	SFULL(K)=SFULL(K-1)-DSIG
1706	SMID(K-1)=0.5*(SFULL(K-1)+SFULL(K))
1707	ENDDO
1708	DSIG=(grid%deta1(KTE-1)grid%pdtop+grid%deta2(KTE-1)PDBOT)*RPDTOT
1709	DSIGSUM=DSIGSUM+DSIG
1710	SMID(KTE-1)=0.5*(SFULL(KTE-1)+SFULL(KTE))
1711	!
1712	!-----------------------------------------------------------------------
1713
1714	#ifdef HWRF
1715	!zhang's doing
1716	if(.NOT.RESTRT .OR. .NOT.allowed_to_read)grid%LU_INDEX=grid%IVGTYP
1717	!end of zhang's doing
1718	#else
1719	grid%lu_index=grid%ivgtyp
1720	#endif
1721
1722	IF(.NOT.RESTRT)THEN
1723	DO J=MYJS,MYJE
1724	DO I=MYIS,MYIE
1725	Z0_DUM(I,J)=grid%z0(I,J) ! hold
1726	ALBEDO_DUM(I,J)=grid%albedo(I,J) ! Save albedos
1727	ENDDO
1728	ENDDO
1729	ENDIF
1730	!
1731	!*** Always define the quantity grid%z0base
1732
1733	IF(.NOT.RESTRT)THEN
1734	DO J=MYJS,MYJE
1735	DO I=MYIS,MYIE
1736	!
1737	IF(grid%sm(I,J)==0)then
1738	grid%z0base(I,J)=VZ0TBL_24(grid%ivgtyp(I,J))+Z0LAND
1739	ELSE
1740	grid%z0base(I,J)=VZ0TBL_24(grid%ivgtyp(I,J))+Z0SEA
1741	ENDIF
1742	!
1743	ENDDO
1744	ENDDO
1745	ENDIF
1746	!
1747	! when allocating CAM radiation 4d arrays (ozmixm, aerosolc) these are not needed
1748	num_ozmixm=1
1749	num_aerosolc=1
1750
1751	! Set GMT, JULDAY, and JULYR outside of phy_init because it is no longer
1752	! called inside phy_init due to moving nest changes. (When nests move
1753	! phy_init may not be called on a process if, for example, it is a moving
1754	! nest and if this part of the domain is not being initialized (not the
1755	! leading edge).) Calling domain_setgmtetc() here will avoid this problem
1756	! when NMM moves to moving nests.
1757	CALL domain_setgmtetc( GRID, START_OF_SIMULATION )
1758
1759	if(restrt) then
1760	#ifdef HWRF
1761	!zhang
1762	CALL nl_get_julyr (grid%id, grid%julyr)
1763	CALL nl_get_julday (grid%id, grid%julday)
1764	CALL nl_get_gmt (grid%id, grid%gmt)
1765	!zhang end
1766	#else
1767	CALL domain_clock_get( grid, current_time=currentTime )
1768	CALL WRFU_TimeGet( currentTime, YY=grid%julyr, dayOfYear=grid%julday, &
1769	H=hr, M=mn, S=sec, MS=ms, rc=rc)
1770	grid%gmt=hr+real(mn)/60.+real(sec)/3600.+real(ms)/(1000*3600)
1771	WRITE( wrf_err_message , * ) 'DEBUG start_domain_nmm(): gmt = ',grid%gmt
1772	CALL wrf_debug( 150, TRIM(wrf_err_message) )
1773	#endif
1774	endif
1775
1776	! Several arguments are RCONFIG entries in Registry.NMM. Registry no longer
1777	! includes these as dummy arguments or declares them. Access them from
1778	! GRID. JM 20050819
1779	#ifndef WRF_NMM_NEST
1780	grid%moved = .FALSE.
1781	#endif
1782
1783	IF (GRID%RESTART) THEN
1784	LRESTART = GRID%RESTART
1785	ELSE
1786	IF (grid%moved) THEN
1787	LRESTART = .TRUE.
1788	ELSE
1789	LRESTART = .FALSE.
1790	ENDIF
1791	END IF
1792
1793	CALL PHY_INIT(GRID%ID,CONFIG_FLAGS,GRID%DT,LRESTART,SFULL,SMID &
1794	& ,grid%pt,TSFC,GRID%RADT,GRID%BLDT,GRID%CUDT,GRID%GSMDT &
1795	& ,grid%DUCUDT, grid%DVCUDT &
1796	& ,RTHCUTEN, RQVCUTEN, RQRCUTEN &
1797	& ,RQCCUTEN, RQSCUTEN, RQICUTEN &
1798	& ,RUSHTEN, RVSHTEN, RTHSHTEN &
1799	& ,RQVSHTEN, RQRSHTEN, RQCSHTEN &
1800	& ,RQSSHTEN, RQISHTEN, RQGSHTEN &
1801	& ,RUBLTEN,RVBLTEN,RTHBLTEN &
1802	& ,RQVBLTEN,RQCBLTEN,RQIBLTEN &
1803	& ,RTHRATEN,RTHRATENLW,RTHRATENSW &
1804	& ,STEPBL,STEPRA,STEPCU &
1805	& ,grid%w0avg, RAINNC, RAINC, grid%raincv, RAINNCV &
1806	& ,SNOWNC, SNOWNCV, GRAUPELNC, GRAUPELNCV &
1807	& ,NCA,GRID%SWRAD_SCAT &
1808	& ,grid%cldefi,LOWLYR &
1809	& ,grid%mass_flux &
1810	& ,grid%rthften, grid%rqvften &
1811	& ,CLDFRA_TRANS,CLDFRA_OLD,GLW,grid%gsw,EMISS,EMTEMP,grid%lu_index&
1812	& ,GRID%LANDUSE_ISICE, GRID%LANDUSE_LUCATS &
1813	& ,GRID%LANDUSE_LUSEAS, GRID%LANDUSE_ISN &
1814	& ,GRID%LU_STATE &
1815	& ,grid%xlat,grid%xlong,grid%albedo,grid%albbck &
1816	& ,GRID%GMT,GRID%JULYR,GRID%JULDAY &
1817	& ,GRID%LEVSIZ, NUM_OZMIXM, NUM_AEROSOLC, GRID%PAERLEV &
1818	& ,TMN,grid%xland,grid%znt,grid%z0,grid%ustar,grid%mol,grid%pblh,grid%tke_pbl &
1819	& ,grid%exch_h,THC,SNOWC,grid%mavail,HFX,QFX,RAINBL &
1820	& ,grid%stc,ZS,DZS,GRID%NUM_SOIL_LAYERS,WARM_RAIN &
1821	& ,ADV_MOIST_COND &
1822	& ,grid%apr_gr,grid%apr_w,grid%apr_mc,grid%apr_st,grid%apr_as &
1823	& ,grid%apr_capma,grid%apr_capme,grid%apr_capmi &
1824	& ,grid%xice,grid%xice,grid%vegfra,grid%snow,grid%canwat,grid%smstav &
1825	& ,grid%smstot, grid%sfcrunoff,grid%udrunoff,grid%grdflx,grid%acsnow &
1826	& ,grid%acsnom,grid%ivgtyp,grid%isltyp,grid%sfcevp,grid%smc &
1827	& ,grid%sh2o, grid%snowh, grid%smfr3d & ! temporary
1828	& ,grid%SNOALB &
1829	& ,GRID%DX,GRID%DY,grid%f_ice_phy,grid%f_rain_phy,grid%f_rimef_phy &
1830	& ,grid%mp_restart_state,grid%tbpvs_state,grid%tbpvs0_state &
1831	& ,.TRUE.,grid%moved,START_OF_SIMULATION &
1832	& ,1 & ! lagday
1833	& ,IDS, IDE, JDS, JDE, KDS, KDE &
1834	& ,IMS, IME, JMS, JME, KMS, KME &
1835	& ,ITS, ITE, JTS, JTE, KTS, KTE &
1836	& ,NUM_URBAN_LAYERS &
1837	& )
1838
1839	#ifdef HWRF
1840	!zhang's doing
1841	grid%julyr_rst=grid%julyr_rst
1842	grid%julday_rst=grid%julday_rst
1843	grid%gmt_rst=grid%gmt_rst
1844	!end of zhang's doing
1845	#endif
1846	!-----------------------------------------------------------------------
1847	!---- Initialization for gravity wave drag (GWD) & mountain blocking (MB)
1848	!
1849	CALL nl_get_cen_lat(GRID%ID, CEN_LAT) !-- CEN_LAT in deg
1850	CALL nl_get_cen_lon(GRID%ID, CEN_LON) !-- CEN_LON in deg
1851	DTPHS=grid%dt*grid%nphs
1852	CALL GWD_init(DTPHS,GRID%DX,GRID%DY,CEN_LAT,CEN_LON,RESTRT &
1853	& ,grid%glat,grid%glon,grid%crot,grid%srot,grid%hangl &
1854	& ,IDS,IDE,JDS,JDE,KDS,KDE &
1855	& ,IMS,IME,JMS,JME,KMS,KME &
1856	& ,ITS,ITE,JTS,JTE,KTS,KTE )
1857	IF(.NOT.RESTRT)THEN
1858	DO J=MYJS,MYJE
1859	DO I=MYIS,MYIE
1860	grid%ugwdsfc(I,J)=0.
1861	grid%vgwdsfc(I,J)=0.
1862	ENDDO
1863	ENDDO
1864	ENDIF
1865
1866	!-----------------------------------------------------------------------
1867	!
1868	#ifdef HWRF
1869	IF(NSTART.EQ.0 .or. .not.allowed_to_read )THEN
1870	#else
1871	IF(NSTART==0)THEN
1872	#endif
1873
1874	DO J=JMS,JME
1875	DO I=IMS,IME
1876	grid%z0(I,J)=grid%z0base(I,J)
1877	ENDDO
1878	ENDDO
1879
1880	DO K=KMS,KME
1881	DO J=JMS,JME
1882	DO I=IMS,IME
1883	grid%cldfra(I,J,K)=CLDFRA_TRANS(I,K,J)
1884	ENDDO
1885	ENDDO
1886	ENDDO
1887
1888	ENDIF
1889
1890	!
1891	!
1892	!mp replace F*_PHY with values defined in module_initialize_real.F?
1893	#ifdef HWRF
1894	IF (.NOT. RESTRT) THEN !zhang
1895	moist = 0.0
1896	grid%f_ice = grid%f_ice_phy
1897	grid%f_rimef = grid%f_rimef_phy
1898	grid%f_rain = grid%f_rain_phy
1899	ENDIF !zhang
1900	#endif
1901
1902	IF (.NOT. RESTRT) THEN
1903	! Added by Greg Thompson, NCAR-RAL, for initializing water vapor
1904	! mixing ratio (from NMM's specific humidity var) into moist array.
1905
1906	!!mp
1907	CALL wrf_message('Initializng moist(:,:,:, Qv) from q')
1908	DO K=KPS,KPE
1909	DO J=JFS,JFE
1910	DO I=IFS,IFE
1911	moist(I,J,K,P_QV) = grid%q(I,J,K) / (1.-grid%q(I,J,K))
1912	enddo
1913	enddo
1914	enddo
1915
1916	! Also sum cloud water, ice, rain, snow, graupel into Ferrier cwm
1917	! array (if any hydrometeors found and non-zero from initialization
1918	! package). Then, determine fractions ice and rain from species.
1919
1920	IF (.not. (MAXVAL(grid%cwm).gt.0. .and. MAXVAL(grid%cwm).lt.1.) ) then
1921	do i_m = 2, num_moist
1922	if (i_m.ne.p_qv) &
1923	& CALL wrf_message(' summing moist(:,:,:,i_m) into cwm array')
1924	DO K=KPS,KPE
1925	DO J=JFS,JFE
1926	DO I=IFS,IFE
1927	IF ( (moist(I,J,K,i_m).gt.EPSQ) .and. (i_m.ne.p_qv) ) THEN
1928	grid%cwm(I,J,K) = grid%cwm(I,J,K) + moist(I,J,K,i_m)
1929	ENDIF
1930	enddo
1931	enddo
1932	enddo
1933	enddo
1934
1935	IF (.not. ( (maxval(grid%f_ice)+maxval(grid%f_rain)) .gt. EPSQ) ) THEN
1936	CALL wrf_message(' computing grid%f_ice')
1937	do i_m = 2, num_moist
1938	DO J=JFS,JFE
1939	DO K=KPS,KPE
1940	DO I=IFS,IFE
1941	IF ( (moist(I,J,K,i_m).gt.EPSQ) .and. &
1942	& ( (i_m.eq.p_qi).or.(i_m.eq.p_qs).or.(i_m.eq.p_qg) ) ) THEN
1943	grid%f_ice(I,K,J) = grid%f_ice(I,K,J) + moist(I,J,K,i_m)
1944	ENDIF
1945	if (model_config_rec%mp_physics(grid%id).EQ.ETAMPNEW) then
1946	if ((i_m.eq.p_qi).or.(i_m.eq.p_qg) ) then
1947	moist(I,J,K,p_qs)=moist(I,J,K,p_qs)+moist(I,J,K,i_m)
1948	moist(I,J,K,i_m) =0.
1949	endif
1950	endif
1951	enddo
1952	enddo
1953	enddo
1954	enddo
1955	CALL wrf_message(' computing f_rain')
1956	!
1957	DO J=JFS,JFE
1958	DO K=KPS,KPE
1959	DO I=IFS,IFE
1960	IF(grid%f_ice(i,k,j)<=EPSQ)THEN
1961	grid%f_ice(I,K,J)=0.
1962	ELSE
1963	grid%f_ice(I,K,J) = grid%f_ice(I,K,J)/grid%cwm(I,J,K)
1964	ENDIF
1965	IF ( (moist(I,J,K,p_qr)+moist(I,J,K,p_qc)).gt.EPSQ) THEN
1966	IF(moist(i,j,k,p_qr)<=EPSQ)THEN
1967	grid%f_rain(I,K,J)=0.
1968	ELSE
1969	grid%f_rain(I,K,J) = moist(i,j,k,p_qr) &
1970	& / (moist(i,j,k,p_qr)+moist(i,j,k,p_qc))
1971	ENDIF
1972	ENDIF
1973	enddo
1974	enddo
1975	enddo
1976	ENDIF
1977	ENDIF
1978	! End addition by Greg Thompson
1979
1980	IF (maxval(grid%f_ice) .gt. 0.) THEN
1981	do J=JMS,JME
1982	do K=KMS,KME
1983	do I=IMS,IME
1984	grid%f_ice_phy(I,K,J)=grid%f_ice(I,K,J)
1985	enddo
1986	enddo
1987	enddo
1988	ENDIF
1989
1990	IF (maxval(grid%f_rain) .gt. 0.) THEN
1991	do J=JMS,JME
1992	do K=KMS,KME
1993	do I=IMS,IME
1994	grid%f_rain_phy(I,K,J)=grid%f_rain(I,K,J)
1995	enddo
1996	enddo
1997	enddo
1998	ENDIF
1999
2000	IF (maxval(grid%f_rimef) .gt. 0.) THEN
2001	do J=JMS,JME
2002	do K=KMS,KME
2003	do I=IMS,IME
2004	grid%f_rimef_phy(I,K,J)=grid%f_rimef(I,K,J)
2005	enddo
2006	enddo
2007	enddo
2008	ENDIF
2009	ENDIF
2010	!
2011	IF (.NOT. RESTRT) THEN
2012	!-- Replace albedos if original albedos are nonzero
2013	IF(MAXVAL(ALBEDO_DUM)>0.)THEN
2014	DO J=JMS,JME
2015	DO I=IMS,IME
2016	grid%albedo(I,J)=ALBEDO_DUM(I,J)
2017	ENDDO
2018	ENDDO
2019	ENDIF
2020	ENDIF
2021
2022	#ifdef HWRF
2023	if(.NOT. RESTRT .OR. .NOT.allowed_to_read) then !zhang's doing
2024	!zhang's doing
2025	#else
2026	IF(.NOT.RESTRT)THEN
2027	#endif
2028	DO J=JMS,JME
2029	DO I=IMS,IME
2030	grid%aprec(I,J)=RAINNC(I,J)*1.E-3
2031	grid%cuprec(I,J)=grid%raincv(I,J)*1.E-3
2032	ENDDO
2033	ENDDO
2034	ENDIF
2035	!following will need mods Sep06
2036	!
2037	#ifdef WRF_CHEM
2038	DO J=JTS,JTE
2039	JJ=MIN(JDE-1,J)
2040	DO K=KTS,KTE-1
2041	KK=MIN(KDE-1,K)
2042	DO I=ITS,ITE
2043	II=MIN(IDE-1,I)
2044	CONVFAC(I,K,J) = grid%pint(II,JJ,KK)/RGASUNIV/grid%t(II,JJ,KK)
2045	ENDDO
2046	ENDDO
2047	ENDDO
2048
2049	DO J=JMS,JME
2050	DO K=KMS,KME
2051	DO I=IMS,IME
2052	PINT_TRANS(I,K,J)=grid%pint(I,J,K)
2053	T_TRANS(I,K,J)=grid%t(I,J,K)
2054	ENDDO
2055	ENDDO
2056	ENDDO
2057	DO J=JMS,JME
2058	DO I=IMS,IME
2059	grid%xlat(i,j)=grid%glat(I,J)/DEGRAD
2060	grid%xlong(I,J)=grid%glon(I,J)/DEGRAD
2061
2062	ENDDO
2063	ENDDO
2064	!!! write(0,*)'now do chem_init'
2065	CALL CHEM_INIT (GRID%ID,CHEM,EMIS_ANT,scalar,GRID%DT,GRID%BIOEMDT,GRID%PHOTDT,GRID%CHEMDT, &
2066	STEPBIOE,STEPPHOT,STEPCHEM,STEPFIREPL,GRID%PLUMERISEFIRE_FRQ, &
2067	ZINT,grid%xlat,grid%xlong,G,AERWRF,CONFIG_FLAGS,grid, &
2068	RRI,T_TRANS,PINT_TRANS,CONVFAC, &
2069	grid%ttday,grid%tcosz,grid%julday,grid%gmt, &
2070	GD_CLOUD,GD_CLOUD2,raincv_a,raincv_b, &
2071	GD_CLOUD_a,GD_CLOUD2_a, &
2072	GD_CLOUD_B,GD_CLOUD2_B, &
2073	TAUAER1,TAUAER2,TAUAER3,TAUAER4, &
2074	GAER1,GAER2,GAER3,GAER4, &
2075	WAER1,WAER2,WAER3,WAER4, &
2076	l2AER,l3AER,l4AER,l5AER,l6aer,l7aer, &
2077	PM2_5_DRY,PM2_5_WATER,PM2_5_DRY_EC, &
2078	grid%last_chem_time_year,grid%last_chem_time_month, &
2079	grid%last_chem_time_day,grid%last_chem_time_hour, &
2080	grid%last_chem_time_minute,grid%last_chem_time_second, &
2081	GRID%CHEM_IN_OPT, &
2082	GRID%KEMIT, &
2083	IDS , IDE , JDS , JDE , KDS , KDE , &
2084	IMS , IME , JMS , JME , KMS , KME , &
2085	ITS , ITE , JTS , JTE , KTS , KTE )
2086
2087	!
2088	! calculate initial pm
2089	!
2090	SELECT CASE (CONFIG_FLAGS%CHEM_OPT)
2091	case (GOCART_SIMPLE,GOCARTRACM_KPP,GOCARTRADM2,GOCARTRADM2_KPP)
2092	call sum_pm_gocart ( &
2093	RRI, CHEM, PM2_5_DRY, PM2_5_DRY_EC, PM10, &
2094	IDS,IDE, JDS,JDE, KDS,KDE, &
2095	IMS,IME, JMS,JME, KMS,KME, &
2096	ITS,ITE, JTS,JTE, KTS,KTE-1 )
2097	CASE (RADM2SORG,RADM2SORG_AQ,RADM2SORG_KPP,RACMSORG_AQ,RACMSORG_KPP)
2098	!!! write(0,*)'sum pm '
2099	CALL SUM_PM_SORGAM ( &
2100	RRI, CHEM, H2OAJ, H2OAI, &
2101	PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC, PM10, &
2102	IDS,IDE, JDS,JDE, KDS,KDE, &
2103	IMS,IME, JMS,JME, KMS,KME, &
2104	ITS,ITE, JTS,JTE, KTS,KTE-1 )
2105
2106	CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
2107	CALL SUM_PM_MOSAIC ( &
2108	RRI, CHEM, &
2109	PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC, PM10, &
2110	IDS,IDE, JDS,JDE, KDS,KDE, &
2111	IMS,IME, JMS,JME, KMS,KME, &
2112	ITS,ITE, JTS,JTE, KTS,KTE-1 )
2113
2114	CASE DEFAULT
2115	DO J=JTS,MIN(JTE,JDE-1)
2116	DO K=KTS,MIN(KTE,KDE-1)
2117	DO I=ITS,MIN(ITE,IDE-1)
2118	PM2_5_DRY(I,K,J) = 0.
2119	PM2_5_WATER(I,K,J) = 0.
2120	PM2_5_DRY_EC(I,K,J) = 0.
2121	PM10(I,K,J) = 0.
2122	ENDDO
2123	ENDDO
2124	ENDDO
2125	END SELECT
2126	#endif
2127	DEALLOCATE(SFULL)
2128	DEALLOCATE(SMID)
2129	DEALLOCATE(DZS)
2130	DEALLOCATE(EMISS)
2131	DEALLOCATE(EMTEMP)
2132	DEALLOCATE(GLW)
2133	DEALLOCATE(HFX)
2134	DEALLOCATE(LOWLYR)
2135	! DEALLOCATE(grid%mavail)
2136	DEALLOCATE(NCA)
2137	DEALLOCATE(QFX)
2138	DEALLOCATE(RAINBL)
2139	DEALLOCATE(RAINC)
2140	DEALLOCATE(RAINNC)
2141	DEALLOCATE(RAINNCV)
2142	DEALLOCATE(RQCBLTEN)
2143	DEALLOCATE(RQIBLTEN)
2144	DEALLOCATE(RQVBLTEN)
2145	DEALLOCATE(RTHBLTEN)
2146	DEALLOCATE(RUBLTEN)
2147	DEALLOCATE(RVBLTEN)
2148	DEALLOCATE(RQCCUTEN)
2149	DEALLOCATE(RQICUTEN)
2150	DEALLOCATE(RQRCUTEN)
2151	DEALLOCATE(RQSCUTEN)
2152	DEALLOCATE(RQVCUTEN)
2153	DEALLOCATE(RTHCUTEN)
2154	DEALLOCATE(RUSHTEN)
2155	DEALLOCATE(RVSHTEN)
2156	DEALLOCATE(RQCSHTEN)
2157	DEALLOCATE(RQISHTEN)
2158	DEALLOCATE(RQRSHTEN)
2159	DEALLOCATE(RQSSHTEN)
2160	DEALLOCATE(RQGSHTEN)
2161	DEALLOCATE(RQVSHTEN)
2162	DEALLOCATE(RTHSHTEN)
2163	DEALLOCATE(RTHRATEN)
2164	DEALLOCATE(RTHRATENLW)
2165	DEALLOCATE(RTHRATENSW)
2166	DEALLOCATE(ZINT)
2167	DEALLOCATE(CONVFAC)
2168	DEALLOCATE(RRI)
2169	DEALLOCATE(SNOWC)
2170	DEALLOCATE(THC)
2171	DEALLOCATE(TMN)
2172	DEALLOCATE(TSFC)
2173	DEALLOCATE(ZS)
2174	DEALLOCATE(PINT_TRANS)
2175	DEALLOCATE(T_TRANS)
2176	DEALLOCATE(CLDFRA_TRANS)
2177	#ifndef WRF_CHEM
2178	DEALLOCATE(CLDFRA_OLD)
2179	#endif
2180	#if 0
2181	DEALLOCATE(w0avg)
2182	#endif
2183	!-----------------------------------------------------------------------
2184	!----------------------------------------------------------------------
2185	DO J=jfs,jfe
2186	DO I=ifs,ife
2187	grid%dwdtmn(I,J)=grid%dwdtmn(I,J)*grid%hbm3(I,J)
2188	grid%dwdtmx(I,J)=grid%dwdtmx(I,J)*grid%hbm3(I,J)
2189	ENDDO
2190	ENDDO
2191	!----------------------------------------------------------------------
2192
2193	#ifdef DM_PARALLEL
2194	# include <HALO_NMM_INIT_1.inc>
2195	# include <HALO_NMM_INIT_2.inc>
2196	# include <HALO_NMM_INIT_3.inc>
2197	# include <HALO_NMM_INIT_4.inc>
2198	# include <HALO_NMM_INIT_5.inc>
2199	# include <HALO_NMM_INIT_6.inc>
2200	# include <HALO_NMM_INIT_7.inc>
2201	# include <HALO_NMM_INIT_8.inc>
2202	# include <HALO_NMM_INIT_9.inc>
2203	# include <HALO_NMM_INIT_10.inc>
2204	# include <HALO_NMM_INIT_11.inc>
2205	# include <HALO_NMM_INIT_12.inc>
2206	# include <HALO_NMM_INIT_13.inc>
2207	# include <HALO_NMM_INIT_14.inc>
2208	# include <HALO_NMM_INIT_15.inc>
2209	# include <HALO_NMM_INIT_15B.inc>
2210	# include <HALO_NMM_INIT_16.inc>
2211	# include <HALO_NMM_INIT_17.inc>
2212	# include <HALO_NMM_INIT_18.inc>
2213	# include <HALO_NMM_INIT_19.inc>
2214	# include <HALO_NMM_INIT_20.inc>
2215	# include <HALO_NMM_INIT_21.inc>
2216	# include <HALO_NMM_INIT_22.inc>
2217	# include <HALO_NMM_INIT_23.inc>
2218	# include <HALO_NMM_INIT_24.inc>
2219	# include <HALO_NMM_INIT_25.inc>
2220	# include <HALO_NMM_INIT_26.inc>
2221	# include <HALO_NMM_INIT_27.inc>
2222	# include <HALO_NMM_INIT_28.inc>
2223	# include <HALO_NMM_INIT_29.inc>
2224	# include <HALO_NMM_INIT_30.inc>
2225	# include <HALO_NMM_INIT_31.inc>
2226	# include <HALO_NMM_INIT_32.inc>
2227	# include <HALO_NMM_INIT_33.inc>
2228	# include <HALO_NMM_INIT_34.inc>
2229	# include <HALO_NMM_INIT_35.inc>
2230	# include <HALO_NMM_INIT_36.inc>
2231	# include <HALO_NMM_INIT_37.inc>
2232	# include <HALO_NMM_INIT_38.inc>
2233	# include <HALO_NMM_INIT_39.inc>
2234	#endif
2235	!#define COPY_OUT
2236	!#include <scalar_derefs.inc>
2237
2238	RETURN
2239
2240
2241	END SUBROUTINE START_DOMAIN_NMM
2242

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

Download in other formats:

Original Format