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