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