wrftladj/module_bc_em_ad.F

   1 !WRF+/AD:MODEL_LAYER:BOUNDARY
   2 !
   3 MODULE a_module_bc_em
   4
   5    USE module_bc
   6    USE module_configure
   7    USE module_wrf_error
   8    USE a_module_bc
   9
  10 CONTAINS
  11
  12 !------------------------------------------------------------------------
  13
  14    SUBROUTINE a_spec_bdyupdate_ph( ph_save, a_ph_save, field, a_field,     &
  15                                field_tend, a_field_tend, mu_tend, a_mu_tend, muts, a_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) :: a_field
  39       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field
  40       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: a_field_tend, a_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(INOUT) :: a_mu_tend, a_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 ) :: a_mu_old
  53       REAL,  DIMENSION( its:ite , jts:jte ) :: mu_old
  54       LOGICAL    :: periodic_x
  55
  56
  57       a_mu_old = 0.
  58       periodic_x = config_flags%periodic_x
  59
  60       variable = variable_in
  61
  62       IF (variable == 'U') variable = 'u'
  63       IF (variable == 'V') variable = 'v'
  64       IF (variable == 'M') variable = 'm'
  65       IF (variable == 'H') variable = 'h'
  66
  67       ibs = ids
  68       ibe = ide-1
  69       itf = min(ite,ide-1)
  70       jbs = jds
  71       jbe = jde-1
  72       jtf = min(jte,jde-1)
  73       ktf = kde-1
  74       IF (variable == 'u') ibe = ide
  75       IF (variable == 'u') itf = min(ite,ide)
  76       IF (variable == 'v') jbe = jde
  77       IF (variable == 'v') jtf = min(jte,jde)
  78       IF (variable == 'm') ktf = kte
  79       IF (variable == 'h') ktf = kte
  80
  81     IF(.NOT.periodic_x)THEN
  82
  83       IF (ibe - itf .lt. spec_zone) THEN
  84 ! X-end boundary
  85         DO i = max(its,ibe-spec_zone+1), itf
  86           b_dist = ibe - i
  87           DO k = kts, ktf
  88             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
  89               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
  90
  91               a_ph_save(i,k,j) = a_ph_save(i,k,j) &
  92                                + (mu_old(i,j)/muts(i,j)-1) * a_field(i,k,j)
  93
  94               a_mu_old(i,j) = a_mu_old(i,j) &
  95                             + (field(i,k,j)+ph_save(i,k,j))/muts(i,j) * a_field(i,k,j)
  96               a_muts(i,j) = a_muts(i,j) &
  97                           - dt*field_tend(i,k,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j) &
  98                           - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j)
  99               a_field_tend(i,k,j) = a_field_tend(i,k,j) &
 100                                   + dt/muts(i,j) * a_field(i,k,j)
 101               a_field(i,k,j) = mu_old(i,j)/muts(i,j) * a_field(i,k,j)
 102
 103               a_muts(i,j) = a_muts(i,j) + a_mu_old(i,j)
 104               a_mu_tend(i,j) = a_mu_tend(i,j) - dt * a_mu_old(i,j)
 105               a_mu_old(i,j) = 0.
 106             ENDDO
 107           ENDDO
 108         ENDDO
 109       ENDIF
 110
 111       IF (its - ibs .lt. spec_zone) THEN
 112 ! X-start boundary
 113         DO i = its, min(itf,ibs+spec_zone-1)
 114           b_dist = i - ibs
 115           DO k = kts, ktf
 116             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
 117               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
 118
 119               a_ph_save(i,k,j) = a_ph_save(i,k,j) &
 120                                + (mu_old(i,j)/muts(i,j)-1) * a_field(i,k,j)
 121
 122               a_mu_old(i,j) = a_mu_old(i,j) &
 123                             + (field(i,k,j)+ph_save(i,k,j))/muts(i,j) * a_field(i,k,j)
 124               a_muts(i,j) = a_muts(i,j) &
 125                           - dt*field_tend(i,k,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j) &
 126                           - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j)
 127               a_field_tend(i,k,j) = a_field_tend(i,k,j) &
 128                                   + dt/muts(i,j) * a_field(i,k,j)
 129               a_field(i,k,j) = mu_old(i,j)/muts(i,j) * a_field(i,k,j)
 130
 131               a_muts(i,j) = a_muts(i,j) + a_mu_old(i,j)
 132               a_mu_tend(i,j) = a_mu_tend(i,j) - dt * a_mu_old(i,j)
 133               a_mu_old(i,j) = 0.
 134             ENDDO
 135           ENDDO
 136         ENDDO
 137       ENDIF
 138
 139     ENDIF
 140
 141       IF (jbe - jtf .lt. spec_zone) THEN
 142 ! Y-end boundary
 143         DO j = max(jts,jbe-spec_zone+1), jtf
 144           b_dist = jbe - j
 145           b_limit = b_dist
 146           IF(periodic_x)b_limit = 0
 147           DO k = kts, ktf
 148             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
 149               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
 150
 151               a_ph_save(i,k,j) = a_ph_save(i,k,j) &
 152                                + (mu_old(i,j)/muts(i,j)-1) * a_field(i,k,j)
 153
 154               a_mu_old(i,j) = a_mu_old(i,j) &
 155                             + (field(i,k,j)+ph_save(i,k,j))/muts(i,j) * a_field(i,k,j)
 156               a_muts(i,j) = a_muts(i,j) &
 157                           - dt*field_tend(i,k,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j) &
 158                           - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j)
 159               a_field_tend(i,k,j) = a_field_tend(i,k,j) &
 160                                   + dt/muts(i,j) * a_field(i,k,j)
 161               a_field(i,k,j) = mu_old(i,j)/muts(i,j) * a_field(i,k,j)
 162
 163               a_muts(i,j) = a_muts(i,j) + a_mu_old(i,j)
 164               a_mu_tend(i,j) = a_mu_tend(i,j) - dt * a_mu_old(i,j)
 165               a_mu_old(i,j) = 0.
 166             ENDDO
 167           ENDDO
 168         ENDDO
 169       ENDIF
 170
 171       IF (jts - jbs .lt. spec_zone) THEN
 172 ! Y-start boundary
 173         DO j = jts, min(jtf,jbs+spec_zone-1)
 174           b_dist = j - jbs
 175           b_limit = b_dist
 176           IF(periodic_x)b_limit = 0
 177           DO k = kts, ktf
 178             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
 179               mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
 180
 181               a_ph_save(i,k,j) = a_ph_save(i,k,j) &
 182                                + (mu_old(i,j)/muts(i,j)-1) * a_field(i,k,j)
 183
 184               a_mu_old(i,j) = a_mu_old(i,j) &
 185                             + (field(i,k,j)+ph_save(i,k,j))/muts(i,j) * a_field(i,k,j)
 186               a_muts(i,j) = a_muts(i,j) &
 187                           - dt*field_tend(i,k,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j) &
 188                           - (field(i,k,j)+ph_save(i,k,j))*mu_old(i,j)/(muts(i,j)*muts(i,j)) * a_field(i,k,j)
 189               a_field_tend(i,k,j) = a_field_tend(i,k,j) &
 190                                   + dt/muts(i,j) * a_field(i,k,j)
 191               a_field(i,k,j) = mu_old(i,j)/muts(i,j) * a_field(i,k,j)
 192
 193               a_muts(i,j) = a_muts(i,j) + a_mu_old(i,j)
 194               a_mu_tend(i,j) = a_mu_tend(i,j) - dt * a_mu_old(i,j)
 195               a_mu_old(i,j) = 0.
 196             ENDDO
 197           ENDDO
 198         ENDDO
 199       ENDIF
 200
 201    END SUBROUTINE a_spec_bdyupdate_ph
 202
 203 !------------------------------------------------------------------------
 204
 205    SUBROUTINE a_relax_bdy_dry ( config_flags,                 &
 206                                 a_ru_tendf, a_rv_tendf,       &
 207                                 a_ph_tendf, a_t_tendf,        &
 208                                 a_rw_tendf, a_mu_tend,        &
 209                                 a_ru, a_rv, ph, a_ph, t, a_t, &
 210                                 w, a_w, a_mu, mut, a_mut,     &
 211                                 a_u_bxs, a_u_bxe, a_u_bys, a_u_bye,      &
 212                                 a_v_bxs, a_v_bxe, a_v_bys, a_v_bye,      &
 213                                 a_ph_bxs, a_ph_bxe, a_ph_bys, a_ph_bye,  &
 214                                 a_t_bxs, a_t_bxe, a_t_bys, a_t_bye,      &
 215                                 a_w_bxs, a_w_bxe, a_w_bys, a_w_bye,      &
 216                                 a_mu_bxs, a_mu_bxe, a_mu_bys, a_mu_bye,  &
 217                                 a_u_btxs, a_u_btxe, a_u_btys, a_u_btye,  &
 218                                 a_v_btxs, a_v_btxe, a_v_btys, a_v_btye,  &
 219                                 a_ph_btxs, a_ph_btxe, a_ph_btys, a_ph_btye,  &
 220                                 a_t_btxs, a_t_btxe, a_t_btys, a_t_btye,  &
 221                                 a_w_btxs, a_w_btxe, a_w_btys, a_w_btye,  &
 222                                 a_mu_btxs, a_mu_btxe, a_mu_btys, a_mu_btye,  &
 223                                 spec_bdy_width, spec_zone, relax_zone,       &
 224                                 dtbc, fcx, gcx,             &
 225                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
 226                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
 227                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 228                                 its, ite, jts, jte, kts, kte )
 229    IMPLICIT NONE
 230
 231    !  Input data.
 232    TYPE(grid_config_rec_type),INTENT(IN) :: config_flags
 233    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
 234                           ims, ime, jms, jme, kms, kme, &
 235                           ips, ipe, jps, jpe, kps, kpe, &
 236                           its, ite, jts, jte, kts, kte
 237    INTEGER, INTENT(IN) :: spec_bdy_width, spec_zone, relax_zone
 238
 239    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: a_ru,     &
 240                                                                 a_rv,     &
 241                                                                 a_ph,     &
 242                                                                 a_w,      &
 243                                                                 a_t
 244    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN   ) :: ph,     &
 245                                                                 w,      &
 246                                                                 t
 247    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: a_mu, &
 248                                                        a_mut
 249    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN   ) :: mut
 250
 251    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: a_ru_tendf, &
 252                                                              a_rv_tendf, &
 253                                                              a_ph_tendf, &
 254                                                              a_rw_tendf, &
 255                                                              a_t_tendf
 256    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(IN) :: a_mu_tend
 257    REAL, DIMENSION(spec_bdy_width), INTENT(IN) :: fcx, gcx
 258
 259    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(INOUT) :: a_u_bxs,a_u_bxe, &
 260                                                                        a_v_bxs,a_v_bxe, &
 261                                                                        a_ph_bxs,a_ph_bxe, &
 262                                                                        a_w_bxs,a_w_bxe, &
 263                                                                        a_t_bxs,a_t_bxe, &
 264                                                                        a_u_btxs,a_u_btxe, &
 265                                                                        a_v_btxs,a_v_btxe, &
 266                                                                        a_ph_btxs,a_ph_btxe, &
 267                                                                        a_w_btxs,a_w_btxe, &
 268                                                                        a_t_btxs,a_t_btxe
 269
 270    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(INOUT) :: a_u_bys,a_u_bye, &
 271                                                                        a_v_bys,a_v_bye, &
 272                                                                        a_ph_bys,a_ph_bye, &
 273                                                                        a_w_bys,a_w_bye, &
 274                                                                        a_t_bys,a_t_bye, &
 275                                                                        a_u_btys,a_u_btye, &
 276                                                                        a_v_btys,a_v_btye, &
 277                                                                        a_ph_btys,a_ph_btye, &
 278                                                                        a_w_btys,a_w_btye, &
 279                                                                        a_t_btys,a_t_btye
 280
 281    REAL, DIMENSION(jms:jme, 1:1, spec_bdy_width), INTENT(INOUT) :: a_mu_bxs,a_mu_bxe, &
 282                                                                    a_mu_btxs,a_mu_btxe
 283
 284    REAL, DIMENSION(ims:ime, 1:1, spec_bdy_width), INTENT(INOUT) :: a_mu_bys,a_mu_bye, &
 285                                                                    a_mu_btys,a_mu_btye
 286    REAL, INTENT(IN) :: dtbc
 287
 288    REAL , DIMENSION( its-1:ite+1 , kts:kte, jts-1:jte+1  ) :: a_rfield
 289    INTEGER :: i_start, i_end, j_start, j_end, i, j, k
 290
 291
 292    a_rfield = 0.
 293
 294    IF( config_flags%nested) THEN
 295      CALL a_relax_bdytend_tile ( a_rfield, a_rw_tendf, &
 296                          a_w_bxs,a_w_bxe,a_w_bys,a_w_bye,     &
 297                          a_w_btxs,a_w_btxe,a_w_btys,a_w_btye, &
 298                          'h'        , config_flags, &
 299                          spec_bdy_width, spec_zone, relax_zone, &
 300                          dtbc, fcx, gcx,             &
 301                          ids,ide, jds,jde, kds,kde,  & ! domain dims
 302                          ims,ime, jms,jme, kms,kme,  & ! memory dims
 303                          ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 304                          its,ite, jts,jte, kts,kte,  &
 305                          its-1, ite+1, jts-1,jte+1,kts,kte )  ! dims of first argument
 306
 307      i_start = max(its-1, ids)
 308      i_end = min(ite+1, ide-1)
 309      j_start = max(jts-1, jds)
 310      j_end = min(jte+1, jde-1)
 311
 312      DO j=j_start,j_end
 313      DO k=kts,kte
 314      DO i=i_start,i_end
 315         a_w(i,k,j) = a_w(i,k,j) + mut(i,j) * a_rfield(i,k,j)
 316         a_mut(i,j) = a_mut(i,j) + w(i,k,j) * a_rfield(i,k,j)
 317         a_rfield(i,k,j) = 0.
 318      ENDDO
 319      ENDDO
 320      ENDDO
 321    END IF
 322
 323    CALL a_relax_bdytend ( a_mu, a_mu_tend,  &
 324                           a_mu_bxs,a_mu_bxe,a_mu_bys,a_mu_bye,     &
 325                           a_mu_btxs,a_mu_btxe,a_mu_btys,a_mu_btye, &
 326                           'm'        , config_flags,  &
 327                           spec_bdy_width, spec_zone, relax_zone, &
 328                           dtbc, fcx, gcx,             &
 329                           ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
 330                           ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
 331                           ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
 332                           its,ite, jts,jte, 1  ,1   )
 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    CALL a_relax_bdytend_tile ( a_rfield, a_t_tendf,  &
 340                        a_t_bxs,a_t_bxe,a_t_bys,a_t_bye,     &
 341                        a_t_btxs,a_t_btxe,a_t_btys,a_t_btye, &
 342                        't'        , config_flags,  &
 343                        spec_bdy_width, spec_zone, relax_zone, &
 344                        dtbc, fcx, gcx,             &
 345                        ids,ide, jds,jde, kds,kde,  & ! domain dims
 346                        ims,ime, jms,jme, kms,kme,  & ! memory dims
 347                        ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 348                        its,ite, jts,jte, kts,kte,  &
 349                        its-1, ite+1, jts-1,jte+1,kts,kte )  ! dims of first argument
 350    DO j=j_start,j_end
 351    DO k=kts,kte-1
 352    DO i=i_start,i_end
 353       a_t(i,k,j) = a_t(i,k,j) + mut(i,j) * a_rfield(i,k,j)
 354       a_mut(i,j) = a_mut(i,j) + t(i,k,j) * a_rfield(i,k,j)
 355       a_rfield(i,k,j) = 0.
 356    ENDDO
 357    ENDDO
 358    ENDDO
 359
 360    CALL a_relax_bdytend_tile ( a_rfield, a_ph_tendf,  &
 361                        a_ph_bxs,a_ph_bxe,a_ph_bys,a_ph_bye,     &
 362                        a_ph_btxs,a_ph_btxe,a_ph_btys,a_ph_btye, &
 363                        'h'        , config_flags,  &
 364                        spec_bdy_width, spec_zone, relax_zone, &
 365                        dtbc, fcx, gcx,             &
 366                        ids,ide, jds,jde, kds,kde,  & ! domain dims
 367                        ims,ime, jms,jme, kms,kme,  & ! memory dims
 368                        ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 369                        its,ite, jts,jte, kts,kte,  &
 370                        its-1, ite+1, jts-1,jte+1,kts,kte )  ! dims of first argument
 371    DO j=j_start,j_end
 372    DO k=kts,kte
 373    DO i=i_start,i_end
 374       a_ph(i,k,j) = a_ph(i,k,j) + mut(i,j) * a_rfield(i,k,j)
 375       a_mut(i,j) = a_mut(i,j) + ph(i,k,j) * a_rfield(i,k,j)
 376       a_rfield(i,k,j) = 0.
 377    ENDDO
 378    ENDDO
 379    ENDDO
 380
 381    CALL a_relax_bdytend ( a_rv, a_rv_tendf,  &
 382                           a_v_bxs,a_v_bxe,a_v_bys,a_v_bye,     &
 383                           a_v_btxs,a_v_btxe,a_v_btys,a_v_btye, &
 384                           'v'        , config_flags,  &
 385                           spec_bdy_width, spec_zone, relax_zone, &
 386                           dtbc, fcx, gcx,             &
 387                           ids,ide, jds,jde, kds,kde,  & ! domain dims
 388                           ims,ime, jms,jme, kms,kme,  & ! memory dims
 389                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 390                           its,ite, jts,jte, kts,kte )
 391
 392    CALL a_relax_bdytend ( a_ru, a_ru_tendf,  &
 393                           a_u_bxs,a_u_bxe,a_u_bys,a_u_bye,     &
 394                           a_u_btxs,a_u_btxe,a_u_btys,a_u_btye, &
 395                           'u'        , config_flags,  &
 396                           spec_bdy_width, spec_zone, relax_zone, &
 397                           dtbc, fcx, gcx,             &
 398                           ids,ide, jds,jde, kds,kde,  & ! domain dims
 399                           ims,ime, jms,jme, kms,kme,  & ! memory dims
 400                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 401                           its,ite, jts,jte, kts,kte )
 402
 403    END SUBROUTINE a_relax_bdy_dry
 404
 405 !------------------------------------------------------------------------
 406
 407    SUBROUTINE a_relax_bdy_scalar ( a_scalar_tend,              &
 408                                    scalar, a_scalar, mu, a_mu, &
 409                                    a_scalar_bxs,a_scalar_bxe,a_scalar_bys,a_scalar_bye,     &
 410                                    a_scalar_btxs,a_scalar_btxe,a_scalar_btys,a_scalar_btye, &
 411                                    spec_bdy_width, spec_zone, relax_zone,                   &
 412                                    dtbc, fcx, gcx,             &
 413                                    config_flags,               &
 414                                    ids,ide, jds,jde, kds,kde,  & ! domain dims
 415                                    ims,ime, jms,jme, kms,kme,  & ! memory dims
 416                                    ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 417                                    its, ite, jts, jte, kts, kte )
 418
 419    IMPLICIT NONE
 420
 421    !  Input data.
 422    TYPE( grid_config_rec_type ) config_flags
 423
 424    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
 425                           ims, ime, jms, jme, kms, kme, &
 426                           ips, ipe, jps, jpe, kps, kpe, &
 427                           its, ite, jts, jte, kts, kte
 428    INTEGER, INTENT(IN) :: spec_bdy_width, spec_zone, relax_zone
 429
 430    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: a_scalar
 431    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(INOUT) :: a_mu
 432    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: scalar
 433    REAL, DIMENSION(ims:ime, jms:jme),          INTENT(IN) :: mu
 434    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: a_scalar_tend
 435    REAL, DIMENSION(spec_bdy_width), INTENT(IN) :: fcx, gcx
 436
 437    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(INOUT) :: a_scalar_bxs,a_scalar_bxe, &
 438                                                                        a_scalar_btxs,a_scalar_btxe
 439    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(INOUT) :: a_scalar_bys,a_scalar_bye, &
 440                                                                        a_scalar_btys,a_scalar_btye
 441    REAL, INTENT(IN) :: dtbc
 442 !Local
 443    INTEGER :: i,j,k, i_start, i_end, j_start, j_end
 444    REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: a_rscalar
 445
 446
 447 !  Initilize local adjoint variable
 448    a_rscalar = 0.0
 449
 450    CALL a_relax_bdytend (a_rscalar, a_scalar_tend,             &
 451                        a_scalar_bxs,a_scalar_bxe,a_scalar_bys,a_scalar_bye,      &
 452                        a_scalar_btxs,a_scalar_btxe,a_scalar_btys,a_scalar_btye,  &
 453                        'q'        , config_flags,  &
 454                        spec_bdy_width, spec_zone, relax_zone, &
 455                        dtbc, fcx, gcx,             &
 456                        ids,ide, jds,jde, kds,kde,  & ! domain dims
 457                        ims,ime, jms,jme, kms,kme,  & ! memory dims
 458                        ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 459                        its,ite, jts,jte, kts,kte )
 460
 461 ! rscalar will be calculated beyond tile limits because relax_bdytend
 462 !   requires a 5-point stencil, and this avoids need for inter-tile/patch
 463 !   communication here
 464    i_start = max(its-1, ids)
 465    i_end = min(ite+1, ide-1)
 466    j_start = max(jts-1, jds)
 467    j_end = min(jte+1, jde-1)
 468
 469    DO j=j_start,j_end
 470    DO k=kts,min(kte,kde-1)
 471    DO i=i_start,i_end
 472       a_scalar(i,k,j) = a_scalar(i,k,j) + mu(i,j) * a_rscalar(i,k,j)
 473       a_mu(i,j) = a_mu(i,j) + scalar(i,k,j) * a_rscalar(i,k,j)
 474       a_rscalar(i,k,j) = 0.0
 475    ENDDO
 476    ENDDO
 477    ENDDO
 478
 479    END SUBROUTINE a_relax_bdy_scalar
 480
 481 !------------------------------------------------------------------------
 482
 483    SUBROUTINE a_spec_bdy_dry ( config_flags,       &
 484                              a_ru_tend, a_rv_tend, &
 485                              a_ph_tend, a_t_tend,  &
 486                              a_rw_tend, a_mu_tend, &
 487                              a_u_btxs,a_u_btxe,a_u_btys,a_u_btye, &
 488                              a_v_btxs,a_v_btxe,a_v_btys,a_v_btye, &
 489                              a_ph_btxs,a_ph_btxe,a_ph_btys,a_ph_btye, &
 490                              a_t_btxs,a_t_btxe,a_t_btys,a_t_btye, &
 491                              a_w_btxs,a_w_btxe,a_w_btys,a_w_btye, &
 492                              a_mu_btxs,a_mu_btxe,a_mu_btys,a_mu_btye, &
 493                              spec_bdy_width, spec_zone,           &
 494                              ids,ide, jds,jde, kds,kde,  & ! domain dims
 495                              ims,ime, jms,jme, kms,kme,  & ! memory dims
 496                              ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 497                              its, ite, jts, jte, kts, kte)
 498    IMPLICIT NONE
 499
 500    !  Input data.
 501    TYPE( grid_config_rec_type ) config_flags
 502
 503
 504    INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
 505                                             ims, ime, jms, jme, kms, kme, &
 506                                             ips, ipe, jps, jpe, kps, kpe, &
 507                                             its, ite, jts, jte, kts, kte
 508    INTEGER ,               INTENT(IN   ) :: spec_bdy_width, spec_zone
 509
 510    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) :: a_ru_tend, &
 511                                                                       a_rv_tend, &
 512                                                                       a_ph_tend, &
 513                                                                       a_rw_tend, &
 514                                                                       a_t_tend
 515    REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT)          :: a_mu_tend
 516
 517    REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width    ), INTENT(INOUT) :: a_u_btxs,a_u_btxe, &
 518                                                                                a_v_btxs,a_v_btxe, &
 519                                                                                a_ph_btxs,a_ph_btxe, &
 520                                                                                a_w_btxs,a_w_btxe, &
 521                                                                                a_t_btxs,a_t_btxe
 522
 523    REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width    ), INTENT(INOUT) :: a_u_btys,a_u_btye, &
 524                                                                                a_v_btys,a_v_btye, &
 525                                                                                a_ph_btys,a_ph_btye, &
 526                                                                                a_w_btys,a_w_btye, &
 527                                                                                a_t_btys,a_t_btye
 528
 529    REAL,  DIMENSION( jms:jme , 1:1 ,     spec_bdy_width    ), INTENT(INOUT) :: a_mu_btxs,a_mu_btxe
 530    REAL,  DIMENSION( ims:ime , 1:1 ,     spec_bdy_width    ), INTENT(INOUT) :: a_mu_btys,a_mu_btye
 531
 532          if(config_flags%nested)                           &
 533          CALL a_spec_bdytend ( a_rw_tend,                  &
 534                                a_w_btxs,a_w_btxe,a_w_btys,a_w_btye, &
 535                                'h'     , config_flags,     &
 536                                spec_bdy_width, spec_zone,  &
 537                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 538                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 539                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 540                                its,ite, jts,jte, kts,kte )
 541
 542          CALL a_spec_bdytend ( a_mu_tend,              &
 543                                a_mu_btxs,a_mu_btxe,a_mu_btys,a_mu_btye, &
 544                                'm'     , config_flags, &
 545                                spec_bdy_width, spec_zone, &
 546                                ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
 547                                ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
 548                                ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
 549                                its,ite, jts,jte, 1  ,1   )
 550
 551          CALL a_spec_bdytend ( a_t_tend,               &
 552                                a_t_btxs,a_t_btxe,a_t_btys,a_t_btye, &
 553                                't'     , config_flags, &
 554                                spec_bdy_width, spec_zone, &
 555                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 556                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 557                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 558                                its,ite, jts,jte, kts,kte )
 559
 560          CALL a_spec_bdytend ( a_ph_tend,              &
 561                                a_ph_btxs,a_ph_btxe,a_ph_btys,a_ph_btye, &
 562                                'h'     , config_flags, &
 563                                spec_bdy_width, spec_zone, &
 564                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 565                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 566                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 567                                its,ite, jts,jte, kts,kte )
 568
 569          CALL a_spec_bdytend ( a_rv_tend,              &
 570                                a_v_btxs,a_v_btxe,a_v_btys,a_v_btye, &
 571                                'v'     , config_flags, &
 572                                spec_bdy_width, spec_zone, &
 573                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 574                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 575                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 576                                its,ite, jts,jte, kts,kte )
 577
 578          CALL a_spec_bdytend ( a_ru_tend,              &
 579                                a_u_btxs,a_u_btxe,a_u_btys,a_u_btye, &
 580                                'u'     , config_flags, &
 581                                spec_bdy_width, spec_zone, &
 582                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 583                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 584                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 585                                its,ite, jts,jte, kts,kte )
 586    END SUBROUTINE a_spec_bdy_dry
 587
 588 !------------------------------------------------------------------------
 589
 590    SUBROUTINE a_spec_bdy_scalar ( a_scalar_tend,    &
 591                           a_scalar_btxs,a_scalar_btxe,a_scalar_btys,a_scalar_btye, &
 592                           spec_bdy_width, spec_zone,                   &
 593                           config_flags,               &
 594                           ids,ide, jds,jde, kds,kde,  & ! domain dims
 595                           ims,ime, jms,jme, kms,kme,  & ! memory dims
 596                           ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 597                           its, ite, jts, jte, kts, kte)
 598    IMPLICIT NONE
 599
 600    !  Input data.
 601    TYPE( grid_config_rec_type ) config_flags
 602
 603
 604    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
 605                           ims, ime, jms, jme, kms, kme, &
 606                           ips, ipe, jps, jpe, kps, kpe, &
 607                           its, ite, jts, jte, kts, kte
 608    INTEGER, INTENT(IN) :: spec_bdy_width, spec_zone
 609
 610    REAL, DIMENSION(ims:ime, kms:kme, jms:jme),        INTENT(INOUT) :: a_scalar_tend
 611
 612    REAL, DIMENSION(jms:jme, kds:kde, spec_bdy_width), INTENT(INOUT) :: a_scalar_btxs,a_scalar_btxe
 613    REAL, DIMENSION(ims:ime, kds:kde, spec_bdy_width), INTENT(INOUT) :: a_scalar_btys,a_scalar_btye
 614
 615 !Local
 616    INTEGER :: i,j,k
 617
 618
 619          CALL a_spec_bdytend ( a_scalar_tend,                &
 620                                a_scalar_btxs,a_scalar_btxe,a_scalar_btys,a_scalar_btye,    &
 621                                'q'     , 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
 628    END SUBROUTINE a_spec_bdy_scalar
 629
 630 !------------------------------------------------------------------------
 631
 632  SUBROUTINE a_set_phys_bc_dry_2(config_flags,u_1,a_u_1,u_2,a_u_2,v_1, &
 633  a_v_1,v_2,a_v_2,w_1,a_w_1,w_2,a_w_2,t_1,a_t_1,t_2,a_t_2,ph_1, &
 634  a_ph_1,ph_2,a_ph_2,mu_1,a_mu_1,mu_2,a_mu_2,ids,ide,jds,jde,kds,kde,ims, &
 635  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 636
 637  IMPLICIT NONE
 638
 639  REAL :: Tmpv1,a_Tmpv1
 640  TYPE(grid_config_rec_type) config_flags
 641  INTEGER :: ids,ide,jds,jde,kds,kde
 642  INTEGER :: ims,ime,jms,jme,kms,kme
 643  INTEGER :: ips,ipe,jps,jpe,kps,kpe
 644  INTEGER :: its,ite,jts,jte,kts,kte
 645  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u_1,a_u_1,u_2,a_u_2,v_1,a_v_1, &
 646  v_2,a_v_2,w_1,a_w_1,w_2,a_w_2,t_1,a_t_1,t_2,a_t_2,ph_1,a_ph_1,ph_2, &
 647  a_ph_2
 648  REAL,DIMENSION(ims:ime,jms:jme) :: mu_1,a_mu_1,mu_2,a_mu_2
 649
 650  CALL a_set_physical_bc3d(a_u_1,'U',config_flags,ids,ide,jds,jde,kds,kde, &
 651  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 652
 653  CALL a_set_physical_bc3d(a_u_2,'U',config_flags,ids,ide,jds,jde,kds,kde, &
 654  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 655
 656  CALL a_set_physical_bc3d(a_v_1,'V',config_flags,ids,ide,jds,jde,kds,kde, &
 657  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 658
 659  CALL a_set_physical_bc3d(a_v_2,'V',config_flags,ids,ide,jds,jde,kds,kde, &
 660  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 661
 662  CALL a_set_physical_bc3d(a_w_1,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 663  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 664
 665  CALL a_set_physical_bc3d(a_w_2,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 666  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 667
 668  CALL a_set_physical_bc3d(a_t_1,'p',config_flags,ids,ide,jds,jde,kds,kde, &
 669  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 670
 671  CALL a_set_physical_bc3d(a_t_2,'p',config_flags,ids,ide,jds,jde,kds,kde, &
 672  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 673
 674  CALL a_set_physical_bc3d(a_ph_1,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 675  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 676
 677  CALL a_set_physical_bc3d(a_ph_2,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 678  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 679
 680  CALL a_set_physical_bc2d(a_mu_1,'t',config_flags,ids,ide,jds,jde,ims,ime, &
 681  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 682
 683  CALL a_set_physical_bc2d(a_mu_2,'t',config_flags,ids,ide,jds,jde,ims,ime, &
 684  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 685
 686  END SUBROUTINE a_set_phys_bc_dry_2
 687
 688 !-------------------------------------------------------------------
 689
 690  SUBROUTINE a_rk_phys_bc_dry_1(config_flags,u,a_u,v,a_v,rw,a_rw,w,a_w, &
 691  muu,a_muu,muv,a_muv,mut,a_mut,php,a_php,alt,a_alt,p,a_p,ids,ide, &
 692  jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 693
 694  IMPLICIT NONE
 695
 696  REAL :: Tmpv1,a_Tmpv1
 697  INTEGER :: ids,ide,jds,jde,kds,kde
 698  INTEGER :: ims,ime,jms,jme,kms,kme
 699  INTEGER :: ips,ipe,jps,jpe,kps,kpe
 700  INTEGER :: its,ite,jts,jte,kts,kte
 701  TYPE(grid_config_rec_type) config_flags
 702  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,a_u,v,a_v,rw,a_rw,w,a_w,php, &
 703  a_php,alt,a_alt,p,a_p
 704  REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu,muv,a_muv,mut,a_mut
 705
 706  CALL a_set_physical_bc3d(a_u,'u',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 707  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 708
 709  CALL a_set_physical_bc3d(a_v,'v',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 710  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 711
 712  CALL a_set_physical_bc3d(a_rw,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 713  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 714
 715  CALL a_set_physical_bc3d(a_w,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 716  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 717
 718  CALL a_set_physical_bc3d(a_php,'w',config_flags,ids,ide,jds,jde,kds,kde, &
 719  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 720
 721  CALL a_set_physical_bc3d(a_alt,'t',config_flags,ids,ide,jds,jde,kds,kde, &
 722  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 723
 724  CALL a_set_physical_bc3d(a_p,'p',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 725  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 726
 727  CALL a_set_physical_bc2d(a_muu,'u',config_flags,ids,ide,jds,jde,ims,ime, &
 728  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 729
 730  CALL a_set_physical_bc2d(a_muv,'v',config_flags,ids,ide,jds,jde,ims,ime, &
 731  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 732
 733  CALL a_set_physical_bc2d(a_mut,'t',config_flags,ids,ide,jds,jde,ims,ime, &
 734  jms,jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 735
 736  END SUBROUTINE a_rk_phys_bc_dry_1
 737
 738 !---------------------------------------------------------------------
 739
 740  SUBROUTINE a_rk_phys_bc_dry_2(config_flags,a_u,a_v,a_w,a_t,&
 741  a_ph,a_mu,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe, &
 742  kps,kpe,its,ite,jts,jte,kts,kte)
 743
 744  IMPLICIT NONE
 745
 746  REAL :: Tmpv1,a_Tmpv1
 747  INTEGER :: ids,ide,jds,jde,kds,kde
 748  INTEGER :: ims,ime,jms,jme,kms,kme
 749  INTEGER :: ips,ipe,jps,jpe,kps,kpe
 750  INTEGER :: its,ite,jts,jte,kts,kte
 751  TYPE(grid_config_rec_type) config_flags
 752  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: a_u,a_v,a_w,a_t,a_ph
 753  REAL,DIMENSION(ims:ime,jms:jme) :: a_mu
 754
 755  CALL a_set_physical_bc3d(a_u,'U',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 756  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 757
 758  CALL a_set_physical_bc3d(a_v,'V',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 759  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 760
 761  CALL a_set_physical_bc3d(a_w,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 762  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 763
 764  CALL a_set_physical_bc3d(a_t,'p',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 765  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 766
 767  CALL a_set_physical_bc3d(a_ph,'w',config_flags,ids,ide,jds,jde,kds,kde,ims, &
 768  ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 769
 770  CALL a_set_physical_bc2d(a_mu,'t',config_flags,ids,ide,jds,jde,ims,ime,jms, &
 771  jme,ips,ipe,jps,jpe,its,ite,jts,jte)
 772
 773  END SUBROUTINE a_rk_phys_bc_dry_2
 774
 775 !---------------------------------------------------------------------
 776
 777    SUBROUTINE a_zero_bdytend  (                                                  &
 778                               u_btxs,a_u_btxs,u_btxe,a_u_btxe, &
 779                               u_btys,a_u_btys,u_btye,a_u_btye, &
 780                               v_btxs,a_v_btxs,v_btxe,a_v_btxe, &
 781                               v_btys,a_v_btys,v_btye,a_v_btye, &
 782                               ph_btxs,a_ph_btxs,ph_btxe,a_ph_btxe, &
 783                               ph_btys,a_ph_btys,ph_btye,a_ph_btye, &
 784                               t_btxs,a_t_btxs,t_btxe,a_t_btxe, &
 785                               t_btys,a_t_btys,t_btye,a_t_btye, &
 786                               w_btxs,a_w_btxs,w_btxe,a_w_btxe, &
 787                               w_btys,a_w_btys,w_btye,a_w_btye, &
 788                               mu_btxs,a_mu_btxs,mu_btxe,a_mu_btxe, &
 789                               mu_btys,a_mu_btys,mu_btye,a_mu_btye, &
 790                               moist_btxs,a_moist_btxs,moist_btxe,a_moist_btxe, &
 791                               moist_btys,a_moist_btys,moist_btye,a_moist_btye, &
 792                               scalar_btxs,a_scalar_btxs,scalar_btxe,a_scalar_btxe, &
 793                               scalar_btys,a_scalar_btys,scalar_btye,a_scalar_btye, &
 794                               spec_bdy_width,n_moist,n_scalar,                 &
 795                               ids,ide, jds,jde, kds,kde,  & ! domain dims
 796                               ims,ime, jms,jme, kms,kme,  & ! memory dims
 797                               ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 798                               its,ite, jts,jte, kts,kte   )
 799    IMPLICIT NONE
 800
 801    !  Input data.
 802
 803    INTEGER ,               INTENT(IN   ) :: spec_bdy_width, n_moist, n_scalar
 804
 805    INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
 806                                             ims, ime, jms, jme, kms, kme, &
 807                                             ips, ipe, jps, jpe, kps, kpe, &
 808                                             its, ite, jts, jte, kts, kte
 809
 810    REAL,DIMENSION(jms:jme,kds:kde,spec_bdy_width),INTENT(INOUT) :: u_btxs,a_u_btxs,u_btxe,a_u_btxe, &
 811                                                                    v_btxs,a_v_btxs,v_btxe,a_v_btxe, &
 812                                                                    ph_btxs,a_ph_btxs,ph_btxe,a_ph_btxe, &
 813                                                                    w_btxs,a_w_btxs,w_btxe,a_w_btxe, &
 814                                                                    t_btxs,a_t_btxs,t_btxe,a_t_btxe
 815
 816    REAL,DIMENSION(ims:ime,kds:kde,spec_bdy_width),INTENT(INOUT) :: u_btys,a_u_btys,u_btye,a_u_btye, &
 817                                                                    v_btys,a_v_btys,v_btye,a_v_btye, &
 818                                                                    ph_btys,a_ph_btys,ph_btye,a_ph_btye, &
 819                                                                    w_btys,a_w_btys,w_btye,a_w_btye, &
 820                                                                    t_btys,a_t_btys,t_btye,a_t_btye
 821
 822    REAL,DIMENSION(jms:jme,1:1    ,spec_bdy_width), INTENT(INOUT) :: mu_btxs,a_mu_btxs,mu_btxe,a_mu_btxe
 823    REAL,DIMENSION(ims:ime,1:1    ,spec_bdy_width), INTENT(INOUT) :: mu_btys,a_mu_btys,mu_btye,a_mu_btye
 824
 825    REAL,DIMENSION(jms:jme,kds:kde,spec_bdy_width,n_moist),INTENT(INOUT) ::  &
 826                               moist_btxs,a_moist_btxs,moist_btxe,a_moist_btxe
 827    REAL,DIMENSION(ims:ime,kds:kde,spec_bdy_width,n_moist),INTENT(INOUT) ::  &
 828                               moist_btys,a_moist_btys,moist_btye,a_moist_btye
 829
 830    REAL,DIMENSION(jms:jme,kds:kde,spec_bdy_width,n_scalar),INTENT(INOUT) ::  &
 831                               scalar_btxs,a_scalar_btxs,scalar_btxe,a_scalar_btxe
 832    REAL,DIMENSION(ims:ime,kds:kde,spec_bdy_width,n_scalar),INTENT(INOUT) ::  &
 833                               scalar_btys,a_scalar_btys,scalar_btye,a_scalar_btye
 834
 835 ! setting adj of bdy tendencies to zero during DFI
 836
 837        CALL wrf_debug( 10, 'In a_zero_bdytend, setting adj of bdy tendencies to 0 during DFI' )
 838        a_u_btxs = 0.
 839        a_u_btxe = 0.
 840        a_u_btys = 0.
 841        a_u_btye = 0.
 842        a_v_btxs = 0.
 843        a_v_btxe = 0.
 844        a_v_btys = 0.
 845        a_v_btye = 0.
 846        a_t_btxs = 0.
 847        a_t_btxe = 0.
 848        a_t_btys = 0.
 849        a_t_btye = 0.
 850        a_ph_btxs = 0.
 851        a_ph_btxe = 0.
 852        a_ph_btys = 0.
 853        a_ph_btye = 0.
 854        a_mu_btxs = 0.
 855        a_mu_btxe = 0.
 856        a_mu_btys = 0.
 857        a_mu_btye = 0.
 858        a_moist_btxs = 0.
 859        a_moist_btxe = 0.
 860        a_moist_btys = 0.
 861        a_moist_btye = 0.
 862        a_scalar_btxs = 0.
 863        a_scalar_btxe = 0.
 864        a_scalar_btys = 0.
 865        a_scalar_btye = 0.
 866
 867 !  ENDIF
 868
 869    END SUBROUTINE a_zero_bdytend
 870
 871 !---------------------------------------------------------------------
 872
 873 ! Revised by Ning Pan, 2010-08-03
 874 !   SUBROUTINE a_set_w_surface(config_flags,znw,fill_w_flag,w,a_w,ht,a_ht,u,a_u, &
 875    SUBROUTINE a_set_w_surface(config_flags,znw,fill_w_flag,w,a_w,ht,u,a_u, &
 876    v,a_v,cf1,cf2,cf3,rdx,rdy,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 877    kme,its,ite,jts,jte,kts,kte)
 878
 879 !PART I: DECLARATION OF VARIABLES
 880
 881    IMPLICIT NONE
 882
 883    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
 884    TYPE(grid_config_rec_type) config_flags
 885    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 886    REAL :: rdx,rdy,cf1,cf2,cf3
 887    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,a_u,v,a_v
 888    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: w,a_w
 889 ! Revised by Ning Pan, 2010-08-03
 890 !   REAL,DIMENSION(ims:ime,jms:jme) :: ht,a_ht,msftx,msfty
 891    REAL,DIMENSION(ims:ime,jms:jme) :: ht,msftx,msfty
 892    REAL,DIMENSION(kms:kme) :: znw
 893    LOGICAL :: fill_w_flag
 894    INTEGER :: i,j,k
 895    INTEGER :: ip1,im1,jp1,jm1
 896    INTEGER :: ip1_limit,im1_limit,jp1_limit,jm1_limit
 897
 898    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
 899    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
 900    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, &
 901    a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
 902    a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019,a_Tmpv20,Tmpv020,a_Tmpv21,Tmpv021
 903    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv200
 904    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv201
 905    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv202
 906    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv203
 907    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv204
 908    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv205
 909    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv206
 910    REAL,DIMENSION(its:min(ite, ide-1)) :: Tmpv207
 911
 912 !PART II: CALCULATIONS OF B. S. TRAJECTORY
 913
 914 !LPB[0]
 915         jm1_limit = jds
 916         jp1_limit = jde-1
 917         im1_limit = ids
 918         ip1_limit = ide-1
 919
 920 !LPB[1]
 921      IF ( config_flags%periodic_x ) THEN
 922
 923           im1_limit = ids-1
 924           ip1_limit = ide
 925
 926    ENDIF
 927
 928 !LPB[2]
 929
 930 !LPB[3]
 931
 932      IF ( config_flags%periodic_y ) THEN
 933
 934           jm1_limit = jds-1
 935           jp1_limit = jde
 936
 937    ENDIF
 938
 939 !!LPB[4]
 940 !        DO j = jts,min(jte,jde-1)
 941
 942 !
 943 !          jm1 = max(j-1, jm1_limit)
 944 !          jp1 = min(j+1, jp1_limit)
 945
 946 !        DO i = its,min(ite,ide-1)
 947 !          im1 = max(i-1, im1_limit)
 948 !          ip1 = min(i+1, ip1_limit)
 949 !            w(i,1,j)=  msfty(i,j)*                                &
 950 !                     .5*rdy*(                                     &
 951 !                              (ht(i,jp1)-ht(i,j  ))               &
 952 !             *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))      &
 953 !                             +(ht(i,j  )-ht(i,jm1))               &
 954 !             *(cf1*v(i,1,j  )+cf2*v(i,2,j  )+cf3*v(i,3,j  ))  )   &
 955 !                       +msftx(i,j)*                               &
 956 !                     .5*rdx*(                                     &
 957 !                              (ht(ip1,j)-ht(i,j  ))               &
 958 !             *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))      &
 959 !                             +(ht(i  ,j)-ht(im1,j))               &
 960 !             *(cf1*u(i  ,1,j)+cf2*u(i  ,2,j)+cf3*u(i  ,3,j))  )
 961 !         ENDDO
 962
 963 !         ENDDO
 964
 965 !!LPB[5]
 966
 967 !!LPB[6]
 968 !      IF (fill_w_flag) THEN
 969
 970 !           DO j = jts,min(jte,jde-1)
 971 !           DO k = kts+1,kte
 972 !           DO i = its,min(ite,ide-1)
 973 !             w(i,k,j) = w(i,1,j)*znw(k)*znw(k)
 974 !           ENDDO
 975 !           ENDDO
 976 !           ENDDO
 977
 978 !   ENDIF
 979
 980 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
 981
 982 !LPB[6]
 983
 984 !  IF(fill_w_flag) THEN
 985 !  DO j =jts, min(jte, jde-1)
 986 !  DO k =kts+1, kte
 987 !  DO i =its, min(ite, ide-1)
 988 !  w(i,k,j) =w(i,1,j)*znw(k)*znw(k)
 989
 990 !  ENDDO
 991 !  ENDDO
 992 !  ENDDO
 993 !  ENDIF
 994
 995    IF(fill_w_flag) THEN
 996
 997    DO j =min(jte, jde-1), jts, -1
 998    DO k =kte, kts+1, -1
 999    DO i =min(ite, ide-1), its, -1
1000    a_w(i,1,j) =a_w(i,1,j) +znw(k)*znw(k)*a_w(i,k,j)
1001    a_w(i,k,j) =0.0
1002    ENDDO
1003    ENDDO
1004    ENDDO
1005
1006    ENDIF
1007
1008 !LPB[5]
1009
1010 !LPB[4]
1011    DO j =min(jte, jde-1), jts, -1
1012
1013    jm1 =max(j-1, jm1_limit)
1014    jp1 =min(j+1, jp1_limit)
1015    DO i =its, min(ite, ide-1)
1016    im1 =max(i-1, im1_limit)
1017    ip1 =min(i+1, ip1_limit)
1018    Tmpv001 =ht(i,jp1) -ht(i,j)
1019    Tmpv002 =cf1*v(i,1,j+1) +cf2*v(i,2,j+1)
1020    Tmpv003 =Tmpv002 +cf3*v(i,3,j+1)
1021    Tmpv200(i) =Tmpv001
1022    Tmpv201(i) =Tmpv003
1023    Tmpv004 =Tmpv200(i)*Tmpv201(i)
1024    Tmpv005 =ht(i,j) -ht(i,jm1)
1025    Tmpv006 =cf1*v(i,1,j) +cf2*v(i,2,j)
1026    Tmpv007 =Tmpv006 +cf3*v(i,3,j)
1027    Tmpv202(i) =Tmpv005
1028    Tmpv203(i) =Tmpv007
1029    Tmpv008 =Tmpv202(i)*Tmpv203(i)
1030    Tmpv009 =Tmpv004 +Tmpv008
1031    Tmpv010 =msfty(i,j)*.5*rdy*Tmpv009
1032    Tmpv011 =ht(ip1,j) -ht(i,j)
1033    Tmpv012 =cf1*u(i+1,1,j) +cf2*u(i+1,2,j)
1034    Tmpv013 =Tmpv012 +cf3*u(i+1,3,j)
1035    Tmpv204(i) =Tmpv011
1036    Tmpv205(i) =Tmpv013
1037    Tmpv014 =Tmpv204(i)*Tmpv205(i)
1038    Tmpv015 =ht(i,j) -ht(im1,j)
1039    Tmpv016 =cf1*u(i,1,j) +cf2*u(i,2,j)
1040    Tmpv017 =Tmpv016 +cf3*u(i,3,j)
1041    Tmpv206(i) =Tmpv015
1042    Tmpv207(i) =Tmpv017
1043    Tmpv018 =Tmpv206(i)*Tmpv207(i)
1044    Tmpv019 =Tmpv014 +Tmpv018
1045    Tmpv020 =msftx(i,j)*.5*rdx*Tmpv019
1046    Tmpv021 =Tmpv010 +Tmpv020
1047 !  w(i,1,j) =Tmpv021
1048
1049    ENDDO
1050
1051    DO i =min(ite, ide-1), its, -1
1052 ! Added by Ning Pan, 2010-08-03
1053    im1 =max(i-1, im1_limit)
1054    ip1 =min(i+1, ip1_limit)
1055
1056    a_Tmpv21 =a_w(i,1,j)
1057    a_w(i,1,j) =0.0
1058    a_Tmpv10 =a_Tmpv21
1059    a_Tmpv20 =a_Tmpv21
1060    a_Tmpv19 =msftx(i,j)*.5*rdx*a_Tmpv20
1061    a_Tmpv14 =a_Tmpv19
1062    a_Tmpv18 =a_Tmpv19
1063    a_Tmpv15 =Tmpv207(i)*a_Tmpv18
1064    a_Tmpv17 =Tmpv206(i)*a_Tmpv18
1065    a_Tmpv16 =a_Tmpv17
1066    a_u(i,3,j) =a_u(i,3,j) +cf3*a_Tmpv17
1067    a_u(i,1,j) =a_u(i,1,j) +cf1*a_Tmpv16
1068    a_u(i,2,j) =a_u(i,2,j) +cf2*a_Tmpv16
1069 ! Remarked by Ning Pan, 2010-08-03
1070 !   a_ht(i,j) =a_ht(i,j) +a_Tmpv15
1071 !   a_ht(im1,j) =a_ht(im1,j) -a_Tmpv15
1072    a_Tmpv11 =Tmpv205(i)*a_Tmpv14
1073    a_Tmpv13 =Tmpv204(i)*a_Tmpv14
1074    a_Tmpv12 =a_Tmpv13
1075    a_u(i+1,3,j) =a_u(i+1,3,j) +cf3*a_Tmpv13
1076    a_u(i+1,1,j) =a_u(i+1,1,j) +cf1*a_Tmpv12
1077    a_u(i+1,2,j) =a_u(i+1,2,j) +cf2*a_Tmpv12
1078 ! Remarked by Ning Pan, 2010-08-03
1079 !   a_ht(ip1,j) =a_ht(ip1,j) +a_Tmpv11
1080 !   a_ht(i,j) =a_ht(i,j) -a_Tmpv11
1081    a_Tmpv9 =msfty(i,j)*.5*rdy*a_Tmpv10
1082    a_Tmpv4 =a_Tmpv9
1083    a_Tmpv8 =a_Tmpv9
1084    a_Tmpv5 =Tmpv203(i)*a_Tmpv8
1085    a_Tmpv7 =Tmpv202(i)*a_Tmpv8
1086    a_Tmpv6 =a_Tmpv7
1087    a_v(i,3,j) =a_v(i,3,j) +cf3*a_Tmpv7
1088    a_v(i,1,j) =a_v(i,1,j) +cf1*a_Tmpv6
1089    a_v(i,2,j) =a_v(i,2,j) +cf2*a_Tmpv6
1090 ! Remarked by Ning Pan, 2010-08-03
1091 !   a_ht(i,j) =a_ht(i,j) +a_Tmpv5
1092 !   a_ht(i,jm1) =a_ht(i,jm1) -a_Tmpv5
1093    a_Tmpv1 =Tmpv201(i)*a_Tmpv4
1094    a_Tmpv3 =Tmpv200(i)*a_Tmpv4
1095    a_Tmpv2 =a_Tmpv3
1096    a_v(i,3,j+1) =a_v(i,3,j+1) +cf3*a_Tmpv3
1097    a_v(i,1,j+1) =a_v(i,1,j+1) +cf1*a_Tmpv2
1098    a_v(i,2,j+1) =a_v(i,2,j+1) +cf2*a_Tmpv2
1099 ! Remarked by Ning Pan, 2010-08-03
1100 !   a_ht(i,jp1) =a_ht(i,jp1) +a_Tmpv1
1101 !   a_ht(i,j) =a_ht(i,j) -a_Tmpv1
1102    ENDDO
1103
1104    ENDDO
1105
1106 !LPB[3]
1107
1108 !  IF( config_flags%periodic_y ) THEN
1109 !  jm1_limit =jds-1
1110 !  jp1_limit =jde
1111 !  ENDIF
1112
1113 ! Remarked by Ning Pan, 2010-08-03
1114 !   IF( config_flags%periodic_y ) THEN
1115
1116 !   ENDIF
1117
1118 !LPB[2]
1119
1120 !LPB[1]
1121
1122 !  IF( config_flags%periodic_x ) THEN
1123 !  im1_limit =ids-1
1124 !  ip1_limit =ide
1125 !  ENDIF
1126
1127 ! Remarked by Ning Pan, 2010-08-03
1128 !   IF( config_flags%periodic_x ) THEN
1129
1130 !   ENDIF
1131
1132 !LPB[0]
1133 !  jm1_limit =jds
1134 !  jp1_limit =jde-1
1135 !  im1_limit =ids
1136 !  ip1_limit =ide-1
1137
1138    END SUBROUTINE a_set_w_surface
1139
1140 END MODULE a_module_bc_em