wrfv2_fire/share/module_bc.F

   1 !WRF:MODEL_LAYER:BOUNDARY
   2 !
   3
   4 MODULE module_bc
   5
   6    USE module_configure
   7    USE module_wrf_error
   8    IMPLICIT NONE
   9
  10 !   TYPE bcs
  11 !
  12 !     LOGICAL                     :: periodic_x
  13 !     LOGICAL                     :: symmetric_xs
  14 !     LOGICAL                     :: symmetric_xe
  15 !     LOGICAL                     :: open_xs
  16 !     LOGICAL                     :: open_xe
  17 !     LOGICAL                     :: periodic_y
  18 !     LOGICAL                     :: symmetric_ys
  19 !     LOGICAL                     :: symmetric_ye
  20 !     LOGICAL                     :: open_ys
  21 !     LOGICAL                     :: open_ye
  22 !     LOGICAL                     :: nested
  23 !     LOGICAL                     :: specified
  24 !     LOGICAL                     :: top_radiation
  25 !
  26 !   END TYPE bcs
  27
  28 !  set the bdyzone.  We are hardwiring this here and we'll
  29 !  decide later where it should be set and stored
  30
  31    INTEGER, PARAMETER            :: bdyzone = 4
  32    INTEGER, PARAMETER            :: bdyzone_x = bdyzone
  33    INTEGER, PARAMETER            :: bdyzone_y = bdyzone
  34
  35    INTERFACE stuff_bdy
  36      MODULE PROCEDURE stuff_bdy_new , stuff_bdy_old
  37    END INTERFACE
  38
  39    INTERFACE stuff_bdytend
  40      MODULE PROCEDURE stuff_bdytend_new , stuff_bdytend_old
  41    END INTERFACE
  42
  43 CONTAINS
  44
  45   SUBROUTINE boundary_condition_check ( config_flags, bzone, error, gn )
  46
  47 !  this routine checks the boundary condition logicals
  48 !  to make sure that the boundary conditions are not over
  49 !  or under specified.  The routine also checks that the
  50 !  boundary zone is sufficiently sized for the specified
  51 !  boundary conditions
  52
  53   IMPLICIT NONE
  54
  55   TYPE( grid_config_rec_type ) config_flags
  56
  57   INTEGER, INTENT(IN   ) :: bzone, gn
  58   INTEGER, INTENT(INOUT) :: error
  59
  60 ! local variables
  61
  62   INTEGER :: xs_bc, xe_bc, ys_bc, ye_bc, bzone_min
  63   INTEGER :: nprocx, nprocy
  64
  65   CALL wrf_debug( 100 , ' checking boundary conditions for grid ' )
  66
  67   error = 0
  68   xs_bc = 0
  69   xe_bc = 0
  70   ys_bc = 0
  71   ye_bc = 0
  72
  73 !  sum the number of conditions specified for each lateral boundary.
  74 !  obviously, this number should be 1
  75
  76   IF( config_flags%periodic_x ) THEN
  77     xs_bc = xs_bc+1
  78     xe_bc = xe_bc+1
  79   ENDIF
  80
  81   IF( config_flags%periodic_y ) THEN
  82     ys_bc = ys_bc+1
  83     ye_bc = ye_bc+1
  84   ENDIF
  85
  86   IF( config_flags%symmetric_xs ) xs_bc = xs_bc + 1
  87   IF( config_flags%symmetric_xe ) xe_bc = xe_bc + 1
  88   IF( config_flags%open_xs )      xs_bc = xs_bc + 1
  89   IF( config_flags%open_xe )      xe_bc = xe_bc + 1
  90
  91
  92   IF( config_flags%symmetric_ys ) ys_bc = ys_bc + 1
  93   IF( config_flags%symmetric_ye ) ye_bc = ye_bc + 1
  94   IF( config_flags%open_ys )      ys_bc = ys_bc + 1
  95   IF( config_flags%open_ye )      ye_bc = ye_bc + 1
  96
  97   IF( config_flags%nested ) THEN
  98      xs_bc = xs_bc + 1
  99      xe_bc = xe_bc + 1
 100      ys_bc = ys_bc + 1
 101      ye_bc = ye_bc + 1
 102    ENDIF
 103
 104   IF( config_flags%specified ) THEN
 105      IF( .NOT. config_flags%periodic_x)xs_bc = xs_bc + 1
 106      IF( .NOT. config_flags%periodic_x)xe_bc = xe_bc + 1
 107      ys_bc = ys_bc + 1
 108      ye_bc = ye_bc + 1
 109    ENDIF
 110
 111   IF( config_flags%polar ) THEN
 112      ys_bc = ys_bc + 1
 113      ye_bc = ye_bc + 1
 114    ENDIF
 115
 116 !  check the number of conditions for each boundary
 117
 118    IF( (xs_bc /= 1) .or. &
 119        (xe_bc /= 1) .or. &
 120        (ys_bc /= 1) .or. &
 121        (ye_bc /= 1)         ) THEN
 122
 123      error = 1
 124
 125      write( wrf_err_message ,*) ' *** Error in boundary condition specification '
 126      CALL wrf_message ( wrf_err_message )
 127      write( wrf_err_message ,*) ' boundary conditions at xs ', xs_bc
 128      CALL wrf_message ( wrf_err_message )
 129      write( wrf_err_message ,*) ' boundary conditions at xe ', xe_bc
 130      CALL wrf_message ( wrf_err_message )
 131      write( wrf_err_message ,*) ' boundary conditions at ys ', ys_bc
 132      CALL wrf_message ( wrf_err_message )
 133      write( wrf_err_message ,*) ' boundary conditions at ye ', ye_bc
 134      CALL wrf_message ( wrf_err_message )
 135      write( wrf_err_message ,*) ' boundary conditions logicals are '
 136      CALL wrf_message ( wrf_err_message )
 137      write( wrf_err_message ,*) ' periodic_x   ',config_flags%periodic_x
 138      CALL wrf_message ( wrf_err_message )
 139      write( wrf_err_message ,*) ' periodic_y   ',config_flags%periodic_y
 140      CALL wrf_message ( wrf_err_message )
 141      write( wrf_err_message ,*) ' symmetric_xs ',config_flags%symmetric_xs
 142      CALL wrf_message ( wrf_err_message )
 143      write( wrf_err_message ,*) ' symmetric_xe ',config_flags%symmetric_xe
 144      CALL wrf_message ( wrf_err_message )
 145      write( wrf_err_message ,*) ' symmetric_ys ',config_flags%symmetric_ys
 146      CALL wrf_message ( wrf_err_message )
 147      write( wrf_err_message ,*) ' symmetric_ye ',config_flags%symmetric_ye
 148      CALL wrf_message ( wrf_err_message )
 149      write( wrf_err_message ,*) ' open_xs      ',config_flags%open_xs
 150      CALL wrf_message ( wrf_err_message )
 151      write( wrf_err_message ,*) ' open_xe      ',config_flags%open_xe
 152      CALL wrf_message ( wrf_err_message )
 153      write( wrf_err_message ,*) ' open_ys      ',config_flags%open_ys
 154      CALL wrf_message ( wrf_err_message )
 155      write( wrf_err_message ,*) ' open_ye      ',config_flags%open_ye
 156      CALL wrf_message ( wrf_err_message )
 157      write( wrf_err_message ,*) ' polar        ',config_flags%polar
 158      CALL wrf_message ( wrf_err_message )
 159      write( wrf_err_message ,*) ' nested       ',config_flags%nested
 160      CALL wrf_message ( wrf_err_message )
 161      write( wrf_err_message ,*) ' specified    ',config_flags%specified
 162      CALL wrf_message ( wrf_err_message )
 163      CALL wrf_error_fatal( ' *** Error in boundary condition specification ' )
 164
 165    ENDIF
 166
 167 !  now check to see if boundary zone size is sufficient.
 168 !  we could have the necessary boundary zone size be returned
 169 !  to the calling routine.
 170
 171    IF( config_flags%periodic_x   .or. &
 172        config_flags%periodic_y   .or. &
 173        config_flags%symmetric_xs .or. &
 174        config_flags%symmetric_xe .or. &
 175        config_flags%symmetric_ys .or. &
 176        config_flags%symmetric_ye        )  THEN
 177
 178        bzone_min = MAX( 1,                                  &
 179                         (config_flags%h_mom_adv_order+1)/2, &
 180                         (config_flags%h_sca_adv_order+1)/2 )
 181
 182        IF( bzone < bzone_min) THEN
 183
 184          error = 2
 185          WRITE ( wrf_err_message , * ) ' boundary zone not large enough '
 186          CALL wrf_message ( wrf_err_message )
 187          WRITE ( wrf_err_message , * ) ' boundary zone specified      ',bzone
 188          CALL wrf_message ( wrf_err_message )
 189          WRITE ( wrf_err_message , * ) ' minimum boundary zone needed ',bzone_min
 190          CALL wrf_error_fatal ( wrf_err_message )
 191
 192        ENDIF
 193    ENDIF
 194
 195    CALL wrf_debug ( 100 , ' boundary conditions OK for grid ' )
 196
 197    END subroutine boundary_condition_check
 198
 199 !--------------------------------------------------------------------------
 200    SUBROUTINE set_physical_bc2d( dat, variable_in,  &
 201                                  config_flags,           &
 202                                  ids,ide, jds,jde,   & ! domain dims
 203                                  ims,ime, jms,jme,   & ! memory dims
 204                                  ips,ipe, jps,jpe,   & ! patch  dims
 205                                  its,ite, jts,jte   )
 206
 207 !  This subroutine sets the data in the boundary region, by direct
 208 !  assignment if possible, for periodic and symmetric (wall)
 209 !  boundary conditions.  Currently, we are only doing 1 variable
 210 !  at a time - lots of overhead, so maybe this routine can be easily
 211 !  inlined later or we could pass multiple variables -
 212 !  would probably want a largestep and smallstep version.
 213
 214 !  15 Jan 99, Dave
 215 !  Modified the incoming its,ite,jts,jte to truly be the tile size.
 216 !  This required modifying the loop limits when the "istag" or "jstag"
 217 !  is used, as this is only required at the end of the domain.
 218
 219       IMPLICIT NONE
 220
 221       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde
 222       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme
 223       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe
 224       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte
 225       CHARACTER,    INTENT(IN   )    :: variable_in
 226
 227       CHARACTER                      :: variable
 228
 229       REAL,  DIMENSION( ims:ime , jms:jme ) :: dat
 230       TYPE( grid_config_rec_type ) config_flags
 231
 232       INTEGER  :: i, j, istag, jstag, itime
 233
 234       LOGICAL  :: debug, open_bc_copy
 235
 236 !------------
 237
 238       debug = .false.
 239
 240       open_bc_copy = .false.
 241
 242       variable = variable_in
 243       IF ( variable_in .ge. 'A' .and. variable_in .le. 'Z' ) THEN
 244         variable = CHAR( ICHAR(variable_in) - ICHAR('A') + ICHAR('a') )
 245       ENDIF
 246       IF ((variable == 'u') .or. (variable == 'v') .or.  &
 247           (variable == 'w') .or. (variable == 't') .or.  &
 248           (variable == 'x') .or. (variable == 'y') .or.  &
 249           (variable == 'r') .or. (variable == 'p') ) open_bc_copy = .true.
 250
 251 !  begin, first set a staggering variable
 252
 253       istag = -1
 254       jstag = -1
 255
 256       IF ((variable == 'u') .or. (variable == 'x')) istag = 0
 257       IF ((variable == 'v') .or. (variable == 'y')) jstag = 0
 258
 259       if(debug) then
 260         write(6,*) ' in bc2d, var is ',variable, istag, jstag
 261         write(6,*) ' b.cs are ',  &
 262       config_flags%periodic_x,  &
 263       config_flags%periodic_y
 264       end if
 265
 266       IF ( variable == 'd' ) then  !JDM
 267          istag = 0
 268          jstag = 0
 269       ENDIF
 270       IF ( variable == 'e' ) then  !JDM
 271          istag = 0
 272       ENDIF
 273       IF ( variable == 'f' ) then  !JDM
 274          jstag = 0
 275       ENDIF
 276
 277 !  periodic conditions.
 278 !  note, patch must cover full range in periodic dir, or else
 279 !  its intra-patch communication that is handled elsewheres.
 280 !  symmetry conditions can always be handled here, because no
 281 !  outside patch communication is needed
 282
 283       periodicity_x:  IF( ( config_flags%periodic_x ) ) THEN
 284         IF ( ( ids == ips ) .and.  ( ide == ipe ) ) THEN  ! test if east and west both on-processor
 285           IF ( its == ids ) THEN
 286
 287             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 288             DO i = 0,-(bdyzone-1),-1
 289               dat(ids+i-1,j) = dat(ide+i-1,j)
 290             ENDDO
 291             ENDDO
 292
 293           ENDIF
 294
 295           IF ( ite == ide ) THEN
 296
 297             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 298 !!          DO i = 1 , bdyzone
 299             DO i = -istag , bdyzone
 300               dat(ide+i+istag,j) = dat(ids+i+istag,j)
 301             ENDDO
 302             ENDDO
 303
 304           ENDIF
 305         ENDIF
 306
 307       ELSE
 308
 309         symmetry_xs: IF( ( config_flags%symmetric_xs ) .and.  &
 310                          ( its == ids )                  )  THEN
 311
 312           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
 313
 314             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 315             DO i = 1, bdyzone
 316               dat(ids-i,j) = dat(ids+i-1,j) !  here, dat(0) = dat(1), etc
 317             ENDDO                             !  symmetry about dat(0.5) (u=0 pt)
 318             ENDDO
 319
 320           ELSE
 321
 322             IF( variable == 'u' ) THEN
 323
 324               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 325               DO i = 0, bdyzone-1
 326                 dat(ids-i,j) = - dat(ids+i,j) ! here, u(0) = - u(2), etc
 327               ENDDO                             !  normal b.c symmetry at u(1)
 328               ENDDO
 329
 330             ELSE
 331
 332               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 333               DO i = 0, bdyzone-1
 334                 dat(ids-i,j) =   dat(ids+i,j) ! here, phi(0) = phi(2), etc
 335               ENDDO                             !  normal b.c symmetry at phi(1)
 336               ENDDO
 337
 338             END IF
 339
 340           ENDIF
 341
 342         ENDIF symmetry_xs
 343
 344
 345 !  now the symmetry boundary at xe
 346
 347         symmetry_xe: IF( ( config_flags%symmetric_xe ) .and.  &
 348                          ( ite == ide )                  )  THEN
 349
 350           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
 351
 352             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 353             DO i = 1, bdyzone
 354               dat(ide+i-1,j) = dat(ide-i,j)  !  sym. about dat(ide-0.5)
 355             ENDDO
 356             ENDDO
 357
 358           ELSE
 359
 360             IF (variable == 'u' ) THEN
 361
 362               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 363               DO i = 0, bdyzone-1
 364                 dat(ide+i,j) = - dat(ide-i,j)  ! u(ide+1) = - u(ide-1), etc.
 365               ENDDO
 366               ENDDO
 367
 368
 369             ELSE
 370
 371               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 372               DO i = 0, bdyzone-1
 373                 dat(ide+i,j) = dat(ide-i,j)  !  phi(ide+1) = phi(ide-1), etc.
 374               ENDDO
 375               ENDDO
 376
 377             END IF
 378
 379           END IF
 380
 381         END IF symmetry_xe
 382
 383
 384 !  set open b.c in X copy into boundary zone here.  WCS, 19 March 2000
 385
 386         open_xs: IF( ( config_flags%open_xs   .or. &
 387                        config_flags%specified .or. &
 388                        config_flags%nested            ) .and.  &
 389                          ( its == ids ) .and. open_bc_copy  )  THEN
 390
 391             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 392               dat(ids-1,j) = dat(ids,j) !  here, dat(0) = dat(1)
 393               dat(ids-2,j) = dat(ids,j)
 394               dat(ids-3,j) = dat(ids,j)
 395             ENDDO
 396
 397         ENDIF open_xs
 398
 399
 400 !  now the open boundary copy at xe
 401
 402         open_xe: IF( ( config_flags%open_xe   .or. &
 403                        config_flags%specified .or. &
 404                        config_flags%nested            ) .and.  &
 405                           ( ite == ide ) .and. open_bc_copy  )  THEN
 406
 407           IF ( variable /= 'u' .and. variable /= 'x') THEN
 408
 409             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 410               dat(ide  ,j) = dat(ide-1,j)
 411               dat(ide+1,j) = dat(ide-1,j)
 412               dat(ide+2,j) = dat(ide-1,j)
 413             ENDDO
 414
 415           ELSE
 416
 417             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 418               dat(ide+1,j) = dat(ide,j)
 419               dat(ide+2,j) = dat(ide,j)
 420               dat(ide+3,j) = dat(ide,j)
 421             ENDDO
 422
 423           END IF
 424
 425         END IF open_xe
 426
 427 !  end open b.c in X copy into boundary zone addition.  WCS, 19 March 2000
 428
 429       END IF periodicity_x
 430
 431 !  same procedure in y
 432
 433       periodicity_y:  IF( ( config_flags%periodic_y ) ) THEN
 434         IF ( ( jds == jps ) .and. ( jde == jpe ) )  THEN    ! test of both north and south on processor
 435
 436           IF( jts == jds ) then
 437
 438             DO j = 0, -(bdyzone-1), -1
 439             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 440               dat(i,jds+j-1) = dat(i,jde+j-1)
 441             ENDDO
 442             ENDDO
 443
 444           END IF
 445
 446           IF( jte == jde ) then
 447
 448             DO j = -jstag, bdyzone
 449             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 450               dat(i,jde+j+jstag) = dat(i,jds+j+jstag)
 451             ENDDO
 452             ENDDO
 453
 454           END IF
 455
 456         END IF
 457
 458       ELSE
 459
 460         symmetry_ys: IF( ( config_flags%symmetric_ys ) .and.  &
 461                          ( jts == jds)                   )  THEN
 462
 463           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
 464
 465             DO j = 1, bdyzone
 466             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 467               dat(i,jds-j) = dat(i,jds+j-1)
 468             ENDDO
 469             ENDDO
 470
 471           ELSE
 472
 473             IF (variable == 'v') THEN
 474
 475               DO j = 1, bdyzone
 476               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 477                 dat(i,jds-j) = - dat(i,jds+j)
 478               ENDDO
 479               ENDDO
 480
 481             ELSE
 482
 483               DO j = 1, bdyzone
 484               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 485                 dat(i,jds-j) = dat(i,jds+j)
 486               ENDDO
 487               ENDDO
 488
 489             END IF
 490
 491           ENDIF
 492
 493         ENDIF symmetry_ys
 494
 495 !  now the symmetry boundary at ye
 496
 497         symmetry_ye: IF( ( config_flags%symmetric_ye ) .and.  &
 498                          ( jte == jde )                  )  THEN
 499
 500           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
 501
 502             DO j = 1, bdyzone
 503             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 504               dat(i,jde+j-1) = dat(i,jde-j)
 505             ENDDO
 506             ENDDO
 507
 508           ELSE
 509
 510             IF (variable == 'v' ) THEN
 511
 512               DO j = 1, bdyzone
 513               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 514                 dat(i,jde+j) = - dat(i,jde-j)    ! bugfix: changed jds on rhs to jde , JM 20020410
 515               ENDDO
 516               ENDDO
 517
 518             ELSE
 519
 520               DO j = 1, bdyzone
 521               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 522                 dat(i,jde+j) = dat(i,jde-j)
 523               ENDDO
 524               ENDDO
 525
 526             END IF
 527
 528           ENDIF
 529
 530         END IF symmetry_ye
 531
 532 !  set open b.c in Y copy into boundary zone here.  WCS, 19 March 2000
 533
 534         open_ys: IF( ( config_flags%open_ys   .or. &
 535                        config_flags%polar     .or. &
 536                        config_flags%specified .or. &
 537                        config_flags%nested            ) .and.  &
 538                          ( jts == jds) .and. open_bc_copy )  THEN
 539
 540             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 541               dat(i,jds-1) = dat(i,jds)
 542               dat(i,jds-2) = dat(i,jds)
 543               dat(i,jds-3) = dat(i,jds)
 544             ENDDO
 545
 546         ENDIF open_ys
 547
 548 !  now the open boundary copy at ye
 549
 550         open_ye: IF( ( config_flags%open_ye   .or. &
 551                        config_flags%polar     .or. &
 552                        config_flags%specified .or. &
 553                        config_flags%nested            ) .and.  &
 554                          ( jte == jde ) .and. open_bc_copy )  THEN
 555
 556           IF  (variable /= 'v' .and. variable /= 'y' ) THEN
 557
 558             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 559               dat(i,jde  ) = dat(i,jde-1)
 560               dat(i,jde+1) = dat(i,jde-1)
 561               dat(i,jde+2) = dat(i,jde-1)
 562             ENDDO
 563
 564           ELSE
 565
 566             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 567               dat(i,jde+1) = dat(i,jde)
 568               dat(i,jde+2) = dat(i,jde)
 569               dat(i,jde+3) = dat(i,jde)
 570             ENDDO
 571
 572           ENDIF
 573
 574         END IF open_ye
 575
 576 !  end open b.c in Y copy into boundary zone addition.  WCS, 19 March 2000
 577
 578       END IF periodicity_y
 579
 580 !  fix corners for doubly periodic domains
 581
 582       IF ( config_flags%periodic_x .and. config_flags%periodic_y &
 583            .and. (ids == ips) .and. (ide == ipe)                 &
 584            .and. (jds == jps) .and. (jde == jpe)                   ) THEN
 585
 586          IF ( (its == ids) .and. (jts == jds) ) THEN  ! lower left corner fill
 587            DO j = 0, -(bdyzone-1), -1
 588            DO i = 0, -(bdyzone-1), -1
 589              dat(ids+i-1,jds+j-1) = dat(ide+i-1,jde+j-1)
 590            ENDDO
 591            ENDDO
 592          END IF
 593
 594          IF ( (ite == ide) .and. (jts == jds) ) THEN  ! lower right corner fill
 595            DO j = 0, -(bdyzone-1), -1
 596            DO i = 1, bdyzone
 597              dat(ide+i+istag,jds+j-1) = dat(ids+i+istag,jde+j-1)
 598            ENDDO
 599            ENDDO
 600          END IF
 601
 602          IF ( (ite == ide) .and. (jte == jde) ) THEN  ! upper right corner fill
 603            DO j = 1, bdyzone
 604            DO i = 1, bdyzone
 605              dat(ide+i+istag,jde+j+jstag) = dat(ids+i+istag,jds+j+jstag)
 606            ENDDO
 607            ENDDO
 608          END IF
 609
 610          IF ( (its == ids) .and. (jte == jde) ) THEN  ! upper left corner fill
 611            DO j = 1, bdyzone
 612            DO i = 0, -(bdyzone-1), -1
 613              dat(ids+i-1,jde+j+jstag) = dat(ide+i-1,jds+j+jstag)
 614            ENDDO
 615            ENDDO
 616          END IF
 617
 618        END IF
 619
 620    END SUBROUTINE set_physical_bc2d
 621
 622 !-----------------------------------
 623
 624    SUBROUTINE set_physical_bc3d( dat, variable_in,        &
 625                                config_flags,                   &
 626                                ids,ide, jds,jde, kds,kde,  & ! domain dims
 627                                ims,ime, jms,jme, kms,kme,  & ! memory dims
 628                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
 629                                its,ite, jts,jte, kts,kte )
 630
 631 !  This subroutine sets the data in the boundary region, by direct
 632 !  assignment if possible, for periodic and symmetric (wall)
 633 !  boundary conditions.  Currently, we are only doing 1 variable
 634 !  at a time - lots of overhead, so maybe this routine can be easily
 635 !  inlined later or we could pass multiple variables -
 636 !  would probably want a largestep and smallstep version.
 637
 638 !  15 Jan 99, Dave
 639 !  Modified the incoming its,ite,jts,jte to truly be the tile size.
 640 !  This required modifying the loop limits when the "istag" or "jstag"
 641 !  is used, as this is only required at the end of the domain.
 642
 643       IMPLICIT NONE
 644
 645       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
 646       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
 647       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
 648       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
 649       CHARACTER,    INTENT(IN   )    :: variable_in
 650
 651       CHARACTER                      :: variable
 652
 653       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ) :: dat
 654       TYPE( grid_config_rec_type ) config_flags
 655
 656       INTEGER  :: i, j, k, istag, jstag, itime, k_end
 657
 658       LOGICAL  :: debug, open_bc_copy
 659
 660 !------------
 661
 662       debug = .false.
 663
 664       open_bc_copy = .false.
 665
 666       variable = variable_in
 667       IF ( variable_in .ge. 'A' .and. variable_in .le. 'Z' ) THEN
 668         variable = CHAR( ICHAR(variable_in) - ICHAR('A') + ICHAR('a') )
 669       ENDIF
 670
 671       IF ((variable == 'u') .or. (variable == 'v') .or.     &
 672           (variable == 'w') .or. (variable == 't') .or.     &
 673           (variable == 'd') .or. (variable == 'e') .or. &
 674           (variable == 'x') .or. (variable == 'y') .or. &
 675           (variable == 'f') .or. (variable == 'r') .or. &
 676           (variable == 'p')                        ) open_bc_copy = .true.
 677
 678 !  begin, first set a staggering variable
 679
 680       istag = -1
 681       jstag = -1
 682       k_end = max(1,min(kde-1,kte))
 683
 684
 685       IF ((variable == 'u') .or. (variable == 'x')) istag = 0
 686       IF ((variable == 'v') .or. (variable == 'y')) jstag = 0
 687       IF ((variable == 'd') .or. (variable == 'xy')) then
 688          istag = 0
 689          jstag = 0
 690       ENDIF
 691       IF ((variable == 'e') ) then
 692          istag = 0
 693          k_end = min(kde,kte)
 694       ENDIF
 695
 696       IF ((variable == 'f') ) then
 697          jstag = 0
 698          k_end = min(kde,kte)
 699       ENDIF
 700
 701       IF ( variable == 'w')  k_end = min(kde,kte)
 702
 703 !      k_end = kte
 704
 705       if(debug) then
 706         write(6,*) ' in bc, var is ',variable, istag, jstag, kte, k_end
 707         write(6,*) ' b.cs are ',  &
 708       config_flags%periodic_x,  &
 709       config_flags%periodic_y
 710       end if
 711
 712
 713
 714 !  periodic conditions.
 715 !  note, patch must cover full range in periodic dir, or else
 716 !  its intra-patch communication that is handled elsewheres.
 717 !  symmetry conditions can always be handled here, because no
 718 !  outside patch communication is needed
 719
 720       periodicity_x:  IF( ( config_flags%periodic_x ) ) THEN
 721
 722         IF ( ( ids == ips ) .and. ( ide == ipe ) ) THEN  ! test if both east and west on-processor
 723           IF ( its == ids ) THEN
 724
 725             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 726             DO k = kts, k_end
 727             DO i = 0,-(bdyzone-1),-1
 728               dat(ids+i-1,k,j) = dat(ide+i-1,k,j)
 729             ENDDO
 730             ENDDO
 731             ENDDO
 732
 733           ENDIF
 734
 735
 736           IF ( ite == ide ) THEN
 737
 738             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 739             DO k = kts, k_end
 740             DO i = -istag , bdyzone
 741               dat(ide+i+istag,k,j) = dat(ids+i+istag,k,j)
 742             ENDDO
 743             ENDDO
 744             ENDDO
 745
 746           ENDIF
 747
 748         ENDIF
 749
 750       ELSE
 751
 752         symmetry_xs: IF( ( config_flags%symmetric_xs ) .and.  &
 753                          ( its == ids )                  )  THEN
 754
 755           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
 756
 757             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 758             DO k = kts, k_end
 759             DO i = 1, bdyzone
 760               dat(ids-i,k,j) = dat(ids+i-1,k,j) !  here, dat(0) = dat(1), etc
 761             ENDDO                                 !  symmetry about dat(0.5) (u = 0 pt)
 762             ENDDO
 763             ENDDO
 764
 765           ELSE
 766
 767             IF ( variable == 'u' ) THEN
 768
 769               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 770               DO k = kts, k_end
 771               DO i = 1, bdyzone
 772                 dat(ids-i,k,j) = - dat(ids+i,k,j) ! here, u(0) = - u(2), etc
 773               ENDDO                                 !  normal b.c symmetry at u(1)
 774               ENDDO
 775               ENDDO
 776
 777             ELSE
 778
 779               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 780               DO k = kts, k_end
 781               DO i = 1, bdyzone
 782                 dat(ids-i,k,j) = dat(ids+i,k,j) ! here, phi(0) = phi(2), etc
 783               ENDDO                               !  normal b.c symmetry at phi(1)
 784               ENDDO
 785               ENDDO
 786
 787             END IF
 788
 789           ENDIF
 790
 791         ENDIF symmetry_xs
 792
 793
 794 !  now the symmetry boundary at xe
 795
 796         symmetry_xe: IF( ( config_flags%symmetric_xe ) .and.  &
 797                          ( ite == ide )                  )  THEN
 798
 799           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
 800
 801             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 802             DO k = kts, k_end
 803             DO i = 1, bdyzone
 804               dat(ide+i-1,k,j) = dat(ide-i,k,j)  !  sym. about dat(ide-0.5)
 805             ENDDO
 806             ENDDO
 807             ENDDO
 808
 809           ELSE
 810
 811             IF (variable == 'u') THEN
 812
 813               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 814               DO k = kts, k_end
 815               DO i = 1, bdyzone
 816                 dat(ide+i,k,j) = - dat(ide-i,k,j)  ! u(ide+1) = - u(ide-1), etc.
 817               ENDDO
 818               ENDDO
 819               ENDDO
 820
 821             ELSE
 822
 823               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
 824               DO k = kts, k_end
 825               DO i = 1, bdyzone
 826                 dat(ide+i,k,j) = dat(ide-i,k,j)  ! phi(ide+1) = - phi(ide-1), etc.
 827               ENDDO
 828               ENDDO
 829               ENDDO
 830
 831              END IF
 832
 833           END IF
 834
 835         END IF symmetry_xe
 836
 837 !  set open b.c in X copy into boundary zone here.  WCS, 19 March 2000
 838
 839         open_xs: IF( ( config_flags%open_xs   .or. &
 840                        config_flags%specified .or. &
 841                        config_flags%nested            ) .and.  &
 842                          ( its == ids ) .and. open_bc_copy  )  THEN
 843
 844             DO j = jts-bdyzone, MIN(jte,jde+jstag)+bdyzone
 845             DO k = kts, k_end
 846               dat(ids-1,k,j) = dat(ids,k,j) !  here, dat(0) = dat(1), etc
 847               dat(ids-2,k,j) = dat(ids,k,j)
 848               dat(ids-3,k,j) = dat(ids,k,j)
 849             ENDDO
 850             ENDDO
 851
 852         ENDIF open_xs
 853
 854
 855 !  now the open_xe boundary copy
 856
 857         open_xe: IF( ( config_flags%open_xe   .or. &
 858                        config_flags%specified .or. &
 859                        config_flags%nested            ) .and.  &
 860                          ( ite == ide ) .and. open_bc_copy )  THEN
 861
 862           IF (variable /= 'u' .and. variable /= 'x' ) THEN
 863
 864             DO j = jts-bdyzone, MIN(jte,jde+jstag)+bdyzone
 865             DO k = kts, k_end
 866               dat(ide  ,k,j) = dat(ide-1,k,j)
 867               dat(ide+1,k,j) = dat(ide-1,k,j)
 868               dat(ide+2,k,j) = dat(ide-1,k,j)
 869             ENDDO
 870             ENDDO
 871
 872           ELSE
 873
 874 !!!!!!! I am not sure about this one!  JM 20020402
 875             DO j = MAX(jds,jts-1)-bdyzone, MIN(jte+1,jde+jstag)+bdyzone
 876             DO k = kts, k_end
 877               dat(ide+1,k,j) = dat(ide,k,j)
 878               dat(ide+2,k,j) = dat(ide,k,j)
 879               dat(ide+3,k,j) = dat(ide,k,j)
 880             ENDDO
 881             ENDDO
 882
 883           END IF
 884
 885         END IF open_xe
 886
 887 !  end open b.c in X copy into boundary zone addition.  WCS, 19 March 2000
 888
 889       END IF periodicity_x
 890
 891 !  same procedure in y
 892
 893       periodicity_y:  IF( ( config_flags%periodic_y ) ) THEN
 894         IF ( ( jds == jps ) .and. ( jde == jpe ) )  THEN      ! test if both north and south on processor
 895           IF( jts == jds ) then
 896
 897             DO j = 0, -(bdyzone-1), -1
 898             DO k = kts, k_end
 899             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 900               dat(i,k,jds+j-1) = dat(i,k,jde+j-1)
 901             ENDDO
 902             ENDDO
 903             ENDDO
 904
 905           END IF
 906
 907           IF( jte == jde ) then
 908
 909             DO j = -jstag, bdyzone
 910             DO k = kts, k_end
 911             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 912               dat(i,k,jde+j+jstag) = dat(i,k,jds+j+jstag)
 913             ENDDO
 914             ENDDO
 915             ENDDO
 916
 917           END IF
 918
 919         END IF
 920
 921       ELSE
 922
 923         symmetry_ys: IF( ( config_flags%symmetric_ys ) .and.  &
 924                          ( jts == jds)                   )  THEN
 925
 926           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
 927
 928             DO j = 1, bdyzone
 929             DO k = kts, k_end
 930             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 931               dat(i,k,jds-j) = dat(i,k,jds+j-1)
 932             ENDDO
 933             ENDDO
 934             ENDDO
 935
 936           ELSE
 937
 938             IF (variable == 'v') THEN
 939
 940               DO j = 1, bdyzone
 941               DO k = kts, k_end
 942               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 943                 dat(i,k,jds-j) = - dat(i,k,jds+j)
 944               ENDDO
 945               ENDDO
 946               ENDDO
 947
 948             ELSE
 949
 950               DO j = 1, bdyzone
 951               DO k = kts, k_end
 952               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 953                 dat(i,k,jds-j) = dat(i,k,jds+j)
 954               ENDDO
 955               ENDDO
 956               ENDDO
 957
 958             END IF
 959
 960           ENDIF
 961
 962         ENDIF symmetry_ys
 963
 964 !  now the symmetry boundary at ye
 965
 966         symmetry_ye: IF( ( config_flags%symmetric_ye ) .and.  &
 967                          ( jte == jde )                  )  THEN
 968
 969           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
 970
 971             DO j = 1, bdyzone
 972             DO k = kts, k_end
 973             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 974               dat(i,k,jde+j-1) = dat(i,k,jde-j)
 975             ENDDO
 976             ENDDO
 977             ENDDO
 978
 979           ELSE
 980
 981             IF ( variable == 'v' ) THEN
 982
 983               DO j = 1, bdyzone
 984               DO k = kts, k_end
 985               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 986                 dat(i,k,jde+j) = - dat(i,k,jde-j)
 987               ENDDO
 988               ENDDO
 989               ENDDO
 990
 991             ELSE
 992
 993               DO j = 1, bdyzone
 994               DO k = kts, k_end
 995               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
 996                 dat(i,k,jde+j) = dat(i,k,jde-j)
 997               ENDDO
 998               ENDDO
 999               ENDDO
1000
1001             END IF
1002
1003           ENDIF
1004
1005         END IF symmetry_ye
1006
1007 !  set open b.c in Y copy into boundary zone here.  WCS, 19 March 2000
1008
1009         open_ys: IF( ( config_flags%open_ys   .or. &
1010                        config_flags%polar     .or. &
1011                        config_flags%specified .or. &
1012                        config_flags%nested            ) .and.  &
1013                          ( jts == jds) .and. open_bc_copy )  THEN
1014
1015             DO k = kts, k_end
1016             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
1017               dat(i,k,jds-1) = dat(i,k,jds)
1018               dat(i,k,jds-2) = dat(i,k,jds)
1019               dat(i,k,jds-3) = dat(i,k,jds)
1020             ENDDO
1021             ENDDO
1022
1023         ENDIF open_ys
1024
1025 !  now the open boundary copy at ye
1026
1027         open_ye: IF( ( config_flags%open_ye   .or. &
1028                        config_flags%polar     .or. &
1029                        config_flags%specified .or. &
1030                        config_flags%nested            ) .and.  &
1031                          ( jte == jde ) .and. open_bc_copy )  THEN
1032
1033           IF (variable /= 'v' .and. variable /= 'y' ) THEN
1034
1035             DO k = kts, k_end
1036             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
1037               dat(i,k,jde  ) = dat(i,k,jde-1)
1038               dat(i,k,jde+1) = dat(i,k,jde-1)
1039               dat(i,k,jde+2) = dat(i,k,jde-1)
1040             ENDDO
1041             ENDDO
1042
1043           ELSE
1044
1045             DO k = kts, k_end
1046             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
1047               dat(i,k,jde+1) = dat(i,k,jde)
1048               dat(i,k,jde+2) = dat(i,k,jde)
1049               dat(i,k,jde+3) = dat(i,k,jde)
1050             ENDDO
1051             ENDDO
1052
1053           ENDIF
1054
1055       END IF open_ye
1056
1057 !  end open b.c in Y copy into boundary zone addition.  WCS, 19 March 2000
1058
1059       END IF periodicity_y
1060
1061 !  fix corners for doubly periodic domains
1062
1063       IF ( config_flags%periodic_x .and. config_flags%periodic_y &
1064            .and. (ids == ips) .and. (ide == ipe)                 &
1065            .and. (jds == jps) .and. (jde == jpe)                   ) THEN
1066
1067          IF ( (its == ids) .and. (jts == jds) ) THEN  ! lower left corner fill
1068            DO j = 0, -(bdyzone-1), -1
1069            DO k = kts, k_end
1070            DO i = 0, -(bdyzone-1), -1
1071              dat(ids+i-1,k,jds+j-1) = dat(ide+i-1,k,jde+j-1)
1072            ENDDO
1073            ENDDO
1074            ENDDO
1075          END IF
1076
1077          IF ( (ite == ide) .and. (jts == jds) ) THEN  ! lower right corner fill
1078            DO j = 0, -(bdyzone-1), -1
1079            DO k = kts, k_end
1080            DO i = 1, bdyzone
1081              dat(ide+i+istag,k,jds+j-1) = dat(ids+i+istag,k,jde+j-1)
1082            ENDDO
1083            ENDDO
1084            ENDDO
1085          END IF
1086
1087          IF ( (ite == ide) .and. (jte == jde) ) THEN  ! upper right corner fill
1088            DO j = 1, bdyzone
1089            DO k = kts, k_end
1090            DO i = 1, bdyzone
1091              dat(ide+i+istag,k,jde+j+jstag) = dat(ids+i+istag,k,jds+j+jstag)
1092            ENDDO
1093            ENDDO
1094            ENDDO
1095          END IF
1096
1097          IF ( (its == ids) .and. (jte == jde) ) THEN  ! upper left corner fill
1098            DO j = 1, bdyzone
1099            DO k = kts, k_end
1100            DO i = 0, -(bdyzone-1), -1
1101              dat(ids+i-1,k,jde+j+jstag) = dat(ide+i-1,k,jds+j+jstag)
1102            ENDDO
1103            ENDDO
1104            ENDDO
1105          END IF
1106
1107        END IF
1108
1109    END SUBROUTINE set_physical_bc3d
1110
1111    SUBROUTINE init_module_bc
1112    END SUBROUTINE init_module_bc
1113
1114 !------------------------------------------------------------------------
1115
1116 ! a couple versions of this call to allow a smaller-than-memory dimensioned field (e.g. tile sized)
1117 ! to be passed in as the first argument.  Both of these call the _core version defined below.
1118    SUBROUTINE relax_bdytend   ( field, field_tend,                     &
1119                                 field_bdy_xs, field_bdy_xe,            &
1120                                 field_bdy_ys, field_bdy_ye,            &
1121                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
1122                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
1123                                 variable_in, config_flags,             &
1124                                 spec_bdy_width, spec_zone, relax_zone, &
1125                                 dtbc, fcx, gcx,             &
1126                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
1127                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
1128                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1129                                 its,ite, jts,jte, kts,kte   &
1130                                 )
1131
1132       IMPLICIT NONE
1133
1134       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1135       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1136       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1137       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1138       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
1139       REAL,         INTENT(IN   )    :: dtbc
1140       CHARACTER,    INTENT(IN   )    :: variable_in
1141
1142       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field
1143       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
1144       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
1145       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
1146       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
1147       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
1148       REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
1149       TYPE( grid_config_rec_type ) config_flags
1150
1151       CALL relax_bdytend_core   ( field, field_tend,                     &
1152                                 field_bdy_xs, field_bdy_xe,            &
1153                                 field_bdy_ys, field_bdy_ye,            &
1154                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
1155                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
1156                                 variable_in, config_flags,             &
1157                                 spec_bdy_width, spec_zone, relax_zone, &
1158                                 dtbc, fcx, gcx,             &
1159                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
1160                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
1161                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1162                                 its,ite, jts,jte, kts,kte,  & ! patch  dims
1163                                 ims,ime, jms,jme, kms,kme )  ! dimension of the field argument
1164    END SUBROUTINE relax_bdytend
1165
1166 ! version that allows tile-sized version of field. Note, caller should define the
1167 ! field to be -+1 of tile size in each dimension because routine is going off onto halo
1168 ! for example, see relax_bdytend in dyn_em/module_bc_em.F
1169    SUBROUTINE relax_bdytend_tile   ( field, field_tend,                     &
1170                                 field_bdy_xs, field_bdy_xe,            &
1171                                 field_bdy_ys, field_bdy_ye,            &
1172                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
1173                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
1174                                 variable_in, config_flags,             &
1175                                 spec_bdy_width, spec_zone, relax_zone, &
1176                                 dtbc, fcx, gcx,             &
1177                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
1178                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
1179                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1180                                 its,ite, jts,jte, kts,kte,  &
1181                                 iXs,iXe, jXs,jXe, kXs,kXe   &  ! dims of first argument
1182                                 )
1183
1184       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1185       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1186       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1187       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1188       INTEGER,      INTENT(IN   )    :: iXs,iXe, jXs,jXe, kXs,kXe
1189       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
1190       REAL,         INTENT(IN   )    :: dtbc
1191       CHARACTER,    INTENT(IN   )    :: variable_in
1192
1193       REAL,  DIMENSION( iXs:iXe , kXs:kXe , jXs:jXe ), INTENT(IN   ) :: field
1194       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
1195       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
1196       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
1197       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
1198       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
1199       REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
1200       TYPE( grid_config_rec_type ) config_flags
1201
1202       CALL relax_bdytend_core   ( field, field_tend,                     &
1203                                 field_bdy_xs, field_bdy_xe,            &
1204                                 field_bdy_ys, field_bdy_ye,            &
1205                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
1206                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
1207                                 variable_in, config_flags,             &
1208                                 spec_bdy_width, spec_zone, relax_zone, &
1209                                 dtbc, fcx, gcx,             &
1210                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
1211                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
1212                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1213                                 its,ite, jts,jte, kts,kte,  &
1214                                 iXs,iXe, jXs,jXe, kXs,kXe )  ! dimension of the field argument
1215    END SUBROUTINE relax_bdytend_tile
1216
1217    SUBROUTINE relax_bdytend_core   ( field, field_tend,                     &
1218                                 field_bdy_xs, field_bdy_xe,            &
1219                                 field_bdy_ys, field_bdy_ye,            &
1220                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
1221                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
1222                                 variable_in, config_flags,             &
1223                                 spec_bdy_width, spec_zone, relax_zone, &
1224                                 dtbc, fcx, gcx,             &
1225                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
1226                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
1227                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1228                                 its,ite, jts,jte, kts,kte,  & ! patch  dims
1229                                 iXs,iXe, jXs,jXe, kXs,kXe   & ! field (1st arg) dims; might be tile or patch
1230                                 )
1231
1232 !  This subroutine adds the tendencies in the boundary relaxation region, for specified
1233 !  boundary conditions.
1234 !  spec_bdy_width is only used to dimension the boundary arrays.
1235 !  relax_zone is the inner edge of the boundary relaxation zone treated here.
1236 !  spec_zone is the width of the outer specified b.c.s that are not changed here.
1237 !  (JD July 2000)
1238
1239       IMPLICIT NONE
1240
1241       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1242       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1243       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1244       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1245       INTEGER,      INTENT(IN   )    :: iXs,iXe, jXs,jXe, kXs,kXe
1246       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
1247       REAL,         INTENT(IN   )    :: dtbc
1248       CHARACTER,    INTENT(IN   )    :: variable_in
1249
1250
1251       REAL,  DIMENSION( iXs:iXe , kXs:kXe , jXs:jXe ), INTENT(IN   ) :: field
1252       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
1253       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
1254       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
1255       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
1256       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
1257       REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
1258       TYPE( grid_config_rec_type ) config_flags
1259
1260       CHARACTER  :: variable
1261       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, im1, ip1
1262       INTEGER    :: b_dist, b_limit
1263       REAL       :: fls0, fls1, fls2, fls3, fls4
1264       LOGICAL    :: periodic_x
1265
1266       periodic_x = config_flags%periodic_x
1267       variable = variable_in
1268
1269       IF (variable == 'U') variable = 'u'
1270       IF (variable == 'V') variable = 'v'
1271       IF (variable == 'M') variable = 'm'
1272       IF (variable == 'H') variable = 'h'
1273
1274       ibs = ids
1275       ibe = ide-1
1276       itf = min(ite,ide-1)
1277       jbs = jds
1278       jbe = jde-1
1279       jtf = min(jte,jde-1)
1280       ktf = kde-1
1281       IF (variable == 'u') ibe = ide
1282       IF (variable == 'u') itf = min(ite,ide)
1283       IF (variable == 'v') jbe = jde
1284       IF (variable == 'v') jtf = min(jte,jde)
1285       IF (variable == 'm') ktf = kte
1286       IF (variable == 'h') ktf = kte
1287
1288
1289       IF (jts - jbs .lt. relax_zone) THEN
1290 ! Y-start boundary
1291         DO j = max(jts,jbs+spec_zone), min(jtf,jbs+relax_zone-1)
1292           b_dist = j - jbs
1293           b_limit = b_dist
1294           IF(periodic_x)b_limit = 0
1295           DO k = kts, ktf
1296             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1297               im1 = max(i-1,ibs)
1298               ip1 = min(i+1,ibe)
1299               fls0 = field_bdy_ys(i, k, b_dist+1) &
1300                    + dtbc * field_bdy_tend_ys(i, k, b_dist+1) &
1301                    - field(i,k,j)
1302               fls1 = field_bdy_ys(im1, k, b_dist+1) &
1303                    + dtbc * field_bdy_tend_ys(im1, k, b_dist+1) &
1304                    - field(im1,k,j)
1305               fls2 = field_bdy_ys(ip1, k, b_dist+1) &
1306                    + dtbc * field_bdy_tend_ys(ip1, k, b_dist+1) &
1307                    - field(ip1,k,j)
1308               fls3 = field_bdy_ys(i, k, b_dist) &
1309                    + dtbc * field_bdy_tend_ys(i, k, b_dist) &
1310                    - field(i,k,j-1)
1311               fls4 = field_bdy_ys(i, k, b_dist+2) &
1312                    + dtbc * field_bdy_tend_ys(i, k, b_dist+2) &
1313                    - field(i,k,j+1)
1314               field_tend(i,k,j) = field_tend(i,k,j) &
1315                                 + fcx(b_dist+1)*fls0 &
1316                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
1317             ENDDO
1318           ENDDO
1319         ENDDO
1320       ENDIF
1321
1322       IF (jbe - jtf .lt. relax_zone) THEN
1323
1324
1325 ! Y-end boundary
1326         DO j = max(jts,jbe-relax_zone+1), min(jtf,jbe-spec_zone)
1327           b_dist = jbe - j
1328           b_limit = b_dist
1329           IF(periodic_x)b_limit = 0
1330
1331
1332           DO k = kts, ktf
1333             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1334               im1 = max(i-1,ibs)
1335               ip1 = min(i+1,ibe)
1336               fls0 = field_bdy_ye(i, k, b_dist+1) &
1337                    + dtbc * field_bdy_tend_ye(i, k, b_dist+1) &
1338                    - field(i,k,j)
1339               fls1 = field_bdy_ye(im1, k, b_dist+1) &
1340                    + dtbc * field_bdy_tend_ye(im1, k, b_dist+1) &
1341                    - field(im1,k,j)
1342               fls2 = field_bdy_ye(ip1, k, b_dist+1) &
1343                    + dtbc * field_bdy_tend_ye(ip1, k, b_dist+1) &
1344                    - field(ip1,k,j)
1345               fls3 = field_bdy_ye(i, k, b_dist) &
1346                    + dtbc * field_bdy_tend_ye(i, k, b_dist) &
1347                    - field(i,k,j+1)
1348               fls4 = field_bdy_ye(i, k, b_dist+2) &
1349                    + dtbc * field_bdy_tend_ye(i, k, b_dist+2) &
1350                    - field(i,k,j-1)
1351               field_tend(i,k,j) = field_tend(i,k,j) &
1352                                 + fcx(b_dist+1)*fls0 &
1353                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
1354
1355             ENDDO
1356           ENDDO
1357         ENDDO
1358       ENDIF
1359
1360     IF(.NOT.periodic_x)THEN
1361       IF (its - ibs .lt. relax_zone) THEN
1362 ! X-start boundary
1363         DO i = max(its,ibs+spec_zone), min(itf,ibs+relax_zone-1)
1364           b_dist = i - ibs
1365           DO k = kts, ktf
1366             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1367               fls0 = field_bdy_xs(j, k, b_dist+1) &
1368                    + dtbc * field_bdy_tend_xs(j, k, b_dist+1) &
1369                    - field(i,k,j)
1370               fls1 = field_bdy_xs(j-1, k, b_dist+1) &
1371                    + dtbc * field_bdy_tend_xs(j-1, k, b_dist+1) &
1372                    - field(i,k,j-1)
1373               fls2 = field_bdy_xs(j+1, k, b_dist+1) &
1374                    + dtbc * field_bdy_tend_xs(j+1, k, b_dist+1) &
1375                    - field(i,k,j+1)
1376               fls3 = field_bdy_xs(j, k, b_dist) &
1377                    + dtbc * field_bdy_tend_xs(j, k, b_dist) &
1378                    - field(i-1,k,j)
1379               fls4 = field_bdy_xs(j, k, b_dist+2) &
1380                    + dtbc * field_bdy_tend_xs(j, k, b_dist+2) &
1381                    - field(i+1,k,j)
1382               field_tend(i,k,j) = field_tend(i,k,j) &
1383                                 + fcx(b_dist+1)*fls0 &
1384                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
1385
1386             ENDDO
1387           ENDDO
1388         ENDDO
1389       ENDIF
1390
1391       IF (ibe - itf .lt. relax_zone) THEN
1392 ! X-end boundary
1393         DO i = max(its,ibe-relax_zone+1), min(itf,ibe-spec_zone)
1394           b_dist = ibe - i
1395           DO k = kts, ktf
1396             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1397               fls0 = field_bdy_xe(j, k, b_dist+1) &
1398                    + dtbc * field_bdy_tend_xe(j, k, b_dist+1) &
1399                    - field(i,k,j)
1400               fls1 = field_bdy_xe(j-1, k, b_dist+1) &
1401                    + dtbc * field_bdy_tend_xe(j-1, k, b_dist+1) &
1402                    - field(i,k,j-1)
1403               fls2 = field_bdy_xe(j+1, k, b_dist+1) &
1404                    + dtbc * field_bdy_tend_xe(j+1, k, b_dist+1) &
1405                    - field(i,k,j+1)
1406               fls3 = field_bdy_xe(j, k, b_dist) &
1407                    + dtbc * field_bdy_tend_xe(j, k, b_dist) &
1408                    - field(i+1,k,j)
1409               fls4 = field_bdy_xe(j, k, b_dist+2) &
1410                    + dtbc * field_bdy_tend_xe(j, k, b_dist+2) &
1411                    - field(i-1,k,j)
1412               field_tend(i,k,j) = field_tend(i,k,j) &
1413                                 + fcx(b_dist+1)*fls0 &
1414                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
1415             ENDDO
1416           ENDDO
1417         ENDDO
1418       ENDIF
1419     ENDIF
1420
1421
1422
1423    END SUBROUTINE relax_bdytend_core
1424 !------------------------------------------------------------------------
1425
1426    SUBROUTINE spec_bdytend   ( field_tend,                           &
1427                                field_bdy_xs, field_bdy_xe,           &
1428                                field_bdy_ys, field_bdy_ye,           &
1429                                field_bdy_tend_xs, field_bdy_tend_xe, &
1430                                field_bdy_tend_ys, field_bdy_tend_ye, &
1431                                variable_in, config_flags, &
1432                                spec_bdy_width, spec_zone, &
1433                                ids,ide, jds,jde, kds,kde,  & ! domain dims
1434                                ims,ime, jms,jme, kms,kme,  & ! memory dims
1435                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1436                                its,ite, jts,jte, kts,kte )
1437
1438 !  This subroutine sets the tendencies in the boundary specified region.
1439 !  spec_bdy_width is only used to dimension the boundary arrays.
1440 !  spec_zone is the width of the outer specified b.c.s that are set here.
1441 !  (JD July 2000)
1442
1443       IMPLICIT NONE
1444
1445       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1446       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1447       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1448       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1449       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone
1450       CHARACTER,    INTENT(IN   )    :: variable_in
1451
1452
1453       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT  ) :: field_tend
1454       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
1455       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
1456       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
1457       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
1458       TYPE( grid_config_rec_type ) config_flags
1459
1460       CHARACTER  :: variable
1461       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
1462       INTEGER    :: b_dist, b_limit
1463       LOGICAL    :: periodic_x
1464
1465       periodic_x = config_flags%periodic_x
1466
1467       variable = variable_in
1468
1469       IF (variable == 'U') variable = 'u'
1470       IF (variable == 'V') variable = 'v'
1471       IF (variable == 'M') variable = 'm'
1472       IF (variable == 'H') variable = 'h'
1473
1474       ibs = ids
1475       ibe = ide-1
1476       itf = min(ite,ide-1)
1477       jbs = jds
1478       jbe = jde-1
1479       jtf = min(jte,jde-1)
1480       ktf = kde-1
1481       IF (variable == 'u') ibe = ide
1482       IF (variable == 'u') itf = min(ite,ide)
1483       IF (variable == 'v') jbe = jde
1484       IF (variable == 'v') jtf = min(jte,jde)
1485       IF (variable == 'm') ktf = kte
1486       IF (variable == 'h') ktf = kte
1487
1488       IF (jts - jbs .lt. spec_zone) THEN
1489 ! Y-start boundary
1490         DO j = jts, min(jtf,jbs+spec_zone-1)
1491           b_dist = j - jbs
1492           b_limit = b_dist
1493           IF(periodic_x)b_limit = 0
1494           DO k = kts, ktf
1495             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1496               field_tend(i,k,j) = field_bdy_tend_ys(i, k, b_dist+1)
1497             ENDDO
1498           ENDDO
1499         ENDDO
1500       ENDIF
1501       IF (jbe - jtf .lt. spec_zone) THEN
1502
1503
1504 ! Y-end boundary
1505         DO j = max(jts,jbe-spec_zone+1), jtf
1506           b_dist = jbe - j
1507           b_limit = b_dist
1508           IF(periodic_x)b_limit = 0
1509
1510
1511           DO k = kts, ktf
1512             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1513               field_tend(i,k,j) = field_bdy_tend_ye(i, k, b_dist+1)
1514             ENDDO
1515           ENDDO
1516         ENDDO
1517       ENDIF
1518
1519     IF(.NOT.periodic_x)THEN
1520       IF (its - ibs .lt. spec_zone) THEN
1521 ! X-start boundary
1522         DO i = its, min(itf,ibs+spec_zone-1)
1523           b_dist = i - ibs
1524           DO k = kts, ktf
1525             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1526               field_tend(i,k,j) = field_bdy_tend_xs(j, k, b_dist+1)
1527             ENDDO
1528           ENDDO
1529         ENDDO
1530       ENDIF
1531
1532       IF (ibe - itf .lt. spec_zone) THEN
1533 ! X-end boundary
1534         DO i = max(its,ibe-spec_zone+1), itf
1535           b_dist = ibe - i
1536           DO k = kts, ktf
1537             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1538               field_tend(i,k,j) = field_bdy_tend_xe(j, k, b_dist+1)
1539             ENDDO
1540           ENDDO
1541         ENDDO
1542       ENDIF
1543     ENDIF
1544
1545    END SUBROUTINE spec_bdytend
1546 !------------------------------------------------------------------------
1547
1548    SUBROUTINE spec_bdyfield   ( field,                     &
1549                                field_bdy_xs, field_bdy_xe,           &
1550                                field_bdy_ys, field_bdy_ye,           &
1551                                variable_in, config_flags,  &
1552                                spec_bdy_width, spec_zone, &
1553                                ids,ide, jds,jde, kds,kde,  & ! domain dims
1554                                ims,ime, jms,jme, kms,kme,  & ! memory dims
1555                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1556                                its,ite, jts,jte, kts,kte )
1557
1558 !  This subroutine sets the tendencies in the boundary specified region.
1559 !  spec_bdy_width is only used to dimension the boundary arrays.
1560 !  spec_zone is the width of the outer specified b.c.s that are set here.
1561 !  (JD July 2000)
1562
1563       IMPLICIT NONE
1564
1565       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1566       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1567       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1568       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1569       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone
1570       CHARACTER,    INTENT(IN   )    :: variable_in
1571
1572
1573       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT  ) :: field
1574       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
1575       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
1576       TYPE( grid_config_rec_type ) config_flags
1577
1578       CHARACTER  :: variable
1579       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
1580       INTEGER    :: b_dist, b_limit
1581       LOGICAL    :: periodic_x
1582
1583       periodic_x = config_flags%periodic_x
1584
1585       variable = variable_in
1586
1587       IF (variable == 'U') variable = 'u'
1588       IF (variable == 'V') variable = 'v'
1589       IF (variable == 'M') variable = 'm'
1590       IF (variable == 'H') variable = 'h'
1591
1592       ibs = ids
1593       ibe = ide-1
1594       itf = min(ite,ide-1)
1595       jbs = jds
1596       jbe = jde-1
1597       jtf = min(jte,jde-1)
1598       ktf = kde-1
1599       IF (variable == 'u') ibe = ide
1600       IF (variable == 'u') itf = min(ite,ide)
1601       IF (variable == 'v') jbe = jde
1602       IF (variable == 'v') jtf = min(jte,jde)
1603       IF (variable == 'm') ktf = kte
1604       IF (variable == 'h') ktf = kte
1605
1606       IF (jts - jbs .lt. spec_zone) THEN
1607 ! Y-start boundary
1608         DO j = jts, min(jtf,jbs+spec_zone-1)
1609           b_dist = j - jbs
1610           b_limit = b_dist
1611           IF(periodic_x)b_limit = 0
1612           DO k = kts, ktf
1613             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1614               field(i,k,j) = field_bdy_ys(i, k, b_dist+1)
1615             ENDDO
1616           ENDDO
1617         ENDDO
1618       ENDIF
1619       IF (jbe - jtf .lt. spec_zone) THEN
1620 ! Y-end boundary
1621         DO j = max(jts,jbe-spec_zone+1), jtf
1622           b_dist = jbe - j
1623           b_limit = b_dist
1624           IF(periodic_x)b_limit = 0
1625           DO k = kts, ktf
1626             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1627               field(i,k,j) = field_bdy_ye(i, k, b_dist+1)
1628             ENDDO
1629           ENDDO
1630         ENDDO
1631       ENDIF
1632
1633     IF(.NOT.periodic_x)THEN
1634       IF (its - ibs .lt. spec_zone) THEN
1635 ! X-start boundary
1636         DO i = its, min(itf,ibs+spec_zone-1)
1637           b_dist = i - ibs
1638           DO k = kts, ktf
1639             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1640               field(i,k,j) = field_bdy_xs(j, k, b_dist+1)
1641             ENDDO
1642           ENDDO
1643         ENDDO
1644       ENDIF
1645
1646       IF (ibe - itf .lt. spec_zone) THEN
1647 ! X-end boundary
1648         DO i = max(its,ibe-spec_zone+1), itf
1649           b_dist = ibe - i
1650           DO k = kts, ktf
1651             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1652               field(i,k,j) = field_bdy_xe(j, k, b_dist+1)
1653             ENDDO
1654           ENDDO
1655         ENDDO
1656       ENDIF
1657     ENDIF
1658
1659    END SUBROUTINE spec_bdyfield
1660 !------------------------------------------------------------------------
1661
1662    SUBROUTINE spec_bdyupdate(  field,      &
1663                                field_tend, dt,            &
1664                                variable_in, config_flags, &
1665                                spec_zone,                  &
1666                                ids,ide, jds,jde, kds,kde,  & ! domain dims
1667                                ims,ime, jms,jme, kms,kme,  & ! memory dims
1668                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1669                                its,ite, jts,jte, kts,kte )
1670
1671 !  This subroutine adds the tendencies in the boundary specified region.
1672 !  spec_zone is the width of the outer specified b.c.s that are set here.
1673 !  (JD August 2000)
1674
1675       IMPLICIT NONE
1676
1677       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1678       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1679       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1680       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1681       INTEGER,      INTENT(IN   )    :: spec_zone
1682       CHARACTER,    INTENT(IN   )    :: variable_in
1683       REAL,         INTENT(IN   )    :: dt
1684
1685
1686       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
1687       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field_tend
1688       TYPE( grid_config_rec_type ) config_flags
1689
1690       CHARACTER  :: variable
1691       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
1692       INTEGER    :: b_dist, b_limit
1693       LOGICAL    :: periodic_x
1694
1695       periodic_x = config_flags%periodic_x
1696
1697       variable = variable_in
1698
1699       IF (variable == 'U') variable = 'u'
1700       IF (variable == 'V') variable = 'v'
1701       IF (variable == 'M') variable = 'm'
1702       IF (variable == 'H') variable = 'h'
1703
1704       ibs = ids
1705       ibe = ide-1
1706       itf = min(ite,ide-1)
1707       jbs = jds
1708       jbe = jde-1
1709       jtf = min(jte,jde-1)
1710       ktf = kde-1
1711       IF (variable == 'u') ibe = ide
1712       IF (variable == 'u') itf = min(ite,ide)
1713       IF (variable == 'v') jbe = jde
1714       IF (variable == 'v') jtf = min(jte,jde)
1715       IF (variable == 'm') ktf = kte
1716       IF (variable == 'h') ktf = kte
1717
1718       IF (jts - jbs .lt. spec_zone) THEN
1719 ! Y-start boundary
1720         DO j = jts, min(jtf,jbs+spec_zone-1)
1721           b_dist = j - jbs
1722           b_limit = b_dist
1723           IF(periodic_x)b_limit = 0
1724           DO k = kts, ktf
1725             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1726               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j)
1727             ENDDO
1728           ENDDO
1729         ENDDO
1730       ENDIF
1731       IF (jbe - jtf .lt. spec_zone) THEN
1732 ! Y-end boundary
1733         DO j = max(jts,jbe-spec_zone+1), jtf
1734           b_dist = jbe - j
1735           b_limit = b_dist
1736           IF(periodic_x)b_limit = 0
1737           DO k = kts, ktf
1738             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1739               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j)
1740             ENDDO
1741           ENDDO
1742         ENDDO
1743       ENDIF
1744
1745     IF(.NOT.periodic_x)THEN
1746       IF (its - ibs .lt. spec_zone) THEN
1747 ! X-start boundary
1748         DO i = its, min(itf,ibs+spec_zone-1)
1749           b_dist = i - ibs
1750           DO k = kts, ktf
1751             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1752               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j)
1753             ENDDO
1754           ENDDO
1755         ENDDO
1756       ENDIF
1757
1758       IF (ibe - itf .lt. spec_zone) THEN
1759 ! X-end boundary
1760         DO i = max(its,ibe-spec_zone+1), itf
1761           b_dist = ibe - i
1762           DO k = kts, ktf
1763             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1764               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j)
1765             ENDDO
1766           ENDDO
1767         ENDDO
1768       ENDIF
1769     ENDIF
1770
1771    END SUBROUTINE spec_bdyupdate
1772 !------------------------------------------------------------------------
1773
1774    SUBROUTINE zero_grad_bdy (  field,                     &
1775                                variable_in, config_flags, &
1776                                spec_zone,                  &
1777                                ids,ide, jds,jde, kds,kde,  & ! domain dims
1778                                ims,ime, jms,jme, kms,kme,  & ! memory dims
1779                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1780                                its,ite, jts,jte, kts,kte )
1781
1782 !  This subroutine sets zero gradient conditions in the boundary specified region.
1783 !  spec_zone is the width of the outer specified b.c.s that are set here.
1784 !  (JD August 2000)
1785
1786       IMPLICIT NONE
1787
1788       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1789       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1790       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1791       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1792       INTEGER,      INTENT(IN   )    :: spec_zone
1793       CHARACTER,    INTENT(IN   )    :: variable_in
1794
1795
1796       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
1797       TYPE( grid_config_rec_type ) config_flags
1798
1799       CHARACTER  :: variable
1800       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
1801       INTEGER    :: b_dist, b_limit
1802       LOGICAL    :: periodic_x
1803
1804       periodic_x = config_flags%periodic_x
1805
1806       variable = variable_in
1807
1808       IF (variable == 'U') variable = 'u'
1809       IF (variable == 'V') variable = 'v'
1810
1811       ibs = ids
1812       ibe = ide-1
1813       itf = min(ite,ide-1)
1814       jbs = jds
1815       jbe = jde-1
1816       jtf = min(jte,jde-1)
1817       ktf = kde-1
1818       IF (variable == 'u') ibe = ide
1819       IF (variable == 'u') itf = min(ite,ide)
1820       IF (variable == 'v') jbe = jde
1821       IF (variable == 'v') jtf = min(jte,jde)
1822       IF (variable == 'w') ktf = kde
1823
1824       IF (jts - jbs .lt. spec_zone) THEN
1825 ! Y-start boundary
1826         DO j = jts, min(jtf,jbs+spec_zone-1)
1827           b_dist = j - jbs
1828           b_limit = b_dist
1829           IF(periodic_x)b_limit = 0
1830           DO k = kts, ktf
1831             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1832               i_inner = max(i,ibs+spec_zone)
1833               i_inner = min(i_inner,ibe-spec_zone)
1834               IF(periodic_x)i_inner = i
1835               field(i,k,j) = field(i_inner,k,jbs+spec_zone)
1836             ENDDO
1837           ENDDO
1838         ENDDO
1839       ENDIF
1840       IF (jbe - jtf .lt. spec_zone) THEN
1841 ! Y-end boundary
1842         DO j = max(jts,jbe-spec_zone+1), jtf
1843           b_dist = jbe - j
1844           b_limit = b_dist
1845           IF(periodic_x)b_limit = 0
1846           DO k = kts, ktf
1847             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1848               i_inner = max(i,ibs+spec_zone)
1849               i_inner = min(i_inner,ibe-spec_zone)
1850               IF(periodic_x)i_inner = i
1851               field(i,k,j) = field(i_inner,k,jbe-spec_zone)
1852             ENDDO
1853           ENDDO
1854         ENDDO
1855       ENDIF
1856
1857     IF(.NOT.periodic_x)THEN
1858       IF (its - ibs .lt. spec_zone) THEN
1859 ! X-start boundary
1860         DO i = its, min(itf,ibs+spec_zone-1)
1861           b_dist = i - ibs
1862           DO k = kts, ktf
1863             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1864               j_inner = max(j,jbs+spec_zone)
1865               j_inner = min(j_inner,jbe-spec_zone)
1866               field(i,k,j) = field(ibs+spec_zone,k,j_inner)
1867             ENDDO
1868           ENDDO
1869         ENDDO
1870       ENDIF
1871
1872       IF (ibe - itf .lt. spec_zone) THEN
1873 ! X-end boundary
1874         DO i = max(its,ibe-spec_zone+1), itf
1875           b_dist = ibe - i
1876           DO k = kts, ktf
1877             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1878               j_inner = max(j,jbs+spec_zone)
1879               j_inner = min(j_inner,jbe-spec_zone)
1880               field(i,k,j) = field(ibe-spec_zone,k,j_inner)
1881             ENDDO
1882           ENDDO
1883         ENDDO
1884       ENDIF
1885     ENDIF
1886
1887    END SUBROUTINE zero_grad_bdy
1888 !------------------------------------------------------------------------
1889
1890    SUBROUTINE flow_dep_bdy  (  field,                     &
1891                                u, v, config_flags, &
1892                                spec_zone,                  &
1893                                ids,ide, jds,jde, kds,kde,  & ! domain dims
1894                                ims,ime, jms,jme, kms,kme,  & ! memory dims
1895                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
1896                                its,ite, jts,jte, kts,kte )
1897
1898 !  This subroutine sets zero gradient conditions for outflow and zero value
1899 !  for inflow in the boundary specified region. Note that field must be unstaggered.
1900 !  The velocities, u and v, will only be used to check their sign (coupled vels OK)
1901 !  spec_zone is the width of the outer specified b.c.s that are set here.
1902 !  (JD August 2000)
1903
1904       IMPLICIT NONE
1905
1906       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
1907       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
1908       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
1909       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
1910       INTEGER,      INTENT(IN   )    :: spec_zone
1911
1912
1913       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
1914       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: u
1915       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: v
1916       TYPE( grid_config_rec_type ) config_flags
1917
1918       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
1919       INTEGER    :: b_dist, b_limit
1920       LOGICAL    :: periodic_x
1921
1922       periodic_x = config_flags%periodic_x
1923
1924       ibs = ids
1925       ibe = ide-1
1926       itf = min(ite,ide-1)
1927       jbs = jds
1928       jbe = jde-1
1929       jtf = min(jte,jde-1)
1930       ktf = kde-1
1931
1932       IF (jts - jbs .lt. spec_zone) THEN
1933 ! Y-start boundary
1934         DO j = jts, min(jtf,jbs+spec_zone-1)
1935           b_dist = j - jbs
1936           b_limit = b_dist
1937           IF(periodic_x)b_limit = 0
1938           DO k = kts, ktf
1939             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1940               i_inner = max(i,ibs+spec_zone)
1941               i_inner = min(i_inner,ibe-spec_zone)
1942               IF(periodic_x)i_inner = i
1943               IF(v(i,k,j) .lt. 0.)THEN
1944                 field(i,k,j) = field(i_inner,k,jbs+spec_zone)
1945               ELSE
1946                 field(i,k,j) = 0.
1947               ENDIF
1948             ENDDO
1949           ENDDO
1950         ENDDO
1951       ENDIF
1952       IF (jbe - jtf .lt. spec_zone) THEN
1953 ! Y-end boundary
1954         DO j = max(jts,jbe-spec_zone+1), jtf
1955           b_dist = jbe - j
1956           b_limit = b_dist
1957           IF(periodic_x)b_limit = 0
1958           DO k = kts, ktf
1959             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
1960               i_inner = max(i,ibs+spec_zone)
1961               i_inner = min(i_inner,ibe-spec_zone)
1962               IF(periodic_x)i_inner = i
1963               IF(v(i,k,j+1) .gt. 0.)THEN
1964                 field(i,k,j) = field(i_inner,k,jbe-spec_zone)
1965               ELSE
1966                 field(i,k,j) = 0.
1967               ENDIF
1968             ENDDO
1969           ENDDO
1970         ENDDO
1971       ENDIF
1972
1973     IF(.NOT.periodic_x)THEN
1974       IF (its - ibs .lt. spec_zone) THEN
1975 ! X-start boundary
1976         DO i = its, min(itf,ibs+spec_zone-1)
1977           b_dist = i - ibs
1978           DO k = kts, ktf
1979             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1980               j_inner = max(j,jbs+spec_zone)
1981               j_inner = min(j_inner,jbe-spec_zone)
1982               IF(u(i,k,j) .lt. 0.)THEN
1983                 field(i,k,j) = field(ibs+spec_zone,k,j_inner)
1984               ELSE
1985                 field(i,k,j) = 0.
1986               ENDIF
1987             ENDDO
1988           ENDDO
1989         ENDDO
1990       ENDIF
1991
1992       IF (ibe - itf .lt. spec_zone) THEN
1993 ! X-end boundary
1994         DO i = max(its,ibe-spec_zone+1), itf
1995           b_dist = ibe - i
1996           DO k = kts, ktf
1997             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
1998               j_inner = max(j,jbs+spec_zone)
1999               j_inner = min(j_inner,jbe-spec_zone)
2000               IF(u(i+1,k,j) .gt. 0.)THEN
2001                 field(i,k,j) = field(ibe-spec_zone,k,j_inner)
2002               ELSE
2003                 field(i,k,j) = 0.
2004               ENDIF
2005             ENDDO
2006           ENDDO
2007         ENDDO
2008       ENDIF
2009     ENDIF
2010
2011    END SUBROUTINE flow_dep_bdy
2012
2013 !------------------------------------------------------------------------------
2014
2015  SUBROUTINE stuff_bdy_new ( data3d , space_bdy_xs, space_bdy_xe, space_bdy_ys, space_bdy_ye, &
2016                              char_stagger , &
2017                              spec_bdy_width , &
2018                              ids, ide, jds, jde, kds, kde , &
2019                              ims, ime, jms, jme, kms, kme , &
2020                              its, ite, jts, jte, kts, kte )
2021
2022  !  This routine puts the data in the 3d arrays into the proper locations
2023  !  for the lateral boundary arrays.
2024
2025     USE module_state_description
2026
2027     IMPLICIT NONE
2028
2029     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
2030     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
2031     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
2032     INTEGER , INTENT(IN) :: spec_bdy_width
2033     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3d
2034     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
2035     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
2036     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
2037
2038     INTEGER :: i , ii , j , jj , k
2039
2040     !  There are four lateral boundary locations that are stored.
2041
2042     !  X start boundary
2043
2044     IF ( char_stagger .EQ. 'W' ) THEN
2045        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2046        DO k = kds , kde
2047        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2048           space_bdy_xs(j,k,i) = data3d(i,k,j)
2049        END DO
2050        END DO
2051        END DO
2052     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2053        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2054        DO k = kds , kde
2055        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2056           space_bdy_xs(j,k,i) = data3d(i,k,j)
2057        END DO
2058        END DO
2059        END DO
2060     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2061        DO j = MAX(jds,jts) , MIN(jde,jte)
2062        DO k = kds , kde - 1
2063        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2064           space_bdy_xs(j,k,i) = data3d(i,k,j)
2065        END DO
2066        END DO
2067        END DO
2068     ELSE
2069        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2070        DO k = kds , kde - 1
2071        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2072           space_bdy_xs(j,k,i) = data3d(i,k,j)
2073        END DO
2074        END DO
2075        END DO
2076     END IF
2077
2078     !  X end boundary
2079
2080     IF      ( char_stagger .EQ. 'U' ) THEN
2081        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2082        DO k = kds , kde - 1
2083        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
2084           ii = ide - i + 1
2085           space_bdy_xe(j,k,ii) = data3d(i,k,j)
2086        END DO
2087        END DO
2088        END DO
2089     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2090        DO j = MAX(jds,jts) , MIN(jde,jte)
2091        DO k = kds , kde - 1
2092        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2093           ii = ide - i
2094           space_bdy_xe(j,k,ii) = data3d(i,k,j)
2095        END DO
2096        END DO
2097        END DO
2098     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2099        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2100        DO k = kds , kde
2101        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2102           ii = ide - i
2103           space_bdy_xe(j,k,ii) = data3d(i,k,j)
2104        END DO
2105        END DO
2106        END DO
2107     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2108        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2109        DO k = kds , kde
2110        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2111           ii = ide - i
2112           space_bdy_xe(j,k,ii) = data3d(i,k,j)
2113        END DO
2114        END DO
2115        END DO
2116     ELSE
2117        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2118        DO k = kds , kde - 1
2119        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2120           ii = ide - i
2121           space_bdy_xe(j,k,ii) = data3d(i,k,j)
2122        END DO
2123        END DO
2124        END DO
2125     END IF
2126
2127     !  Y start boundary
2128
2129     IF ( char_stagger .EQ. 'W' ) THEN
2130        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2131        DO k = kds , kde
2132        DO i = MAX(ids,its) , MIN(ide-1,ite)
2133           space_bdy_ys(i,k,j) = data3d(i,k,j)
2134        END DO
2135        END DO
2136        END DO
2137     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2138        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2139        DO k = kds , kde
2140        DO i = MAX(ids,its) , MIN(ide-1,ite)
2141           space_bdy_ys(i,k,j) = data3d(i,k,j)
2142        END DO
2143        END DO
2144        END DO
2145     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2146        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2147        DO k = kds , kde - 1
2148        DO i = MAX(ids,its) , MIN(ide,ite)
2149           space_bdy_ys(i,k,j) = data3d(i,k,j)
2150        END DO
2151        END DO
2152        END DO
2153     ELSE
2154        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2155        DO k = kds , kde - 1
2156        DO i = MAX(ids,its) , MIN(ide-1,ite)
2157           space_bdy_ys(i,k,j) = data3d(i,k,j)
2158        END DO
2159        END DO
2160        END DO
2161     END IF
2162
2163     !  Y end boundary
2164
2165     IF      ( char_stagger .EQ. 'V' ) THEN
2166        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
2167        DO k = kds , kde - 1
2168        DO i = MAX(ids,its) , MIN(ide-1,ite)
2169           jj = jde - j + 1
2170           space_bdy_ye(i,k,jj) = data3d(i,k,j)
2171        END DO
2172        END DO
2173        END DO
2174     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2175        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2176        DO k = kds , kde - 1
2177        DO i = MAX(ids,its) , MIN(ide,ite)
2178           jj = jde - j
2179           space_bdy_ye(i,k,jj) = data3d(i,k,j)
2180        END DO
2181        END DO
2182        END DO
2183     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2184        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2185        DO k = kds , kde
2186        DO i = MAX(ids,its) , MIN(ide-1,ite)
2187           jj = jde - j
2188           space_bdy_ye(i,k,jj) = data3d(i,k,j)
2189        END DO
2190        END DO
2191        END DO
2192     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2193        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2194        DO k = kds , kde
2195        DO i = MAX(ids,its) , MIN(ide-1,ite)
2196           jj = jde - j
2197           space_bdy_ye(i,k,jj) = data3d(i,k,j)
2198        END DO
2199        END DO
2200        END DO
2201     ELSE
2202        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2203        DO k = kds , kde - 1
2204        DO i = MAX(ids,its) , MIN(ide-1,ite)
2205           jj = jde - j
2206           space_bdy_ye(i,k,jj) = data3d(i,k,j)
2207        END DO
2208        END DO
2209        END DO
2210     END IF
2211
2212  END SUBROUTINE stuff_bdy_new
2213
2214  SUBROUTINE stuff_bdytend_new ( data3dnew , data3dold , time_diff , &
2215                              space_bdy_xs, space_bdy_xe, space_bdy_ys, space_bdy_ye, &
2216                              char_stagger , &
2217                              spec_bdy_width , &
2218                              ids, ide, jds, jde, kds, kde , &
2219                              ims, ime, jms, jme, kms, kme , &
2220                              its, ite, jts, jte, kts, kte )
2221
2222  !  This routine puts the tendency data into the proper locations
2223  !  for the lateral boundary arrays.
2224
2225     USE module_state_description
2226
2227     IMPLICIT NONE
2228
2229     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
2230     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
2231     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
2232     INTEGER , INTENT(IN) :: spec_bdy_width
2233     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
2234     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
2235     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
2236     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
2237     REAL , INTENT(IN) :: time_diff ! seconds
2238
2239     INTEGER :: i , ii , j , jj , k
2240
2241     !  There are four lateral boundary locations that are stored.
2242
2243     !  X start boundary
2244
2245     IF ( char_stagger .EQ. 'W' ) THEN
2246        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2247        DO k = kds , kde
2248        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2249           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2250        END DO
2251        END DO
2252        END DO
2253     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2254        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2255        DO k = kds , kde
2256        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2257           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2258        END DO
2259        END DO
2260        END DO
2261     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2262        DO j = MAX(jds,jts) , MIN(jde,jte)
2263        DO k = kds , kde - 1
2264        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2265           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2266        END DO
2267        END DO
2268        END DO
2269     ELSE
2270        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2271        DO k = kds , kde - 1
2272        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2273           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2274        END DO
2275        END DO
2276        END DO
2277     END IF
2278
2279     !  X end boundary
2280
2281     IF      ( char_stagger .EQ. 'U' ) THEN
2282        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2283        DO k = kds , kde - 1
2284        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
2285           ii = ide - i + 1
2286           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2287        END DO
2288        END DO
2289        END DO
2290     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2291        DO j = MAX(jds,jts) , MIN(jde,jte)
2292        DO k = kds , kde - 1
2293        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2294           ii = ide - i
2295           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2296        END DO
2297        END DO
2298        END DO
2299     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2300        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2301        DO k = kds , kde
2302        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2303           ii = ide - i
2304           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2305        END DO
2306        END DO
2307        END DO
2308     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2309        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2310        DO k = kds , kde
2311        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2312           ii = ide - i
2313           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2314        END DO
2315        END DO
2316        END DO
2317     ELSE
2318        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2319        DO k = kds , kde - 1
2320        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2321           ii = ide - i
2322           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2323        END DO
2324        END DO
2325        END DO
2326     END IF
2327
2328     !  Y start boundary
2329
2330     IF ( char_stagger .EQ. 'W' ) THEN
2331        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2332        DO k = kds , kde
2333        DO i = MAX(ids,its) , MIN(ide-1,ite)
2334           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2335        END DO
2336        END DO
2337        END DO
2338     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2339        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2340        DO k = kds , kde
2341        DO i = MAX(ids,its) , MIN(ide-1,ite)
2342           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2343        END DO
2344        END DO
2345        END DO
2346     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2347        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2348        DO k = kds , kde - 1
2349        DO i = MAX(ids,its) , MIN(ide,ite)
2350           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2351        END DO
2352        END DO
2353        END DO
2354     ELSE
2355        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2356        DO k = kds , kde - 1
2357        DO i = MAX(ids,its) , MIN(ide-1,ite)
2358           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2359        END DO
2360        END DO
2361        END DO
2362     END IF
2363
2364     !  Y end boundary
2365
2366     IF      ( char_stagger .EQ. 'V' ) THEN
2367        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
2368        DO k = kds , kde - 1
2369        DO i = MAX(ids,its) , MIN(ide-1,ite)
2370           jj = jde - j + 1
2371           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2372        END DO
2373        END DO
2374        END DO
2375     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2376        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2377        DO k = kds , kde - 1
2378        DO i = MAX(ids,its) , MIN(ide,ite)
2379           jj = jde - j
2380           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2381        END DO
2382        END DO
2383        END DO
2384     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2385        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2386        DO k = kds , kde
2387        DO i = MAX(ids,its) , MIN(ide-1,ite)
2388           jj = jde - j
2389           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2390        END DO
2391        END DO
2392        END DO
2393     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2394        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2395        DO k = kds , kde
2396        DO i = MAX(ids,its) , MIN(ide-1,ite)
2397           jj = jde - j
2398           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2399        END DO
2400        END DO
2401        END DO
2402     ELSE
2403        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2404        DO k = kds , kde - 1
2405        DO i = MAX(ids,its) , MIN(ide-1,ite)
2406           jj = jde - j
2407           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2408        END DO
2409        END DO
2410        END DO
2411     END IF
2412
2413  END SUBROUTINE stuff_bdytend_new
2414
2415 !--- old versions for use with modules that use the old bdy data structures ---
2416
2417  SUBROUTINE stuff_bdy_old ( data3d , space_bdy , char_stagger , &
2418                              ijds , ijde , spec_bdy_width , &
2419                              ids, ide, jds, jde, kds, kde , &
2420                              ims, ime, jms, jme, kms, kme , &
2421                              its, ite, jts, jte, kts, kte )
2422
2423  !  This routine puts the data in the 3d arrays into the proper locations
2424  !  for the lateral boundary arrays.
2425
2426     USE module_state_description
2427
2428     IMPLICIT NONE
2429
2430     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
2431     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
2432     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
2433     INTEGER , INTENT(IN) :: ijds , ijde , spec_bdy_width
2434     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3d
2435     REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4) , INTENT(OUT) :: space_bdy
2436     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
2437
2438     INTEGER :: i , ii , j , jj , k
2439
2440     !  There are four lateral boundary locations that are stored.
2441
2442     !  X start boundary
2443
2444     IF ( char_stagger .EQ. 'W' ) THEN
2445        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2446        DO k = kds , kde
2447        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2448           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
2449        END DO
2450        END DO
2451        END DO
2452     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2453        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2454        DO k = kds , kde
2455        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2456           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
2457        END DO
2458        END DO
2459        END DO
2460     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2461        DO j = MAX(jds,jts) , MIN(jde,jte)
2462        DO k = kds , kde - 1
2463        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2464           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
2465        END DO
2466        END DO
2467        END DO
2468     ELSE
2469        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2470        DO k = kds , kde - 1
2471        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2472           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
2473        END DO
2474        END DO
2475        END DO
2476     END IF
2477
2478     !  X end boundary
2479
2480     IF      ( char_stagger .EQ. 'U' ) THEN
2481        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2482        DO k = kds , kde - 1
2483        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
2484           ii = ide - i + 1
2485           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
2486        END DO
2487        END DO
2488        END DO
2489     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2490        DO j = MAX(jds,jts) , MIN(jde,jte)
2491        DO k = kds , kde - 1
2492        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2493           ii = ide - i
2494           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
2495        END DO
2496        END DO
2497        END DO
2498     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2499        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2500        DO k = kds , kde
2501        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2502           ii = ide - i
2503           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
2504        END DO
2505        END DO
2506        END DO
2507     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2508        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2509        DO k = kds , kde
2510        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2511           ii = ide - i
2512           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
2513        END DO
2514        END DO
2515        END DO
2516     ELSE
2517        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2518        DO k = kds , kde - 1
2519        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2520           ii = ide - i
2521           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
2522        END DO
2523        END DO
2524        END DO
2525     END IF
2526
2527     !  Y start boundary
2528
2529     IF ( char_stagger .EQ. 'W' ) THEN
2530        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2531        DO k = kds , kde
2532        DO i = MAX(ids,its) , MIN(ide-1,ite)
2533           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
2534        END DO
2535        END DO
2536        END DO
2537     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2538        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2539        DO k = kds , kde
2540        DO i = MAX(ids,its) , MIN(ide-1,ite)
2541           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
2542        END DO
2543        END DO
2544        END DO
2545     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2546        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2547        DO k = kds , kde - 1
2548        DO i = MAX(ids,its) , MIN(ide,ite)
2549           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
2550        END DO
2551        END DO
2552        END DO
2553     ELSE
2554        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2555        DO k = kds , kde - 1
2556        DO i = MAX(ids,its) , MIN(ide-1,ite)
2557           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
2558        END DO
2559        END DO
2560        END DO
2561     END IF
2562
2563     !  Y end boundary
2564
2565     IF      ( char_stagger .EQ. 'V' ) THEN
2566        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
2567        DO k = kds , kde - 1
2568        DO i = MAX(ids,its) , MIN(ide-1,ite)
2569           jj = jde - j + 1
2570           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
2571        END DO
2572        END DO
2573        END DO
2574     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2575        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2576        DO k = kds , kde - 1
2577        DO i = MAX(ids,its) , MIN(ide,ite)
2578           jj = jde - j
2579           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
2580        END DO
2581        END DO
2582        END DO
2583     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2584        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2585        DO k = kds , kde
2586        DO i = MAX(ids,its) , MIN(ide-1,ite)
2587           jj = jde - j
2588           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
2589        END DO
2590        END DO
2591        END DO
2592     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2593        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2594        DO k = kds , kde
2595        DO i = MAX(ids,its) , MIN(ide-1,ite)
2596           jj = jde - j
2597           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
2598        END DO
2599        END DO
2600        END DO
2601     ELSE
2602        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2603        DO k = kds , kde - 1
2604        DO i = MAX(ids,its) , MIN(ide-1,ite)
2605           jj = jde - j
2606           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
2607        END DO
2608        END DO
2609        END DO
2610     END IF
2611
2612  END SUBROUTINE stuff_bdy_old
2613
2614  SUBROUTINE stuff_bdytend_old ( data3dnew , data3dold , time_diff , space_bdy , char_stagger , &
2615                              ijds , ijde , spec_bdy_width , &
2616                              ids, ide, jds, jde, kds, kde , &
2617                              ims, ime, jms, jme, kms, kme , &
2618                              its, ite, jts, jte, kts, kte )
2619
2620  !  This routine puts the tendency data into the proper locations
2621  !  for the lateral boundary arrays.
2622
2623     USE module_state_description
2624
2625     IMPLICIT NONE
2626
2627     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
2628     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
2629     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
2630     INTEGER , INTENT(IN) :: ijds , ijde , spec_bdy_width
2631     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
2632 !    REAL , DIMENSION(:,:,:,:) , INTENT(OUT) :: space_bdy
2633     REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4) , INTENT(OUT) :: space_bdy
2634     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
2635     REAL , INTENT(IN) :: time_diff ! seconds
2636
2637     INTEGER :: i , ii , j , jj , k
2638
2639     !  There are four lateral boundary locations that are stored.
2640
2641     !  X start boundary
2642
2643     IF ( char_stagger .EQ. 'W' ) THEN
2644        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2645        DO k = kds , kde
2646        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2647           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2648 !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
2649        END DO
2650        END DO
2651        END DO
2652     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2653        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2654        DO k = kds , kde
2655        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2656           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2657 !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
2658        END DO
2659        END DO
2660        END DO
2661     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2662        DO j = MAX(jds,jts) , MIN(jde,jte)
2663        DO k = kds , kde - 1
2664        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2665           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2666 !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
2667        END DO
2668        END DO
2669        END DO
2670     ELSE
2671        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2672        DO k = kds , kde - 1
2673        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2674           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2675 !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
2676        END DO
2677        END DO
2678        END DO
2679     END IF
2680
2681     !  X end boundary
2682
2683     IF      ( char_stagger .EQ. 'U' ) THEN
2684        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2685        DO k = kds , kde - 1
2686        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
2687           ii = ide - i + 1
2688           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2689 !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
2690        END DO
2691        END DO
2692        END DO
2693     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2694        DO j = MAX(jds,jts) , MIN(jde,jte)
2695        DO k = kds , kde - 1
2696        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2697           ii = ide - i
2698           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2699 !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
2700        END DO
2701        END DO
2702        END DO
2703     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2704        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2705        DO k = kds , kde
2706        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2707           ii = ide - i
2708           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2709 !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
2710        END DO
2711        END DO
2712        END DO
2713     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2714        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2715        DO k = kds , kde
2716        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2717           ii = ide - i
2718           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2719 !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
2720        END DO
2721        END DO
2722        END DO
2723     ELSE
2724        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2725        DO k = kds , kde - 1
2726        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2727           ii = ide - i
2728           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2729 !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
2730        END DO
2731        END DO
2732        END DO
2733     END IF
2734
2735     !  Y start boundary
2736
2737     IF ( char_stagger .EQ. 'W' ) THEN
2738        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2739        DO k = kds , kde
2740        DO i = MAX(ids,its) , MIN(ide-1,ite)
2741           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2742 !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
2743        END DO
2744        END DO
2745        END DO
2746     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2747        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2748        DO k = kds , kde
2749        DO i = MAX(ids,its) , MIN(ide-1,ite)
2750           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2751 !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
2752        END DO
2753        END DO
2754        END DO
2755     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2756        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2757        DO k = kds , kde - 1
2758        DO i = MAX(ids,its) , MIN(ide,ite)
2759           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2760 !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
2761        END DO
2762        END DO
2763        END DO
2764     ELSE
2765        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2766        DO k = kds , kde - 1
2767        DO i = MAX(ids,its) , MIN(ide-1,ite)
2768           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2769 !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
2770        END DO
2771        END DO
2772        END DO
2773     END IF
2774
2775     !  Y end boundary
2776
2777     IF      ( char_stagger .EQ. 'V' ) THEN
2778        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
2779        DO k = kds , kde - 1
2780        DO i = MAX(ids,its) , MIN(ide-1,ite)
2781           jj = jde - j + 1
2782           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2783 !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
2784        END DO
2785        END DO
2786        END DO
2787     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2788        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2789        DO k = kds , kde - 1
2790        DO i = MAX(ids,its) , MIN(ide,ite)
2791           jj = jde - j
2792           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2793 !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
2794        END DO
2795        END DO
2796        END DO
2797     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2798        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2799        DO k = kds , kde
2800        DO i = MAX(ids,its) , MIN(ide-1,ite)
2801           jj = jde - j
2802           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2803 !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
2804        END DO
2805        END DO
2806        END DO
2807     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2808        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2809        DO k = kds , kde
2810        DO i = MAX(ids,its) , MIN(ide-1,ite)
2811           jj = jde - j
2812           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2813 !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
2814        END DO
2815        END DO
2816        END DO
2817     ELSE
2818        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2819        DO k = kds , kde - 1
2820        DO i = MAX(ids,its) , MIN(ide-1,ite)
2821           jj = jde - j
2822           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
2823 !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
2824        END DO
2825        END DO
2826        END DO
2827     END IF
2828
2829  END SUBROUTINE stuff_bdytend_old
2830
2831  SUBROUTINE stuff_bdy_ijk ( data3d , space_bdy_xs, space_bdy_xe, &
2832                              space_bdy_ys, space_bdy_ye, &
2833                              char_stagger , spec_bdy_width, &
2834                              ids, ide, jds, jde, kds, kde , &
2835                              ims, ime, jms, jme, kms, kme , &
2836                              its, ite, jts, jte, kts, kte )
2837
2838  !  This routine puts the data in the 3d arrays into the proper locations
2839  !  for the lateral boundary arrays.
2840
2841     USE module_state_description
2842
2843     IMPLICIT NONE
2844
2845     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
2846     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
2847     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
2848     INTEGER , INTENT(IN) :: spec_bdy_width
2849     REAL , DIMENSION(ims:ime,jms:jme,kms:kme) , INTENT(IN) :: data3d
2850 !    REAL , DIMENSION(:,:,:,:) , INTENT(OUT) :: space_bdy
2851 !    REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4,1) , INTENT(OUT) :: space_bdy
2852     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
2853     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
2854     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
2855
2856     INTEGER :: i , ii , j , jj , k
2857
2858     !  There are four lateral boundary locations that are stored.
2859
2860     !  X start boundary
2861
2862     IF ( char_stagger .EQ. 'W' ) THEN
2863        DO k = kds , kde
2864        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2865        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2866           space_bdy_xs(j,k,i) = data3d(i,j,k)
2867        END DO
2868        END DO
2869        END DO
2870     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2871        DO k = kds , kde
2872        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2873        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2874           space_bdy_xs(j,k,i) = data3d(i,j,k)
2875        END DO
2876        END DO
2877        END DO
2878     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2879        DO k = kds , kde - 1
2880        DO j = MAX(jds,jts) , MIN(jde,jte)
2881        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2882           space_bdy_xs(j,k,i) = data3d(i,j,k)
2883        END DO
2884        END DO
2885        END DO
2886     ELSE
2887        DO k = kds , kde - 1
2888        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2889        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
2890           space_bdy_xs(j,k,i) = data3d(i,j,k)
2891        END DO
2892        END DO
2893        END DO
2894     END IF
2895
2896     !  X end boundary
2897
2898     IF      ( char_stagger .EQ. 'U' ) THEN
2899        DO k = kds , kde - 1
2900        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2901        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
2902           ii = ide - i + 1
2903           space_bdy_xe(j,k,ii) = data3d(i,j,k)
2904        END DO
2905        END DO
2906        END DO
2907     ELSE IF ( char_stagger .EQ. 'V' ) THEN
2908        DO k = kds , kde - 1
2909        DO j = MAX(jds,jts) , MIN(jde,jte)
2910        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2911           ii = ide - i
2912           space_bdy_xe(j,k,ii) = data3d(i,j,k)
2913        END DO
2914        END DO
2915        END DO
2916     ELSE IF ( char_stagger .EQ. 'W' ) THEN
2917        DO k = kds , kde
2918        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2919        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2920           ii = ide - i
2921           space_bdy_xe(j,k,ii) = data3d(i,j,k)
2922        END DO
2923        END DO
2924        END DO
2925     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2926        DO k = kds , kde
2927        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2928        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2929           ii = ide - i
2930           space_bdy_xe(j,k,ii) = data3d(i,j,k)
2931        END DO
2932        END DO
2933        END DO
2934     ELSE
2935        DO k = kds , kde - 1
2936        DO j = MAX(jds,jts) , MIN(jde-1,jte)
2937        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
2938           ii = ide - i
2939           space_bdy_xe(j,k,ii) = data3d(i,j,k)
2940        END DO
2941        END DO
2942        END DO
2943     END IF
2944
2945     !  Y start boundary
2946
2947     IF ( char_stagger .EQ. 'W' ) THEN
2948        DO k = kds , kde
2949        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2950        DO i = MAX(ids,its) , MIN(ide-1,ite)
2951           space_bdy_ys(i,k,j) = data3d(i,j,k)
2952        END DO
2953        END DO
2954        END DO
2955     ELSE IF ( char_stagger .EQ. 'M' ) THEN
2956        DO k = kds , kde
2957        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2958        DO i = MAX(ids,its) , MIN(ide-1,ite)
2959           space_bdy_ys(i,k,j) = data3d(i,j,k)
2960        END DO
2961        END DO
2962        END DO
2963     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2964        DO k = kds , kde - 1
2965        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2966        DO i = MAX(ids,its) , MIN(ide,ite)
2967           space_bdy_ys(i,k,j) = data3d(i,j,k)
2968        END DO
2969        END DO
2970        END DO
2971     ELSE
2972        DO k = kds , kde - 1
2973        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
2974        DO i = MAX(ids,its) , MIN(ide-1,ite)
2975           space_bdy_ys(i,k,j) = data3d(i,j,k)
2976        END DO
2977        END DO
2978        END DO
2979     END IF
2980
2981     !  Y end boundary
2982
2983     IF      ( char_stagger .EQ. 'V' ) THEN
2984        DO k = kds , kde - 1
2985        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
2986        DO i = MAX(ids,its) , MIN(ide-1,ite)
2987           jj = jde - j + 1
2988           space_bdy_ye(i,k,jj) = data3d(i,j,k)
2989        END DO
2990        END DO
2991        END DO
2992     ELSE IF ( char_stagger .EQ. 'U' ) THEN
2993        DO k = kds , kde - 1
2994        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
2995        DO i = MAX(ids,its) , MIN(ide,ite)
2996           jj = jde - j
2997           space_bdy_ye(i,k,jj) = data3d(i,j,k)
2998        END DO
2999        END DO
3000        END DO
3001     ELSE IF ( char_stagger .EQ. 'W' ) THEN
3002        DO k = kds , kde
3003        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3004        DO i = MAX(ids,its) , MIN(ide-1,ite)
3005           jj = jde - j
3006           space_bdy_ye(i,k,jj) = data3d(i,j,k)
3007        END DO
3008        END DO
3009        END DO
3010     ELSE IF ( char_stagger .EQ. 'M' ) THEN
3011        DO k = kds , kde
3012        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3013        DO i = MAX(ids,its) , MIN(ide-1,ite)
3014           jj = jde - j
3015           space_bdy_ye(i,k,jj) = data3d(i,j,k)
3016        END DO
3017        END DO
3018        END DO
3019     ELSE
3020        DO k = kds , kde - 1
3021        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3022        DO i = MAX(ids,its) , MIN(ide-1,ite)
3023           jj = jde - j
3024           space_bdy_ye(i,k,jj) = data3d(i,j,k)
3025 !        if (K .eq. 54 .and. I .eq. 369) then
3026 !       write(0,*) 'N bound i,k,jj,P_YEB,data3d,space_bdy: ', i,k,jj,P_YEB,data3d(I,j,k),space_bdy(i,k,jj,P_YEB,1)
3027 !       endif
3028
3029        END DO
3030        END DO
3031        END DO
3032     END IF
3033
3034  END SUBROUTINE stuff_bdy_ijk
3035
3036  SUBROUTINE stuff_bdytend_ijk ( data3dnew , data3dold , time_diff , &
3037                              space_bdy_xs, space_bdy_xe, space_bdy_ys, space_bdy_ye, &
3038                              char_stagger , &
3039                              spec_bdy_width , &
3040                              ids, ide, jds, jde, kds, kde , &
3041                              ims, ime, jms, jme, kms, kme , &
3042                              its, ite, jts, jte, kts, kte )
3043
3044  !  This routine puts the tendency data into the proper locations
3045  !  for the lateral boundary arrays.
3046
3047     USE module_state_description
3048
3049     IMPLICIT NONE
3050
3051     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
3052     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
3053     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
3054     INTEGER , INTENT(IN) :: spec_bdy_width
3055 !    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
3056     REAL , DIMENSION(ims:ime,jms:jme,kms:kme) , INTENT(IN) :: data3dnew , data3dold
3057     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
3058     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
3059
3060     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
3061     REAL , INTENT(IN) :: time_diff ! seconds
3062
3063     INTEGER :: i , ii , j , jj , k
3064
3065     !  There are four lateral boundary locations that are stored.
3066
3067     !  X start boundary
3068
3069     IF ( char_stagger .EQ. 'W' ) THEN
3070        DO k = kds , kde
3071        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3072        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
3073           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3074        END DO
3075        END DO
3076        END DO
3077     ELSE IF ( char_stagger .EQ. 'M' ) THEN
3078        DO k = kds , kde
3079        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3080        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
3081           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3082        END DO
3083        END DO
3084        END DO
3085     ELSE IF ( char_stagger .EQ. 'V' ) THEN
3086        DO k = kds , kde - 1
3087        DO j = MAX(jds,jts) , MIN(jde,jte)
3088        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
3089           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3090        END DO
3091        END DO
3092        END DO
3093     ELSE
3094        DO k = kds , kde - 1
3095        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3096        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
3097           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3098        END DO
3099        END DO
3100        END DO
3101     END IF
3102
3103     !  X end boundary
3104
3105     IF      ( char_stagger .EQ. 'U' ) THEN
3106        DO k = kds , kde - 1
3107        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3108        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
3109           ii = ide - i + 1
3110           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3111        END DO
3112        END DO
3113        END DO
3114     ELSE IF ( char_stagger .EQ. 'V' ) THEN
3115        DO k = kds , kde - 1
3116        DO j = MAX(jds,jts) , MIN(jde,jte)
3117        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
3118           ii = ide - i
3119           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3120        END DO
3121        END DO
3122        END DO
3123     ELSE IF ( char_stagger .EQ. 'W' ) THEN
3124        DO k = kds , kde
3125        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3126        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
3127           ii = ide - i
3128           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3129        END DO
3130        END DO
3131        END DO
3132     ELSE IF ( char_stagger .EQ. 'M' ) THEN
3133        DO k = kds , kde
3134        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3135        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
3136           ii = ide - i
3137           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3138        END DO
3139        END DO
3140        END DO
3141     ELSE
3142        DO k = kds , kde - 1
3143        DO j = MAX(jds,jts) , MIN(jde-1,jte)
3144        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
3145           ii = ide - i
3146           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3147        END DO
3148        END DO
3149        END DO
3150     END IF
3151
3152     !  Y start boundary
3153
3154     IF ( char_stagger .EQ. 'W' ) THEN
3155        DO k = kds , kde
3156        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
3157        DO i = MAX(ids,its) , MIN(ide-1,ite)
3158           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3159        END DO
3160        END DO
3161        END DO
3162     ELSE IF ( char_stagger .EQ. 'M' ) THEN
3163        DO k = kds , kde
3164        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
3165        DO i = MAX(ids,its) , MIN(ide-1,ite)
3166           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3167        END DO
3168        END DO
3169        END DO
3170     ELSE IF ( char_stagger .EQ. 'U' ) THEN
3171        DO k = kds , kde - 1
3172        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
3173        DO i = MAX(ids,its) , MIN(ide,ite)
3174           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3175        END DO
3176        END DO
3177        END DO
3178     ELSE
3179        DO k = kds , kde - 1
3180        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
3181        DO i = MAX(ids,its) , MIN(ide-1,ite)
3182           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3183        END DO
3184        END DO
3185        END DO
3186     END IF
3187
3188     !  Y end boundary
3189
3190     IF      ( char_stagger .EQ. 'V' ) THEN
3191        DO k = kds , kde - 1
3192        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
3193        DO i = MAX(ids,its) , MIN(ide-1,ite)
3194           jj = jde - j + 1
3195           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3196        END DO
3197        END DO
3198        END DO
3199     ELSE IF ( char_stagger .EQ. 'U' ) THEN
3200        DO k = kds , kde - 1
3201        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3202        DO i = MAX(ids,its) , MIN(ide,ite)
3203           jj = jde - j
3204           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3205        END DO
3206        END DO
3207        END DO
3208     ELSE IF ( char_stagger .EQ. 'W' ) THEN
3209        DO k = kds , kde
3210        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3211        DO i = MAX(ids,its) , MIN(ide-1,ite)
3212           jj = jde - j
3213           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3214        END DO
3215        END DO
3216        END DO
3217     ELSE IF ( char_stagger .EQ. 'M' ) THEN
3218        DO k = kds , kde
3219        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3220        DO i = MAX(ids,its) , MIN(ide-1,ite)
3221           jj = jde - j
3222           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3223        END DO
3224        END DO
3225        END DO
3226     ELSE
3227        DO k = kds , kde - 1
3228        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
3229        DO i = MAX(ids,its) , MIN(ide-1,ite)
3230           jj = jde - j
3231           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
3232 !        if (K .eq. 54 .and. I .eq. 369) then
3233 !       write(0,*) 'N bound i,k,jj,data3dnew,data3dold: ', i,k,jj,data3dnew(I,j,k),data3dold(i,j,k)
3234 !       endif
3235        END DO
3236        END DO
3237        END DO
3238     END IF
3239
3240  END SUBROUTINE stuff_bdytend_ijk
3241
3242 END MODULE module_bc
3243
3244 SUBROUTINE get_bdyzone_x ( bzx )
3245   USE module_bc
3246   IMPLICIT NONE
3247   INTEGER bzx
3248   bzx = bdyzone_x
3249 END SUBROUTINE get_bdyzone_x
3250
3251 SUBROUTINE get_bdyzone_y ( bzy)
3252   USE module_bc
3253   IMPLICIT NONE
3254   INTEGER bzy
3255   bzy = bdyzone_y
3256 END SUBROUTINE get_bdyzone_y
3257
3258 SUBROUTINE get_bdyzone ( bz)
3259   USE module_bc
3260   IMPLICIT NONE
3261   INTEGER bz
3262   bz = bdyzone
3263 END SUBROUTINE get_bdyzone