wrftladj/start_em_tl.F

   1 !-------------------------------------------------------------------
   2
   3    SUBROUTINE g_start_domain_em ( grid, allowed_to_read &
   4 ! Actual arguments generated from Registry
   5 # include "dummy_new_args.inc"
   6 !
   7 )
   8
   9    USE module_domain, ONLY : domain, wrfu_timeinterval, get_ijk_from_grid, &
  10         domain_setgmtetc
  11    USE module_state_description
  12    USE module_model_constants
  13    USE g_module_bc, ONLY : g_set_physical_bc2d
  14    USE g_module_bc_em
  15    USE module_configure, ONLY : grid_config_rec_type
  16    USE module_tiles, ONLY : set_tiles
  17 #ifdef DM_PARALLEL
  18    USE module_dm, ONLY : wrf_dm_min_real, wrf_dm_max_real, wrf_dm_maxval, &
  19         ntasks_x, ntasks_y, &
  20         local_communicator_periodic, local_communicator, mytask, ntasks
  21 #else
  22    USE module_dm, ONLY : wrf_dm_min_real, wrf_dm_max_real
  23 #endif
  24    USE module_comm_dm
  25
  26    USE g_module_physics_init
  27    USE module_diag_pld, ONLY : pld
  28
  29    USE module_model_constants
  30
  31    IMPLICIT NONE
  32    !  Input data.
  33    TYPE (domain)          :: grid
  34
  35    LOGICAL , INTENT(IN)   :: allowed_to_read
  36
  37    !  Definitions of dummy arguments to this routine (generated from Registry).
  38 # include "dummy_new_decl.inc"
  39
  40    !  Structure that contains run-time configuration (namelist) data for domain
  41    TYPE (grid_config_rec_type)              :: config_flags
  42
  43    !  Local data
  44    INTEGER                             ::                       &
  45                                   ids, ide, jds, jde, kds, kde, &
  46                                   ims, ime, jms, jme, kms, kme, &
  47                                   ips, ipe, jps, jpe, kps, kpe, &
  48                                   its, ite, jts, jte, kts, kte, &
  49                                   ij,i,j,k,ii,jj,kk,loop,error,l
  50
  51    INTEGER ::              imsx, imex, jmsx, jmex, kmsx, kmex,    &
  52                            ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
  53                            imsy, imey, jmsy, jmey, kmsy, kmey,    &
  54                            ipsy, ipey, jpsy, jpey, kpsy, kpey
  55
  56    INTEGER     :: i_m
  57
  58    REAL        :: p00, t00, a, tiso, p_surf, pd_surf, temp, tiso_tmp
  59    REAL        :: p_strat, a_strat
  60    REAL :: qvf1, qvf2, qvf, pwx1 ,g_qvf,g_pwx1, pwr1, g_pwr1
  61    REAL :: pfu, pfd, phm, g_pfu, g_pfd, g_phm
  62    REAL :: MPDT
  63    REAL :: spongeweight
  64    LOGICAL :: first_trip_for_this_domain, start_of_simulation, fill_w_flag
  65    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
  66
  67 #if (WRF_CHEM!=1)
  68       REAL,ALLOCATABLE,DIMENSION(:,:,:) :: cldfra_old
  69 #endif
  70
  71    REAL :: lat1 , lat2 , lat3 , lat4
  72    REAL :: lon1 , lon2 , lon3 , lon4
  73    INTEGER :: num_points_lat_lon , iloc , jloc
  74    CHARACTER (LEN=132) :: message
  75    TYPE(WRFU_TimeInterval) :: stepTime
  76    REAL, DIMENSION(:,:), ALLOCATABLE :: clat_glob
  77    logical :: f_flux  ! flag for computing averaged fluxes in cu_gd
  78
  79    INTEGER :: idex, jdex
  80    INTEGER :: im1,ip1,jm1,jp1
  81    REAL :: hx,hy,pi
  82
  83    REAL :: w_max, w_min
  84    LOGICAL :: w_needs_to_be_set
  85
  86    CALL get_ijk_from_grid ( grid ,                              &
  87                            ids, ide, jds, jde, kds, kde,        &
  88                            ims, ime, jms, jme, kms, kme,        &
  89                            ips, ipe, jps, jpe, kps, kpe,        &
  90                            imsx, imex, jmsx, jmex, kmsx, kmex,  &
  91                            ipsx, ipex, jpsx, jpex, kpsx, kpex,  &
  92                            imsy, imey, jmsy, jmey, kmsy, kmey,  &
  93                            ipsy, ipey, jpsy, jpey, kpsy, kpey )
  94
  95    kts = kps ; kte = kpe     ! note that tile is entire patch
  96    its = ips ; ite = ipe     ! note that tile is entire patch
  97    jts = jps ; jte = jpe    ! note that tile is entire patch
  98 #if (WRF_CHEM!=1)
  99          ALLOCATE(CLDFRA_OLD(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; CLDFRA_OLD = 0.
 100 #endif
 101    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 102
 103 !kludge - need to stop CG from resetting precip and phys tendencies to zero
 104 !         when we are in here due to a nest being spawned, we want to still
 105 !         recompute the base state, but that is about it
 106    !  This is temporary and will need to be changed when grid%itimestep is removed.
 107
 108    IF ( grid%itimestep .EQ. 0 ) THEN
 109       first_trip_for_this_domain = .TRUE.
 110    ELSE
 111       first_trip_for_this_domain = .FALSE.
 112    END IF
 113
 114    IF ( config_flags%use_baseparam_fr_nml ) then
 115       CALL nl_get_base_pres  ( 1 , p00 )
 116       CALL nl_get_base_temp  ( 1 , t00 )
 117       CALL nl_get_base_lapse ( 1 , a   )
 118       CALL nl_get_iso_temp   ( 1 , tiso )
 119       CALL nl_get_base_lapse_strat ( 1 , a_strat )
 120       CALL nl_get_base_pres_strat  ( 1 , p_strat )
 121       IF ( ( t00 .LT. 100. .or. p00 .LT. 10000.) .AND. ( .NOT. grid%this_is_an_ideal_run ) ) THEN
 122          WRITE(wrf_err_message,*) 'start_em: BAD BASE STATE for T00 or P00 in namelist.input file'
 123          CALL wrf_error_fatal(TRIM(wrf_err_message))
 124       END IF
 125
 126    ELSE
 127    ! get these constants from model data
 128
 129       t00  = grid%t00
 130       p00  = grid%p00
 131       a    = grid%tlp
 132       tiso = grid%tiso
 133       a_strat = grid%tlp_strat
 134       p_strat = grid%p_strat
 135       IF ( ( t00 .LT. 100. .or. p00 .LT. 10000.) .AND. ( .NOT. grid%this_is_an_ideal_run ) ) THEN
 136       WRITE(wrf_err_message,*)&
 137       'start_em_tl: did not find base state parameters in wrfinput. Add use_baseparam_fr_nml = .t. in &dynamics and rerun'
 138       CALL wrf_error_fatal(TRIM(wrf_err_message))
 139       ENDIF
 140
 141    ENDIF
 142
 143 !  check if tiso in the input file agrees with namelist value
 144
 145    CALL nl_get_iso_temp   ( 1 , tiso_tmp )
 146    IF ( ( tiso_tmp .NE. tiso ) .AND. ( .NOT. grid%this_is_an_ideal_run ) ) THEN
 147       WRITE(wrf_err_message,*)&
 148       'start_em: namelist iso_temp is not equal to iso_temp in wrfinput. Reset nml value and rerun'
 149       CALL wrf_error_fatal(TRIM(wrf_err_message))
 150    ENDIF
 151
 152    IF ( .NOT. config_flags%restart .AND. &
 153         (( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ))) THEN
 154
 155       IF ( config_flags%map_proj .EQ. 0 ) THEN
 156          CALL wrf_error_fatal ( 'start_domain: Idealized case cannot have a separate nested input file' )
 157       END IF
 158
 159       !  Base state potential temperature and inverse density (alpha = 1/rho) from
 160       !  the half eta levels and the base-profile surface pressure.  Compute 1/rho
 161       !  from equation of state.  The potential temperature is a perturbation from t0.
 162
 163       DO j = jts, MIN(jte,jde-1)
 164          DO i = its, MIN(ite,ide-1)
 165
 166             !  Base state pressure is a function of eta level and terrain, only, plus
 167             !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
 168             !  temperature, K), A (temperature difference, from 1000 mb to 300 mb, K),
 169             !  tiso (isothermal temperature at tropopause/lower stratosphere),
 170             !  p_strat (pressure at top of isothermal layer), A_strat (lapse rate in
 171             !  stratosphere above isothermal layer)
 172
 173             p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 )
 174
 175             DO k = 1, kte-1
 176                grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
 177                temp = MAX ( tiso, t00 + A*LOG(grid%pb(i,k,j)/p00) )
 178                IF ( grid%pb(i,k,j) .LT. p_strat ) THEN
 179                   temp = tiso + A_strat * LOG ( grid%pb(i,k,j)/p_strat )
 180                ENDIF
 181                grid%t_init(i,k,j) = temp*(p00/grid%pb(i,k,j))**(r_d/cp) - t0
 182 !              grid%t_init(i,k,j) = (t00 + A*LOG(grid%pb(i,k,j)/p00))*(p00/grid%pb(i,k,j))**(r_d/cp) - t0
 183                grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm
 184             END DO
 185
 186             !  Base state mu is defined as base state surface pressure minus grid%p_top
 187
 188             grid%mub(i,j) = p_surf - grid%p_top
 189
 190             !  Integrate base geopotential, starting at terrain elevation.  This assures that
 191             !  the base state is in exact hydrostatic balance with respect to the model equations.
 192             !  This field is on full levels.
 193
 194             grid%phb(i,1,j) = grid%ht(i,j) * g
 195
 196             IF ( config_flags%hypsometric_opt .EQ. 1 ) THEN
 197                DO k  = 2,kte
 198                   grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j)
 199                END DO
 200             ELSE IF ( config_flags%hypsometric_opt .EQ. 2 ) THEN
 201                DO k  = 2,kte
 202                   pfu = grid%mub(i,j)*grid%znw(k)   + grid%p_top
 203                   pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top
 204                   phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top
 205                   grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu)
 206                END DO
 207             END IF
 208          END DO
 209       END DO
 210
 211    ENDIF
 212
 213    IF(.not.config_flags%restart)THEN
 214
 215 !  if this is for a nested domain, the defined/interpolated fields are the _2
 216
 217      IF ( first_trip_for_this_domain ) THEN
 218
 219 ! data that is expected to be zero must be explicitly initialized as such
 220 !    grid%h_diabatic = 0.
 221
 222        DO j = jts,min(jte,jde-1)
 223        DO k = kts,kte-1
 224        DO i = its, min(ite,ide-1)
 225            IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
 226              grid%t_1(i,k,j)=grid%t_2(i,k,j)
 227              grid%g_t_1(i,k,j)=grid%g_t_2(i,k,j)
 228            ENDIF
 229        ENDDO
 230        ENDDO
 231        ENDDO
 232
 233        DO j = jts,min(jte,jde-1)
 234        DO k = kts,kte
 235        DO i = its, min(ite,ide-1)
 236           grid%ph_1(i,k,j)=grid%ph_2(i,k,j)
 237           grid%g_ph_1(i,k,j)=grid%g_ph_2(i,k,j)
 238        ENDDO
 239        ENDDO
 240        ENDDO
 241
 242        DO j = jts,min(jte,jde-1)
 243        DO i = its, min(ite,ide-1)
 244            IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
 245              grid%mu_1(i,j)=grid%mu_2(i,j)
 246              grid%g_mu_1(i,j)=grid%g_mu_2(i,j)
 247            ENDIF
 248        ENDDO
 249        ENDDO
 250      END IF
 251
 252 !  reconstitute base-state fields
 253
 254     IF(config_flags%max_dom .EQ. 1)THEN
 255 ! with single domain, grid%t_init from wrfinput is OK to use
 256      DO j = jts,min(jte,jde-1)
 257      DO k = kts,kte-1
 258      DO i = its, min(ite,ide-1)
 259        IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
 260          grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top
 261          grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm
 262        ENDIF
 263      ENDDO
 264      ENDDO
 265      ENDDO
 266     ENDIF
 267
 268 ! Use equations from calc_p_rho_phi to derive p and al from ph: linear in log p
 269
 270     IF ( config_flags%hypsometric_opt .EQ. 1 ) THEN
 271        DO j=jts,min(jte,jde-1)
 272        DO k=kts,kte-1
 273        DO i=its,min(ite,ide-1)
 274           grid%g_al(i,k,j) = -((grid%alb(i,k,j)*grid%g_mu_1(i,j)+grid%rdnw(k)*(grid%g_ph_1(i,k+1,j) &
 275              -grid%g_ph_1(i,k,j)))/(grid%mub(i,j)+grid%mu_1(i,j))-grid%g_mu_1(i,j)*(grid%alb(i,k,j) &
 276              *grid%mu_1(i,j)+grid%rdnw(k)*(grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)))/(grid%mub(i,j)+grid%mu_1(i,j))**2)
 277           grid%al(i,k,j)=-1./(grid%mub(i,j)+grid%mu_1(i,j))*(grid%alb(i,k,j)*grid%mu_1(i,j)  &
 278                      +grid%rdnw(k)*(grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)))
 279
 280        ENDDO
 281        ENDDO
 282        ENDDO
 283     ELSE IF ( config_flags%hypsometric_opt .EQ. 2 ) THEN
 284        DO j=jts,min(jte,jde-1)
 285        DO k=kts,kte-1
 286        DO i=its,min(ite,ide-1)
 287           pfu = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znw(k+1)+grid%p_top
 288           g_pfu = grid%g_mu_1(i,j)*grid%znw(k+1)
 289           pfd = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znw(k)  +grid%p_top
 290           g_pfd = grid%g_mu_1(i,j)*grid%znw(k)
 291           phm = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znu(k)  +grid%p_top
 292           g_phm = grid%g_mu_1(i,j)*grid%znu(k)
 293
 294           grid%g_al(i,k,j) = (((grid%g_ph_1(i,k+1,j)-grid%g_ph_1(i,k,j))*phm- &
 295                  (grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)) &
 296                  *g_phm)*LOG(pfd/pfu)/phm**2-(grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)+ &
 297                  grid%phb(i,k+1,j)-grid%phb(i,k,j))*(g_pfd*pfu-pfd*g_pfu)/(phm*pfu*pfd))/LOG(pfd/pfu)**2
 298
 299           grid%al(i,k,j) = (grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)) &
 300                             /phm/LOG(pfd/pfu)-grid%alb(i,k,j)
 301        ENDDO
 302        ENDDO
 303        ENDDO
 304     END IF
 305     DO j=jts,min(jte,jde-1)
 306     DO k=kts,kte-1
 307     DO i=its,min(ite,ide-1)
 308        qvf = 1.+rvovrd*moist(i,k,j,P_QV)
 309        pwx1 = r_d*(t0+grid%t_1(i,k,j))*qvf/(p1000mb*(grid%al(i,k,j)+grid%alb(i,k,j)))
 310        pwr1 = pwx1**cpovcv
 311        IF ( .NOT. config_flags%var4d_run) THEN
 312           g_qvf = rvovrd*g_moist(i,k,j,P_QV)
 313
 314           g_pwx1 = (r_d*(grid%g_t_1(i,k,j)*qvf+(t0+grid%t_1(i,k,j))*g_qvf)*p1000mb*&
 315              (grid%al(i,k,j)+grid%alb(i,k,j))-r_d*(t0+grid%t_1(i,k,j))*qvf*p1000mb*&
 316              grid%g_al(i,k,j))/(p1000mb*(grid%al(i,k,j)+grid%alb(i,k,j)))**2
 317           IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. cpovcv .EQ. INT(&
 318                cpovcv))) THEN
 319             g_pwr1 = cpovcv*pwx1**(cpovcv-1)*g_pwx1
 320           ELSE IF (pwx1 .EQ. 0.0 .AND. cpovcv .EQ. 1.0) THEN
 321             g_pwr1 = g_pwx1
 322           ELSE
 323             g_pwr1 = 0.0
 324           END IF
 325           grid%g_p(i, k, j) = p1000mb*g_pwr1
 326        END IF
 327        grid%p(i,k,j)=p1000mb*pwr1 - grid%pb(i,k,j)
 328
 329        grid%g_p_hyd(i,k,j) = grid%g_p(i,k,j)
 330        grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j)
 331
 332        grid%g_alt(i,k,j) = grid%g_al(i,k,j)
 333        grid%alt(i,k,j) = grid%al(i,k,j) + grid%alb(i,k,j)
 334     ENDDO
 335     ENDDO
 336     ENDDO
 337
 338     DO j=jts,min(jte,jde-1)
 339        DO i=its,min(ite,ide-1)
 340           p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 )
 341           grid%p_hyd_w(i,1,j) = grid%p(i,1,j) + grid%znw(1)*(p_surf - grid%p_top) + grid%p_top
 342           grid%g_p_hyd_w(i,1,j) = grid%g_p(i,1,j)
 343           DO k=kts+1,kte
 344              grid%p_hyd_w(i,k,j) = ( 2.*(grid%p(i,k-1,j)+grid%pb(i,k-1,j)) - grid%p_hyd_w(i,k-1,j) )
 345              grid%g_p_hyd_w(i,k,j) = 2.*grid%g_p(i,k-1,j) - grid%g_p_hyd_w(i,k-1,j)
 346           ENDDO
 347        ENDDO
 348     ENDDO
 349
 350    ENDIF
 351
 352    IF ( first_trip_for_this_domain ) THEN
 353
 354    CALL wrf_debug ( 100 , 'start_domain_em_tl: Before call to g_phy_init' )
 355
 356 ! namelist MPDT does not exist yet, so set it here
 357 ! MPDT is the call frequency for microphysics in minutes (0 means every step)
 358    MPDT = 0.
 359
 360 ! set GMT outside of phy_init because phy_init may not be called on this
 361 ! process if, for example, it is a moving nest and if this part of the domain is not
 362 ! being initialized (not the leading edge).
 363    CALL domain_setgmtetc( grid, start_of_simulation )
 364 !tgs
 365    IF(config_flags%cycling) start_of_simulation = .true.
 366 !  print *,'cycling, start_of_simulation -->',config_flags%cycling, start_of_simulation
 367
 368    CALL set_tiles ( grid , grid%imask_nostag, ims, ime, jms, jme, ips, ipe, jps, jpe )
 369 !
 370 ! Phy init can do reads and broadcasts when initializing physics -- landuse for example. However, if
 371 ! we're running on a reduced mesh (that is, some tasks don't have any work) we have to at least let them
 372 ! pass through this code so the broadcasts don't hang on the other, active tasks.  Set the number of
 373 ! tiles to a minimum of 1 and assume that the backwards patch ranges (ips=0, ipe=-1) will prevent
 374 ! anything else from happening on the blank tasks.  JM 20080605
 375 !
 376    if ( allowed_to_read ) grid%num_tiles = max(1,grid%num_tiles)
 377 !
 378 ! Phy_init is not necessarily thread-safe; do not multi-thread this loop.
 379 ! The tiling is to handle the fact that we may be masking off part of the computation.
 380 !
 381    DO ij = 1, grid%num_tiles
 382
 383 !tgs do not need physics initialization for backward DFI integration
 384     IF ( ( grid%dfi_opt .EQ. DFI_NODFI ) .or. &
 385           ( ( grid%dfi_stage .NE. DFI_BCK ) .and. &
 386           ( grid%dfi_stage .NE. DFI_STARTBCK ) ) ) THEN    !tgs, mods by tah
 387
 388      CALL g_phy_init( grid%id , config_flags, grid%DT, grid%RESTART, grid%znw, grid%znu,   &
 389                       grid%p_top, grid%tsk, grid%RADT,grid%BLDT,grid%CUDT, MPDT, &
 390                       grid%rucuten, grid%rvcuten, grid%rthcuten, grid%g_rthcuten, &
 391                       grid%rqvcuten, grid%g_rqvcuten, grid%rqrcuten, grid%rqccuten, &
 392                       grid%g_rqccuten, &
 393                       grid%rqscuten, grid%rqicuten,                          &
 394                       grid%rushten, grid%rvshten, grid%rthshten,             &
 395                       grid%rqvshten, grid%rqrshten, grid%rqcshten,           &
 396                       grid%rqsshten, grid%rqishten, grid%rqgshten,           &
 397                       grid%rublten,grid%g_rublten,grid%rvblten,grid%g_rvblten, &
 398                       grid%rthblten, grid%g_rthblten,              &
 399                       grid%rqvblten,grid%g_rqvblten,grid%rqcblten,grid%rqiblten, &
 400                       grid%rthraten,grid%rthratenlw,grid%rthratensw,         &
 401                       grid%stepbl,grid%stepra,grid%stepcu,                   &
 402                       grid%w0avg, grid%g_w0avg, grid%rainnc, grid%g_rainnc, &
 403                       grid%rainc, grid%g_rainc, grid%raincv, grid%g_raincv, &
 404                       grid%rainncv, grid%g_rainncv, &
 405                       grid%snownc, grid%g_snownc, grid%snowncv, grid%g_snowncv, &
 406                       grid%graupelnc, grid%g_graupelnc, grid%graupelncv, grid%g_graupelncv, &
 407                       grid%nca,grid%swrad_scat,                    &
 408                       grid%cldefi,grid%lowlyr,                          &
 409                       grid%mass_flux,                              &
 410                       grid%rthften, grid%rqvften,                       &
 411                       grid%cldfra,                                      &
 412 #if (WRF_CHEM!=1)
 413                       cldfra_old,                                  &
 414 #endif
 415                       grid%glw,grid%gsw,grid%emiss,grid%embck,            &
 416                       grid%lu_index,                                      &
 417                       grid%landuse_ISICE, grid%landuse_LUCATS,            &
 418                       grid%landuse_LUSEAS, grid%landuse_ISN,              &
 419                       grid%lu_state,                                      &
 420                       grid%xlat,grid%xlong,grid%albedo,grid%albbck,grid%GMT,grid%JULYR,grid%JULDAY,     &
 421                       grid%levsiz, num_ozmixm, num_aerosolc, grid%paerlev,  &
 422                       grid%alevsiz, grid%no_src_types,                      &
 423                       grid%tmn,grid%xland,grid%znt,grid%z0,grid%ust,grid%mol,grid%pblh,grid%tke_pbl,    &
 424                       grid%exch_h,grid%thc,grid%snowc,grid%mavail,grid%hfx,grid%qfx,grid%rainbl, &
 425                       grid%tslb,grid%zs,grid%dzs,config_flags%num_soil_layers,grid%warm_rain,  &
 426                       grid%adv_moist_cond,                         &
 427                       grid%apr_gr,grid%apr_w,grid%apr_mc,grid%apr_st,grid%apr_as,      &
 428                       grid%apr_capma,grid%apr_capme,grid%apr_capmi,          &
 429                       grid%xice,grid%xicem,grid%vegfra,grid%snow,grid%canwat,grid%smstav,         &
 430                       grid%smstot, grid%sfcrunoff,grid%udrunoff,grid%grdflx,grid%acsnow,      &
 431                       grid%acsnom,grid%ivgtyp,grid%isltyp, grid%sfcevp,grid%smois,     &
 432                       grid%sh2o, grid%snowh, grid%smfr3d,                    &
 433                       grid%snoalb,                 &
 434                       grid%DX,grid%DY,grid%f_ice_phy,grid%f_rain_phy,grid%f_rimef_phy, &
 435                       grid%mp_restart_state,grid%tbpvs_state,grid%tbpvs0_state,&
 436                       allowed_to_read, grid%moved, start_of_simulation,               &
 437                       grid%LAGDAY, &
 438                       ids, ide, jds, jde, kds, kde,           &
 439                       ims, ime, jms, jme, kms, kme,           &
 440                       grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), kts, kte, &
 441                       config_flags%num_urban_ndm,                           & !multi-layer urban
 442                       config_flags%urban_map_zrd,                           & !multi-layer urban
 443                       config_flags%urban_map_zwd,                           & !multi-layer urban
 444                       config_flags%urban_map_gd,                            & !multi-layer urban
 445                       config_flags%urban_map_zd,                            & !multi-layer urban
 446                       config_flags%urban_map_zdf,                           & !multi-layer urban
 447                       config_flags%urban_map_bd,                            & !multi-layer urban
 448                       config_flags%urban_map_wd,                            & !multi-layer urban
 449                       config_flags%urban_map_gbd,                           & !multi-layer urban
 450                       config_flags%urban_map_fbd,                           & !multi-layer urban
 451                       config_flags%num_urban_hi,                            & !multi-layer urban
 452                       grid%raincv_a,grid%raincv_b,                                    &
 453                       grid%gd_cloud, grid%gd_cloud2,                                  & ! Optional
 454                       grid%gd_cloud_a, grid%gd_cloud2_a,                              & ! Optional
 455                       grid%QC_CU, grid%QI_CU,                                         & ! Optional
 456                       ozmixm,grid%pin,                             &     ! Optional
 457                       grid%m_ps_1,grid%m_ps_2,grid%m_hybi,aerosolc_1,aerosolc_2,&  ! Optional
 458                       grid%rundgdten,grid%rvndgdten,grid%rthndgdten,         &     ! Optional
 459                       grid%rphndgdten,grid%rqvndgdten,grid%rmundgdten,       &     ! Optional
 460                       grid%FGDT,grid%stepfg,                        &     ! Optional
 461                       grid%cugd_tten,grid%cugd_ttens,grid%cugd_qvten,        &   ! Optional
 462                       grid%cugd_qvtens,grid%cugd_qcten,                 &   ! Optional
 463                       grid%ISNOWXY, grid%ZSNSOXY, grid%TSNOXY,                                  &   ! Optional Noah-MP
 464                       grid%SNICEXY, grid%SNLIQXY, grid%TVXY, grid%TGXY, grid%CANICEXY,          &   ! Optional Noah-MP
 465                       grid%CANLIQXY, grid%EAHXY, grid%TAHXY, grid%CMXY,                         &   ! Optional Noah-MP
 466                       grid%CHXY, grid%FWETXY, grid%SNEQVOXY,grid%ALBOLDXY,grid%QSNOWXY,grid%QRAINXY, &   ! Optional Noah-MP
 467                       grid%WSLAKEXY, grid%ZWTXY, grid%WAXY, grid%WTXY, grid%LFMASSXY, grid%RTMASSXY, & ! Optional Noah-MP
 468                       grid%STMASSXY, grid%WOODXY, grid%STBLCPXY, grid%FASTCPXY,                 &   ! Optional Noah-MP
 469                       grid%XSAIXY,                                                              &   ! Optional Noah-MP
 470                       grid%T2MVXY, grid%T2MBXY, grid%CHSTARXY,                                  &   ! Optional Noah-MP
 471                       grid%DZR, grid%DZB, grid%DZG,                          & !Optional urban
 472                       grid%TR_URB2D,grid%TB_URB2D,grid%TG_URB2D,grid%TC_URB2D,    & !Optional urban
 473                       grid%QC_URB2D, grid%XXXR_URB2D,grid%XXXB_URB2D,        & !Optional urban
 474                       grid%XXXG_URB2D, grid%XXXC_URB2D,                 & !Optional urban
 475                       grid%TRL_URB3D, grid%TBL_URB3D, grid%TGL_URB3D,        & !Optional urban
 476                       grid%SH_URB2D, grid%LH_URB2D, grid%G_URB2D, grid%RN_URB2D,  & !Optional urban
 477                       grid%TS_URB2D, grid%FRC_URB2D, grid%UTYPE_URB2D,      & !Optional urban
 478                       grid%TRB_URB4D,grid%TW1_URB4D,grid%TW2_URB4D,grid%TGB_URB4D,grid%TLEV_URB3D,  & !multi-layer urban
 479                       grid%QLEV_URB3D,grid%TW1LEV_URB3D,grid%TW2LEV_URB3D,        & !multi-layer urban
 480                       grid%TGLEV_URB3D,grid%TFLEV_URB3D,grid%SF_AC_URB3D,         & !multi-layer urban
 481                       grid%LF_AC_URB3D,grid%CM_AC_URB3D,grid%SFVENT_URB3D,grid%LFVENT_URB3D,   & !multi-layer urban
 482                       grid%SFWIN1_URB3D,grid%SFWIN2_URB3D, & !multi-layer urban
 483                       grid%SFW1_URB3D,grid%SFW2_URB3D,grid%SFR_URB3D,grid%SFG_URB3D,     & !multi-layer urban
 484                       grid%A_U_BEP,grid%A_V_BEP,grid%A_T_BEP,grid%A_Q_BEP,             & !multi-layer urban
 485                       grid%A_E_BEP,grid%B_U_BEP,grid%B_V_BEP,grid%B_T_BEP,             & !multi-layer urban
 486                       grid%B_Q_BEP,grid%B_E_BEP,grid%DLG_BEP,                          & !multi-layer urban
 487                       grid%DL_U_BEP,grid%SF_BEP,grid%VL_BEP,                           & !multi-layer urban
 488                       grid%TML,grid%T0ML,grid%HML,grid%H0ML,grid%HUML,grid%HVML,grid%TMOML,     & !Optional oml
 489                       grid%itimestep, grid%fdob,            &
 490                       t00, p00, a,                      & ! for obs_nudge base state
 491                       grid%TYR, grid%TYRA, grid%TDLY, grid%TLAG, grid%NYEAR, grid%NDAY,grid%tmn_update, &
 492                       grid%achfx, grid%aclhf, grid%acgrdflx                 &
 493                       ,grid%te_temf,grid%cf3d_temf,grid%wm_temf        & ! WA
 494                       ,grid%massflux_EDKF, grid%entr_EDKF, grid%detr_EDKF                &
 495                       ,grid%thl_up,grid%thv_up,grid%rt_up                                &
 496                       ,grid%rv_up,grid%rc_up,grid%u_up,grid%v_up,grid%frac_up            &
 497                       )
 498        ENDIF   !tgs
 499
 500    ENDDO
 501
 502    CALL wrf_debug ( 100 , 'start_domain_em_tl: After call to g_phy_init' )
 503
 504    END IF
 505
 506 !
 507 !
 508
 509  !  set physical boundary conditions for all initialized variables
 510
 511 !-----------------------------------------------------------------------
 512 !  Stencils for patch communications  (WCS, 29 June 2001)
 513 !  Note:  the size of this halo exchange reflects the
 514 !         fact that we are carrying the uncoupled variables
 515 !         as state variables in the mass coordinate model, as
 516 !         opposed to the coupled variables as in the height
 517 !         coordinate model.
 518 !
 519 !                           * * * * *
 520 !         *        * * *    * * * * *
 521 !       * + *      * + *    * * + * *
 522 !         *        * * *    * * * * *
 523 !                           * * * * *
 524 !
 525 !j  grid%u_1                          x
 526 !j  grid%u_2                          x
 527 !j  grid%v_1                          x
 528 !j  grid%v_2                          x
 529 !j  grid%w_1                          x
 530 !j  grid%w_2                          x
 531 !j  grid%t_1                          x
 532 !j  grid%t_2                          x
 533 !j grid%ph_1                          x
 534 !j grid%ph_2                          x
 535 !
 536 !j  grid%t_init                       x
 537 !
 538 !j  grid%phb   x
 539 !j  grid%ph0   x
 540 !j  grid%php   x
 541 !j   grid%pb   x
 542 !j   grid%al   x
 543 !j  grid%alt   x
 544 !j  grid%alb   x
 545 !
 546 !  the following are 2D (xy) variables
 547 !
 548 !j grid%mu_1                          x
 549 !j grid%mu_2                          x
 550 !j grid%mub   x
 551 !j grid%mu0   x
 552 !j grid%ht    x
 553 !j grid%msftx x
 554 !j grid%msfty x
 555 !j grid%msfux x
 556 !j grid%msfuy x
 557 !j grid%msfvx x
 558 !j grid%msfvy x
 559 !j grid%sina  x
 560 !j grid%cosa  x
 561 !j grid%e     x
 562 !j grid%f     x
 563 !
 564 !  4D variables
 565 !
 566 ! moist                        x
 567 !  chem                        x
 568 !scalar                        x
 569
 570 !--------------------------------------------------------------
 571
 572 #ifdef DM_PARALLEL
 573 #  include "HALO_EM_INIT_1_TL.inc"
 574 #  include "HALO_EM_INIT_2_TL.inc"
 575 #  include "HALO_EM_INIT_3_TL.inc"
 576 #  include "HALO_EM_INIT_4_TL.inc"
 577 #  include "HALO_EM_INIT_5_TL.inc"
 578 #endif
 579
 580
 581    CALL g_set_physical_bc3d( grid%u_1, grid%g_u_1 , 'U' , config_flags ,                  &
 582                          ids , ide , jds , jde , kds , kde ,        &
 583                          ims , ime , jms , jme , kms , kme ,        &
 584                          its , ite , jts , jte , kts , kte ,        &
 585                          its , ite , jts , jte , kts , kte )
 586    CALL g_set_physical_bc3d( grid%u_2, grid%g_u_2 , 'U' , config_flags ,                  &
 587                          ids , ide , jds , jde , kds , kde ,        &
 588                          ims , ime , jms , jme , kms , kme ,        &
 589                          its , ite , jts , jte , kts , kte ,        &
 590                          its , ite , jts , jte , kts , kte )
 591
 592    CALL g_set_physical_bc3d( grid%v_1, grid%g_v_1 , 'V' , config_flags ,                  &
 593                          ids , ide , jds , jde , kds , kde ,        &
 594                          ims , ime , jms , jme , kms , kme ,        &
 595                          its , ite , jts , jte , kts , kte ,        &
 596                          its , ite , jts , jte , kts , kte )
 597    CALL g_set_physical_bc3d( grid%v_2, grid%g_v_2 , 'V' , config_flags ,                  &
 598                          ids , ide , jds , jde , kds , kde ,        &
 599                          ims , ime , jms , jme , kms , kme ,        &
 600                          its , ite , jts , jte , kts , kte ,        &
 601                          its , ite , jts , jte , kts , kte )
 602
 603 ! Set the w at the surface.  If this is the start of a forecast, or if this is a cycled run
 604 ! and the start of that forecast, we define the w field.  However, if this a restart, then
 605 ! we leave w alone.  Initial value is V dot grad(topo) at surface, then smoothly decaying
 606 ! above that.
 607
 608    IF ( ( start_of_simulation .OR. config_flags%cycling ) .AND. ( .NOT. config_flags%restart ) ) THEN
 609 ! If W already exists (not zero), then we leave it alone.  How to do this?  We find the
 610 ! max/min on this node at the surface.  If parallel, we collect the max/min from all procs.
 611 ! If the max/min throughout the entire domain at the surface is identically 0, then we say
 612 ! that the W field is NOT initialized, and we run the set_w_surface routines for the
 613 ! two time levels of W.  If the field is already initialized, we do NOT run those two
 614 ! routines.
 615
 616       w_max = grid%w_2(its,1,jts)
 617       w_min = grid%w_2(its,1,jts)
 618       DO j = jts, MIN(jte,jde-1)
 619          DO i = its, MIN(ite,ide-1)
 620          w_max = MAX ( w_max , grid%w_2(i,1,j) )
 621          w_min = MIN ( w_min , grid%w_2(i,1,j) )
 622          END DO
 623       END DO
 624 #ifdef DM_PARALLEL
 625       w_max = wrf_dm_max_real ( w_max )
 626       w_min = wrf_dm_min_real ( w_min )
 627 #endif
 628
 629       IF ( ( ABS(w_max) .LT. 1.E-6 ) .AND. &
 630            ( ABS(w_min) .LT. 1.E-6 ) ) THEN
 631          w_needs_to_be_set = .TRUE.
 632       ELSE
 633          IF ( config_flags%use_input_w ) THEN
 634             w_needs_to_be_set = .FALSE.
 635          ELSE
 636             w_needs_to_be_set = .TRUE.
 637          END IF
 638       END IF
 639
 640       IF ( w_needs_to_be_set ) THEN
 641
 642          ! setting kinematic condition for w at the surface
 643
 644          fill_w_flag = .true.
 645          CALL g_set_w_surface(  config_flags, grid%znw, fill_w_flag,             &
 646                               grid%w_1, grid%g_w_1, grid%ht, &
 647                               grid%u_1, grid%g_u_1, grid%v_1, grid%g_v_1, grid%cf1, &
 648                               grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
 649                               ids, ide, jds, jde, kds, kde,                    &
 650                               ims, ime, jms, jme, kms, kme,                    &
 651                               its, ite, jts, jte, kts, kte                     )
 652          CALL g_set_w_surface(  config_flags, grid%znw, fill_w_flag,             &
 653                               grid%w_2, grid%g_w_2, grid%ht,  &
 654                               grid%u_2, grid%g_u_2, grid%v_2, grid%g_v_2, grid%cf1, &
 655                               grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
 656                               ids, ide, jds, jde, kds, kde,                    &
 657                               ims, ime, jms, jme, kms, kme,                    &
 658                               its, ite, jts, jte, kts, kte                     )
 659       END IF
 660
 661
 662    ENDIF
 663
 664 ! finished setting kinematic condition for w at the surface
 665
 666    CALL g_set_physical_bc3d( grid%w_1, grid%g_w_1 , 'W' , config_flags ,                 &
 667                          ids , ide , jds , jde , kds , kde ,        &
 668                          ims , ime , jms , jme , kms , kme ,        &
 669                          its , ite , jts , jte , kts , kte ,        &
 670                          its , ite , jts , jte , kts , kte )
 671    CALL g_set_physical_bc3d( grid%w_2, grid%g_w_2 , 'W' , config_flags ,                 &
 672                          ids , ide , jds , jde , kds , kde ,        &
 673                          ims , ime , jms , jme , kms , kme ,        &
 674                          its , ite , jts , jte , kts , kte ,        &
 675                          its , ite , jts , jte , kts , kte )
 676
 677    CALL g_set_physical_bc3d( grid%ph_1, grid%g_ph_1 , 'W' , config_flags ,                 &
 678                          ids , ide , jds , jde , kds , kde ,        &
 679                          ims , ime , jms , jme , kms , kme ,        &
 680                          its , ite , jts , jte , kts , kte ,        &
 681                          its , ite , jts , jte , kts , kte )
 682
 683    CALL g_set_physical_bc3d( grid%ph_2, grid%g_ph_2 , 'W' , config_flags ,                 &
 684                          ids , ide , jds , jde , kds , kde ,        &
 685                          ims , ime , jms , jme , kms , kme ,        &
 686                          its , ite , jts , jte , kts , kte ,        &
 687                          its , ite , jts , jte , kts , kte )
 688
 689    CALL g_set_physical_bc3d( grid%t_1, grid%g_t_1 , 't' , config_flags ,                 &
 690                          ids , ide , jds , jde , kds , kde ,        &
 691                          ims , ime , jms , jme , kms , kme ,        &
 692                          its , ite , jts , jte , kts , kte ,        &
 693                          its , ite , jts , jte , kts , kte )
 694
 695    CALL g_set_physical_bc3d( grid%t_2, grid%g_t_2 , 't' , config_flags ,                 &
 696                          ids , ide , jds , jde , kds , kde ,        &
 697                          ims , ime , jms , jme , kms , kme ,        &
 698                          its , ite , jts , jte , kts , kte ,        &
 699                          its , ite , jts , jte , kts , kte )
 700
 701    CALL g_set_physical_bc2d( grid%mu_1, grid%g_mu_1, 't' , config_flags ,   &
 702                            ids , ide , jds , jde ,  &
 703                            ims , ime , jms , jme ,  &
 704                            its , ite , jts , jte ,  &
 705                            its , ite , jts , jte   )
 706    CALL g_set_physical_bc2d( grid%mu_2, grid%g_mu_2, 't' , config_flags ,   &
 707                            ids , ide , jds , jde ,  &
 708                            ims , ime , jms , jme ,  &
 709                            its , ite , jts , jte ,  &
 710                            its , ite , jts , jte   )
 711    CALL g_set_physical_bc3d( grid%php, grid%g_php , 'W' , config_flags ,                 &
 712                          ids , ide , jds , jde , kds , kde ,        &
 713                          ims , ime , jms , jme , kms , kme ,        &
 714                          its , ite , jts , jte , kts , kte ,        &
 715                          its , ite , jts , jte , kts , kte )
 716
 717    CALL g_set_physical_bc3d( grid%al, grid%g_al , 't' , config_flags ,                 &
 718                          ids , ide , jds , jde , kds , kde ,        &
 719                          ims , ime , jms , jme , kms , kme ,        &
 720                          its , ite , jts , jte , kts , kte ,        &
 721                          its , ite , jts , jte , kts , kte )
 722    CALL g_set_physical_bc3d( grid%alt, grid%g_alt , 't' , config_flags ,                 &
 723                          ids , ide , jds , jde , kds , kde ,        &
 724                          ims , ime , jms , jme , kms , kme ,        &
 725                          its , ite , jts , jte , kts , kte ,        &
 726                          its , ite , jts , jte , kts , kte )
 727    CALL g_set_physical_bc3d(grid%tke_2, grid%g_tke_2, 't' , config_flags ,                 &
 728                          ids , ide , jds , jde , kds , kde ,        &
 729                          ims , ime , jms , jme , kms , kme ,        &
 730                          its , ite , jts , jte , kts , kte ,        &
 731                          its , ite , jts , jte , kts , kte )
 732
 733    IF (num_moist > 0) THEN
 734
 735 ! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
 736
 737       loop_3d_m   : DO loop = 1 , num_moist
 738          CALL g_set_physical_bc3d( moist(:,:,:,loop), g_moist(:,:,:,loop) , 'r' , config_flags ,                 &
 739                                  ids , ide , jds , jde , kds , kde ,        &
 740                                  ims , ime , jms , jme , kms , kme ,        &
 741                                  its , ite , jts , jte , kts , kte ,        &
 742                                  its , ite , jts , jte , kts , kte )
 743       END DO loop_3d_m
 744
 745    ENDIF
 746
 747    IF (num_scalar > 0) THEN
 748
 749 ! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
 750
 751       loop_3d_s   : DO loop = 1 , num_scalar
 752          CALL g_set_physical_bc3d( scalar(:,:,:,loop), g_scalar(:,:,:,loop) , 'r' , config_flags ,               &
 753                                  ids , ide , jds , jde , kds , kde ,        &
 754                                  ims , ime , jms , jme , kms , kme ,        &
 755                                  its , ite , jts , jte , kts , kte ,        &
 756                                  its , ite , jts , jte , kts , kte )
 757       END DO loop_3d_s
 758
 759    ENDIF
 760
 761         ! initialize advective tendency diagnostics for non-chem
 762         if ( grid%itimestep .eq. 0 .and. config_flags%tenddiag .eq. USETENDDIAG ) then
 763           advh_t(:,:,:,:) = 0.
 764           g_advh_t(:,:,:,:) = 0.
 765           advz_t(:,:,:,:) = 0.
 766           g_advz_t(:,:,:,:) = 0.
 767         endif
 768
 769 #if (WRF_CHEM!=1)
 770       DEALLOCATE(CLDFRA_OLD)
 771 #endif
 772 #ifdef DM_PARALLEL
 773 #   include "HALO_EM_INIT_1_TL.inc"
 774 #   include "HALO_EM_INIT_2_TL.inc"
 775 #   include "HALO_EM_INIT_3_TL.inc"
 776 #   include "HALO_EM_INIT_4_TL.inc"
 777 #   include "HALO_EM_INIT_5_TL.inc"
 778 #endif
 779
 780    IF (config_flags%p_lev_diags == PRESS_DIAGS ) THEN
 781     CALL wrf_debug ( 200 , ' PLD: pressure level diags' )
 782     CALL pld (                                  &
 783                  !  Input data for computing
 784                   U=grid%u_2                    &
 785                  ,V=grid%v_2                    &
 786                  ,W=grid%w_2                    &
 787                  ,t=grid%t_2                    &
 788                  ,qv=moist(:,:,:,P_QV)          &
 789                  ,zp=grid%ph_2                  &
 790                  ,zb=grid%phb                   &
 791                  ,pp=grid%p                     &
 792                  ,pb=grid%pb                    &
 793                  ,p=grid%p_hyd                  &
 794                  ,pw=grid%p_hyd_w               &
 795                  !  Map factors, coriolis for diags
 796                  ,msfux=grid%msfux              &
 797                  ,msfuy=grid%msfuy              &
 798                  ,msfvx=grid%msfvx              &
 799                  ,msfvy=grid%msfvy              &
 800                  ,msftx=grid%msftx              &
 801                  ,msfty=grid%msfty              &
 802                  ,f=grid%f                      &
 803                  ,e=grid%e                      &
 804                  !  Namelist info
 805                  ,use_tot_or_hyd_p=config_flags%use_tot_or_hyd_p &
 806                  ,extrap_below_grnd=config_flags%extrap_below_grnd &
 807                  ,missing=config_flags%p_lev_missing &
 808                  !  The diagnostics, mostly output variables
 809                  ,num_press_levels=config_flags%num_press_levels &
 810                  ,max_press_levels=max_plevs    &
 811                  ,press_levels=model_config_rec%press_levels &
 812                  ,p_pl  = grid%p_pl             &
 813                  ,u_pl  = grid%u_pl             &
 814                  ,v_pl  = grid%v_pl             &
 815                  ,t_pl  = grid%t_pl             &
 816                  ,rh_pl = grid%rh_pl            &
 817                  ,ght_pl= grid%ght_pl           &
 818                  ,s_pl  = grid%s_pl             &
 819                  ,td_pl = grid%td_pl            &
 820                  ,q_pl = grid%q_pl              &
 821                  !  Dimension arguments
 822                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde    &
 823                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme    &
 824                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte    )
 825    ENDIF
 826
 827      CALL wrf_debug ( 100 , 'start_domain_em_tl: Returning' )
 828
 829      RETURN
 830
 831    END SUBROUTINE g_start_domain_em
 832