| blob | 4dc1d1122504bf8ea08879858a8381b2914b74a4 |
1 !#define NO_RESTRICT_ACCEL
2 !#define NO_GFDLETAINIT
3 !#define NO_UPSTREAM_ADVECTION
4 !----------------------------------------------------------------------
5 !
6 #ifdef HWRF
7 SUBROUTINE GUESS_COUPLING_TIMESTEP(gridid,DTC)
8 USE module_configure
9 implicit none
10 real, intent(out) :: DTC
11 integer, intent(in) :: gridid
12 type(grid_config_rec_type) :: config_flags
13 character*255 :: message
15 real :: dt
16 integer :: nphs,movemin
17 if(model_config_rec%max_dom>=2) then
18 ! Normally, in an HWRF simulation, domain 2 has
19 ! dt*nphs*movemin = coupling timestep
20 ! So if there is a domain 2, we'll use that to
21 ! guess the coupling timestep.
22 if(gridid==1) then
23 ! The first time this routine is called, it is for domain 1,
24 ! and domain 2 has not been created yet. That means domain
25 ! 2 still has its dt set to the internal WRF default of 2.
26 ! To get domain 2's correct dt, we get domain 1's dt and
27 ! divide by 3
28 call wrf_message('Guessing coupling timestep from d01''s dt/3 and d02''s nphs and movemin...')
29 call model_to_grid_config_rec(1,model_config_rec,config_flags)
30 dt=config_flags%dt/3
31 call model_to_grid_config_rec(2,model_config_rec,config_flags)
32 else
33 call wrf_message('Guessing coupling timestep from d02 settings...')
34 call model_to_grid_config_rec(2,model_config_rec,config_flags)
35 dt=config_flags%dt
36 endif
37 else
38 ! Someone is doing a single domain run, so guess the
39 ! coupling timestep using the
40 call wrf_message('Guessing coupling timestep from d01 settings because there is no d02...')
41 call model_to_grid_config_rec(1,model_config_rec,config_flags)
42 endif
43 nphs=config_flags%nphs
44 movemin=config_flags%movemin
46 dtc = dt*nphs*movemin
47 388 format("dtc=dt*nphs*movemin = ",F0.3,"=",F0.3,"*",I0,"*",I0)
48 write(message,388) dtc,dt,nphs,movemin
49 call wrf_message(message)
50 END SUBROUTINE GUESS_COUPLING_TIMESTEP
51 #endif
52 !
53 !----------------------------------------------------------------------
54 !
55 !----------------------------------------------------------------------
56 !
57 SUBROUTINE START_DOMAIN_NMM(GRID, allowed_to_read &
58 !
59 #include <dummy_new_args.inc>
60 !
61 & )
62 !----------------------------------------------------------------------
63 !
64 USE MODULE_TIMING
65 #ifdef HWRF
66 USE MODULE_HIFREQ, only : hifreq_open
67 #endif
68 USE MODULE_DOMAIN
69 USE MODULE_RANDOM, only : srand_grid, rand_grid_r4
70 USE MODULE_DRIVER_CONSTANTS
71 USE module_model_constants
72 USE MODULE_CONFIGURE
73 USE MODULE_WRF_ERROR
74 USE MODULE_MPP
75 USE MODULE_CTLBLK
76 #ifdef DM_PARALLEL
77 USE MODULE_DM, ONLY : LOCAL_COMMUNICATOR &
78 ,MYTASK,NTASKS,NTASKS_X &
79 ,NTASKS_Y
80 USE MODULE_COMM_DM
81 #else
82 USE MODULE_DM
83 #endif
84 !
85 USE MODULE_IGWAVE_ADJUST,ONLY: PDTE, PFDHT, DDAMP
86 USE MODULE_ADVECTION, ONLY: ADVE, VAD2, HAD2
87 USE MODULE_NONHY_DYNAM, ONLY: VADZ, HADZ
88 USE MODULE_DIFFUSION_NMM,ONLY: HDIFF
89 USE MODULE_BNDRY_COND, ONLY: BOCOH, BOCOV
90 USE MODULE_PHYSICS_INIT
91 USE MODULE_GWD
92 ! USE MODULE_RA_GFDLETA
93 !
94 USE MODULE_EXT_INTERNAL
95 !
96 #ifdef WRF_CHEM
97 USE MODULE_AEROSOLS_SORGAM, ONLY: SUM_PM_SORGAM
98 USE MODULE_GOCART_AEROSOLS, ONLY: SUM_PM_GOCART
99 USE MODULE_MOSAIC_DRIVER, ONLY: SUM_PM_MOSAIC
100 #endif
101 !
102 !----------------------------------------------------------------------
103 !
104 IMPLICIT NONE
105 !
106 !----------------------------------------------------------------------
107 !***
108 !*** Arguments
109 !***
110 TYPE(DOMAIN),INTENT(INOUT) :: GRID
111 LOGICAL , INTENT(IN) :: allowed_to_read
112 !
113 #include <dummy_new_decl.inc>
114 !
115 TYPE(GRID_CONFIG_REC_TYPE) :: CONFIG_FLAGS
116 !
117 #ifdef WRF_CHEM
118 REAL RGASUNIV ! universal gas constant [ J/mol-K ]
119 PARAMETER ( RGASUNIV = 8.314510 )
120 #endif
121 !
122 !***
123 !*** LOCAL DATA
124 !***
125 #ifdef HWRF
126 LOGICAL :: ANAL !zhang's doing, added for analysis option
127 #endif
129 integer(kind=4) :: random_seed
130 INTEGER :: parent_id, nestid, max_dom,one
131 LOGICAL :: grid_allowed, nestless
133 INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE &
134 & ,IMS,IME,JMS,JME,KMS,KME &
135 & ,IPS,IPE,JPS,JPE,KPS,KPE
136 !
137 INTEGER :: ERROR,LOOP
139 REAL,ALLOCATABLE,DIMENSION(:) :: PHALF
140 !
141 REAL :: EPSB=0.1,EPSIN=9.8
142 !
143 INTEGER :: JHL=7
144 !
145 INTEGER :: I,IEND,IER,IFE,IFS,IHH,IHL,IHRSTB,II,IRTN &
146 & ,ISIZ1,ISIZ2,ISTART,ISTAT,IX,J,J00,JFE,JFS,JHH,JJ &
147 & ,JM1,JM2,JM3,JP1,JP2,JP3,JX,KK &
148 & ,K,K400,KBI,KBI2,KCCO2,KNT,KNTI &
149 & ,LB,LRECBC,L &
150 & ,N,NMAP,NRADLH,NRADSH,NREC,NS,RECL,STAT &
151 & ,STEPBL,STEPCU,STEPRA
152 !
153 INTEGER :: MY_E,MY_N,MY_S,MY_W &
154 & ,MY_NE,MY_NW,MY_SE,MY_SW,MYI,MYJ,NPE
155 !
156 INTEGER :: I_M
157 !
158 INTEGER :: ILPAD2,IRPAD2,JBPAD2,JTPAD2
159 INTEGER :: ITS,ITE,JTS,JTE,KTS,KTE
160 !
161 INTEGER,DIMENSION(3) :: LPTOP
162 !
163 REAL :: ADDL,APELM,APELMNW,APEM1,CAPA,CLOGES,DPLM,DZLM,EPS,ESE &
164 & ,FAC1,FAC2,PDIF,PLM,PM1,PSFCK,PSS,PSUM,QLM,RANG &
165 & ,SLPM,TERM1,THLM,TIME,TLM,TSFCK,ULM,VLM
166 !
167 !!! REAL :: BLDT,CWML,EXNSFC,G_INV,PLYR,PSFC,ROG,SFCZ,THSIJ,TL
168 REAL :: CWML,EXNSFC,G_INV,PLYR,PSURF,ROG,SFCZ,THSIJ,TL,ZOQING
169 REAL :: TEND
170 #ifdef HWRF
171 !zhang's doing
172 REAL :: TSTART
173 !zhang's doing ends
174 #endif
175 #ifdef HWRF
176 ! gopal's doing for the moving nest (MSLP computation)
177 !-----------------------------------------------------------------------------------------------------
178 REAL, PARAMETER :: LAPSR=6.5E-3, GI=1./G,D608=0.608
179 REAL, PARAMETER :: COEF3=287.05*GI*LAPSR, COEF2=-1./COEF3
180 REAL, PARAMETER :: TRG=2.0*R_D*GI,LAPSI=1.0/LAPSR
181 REAL :: RTOPP,APELP,DZ,SFCT,A
182 !-----------------------------------------------------------------------------------------------------
183 #endif
185 !
186 !!! REAL,ALLOCATABLE,DIMENSION(:,:) :: RAINBL,RAINNC,RAINNC &
187 INTEGER,ALLOCATABLE,DIMENSION(:,:) :: ITEMP,LOWLYR
188 REAL,ALLOCATABLE,DIMENSION(:) :: SFULL,SMID
189 REAL,ALLOCATABLE,DIMENSION(:) :: DZS,ZS
190 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: RQCBLTEN,RQIBLTEN &
191 & ,RQVBLTEN,RTHBLTEN &
192 & ,RUBLTEN,RVBLTEN &
193 & ,RQCCUTEN,RQICUTEN,RQRCUTEN &
194 & ,RQSCUTEN,RQVCUTEN,RTHCUTEN &
195 & ,RUSHTEN,RVSHTEN &
196 & ,RQCSHTEN,RQISHTEN,RQRSHTEN &
197 & ,RQSSHTEN,RQVSHTEN,RTHSHTEN &
198 & ,RQGSHTEN &
199 & ,RTHRATEN &
200 & ,RTHRATENLW,RTHRATENSW
201 REAL,ALLOCATABLE,DIMENSION(:,:) :: EMISS,EMTEMP,GLW,HFX &
202 & ,NCA &
203 & ,QFX,RAINBL,RAINC,RAINNC &
204 & ,RAINNCV &
205 & ,SNOWNC,SNOWNCV &
206 & ,GRAUPELNC,GRAUPELNCV &
207 & ,SNOWC,THC,TMN,TSFC
209 REAL,ALLOCATABLE,DIMENSION(:,:) :: Z0_DUM, ALBEDO_DUM
210 !
211 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZINT,RRI,CONVFAC,ZMID
212 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: T_TRANS,PINT_TRANS
213 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CLDFRA_TRANS
214 #ifndef WRF_CHEM
215 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: CLDFRA_OLD
216 #endif
217 #if 0
218 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: w0avg
219 #endif
220 LOGICAL :: E_BDY,N_BDY,S_BDY,W_BDY,WARM_RAIN,ADV_MOIST_COND
221 LOGICAL :: START_OF_SIMULATION
222 LOGICAL :: LRESTART
223 LOGICAL :: ETAMP_Regional, ICE1_indx, ICE2_indx
226 integer :: jam,retval
227 CHARACTER(LEN=255) :: message
228 integer myproc
229 real :: dsig,dsigsum,pdbot,pdtot,rpdtot
230 real :: fisx,ht,prodx,rg
231 integer :: i_t=096,j_t=195,n_t=11
232 integer :: i_u=49,j_u=475,n_u=07
233 integer :: i_v=49,j_v=475,n_v=07
234 integer :: num_ozmixm, num_aerosolc
235 real :: cen_lat,cen_lon,dtphs ! GWD
236 integer :: num_urban_layers
237 !Rogers GMT
238 INTEGER :: hr, mn, sec, ms, rc
239 TYPE(WRFU_Time) :: currentTime
241 INTEGER :: interval_seconds, restart_interval
243 ! z0base new
245 REAL,DIMENSION(0:30) :: VZ0TBL_24
246 VZ0TBL_24= (/0., &
247 & 1.00, 0.07, 0.07, 0.07, 0.07, 0.15, &
248 & 0.08, 0.03, 0.05, 0.86, 0.80, 0.85, &
249 & 2.65, 1.09, 0.80, 0.001, 0.04, 0.05, &
250 & 0.01, 0.04, 0.06, 0.05, 0.03, 0.001, &
251 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
253 ! end z0base new
254 !
255 !----------------------------------------------------------------------
256 !#define COPY_IN
257 !#include <scalar_derefs.inc>
258 !----------------------------------------------------------------------
259 !**********************************************************************
260 !----------------------------------------------------------------------
261 !
262 call start_timing
264 #ifdef HWRF
265 if(grid%id==3) then
266 grid%force_sst=1
267 else
268 grid%force_sst=2
269 endif
270 #endif
272 CALL GET_IJK_FROM_GRID(GRID, &
273 & IDS,IDE,JDS,JDE,KDS,KDE, &
274 & IMS,IME,JMS,JME,KMS,KME, &
275 & IPS,IPE,JPS,JPE,KPS,KPE)
276 !
277 ITS=IPS
278 ITE=IPE
279 JTS=JPS
280 JTE=JPE
281 KTS=KPS
282 KTE=KPE
284 #ifdef HWRF
285 call guess_coupling_timestep(grid%id,grid%guessdtc)
286 grid%dtc=0
287 #endif
289 CALL model_to_grid_config_rec(grid%id,model_config_rec &
290 & ,config_flags)
291 !
292 RESTRT=config_flags%restart
293 #ifdef HWRF
294 !zhang's doing added for analysis option
295 ANAL=config_flags%analysis ! gopal's doing
296 !zhang's doing ends
297 #endif
299 #if 1
300 IF(IME>NMM_MAX_DIM )THEN
301 WRITE(wrf_err_message,*) &
302 'start_domain_nmm ime (',ime,') > ',NMM_MAX_DIM, &
303 '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
304 CALL WRF_ERROR_FATAL(wrf_err_message)
305 ENDIF
306 !
307 IF(JME>NMM_MAX_DIM )THEN
308 WRITE(wrf_err_message,*) &
309 'start_domain_nmm jme (',jme,') > ',NMM_MAX_DIM, &
310 '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
311 CALL WRF_ERROR_FATAL(wrf_err_message)
312 ENDIF
313 #else
314 IF(IMS>-2.OR.IME>NMM_MAX_DIM )THEN
315 WRITE(wrf_err_message,*) &
316 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, &
317 '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
318 CALL WRF_ERROR_FATAL(wrf_err_message)
319 ENDIF
320 !
321 IF(JMS>-2.OR.JME>NMM_MAX_DIM )THEN
322 WRITE(wrf_err_message,*) &
323 'start_domain_nmm jms(',jms,' > -2 or jme (',jme,') > ',NMM_MAX_DIM, &
324 '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.'
325 CALL WRF_ERROR_FATAL(wrf_err_message)
326 ENDIF
327 #endif
328 !
329 !----------------------------------------------------------------------
330 !
331 WRITE(message,196)IHRST,IDAT
332 CALL wrf_message(trim(message))
333 196 FORMAT(' FORECAST BEGINS ',I2,' GMT ',2(I2,'/'),I4)
336 !! Restarts must be made from times for which boundary data is available
338 CALL nl_get_interval_seconds(GRID%ID, interval_seconds)
339 CALL nl_get_restart_interval(GRID%ID, restart_interval)
340 IF (MOD(restart_interval*60,interval_seconds) /= 0) THEN
341 WRITE(wrf_err_message,*)' restart_interval is not integer multiplier of interval_seconds'
342 CALL WRF_ERROR_FATAL(wrf_err_message)
343 END IF
345 #if (HWRF==1)
346 if(grid%vortex_tracker<1 .or. grid%vortex_tracker>3) then
347 write(wrf_err_message,*)' domain ',grid%id,' has an invalid value ',grid%vortex_tracker,' for grid%vortex_tracker. It must be 1, 2 or 3.'
348 endif
349 #endif
351 !!!!!!tlb
352 !!!! For now, set NPES to 1
353 NPES=1
354 !!!!!!tlb
355 MY_IS_GLB=IPS
356 MY_IE_GLB=IPE-1
357 MY_JS_GLB=JPS
358 MY_JE_GLB=JPE-1
359 !
360 IM=IPE-1
361 JM=JPE-1
362 !!!!!!!!!
363 !! All "my" variables defined below have had the IDE or JDE specification
364 !! reduced by 1
365 !!!!!!!!!!!
367 MYIS=MAX(IDS,IPS)
368 MYIE=MIN(IDE-1,IPE)
369 MYJS=MAX(JDS,JPS)
370 MYJE=MIN(JDE-1,JPE)
372 MYIS1 =MAX(IDS+1,IPS)
373 MYIE1 =MIN(IDE-2,IPE)
374 MYJS2 =MAX(JDS+2,JPS)
375 MYJE2 =MIN(JDE-3,JPE)
376 !
377 MYIS_P1=MAX(IDS,IPS-1)
378 MYIE_P1=MIN(IDE-1,IPE+1)
379 MYIS_P2=MAX(IDS,IPS-2)
380 MYIE_P2=MIN(IDE-1,IPE+2)
381 MYIS_P3=MAX(IDS,IPS-3)
382 MYIE_P3=MIN(IDE-1,IPE+3)
383 MYJS_P3=MAX(JDS,JPS-3)
384 MYJE_P3=MIN(JDE-1,JPE+3)
385 MYIS_P4=MAX(IDS,IPS-4)
386 MYIE_P4=MIN(IDE-1,IPE+4)
387 MYJS_P4=MAX(JDS,JPS-4)
388 MYJE_P4=MIN(JDE-1,JPE+4)
389 MYIS_P5=MAX(IDS,IPS-5)
390 MYIE_P5=MIN(IDE-1,IPE+5)
391 MYJS_P5=MAX(JDS,JPS-5)
392 MYJE_P5=MIN(JDE-1,JPE+5)
393 !
394 MYIS1_P1=MAX(IDS+1,IPS-1)
395 MYIE1_P1=MIN(IDE-2,IPE+1)
396 MYIS1_P2=MAX(IDS+1,IPS-2)
397 MYIE1_P2=MIN(IDE-2,IPE+2)
398 !
399 MYJS1_P1=MAX(JDS+1,JPS-1)
400 MYJS2_P1=MAX(JDS+2,JPS-1)
401 MYJE1_P1=MIN(JDE-2,JPE+1)
402 MYJE2_P1=MIN(JDE-3,JPE+1)
403 MYJS1_P2=MAX(JDS+1,JPS-2)
404 MYJE1_P2=MIN(JDE-2,JPE+2)
405 MYJS2_P2=MAX(JDS+2,JPS-2)
406 MYJE2_P2=MIN(JDE-3,JPE+2)
407 MYJS1_P3=MAX(JDS+1,JPS-3)
408 MYJE1_P3=MIN(JDE-2,JPE+3)
409 MYJS2_P3=MAX(JDS+2,JPS-3)
410 MYJE2_P3=MIN(JDE-3,JPE+3)
411 !!!!!!!!!!!
412 !
413 #ifdef DM_PARALLEL
415 CALL WRF_GET_MYPROC(MYPROC)
416 MYPE=MYPROC
418 !
419 !----------------------------------------------------------------------
420 !*** Let each task determine who its eight neighbors are because we
421 !*** will need to know that for the halo exchanges. The direction
422 !*** to each neighbor will be designated by the following integers:
423 !
424 !*** north: 1
425 !*** east: 2
426 !*** south: 3
427 !*** west: 4
428 !*** northeast: 5
429 !*** southeast: 6
430 !*** southwest: 7
431 !*** northwest: 8
432 !
433 !*** If a task has no neighbor in a particular direction because of
434 !*** the presence of the global domain boundary then that element
435 !*** of my_neb is set to -1.
436 !-----------------------------------------------------------------------
437 !
438 call wrf_get_nprocx(inpes)
439 call wrf_get_nprocy(jnpes)
440 !
441 allocate(itemp(inpes,jnpes),stat=istat)
442 npe=0
443 !
444 do j=1,jnpes
445 do i=1,inpes
446 itemp(i,j)=npe
447 if(npe==mype)then
448 myi=i
449 myj=j
450 endif
451 npe=npe+1
452 enddo
453 enddo
454 !
455 my_n=-1
456 if(myj+1<=jnpes)my_n=itemp(myi,myj+1)
457 !
458 my_e=-1
459 if(myi+1<=inpes)my_e=itemp(myi+1,myj)
460 !
461 my_s=-1
462 if(myj-1>=1)my_s=itemp(myi,myj-1)
463 !
464 my_w=-1
465 if(myi-1>=1)my_w=itemp(myi-1,myj)
466 !
467 my_ne=-1
468 if((myi+1<=inpes).and.(myj+1<=jnpes)) &
469 my_ne=itemp(myi+1,myj+1)
470 !
471 my_se=-1
472 if((myi+1<=inpes).and.(myj-1>=1)) &
473 my_se=itemp(myi+1,myj-1)
474 !
475 my_sw=-1
476 if((myi-1>=1).and.(myj-1>=1)) &
477 my_sw=itemp(myi-1,myj-1)
478 !
479 my_nw=-1
480 if((myi-1>=1).and.(myj+1<=jnpes)) &
481 my_nw=itemp(myi-1,myj+1)
482 !
483 ! my_neb(1)=my_n
484 ! my_neb(2)=my_e
485 ! my_neb(3)=my_s
486 ! my_neb(4)=my_w
487 ! my_neb(5)=my_ne
488 ! my_neb(6)=my_se
489 ! my_neb(7)=my_sw
490 ! my_neb(8)=my_nw
491 !
492 deallocate(itemp)
493 # include <HALO_NMM_INIT_1.inc>
494 # include <HALO_NMM_INIT_2.inc>
495 # include <HALO_NMM_INIT_3.inc>
496 # include <HALO_NMM_INIT_4.inc>
497 # include <HALO_NMM_INIT_5.inc>
498 # include <HALO_NMM_INIT_6.inc>
499 # include <HALO_NMM_INIT_7.inc>
500 # include <HALO_NMM_INIT_8.inc>
501 # include <HALO_NMM_INIT_9.inc>
502 # include <HALO_NMM_INIT_10.inc>
503 # include <HALO_NMM_INIT_11.inc>
504 # include <HALO_NMM_INIT_12.inc>
505 # include <HALO_NMM_INIT_13.inc>
506 # include <HALO_NMM_INIT_14.inc>
507 # include <HALO_NMM_INIT_15.inc>
508 # include <HALO_NMM_INIT_16.inc>
509 # include <HALO_NMM_INIT_17.inc>
510 # include <HALO_NMM_INIT_18.inc>
511 # include <HALO_NMM_INIT_19.inc>
512 # include <HALO_NMM_INIT_20.inc>
513 # include <HALO_NMM_INIT_21.inc>
514 # include <HALO_NMM_INIT_22.inc>
515 # include <HALO_NMM_INIT_23.inc>
516 # include <HALO_NMM_INIT_24.inc>
517 # include <HALO_NMM_INIT_25.inc>
518 # include <HALO_NMM_INIT_26.inc>
519 # include <HALO_NMM_INIT_27.inc>
520 # include <HALO_NMM_INIT_28.inc>
521 # include <HALO_NMM_INIT_29.inc>
522 # include <HALO_NMM_INIT_30.inc>
523 # include <HALO_NMM_INIT_31.inc>
524 # include <HALO_NMM_INIT_32.inc>
525 # include <HALO_NMM_INIT_33.inc>
526 # include <HALO_NMM_INIT_34.inc>
527 # include <HALO_NMM_INIT_35.inc>
528 # include <HALO_NMM_INIT_36.inc>
529 # include <HALO_NMM_INIT_37.inc>
530 # include <HALO_NMM_INIT_38.inc>
531 # include <HALO_NMM_INIT_39.inc>
532 #endif
533 !
534 DO J=MYJS_P4,MYJE_P4
535 grid%iheg(J)=MOD(J+1,2)
536 grid%ihwg(J)=grid%iheg(J)-1
537 grid%iveg(J)=MOD(J,2)
538 grid%ivwg(J)=grid%iveg(J)-1
539 ENDDO
540 !
541 DO J=MYJS_P4,MYJE_P4
542 grid%ivw(J)=grid%ivwg(J)
543 grid%ive(J)=grid%iveg(J)
544 grid%ihe(J)=grid%iheg(J)
545 grid%ihw(J)=grid%ihwg(J)
546 ENDDO
547 !
548 CAPA=R_D/CP
549 LM=KPE-KPS+1
550 !
551 IFS=IPS
552 JFS=JPS
553 JFE=MIN(JPE,JDE-1)
554 IFE=MIN(IPE,IDE-1)
556 if((allowed_to_read.and..not.(restrt)) .or. .not.allowed_to_read) then
557 randif: IF(in_use_for_config(grid%id,'random'))THEN
558 ! Reset random number generator at first initialization,
559 ! or after a nest move. (Need to reset after a nest move
560 ! or the leading edge will be filled with 3x3 areas with
561 ! the same random number generator state.)
562 random_seed=config_flags%random_seed + grid%ntsd
564 write(message,'(A,I0,A,I0)') 'Resetting random number for domain ',grid%id,' with seed ',random_seed
565 call wrf_message(message)
566 one=1
567 call srand_grid(grid%randstate1,grid%randstate2, &
568 grid%randstate3,grid%randstate4, &
569 IDS,IDE,JDS,JDE,one,one, &
570 IMS,IME,JMS,JME,one,one, &
571 IPS,IPE,JPS,JPE,one,one,random_seed)
572 call rand_grid_r4(grid%randstate1,grid%randstate2, &
573 grid%randstate3,grid%randstate4, &
574 grid%random, &
575 IDS,IDE,JDS,JDE,one,one, &
576 IMS,IME,JMS,JME,one,one, &
577 IPS,IPE,JPS,JPE,one,one)
578 else
579 grid%random = 0.0
580 endif randif
581 endif
582 ! Begin HWRF update for high-frequency output
583 #ifdef HWRF
584 if(allowed_to_read .and. config_flags%high_freq) then
585 if(grid%id==config_flags%high_dom) then
586 call HIFREQ_OPEN(grid,config_flags)
587 elseif(config_flags%high_dom==-99) then
588 nestless=.true.
589 CALL nl_get_max_dom( 1, max_dom )
590 nestdo: do nestid=2,max_dom
591 call nl_get_grid_allowed(nestid,grid_allowed)
592 if(grid_allowed) then
593 call nl_get_parent_id(nestid,parent_id)
594 if(parent_id==grid%id) then
595 write(message,'("Domain ",I0," does not have hifreq out (can have a child).")') grid%id
596 nestless=.false.
597 exit nestdo
598 endif
599 endif
600 enddo nestdo
601 if(nestless) then
602 call HIFREQ_OPEN(grid,config_flags)
603 endif
604 else
605 write(message,'("Domain ",I0," does not have hifreq out.")') grid%id
606 endif
607 else
608 write(message,'("Domain ",I0," is not being initialized.")') grid%id
609 endif
610 ! end of high-freq output
611 #endif
612 !
613 #ifdef HWRF
614 !zhang's doing
615 IF((.NOT.RESTRT .AND. .NOT.ANAL) .OR. .NOT.allowed_to_read)THEN
616 !end of zhang's doing
617 #else
618 IF(.NOT.RESTRT)THEN
619 #endif
620 DO J=JFS,JFE
621 DO I=IFS,IFE
622 grid%pdsl(I,J) =grid%pd(I,J)*grid%res(I,J)
623 grid%prec(I,J) =0.
624 IF(allowed_to_read)grid%acprec(I,J)=0. ! This is gopal's inclusion for moving nest
625 grid%cuprec(I,J)=0.
626 rg=1./g
627 ht=grid%fis(i,j)*rg
628 !!! fisx=ht*g
629 ! fisx=max(grid%fis(i,j),0.)
630 ! prodx=grid%z0(I,J)*Z0MAX
631 ! grid%z0(I,J) =grid%sm(I,J)*Z0SEA+(1.-grid%sm(I,J))* &
632 ! & (grid%z0(I,J)*Z0MAX+FISx *FCM+Z0LAND)
633 !!! & (prodx +FISx *FCM+Z0LAND)
634 grid%qsh(I,J) =0.
635 grid%akms(I,J) =0.
636 grid%akhs(I,J) =0.
637 grid%twbs(I,J) =0.
638 grid%qwbs(I,J) =0.
639 IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
640 grid%cldefi(I,J)=1.
641 grid%htop(I,J) =REAL(KTS)
642 grid%htopd(I,J) =REAL(KTS)
643 grid%htops(I,J) =REAL(KTS)
644 grid%hbot(I,J) =REAL(KTE)
645 grid%hbotd(I,J) =REAL(KTE)
646 grid%hbots(I,J) =REAL(KTE)
647 ENDIF
648 !***
649 !*** AT THIS POINT, WE MUST CALCULATE THE INITIAL POTENTIAL TEMPERATURE
650 !*** OF THE SURFACE AND OF THE SUBGROUND.
651 !*** EXTRAPOLATE DOWN FOR INITIAL SURFACE POTENTIAL TEMPERATURE.
652 !*** ALSO DO THE SHELTER PRESSURE.
653 !***
654 !
655 !*** BECAUSE WE REINITIALIZE TOPOGRAPHY, LAND SEA MASK AND FIND THE TEMPERATURE
656 !*** FIELD OVER THE NEW TOPOGRAPHY, AFTER THE MOVE, I THINK IT MORE APPROPRIATE
657 !*** TO USE grid%nmm_tsk OR grid%sst TO RE-DERIVE grid%ths AND QS (AND CONSEQUENTLY grid%thz0 AND grid%qz0).
658 !*** THIS MAY BE MORE CONSISTENT WITH THE PSEUDO-HYDROSTATIC BALANCING THAT IS
659 !*** DONE OVER THE NEW TERRAIN (AND WITH NEW grid%sm). gopal!
660 !***
661 !***
663 IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
665 PM1=grid%aeta1(KTS)*grid%pdtop+grid%aeta2(KTS)*grid%pdsl(I,J)+grid%pt
666 APEM1=(1.E5/PM1)**CAPA
668 IF(grid%nmm_tsk(I,J)>=200.)THEN ! have a specific skin temp, use it
669 #ifdef HWRF
670 grid%ths(I,J)=grid%nmm_tsk(I,J)*(1.+P608*grid%q(I,J,KTS+1))*APEM1
671 TSFCK=grid%nmm_tsk(I,J)*(1.+P608*grid%q(I,J,KTS+1))
672 #else
673 grid%ths(I,J)=grid%nmm_tsk(I,J)*APEM1
674 TSFCK=grid%nmm_tsk(I,J)
675 #endif
677 ELSE ! use lowest layer as a proxy
678 #ifdef HWRF
679 grid%ths(I,J)=grid%t(I,J,KTS)*(1.+P608*grid%q(I,J,KTS+1))*APEM1
680 TSFCK=grid%t(I,J,KTS)*(1.+P608*grid%q(I,J,KTS+1))
681 #else
682 grid%ths(I,J)=grid%t(I,J,KTS)*APEM1
683 TSFCK=grid%t(I,J,KTS)
684 #endif
685 ENDIF
687 PSFCK=grid%pd(I,J)+grid%pdtop+grid%pt
688 !
689 IF(grid%sm(I,J)<0.5) THEN
690 grid%qsh(I,J)=PQ0/PSFCK*EXP(A2*(TSFCK-A3)/(TSFCK-A4))
691 ELSEIF(grid%sm(I,J)>0.5) THEN
692 grid%ths(I,J)=grid%sst(I,J)*(1.E5/(grid%pd(I,J)+grid%pdtop+grid%pt))**CAPA
693 ENDIF
694 !
695 TERM1=-0.068283/grid%t(I,J,KTS)
696 grid%pshltr(I,J)=(grid%pd(I,J)+grid%pdtop+grid%pt)*EXP(TERM1)
697 !
698 grid%ustar(I,J)=0.1
699 grid%thz0(I,J)=grid%ths(I,J)
700 grid%qz0(I,J)=grid%qsh(I,J)
701 grid%uz0(I,J)=0.
702 grid%vz0(I,J)=0.
704 ENDIF ! endif for allowed to read
705 !
706 ENDDO
707 ENDDO
709 !***
710 !*** INITIALIZE CLOUD FIELDS
711 !***
712 IF (MAXVAL(grid%cwm) .gt. 0. .and. MAXVAL(grid%cwm) .lt. 1.) then
713 CALL wrf_message('appear to have grid%cwm values...do not zero')
714 ELSE
715 IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
716 CALL wrf_message('zeroing grid%cwm')
717 DO K=KPS,KPE
718 DO J=JFS,JFE
719 DO I=IFS,IFE
720 grid%cwm(I,J,K)=0.
721 ENDDO
722 ENDDO
723 ENDDO
724 ENDIF
725 ENDIF
726 !***
727 !*** INITIALIZE ACCUMULATOR ARRAYS TO ZERO.
728 !***
729 grid%ardsw=0.0
730 grid%ardlw=0.0
731 grid%asrfc=0.0
732 grid%avrain=0.0
733 grid%avcnvc=0.0
734 !
735 DO J=JFS,JFE
736 DO I=IFS,IFE
737 grid%acfrcv(I,J)=0.
738 grid%ncfrcv(I,J)=0
739 grid%acfrst(I,J)=0.
740 grid%ncfrst(I,J)=0
741 grid%acsnow(I,J)=0.
742 grid%acsnom(I,J)=0.
743 grid%ssroff(I,J)=0.
744 grid%bgroff(I,J)=0.
745 grid%alwin(I,J) =0.
746 grid%alwout(I,J)=0.
747 grid%alwtoa(I,J)=0.
748 grid%aswin(I,J) =0.
749 grid%aswout(I,J)=0.
750 grid%aswtoa(I,J)=0.
751 grid%sfcshx(I,J)=0.
752 grid%sfclhx(I,J)=0.
753 grid%subshx(I,J)=0.
754 grid%snopcx(I,J)=0.
755 grid%sfcuvx(I,J)=0.
756 grid%sfcevp(I,J)=0.
757 grid%potevp(I,J)=0.
758 grid%potflx(I,J)=0.
759 ENDDO
760 ENDDO
761 !***
762 !*** INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER.
763 !***
764 EPS=R_D/R_V
765 !
766 IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
767 DO J=JFS,JFE
768 DO I=IFS,IFE
769 IF(grid%sm(I,J)>0.5)THEN
770 CLOGES =-CM1/grid%sst(I,J)-CM2*ALOG10(grid%sst(I,J))+CM3
771 ESE = 10.**(CLOGES+2.)
772 grid%qsh(I,J)= grid%sm(I,J)*EPS*ESE/(grid%pd(I,J)+grid%pdtop+grid%pt-ESE*(1.-EPS))
773 ENDIF
774 ENDDO
775 ENDDO
776 ENDIF
777 !***
778 !*** INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL
779 !*** VALUE (EPSQ2) ABOVE GROUND. SET TKE TO ZERO IN THE
780 !*** THE LOWEST MODEL LAYER. IN THE LOWEST TWO ATMOSPHERIC
781 !*** ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI).
782 !***
783 !***EROGERS: add check for realistic values of grid%q2
784 !
785 IF (MAXVAL(grid%q2) .gt. epsq2 .and. MAXVAL(grid%q2) .lt. 200.) then
786 CALL wrf_message('appear to have grid%q2 values...do not zero')
787 ELSE
788 IF(allowed_to_read)THEN ! This is gopal's inclusion for moving nest
789 CALL wrf_message('zeroing grid%q2')
790 DO K=KPS,KPE-1
791 DO J=JFS,JFE
792 DO I=IFS,IFE
793 #ifdef HWRF
794 grid%q2(I,J,K)=0.
795 #else
796 grid%q2(I,J,K)=grid%hbm2(I,J)*EPSQ2
797 #endif
798 ENDDO
799 ENDDO
800 ENDDO
801 !
802 DO J=JFS,JFE
803 DO I=IFS,IFE
804 grid%q2(I,J,LM) = 0.
805 #ifdef HWRF
806 grid%q2(I,J,KTE-2)= 0.
807 grid%q2(I,J,KTE-1)= 0.
808 #else
809 grid%q2(I,J,KTE-2)= grid%hbm2(I,J)*Q2INI
810 grid%q2(I,J,KTE-1)= grid%hbm2(I,J)*Q2INI
811 #endif
812 ENDDO
813 ENDDO
814 ENDIF
815 ENDIF
816 !***
817 !*** PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL.
818 !*** INITIALIZE LATENT HEATING ACCUMULATION ARRAYS.
819 !***
820 DO K=KPS,KPE
821 DO J=JFS,JFE
822 DO I=IFS,IFE
823 IF(grid%q(I,J,K)<EPSQ)grid%q(I,J,K)=EPSQ
824 grid%train(I,J,K)=0.
825 grid%tcucn(I,J,K)=0.
826 ENDDO
827 ENDDO
828 ENDDO
829 !
830 !***
831 !*** INITIALIZE MAX/MIN TEMPERATURES.
832 !***
833 DO J=JFS,JFE
834 DO I=IFS,IFE
835 grid%tlmax(I,J)=grid%t(I,J,KPS)
836 grid%tlmin(I,J)=grid%t(I,J,KPS)
837 ENDDO
838 ENDDO
839 !
840 !----------------------------------------------------------------------
841 !*** END OF SCRATCH START INITIALIZATION BLOCK.
842 !----------------------------------------------------------------------
843 !
844 CALL wrf_message('INIT: INITIALIZED ARRAYS FOR CLEAN START')
845 ENDIF ! <--- (not restart)
847 IF(NEST)THEN
848 DO J=JFS,JFE
849 DO I=IFS,IFE
850 !
851 IF(grid%t(I,J,KTS)==0.)THEN
852 grid%t(I,J,KTS)=grid%t(I,J,KTS+1)
853 ENDIF
854 !
855 TERM1=-0.068283/grid%t(I,J,KTS)
856 grid%pshltr(I,J)=(grid%pd(I,J)+grid%pdtop+grid%pt)*EXP(TERM1)
857 ENDDO
858 ENDDO
859 ENDIF
860 !
861 !----------------------------------------------------------------------
862 !*** RESTART INITIALIZING. CHECK TO SEE IF WE NEED TO ZERO
863 !*** ACCUMULATION ARRAYS.
864 !----------------------------------------------------------------------
866 TSPH=3600./GRID%DT ! needed?
867 grid%nphs0=GRID%NPHS
868 #ifdef HWRF
869 !zhang's doing
870 tstart = grid%TSTART
871 !zhang's doing ends
872 #endif
874 IF(MYPE==0)THEN
875 WRITE( wrf_err_message, * )' start_nmm TSTART=',grid%tstart
876 CALL wrf_debug( 1, TRIM(wrf_err_message) )
877 WRITE( wrf_err_message, * )' start_nmm TPREC=',grid%tprec
878 CALL wrf_debug( 1, TRIM(wrf_err_message) )
879 WRITE( wrf_err_message, * )' start_nmm THEAT=',grid%theat
880 CALL wrf_debug( 1, TRIM(wrf_err_message) )
881 WRITE( wrf_err_message, * )' start_nmm TCLOD=',grid%tclod
882 CALL wrf_debug( 1, TRIM(wrf_err_message) )
883 WRITE( wrf_err_message, * )' start_nmm TRDSW=',grid%trdsw
884 CALL wrf_debug( 1, TRIM(wrf_err_message) )
885 WRITE( wrf_err_message, * )' start_nmm TRDLW=',grid%trdlw
886 CALL wrf_debug( 1, TRIM(wrf_err_message) )
887 WRITE( wrf_err_message, * )' start_nmm TSRFC=',grid%tsrfc
888 CALL wrf_debug( 1, TRIM(wrf_err_message) )
889 WRITE( wrf_err_message, * )' start_nmm PCPFLG=',grid%pcpflg
890 CALL wrf_debug( 1, TRIM(wrf_err_message) )
891 ENDIF
893 NSTART = INT(grid%TSTART*TSPH+0.5)
894 !
895 grid%ntsd = NSTART
897 !! want non-zero values for grid%nprec, grid%nheat type vars to avoid problems
898 !! with mod statements below.
900 grid%nprec = INT(grid%TPREC *TSPH+0.5)
901 grid%nheat = INT(grid%THEAT *TSPH+0.5)
902 grid%nclod = INT(grid%TCLOD *TSPH+0.5)
903 grid%nrdsw = INT(grid%TRDSW *TSPH+0.5)
904 grid%nrdlw = INT(grid%TRDLW *TSPH+0.5)
905 grid%nsrfc = INT(grid%TSRFC *TSPH+0.5)
906 #ifdef HWRF
907 !zhang's dong for analysis option:
908 grid%NCNVC0 = grid%NCNVC
909 grid%NPHS0 = grid%NPHS
910 #endif
911 !
912 !----------------------------------------------------------------------
913 !
914 !*** FLAG FOR INITIALIZING ARRAYS, LOOKUP TABLES, & CONSTANTS USED IN
915 !*** MICROPHYSICS AND RADIATION
916 !
917 !----------------------------------------------------------------------
918 !
919 grid%micro_start=.TRUE.
920 !
921 !----------------------------------------------------------------------
922 !***
923 !*** INITIALIZE ADVECTION TENDENCIES TO ZERO SO THAT
924 !*** BOUNDARY POINTS WILL ALWAYS BE ZERO
925 !***
926 DO J=JFS,JFE
927 DO I=IFS,IFE
928 grid%adt(I,J)=0.
929 grid%adu(I,J)=0.
930 grid%adv(I,J)=0.
931 ENDDO
932 ENDDO
933 !----------------------------------------------------------------------
934 !***
935 !*** SET INDEX ARRAYS FOR UPSTREAM ADVECTION
936 !***
937 !----------------------------------------------------------------------
938 DO J=JFS,JFE
939 grid%n_iup_h(J)=0
940 grid%n_iup_v(J)=0
941 grid%n_iup_adh(J)=0
942 grid%n_iup_adv(J)=0
943 !
944 DO I=IFS,IFE
945 grid%iup_h(I,J)=-999
946 grid%iup_v(I,J)=-999
947 grid%iup_adh(I,J)=-999
948 grid%iup_adv(I,J)=-999
949 ENDDO
950 !
951 ENDDO
953 #ifndef NO_UPSTREAM_ADVECTION
954 !
955 !*** n_iup_h HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
956 !*** FOR UPSTREAM ADVECTION (FULL ROWS IN THE 3RD THROUGH 7TH
957 !*** ROWS FROM THE SOUTH AND NORTH GLOBAL BOUNDARIES AND
958 !*** FOUR POINTS ADJACENT TO THE WEST AND EAST GLOBAL BOUNDARIES
959 !*** ON ALL OTHER INTERNAL ROWS). SIMILARLY FOR n_iup_v.
960 !*** BECAUSE OF HORIZONTAL OPERATIONS, THESE POINTS EXTEND OUTSIDE
961 !*** OF THE UPSTREAM REGION SOMEWHAT.
962 !*** n_iup_adh HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
963 !*** FOR THE COMPUTATION OF THE TENDENCIES THEMSELVES (adt, ADQ2M
964 !*** AND ADQ2L); SPECIFICALLY THESE TENDENCIES ARE ONLY DONE IN
965 !*** THE UPSTREAM REGION.
966 !*** n_iup_adv HOLDS THE NUMBER OF MASS POINTS NEEDED IN EACH ROW
967 !*** FOR THE VELOCITY POINT TENDENCIES.
968 !*** iup_h AND iup_v HOLD THE ACTUAL I VALUES USED IN EACH ROW.
969 !*** LIKEWISE FOR iup_adh AND iup_adv.
970 !*** ALSO, SET upstrm FOR THOSE TASKS AROUND THE GLOBAL EDGE.
971 !
972 grid%upstrm=.FALSE.
973 !
974 S_BDY=(JPS==JDS)
975 N_BDY=(JPE==JDE)
976 W_BDY=(IPS==IDS)
977 E_BDY=(IPE==IDE)
978 !
979 JTPAD2=2
980 JBPAD2=2
981 IRPAD2=2
982 ILPAD2=2
983 !
984 IF(S_BDY)THEN
985 grid%upstrm=.TRUE.
986 JBPAD2=0
987 !
988 DO JJ=1,7
989 J=JJ ! -MY_JS_GLB+1
990 KNTI=0
991 DO I=MYIS_P2,MYIE_P2
992 grid%iup_h(IMS+KNTI,J)=I
993 grid%iup_v(IMS+KNTI,J)=I
994 KNTI=KNTI+1
995 ENDDO
996 grid%n_iup_h(J)=KNTI
997 grid%n_iup_v(J)=KNTI
998 ENDDO
999 !
1000 DO JJ=3,5
1001 J=JJ ! -MY_JS_GLB+1
1002 KNTI=0
1003 ISTART=MYIS1_P2
1004 IEND=MYIE1_P2
1005 IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
1006 DO I=ISTART,IEND
1007 grid%iup_adh(IMS+KNTI,J)=I
1008 KNTI=KNTI+1
1009 ENDDO
1010 grid%n_iup_adh(J)=KNTI
1011 !
1012 KNTI=0
1013 ISTART=MYIS1_P2
1014 IEND=MYIE1_P2
1015 IF(E_BDY)IEND=IEND-MOD(JJ,2)
1016 DO I=ISTART,IEND
1017 grid%iup_adv(IMS+KNTI,J)=I
1018 KNTI=KNTI+1
1019 ENDDO
1020 grid%n_iup_adv(J)=KNTI
1021 ENDDO
1022 ENDIF
1023 !
1024 IF(N_BDY)THEN
1025 grid%upstrm=.TRUE.
1026 JTPAD2=0
1027 !
1028 DO JJ=JDE-7, JDE-1 ! JM-6,JM
1029 J=JJ ! -MY_JS_GLB+1
1030 KNTI=0
1031 DO I=MYIS_P2,MYIE_P2
1032 grid%iup_h(IMS+KNTI,J)=I
1033 grid%iup_v(IMS+KNTI,J)=I
1034 KNTI=KNTI+1
1035 ENDDO
1036 grid%n_iup_h(J)=KNTI
1037 grid%n_iup_v(J)=KNTI
1038 ENDDO
1039 !
1040 DO JJ=JDE-5, JDE-3 ! JM-4,JM-2
1041 J=JJ ! -MY_JS_GLB+1
1042 KNTI=0
1043 ISTART=MYIS1_P2
1044 IEND=MYIE1_P2
1045 IF(E_BDY)IEND=IEND-MOD(JJ+1,2)
1046 DO I=ISTART,IEND
1047 grid%iup_adh(IMS+KNTI,J)=I
1048 KNTI=KNTI+1
1049 ENDDO
1050 grid%n_iup_adh(J)=KNTI
1051 !
1052 KNTI=0
1053 ISTART=MYIS1_P2
1054 IEND=MYIE1_P2
1055 IF(E_BDY)IEND=IEND-MOD(JJ,2)
1056 DO I=ISTART,IEND
1057 grid%iup_adv(IMS+KNTI,J)=I
1058 KNTI=KNTI+1
1059 ENDDO
1060 grid%n_iup_adv(J)=KNTI
1061 ENDDO
1062 ENDIF
1063 !
1064 IF(W_BDY)THEN
1065 grid%upstrm=.TRUE.
1066 ILPAD2=0
1067 DO JJ=8,JDE-8 ! JM-7
1068 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1069 J=JJ ! -MY_JS_GLB+1
1070 !
1071 DO I=1,4
1072 grid%iup_h(IMS+I-1,J)=I
1073 grid%iup_v(IMS+I-1,J)=I
1074 ENDDO
1075 grid%n_iup_h(J)=4
1076 grid%n_iup_v(J)=4
1077 ENDIF
1078 ENDDO
1079 !
1080 DO JJ=6,JDE-6 ! JM-5
1081 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1082 J=JJ ! -MY_JS_GLB+1
1083 KNTI=0
1084 IEND=2+MOD(JJ,2)
1085 DO I=2,IEND
1086 grid%iup_adh(IMS+KNTI,J)=I
1087 KNTI=KNTI+1
1088 ENDDO
1089 grid%n_iup_adh(J)=KNTI
1090 !
1091 KNTI=0
1092 IEND=2+MOD(JJ+1,2)
1093 DO I=2,IEND
1094 grid%iup_adv(IMS+KNTI,J)=I
1095 KNTI=KNTI+1
1096 ENDDO
1097 grid%n_iup_adv(J)=KNTI
1098 !
1099 ENDIF
1100 ENDDO
1101 ENDIF
1102 !
1103 CALL WRF_GET_NPROCX(INPES)
1104 !
1105 IF(E_BDY)THEN
1106 grid%upstrm=.TRUE.
1107 IRPAD2=0
1108 DO JJ=8,JDE-8 ! JM-7
1109 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1110 J=JJ ! -MY_JS_GLB+1
1111 IEND=IM-MOD(JJ+1,2)
1112 ISTART=IEND-3
1113 !
1114 !*** IN CASE THERE IS ONLY A SINGLE GLOBAL TASK IN THE
1115 !*** I DIRECTION THEN WE MUST ADD THE WESTSIDE UPSTREAM
1116 !*** POINTS TO THE EASTSIDE POINTS IN EACH ROW.
1117 !
1118 KNTI=0
1119 IF(INPES.EQ.1)KNTI=grid%n_iup_h(J)
1120 !
1121 DO II=ISTART,IEND
1122 I=II ! -MY_IS_GLB+1
1123 grid%iup_h(IMS+KNTI,J)=I
1124 KNTI=KNTI+1
1125 ENDDO
1126 grid%n_iup_h(J)=KNTI
1127 ENDIF
1128 ENDDO
1129 !
1130 DO JJ=6,JDE-6 ! JM-5
1131 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1132 J=JJ ! -MY_JS_GLB+1
1133 IEND=IM-1-MOD(JJ+1,2)
1134 ISTART=IEND-MOD(JJ,2)
1135 KNTI=0
1136 IF(INPES==1)KNTI=grid%n_iup_adh(J)
1137 DO II=ISTART,IEND
1138 I=II ! -MY_IS_GLB+1
1139 grid%iup_adh(IMS+KNTI,J)=I
1140 KNTI=KNTI+1
1141 ENDDO
1142 grid%n_iup_adh(J)=KNTI
1143 ENDIF
1144 ENDDO
1145 !***
1146 DO JJ=8,JDE-8 ! JM-7
1147 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1148 J=JJ ! -MY_JS_GLB+1
1149 IEND=IM-MOD(JJ,2)
1150 ISTART=IEND-3
1151 KNTI=0
1152 IF(INPES==1)KNTI=grid%n_iup_v(J)
1153 !
1154 DO II=ISTART,IEND
1155 I=II ! -MY_IS_GLB+1
1156 grid%iup_v(IMS+KNTI,J)=I
1157 KNTI=KNTI+1
1158 ENDDO
1159 grid%n_iup_v(J)=KNTI
1160 ENDIF
1161 ENDDO
1162 !
1163 DO JJ=6,JDE-6 ! JM-5
1164 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1165 J=JJ ! -MY_JS_GLB+1
1166 IEND=IM-1-MOD(JJ,2)
1167 ISTART=IEND-MOD(JJ+1,2)
1168 KNTI=0
1169 IF(INPES==1)KNTI=grid%n_iup_adv(J)
1170 DO II=ISTART,IEND
1171 I=II ! -MY_IS_GLB+1
1172 grid%iup_adv(IMS+KNTI,J)=I
1173 KNTI=KNTI+1
1174 ENDDO
1175 grid%n_iup_adv(J)=KNTI
1176 ENDIF
1177 ENDDO
1178 ENDIF
1179 !----------------------------------------------------------------------
1180 jam=6+2*(JDE-JDS-1-9)
1181 !
1182 !*** EXTRACT em AND emt FOR THE LOCAL SUBDOMAINS
1183 !
1184 DO J=MYJS_P5,MYJE_P5
1185 grid%em_loc(J)=-9.E9
1186 grid%emt_loc(J)=-9.E9
1187 ENDDO
1188 !!! IF(IBROW==1)THEN
1189 IF(S_BDY)THEN
1190 DO J=3,5
1191 grid%em_loc(J)=grid%em(J-2)
1192 grid%emt_loc(J)=grid%emt(J-2)
1193 ENDDO
1194 ENDIF
1195 !!! IF(ITROW==1)THEN
1196 IF(N_BDY)THEN
1197 KNT=3
1198 DO JJ=JDE-5,JDE-3 ! JM-4,JM-2
1199 KNT=KNT+1
1200 J=JJ ! -MY_JS_GLB+1
1201 grid%em_loc(J)=grid%em(KNT)
1202 grid%emt_loc(J)=grid%emt(KNT)
1203 ENDDO
1204 ENDIF
1205 !!! IF(ILCOL==1)THEN
1206 IF(W_BDY)THEN
1207 KNT=6
1208 DO JJ=6,JDE-6 ! JM-5
1209 KNT=KNT+1
1210 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1211 J=JJ ! -MY_JS_GLB+1
1212 grid%em_loc(J)=grid%em(KNT)
1213 grid%emt_loc(J)=grid%emt(KNT)
1214 ENDIF
1215 ENDDO
1216 ENDIF
1217 !!! IF(IRCOL==1)THEN
1218 IF(E_BDY)THEN
1219 KNT=6+JDE-11 ! JM-10
1220 DO JJ=6,JDE-6 ! JM-5
1221 KNT=KNT+1
1222 IF(JJ>=MY_JS_GLB-2.AND.JJ<=MY_JE_GLB+2)THEN
1223 J=JJ ! -MY_JS_GLB+1
1224 grid%em_loc(J)=grid%em(KNT)
1225 grid%emt_loc(J)=grid%emt(KNT)
1226 ENDIF
1227 ENDDO
1228 ENDIF
1229 #else
1230 CALL wrf_message( 'start_domain_nmm: upstream advection commented out')
1231 #endif
1232 !
1233 !***
1234 !*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
1235 !***
1236 #ifdef HWRF
1237 !zhang'sdoing IF(NSTART.EQ.0)THEN
1238 IF(NSTART.EQ.0 .or. .not.allowed_to_read )THEN
1239 !zhang's doing ends
1240 #else
1241 IF(NSTART.EQ.0)THEN
1242 #endif
1243 !
1244 GRID%NSOIL= GRID%NUM_SOIL_LAYERS
1245 DO J=JFS,JFE
1246 DO I=IFS,IFE
1247 grid%pctsno(I,J)=-999.0
1248 IF(grid%sm(I,J)<0.5)THEN
1249 grid%cmc(I,J)=0.0
1250 ! grid%cmc(I,J)=grid%canwat(i,j) ! tgs
1251 IF(grid%sice(I,J)>0.5)THEN
1252 !***
1253 !*** SEA-ICE CASE
1254 !***
1255 grid%smstav(I,J)=1.0
1256 grid%smstot(I,J)=1.0
1257 grid%ssroff(I,J)=0.0
1258 grid%bgroff(I,J)=0.0
1259 grid%cmc(I,J)=0.0
1260 DO NS=1,GRID%NSOIL
1261 grid%smc(I,NS,J)=1.0
1262 ! grid%sh2o(I,NS,J)=0.05
1263 grid%sh2o(I,NS,J)=1.0
1264 ENDDO
1265 ENDIF
1266 ELSE
1267 !***
1268 !*** WATER CASE
1269 !***
1270 grid%smstav(I,J)=1.0
1271 grid%smstot(I,J)=1.0
1272 grid%ssroff(I,J)=0.0
1273 grid%bgroff(I,J)=0.0
1274 grid%soiltb(I,J)=273.16
1275 grid%grnflx(I,J)=0.
1276 grid%subshx(I,J)=0.0
1277 grid%acsnow(I,J)=0.0
1278 grid%acsnom(I,J)=0.0
1279 grid%snopcx(I,J)=0.0
1280 grid%cmc(I,J)=0.0
1281 grid%sno(I,J)=0.0
1282 DO NS=1,GRID%NSOIL
1283 grid%smc(I,NS,J)=1.0
1284 grid%stc(I,NS,J)=273.16
1285 ! grid%sh2o(I,NS,J)=0.05
1286 grid%sh2o(I,NS,J)=1.0
1287 ENDDO
1288 ENDIF
1289 !
1290 ENDDO
1291 ENDDO
1292 !
1293 grid%aphtim=0.0
1294 grid%aratim=0.0
1295 grid%acutim=0.0
1296 !
1297 ENDIF
1298 !
1299 !----------------------------------------------------------------------
1300 !*** INITIALIZE RADTN VARIABLES
1301 !*** CALCULATE THE NUMBER OF STEPS AT EACH POINT.
1302 !*** THE ARRAY 'lvl' WILL COORDINATE VERTICAL LOCATIONS BETWEEN
1303 !*** THE LIFTED WORKING ARRAYS AND THE FUNDAMENTAL MODEL ARRAYS.
1304 !*** lvl HOLDS THE HEIGHT (IN MODEL LAYERS) OF THE TOPOGRAPHY AT
1305 !*** EACH GRID POINT.
1306 !----------------------------------------------------------------------
1307 !
1308 DO J=JFS,JFE
1309 DO I=IFS,IFE
1310 grid%lvl(I,J)=LM-KTE
1311 ENDDO
1312 ENDDO
1313 !***
1314 !*** DETERMINE MODEL LAYER LIMITS FOR HIGH(3), MIDDLE(2),
1315 !*** AND LOW(1) CLOUDS. ALSO FIND MODEL LAYER THAT IS JUST BELOW
1316 !*** (HEIGHT-WISE) 400 MB. (K400)
1317 !***
1318 K400=0
1319 PSUM=grid%pt
1320 SLPM=101325.
1321 PDIF=SLPM-grid%pt
1322 DO K=1,LM
1323 PSUM=PSUM+grid%deta(K)*PDIF
1324 IF(LPTOP(3)==0)THEN
1325 IF(PSUM>PHITP)LPTOP(3)=K
1326 ELSEIF(LPTOP(2)==0)THEN
1327 IF(PSUM>PMDHI)LPTOP(2)=K
1328 ELSEIF(K400==0)THEN
1329 IF(PSUM>P400)K400=K
1330 ELSEIF(LPTOP(1)==0)THEN
1331 IF(PSUM>PLOMD)LPTOP(1)=K
1332 ENDIF
1333 ENDDO
1334 !***
1335 !*** CALL GRADFS ONCE TO CALC. CONSTANTS AND GET O3 DATA
1336 !***
1337 KCCO2=0
1338 !***
1339 !*** CALCULATE THE MIDLAYER PRESSURES IN THE STANDARD ATMOSPHERE
1340 !***
1341 PSS=101325.
1342 PDIF=PSS-grid%pt
1343 !
1344 ALLOCATE(PHALF(LM+1),STAT=I)
1345 !
1346 DO K=KPS,KPE-1
1347 PHALF(K+1)=grid%aeta(K)*PDIF+grid%pt
1348 ENDDO
1350 !
1351 PHALF(1)=0.
1352 PHALF(LM+1)=PSS
1353 !***
1354 !!! CALL GRADFS(PHALF,KCCO2,NUNIT_CO2)
1355 !***
1356 !*** CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE
1357 !***
1358 !!! IF(MYPE==0)CALL SOLARD(SUN_DIST)
1359 !!! CALL MPI_BCAST(SUN_DIST,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
1361 !***
1362 !*** CALL ZENITH SIMPLY TO GET THE DAY OF THE YEAR FOR
1363 !*** THE SETUP OF THE OZONE DATA
1364 !***
1365 TIME=(grid%ntsd-1)*GRID%DT
1366 !
1367 !!! CALL ZENITH(TIME,DAYI,HOUR)
1368 !
1369 ADDL=0.
1370 IF(MOD(IDAT(3),4)==0)ADDL=1.
1371 !
1372 !!! CALL O3CLIM
1373 !
1374 !
1375 DEALLOCATE(PHALF)
1376 !----------------------------------------------------------------------
1377 !*** SOME INITIAL VALUES RELATED TO TURBULENCE SCHEME
1378 !----------------------------------------------------------------------
1379 !
1380 IF(allowed_to_read.and.(.NOT.RESTRT))THEN ! This is gopal's inclusion for moving nest
1382 DO J=JFS,JFE
1383 DO I=IFS,IFE
1384 !***
1385 !*** TRY A SIMPLE LINEAR INTERP TO GET 2/10 M VALUES
1386 !***
1387 #ifdef HWRF
1388 !zhang's doing
1389 IF(.NOT.RESTRT .OR. .NOT.allowed_to_read) then
1390 grid%PDSL(I,J)=grid%PD(I,J)*grid%RES(I,J)
1391 endif
1392 !end of zhang's doing
1393 #else
1394 grid%PDSL(I,J)=grid%PD(I,J)*grid%RES(I,J)
1395 #endif
1396 !
1397 ULM=grid%u(I,J,KTS)
1398 VLM=grid%v(I,J,KTS)
1399 TLM=grid%t(I,J,KTS)
1400 QLM=grid%q(I,J,KTS)
1401 PLM=grid%aeta1(KTS)*grid%pdtop+grid%aeta2(KTS)*grid%pdsl(I,J)+grid%pt
1402 APELM=(1.0E5/PLM)**CAPA
1403 TERM1=-0.068283/grid%t(I,J,KTS)
1404 grid%pshltr(I,J)=(grid%pd(I,J)+grid%pdtop+grid%pt)*EXP(TERM1)
1405 APELMNW=(1.0E5/grid%pshltr(I,J))**CAPA
1406 THLM=TLM*APELM
1407 DPLM=(grid%deta1(KTS)*grid%pdtop+grid%deta2(KTS)*grid%pdsl(I,J))*0.5
1408 DZLM=R_D*DPLM*TLM*(1.+P608*QLM)/(G*PLM)
1409 FAC1=10./DZLM
1410 FAC2=(DZLM-10.)/DZLM
1411 IF(DZLM<=10.)THEN
1412 FAC1=1.
1413 FAC2=0.
1414 ENDIF
1415 !
1416 #ifdef HWRF
1417 !zhang's doing
1418 IF(.NOT.RESTRT .OR. .NOT.allowed_to_read)THEN
1419 !end of zhang's doing
1420 #else
1421 IF(.NOT.RESTRT)THEN
1422 #endif
1423 grid%th10(I,J)=FAC2*grid%ths(I,J)+FAC1*THLM
1424 grid%q10(I,J)=FAC2*grid%qsh(I,J)+FAC1*QLM
1425 #ifdef HWRF
1426 IF(grid%sm(I,J).LT.0.5)THEN
1427 grid%u10(I,J)=ULM*(log(10./grid%z0(I,J))/log(DZLM/grid%z0(I,J))) ! this is all Qingfu's doing
1428 grid%v10(I,J)=VLM*(log(10./grid%z0(I,J))/log(DZLM/grid%z0(I,J)))
1429 ZOQING=1.944*SQRT(grid%u10(I,J)*grid%u10(I,J)+grid%v10(I,J)*grid%v10(I,J))
1430 IF(ZOQING.GT.60.)THEN
1431 grid%u10(I,J)=grid%u10(I,J)*(1.12-7.2/ZOQING)
1432 grid%v10(I,J)=grid%v10(I,J)*(1.12-7.2/ZOQING)
1433 ENDIF
1434 ELSE
1435 ZOQING=(0.074*SQRT(ULM*ULM+VLM*VLM)-0.58)*1.0e-3
1436 ZOQING=MAX(ZOQING,grid%z0(I,J)) ! for winds greater than 12.5 m/s
1437 grid%u10(I,J)=ULM*(log(10./ZOQING))/log(DZLM/ZOQING) ! this is all Qingfu's doing
1438 grid%v10(I,J)=VLM*(log(10./ZOQING))/log(DZLM/ZOQING)
1439 ZOQING=1.944*SQRT(grid%u10(I,J)*grid%u10(I,J)+grid%v10(I,J)*grid%v10(I,J))
1440 IF(ZOQING.GT.60.)THEN
1441 grid%u10(I,J)=grid%u10(I,J)*(1.12-7.2/ZOQING)
1442 grid%v10(I,J)=grid%v10(I,J)*(1.12-7.2/ZOQING)
1443 END IF
1444 ENDIF
1445 #else
1446 grid%u10(I,J)=ULM
1447 grid%v10(I,J)=VLM
1448 #endif
1449 ENDIF
1450 !
1451 ! FAC1=2./DZLM
1452 ! FAC2=(DZLM-2.)/DZLM
1453 ! IF(DZLM.LE.2.)THEN
1454 ! FAC1=1.
1455 ! FAC2=0.
1456 ! ENDIF
1457 !
1458 IF(.NOT.RESTRT.OR.NEST)THEN
1459 !
1460 IF ( (THLM-grid%ths(I,J))>2.0) THEN ! weight differently in different scenarios
1461 FAC1=0.3
1462 FAC2=0.7
1463 ELSE
1464 FAC1=0.8
1465 FAC2=0.2
1466 ENDIF
1468 #ifdef HWRF
1469 grid%tshltr(I,J)=0.2*grid%ths(I,J)+0.8*THLM
1470 grid%qshltr(I,J)=0.2*grid%qsh(I,J)+0.8*QLM
1471 #else
1472 grid%tshltr(I,J)=FAC2*grid%ths(I,J)+FAC1*THLM
1473 grid%qshltr(I,J)=FAC2*grid%qsh(I,J)+FAC1*QLM
1474 #endif
1475 ENDIF
1476 !***
1477 !*** NEED TO CONVERT TO THETA IF IS THE RESTART CASE
1478 !*** AS CHKOUT.f WILL CONVERT TO TEMPERATURE
1479 !***
1480 !EROGERS: COMMENT OUT IN WRF-NMM
1481 !***
1482 ! IF(RESTRT)THEN
1483 ! grid%tshltr(I,J)=grid%tshltr(I,J)*APELMNW
1484 ! ENDIF
1485 ENDDO
1486 ENDDO
1488 END IF ! IF(allowed_to_read)THEN
1489 !
1490 !----------------------------------------------------------------------
1491 !*** INITIALIZE TAU-1 VALUES FOR ADAMS-BASHFORTH
1492 !----------------------------------------------------------------------
1493 !
1494 #ifdef HWRF
1495 !zhang's doing
1496 IF(.NOT.RESTRT .OR. .NOT.allowed_to_read)THEN !zhang's doing
1497 #else
1498 IF(.NOT.RESTRT)THEN
1499 #endif
1500 DO K=KPS,KPE
1501 DO J=JFS,JFE
1502 DO I=ifs,ife
1503 grid%told(I,J,K)=grid%t(I,J,K) ! grid%t AT TAU-1
1504 grid%uold(I,J,K)=grid%u(I,J,K) ! grid%u AT TAU-1
1505 grid%vold(I,J,K)=grid%v(I,J,K) ! grid%v AT TAU-1
1506 ENDDO
1507 ENDDO
1508 ENDDO
1509 ENDIF
1510 !
1511 !----------------------------------------------------------------------
1512 !*** INITIALIZE NONHYDROSTATIC QUANTITIES
1513 !----------------------------------------------------------------------
1514 !
1515 !!!! SHOULD grid%dwdt BE REDEFINED IF RESTRT?
1517 IF((.NOT.RESTRT.OR.NEST).AND. allowed_to_read)THEN ! This is gopal's inclusion for moving nest
1518 DO K=KPS,KPE
1519 DO J=JFS,JFE
1520 DO I=IFS,IFE
1521 grid%dwdt(I,J,K)=1.
1522 ENDDO
1523 ENDDO
1524 ENDDO
1525 ENDIF
1526 !***
1527 #ifdef HWRF
1528 IF(.NOT.RESTRT .OR. .NOT.allowed_to_read) THEN !zhang's doing
1529 #endif
1530 IF(GRID%SIGMA==1)THEN
1531 DO J=JFS,JFE
1532 DO I=IFS,IFE
1533 grid%pdsl(I,J)=grid%pd(I,J)
1534 ENDDO
1535 ENDDO
1536 ELSE
1537 DO J=JFS,JFE
1538 DO I=IFS,IFE
1539 grid%pdsl(I,J)=grid%res(I,J)*grid%pd(I,J)
1540 ENDDO
1541 ENDDO
1542 ENDIF
1543 #ifdef HWRF
1544 ENDIF !zhang's doing
1545 #endif
1546 !
1547 !***
1548 !
1549 !
1550 !!!! SHOULD pint,z,w BE REDEFINED IF RESTRT?
1552 WRITE( wrf_err_message, * )' restrt=',restrt,' nest=',nest
1553 CALL wrf_debug( 0, TRIM(wrf_err_message) )
1554 WRITE( wrf_err_message, * )' grid%pdtop=',grid%pdtop,' grid%pt=',grid%pt
1555 CALL wrf_debug( 0, TRIM(wrf_err_message) )
1556 #ifdef HWRF
1557 !zhang's doing
1558 IF(.NOT.RESTRT.OR.NEST .OR. .NOT.allowed_to_read)THEN
1559 !end of zhang's doing
1560 #else
1561 IF(.NOT.RESTRT.OR.NEST)THEN
1562 #endif
1563 DO K=KPS,KPE
1564 DO J=JFS,JFE
1565 DO I=IFS,IFE
1566 grid%pint(I,J,K)=grid%eta1(K)*grid%pdtop+grid%eta2(K)*grid%pdsl(I,J)+grid%pt
1567 grid%z(I,J,K)=grid%pint(I,J,K)
1568 grid%w(I,J,K)=0.
1569 #ifdef IDEAL_NMM_TC
1570 grid%f(I,J)=0.5*GRID%DT*3.15656e-5 ! IDEAL CASE 0.5*DT*f (and not f!)
1571 #endif
1572 ENDDO
1573 ENDDO
1574 ENDDO
1575 ENDIF
1576 #ifdef HWRF
1577 !zhang's doing
1578 IF(.NOT.RESTRT.OR.NEST .OR. .NOT.allowed_to_read)THEN
1579 #endif
1581 DO K=KTS,KTE-1
1582 DO J=JFS,JFE
1583 DO I=IFS,IFE
1584 grid%rtop(I,J,K)=(grid%q(I,J,K)*P608-grid%cwm(I,J,K)+1.)*grid%t(I,J,K)*R_D/ &
1585 ((grid%pint(I,J,K+1)+grid%pint(I,J,K))*0.5)
1586 ENDDO
1587 ENDDO
1588 ENDDO
1589 #ifdef HWRF
1590 ENDIF !zhang
1591 #endif
1593 #ifdef HWRF
1594 hwrfx_mslp: if(grid%vortex_tracker /= 1) then
1595 ! XUEJIN's doing
1596 ! add to output MSLP at the initial time
1597 !
1598 ! COMPUTATION OF MSLP ! This is gopal's doing
1599 !
1602 DO J=JFS,JFE
1603 DO I=IFS,IFE
1604 grid%Z(I,J,1)=grid%FIS(I,J)*GI
1605 ENDDO
1606 ENDDO
1608 DO K=KPS,2
1609 DO J=JFS,JFE
1610 DO I=IFS,IFE
1611 APELP = (grid%PINT(I,J,K+1)+grid%PINT(I,J,K))
1612 RTOPP = TRG*grid%T(I,J,K)*(1.0+grid%Q(I,J,K)*P608)/APELP
1613 DZ = RTOPP*(grid%DETA1(K)*grid%PDTOP+grid%DETA2(K)*grid%PD(I,J))
1614 grid%Z(I,J,K+1) = grid%Z(I,J,K) + DZ
1615 ENDDO
1616 ENDDO
1617 ENDDO
1619 grid%MSLP=-9999.99
1620 DO J=JFS,JFE
1621 DO I=IFS,IFE
1622 SFCT = grid%T(I,J,1)*(1.+D608*grid%Q(I,J,1)) + LAPSR*(grid%Z(I,J,1)+grid%Z(I,J,2))*0.5
1623 A = LAPSR*grid%Z(I,J,1)/SFCT
1624 grid%MSLP(I,J) = grid%PINT(I,J,1)*(1-A)**COEF2
1625 ENDDO
1626 ENDDO
1628 ! SET BACK Z AS IN ORIGINAL CODE
1630 DO K=KPS,KPE
1631 DO J=JFS,JFE
1632 DO I=IFS,IFE
1633 grid%Z(I,J,K)=grid%PINT(I,J,K)
1634 ENDDO
1635 ENDDO
1636 ENDDO
1638 endif hwrfx_mslp
1639 #endif
1642 #ifndef NO_RESTRICT_ACCEL
1643 !----------------------------------------------------------------------
1644 !*** RESTRICTING THE ACCELERATION ALONG THE BOUNDARIES
1645 !----------------------------------------------------------------------
1646 !
1647 DO J=JFS,JFE
1648 DO I=IFS,IFE
1649 grid%dwdtmn(I,J)=-EPSIN
1650 grid%dwdtmx(I,J)= EPSIN
1651 ENDDO
1652 ENDDO
1653 !
1654 !***
1655 IF(JHL>1)THEN
1656 JHH=JDE-1-JHL+1 ! JM-JHL+1
1657 IHL=JHL/2+1
1658 !
1659 DO J=1,JHL
1660 IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1661 JX=J ! -MY_JS_GLB+1
1662 DO I=1,IDE-1 ! IM
1663 IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1664 IX=I ! -MY_IS_GLB+1
1665 grid%dwdtmn(IX,JX)=-EPSB
1666 grid%dwdtmx(IX,JX)= EPSB
1667 ENDIF
1668 ENDDO
1669 ENDIF
1670 ENDDO
1671 !
1672 DO J=JHH,JDE-1 ! JM
1673 IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1674 JX=J ! -MY_JS_GLB+1
1675 DO I=1,IDE-1 ! IM
1676 IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1677 IX=I ! -MY_IS_GLB+1
1678 grid%dwdtmn(IX,JX)=-EPSB
1679 grid%dwdtmx(IX,JX)= EPSB
1680 ENDIF
1681 ENDDO
1682 ENDIF
1683 ENDDO
1684 !
1685 DO J=1,JDE-1 ! JM
1686 IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1687 JX=J ! -MY_JS_GLB+1
1688 DO I=1,IHL
1689 IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1690 IX=I ! -MY_IS_GLB+1
1691 grid%dwdtmn(IX,JX)=-EPSB
1692 grid%dwdtmx(IX,JX)= EPSB
1693 ENDIF
1694 ENDDO
1695 ENDIF
1696 ENDDO
1697 !
1698 DO J=1,JDE-1 ! JM
1699 IF(J>=MY_JS_GLB-JBPAD2.AND.J<=MY_JE_GLB+JTPAD2)THEN
1700 JX=J ! -MY_JS_GLB+1
1701 ! moved this line to inside the J-loop, 20030429, jm
1702 IHH=IDE-1-IHL+MOD(J,2) ! IM-IHL+MOD(J,2)
1703 DO I=IHH,IDE-1 ! IM
1704 IF(I>=MY_IS_GLB-ILPAD2.AND.I<=MY_IE_GLB+IRPAD2)THEN
1705 IX=I ! -MY_IS_GLB+1
1706 grid%dwdtmn(IX,JX)=-EPSB
1707 grid%dwdtmx(IX,JX)= EPSB
1708 ENDIF
1709 ENDDO
1710 ENDIF
1711 ENDDO
1712 !
1713 ENDIF
1715 #else
1716 CALL wrf_message('start_domain_nmm: NO_RESTRICT_ACCEL')
1717 #endif
1719 !-----------------------------------------------------------------------
1720 !*** CALL THE GENERAL PHYSICS INITIALIZATION
1721 !-----------------------------------------------------------------------
1722 !
1724 ALLOCATE(SFULL(KMS:KME),STAT=I) ; SFULL = 0.
1725 ALLOCATE(SMID(KMS:KME),STAT=I) ; SMID = 0.
1726 ALLOCATE(EMISS(IMS:IME,JMS:JME),STAT=I) ; EMISS = 0.
1727 ALLOCATE(EMTEMP(IMS:IME,JMS:JME),STAT=I) ; EMTEMP = 0.
1728 ALLOCATE(GLW(IMS:IME,JMS:JME),STAT=I) ; GLW = 0.
1729 ALLOCATE(HFX(IMS:IME,JMS:JME),STAT=I) ; HFX = 0.
1730 ALLOCATE(LOWLYR(IMS:IME,JMS:JME),STAT=I) ; LOWLYR = 0.
1731 ! ALLOCATE(grid%mavail(IMS:IME,JMS:JME),STAT=I) ; grid%mavail = 0.
1732 ALLOCATE(NCA(IMS:IME,JMS:JME),STAT=I) ; NCA = 0.
1733 ALLOCATE(QFX(IMS:IME,JMS:JME),STAT=I) ; QFX = 0.
1734 ALLOCATE(RAINBL(IMS:IME,JMS:JME),STAT=I) ; RAINBL = 0.
1735 ALLOCATE(RAINC(IMS:IME,JMS:JME),STAT=I) ; RAINC = 0.
1736 ALLOCATE(RAINNC(IMS:IME,JMS:JME),STAT=I) ; RAINNC = 0.
1737 ALLOCATE(RAINNCV(IMS:IME,JMS:JME),STAT=I) ; RAINNCV = 0.
1738 ALLOCATE(SNOWNC(IMS:IME,JMS:JME),STAT=I) ; SNOWNC = 0.
1739 ALLOCATE(SNOWNCV(IMS:IME,JMS:JME),STAT=I) ; SNOWNCV = 0.
1740 ALLOCATE(GRAUPELNC(IMS:IME,JMS:JME),STAT=I) ; GRAUPELNC = 0.
1741 ALLOCATE(GRAUPELNCV(IMS:IME,JMS:JME),STAT=I) ; GRAUPELNCV = 0.
1743 ALLOCATE(ZS(KMS:KME),STAT=I) ; ZS = 0.
1744 ALLOCATE(SNOWC(IMS:IME,JMS:JME),STAT=I) ; SNOWC = 0.
1745 ALLOCATE(THC(IMS:IME,JMS:JME),STAT=I) ; THC = 0.
1746 ALLOCATE(TMN(IMS:IME,JMS:JME),STAT=I) ; TMN = 0.
1747 ALLOCATE(TSFC(IMS:IME,JMS:JME),STAT=I) ; TSFC = 0.
1748 ALLOCATE(Z0_DUM(IMS:IME,JMS:JME),STAT=I) ; Z0_DUM = 0.
1749 ALLOCATE(ALBEDO_DUM(IMS:IME,JMS:JME),STAT=I) ; ALBEDO_DUM = 0.
1751 ALLOCATE(DZS(KMS:KME),STAT=I) ; DZS = 0.
1752 ALLOCATE(RQCBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCBLTEN = 0.
1753 ALLOCATE(RQIBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQIBLTEN = 0.
1754 ALLOCATE(RQVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVBLTEN = 0.
1755 ALLOCATE(RTHBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHBLTEN = 0.
1756 ALLOCATE(RUBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RUBLTEN = 0.
1757 ALLOCATE(RVBLTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RVBLTEN = 0.
1758 ALLOCATE(RQCCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCCUTEN = 0.
1759 ALLOCATE(RQICUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQICUTEN = 0.
1760 ALLOCATE(RQRCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQRCUTEN = 0.
1761 ALLOCATE(RQSCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQSCUTEN = 0.
1762 ALLOCATE(RQVCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVCUTEN = 0.
1763 ALLOCATE(RTHCUTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHCUTEN = 0.
1764 ALLOCATE(RUSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RUSHTEN = 0.
1765 ALLOCATE(RVSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RVSHTEN = 0.
1766 ALLOCATE(RQCSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQCSHTEN = 0.
1767 ALLOCATE(RQISHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQISHTEN = 0.
1768 ALLOCATE(RQRSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQRSHTEN = 0.
1769 ALLOCATE(RQSSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQSSHTEN = 0.
1770 ALLOCATE(RQGSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQGSHTEN = 0.
1771 ALLOCATE(RQVSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RQVSHTEN = 0.
1772 ALLOCATE(RTHSHTEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHSHTEN = 0.
1773 ALLOCATE(RTHRATEN(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATEN = 0.
1774 ALLOCATE(RTHRATENLW(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATENLW = 0.
1775 ALLOCATE(RTHRATENSW(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RTHRATENSW = 0.
1776 ALLOCATE(ZINT(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; ZINT = 0.
1777 ALLOCATE(CONVFAC(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CONVFAC = 0.
1778 ALLOCATE(PINT_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; PINT_TRANS = 0.
1779 ALLOCATE(T_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; T_TRANS = 0.
1780 ALLOCATE(RRI(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; RRI = 0.
1781 ALLOCATE(CLDFRA_TRANS(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_TRANS = 0.
1782 #ifndef WRF_CHEM
1783 ALLOCATE(CLDFRA_OLD(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; CLDFRA_OLD = 0.
1784 #endif
1785 #if 0
1786 ALLOCATE(w0avg(IMS:IME,KMS:KME,JMS:JME),STAT=I) ; w0avg = 0.
1787 #endif
1788 !-----------------------------------------------------------------------
1789 !jm added set of g_inv
1790 G_INV=1./G
1791 ROG=R_D*G_INV
1792 GRID%RADT=GRID%NRADS*GRID%DT/60.
1793 GRID%BLDT=GRID%NPHS*GRID%DT/60.
1794 GRID%CUDT=GRID%NCNVC*GRID%DT/60.
1795 GRID%GSMDT=GRID%NPHS*GRID%DT/60.
1796 !
1797 DO J=MYJS,MYJE
1798 DO I=MYIS,MYIE
1799 SFCZ=grid%fis(I,J)*G_INV
1800 ZINT(I,KTS,J)=SFCZ
1801 #ifdef HWRF
1802 !zhang's doing
1803 IF(.NOT.RESTRT .OR. .NOT.allowed_to_read) then
1804 grid%PDSL(I,J)=grid%PD(I,J)*grid%RES(I,J)
1805 endif
1806 !end of zhang's doing
1807 #else
1808 grid%pdsl(I,J)=grid%pd(I,J)*grid%res(I,J)
1809 #endif
1810 PSURF=grid%pint(I,J,KTS)
1811 EXNSFC=(1.E5/PSURF)**CAPA
1812 grid%xland(I,J)=grid%sm(I,J)+1.
1813 THSIJ=(grid%sst(I,J)*EXNSFC)*(grid%xland(I,J)-1.) &
1814 & +grid%ths(I,J)*(2.-grid%sm(I,J))
1815 TSFC(I,J)=THSIJ/EXNSFC
1816 !
1817 DO K=KTS,KTE-1
1818 PLYR=(grid%pint(I,J,K)+grid%pint(I,J,K+1))*0.5
1819 TL=grid%t(I,J,K)
1820 CWML=grid%cwm(I,J,K)
1821 RRI(I,K,J)=R_D*TL*(1.+P608*grid%q(I,J,K))/PLYR
1822 ZINT(I,K+1,J)=ZINT(I,K,J)+TL/PLYR &
1823 *(grid%deta1(K)*grid%pdtop+grid%deta2(K)*grid%pdsl(I,J))*ROG &
1824 *(grid%q(I,J,K)*P608-CWML+1.)
1825 ENDDO
1826 !
1827 ! DO K=KTS,KTE
1828 !!! ZMID(I,K,J)=0.5*(ZINT(I,K,J)+ZINT(I,K+1,J))
1829 ! ENDDO
1830 ENDDO
1831 ENDDO
1832 !
1833 !-----------------------------------------------------------------------
1834 !*** RECREATE SIGMA VALUES AT LAYER INTERFACES FOR THE FULL VERTICAL
1835 !*** DOMAIN FROM THICKNESS VALUES FOR THE TWO SUBDOMAINS.
1836 !*** NOTE: KTE=NUMBER OF LAYERS PLUS ONE
1837 !-----------------------------------------------------------------------
1838 !
1839 PDTOT=101325.-grid%pt
1840 RPDTOT=1./PDTOT
1841 PDBOT=PDTOT-grid%pdtop
1842 SFULL(KTS)=1.
1843 SFULL(KTE)=0.
1844 DSIGSUM = 0.
1845 DO K=KTS+1,KTE
1846 DSIG=(grid%deta1(K-1)*grid%pdtop+grid%deta2(K-1)*PDBOT)*RPDTOT
1847 DSIGSUM=DSIGSUM+DSIG
1848 SFULL(K)=SFULL(K-1)-DSIG
1849 SMID(K-1)=0.5*(SFULL(K-1)+SFULL(K))
1850 ENDDO
1851 DSIG=(grid%deta1(KTE-1)*grid%pdtop+grid%deta2(KTE-1)*PDBOT)*RPDTOT
1852 DSIGSUM=DSIGSUM+DSIG
1853 SMID(KTE-1)=0.5*(SFULL(KTE-1)+SFULL(KTE))
1854 !
1855 !-----------------------------------------------------------------------
1857 #ifdef HWRF
1858 !zhang's doing
1859 if(.NOT.RESTRT .OR. .NOT.allowed_to_read)grid%LU_INDEX=grid%IVGTYP
1860 !end of zhang's doing
1861 #else
1862 grid%lu_index=grid%ivgtyp
1863 #endif
1865 IF(.NOT.RESTRT)THEN
1866 DO J=MYJS,MYJE
1867 DO I=MYIS,MYIE
1868 Z0_DUM(I,J)=grid%z0(I,J) ! hold
1869 ALBEDO_DUM(I,J)=grid%albedo(I,J) ! Save albedos
1870 ENDDO
1871 ENDDO
1872 ENDIF
1873 !
1874 !*** Always define the quantity grid%z0base
1876 IF(.NOT.RESTRT)THEN
1877 DO J=MYJS,MYJE
1878 DO I=MYIS,MYIE
1879 !
1880 IF(grid%sm(I,J)==0)then
1881 grid%z0base(I,J)=VZ0TBL_24(grid%ivgtyp(I,J))+Z0LAND
1882 ELSE
1883 grid%z0base(I,J)=VZ0TBL_24(grid%ivgtyp(I,J))+Z0SEA
1884 ENDIF
1885 !
1886 ENDDO
1887 ENDDO
1888 ENDIF
1889 !
1890 ! when allocating CAM radiation 4d arrays (ozmixm, aerosolc) these are not needed
1891 num_ozmixm=1
1892 num_aerosolc=1
1894 ! Set GMT, JULDAY, and JULYR outside of phy_init because it is no longer
1895 ! called inside phy_init due to moving nest changes. (When nests move
1896 ! phy_init may not be called on a process if, for example, it is a moving
1897 ! nest and if this part of the domain is not being initialized (not the
1898 ! leading edge).) Calling domain_setgmtetc() here will avoid this problem
1899 ! when NMM moves to moving nests.
1900 CALL domain_setgmtetc( GRID, START_OF_SIMULATION )
1902 if(restrt) then
1903 #ifdef HWRF
1904 !zhang
1905 CALL nl_get_julyr (grid%id, grid%julyr)
1906 CALL nl_get_julday (grid%id, grid%julday)
1907 CALL nl_get_gmt (grid%id, grid%gmt)
1908 !zhang end
1909 #else
1910 CALL domain_clock_get( grid, current_time=currentTime )
1911 CALL WRFU_TimeGet( currentTime, YY=grid%julyr, dayOfYear=grid%julday, &
1912 H=hr, M=mn, S=sec, MS=ms, rc=rc)
1913 grid%gmt=hr+real(mn)/60.+real(sec)/3600.+real(ms)/(1000*3600)
1914 WRITE( wrf_err_message , * ) 'DEBUG start_domain_nmm(): gmt = ',grid%gmt
1915 CALL wrf_debug( 150, TRIM(wrf_err_message) )
1916 #endif
1917 endif
1919 ! Several arguments are RCONFIG entries in Registry.NMM. Registry no longer
1920 ! includes these as dummy arguments or declares them. Access them from
1921 ! GRID. JM 20050819
1922 #ifndef WRF_NMM_NEST
1923 grid%moved = .FALSE.
1924 #endif
1926 IF (GRID%RESTART) THEN
1927 LRESTART = GRID%RESTART
1928 ELSE
1929 IF (grid%moved) THEN
1930 LRESTART = .TRUE.
1931 ELSE
1932 LRESTART = .FALSE.
1933 ENDIF
1934 END IF
1936 CALL PHY_INIT(GRID%ID,CONFIG_FLAGS,GRID%DT,LRESTART,SFULL,SMID &
1937 & ,grid%pt,TSFC,GRID%RADT,GRID%BLDT,GRID%CUDT,GRID%GSMDT &
1938 & ,grid%DUCUDT, grid%DVCUDT &
1939 & ,RTHCUTEN, RQVCUTEN, RQRCUTEN &
1940 & ,RQCCUTEN, RQSCUTEN, RQICUTEN &
1941 & ,RUSHTEN, RVSHTEN, RTHSHTEN &
1942 & ,RQVSHTEN, RQRSHTEN, RQCSHTEN &
1943 & ,RQSSHTEN, RQISHTEN, RQGSHTEN &
1944 & ,RUBLTEN,RVBLTEN,RTHBLTEN &
1945 & ,RQVBLTEN,RQCBLTEN,RQIBLTEN &
1946 & ,RTHRATEN,RTHRATENLW,RTHRATENSW &
1947 & ,STEPBL,STEPRA,STEPCU &
1948 & ,grid%w0avg, RAINNC, RAINC, grid%raincv, RAINNCV &
1949 & ,SNOWNC, SNOWNCV, GRAUPELNC, GRAUPELNCV &
1950 & ,NCA,GRID%SWRAD_SCAT &
1951 & ,grid%cldefi,LOWLYR &
1952 & ,grid%mass_flux &
1953 & ,grid%rthften, grid%rqvften &
1954 & ,CLDFRA_TRANS,CLDFRA_OLD,GLW,grid%gsw,EMISS,EMTEMP,grid%lu_index&
1955 & ,GRID%LANDUSE_ISICE, GRID%LANDUSE_LUCATS &
1956 & ,GRID%LANDUSE_LUSEAS, GRID%LANDUSE_ISN &
1957 & ,GRID%LU_STATE &
1958 & ,grid%xlat,grid%xlong,grid%albedo,grid%albbck &
1959 & ,GRID%GMT,GRID%JULYR,GRID%JULDAY &
1960 & ,GRID%LEVSIZ, NUM_OZMIXM, NUM_AEROSOLC, GRID%PAERLEV &
1961 & ,TMN,grid%xland,grid%znt,grid%z0,grid%ustar,grid%mol,grid%pblh,grid%tke_pbl &
1962 & ,grid%exch_h,THC,SNOWC,grid%mavail,HFX,QFX,RAINBL &
1963 & ,grid%stc,grid%sldpth,grid%DZSoil,GRID%NUM_SOIL_LAYERS,WARM_RAIN &
1964 & ,ADV_MOIST_COND &
1965 & ,grid%apr_gr,grid%apr_w,grid%apr_mc,grid%apr_st,grid%apr_as &
1966 & ,grid%apr_capma,grid%apr_capme,grid%apr_capmi &
1967 & ,grid%xice,grid%xice,grid%vegfra,grid%snow,grid%canwat,grid%smstav &
1968 & ,grid%smstot, grid%sfcrunoff,grid%udrunoff,grid%grdflx,grid%acsnow &
1969 & ,grid%acsnom,grid%ivgtyp,grid%isltyp,grid%sfcevp,grid%smc &
1970 & ,grid%sh2o, grid%snowh, grid%smfr3d & ! temporary
1971 & ,grid%SNOALB &
1972 & ,GRID%DX,GRID%DY,grid%f_ice_phy,grid%f_rain_phy,grid%f_rimef_phy &
1973 & ,grid%mp_restart_state,grid%tbpvs_state,grid%tbpvs0_state &
1974 & ,ALLOWED_TO_READ,grid%moved,START_OF_SIMULATION &
1975 & ,1 & ! lagday
1976 & ,IDS, IDE, JDS, JDE, KDS, KDE &
1977 & ,IMS, IME, JMS, JME, KMS, KME &
1978 & ,ITS, ITE, JTS, JTE, KTS, KTE &
1979 & ,NUM_URBAN_LAYERS &
1980 & ,GRID%RAINCV_A,GRID%RAINCV_B &
1981 & ,ISNOWXY=grid%ISNOWXY, ZSNSOXY=grid%ZSNSOXY, TSNOXY=grid%TSNOXY, & ! Optional Noah-MP
1982 & SNICEXY=grid%SNICEXY, SNLIQXY=grid%SNLIQXY, TVXY=grid%TVXY, & ! Optional Noah-MP
1983 & TGXY=grid%TGXY, CANICEXY=grid%CANICEXY, & ! Optional Noah-MP
1984 & CANLIQXY=grid%CANLIQXY, EAHXY=grid%EAHXY, & ! Optional Noah-MP
1985 & TAHXY=grid%TAHXY, CMXY=grid%CMXY, & ! Optional Noah-MP
1986 & CHXY=grid%CHXY, FWETXY=grid%FWETXY, SNEQVOXY=grid%SNEQVOXY, & ! Optional Noah-MP
1987 & ALBOLDXY=grid%ALBOLDXY, QSNOWXY=grid%QSNOWXY, & ! Optional Noah-MP
1988 & WSLAKEXY=grid%WSLAKEXY, ZWTXY=grid%ZWTXY, WAXY=grid%WAXY, & ! Optional Noah-MP
1989 & WTXY=grid%WTXY, LFMASSXY=grid%LFMASSXY, RTMASSXY=grid%RTMASSXY, & ! Optional Noah-MP
1990 & STMASSXY=grid%STMASSXY, WOODXY=grid%WOODXY, & ! Optional Noah-MP
1991 & STBLCPXY=grid%STBLCPXY, FASTCPXY=grid%FASTCPXY, & ! Optional Noah-MP
1992 & XSAIXY=grid%XSAIXY, & ! Optional Noah-MP
1993 & T2MVXY=grid%T2MVXY, T2MBXY=grid%T2MBXY, CHSTARXY=grid%CHSTARXY & ! Optional Noah-MP
1994 & )
1996 #ifdef HWRF
1997 !zhang's doing
1998 grid%julyr_rst=grid%julyr_rst
1999 grid%julday_rst=grid%julday_rst
2000 grid%gmt_rst=grid%gmt_rst
2001 !end of zhang's doing
2002 #endif
2003 !-----------------------------------------------------------------------
2004 !---- Initialization for gravity wave drag (GWD) & mountain blocking (MB)
2005 !
2006 CALL nl_get_cen_lat(GRID%ID, CEN_LAT) !-- CEN_LAT in deg
2007 CALL nl_get_cen_lon(GRID%ID, CEN_LON) !-- CEN_LON in deg
2008 DTPHS=grid%dt*grid%nphs
2009 CALL GWD_init(DTPHS,GRID%DX,GRID%DY,CEN_LAT,CEN_LON,RESTRT &
2010 & ,grid%glat,grid%glon,grid%crot,grid%srot,grid%hangl &
2011 & ,IDS,IDE,JDS,JDE,KDS,KDE &
2012 & ,IMS,IME,JMS,JME,KMS,KME &
2013 & ,ITS,ITE,JTS,JTE,KTS,KTE )
2014 IF(.NOT.RESTRT)THEN
2015 DO J=MYJS,MYJE
2016 DO I=MYIS,MYIE
2017 grid%ugwdsfc(I,J)=0.
2018 grid%vgwdsfc(I,J)=0.
2019 ENDDO
2020 ENDDO
2021 ENDIF
2023 !-----------------------------------------------------------------------
2024 !
2025 #ifdef HWRF
2026 IF(NSTART.EQ.0 .or. .not.allowed_to_read )THEN
2027 #else
2028 IF(NSTART==0)THEN
2029 #endif
2031 DO J=JMS,JME
2032 DO I=IMS,IME
2033 grid%z0(I,J)=grid%z0base(I,J)
2034 ENDDO
2035 ENDDO
2037 DO K=KMS,KME
2038 DO J=JMS,JME
2039 DO I=IMS,IME
2040 grid%cldfra(I,J,K)=CLDFRA_TRANS(I,K,J)
2041 ENDDO
2042 ENDDO
2043 ENDDO
2045 ENDIF
2047 !
2048 !
2049 !mp replace F*_PHY with values defined in module_initialize_real.F?
2050 #ifdef HWRF
2051 IF (.NOT. RESTRT .and. ALLOWED_TO_READ) THEN !zhang
2052 moist = 0.0
2053 grid%f_ice = grid%f_ice_phy
2054 grid%f_rimef = grid%f_rimef_phy
2055 grid%f_rain = grid%f_rain_phy
2056 ENDIF !zhang
2057 #endif
2059 IF (.NOT. RESTRT .and. ALLOWED_TO_READ) THEN
2060 ! Added by Greg Thompson, NCAR-RAL, for initializing water vapor
2061 ! mixing ratio (from NMM's specific humidity var) into moist array.
2063 !!mp
2064 CALL wrf_message('Initializng moist(:,:,:, Qv) from q')
2065 DO K=KPS,KPE
2066 DO J=JFS,JFE
2067 DO I=IFS,IFE
2068 moist(I,J,K,P_QV) = grid%q(I,J,K) / (1.-grid%q(I,J,K))
2069 enddo
2070 enddo
2071 enddo
2073 ! Also sum cloud water, ice, rain, snow, graupel into Ferrier cwm
2074 ! array (if any hydrometeors found and non-zero from initialization
2075 ! package). Then, determine fractions ice and rain from species.
2077 IF (.not. (MAXVAL(grid%cwm).gt.0. .and. MAXVAL(grid%cwm).lt.1.) ) then
2078 do i_m = 2, num_moist
2079 if (i_m.ne.p_qv) &
2080 & CALL wrf_message(' summing moist(:,:,:,i_m) into cwm array')
2081 DO K=KPS,KPE
2082 DO J=JFS,JFE
2083 DO I=IFS,IFE
2084 IF ( (moist(I,J,K,i_m).gt.EPSQ) .and. (i_m.ne.p_qv) ) THEN
2085 grid%cwm(I,J,K) = grid%cwm(I,J,K) + moist(I,J,K,i_m)
2086 ENDIF
2087 enddo
2088 enddo
2089 enddo
2090 enddo
2092 IF (.not. ( (maxval(grid%f_ice)+maxval(grid%f_rain)) .gt. EPSQ) ) THEN
2093 ETAMP_Regional=.FALSE. !-- Regional NAM or HRW (Ferrier) microphysics
2094 if (model_config_rec%mp_physics(grid%id).EQ.ETAMPOLD .OR. &
2095 & model_config_rec%mp_physics(grid%id).EQ.ETAMPNEW ) &
2096 & ETAMP_Regional=.TRUE.
2097 CALL wrf_message(' computing grid%f_ice')
2098 do i_m = 2, num_moist
2099 ICE1_indx=.FALSE.
2100 IF (i_m==P_qi .or. i_m==P_qg ) ICE1_indx=.TRUE.
2101 ICE2_indx=ICE1_indx
2102 IF (i_m==P_qs) ICE2_indx=.TRUE.
2103 DO J=JFS,JFE
2104 DO K=KPS,KPE
2105 DO I=IFS,IFE
2106 IF (ETAMP_Regional .AND. ICE1_indx) THEN
2107 moist(I,J,K,p_qs)=moist(I,J,K,p_qs)+moist(I,J,K,i_m)
2108 moist(I,J,K,i_m) =0.
2109 ENDIF
2110 IF ( moist(I,J,K,i_m)>EPSQ .AND. ICE2_indx) THEN
2111 grid%f_ice(I,K,J) = grid%f_ice(I,K,J) + moist(I,J,K,i_m)
2112 ENDIF
2113 enddo
2114 enddo
2115 enddo
2116 enddo
2117 CALL wrf_message(' computing f_rain')
2118 !
2119 DO J=JFS,JFE
2120 DO K=KPS,KPE
2121 DO I=IFS,IFE
2122 IF(grid%f_ice(i,k,j)<=EPSQ)THEN
2123 grid%f_ice(I,K,J)=0.
2124 ELSE
2125 grid%f_ice(I,K,J) = grid%f_ice(I,K,J)/grid%cwm(I,J,K)
2126 ENDIF
2127 IF ( (moist(I,J,K,p_qr)+moist(I,J,K,p_qc)).gt.EPSQ) THEN
2128 IF(moist(i,j,k,p_qr)<=EPSQ)THEN
2129 grid%f_rain(I,K,J)=0.
2130 ELSE
2131 grid%f_rain(I,K,J) = moist(i,j,k,p_qr) &
2132 & / (moist(i,j,k,p_qr)+moist(i,j,k,p_qc))
2133 ENDIF
2134 ENDIF
2135 enddo
2136 enddo
2137 enddo
2138 ENDIF
2139 ENDIF
2140 ! End addition by Greg Thompson
2142 IF (maxval(grid%f_ice) .gt. 0.) THEN
2143 do J=JMS,JME
2144 do K=KMS,KME
2145 do I=IMS,IME
2146 grid%f_ice_phy(I,K,J)=grid%f_ice(I,K,J)
2147 enddo
2148 enddo
2149 enddo
2150 ENDIF
2152 IF (maxval(grid%f_rain) .gt. 0.) THEN
2153 do J=JMS,JME
2154 do K=KMS,KME
2155 do I=IMS,IME
2156 grid%f_rain_phy(I,K,J)=grid%f_rain(I,K,J)
2157 enddo
2158 enddo
2159 enddo
2160 ENDIF
2162 IF (maxval(grid%f_rimef) .gt. 0.) THEN
2163 do J=JMS,JME
2164 do K=KMS,KME
2165 do I=IMS,IME
2166 grid%f_rimef_phy(I,K,J)=grid%f_rimef(I,K,J)
2167 enddo
2168 enddo
2169 enddo
2170 ENDIF
2171 ENDIF
2172 !
2173 IF (.NOT. RESTRT) THEN
2174 !-- Replace albedos if original albedos are nonzero
2175 IF(MAXVAL(ALBEDO_DUM)>0.)THEN
2176 DO J=JMS,JME
2177 DO I=IMS,IME
2178 grid%albedo(I,J)=ALBEDO_DUM(I,J)
2179 ENDDO
2180 ENDDO
2181 ENDIF
2182 ENDIF
2184 #ifdef HWRF
2185 if(.NOT. RESTRT .OR. .NOT.allowed_to_read) then !zhang's doing
2186 !zhang's doing
2187 #else
2188 IF(.NOT.RESTRT)THEN
2189 #endif
2190 DO J=JMS,JME
2191 DO I=IMS,IME
2192 grid%aprec(I,J)=RAINNC(I,J)*1.E-3
2193 grid%cuprec(I,J)=grid%raincv(I,J)*1.E-3
2194 ENDDO
2195 ENDDO
2196 ENDIF
2197 !following will need mods Sep06
2198 !
2199 #ifdef WRF_CHEM
2200 DO J=JTS,JTE
2201 JJ=MIN(JDE-1,J)
2202 DO K=KTS,KTE-1
2203 KK=MIN(KDE-1,K)
2204 DO I=ITS,ITE
2205 II=MIN(IDE-1,I)
2206 CONVFAC(I,K,J) = grid%pint(II,JJ,KK)/RGASUNIV/grid%t(II,JJ,KK)
2207 ENDDO
2208 ENDDO
2209 ENDDO
2211 DO J=JMS,JME
2212 DO K=KMS,KME
2213 DO I=IMS,IME
2214 PINT_TRANS(I,K,J)=grid%pint(I,J,K)
2215 T_TRANS(I,K,J)=grid%t(I,J,K)
2216 ENDDO
2217 ENDDO
2218 ENDDO
2219 DO J=JMS,JME
2220 DO I=IMS,IME
2221 grid%xlat(i,j)=grid%glat(I,J)/DEGRAD
2222 grid%xlong(I,J)=grid%glon(I,J)/DEGRAD
2224 ENDDO
2225 ENDDO
2226 !!! write(0,*)'now do chem_init'
2227 CALL CHEM_INIT (GRID%ID,CHEM,EMIS_ANT,scalar,GRID%DT,GRID%BIOEMDT,GRID%PHOTDT,GRID%CHEMDT, &
2228 STEPBIOE,STEPPHOT,STEPCHEM,STEPFIREPL,GRID%PLUMERISEFIRE_FRQ, &
2229 ZINT,grid%xlat,grid%xlong,G,AERWRF,CONFIG_FLAGS,grid, &
2230 RRI,T_TRANS,PINT_TRANS,CONVFAC, &
2231 grid%ttday,grid%tcosz,grid%julday,grid%gmt, &
2232 GD_CLOUD,GD_CLOUD2,raincv_a,raincv_b, &
2233 GD_CLOUD_a,GD_CLOUD2_a, &
2234 GD_CLOUD_B,GD_CLOUD2_B, &
2235 TAUAER1,TAUAER2,TAUAER3,TAUAER4, &
2236 GAER1,GAER2,GAER3,GAER4, &
2237 WAER1,WAER2,WAER3,WAER4, &
2238 l2AER,l3AER,l4AER,l5AER,l6aer,l7aer, &
2239 PM2_5_DRY,PM2_5_WATER,PM2_5_DRY_EC, &
2240 grid%last_chem_time_year,grid%last_chem_time_month, &
2241 grid%last_chem_time_day,grid%last_chem_time_hour, &
2242 grid%last_chem_time_minute,grid%last_chem_time_second, &
2243 GRID%CHEM_IN_OPT, &
2244 GRID%KEMIT, &
2245 IDS , IDE , JDS , JDE , KDS , KDE , &
2246 IMS , IME , JMS , JME , KMS , KME , &
2247 ITS , ITE , JTS , JTE , KTS , KTE )
2249 !
2250 ! calculate initial pm
2251 !
2252 SELECT CASE (CONFIG_FLAGS%CHEM_OPT)
2253 case (GOCART_SIMPLE,GOCARTRACM_KPP,GOCARTRADM2,GOCARTRADM2_KPP)
2254 call sum_pm_gocart ( &
2255 RRI, CHEM, PM2_5_DRY, PM2_5_DRY_EC, PM10, &
2256 IDS,IDE, JDS,JDE, KDS,KDE, &
2257 IMS,IME, JMS,JME, KMS,KME, &
2258 ITS,ITE, JTS,JTE, KTS,KTE-1 )
2259 CASE (RADM2SORG,RADM2SORG_AQ,RADM2SORG_AQCHEM,RADM2SORG_KPP,RACMSORG_AQ,RACMSORG_AQCHEM,RACMSORG_KPP)
2260 !!! write(0,*)'sum pm '
2261 CALL SUM_PM_SORGAM ( &
2262 RRI, CHEM, H2OAJ, H2OAI, &
2263 PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC, PM10, &
2264 IDS,IDE, JDS,JDE, KDS,KDE, &
2265 IMS,IME, JMS,JME, KMS,KME, &
2266 ITS,ITE, JTS,JTE, KTS,KTE-1 )
2268 CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
2269 CALL SUM_PM_MOSAIC ( &
2270 RRI, CHEM, &
2271 PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC, PM10, &
2272 IDS,IDE, JDS,JDE, KDS,KDE, &
2273 IMS,IME, JMS,JME, KMS,KME, &
2274 ITS,ITE, JTS,JTE, KTS,KTE-1 )
2276 CASE DEFAULT
2277 DO J=JTS,MIN(JTE,JDE-1)
2278 DO K=KTS,MIN(KTE,KDE-1)
2279 DO I=ITS,MIN(ITE,IDE-1)
2280 PM2_5_DRY(I,K,J) = 0.
2281 PM2_5_WATER(I,K,J) = 0.
2282 PM2_5_DRY_EC(I,K,J) = 0.
2283 PM10(I,K,J) = 0.
2284 ENDDO
2285 ENDDO
2286 ENDDO
2287 END SELECT
2288 #endif
2289 DEALLOCATE(SFULL)
2290 DEALLOCATE(SMID)
2291 DEALLOCATE(DZS)
2292 DEALLOCATE(EMISS)
2293 DEALLOCATE(EMTEMP)
2294 DEALLOCATE(GLW)
2295 DEALLOCATE(HFX)
2296 DEALLOCATE(LOWLYR)
2297 ! DEALLOCATE(grid%mavail)
2298 DEALLOCATE(NCA)
2299 DEALLOCATE(QFX)
2300 DEALLOCATE(RAINBL)
2301 DEALLOCATE(RAINC)
2302 DEALLOCATE(RAINNC)
2303 DEALLOCATE(RAINNCV)
2304 DEALLOCATE(RQCBLTEN)
2305 DEALLOCATE(RQIBLTEN)
2306 DEALLOCATE(RQVBLTEN)
2307 DEALLOCATE(RTHBLTEN)
2308 DEALLOCATE(RUBLTEN)
2309 DEALLOCATE(RVBLTEN)
2310 DEALLOCATE(RQCCUTEN)
2311 DEALLOCATE(RQICUTEN)
2312 DEALLOCATE(RQRCUTEN)
2313 DEALLOCATE(RQSCUTEN)
2314 DEALLOCATE(RQVCUTEN)
2315 DEALLOCATE(RTHCUTEN)
2316 DEALLOCATE(RUSHTEN)
2317 DEALLOCATE(RVSHTEN)
2318 DEALLOCATE(RQCSHTEN)
2319 DEALLOCATE(RQISHTEN)
2320 DEALLOCATE(RQRSHTEN)
2321 DEALLOCATE(RQSSHTEN)
2322 DEALLOCATE(RQGSHTEN)
2323 DEALLOCATE(RQVSHTEN)
2324 DEALLOCATE(RTHSHTEN)
2325 DEALLOCATE(RTHRATEN)
2326 DEALLOCATE(RTHRATENLW)
2327 DEALLOCATE(RTHRATENSW)
2328 DEALLOCATE(ZINT)
2329 DEALLOCATE(CONVFAC)
2330 DEALLOCATE(RRI)
2331 DEALLOCATE(SNOWC)
2332 DEALLOCATE(THC)
2333 DEALLOCATE(TMN)
2334 DEALLOCATE(TSFC)
2335 DEALLOCATE(ZS)
2336 DEALLOCATE(PINT_TRANS)
2337 DEALLOCATE(T_TRANS)
2338 DEALLOCATE(CLDFRA_TRANS)
2339 #ifndef WRF_CHEM
2340 DEALLOCATE(CLDFRA_OLD)
2341 #endif
2342 #if 0
2343 DEALLOCATE(w0avg)
2344 #endif
2345 !-----------------------------------------------------------------------
2346 !----------------------------------------------------------------------
2347 DO J=jfs,jfe
2348 DO I=ifs,ife
2349 grid%dwdtmn(I,J)=grid%dwdtmn(I,J)*grid%hbm3(I,J)
2350 grid%dwdtmx(I,J)=grid%dwdtmx(I,J)*grid%hbm3(I,J)
2351 ENDDO
2352 ENDDO
2353 !----------------------------------------------------------------------
2355 #ifdef DM_PARALLEL
2356 # include <HALO_NMM_INIT_1.inc>
2357 # include <HALO_NMM_INIT_2.inc>
2358 # include <HALO_NMM_INIT_3.inc>
2359 # include <HALO_NMM_INIT_4.inc>
2360 # include <HALO_NMM_INIT_5.inc>
2361 # include <HALO_NMM_INIT_6.inc>
2362 # include <HALO_NMM_INIT_7.inc>
2363 # include <HALO_NMM_INIT_8.inc>
2364 # include <HALO_NMM_INIT_9.inc>
2365 # include <HALO_NMM_INIT_10.inc>
2366 # include <HALO_NMM_INIT_11.inc>
2367 # include <HALO_NMM_INIT_12.inc>
2368 # include <HALO_NMM_INIT_13.inc>
2369 # include <HALO_NMM_INIT_14.inc>
2370 # include <HALO_NMM_INIT_15.inc>
2371 # include <HALO_NMM_INIT_15B.inc>
2372 # include <HALO_NMM_INIT_16.inc>
2373 # include <HALO_NMM_INIT_17.inc>
2374 # include <HALO_NMM_INIT_18.inc>
2375 # include <HALO_NMM_INIT_19.inc>
2376 # include <HALO_NMM_INIT_20.inc>
2377 # include <HALO_NMM_INIT_21.inc>
2378 # include <HALO_NMM_INIT_22.inc>
2379 # include <HALO_NMM_INIT_23.inc>
2380 # include <HALO_NMM_INIT_24.inc>
2381 # include <HALO_NMM_INIT_25.inc>
2382 # include <HALO_NMM_INIT_26.inc>
2383 # include <HALO_NMM_INIT_27.inc>
2384 # include <HALO_NMM_INIT_28.inc>
2385 # include <HALO_NMM_INIT_29.inc>
2386 # include <HALO_NMM_INIT_30.inc>
2387 # include <HALO_NMM_INIT_31.inc>
2388 # include <HALO_NMM_INIT_32.inc>
2389 # include <HALO_NMM_INIT_33.inc>
2390 # include <HALO_NMM_INIT_34.inc>
2391 # include <HALO_NMM_INIT_35.inc>
2392 # include <HALO_NMM_INIT_36.inc>
2393 # include <HALO_NMM_INIT_37.inc>
2394 # include <HALO_NMM_INIT_38.inc>
2395 # include <HALO_NMM_INIT_39.inc>
2396 #endif
2397 !#define COPY_OUT
2398 !#include <scalar_derefs.inc>
2400 write(message,*) "Timing for start_domain on d",grid%id
2401 call end_timing(message)
2403 RETURN
2406 END SUBROUTINE START_DOMAIN_NMM