Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

start_domain_nmm.F @ 3553

Last change on this file since 3553 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 56.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_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