source: lmdz_wrf/trunk/WRFV3/dyn_nmm/start_domain_nmm.F @ 1895

Last change on this file since 1895 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 71.4 KB
Line 
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
77
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
123
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
147
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
162
163
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
178
179      INTEGER :: interval_seconds, restart_interval
180
181! z0base new
182 
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/)
190 
191! end z0base new
192!
193!----------------------------------------------------------------------
194!#define COPY_IN
195!#include <scalar_derefs.inc>
196!----------------------------------------------------------------------
197!**********************************************************************
198!----------------------------------------------------------------------
199!
200
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
212
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
222
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)
258
259
260!!    Restarts must be made from times for which boundary data is available
261
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
268
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!!!!!!!!!!!
284
285      MYIS=MAX(IDS,IPS)
286      MYIE=MIN(IDE-1,IPE)
287      MYJS=MAX(JDS,JPS)
288      MYJE=MIN(JDE-1,JPE)
289
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
332
333      CALL WRF_GET_MYPROC(MYPROC)
334      MYPE=MYPROC
335
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!***
523
524      IF(allowed_to_read)THEN       ! This is gopal's inclusion for moving nest
525
526          PM1=grid%aeta1(KTS)*grid%pdtop+grid%aeta2(KTS)*grid%pdsl(I,J)+grid%pt
527          APEM1=(1.E5/PM1)**CAPA
528
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
537
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
547
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.
564
565      ENDIF  ! endif for allowed to read
566!
567        ENDDO
568        ENDDO
569
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)
707
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!----------------------------------------------------------------------
726
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
734
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
753
754      NSTART = INT(grid%TSTART*TSPH+0.5)
755!
756      grid%ntsd = NSTART
757
758
759!! want non-zero values for grid%nprec, grid%nheat type vars to avoid problems
760!! with mod statements below.
761
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
814
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
1211     
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)
1222
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
1243
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
1329
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
1349
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?
1378
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?
1413
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
1439
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
1451
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!
1458
1459
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
1465
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
1476
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
1485
1486! SET BACK Z AS IN ORIGINAL CODE
1487
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
1495
1496#endif
1497
1498
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
1571
1572#else
1573      CALL wrf_message('start_domain_nmm: NO_RESTRICT_ACCEL')
1574#endif
1575
1576!-----------------------------------------------------------------------
1577!***  CALL THE GENERAL PHYSICS INITIALIZATION
1578!-----------------------------------------------------------------------
1579!
1580
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.
1599
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.
1607
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!-----------------------------------------------------------------------
1713
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
1721
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
1732                                                                                                                                             
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
1750
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 )
1758
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
1775
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
1782
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
1792
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     &             ,.TRUE.,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     &                )
1838
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
1865
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
1873
1874        DO J=JMS,JME
1875        DO I=IMS,IME
1876          grid%z0(I,J)=grid%z0base(I,J)
1877        ENDDO
1878        ENDDO
1879
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
1887
1888      ENDIF
1889
1890!
1891!
1892!mp replace F*_PHY with values defined in module_initialize_real.F?
1893#ifdef HWRF
1894      IF (.NOT. RESTRT) 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
1901
1902      IF (.NOT. RESTRT) THEN
1903! Added by Greg Thompson, NCAR-RAL, for initializing water vapor
1904! mixing ratio (from NMM's specific humidity var) into moist array.
1905
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     
1915     
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.       
1919     
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
1934
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
1979
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
1989
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
1999
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
2021
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
2048     
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
2061
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                     )
2086
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                                 )
2105             
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                                 )
2113             
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!----------------------------------------------------------------------
2192
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>
2237
2238   RETURN
2239
2240
2241END SUBROUTINE START_DOMAIN_NMM
2242
Note: See TracBrowser for help on using the repository browser.