wrftladj/module_bc_em_tl.F

   1 !WRF+/TL:MODEL_LAYER:BOUNDARY
   2 !
   3 MODULE g_module_bc_em
   4
   5    USE module_bc
   6    USE module_configure
   7    USE module_wrf_error
   8    USE g_module_bc
   9
  10 CONTAINS
  11
  12 !------------------------------------------------------------------------
  13
  14    SUBROUTINE g_spec_bdyupdate_ph( ph_save, g_ph_save, field, g_field,     &
  15                                field_tend, g_field_tend, mu_tend, g_mu_tend, muts, g_muts, dt,     &
  16                                variable_in, config_flags, &
  17                                spec_zone,                  &
  18                                ids,ide, jds,jde, kds,kde,  & ! domain dims
  19                                ims,ime, jms,jme, kms,kme,  & ! memory dims
  20                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
  21                                its,ite, jts,jte, kts,kte )
  22
  23 !  This subroutine adds the tendencies in the boundary specified region.
  24 !  spec_zone is the width of the outer specified b.c.s that are set here.
  25 !  (JD August 2000)
  26
  27       IMPLICIT NONE
  28
  29       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
  30       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
  31       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
  32       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
  33       INTEGER,      INTENT(IN   )    :: spec_zone
  34       CHARACTER,    INTENT(IN   )    :: variable_in
  35       REAL,         INTENT(IN   )    :: dt
  36
  37
  38       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: g_field
  39       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
  40       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: g_field_tend, g_ph_save
  41       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field_tend, ph_save
  42       REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(IN   ) :: g_mu_tend, g_muts
  43       REAL,  DIMENSION( ims:ime , jms:jme ), INTENT(IN   ) :: mu_tend, muts
  44       TYPE( grid_config_rec_type ) config_flags
  45
  46       CHARACTER  :: variable
  47       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
  48       INTEGER    :: b_dist, b_limit
  49
  50 !     Local array
  51
  52       REAL,  DIMENSION( its:ite , jts:jte ) :: g_mu_old
  53       REAL,  DIMENSION( its:ite , jts:jte ) :: mu_old
  54       LOGICAL    :: periodic_x
  55
  56       periodic_x = config_flags%periodic_x
  57
  58       variable = variable_in
  59
  60       IF (variable == 'U') variable = 'u'
  61       IF (variable == 'V') variable = 'v'
  62       IF (variable == 'M') variable = 'm'
  63       IF (variable == 'H') variable = 'h'
  64
  65       ibs = ids
  66       ibe = ide-1
  67       itf = min(ite,ide-1)
  68       jbs = jds
  69       jbe = jde-1
  70       jtf = min(jte,jde-1)
  71       ktf = kde-1
  72       IF (variable == 'u') ibe = ide
  73       IF (variable == 'u') itf = min(ite,ide)
  74       IF (variable == 'v') jbe = jde
  75       IF (variable == 'v') jtf = min(jte,jde)
  76       IF (variable == 'm') ktf = kte
  77       IF (variable == 'h') ktf = kte
  78
  79       IF (jts - jbs .lt. spec_zone) THEN
  80 ! Y-start boundary
  81         DO j = jts, min(jtf,jbs+spec_zone-1)
  82           b_dist = j - jbs
  83           b_limit = b_dist
  84           IF(periodic_x)b_limit = 0
  85           DO k = kts, ktf
  86             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
  87
  88               g_mu_old(i,j) = g_muts(i,j) - dt*g_mu_tend(i,j)
  89               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
  90
  91               g_field(i,k,j) = (g_field(i,k,j)+g_ph_save(i,k,j))*mu_old(i,j)/muts(i,j) &
  92                    + (field(i,k,j)+ph_save(i,k,j))*g_mu_old(i,j)/muts(i,j)             &
  93                    - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) &
  94                    + dt*( g_field_tend(i,k,j)/muts(i,j)                                &
  95                         - field_tend(i,k,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) )        &
  96                    - g_ph_save(i,k,j)
  97               field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
  98                    dt*field_tend(i,k,j)/muts(i,j) +               &
  99                    ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
 100
 101             ENDDO
 102           ENDDO
 103         ENDDO
 104       ENDIF
 105       IF (jbe - jtf .lt. spec_zone) THEN
 106 ! Y-end boundary
 107         DO j = max(jts,jbe-spec_zone+1), jtf
 108           b_dist = jbe - j
 109           b_limit = b_dist
 110           IF(periodic_x)b_limit = 0
 111           DO k = kts, ktf
 112             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
 113
 114               g_mu_old(i,j) = g_muts(i,j) - dt*g_mu_tend(i,j)
 115               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
 116
 117               g_field(i,k,j) = (g_field(i,k,j)+g_ph_save(i,k,j))*mu_old(i,j)/muts(i,j) &
 118                    + (field(i,k,j)+ph_save(i,k,j))*g_mu_old(i,j)/muts(i,j)             &
 119                    - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) &
 120                    + dt*( g_field_tend(i,k,j)/muts(i,j)                                &
 121                         - field_tend(i,k,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) )        &
 122                    - g_ph_save(i,k,j)
 123               field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
 124                    dt*field_tend(i,k,j)/muts(i,j) +               &
 125                    ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
 126
 127             ENDDO
 128           ENDDO
 129         ENDDO
 130       ENDIF
 131
 132     IF(.NOT.periodic_x)THEN
 133       IF (its - ibs .lt. spec_zone) THEN
 134 ! X-start boundary
 135         DO i = its, min(itf,ibs+spec_zone-1)
 136           b_dist = i - ibs
 137           DO k = kts, ktf
 138             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
 139
 140               g_mu_old(i,j) = g_muts(i,j) - dt*g_mu_tend(i,j)
 141               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
 142
 143               g_field(i,k,j) = (g_field(i,k,j)+g_ph_save(i,k,j))*mu_old(i,j)/muts(i,j) &
 144                    + (field(i,k,j)+ph_save(i,k,j))*g_mu_old(i,j)/muts(i,j)             &
 145                    - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) &
 146                    + dt*( g_field_tend(i,k,j)/muts(i,j)                                &
 147                         - field_tend(i,k,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) )        &
 148                    - g_ph_save(i,k,j)
 149               field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
 150                    dt*field_tend(i,k,j)/muts(i,j) +               &
 151                    ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
 152
 153             ENDDO
 154           ENDDO
 155         ENDDO
 156       ENDIF
 157
 158       IF (ibe - itf .lt. spec_zone) THEN
 159 ! X-end boundary
 160         DO i = max(its,ibe-spec_zone+1), itf
 161           b_dist = ibe - i
 162           DO k = kts, ktf
 163             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
 164
 165               g_mu_old(i,j) = g_muts(i,j) - dt*g_mu_tend(i,j)
 166               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
 167
 168               g_field(i,k,j) = (g_field(i,k,j)+g_ph_save(i,k,j))*mu_old(i,j)/muts(i,j) &
 169                    + (field(i,k,j)+ph_save(i,k,j))*g_mu_old(i,j)/muts(i,j)             &
 170                    - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) &
 171                    + dt*( g_field_tend(i,k,j)/muts(i,j)                                &
 172                         - field_tend(i,k,j)*g_muts(i,j)/(muts(i,j)*muts(i,j)) )        &
 173                    - g_ph_save(i,k,j)
 174               field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
 175                    dt*field_tend(i,k,j)/muts(i,j) +               &
 176                    ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
 177
 178             ENDDO
 179           ENDDO
 180         ENDDO
 181       ENDIF
 182     ENDIF
 183
 184    END SUBROUTINE g_spec_bdyupdate_ph
 185
 186 !------------------------------------------------------------------------
 187
 188    SUBROUTINE g_relax_bdy_dry ( config_flags, &
 189        ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, &
 190        ph_tendf, g_ph_tendf, t_tendf, g_t_tendf,   &
 191        rw_tendf, g_rw_tendf, mu_tend, g_mu_tend,   &
 192        ru, g_ru, rv, g_rv, ph, g_ph, t, g_t,       &
 193        w, g_w, mu, g_mu, mut, g_mut,               &
 194        u_bxs, g_u_bxs, u_bxe, g_u_bxe, u_bys, g_u_bys, u_bye, g_u_bye,  &
 195        v_bxs, g_v_bxs, v_bxe, g_v_bxe, v_bys, g_v_bys, v_bye, g_v_bye,  &
 196        ph_bxs, g_ph_bxs, ph_bxe, g_ph_bxe, ph_bys, g_ph_bys, ph_bye, g_ph_bye,  &
 197        t_bxs, g_t_bxs, t_bxe, g_t_bxe, t_bys, g_t_bys, t_bye, g_t_bye,  &
 198        w_bxs, g_w_bxs, w_bxe, g_w_bxe, w_bys, g_w_bys, w_bye, g_w_bye,  &
 199        mu_bxs, g_mu_bxs, mu_bxe, g_mu_bxe, mu_bys, g_mu_bys, mu_bye, g_mu_bye,  &
 200        u_btxs, g_u_btxs, u_btxe, g_u_btxe, u_btys, g_u_btys, u_btye, g_u_btye,  &
 201        v_btxs, g_v_btxs, v_btxe, g_v_btxe, v_btys, g_v_btys, v_btye, g_v_btye,  &
 202        ph_btxs, g_ph_btxs, ph_btxe, g_ph_btxe, ph_btys, g_ph_btys, ph_btye, g_ph_btye, &
 203        t_btxs, g_t_btxs, t_btxe, g_t_btxe, t_btys, g_t_btys, t_btye, g_t_btye,  &
 204        w_btxs, g_w_btxs, w_btxe, g_w_btxe, w_btys, g_w_btys, w_btye, g_w_btye,  &
 205        mu_btxs, g_mu_btxs, mu_btxe, g_mu_btxe, mu_btys, g_mu_btys, mu_btye, g_mu_btye, &
 206        spec_bdy_width, spec_zone, relax_zone,  &
 207        dtbc, fcx, gcx,             &
 208        ids,ide, jds,jde, kds,kde,  & ! domain dims
 209        ims,ime, jms,jme, kms,kme,  & ! memory dims
 210        ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 211        its, ite, jts, jte, kts, kte)
 212
 213    IMPLICIT NONE
 214
 215    !  Input data.
 216    TYPE(grid_config_rec_type), INTENT(IN) ::  config_flags
 217    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
 218                           ims, ime, jms, jme, kms, kme, &
 219                           ips, ipe, jps, jpe, kps, kpe, &
 220                           its, ite, jts, jte, kts, kte
 221    INTEGER, INTENT(IN) :: spec_bdy_width, spec_zone, relax_zone
 222
 223    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: g_ru,  &
 224                                                              g_rv,  &
 225                                                              g_ph,  &
 226                                                              g_w,   &
 227                                                              g_t
 228    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ru, &
 229                                                              rv, &
 230                                                              ph, &
 231                                                              w,  &
 232                                                              t
 233    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: g_mu, &
 234                                                     g_mut
 235    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mu, &
 236                                                     mut
 237
 238    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: g_ru_tendf, &
 239                                                                 g_rv_tendf, &
 240                                                                 g_ph_tendf, &
 241                                                                 g_rw_tendf, &
 242                                                                 g_t_tendf
 243    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: ru_tendf, &
 244                                                                 rv_tendf, &
 245                                                                 ph_tendf, &
 246                                                                 rw_tendf, &
 247                                                                 t_tendf
 248    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(INOUT) :: g_mu_tend
 249    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(INOUT) :: mu_tend
 250
 251    REAL, DIMENSION(spec_bdy_width), INTENT(IN) :: fcx, gcx
 252    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(IN) :: g_u_bxs,g_u_bxe, &
 253                                                                     g_v_bxs,g_v_bxe, &
 254                                                                     g_ph_bxs,g_ph_bxe, &
 255                                                                     g_w_bxs,g_w_bxe, &
 256                                                                     g_t_bxs,g_t_bxe, &
 257                                                                     g_u_btxs,g_u_btxe, &
 258                                                                     g_v_btxs,g_v_btxe, &
 259                                                                     g_ph_btxs,g_ph_btxe, &
 260                                                                     g_w_btxs,g_w_btxe, &
 261                                                                     g_t_btxs,g_t_btxe
 262    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(IN) :: u_bxs,u_bxe, &
 263                                                                     v_bxs,v_bxe, &
 264                                                                     ph_bxs,ph_bxe, &
 265                                                                     w_bxs,w_bxe, &
 266                                                                     t_bxs,t_bxe, &
 267                                                                     u_btxs,u_btxe, &
 268                                                                     v_btxs,v_btxe, &
 269                                                                     ph_btxs,ph_btxe, &
 270                                                                     w_btxs,w_btxe, &
 271                                                                     t_btxs,t_btxe
 272
 273    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(IN) :: g_u_bys,g_u_bye, &
 274                                                                     g_v_bys,g_v_bye, &
 275                                                                     g_ph_bys,g_ph_bye, &
 276                                                                     g_w_bys,g_w_bye, &
 277                                                                     g_t_bys,g_t_bye, &
 278                                                                     g_u_btys,g_u_btye, &
 279                                                                     g_v_btys,g_v_btye, &
 280                                                                     g_ph_btys,g_ph_btye, &
 281                                                                     g_w_btys,g_w_btye, &
 282                                                                     g_t_btys,g_t_btye
 283    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(IN) :: u_bys,u_bye, &
 284                                                                     v_bys,v_bye, &
 285                                                                     ph_bys,ph_bye, &
 286                                                                     w_bys,w_bye, &
 287                                                                     t_bys,t_bye, &
 288                                                                     u_btys,u_btye, &
 289                                                                     v_btys,v_btye, &
 290                                                                     ph_btys,ph_btye, &
 291                                                                     w_btys,w_btye, &
 292                                                                     t_btys,t_btye
 293    REAL, DIMENSION(jms:jme, 1:1, spec_bdy_width), INTENT(IN) :: g_mu_bxs,g_mu_bxe, &
 294                                                                 g_mu_btxs,g_mu_btxe
 295    REAL, DIMENSION(jms:jme, 1:1, spec_bdy_width), INTENT(IN) :: mu_bxs,mu_bxe, &
 296                                                                 mu_btxs,mu_btxe
 297    REAL, DIMENSION(ims:ime, 1:1, spec_bdy_width), INTENT(IN) :: g_mu_bys,g_mu_bye, &
 298                                                                 g_mu_btys,g_mu_btye
 299    REAL, DIMENSION(ims:ime, 1:1, spec_bdy_width), INTENT(IN) :: mu_bys,mu_bye, &
 300                                                                 mu_btys,mu_btye
 301    REAL, INTENT(IN) :: dtbc
 302
 303    REAL, DIMENSION( its-1:ite+1 , kts:kte, jts-1:jte+1  ) :: g_rfield
 304    REAL, DIMENSION( its-1:ite+1 , kts:kte, jts-1:jte+1  ) :: rfield
 305    INTEGER :: i_start, i_end, j_start, j_end, i, j, k
 306
 307
 308    CALL g_relax_bdytend ( ru, g_ru, ru_tendf, g_ru_tendf, &
 309                           u_bxs,g_u_bxs,u_bxe,g_u_bxe, &
 310                           u_bys,g_u_bys,u_bye,g_u_bye, &
 311                           u_btxs,g_u_btxs,u_btxe,g_u_btxe, &
 312                           u_btys,g_u_btys,u_btye,g_u_btye, &
 313                           'u'        , config_flags,  &
 314                           spec_bdy_width, spec_zone, relax_zone, &
 315                           dtbc, fcx, gcx,             &
 316                           ids,ide, jds,jde, kds,kde,  & ! domain dims
 317                           ims,ime, jms,jme, kms,kme,  & ! memory dims
 318                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 319                           its,ite, jts,jte, kts,kte )
 320
 321    CALL g_relax_bdytend ( rv, g_rv, rv_tendf, g_rv_tendf, &
 322                           v_bxs,g_v_bxs,v_bxe,g_v_bxe, &
 323                           v_bys,g_v_bys,v_bye,g_v_bye, &
 324                           v_btxs,g_v_btxs,v_btxe,g_v_btxe, &
 325                           v_btys,g_v_btys,v_btye,g_v_btye, &
 326                           'v'        , config_flags,  &
 327                           spec_bdy_width, spec_zone, relax_zone, &
 328                           dtbc, fcx, gcx,             &
 329                           ids,ide, jds,jde, kds,kde,  & ! domain dims
 330                           ims,ime, jms,jme, kms,kme,  & ! memory dims
 331                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 332                           its,ite, jts,jte, kts,kte )
 333
 334    i_start = max(its-1, ids)
 335    i_end = min(ite+1, ide-1)
 336    j_start = max(jts-1, jds)
 337    j_end = min(jte+1, jde-1)
 338
 339    DO j=j_start,j_end
 340    DO k=kts,kte
 341    DO i=i_start,i_end
 342       g_rfield(i,k,j) = g_ph(i,k,j)*mut(i,j) + ph(i,k,j)*g_mut(i,j)
 343       rfield(i,k,j) = ph(i,k,j)*mut(i,j)
 344    ENDDO
 345    ENDDO
 346    ENDDO
 347    CALL g_relax_bdytend_tile ( rfield, g_rfield, ph_tendf, g_ph_tendf, &
 348                        ph_bxs,g_ph_bxs,ph_bxe,g_ph_bxe, &
 349                        ph_bys,g_ph_bys,ph_bye,g_ph_bye, &
 350                        ph_btxs,g_ph_btxs,ph_btxe,g_ph_btxe, &
 351                        ph_btys,g_ph_btys,ph_btye,g_ph_btye, &
 352                        'h'        , config_flags,  &
 353                        spec_bdy_width, spec_zone, relax_zone, &
 354                        dtbc, fcx, gcx,             &
 355                        ids,ide, jds,jde, kds,kde,  & ! domain dims
 356                        ims,ime, jms,jme, kms,kme,  & ! memory dims
 357                        ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 358                        its,ite, jts,jte, kts,kte,  &
 359                        its-1, ite+1, jts-1,jte+1,kts,kte )  ! dims of first argument
 360
 361    DO j=j_start,j_end
 362    DO k=kts,kte-1
 363    DO i=i_start,i_end
 364       g_rfield(i,k,j) = g_t(i,k,j)*mut(i,j) + t(i,k,j)*g_mut(i,j)
 365       rfield(i,k,j) = t(i,k,j)*mut(i,j)
 366    ENDDO
 367    ENDDO
 368    ENDDO
 369    CALL g_relax_bdytend_tile ( rfield, g_rfield, t_tendf, g_t_tendf, &
 370                        t_bxs,g_t_bxs,t_bxe,g_t_bxe, &
 371                        t_bys,g_t_bys,t_bye,g_t_bye, &
 372                        t_btxs,g_t_btxs,t_btxe,g_t_btxe, &
 373                        t_btys,g_t_btys,t_btye,g_t_btye, &
 374                        't'        , config_flags,  &
 375                        spec_bdy_width, spec_zone, relax_zone, &
 376                        dtbc, fcx, gcx,             &
 377                        ids,ide, jds,jde, kds,kde,  & ! domain dims
 378                        ims,ime, jms,jme, kms,kme,  & ! memory dims
 379                        ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 380                        its,ite, jts,jte, kts,kte,  &
 381                        its-1, ite+1, jts-1,jte+1,kts,kte )  ! dims of first argument
 382
 383    CALL g_relax_bdytend ( mu, g_mu, mu_tend, g_mu_tend, &
 384                        mu_bxs,g_mu_bxs,mu_bxe,g_mu_bxe, &
 385                        mu_bys,g_mu_bys,mu_bye,g_mu_bye, &
 386                        mu_btxs,g_mu_btxs,mu_btxe,g_mu_btxe, &
 387                        mu_btys,g_mu_btys,mu_btye,g_mu_btye, &
 388                        'm'        , config_flags,  &
 389                        spec_bdy_width, spec_zone, relax_zone, &
 390                        dtbc, fcx, gcx,             &
 391                        ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
 392                        ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
 393                        ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
 394                        its,ite, jts,jte, 1  ,1   )
 395
 396    IF( config_flags%nested) THEN
 397
 398      i_start = max(its-1, ids)
 399      i_end = min(ite+1, ide-1)
 400      j_start = max(jts-1, jds)
 401      j_end = min(jte+1, jde-1)
 402
 403      DO j=j_start,j_end
 404      DO k=kts,kte
 405      DO i=i_start,i_end
 406         g_rfield(i,k,j) = g_w(i,k,j)*mut(i,j) + w(i,k,j)*g_mut(i,j)
 407         rfield(i,k,j) = w(i,k,j)*mut(i,j)
 408      ENDDO
 409      ENDDO
 410      ENDDO
 411      CALL g_relax_bdytend_tile ( rfield, g_rfield, rw_tendf, g_rw_tendf, &
 412                          w_bxs,g_w_bxs,w_bxe,g_w_bxe, &
 413                          w_bys,g_w_bys,w_bye,g_w_bye, &
 414                          w_btxs,g_w_btxs,w_btxe,g_w_btxe, &
 415                          w_btys,g_w_btys,w_btye,g_w_btye, &
 416                          'h'        , config_flags,  &
 417                          spec_bdy_width, spec_zone, relax_zone, &
 418                          dtbc, fcx, gcx,             &
 419                          ids,ide, jds,jde, kds,kde,  & ! domain dims
 420                          ims,ime, jms,jme, kms,kme,  & ! memory dims
 421                          ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 422                          its,ite, jts,jte, kts,kte,  &
 423                          its-1, ite+1, jts-1,jte+1,kts,kte )  ! dims of first argument
 424
 425    END IF
 426
 427    END SUBROUTINE g_relax_bdy_dry
 428
 429 !------------------------------------------------------------------------
 430
 431    SUBROUTINE g_relax_bdy_scalar ( scalar_tend, g_scalar_tend, &
 432                                    scalar, g_scalar, mu, g_mu, &
 433                                    scalar_bxs,g_scalar_bxs,scalar_bxe,g_scalar_bxe, &
 434                                    scalar_bys,g_scalar_bys,scalar_bye,g_scalar_bye, &
 435                                    scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe, &
 436                                    scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye, &
 437                                    spec_bdy_width, spec_zone, relax_zone,       &
 438                                    dtbc, fcx, gcx,             &
 439                                    config_flags,               &
 440                                    ids,ide, jds,jde, kds,kde,  & ! domain dims
 441                                    ims,ime, jms,jme, kms,kme,  & ! memory dims
 442                                    ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 443                                    its, ite, jts, jte, kts, kte)
 444
 445    IMPLICIT NONE
 446
 447    !  Input data.
 448    TYPE( grid_config_rec_type ) config_flags
 449
 450    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
 451                           ims, ime, jms, jme, kms, kme, &
 452                           ips, ipe, jps, jpe, kps, kpe, &
 453                           its, ite, jts, jte, kts, kte
 454    INTEGER, INTENT(IN) :: spec_bdy_width, spec_zone, relax_zone
 455
 456    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN   ) :: g_scalar
 457    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN   ) :: scalar
 458    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(IN   ) :: g_mu
 459    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(IN   ) :: mu
 460    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: g_scalar_tend
 461    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: scalar_tend
 462    REAL, DIMENSION(spec_bdy_width), INTENT(IN) :: fcx, gcx
 463
 464    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(IN) :: g_scalar_bxs,g_scalar_bxe, &
 465                                                                     g_scalar_btxs,g_scalar_btxe
 466    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(IN) :: g_scalar_bys,g_scalar_bye, &
 467                                                                     g_scalar_btys,g_scalar_btye
 468    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(IN) :: scalar_bxs,scalar_bxe, &
 469                                                                     scalar_btxs,scalar_btxe
 470    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(IN) :: scalar_bys,scalar_bye, &
 471                                                                     scalar_btys,scalar_btye
 472    REAL, INTENT(IN   ) :: dtbc
 473 !Local
 474    INTEGER :: i,j,k, i_start, i_end, j_start, j_end
 475    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) :: rscalar
 476    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) :: g_rscalar
 477
 478 ! rscalar will be calculated beyond tile limits because relax_bdytend
 479 !   requires a 5-point stencil, and this avoids need for inter-tile/patch
 480 !   communication here
 481            i_start = max(its-1, ids)
 482            i_end = min(ite+1, ide-1)
 483            j_start = max(jts-1, jds)
 484            j_end = min(jte+1, jde-1)
 485
 486            DO j=j_start,j_end
 487            DO k=kts,min(kte,kde-1)
 488            DO i=i_start,i_end
 489               g_rscalar(i,k,j) = g_scalar(i,k,j)*mu(i,j) + scalar(i,k,j)*g_mu(i,j)
 490               rscalar(i,k,j) = scalar(i,k,j)*mu(i,j)
 491            ENDDO
 492            ENDDO
 493            ENDDO
 494
 495            CALL g_relax_bdytend (rscalar, g_rscalar, scalar_tend, g_scalar_tend,  &
 496                                  scalar_bxs,g_scalar_bxs,scalar_bxe,g_scalar_bxe, &
 497                                  scalar_bys,g_scalar_bys,scalar_bye,g_scalar_bye, &
 498                                  scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe, &
 499                                  scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye, &
 500                                  'q'        , config_flags,  &
 501                                  spec_bdy_width, spec_zone, relax_zone, &
 502                                  dtbc, fcx, gcx,             &
 503                                  ids,ide, jds,jde, kds,kde,  & ! domain dims
 504                                  ims,ime, jms,jme, kms,kme,  & ! memory dims
 505                                  ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 506                                  its,ite, jts,jte, kts,kte )
 507
 508    END SUBROUTINE g_relax_bdy_scalar
 509
 510 !------------------------------------------------------------------------
 511    SUBROUTINE g_spec_bdy_dry ( config_flags,                        &
 512                              ru_tend, g_ru_tend, rv_tend, g_rv_tend, &
 513                              ph_tend, g_ph_tend, t_tend, g_t_tend, &
 514                              rw_tend, g_rw_tend, mu_tend, g_mu_tend, &
 515                              u_bxs,g_u_bxs,u_bxe,g_u_bxe,u_bys,g_u_bys,u_bye,g_u_bye, &
 516                              v_bxs,g_v_bxs,v_bxe,g_v_bxe,v_bys,g_v_bys,v_bye,g_v_bye, &
 517                              ph_bxs,g_ph_bxs,ph_bxe,g_ph_bxe,ph_bys,g_ph_bys,ph_bye,g_ph_bye, &
 518                              t_bxs,g_t_bxs,t_bxe,g_t_bxe,t_bys,g_t_bys,t_bye,g_t_bye, &
 519                              w_bxs,g_w_bxs,w_bxe,g_w_bxe,w_bys,g_w_bys,w_bye,g_w_bye, &
 520                              mu_bxs,g_mu_bxs,mu_bxe,g_mu_bxe,mu_bys,g_mu_bys,mu_bye,g_mu_bye, &
 521                              u_btxs,g_u_btxs,u_btxe,g_u_btxe,u_btys,g_u_btys,u_btye,g_u_btye, &
 522                              v_btxs,g_v_btxs,v_btxe,g_v_btxe,v_btys,g_v_btys,v_btye,g_v_btye, &
 523                              ph_btxs,g_ph_btxs,ph_btxe,g_ph_btxe,ph_btys,g_ph_btys,ph_btye,g_ph_btye, &
 524                              t_btxs,g_t_btxs,t_btxe,g_t_btxe,t_btys,g_t_btys,t_btye,g_t_btye, &
 525                              w_btxs,g_w_btxs,w_btxe,g_w_btxe,w_btys,g_w_btys,w_btye,g_w_btye, &
 526                              mu_btxs,g_mu_btxs,mu_btxe,g_mu_btxe,mu_btys,g_mu_btys,mu_btye,g_mu_btye, &
 527                              spec_bdy_width, spec_zone,           &
 528                              ids,ide, jds,jde, kds,kde,  & ! domain dims
 529                              ims,ime, jms,jme, kms,kme,  & ! memory dims
 530                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 531                              its, ite, jts, jte, kts, kte)
 532    IMPLICIT NONE
 533
 534    !  Input data.
 535    TYPE( grid_config_rec_type ) config_flags
 536
 537
 538    INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
 539                                             ims, ime, jms, jme, kms, kme, &
 540                                             ips, ipe, jps, jpe, kps, kpe, &
 541                                             its, ite, jts, jte, kts, kte
 542    INTEGER ,               INTENT(IN   ) :: spec_bdy_width, spec_zone
 543
 544    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(OUT  ) :: g_ru_tend, &
 545                                                                       g_rv_tend, &
 546                                                                       g_ph_tend, &
 547                                                                       g_rw_tend, &
 548                                                                       g_t_tend
 549    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(OUT  ) :: ru_tend, &
 550                                                                       rv_tend, &
 551                                                                       ph_tend, &
 552                                                                       rw_tend, &
 553                                                                       t_tend
 554    REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(OUT  )          :: g_mu_tend
 555    REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(OUT  )          :: mu_tend
 556
 557    REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width    ), INTENT(IN   ) :: g_u_bxs,g_u_bxe,  &
 558                                                                                g_v_bxs,g_v_bxe,  &
 559                                                                                g_ph_bxs,g_ph_bxe, &
 560                                                                                g_w_bxs,g_w_bxe, &
 561                                                                                g_t_bxs,g_t_bxe,  &
 562                                                                                g_u_btxs,g_u_btxe, &
 563                                                                                g_v_btxs,g_v_btxe, &
 564                                                                                g_ph_btxs,g_ph_btxe, &
 565                                                                                g_w_btxs,g_w_btxe, &
 566                                                                                g_t_btxs,g_t_btxe
 567    REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width    ), INTENT(IN   ) :: u_bxs,u_bxe,  &
 568                                                                                v_bxs,v_bxe,  &
 569                                                                                ph_bxs,ph_bxe, &
 570                                                                                w_bxs,w_bxe, &
 571                                                                                t_bxs,t_bxe,  &
 572                                                                                u_btxs,u_btxe, &
 573                                                                                v_btxs,v_btxe, &
 574                                                                                ph_btxs,ph_btxe, &
 575                                                                                w_btxs,w_btxe, &
 576                                                                                t_btxs,t_btxe
 577
 578    REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width    ), INTENT(IN   ) :: g_u_bys,g_u_bye,  &
 579                                                                                g_v_bys,g_v_bye,  &
 580                                                                                g_ph_bys,g_ph_bye, &
 581                                                                                g_w_bys,g_w_bye, &
 582                                                                                g_t_bys,g_t_bye,  &
 583                                                                                g_u_btys,g_u_btye, &
 584                                                                                g_v_btys,g_v_btye, &
 585                                                                                g_ph_btys,g_ph_btye, &
 586                                                                                g_w_btys,g_w_btye, &
 587                                                                                g_t_btys,g_t_btye
 588    REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width    ), INTENT(IN   ) :: u_bys,u_bye,  &
 589                                                                                v_bys,v_bye,  &
 590                                                                                ph_bys,ph_bye, &
 591                                                                                w_bys,w_bye, &
 592                                                                                t_bys,t_bye,  &
 593                                                                                u_btys,u_btye, &
 594                                                                                v_btys,v_btye, &
 595                                                                                ph_btys,ph_btye, &
 596                                                                                w_btys,w_btye, &
 597                                                                                t_btys,t_btye
 598
 599    REAL,  DIMENSION( jms:jme , 1:1 ,     spec_bdy_width    ), INTENT(IN   ) :: g_mu_bxs,g_mu_bxe, &
 600                                                                                g_mu_btxs,g_mu_btxe
 601    REAL,  DIMENSION( jms:jme , 1:1 ,     spec_bdy_width    ), INTENT(IN   ) :: mu_bxs,mu_bxe, &
 602                                                                                mu_btxs,mu_btxe
 603
 604    REAL,  DIMENSION( ims:ime , 1:1 ,     spec_bdy_width    ), INTENT(IN   ) :: g_mu_bys,g_mu_bye, &
 605                                                                                g_mu_btys,g_mu_btye
 606    REAL,  DIMENSION( ims:ime , 1:1 ,     spec_bdy_width    ), INTENT(IN   ) :: mu_bys,mu_bye, &
 607                                                                                mu_btys,mu_btye
 608
 609          CALL g_spec_bdytend (   ru_tend, g_ru_tend,               &
 610                                u_bxs,g_u_bxs,u_bxe,g_u_bxe,u_bys,g_u_bys,u_bye,g_u_bye, &
 611                                u_btxs,g_u_btxs,u_btxe,g_u_btxe,u_btys,g_u_btys,u_btye,g_u_btye, &
 612                                'u'     , config_flags, &
 613                                spec_bdy_width, spec_zone, &
 614                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 615                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 616                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 617                                its,ite, jts,jte, kts,kte )
 618          CALL g_spec_bdytend (   rv_tend, g_rv_tend,               &
 619                                v_bxs,g_v_bxs,v_bxe,g_v_bxe,v_bys,g_v_bys,v_bye,g_v_bye, &
 620                                v_btxs,g_v_btxs,v_btxe,g_v_btxe,v_btys,g_v_btys,v_btye,g_v_btye, &
 621                                'v'     , config_flags, &
 622                                spec_bdy_width, spec_zone, &
 623                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 624                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 625                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 626                                its,ite, jts,jte, kts,kte )
 627          CALL g_spec_bdytend (   ph_tend, g_ph_tend,                &
 628                                ph_bxs,g_ph_bxs,ph_bxe,g_ph_bxe,ph_bys,g_ph_bys,ph_bye,g_ph_bye, &
 629                                ph_btxs,g_ph_btxs,ph_btxe,g_ph_btxe,ph_btys,g_ph_btys,ph_btye,g_ph_btye, &
 630                                'h'     , config_flags, &
 631                                spec_bdy_width, spec_zone, &
 632                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 633                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 634                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 635                                its,ite, jts,jte, kts,kte )
 636          CALL g_spec_bdytend (   t_tend, g_t_tend,                &
 637                                t_bxs,g_t_bxs,t_bxe,g_t_bxe,t_bys,g_t_bys,t_bye,g_t_bye, &
 638                                t_btxs,g_t_btxs,t_btxe,g_t_btxe,t_btys,g_t_btys,t_btye,g_t_btye, &
 639                                't'     , config_flags, &
 640                                spec_bdy_width, spec_zone, &
 641                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 642                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 643                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 644                                its,ite, jts,jte, kts,kte )
 645          CALL g_spec_bdytend (   mu_tend, g_mu_tend,               &
 646                                mu_bxs,g_mu_bxs,mu_bxe,g_mu_bxe,mu_bys,g_mu_bys,mu_bye,g_mu_bye, &
 647                                mu_btxs,g_mu_btxs,mu_btxe,g_mu_btxe,mu_btys,g_mu_btys,mu_btye,g_mu_btye, &
 648                                'm'     , config_flags, &
 649                                spec_bdy_width, spec_zone, &
 650                                ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
 651                                ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
 652                                ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
 653                                its,ite, jts,jte, 1  ,1   )
 654
 655          if(config_flags%nested)                           &
 656          CALL g_spec_bdytend (   rw_tend, g_rw_tend,                   &
 657                                w_bxs,g_w_bxs,w_bxe,g_w_bxe,w_bys,g_w_bys,w_bye,g_w_bye, &
 658                                w_btxs,g_w_btxs,w_btxe,g_w_btxe,w_btys,g_w_btys,w_btye,g_w_btye, &
 659                                'h'     , config_flags,     &
 660                                spec_bdy_width, spec_zone,  &
 661                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 662                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 663                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 664                                its,ite, jts,jte, kts,kte )
 665
 666    END SUBROUTINE g_spec_bdy_dry
 667
 668 !------------------------------------------------------------------------
 669    SUBROUTINE g_spec_bdy_scalar ( scalar_tend, g_scalar_tend,   &
 670                           scalar_bxs,g_scalar_bxs,scalar_bxe,g_scalar_bxe,   &
 671                           scalar_bys,g_scalar_bys,scalar_bye,g_scalar_bye,   &
 672                           scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe,   &
 673                           scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye,   &
 674                           spec_bdy_width, spec_zone,  &
 675                           config_flags,               &
 676                           ids,ide, jds,jde, kds,kde,  & ! domain dims
 677                           ims,ime, jms,jme, kms,kme,  & ! memory dims
 678                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 679                           its, ite, jts, jte, kts, kte)
 680    IMPLICIT NONE
 681
 682    !  Input data.
 683    TYPE( grid_config_rec_type ) config_flags
 684
 685
 686    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
 687                           ims, ime, jms, jme, kms, kme, &
 688                           ips, ipe, jps, jpe, kps, kpe, &
 689                           its, ite, jts, jte, kts, kte
 690    INTEGER, INTENT(IN) :: spec_bdy_width, spec_zone
 691
 692    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: g_scalar_tend
 693    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: scalar_tend
 694
 695    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(IN) :: g_scalar_bxs,g_scalar_bxe, &
 696                                                                     g_scalar_btxs,g_scalar_btxe
 697    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(IN) :: g_scalar_bys,g_scalar_bye, &
 698                                                                     g_scalar_btys,g_scalar_btye
 699
 700    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(IN) :: scalar_bxs,scalar_bxe, &
 701                                                                     scalar_btxs,scalar_btxe
 702    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(IN) :: scalar_bys,scalar_bye, &
 703                                                                     scalar_btys,scalar_btye
 704
 705 !Local
 706    INTEGER :: i,j,k
 707
 708
 709          CALL g_spec_bdytend ( scalar_tend, g_scalar_tend,  &
 710                                scalar_bxs,g_scalar_bxs,scalar_bxe,g_scalar_bxe, &
 711                                scalar_bys,g_scalar_bys,scalar_bye,g_scalar_bye, &
 712                                scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe, &
 713                                scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye, &
 714                                'q'     , config_flags, &
 715                                spec_bdy_width, spec_zone, &
 716                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 717                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 718                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 719                                its,ite, jts,jte, kts,kte )
 720
 721    END SUBROUTINE g_spec_bdy_scalar
 722
 723 !------------------------------------------------------------------------
 724
 725  SUBROUTINE g_set_phys_bc_dry_2(config_flags,u_1,g_u_1,u_2,g_u_2,v_1, &
 726  g_v_1,v_2,g_v_2,w_1,g_w_1,w_2,g_w_2,t_1,g_t_1,t_2,g_t_2,ph_1, &
 727  g_ph_1,ph_2,g_ph_2,mu_1,g_mu_1,mu_2,g_mu_2,ids,ide,jds,jde,kds,kde,ims, &
 728  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 729
 730  IMPLICIT NONE
 731
 732  TYPE(grid_config_rec_type) config_flags
 733  INTEGER :: ids,ide,jds,jde,kds,kde
 734  INTEGER :: ims,ime,jms,jme,kms,kme
 735  INTEGER :: ips,ipe,jps,jpe,kps,kpe
 736  INTEGER :: its,ite,jts,jte,kts,kte
 737  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u_1,g_u_1,u_2,g_u_2,v_1,g_v_1, &
 738  v_2,g_v_2,w_1,g_w_1,w_2,g_w_2,t_1,g_t_1,t_2,g_t_2,ph_1,g_ph_1,ph_2, &
 739  g_ph_2
 740  REAL,DIMENSION(ims:ime,jms:jme) :: mu_1,g_mu_1,mu_2,g_mu_2
 741
 742  CALL g_set_physical_bc3d(u_1,g_u_1,'U',config_flags,ids,ide,jds,jde,kds,kde, &
 743  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 744
 745  CALL g_set_physical_bc3d(u_2,g_u_2,'U',config_flags,ids,ide,jds,jde,kds,kde, &
 746  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 747
 748  CALL g_set_physical_bc3d(v_1,g_v_1,'V',config_flags,ids,ide,jds,jde,kds,kde, &
 749  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 750
 751  CALL g_set_physical_bc3d(v_2,g_v_2,'V',config_flags,ids,ide,jds,jde,kds,kde, &
 752  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 753
 754  CALL g_set_physical_bc3d(w_1,g_w_1,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 755  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 756
 757  CALL g_set_physical_bc3d(w_2,g_w_2,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 758  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 759
 760  CALL g_set_physical_bc3d(t_1,g_t_1,'p',config_flags,ids,ide,jds,jde,kds,kde, &
 761  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 762
 763  CALL g_set_physical_bc3d(t_2,g_t_2,'p',config_flags,ids,ide,jds,jde,kds,kde, &
 764  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 765
 766  CALL g_set_physical_bc3d(ph_1,g_ph_1,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 767  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 768
 769  CALL g_set_physical_bc3d(ph_2,g_ph_2,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 770  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 771
 772  CALL g_set_physical_bc2d(mu_1,g_mu_1,'t',config_flags,ids,ide,jds,jde,ims,ime, &
 773  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 774
 775  CALL g_set_physical_bc2d(mu_2,g_mu_2,'t',config_flags,ids,ide,jds,jde,ims,ime, &
 776  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 777
 778  END SUBROUTINE g_set_phys_bc_dry_2
 779
 780 !------------------------------------------------------------------------
 781
 782  SUBROUTINE g_rk_phys_bc_dry_1(config_flags,u,g_u,v,g_v,rw,g_rw,w,g_w, &
 783  muu,g_muu,muv,g_muv,mut,g_mut,php,g_php,alt,g_alt,p,g_p,ids,ide, &
 784  jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 785
 786  IMPLICIT NONE
 787
 788  INTEGER :: ids,ide,jds,jde,kds,kde
 789  INTEGER :: ims,ime,jms,jme,kms,kme
 790  INTEGER :: ips,ipe,jps,jpe,kps,kpe
 791  INTEGER :: its,ite,jts,jte,kts,kte
 792  TYPE(grid_config_rec_type) config_flags
 793  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,g_u,v,g_v,rw,g_rw,w,g_w,php, &
 794  g_php,alt,g_alt,p,g_p
 795  REAL,DIMENSION(ims:ime,jms:jme) :: muu,g_muu,muv,g_muv,mut,g_mut
 796
 797  CALL g_set_physical_bc3d(u,g_u,'u',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 798  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 799
 800  CALL g_set_physical_bc3d(v,g_v,'v',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 801  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 802
 803  CALL g_set_physical_bc3d(rw,g_rw,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 804  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 805
 806  CALL g_set_physical_bc3d(w,g_w,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 807  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 808
 809  CALL g_set_physical_bc3d(php,g_php,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 810  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 811
 812  CALL g_set_physical_bc3d(alt,g_alt,'t',config_flags,ids,ide,jds,jde,kds,kde, &
 813  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 814
 815  CALL g_set_physical_bc3d(p,g_p,'p',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 816  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 817
 818  CALL g_set_physical_bc2d(muu,g_muu,'u',config_flags,ids,ide,jds,jde,ims,ime, &
 819  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 820
 821  CALL g_set_physical_bc2d(muv,g_muv,'v',config_flags,ids,ide,jds,jde,ims,ime, &
 822  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 823
 824  CALL g_set_physical_bc2d(mut,g_mut,'t',config_flags,ids,ide,jds,jde,ims,ime, &
 825  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 826
 827  END SUBROUTINE g_rk_phys_bc_dry_1
 828
 829 !------------------------------------------------------------------------
 830
 831  SUBROUTINE g_rk_phys_bc_dry_2(config_flags,u,g_u,v,g_v,w,g_w,t,g_t,ph, &
 832  g_ph,mu,g_mu,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe, &
 833  kps,kpe,its,ite,jts,jte,kts,kte)
 834
 835  IMPLICIT NONE
 836
 837  INTEGER :: ids,ide,jds,jde,kds,kde
 838  INTEGER :: ims,ime,jms,jme,kms,kme
 839  INTEGER :: ips,ipe,jps,jpe,kps,kpe
 840  INTEGER :: its,ite,jts,jte,kts,kte
 841  TYPE(grid_config_rec_type) config_flags
 842  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,g_u,v,g_v,w,g_w,t,g_t,ph,g_ph
 843  REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 844
 845  CALL g_set_physical_bc3d(u,g_u,'U',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 846  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 847
 848  CALL g_set_physical_bc3d(v,g_v,'V',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 849  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 850
 851  CALL g_set_physical_bc3d(w,g_w,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 852  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 853
 854  CALL g_set_physical_bc3d(t,g_t,'p',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 855  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 856
 857  CALL g_set_physical_bc3d(ph,g_ph,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 858  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 859
 860  CALL g_set_physical_bc2d(mu,g_mu,'t',config_flags,ids,ide,jds,jde,ims,ime,jms, &
 861  jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 862
 863  END SUBROUTINE g_rk_phys_bc_dry_2
 864
 865 !---------------------------------------------------------------------
 866
 867    SUBROUTINE g_zero_bdytend  (                                &
 868                               u_btxs,g_u_btxs,u_btxe,g_u_btxe, &
 869                               u_btys,g_u_btys,u_btye,g_u_btye, &
 870                               v_btxs,g_v_btxs,v_btxe,g_v_btxe, &
 871                               v_btys,g_v_btys,v_btye,g_v_btye, &
 872                               ph_btxs,g_ph_btxs,ph_btxe,g_ph_btxe, &
 873                               ph_btys,g_ph_btys,ph_btye,g_ph_btye, &
 874                               t_btxs,g_t_btxs,t_btxe,g_t_btxe, &
 875                               t_btys,g_t_btys,t_btye,g_t_btye, &
 876                               w_btxs,g_w_btxs,w_btxe,g_w_btxe, &
 877                               w_btys,g_w_btys,w_btye,g_w_btye, &
 878                               mu_btxs,g_mu_btxs,mu_btxe,g_mu_btxe, &
 879                               mu_btys,g_mu_btys,mu_btye,g_mu_btye, &
 880                               moist_btxs,g_moist_btxs,moist_btxe,g_moist_btxe, &
 881                               moist_btys,g_moist_btys,moist_btye,g_moist_btye, &
 882                               scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe, &
 883                               scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye, &
 884                               spec_bdy_width,n_moist,n_scalar,                 &
 885                               ids,ide, jds,jde, kds,kde,  & ! domain dims
 886                               ims,ime, jms,jme, kms,kme,  & ! memory dims
 887                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 888                               its,ite, jts,jte, kts,kte   )
 889    IMPLICIT NONE
 890
 891    !  Input data.
 892
 893    INTEGER ,               INTENT(IN   ) :: spec_bdy_width, n_moist, n_scalar
 894
 895    INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
 896                                             ims, ime, jms, jme, kms, kme, &
 897                                             ips, ipe, jps, jpe, kps, kpe, &
 898                                             its, ite, jts, jte, kts, kte
 899
 900    REAL,DIMENSION(jms:jme,kds:kde,spec_bdy_width),INTENT(INOUT) :: u_btxs,g_u_btxs,u_btxe,g_u_btxe, &
 901                                                                    v_btxs,g_v_btxs,v_btxe,g_v_btxe, &
 902                                                                    ph_btxs,g_ph_btxs,ph_btxe,g_ph_btxe, &
 903                                                                    w_btxs,g_w_btxs,w_btxe,g_w_btxe, &
 904                                                                    t_btxs,g_t_btxs,t_btxe,g_t_btxe
 905
 906    REAL,DIMENSION(ims:ime,kds:kde,spec_bdy_width),INTENT(INOUT) :: u_btys,g_u_btys,u_btye,g_u_btye, &
 907                                                                    v_btys,g_v_btys,v_btye,g_v_btye, &
 908                                                                    ph_btys,g_ph_btys,ph_btye,g_ph_btye, &
 909                                                                    w_btys,g_w_btys,w_btye,g_w_btye, &
 910                                                                    t_btys,g_t_btys,t_btye,g_t_btye
 911
 912    REAL,DIMENSION(jms:jme,1:1    ,spec_bdy_width), INTENT(INOUT) :: mu_btxs,g_mu_btxs,mu_btxe,g_mu_btxe
 913    REAL,DIMENSION(ims:ime,1:1    ,spec_bdy_width), INTENT(INOUT) :: mu_btys,g_mu_btys,mu_btye,g_mu_btye
 914
 915    REAL,DIMENSION(jms:jme,kds:kde,spec_bdy_width,n_moist),INTENT(INOUT) ::  &
 916                               moist_btxs,g_moist_btxs,moist_btxe,g_moist_btxe
 917    REAL,DIMENSION(ims:ime,kds:kde,spec_bdy_width,n_moist),INTENT(INOUT) ::  &
 918                               moist_btys,g_moist_btys,moist_btye,g_moist_btye
 919    REAL,DIMENSION(jms:jme,kds:kde,spec_bdy_width,n_scalar),INTENT(INOUT) ::  &
 920                               scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe
 921    REAL,DIMENSION(ims:ime,kds:kde,spec_bdy_width,n_scalar),INTENT(INOUT) ::  &
 922                               scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye
 923
 924 ! setting tl of bdy tendencies to zero during DFI
 925
 926        CALL wrf_debug( 10, 'In g_zero_bdytend, setting tl of bdy tendencies to 0 during DFI' )
 927        g_u_btxs = 0.
 928        g_u_btxe = 0.
 929        g_u_btys = 0.
 930        g_u_btye = 0.
 931        g_v_btxs = 0.
 932        g_v_btxe = 0.
 933        g_v_btys = 0.
 934        g_v_btye = 0.
 935        g_t_btxs = 0.
 936        g_t_btxe = 0.
 937        g_t_btys = 0.
 938        g_t_btye = 0.
 939        g_ph_btxs = 0.
 940        g_ph_btxe = 0.
 941        g_ph_btys = 0.
 942        g_ph_btye = 0.
 943        g_mu_btxs = 0.
 944        g_mu_btxe = 0.
 945        g_mu_btys = 0.
 946        g_mu_btye = 0.
 947        g_moist_btxs = 0.
 948        g_moist_btxe = 0.
 949        g_moist_btys = 0.
 950        g_moist_btye = 0.
 951        g_scalar_btxs = 0.
 952        g_scalar_btxe = 0.
 953        g_scalar_btys = 0.
 954        g_scalar_btye = 0.
 955
 956        u_btxs = 0.
 957        u_btxe = 0.
 958        u_btys = 0.
 959        u_btye = 0.
 960        v_btxs = 0.
 961        v_btxe = 0.
 962        v_btys = 0.
 963        v_btye = 0.
 964        t_btxs = 0.
 965        t_btxe = 0.
 966        t_btys = 0.
 967        t_btye = 0.
 968        ph_btxs = 0.
 969        ph_btxe = 0.
 970        ph_btys = 0.
 971        ph_btye = 0.
 972        mu_btxs = 0.
 973        mu_btxe = 0.
 974        mu_btys = 0.
 975        mu_btye = 0.
 976        moist_btxs = 0.
 977        moist_btxe = 0.
 978        moist_btys = 0.
 979        moist_btye = 0.
 980        scalar_btxs = 0.
 981        scalar_btxe = 0.
 982        scalar_btys = 0.
 983        scalar_btye = 0.
 984
 985 !  ENDIF
 986
 987    END SUBROUTINE g_zero_bdytend
 988
 989 !---------------------------------------------------------------------
 990
 991 ! Revised by Ning Pan, 2010-08-03
 992 ! SUBROUTINE g_set_w_surface(config_flags,znw,fill_w_flag,w,g_w,ht,g_ht,u, &
 993  SUBROUTINE g_set_w_surface(config_flags,znw,fill_w_flag,w,g_w,ht,u, &
 994  g_u,v,g_v,cf1,cf2,cf3,rdx,rdy,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
 995  jme,kms,kme,its,ite,jts,jte,kts,kte)
 996
 997  IMPLICIT NONE
 998
 999  REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
1000  g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8,Tmpv9,g_Tmpv9, &
1001  Tmpv10,g_Tmpv10,Tmpv11,g_Tmpv11,Tmpv12,g_Tmpv12,Tmpv13,g_Tmpv13,Tmpv14, &
1002  g_Tmpv14,Tmpv15,g_Tmpv15,Tmpv16,g_Tmpv16,Tmpv17,g_Tmpv17,Tmpv18, &
1003  g_Tmpv18,Tmpv19,g_Tmpv19,Tmpv20,g_Tmpv20
1004  TYPE(grid_config_rec_type) config_flags
1005  INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
1006  REAL :: rdx,rdy,cf1,cf2,cf3
1007  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,g_u,v,g_v
1008  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: w,g_w
1009 ! Revised by Ning Pan, 2010-08-03
1010 ! REAL,DIMENSION(ims:ime,jms:jme) :: ht,g_ht,msftx,msfty
1011  REAL,DIMENSION(ims:ime,jms:jme) :: ht,msftx,msfty
1012  REAL,DIMENSION(kms:kme) :: znw
1013  LOGICAL :: fill_w_flag
1014  INTEGER :: i,j,k
1015  INTEGER :: ip1,im1,jp1,jm1
1016  INTEGER :: ip1_limit,im1_limit,jp1_limit,jm1_limit
1017
1018  jm1_limit =jds
1019
1020  jp1_limit =jde-1
1021
1022  im1_limit =ids
1023
1024  ip1_limit =ide-1
1025
1026  IF( config_flags%periodic_x ) THEN
1027
1028  im1_limit =ids-1
1029
1030  ip1_limit =ide
1031  ENDIF
1032
1033  IF( config_flags%periodic_y ) THEN
1034
1035  jm1_limit =jds-1
1036
1037  jp1_limit =jde
1038  ENDIF
1039
1040  DO j =jts,min(jte,jde-1)
1041
1042  jm1 =max(j-1,jm1_limit)
1043
1044  jp1 =min(j+1,jp1_limit)
1045
1046  DO i =its,min(ite,ide-1)
1047
1048  im1 =max(i-1,im1_limit)
1049
1050  ip1 =min(i+1,ip1_limit)
1051
1052 ! Revised by Ning Pan, 2010-08-03
1053 ! g_Tmpv1 =(ht(i,jp1) -ht(i,j))*(cf1*g_v(i,1,j+1) +cf2*g_v(i,2,j+1) &
1054 ! +cf3*g_v(i,3,j+1)) +(g_ht(i,jp1) -g_ht(i,j))*(cf1*v(i,1,j+1) +cf2*v(i,2,j+ &
1055 ! 1) +cf3*v(i,3,j+1))
1056  g_Tmpv1 =(ht(i,jp1) -ht(i,j))*(cf1*g_v(i,1,j+1) +cf2*g_v(i,2,j+1) &
1057  +cf3*g_v(i,3,j+1))
1058  Tmpv1 =(ht(i,jp1) -ht(i,j))*(cf1*v(i,1,j+1) +cf2*v(i,2,j+1) +cf3*v(i,3,j+1))
1059
1060 ! Revised by Ning Pan, 2010-08-03
1061 ! g_Tmpv2 =(ht(i,j) -ht(i,jm1))*(cf1*g_v(i,1,j) +cf2*g_v(i,2,j) &
1062 ! +cf3*g_v(i,3,j)) +(g_ht(i,j) -g_ht(i,jm1))*(cf1*v(i,1,j) +cf2*v(i,2,j) &
1063 ! +cf3*v(i,3,j))
1064  g_Tmpv2 =(ht(i,j) -ht(i,jm1))*(cf1*g_v(i,1,j) +cf2*g_v(i,2,j) &
1065  +cf3*g_v(i,3,j))
1066  Tmpv2 =(ht(i,j) -ht(i,jm1))*(cf1*v(i,1,j) +cf2*v(i,2,j) +cf3*v(i,3,j))
1067
1068 ! Revised by Ning Pan, 2010-08-03
1069 ! g_Tmpv3 =(ht(ip1,j) -ht(i,j))*(cf1*g_u(i+1,1,j) +cf2*g_u(i+1,2,j) &
1070 ! +cf3*g_u(i+1,3,j)) +(g_ht(ip1,j) -g_ht(i,j))*(cf1*u(i+1,1,j) +cf2*u(i+1,2, &
1071 ! j) +cf3*u(i+1,3,j))
1072  g_Tmpv3 =(ht(ip1,j) -ht(i,j))*(cf1*g_u(i+1,1,j) +cf2*g_u(i+1,2,j) &
1073  +cf3*g_u(i+1,3,j))
1074  Tmpv3 =(ht(ip1,j) -ht(i,j))*(cf1*u(i+1,1,j) +cf2*u(i+1,2,j) +cf3*u(i+1,3,j))
1075
1076 ! Revised by Ning Pan, 2010-08-03
1077 ! g_Tmpv4 =(ht(i,j) -ht(im1,j))*(cf1*g_u(i,1,j) +cf2*g_u(i,2,j) &
1078 ! +cf3*g_u(i,3,j)) +(g_ht(i,j) -g_ht(im1,j))*(cf1*u(i,1,j) +cf2*u(i,2,j) &
1079 ! +cf3*u(i,3,j))
1080  g_Tmpv4 =(ht(i,j) -ht(im1,j))*(cf1*g_u(i,1,j) +cf2*g_u(i,2,j) &
1081  +cf3*g_u(i,3,j))
1082  Tmpv4 =(ht(i,j) -ht(im1,j))*(cf1*u(i,1,j) +cf2*u(i,2,j) +cf3*u(i,3,j))
1083
1084  g_w(i,1,j) =msfty(i,j) *.5 *rdy*(g_Tmpv1 +g_Tmpv2) +msftx(i,j) &
1085  *.5 *rdx*(g_Tmpv3 +g_Tmpv4)
1086  w(i,1,j) =msfty(i,j) *.5 *rdy*(Tmpv1 +Tmpv2) +msftx(i,j) *.5 *rdx*(Tmpv3 +Tmpv4)
1087
1088  ENDDO
1089  ENDDO
1090
1091  IF(fill_w_flag) THEN
1092
1093  DO j =jts,min(jte,jde-1)
1094  DO k =kts+1,kte
1095  DO i =its,min(ite,ide-1)
1096
1097  g_w(i,k,j) =g_w(i,1,j)*znw(k)*znw(k)
1098  w(i,k,j) =w(i,1,j)*znw(k)*znw(k)
1099
1100  ENDDO
1101  ENDDO
1102  ENDDO
1103  ENDIF
1104
1105  END SUBROUTINE g_set_w_surface
1106
1107 END MODULE g_module_bc_em