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 ! 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/PSFCK*EXP(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)*EPS*ESE/(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)=AVGEFI*SM(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_D*DPLM*TLM*(1.+P608*QLM)/(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)=FAC2*THS(I,J)+FAC1*THLM
1271 Q10(I,J)=FAC2*QSH(I,J)+FAC1*QLM
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)=FAC2*THS(I,J)+FAC1*THLM
1294 ! TSHLTR(I,J)=0.2*THS(I,J)+0.8*THLM
1295 QSHLTR(I,J)=FAC2*QSH(I,J)+FAC1*QLM
1296 ! QSHLTR(I,J)=0.2*QSH(I,J)+0.8*QLM
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_d*tl*(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