Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

start_domain_nmm.F @ 3094

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

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

Download in other formats:

Original Format