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