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