PageRenderTime 67ms CodeModel.GetById 17ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/share/module_bc.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 3400 lines | 2558 code | 521 blank | 321 comment | 148 complexity | 29e913f4d91363971266041ed6c69a14 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. !WRF:MODEL_LAYER:BOUNDARY
    2. 

  2. !
    3. 

  3. 

  4. MODULE module_bc
    5. 

  5. 

  6.    USE module_configure
    7. 

  7.    USE module_wrf_error
    8. 

  8.    USE module_model_constants
    9. 

  9.    IMPLICIT NONE
    10. 

  10. 

  11. !   TYPE bcs
    12. 

  12. !
    13. 

  13. !     LOGICAL                     :: periodic_x
    14. 

  14. !     LOGICAL                     :: symmetric_xs
    15. 

  15. !     LOGICAL                     :: symmetric_xe
    16. 

  16. !     LOGICAL                     :: open_xs
    17. 

  17. !     LOGICAL                     :: open_xe
    18. 

  18. !     LOGICAL                     :: periodic_y
    19. 

  19. !     LOGICAL                     :: symmetric_ys
    20. 

  20. !     LOGICAL                     :: symmetric_ye
    21. 

  21. !     LOGICAL                     :: open_ys
    22. 

  22. !     LOGICAL                     :: open_ye
    23. 

  23. !     LOGICAL                     :: nested
    24. 

  24. !     LOGICAL                     :: specified
    25. 

  25. !     LOGICAL                     :: top_radiation
    26. 

  26. !
    27. 

  27. !   END TYPE bcs
    28. 

  28. 

  29. !  set the bdyzone.  We are hardwiring this here and we'll
    30. 

  30. !  decide later where it should be set and stored
    31. 

  31. 

  32.    INTEGER, PARAMETER            :: bdyzone = 4
    33. 

  33.    INTEGER, PARAMETER            :: bdyzone_x = bdyzone
    34. 

  34.    INTEGER, PARAMETER            :: bdyzone_y = bdyzone
    35. 

  35. 

  36.    INTERFACE stuff_bdy
    37. 

  37.      MODULE PROCEDURE stuff_bdy_new , stuff_bdy_old
    38. 

  38.    END INTERFACE
    39. 

  39. 

  40.    INTERFACE stuff_bdytend
    41. 

  41.      MODULE PROCEDURE stuff_bdytend_new , stuff_bdytend_old
    42. 

  42.    END INTERFACE
    43. 

  43. 

  44. CONTAINS
    45. 

  45. 

  46.   SUBROUTINE boundary_condition_check ( config_flags, bzone, error, gn )
    47. 

  47. 

  48. !  this routine checks the boundary condition logicals 
    49. 

  49. !  to make sure that the boundary conditions are not over
    50. 

  50. !  or under specified.  The routine also checks that the
    51. 

  51. !  boundary zone is sufficiently sized for the specified
    52. 

  52. !  boundary conditions
    53. 

  53. 

  54.   IMPLICIT NONE
    55. 

  55. 

  56.   TYPE( grid_config_rec_type ) config_flags
    57. 

  57. 

  58.   INTEGER, INTENT(IN   ) :: bzone, gn
    59. 

  59.   INTEGER, INTENT(INOUT) :: error
    60. 

  60. 

  61. ! local variables
    62. 

  62. 

  63.   INTEGER :: xs_bc, xe_bc, ys_bc, ye_bc, bzone_min
    64. 

  64.   INTEGER :: nprocx, nprocy
    65. 

  65. 

  66.   CALL wrf_debug( 100 , ' checking boundary conditions for grid ' )
    67. 

  67. 

  68.   error = 0
    69. 

  69.   xs_bc = 0
    70. 

  70.   xe_bc = 0
    71. 

  71.   ys_bc = 0
    72. 

  72.   ye_bc = 0
    73. 

  73. 

  74. !  sum the number of conditions specified for each lateral boundary.
    75. 

  75. !  obviously, this number should be 1
    76. 

  76. 

  77.   IF( config_flags%periodic_x ) THEN
    78. 

  78.     xs_bc = xs_bc+1
    79. 

  79.     xe_bc = xe_bc+1
    80. 

  80.   ENDIF
    81. 

  81. 

  82.   IF( config_flags%periodic_y ) THEN
    83. 

  83.     ys_bc = ys_bc+1
    84. 

  84.     ye_bc = ye_bc+1
    85. 

  85.   ENDIF
    86. 

  86. 

  87.   IF( config_flags%symmetric_xs ) xs_bc = xs_bc + 1
    88. 

  88.   IF( config_flags%symmetric_xe ) xe_bc = xe_bc + 1
    89. 

  89.   IF( config_flags%open_xs )      xs_bc = xs_bc + 1
    90. 

  90.   IF( config_flags%open_xe )      xe_bc = xe_bc + 1
    91. 

  91. 

  92. 

  93.   IF( config_flags%symmetric_ys ) ys_bc = ys_bc + 1
    94. 

  94.   IF( config_flags%symmetric_ye ) ye_bc = ye_bc + 1
    95. 

  95.   IF( config_flags%open_ys )      ys_bc = ys_bc + 1
    96. 

  96.   IF( config_flags%open_ye )      ye_bc = ye_bc + 1
    97. 

  97. 

  98.   IF( config_flags%nested ) THEN
    99. 

  99.      xs_bc = xs_bc + 1
    100. 

  100.      xe_bc = xe_bc + 1
    101. 

  101.      ys_bc = ys_bc + 1
    102. 

  102.      ye_bc = ye_bc + 1
    103. 

  103.    ENDIF
    104. 

  104. 

  105.   IF( config_flags%specified ) THEN
    106. 

  106.      IF( .NOT. config_flags%periodic_x)xs_bc = xs_bc + 1
    107. 

  107.      IF( .NOT. config_flags%periodic_x)xe_bc = xe_bc + 1
    108. 

  108.      ys_bc = ys_bc + 1
    109. 

  109.      ye_bc = ye_bc + 1
    110. 

  110.    ENDIF
    111. 

  111. 

  112.   IF( config_flags%polar ) THEN
    113. 

  113.      ys_bc = ys_bc + 1
    114. 

  114.      ye_bc = ye_bc + 1
    115. 

  115.    ENDIF
    116. 

  116. 

  117. !  check the number of conditions for each boundary
    118. 

  118. 

  119.    IF( (xs_bc /= 1) .or. &
    120. 

  120.        (xe_bc /= 1) .or. &
    121. 

  121.        (ys_bc /= 1) .or. &
    122. 

  122.        (ye_bc /= 1)         ) THEN
    123. 

  123. 

  124.      error = 1
    125. 

  125. 

  126.      write( wrf_err_message ,*) ' *** Error in boundary condition specification '
    127. 

  127.      CALL wrf_message ( wrf_err_message )
    128. 

  128.      write( wrf_err_message ,*) ' boundary conditions at xs ', xs_bc
    129. 

  129.      CALL wrf_message ( wrf_err_message )
    130. 

  130.      write( wrf_err_message ,*) ' boundary conditions at xe ', xe_bc
    131. 

  131.      CALL wrf_message ( wrf_err_message )
    132. 

  132.      write( wrf_err_message ,*) ' boundary conditions at ys ', ys_bc
    133. 

  133.      CALL wrf_message ( wrf_err_message )
    134. 

  134.      write( wrf_err_message ,*) ' boundary conditions at ye ', ye_bc
    135. 

  135.      CALL wrf_message ( wrf_err_message )
    136. 

  136.      write( wrf_err_message ,*) ' boundary conditions logicals are '
    137. 

  137.      CALL wrf_message ( wrf_err_message )
    138. 

  138.      write( wrf_err_message ,*) ' periodic_x   ',config_flags%periodic_x
    139. 

  139.      CALL wrf_message ( wrf_err_message )
    140. 

  140.      write( wrf_err_message ,*) ' periodic_y   ',config_flags%periodic_y
    141. 

  141.      CALL wrf_message ( wrf_err_message )
    142. 

  142.      write( wrf_err_message ,*) ' symmetric_xs ',config_flags%symmetric_xs
    143. 

  143.      CALL wrf_message ( wrf_err_message )
    144. 

  144.      write( wrf_err_message ,*) ' symmetric_xe ',config_flags%symmetric_xe
    145. 

  145.      CALL wrf_message ( wrf_err_message )
    146. 

  146.      write( wrf_err_message ,*) ' symmetric_ys ',config_flags%symmetric_ys
    147. 

  147.      CALL wrf_message ( wrf_err_message )
    148. 

  148.      write( wrf_err_message ,*) ' symmetric_ye ',config_flags%symmetric_ye
    149. 

  149.      CALL wrf_message ( wrf_err_message )
    150. 

  150.      write( wrf_err_message ,*) ' open_xs      ',config_flags%open_xs
    151. 

  151.      CALL wrf_message ( wrf_err_message )
    152. 

  152.      write( wrf_err_message ,*) ' open_xe      ',config_flags%open_xe
    153. 

  153.      CALL wrf_message ( wrf_err_message )
    154. 

  154.      write( wrf_err_message ,*) ' open_ys      ',config_flags%open_ys
    155. 

  155.      CALL wrf_message ( wrf_err_message )
    156. 

  156.      write( wrf_err_message ,*) ' open_ye      ',config_flags%open_ye
    157. 

  157.      CALL wrf_message ( wrf_err_message )
    158. 

  158.      write( wrf_err_message ,*) ' polar        ',config_flags%polar
    159. 

  159.      CALL wrf_message ( wrf_err_message )
    160. 

  160.      write( wrf_err_message ,*) ' nested       ',config_flags%nested
    161. 

  161.      CALL wrf_message ( wrf_err_message )
    162. 

  162.      write( wrf_err_message ,*) ' specified    ',config_flags%specified
    163. 

  163.      CALL wrf_message ( wrf_err_message )
    164. 

  164.      CALL wrf_error_fatal( ' *** Error in boundary condition specification ' )
    165. 

  165. 

  166.    ENDIF
    167. 

  167. 

  168. !  now check to see if boundary zone size is sufficient.
    169. 

  169. !  we could have the necessary boundary zone size be returned
    170. 

  170. !  to the calling routine.
    171. 

  171. 

  172.    IF( config_flags%periodic_x   .or. &
    173. 

  173.        config_flags%periodic_y   .or. &
    174. 

  174.        config_flags%symmetric_xs .or. &
    175. 

  175.        config_flags%symmetric_xe .or. &
    176. 

  176.        config_flags%symmetric_ys .or. &
    177. 

  177.        config_flags%symmetric_ye        )  THEN
    178. 

  178. 

  179.        bzone_min = MAX( 1,                                  &
    180. 

  180.                         (config_flags%h_mom_adv_order+1)/2, &
    181. 

  181.                         (config_flags%h_sca_adv_order+1)/2 )
    182. 

  182. 

  183.        IF( bzone < bzone_min) THEN  
    184. 

  184. 

  185.          error = 2
    186. 

  186.          WRITE ( wrf_err_message , * ) ' boundary zone not large enough '
    187. 

  187.          CALL wrf_message ( wrf_err_message )
    188. 

  188.          WRITE ( wrf_err_message , * ) ' boundary zone specified      ',bzone
    189. 

  189.          CALL wrf_message ( wrf_err_message )
    190. 

  190.          WRITE ( wrf_err_message , * ) ' minimum boundary zone needed ',bzone_min
    191. 

  191.          CALL wrf_error_fatal ( wrf_err_message )
    192. 

  192. 

  193.        ENDIF
    194. 

  194.    ENDIF
    195. 

  195. 

  196.    CALL wrf_debug ( 100 , ' boundary conditions OK for grid ' )
    197. 

  197. 

  198.    END subroutine boundary_condition_check
    199. 

  199. 

  200. !--------------------------------------------------------------------------
    201. 

  201.    SUBROUTINE set_physical_bc2d( dat, variable_in,  &
    202. 

  202.                                  config_flags,           & 
    203. 

  203.                                  ids,ide, jds,jde,   & ! domain dims
    204. 

  204.                                  ims,ime, jms,jme,   & ! memory dims
    205. 

  205.                                  ips,ipe, jps,jpe,   & ! patch  dims
    206. 

  206.                                  its,ite, jts,jte   )      
    207. 

  207. 

  208. !  This subroutine sets the data in the boundary region, by direct
    209. 

  209. !  assignment if possible, for periodic and symmetric (wall)
    210. 

  210. !  boundary conditions.  Currently, we are only doing 1 variable
    211. 

  211. !  at a time - lots of overhead, so maybe this routine can be easily 
    212. 

  212. !  inlined later or we could pass multiple variables -
    213. 

  213. !  would probably want a largestep and smallstep version.
    214. 

  214. 

  215. !  15 Jan 99, Dave
    216. 

  216. !  Modified the incoming its,ite,jts,jte to truly be the tile size.
    217. 

  217. !  This required modifying the loop limits when the "istag" or "jstag"
    218. 

  218. !  is used, as this is only required at the end of the domain.
    219. 

  219. 

  220.       IMPLICIT NONE
    221. 

  221. 

  222.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde
    223. 

  223.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme
    224. 

  224.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe
    225. 

  225.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte
    226. 

  226.       CHARACTER,    INTENT(IN   )    :: variable_in
    227. 

  227. 

  228.       CHARACTER                      :: variable
    229. 

  229. 

  230.       REAL,  DIMENSION( ims:ime , jms:jme ) :: dat
    231. 

  231.       TYPE( grid_config_rec_type ) config_flags
    232. 

  232. 

  233.       INTEGER  :: i, j, istag, jstag, itime
    234. 

  234. 

  235.       LOGICAL  :: debug, open_bc_copy
    236. 

  236. 

  237. !------------
    238. 

  238. 

  239.       debug = .false.
    240. 

  240. 

  241.       open_bc_copy = .false.
    242. 

  242. 

  243.       variable = variable_in
    244. 

  244.       IF ( variable_in .ge. 'A' .and. variable_in .le. 'Z' ) THEN
    245. 

  245.         variable = CHAR( ICHAR(variable_in) - ICHAR('A') + ICHAR('a') )
    246. 

  246.       ENDIF
    247. 

  247.       IF ((variable == 'u') .or. (variable == 'v') .or.  &
    248. 

  248.           (variable == 'w') .or. (variable == 't') .or.  &
    249. 

  249.           (variable == 'x') .or. (variable == 'y') .or.  &
    250. 

  250.           (variable == 'r') .or. (variable == 'p') ) open_bc_copy = .true.
    251. 

  251. 

  252. !  begin, first set a staggering variable
    253. 

  253. 

  254.       istag = -1
    255. 

  255.       jstag = -1
    256. 

  256. 

  257.       IF ((variable == 'u') .or. (variable == 'x')) istag = 0
    258. 

  258.       IF ((variable == 'v') .or. (variable == 'y')) jstag = 0
    259. 

  259. 

  260.       if(debug) then
    261. 

  261.         write(6,*) ' in bc2d, var is ',variable, istag, jstag
    262. 

  262.         write(6,*) ' b.cs are ',  &
    263. 

  263.       config_flags%periodic_x,  &
    264. 

  264.       config_flags%periodic_y
    265. 

  265.       end if
    266. 

  266.       
    267. 

  267.       IF ( variable == 'd' ) then  !JDM
    268. 

  268.          istag = 0
    269. 

  269.          jstag = 0
    270. 

  270.       ENDIF
    271. 

  271.       IF ( variable == 'e' ) then  !JDM
    272. 

  272.          istag = 0
    273. 

  273.       ENDIF
    274. 

  274.       IF ( variable == 'f' ) then  !JDM
    275. 

  275.          jstag = 0
    276. 

  276.       ENDIF
    277. 

  277. 

  278. !  periodic conditions.
    279. 

  279. !  note, patch must cover full range in periodic dir, or else
    280. 

  280. !  its intra-patch communication that is handled elsewheres.
    281. 

  281. !  symmetry conditions can always be handled here, because no
    282. 

  282. !  outside patch communication is needed
    283. 

  283. 

  284.       periodicity_x:  IF( ( config_flags%periodic_x ) ) THEN 
    285. 

  285.         IF ( ( ids == ips ) .and.  ( ide == ipe ) ) THEN  ! test if east and west both on-processor 
    286. 

  286.           IF ( its == ids ) THEN
    287. 

  287. 

  288.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    289. 

  289.             DO i = 0,-(bdyzone-1),-1
    290. 

  290.               dat(ids+i-1,j) = dat(ide+i-1,j)
    291. 

  291.             ENDDO
    292. 

  292.             ENDDO
    293. 

  293. 

  294.           ENDIF
    295. 

  295. 

  296.           IF ( ite == ide ) THEN
    297. 

  297. 

  298.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    299. 

  299. !!          DO i = 1 , bdyzone
    300. 

  300.             DO i = -istag , bdyzone
    301. 

  301.               dat(ide+i+istag,j) = dat(ids+i+istag,j)
    302. 

  302.             ENDDO
    303. 

  303.             ENDDO
    304. 

  304. 

  305.           ENDIF
    306. 

  306.         ENDIF
    307. 

  307. 

  308.       ELSE 
    309. 

  309. 

  310.         symmetry_xs: IF( ( config_flags%symmetric_xs ) .and.  &
    311. 

  311.                          ( its == ids )                  )  THEN
    312. 

  312. 

  313.           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
    314. 

  314. 

  315.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    316. 

  316.             DO i = 1, bdyzone
    317. 

  317.               dat(ids-i,j) = dat(ids+i-1,j) !  here, dat(0) = dat(1), etc
    318. 

  318.             ENDDO                             !  symmetry about dat(0.5) (u=0 pt)
    319. 

  319.             ENDDO
    320. 

  320. 

  321.           ELSE
    322. 

  322. 

  323.             IF( variable == 'u' ) THEN
    324. 

  324. 

  325.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    326. 

  326.               DO i = 0, bdyzone-1
    327. 

  327.                 dat(ids-i,j) = - dat(ids+i,j) ! here, u(0) = - u(2), etc
    328. 

  328.               ENDDO                             !  normal b.c symmetry at u(1)
    329. 

  329.               ENDDO
    330. 

  330. 

  331.             ELSE
    332. 

  332. 

  333.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    334. 

  334.               DO i = 0, bdyzone-1
    335. 

  335.                 dat(ids-i,j) =   dat(ids+i,j) ! here, phi(0) = phi(2), etc
    336. 

  336.               ENDDO                             !  normal b.c symmetry at phi(1)
    337. 

  337.               ENDDO
    338. 

  338. 

  339.             END IF
    340. 

  340. 

  341.           ENDIF
    342. 

  342. 

  343.         ENDIF symmetry_xs
    344. 

  344. 

  345. 

  346. !  now the symmetry boundary at xe
    347. 

  347. 

  348.         symmetry_xe: IF( ( config_flags%symmetric_xe ) .and.  &
    349. 

  349.                          ( ite == ide )                  )  THEN
    350. 

  350. 

  351.           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
    352. 

  352. 

  353.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    354. 

  354.             DO i = 1, bdyzone
    355. 

  355.               dat(ide+i-1,j) = dat(ide-i,j)  !  sym. about dat(ide-0.5)
    356. 

  356.             ENDDO
    357. 

  357.             ENDDO
    358. 

  358. 

  359.           ELSE
    360. 

  360. 

  361.             IF (variable == 'u' ) THEN
    362. 

  362. 

  363.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    364. 

  364.               DO i = 0, bdyzone-1
    365. 

  365.                 dat(ide+i,j) = - dat(ide-i,j)  ! u(ide+1) = - u(ide-1), etc.
    366. 

  366.               ENDDO
    367. 

  367.               ENDDO
    368. 

  368. 

  369. 

  370.             ELSE
    371. 

  371. 

  372.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    373. 

  373.               DO i = 0, bdyzone-1
    374. 

  374.                 dat(ide+i,j) = dat(ide-i,j)  !  phi(ide+1) = phi(ide-1), etc.
    375. 

  375.               ENDDO
    376. 

  376.               ENDDO
    377. 

  377. 

  378.             END IF
    379. 

  379. 

  380.           END IF 
    381. 

  381. 

  382.         END IF symmetry_xe
    383. 

  383. 

  384. 

  385. !  set open b.c in X copy into boundary zone here.  WCS, 19 March 2000
    386. 

  386. 

  387.         open_xs: IF( ( config_flags%open_xs   .or. &
    388. 

  388.                        config_flags%specified .or. &
    389. 

  389.                        config_flags%nested            ) .and.  &
    390. 

  390.                          ( its == ids ) .and. open_bc_copy  )  THEN
    391. 

  391. 

  392.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    393. 

  393.               dat(ids-1,j) = dat(ids,j) !  here, dat(0) = dat(1)
    394. 

  394.               dat(ids-2,j) = dat(ids,j)
    395. 

  395.               dat(ids-3,j) = dat(ids,j)
    396. 

  396.             ENDDO
    397. 

  397. 

  398.         ENDIF open_xs
    399. 

  399. 

  400. 

  401. !  now the open boundary copy at xe
    402. 

  402. 

  403.         open_xe: IF( ( config_flags%open_xe   .or. &
    404. 

  404.                        config_flags%specified .or. &
    405. 

  405.                        config_flags%nested            ) .and.  &
    406. 

  406.                           ( ite == ide ) .and. open_bc_copy  )  THEN
    407. 

  407. 

  408.           IF ( variable /= 'u' .and. variable /= 'x') THEN
    409. 

  409. 

  410.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    411. 

  411.               dat(ide  ,j) = dat(ide-1,j) 
    412. 

  412.               dat(ide+1,j) = dat(ide-1,j) 
    413. 

  413.               dat(ide+2,j) = dat(ide-1,j) 
    414. 

  414.             ENDDO
    415. 

  415. 

  416.           ELSE
    417. 

  417. 

  418.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    419. 

  419.               dat(ide+1,j) = dat(ide,j)
    420. 

  420.               dat(ide+2,j) = dat(ide,j)
    421. 

  421.               dat(ide+3,j) = dat(ide,j)
    422. 

  422.             ENDDO
    423. 

  423. 

  424.           END IF 
    425. 

  425. 

  426.         END IF open_xe
    427. 

  427. 

  428. !  end open b.c in X copy into boundary zone addition.  WCS, 19 March 2000
    429. 

  429. 

  430.       END IF periodicity_x
    431. 

  431. 

  432. !  same procedure in y
    433. 

  433. 

  434.       periodicity_y:  IF( ( config_flags%periodic_y ) ) THEN
    435. 

  435.         IF ( ( jds == jps ) .and. ( jde == jpe ) )  THEN    ! test of both north and south on processor
    436. 

  436. 

  437.           IF( jts == jds ) then
    438. 

  438. 

  439.             DO j = 0, -(bdyzone-1), -1
    440. 

  440.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    441. 

  441.               dat(i,jds+j-1) = dat(i,jde+j-1)
    442. 

  442.             ENDDO
    443. 

  443.             ENDDO
    444. 

  444. 

  445.           END IF
    446. 

  446. 

  447.           IF( jte == jde ) then
    448. 

  448. 

  449.             DO j = -jstag, bdyzone
    450. 

  450.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    451. 

  451.               dat(i,jde+j+jstag) = dat(i,jds+j+jstag)
    452. 

  452.             ENDDO
    453. 

  453.             ENDDO
    454. 

  454. 

  455.           END IF
    456. 

  456. 

  457.         END IF
    458. 

  458. 

  459.       ELSE
    460. 

  460. 

  461.         symmetry_ys: IF( ( config_flags%symmetric_ys ) .and.  &
    462. 

  462.                          ( jts == jds)                   )  THEN
    463. 

  463. 

  464.           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
    465. 

  465. 

  466.             DO j = 1, bdyzone
    467. 

  467.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    468. 

  468.               dat(i,jds-j) = dat(i,jds+j-1) 
    469. 

  469.             ENDDO
    470. 

  470.             ENDDO
    471. 

  471. 

  472.           ELSE
    473. 

  473. 

  474.             IF (variable == 'v') THEN
    475. 

  475. 

  476.               DO j = 1, bdyzone
    477. 

  477.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    478. 

  478.                 dat(i,jds-j) = - dat(i,jds+j) 
    479. 

  479.               ENDDO              
    480. 

  480.               ENDDO
    481. 

  481. 

  482.             ELSE
    483. 

  483. 

  484.               DO j = 1, bdyzone
    485. 

  485.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    486. 

  486.                 dat(i,jds-j) = dat(i,jds+j) 
    487. 

  487.               ENDDO              
    488. 

  488.               ENDDO
    489. 

  489. 

  490.             END IF
    491. 

  491. 

  492.           ENDIF
    493. 

  493. 

  494.         ENDIF symmetry_ys
    495. 

  495. 

  496. !  now the symmetry boundary at ye
    497. 

  497. 

  498.         symmetry_ye: IF( ( config_flags%symmetric_ye ) .and.  &
    499. 

  499.                          ( jte == jde )                  )  THEN
    500. 

  500. 

  501.           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
    502. 

  502. 

  503.             DO j = 1, bdyzone
    504. 

  504.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    505. 

  505.               dat(i,jde+j-1) = dat(i,jde-j) 
    506. 

  506.             ENDDO                               
    507. 

  507.             ENDDO
    508. 

  508. 

  509.           ELSE
    510. 

  510. 

  511.             IF (variable == 'v' ) THEN
    512. 

  512. 

  513.               DO j = 1, bdyzone
    514. 

  514.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    515. 

  515.                 dat(i,jde+j) = - dat(i,jde-j)    ! bugfix: changed jds on rhs to jde , JM 20020410
    516. 

  516.               ENDDO                               
    517. 

  517.               ENDDO
    518. 

  518. 

  519.             ELSE
    520. 

  520. 

  521.               DO j = 1, bdyzone
    522. 

  522.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    523. 

  523.                 dat(i,jde+j) = dat(i,jde-j)
    524. 

  524.               ENDDO                               
    525. 

  525.               ENDDO
    526. 

  526. 

  527.             END IF
    528. 

  528. 

  529.           ENDIF
    530. 

  530. 

  531.         END IF symmetry_ye
    532. 

  532. 

  533. !  set open b.c in Y copy into boundary zone here.  WCS, 19 March 2000
    534. 

  534. 

  535.         open_ys: IF( ( config_flags%open_ys   .or. &
    536. 

  536.                        config_flags%polar     .or. &
    537. 

  537.                        config_flags%specified .or. &
    538. 

  538.                        config_flags%nested            ) .and.  &
    539. 

  539.                          ( jts == jds) .and. open_bc_copy )  THEN
    540. 

  540. 

  541.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    542. 

  542.               dat(i,jds-1) = dat(i,jds) 
    543. 

  543.               dat(i,jds-2) = dat(i,jds) 
    544. 

  544.               dat(i,jds-3) = dat(i,jds) 
    545. 

  545.             ENDDO
    546. 

  546. 

  547.         ENDIF open_ys
    548. 

  548. 

  549. !  now the open boundary copy at ye
    550. 

  550. 

  551.         open_ye: IF( ( config_flags%open_ye   .or. &
    552. 

  552.                        config_flags%polar     .or. &
    553. 

  553.                        config_flags%specified .or. &
    554. 

  554.                        config_flags%nested            ) .and.  &
    555. 

  555.                          ( jte == jde ) .and. open_bc_copy )  THEN
    556. 

  556. 

  557.           IF  (variable /= 'v' .and. variable /= 'y' ) THEN
    558. 

  558. 

  559.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    560. 

  560.               dat(i,jde  ) = dat(i,jde-1) 
    561. 

  561.               dat(i,jde+1) = dat(i,jde-1) 
    562. 

  562.               dat(i,jde+2) = dat(i,jde-1) 
    563. 

  563.             ENDDO                               
    564. 

  564. 

  565.           ELSE
    566. 

  566. 

  567.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    568. 

  568.               dat(i,jde+1) = dat(i,jde) 
    569. 

  569.               dat(i,jde+2) = dat(i,jde) 
    570. 

  570.               dat(i,jde+3) = dat(i,jde) 
    571. 

  571.             ENDDO                               
    572. 

  572. 

  573.           ENDIF
    574. 

  574. 

  575.         END IF open_ye
    576. 

  576.       
    577. 

  577. !  end open b.c in Y copy into boundary zone addition.  WCS, 19 March 2000
    578. 

  578. 

  579.       END IF periodicity_y
    580. 

  580. 

  581. !  fix corners for doubly periodic domains
    582. 

  582. 

  583.       IF ( config_flags%periodic_x .and. config_flags%periodic_y &
    584. 

  584.            .and. (ids == ips) .and. (ide == ipe)                 &
    585. 

  585.            .and. (jds == jps) .and. (jde == jpe)                   ) THEN
    586. 

  586. 

  587.          IF ( (its == ids) .and. (jts == jds) ) THEN  ! lower left corner fill
    588. 

  588.            DO j = 0, -(bdyzone-1), -1
    589. 

  589.            DO i = 0, -(bdyzone-1), -1
    590. 

  590.              dat(ids+i-1,jds+j-1) = dat(ide+i-1,jde+j-1)
    591. 

  591.            ENDDO
    592. 

  592.            ENDDO
    593. 

  593.          END IF
    594. 

  594. 

  595.          IF ( (ite == ide) .and. (jts == jds) ) THEN  ! lower right corner fill
    596. 

  596.            DO j = 0, -(bdyzone-1), -1
    597. 

  597.            DO i = 1, bdyzone
    598. 

  598.              dat(ide+i+istag,jds+j-1) = dat(ids+i+istag,jde+j-1)
    599. 

  599.            ENDDO
    600. 

  600.            ENDDO
    601. 

  601.          END IF
    602. 

  602. 

  603.          IF ( (ite == ide) .and. (jte == jde) ) THEN  ! upper right corner fill
    604. 

  604.            DO j = 1, bdyzone
    605. 

  605.            DO i = 1, bdyzone
    606. 

  606.              dat(ide+i+istag,jde+j+jstag) = dat(ids+i+istag,jds+j+jstag)
    607. 

  607.            ENDDO
    608. 

  608.            ENDDO
    609. 

  609.          END IF
    610. 

  610. 

  611.          IF ( (its == ids) .and. (jte == jde) ) THEN  ! upper left corner fill
    612. 

  612.            DO j = 1, bdyzone
    613. 

  613.            DO i = 0, -(bdyzone-1), -1
    614. 

  614.              dat(ids+i-1,jde+j+jstag) = dat(ide+i-1,jds+j+jstag)
    615. 

  615.            ENDDO
    616. 

  616.            ENDDO
    617. 

  617.          END IF
    618. 

  618. 

  619.        END IF
    620. 

  620. 

  621.    END SUBROUTINE set_physical_bc2d
    622. 

  622. 

  623. !-----------------------------------
    624. 

  624. 

  625.    SUBROUTINE set_physical_bc3d( dat, variable_in,        &
    626. 

  626.                                config_flags,                   & 
    627. 

  627.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    628. 

  628.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    629. 

  629.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    630. 

  630.                                its,ite, jts,jte, kts,kte )
    631. 

  631. 

  632. !  This subroutine sets the data in the boundary region, by direct
    633. 

  633. !  assignment if possible, for periodic and symmetric (wall)
    634. 

  634. !  boundary conditions.  Currently, we are only doing 1 variable
    635. 

  635. !  at a time - lots of overhead, so maybe this routine can be easily 
    636. 

  636. !  inlined later or we could pass multiple variables -
    637. 

  637. !  would probably want a largestep and smallstep version.
    638. 

  638. 

  639. !  15 Jan 99, Dave
    640. 

  640. !  Modified the incoming its,ite,jts,jte to truly be the tile size.
    641. 

  641. !  This required modifying the loop limits when the "istag" or "jstag"
    642. 

  642. !  is used, as this is only required at the end of the domain.
    643. 

  643. 

  644.       IMPLICIT NONE
    645. 

  645. 

  646.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    647. 

  647.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    648. 

  648.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    649. 

  649.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    650. 

  650.       CHARACTER,    INTENT(IN   )    :: variable_in
    651. 

  651. 

  652.       CHARACTER                      :: variable
    653. 

  653. 

  654.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ) :: dat
    655. 

  655.       TYPE( grid_config_rec_type ) config_flags
    656. 

  656. 

  657.       INTEGER  :: i, j, k, istag, jstag, itime, k_end
    658. 

  658. 

  659.       LOGICAL  :: debug, open_bc_copy
    660. 

  660. 

  661. !------------
    662. 

  662. 

  663.       debug = .false.
    664. 

  664. 

  665.       open_bc_copy = .false.
    666. 

  666. 

  667.       variable = variable_in
    668. 

  668.       IF ( variable_in .ge. 'A' .and. variable_in .le. 'Z' ) THEN
    669. 

  669.         variable = CHAR( ICHAR(variable_in) - ICHAR('A') + ICHAR('a') )
    670. 

  670.       ENDIF
    671. 

  671. 

  672.       IF ((variable == 'u') .or. (variable == 'v') .or.     &
    673. 

  673.           (variable == 'w') .or. (variable == 't') .or.     &
    674. 

  674.           (variable == 'd') .or. (variable == 'e') .or. &
    675. 

  675.           (variable == 'x') .or. (variable == 'y') .or. &
    676. 

  676.           (variable == 'f') .or. (variable == 'r') .or. &
    677. 

  677.           (variable == 'p')                        ) open_bc_copy = .true.
    678. 

  678. 

  679. !  begin, first set a staggering variable
    680. 

  680. 

  681.       istag = -1
    682. 

  682.       jstag = -1
    683. 

  683.       k_end = max(1,min(kde-1,kte))
    684. 

  684. 

  685. 

  686.       IF ((variable == 'u') .or. (variable == 'x')) istag = 0
    687. 

  687.       IF ((variable == 'v') .or. (variable == 'y')) jstag = 0
    688. 

  688.       IF ((variable == 'd') .or. (variable == 'xy')) then
    689. 

  689.          istag = 0
    690. 

  690.          jstag = 0
    691. 

  691.       ENDIF
    692. 

  692.       IF ((variable == 'e') ) then
    693. 

  693.          istag = 0
    694. 

  694.          k_end = min(kde,kte)
    695. 

  695.       ENDIF
    696. 

  696. 

  697.       IF ((variable == 'f') ) then
    698. 

  698.          jstag = 0
    699. 

  699.          k_end = min(kde,kte)
    700. 

  700.       ENDIF
    701. 

  701. 

  702.       IF ( variable == 'w')  k_end = min(kde,kte)
    703. 

  703. 

  704. !      k_end = kte
    705. 

  705. 

  706.       if(debug) then
    707. 

  707.         write(6,*) ' in bc, var is ',variable, istag, jstag, kte, k_end
    708. 

  708.         write(6,*) ' b.cs are ',  &
    709. 

  709.       config_flags%periodic_x,  &
    710. 

  710.       config_flags%periodic_y
    711. 

  711.       end if
    712. 

  712.       
    713. 

  713. 

  714. 

  715. !  periodic conditions.
    716. 

  716. !  note, patch must cover full range in periodic dir, or else
    717. 

  717. !  its intra-patch communication that is handled elsewheres.
    718. 

  718. !  symmetry conditions can always be handled here, because no
    719. 

  719. !  outside patch communication is needed
    720. 

  720. 

  721.       periodicity_x:  IF( ( config_flags%periodic_x ) ) THEN
    722. 

  722. 

  723.         IF ( ( ids == ips ) .and. ( ide == ipe ) ) THEN  ! test if both east and west on-processor
    724. 

  724.           IF ( its == ids ) THEN
    725. 

  725. 

  726.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    727. 

  727.             DO k = kts, k_end
    728. 

  728.             DO i = 0,-(bdyzone-1),-1
    729. 

  729.               dat(ids+i-1,k,j) = dat(ide+i-1,k,j)
    730. 

  730.             ENDDO
    731. 

  731.             ENDDO
    732. 

  732.             ENDDO
    733. 

  733. 

  734.           ENDIF
    735. 

  735. 

  736. 

  737.           IF ( ite == ide ) THEN
    738. 

  738. 

  739.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    740. 

  740.             DO k = kts, k_end
    741. 

  741.             DO i = -istag , bdyzone
    742. 

  742.               dat(ide+i+istag,k,j) = dat(ids+i+istag,k,j)
    743. 

  743.             ENDDO
    744. 

  744.             ENDDO
    745. 

  745.             ENDDO
    746. 

  746. 

  747.           ENDIF
    748. 

  748. 

  749.         ENDIF
    750. 

  750. 

  751.       ELSE 
    752. 

  752. 

  753.         symmetry_xs: IF( ( config_flags%symmetric_xs ) .and.  &
    754. 

  754.                          ( its == ids )                  )  THEN
    755. 

  755. 

  756.           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
    757. 

  757. 

  758.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    759. 

  759.             DO k = kts, k_end
    760. 

  760.             DO i = 1, bdyzone
    761. 

  761.               dat(ids-i,k,j) = dat(ids+i-1,k,j) !  here, dat(0) = dat(1), etc
    762. 

  762.             ENDDO                                 !  symmetry about dat(0.5) (u = 0 pt)
    763. 

  763.             ENDDO
    764. 

  764.             ENDDO
    765. 

  765. 

  766.           ELSE
    767. 

  767. 

  768.             IF ( variable == 'u' ) THEN
    769. 

  769. 

  770.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    771. 

  771.               DO k = kts, k_end
    772. 

  772.               DO i = 1, bdyzone
    773. 

  773.                 dat(ids-i,k,j) = - dat(ids+i,k,j) ! here, u(0) = - u(2), etc
    774. 

  774.               ENDDO                                 !  normal b.c symmetry at u(1)
    775. 

  775.               ENDDO
    776. 

  776.               ENDDO
    777. 

  777. 

  778.             ELSE
    779. 

  779. 

  780.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    781. 

  781.               DO k = kts, k_end
    782. 

  782.               DO i = 1, bdyzone
    783. 

  783.                 dat(ids-i,k,j) = dat(ids+i,k,j) ! here, phi(0) = phi(2), etc
    784. 

  784.               ENDDO                               !  normal b.c symmetry at phi(1)
    785. 

  785.               ENDDO
    786. 

  786.               ENDDO
    787. 

  787. 

  788.             END IF
    789. 

  789. 

  790.           ENDIF
    791. 

  791. 

  792.         ENDIF symmetry_xs
    793. 

  793. 

  794. 

  795. !  now the symmetry boundary at xe
    796. 

  796. 

  797.         symmetry_xe: IF( ( config_flags%symmetric_xe ) .and.  &
    798. 

  798.                          ( ite == ide )                  )  THEN
    799. 

  799. 

  800.           IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN
    801. 

  801. 

  802.             DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    803. 

  803.             DO k = kts, k_end
    804. 

  804.             DO i = 1, bdyzone
    805. 

  805.               dat(ide+i-1,k,j) = dat(ide-i,k,j)  !  sym. about dat(ide-0.5)
    806. 

  806.             ENDDO
    807. 

  807.             ENDDO
    808. 

  808.             ENDDO
    809. 

  809. 

  810.           ELSE
    811. 

  811. 

  812.             IF (variable == 'u') THEN
    813. 

  813. 

  814.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    815. 

  815.               DO k = kts, k_end
    816. 

  816.               DO i = 1, bdyzone
    817. 

  817.                 dat(ide+i,k,j) = - dat(ide-i,k,j)  ! u(ide+1) = - u(ide-1), etc.
    818. 

  818.               ENDDO
    819. 

  819.               ENDDO
    820. 

  820.               ENDDO
    821. 

  821. 

  822.             ELSE
    823. 

  823. 

  824.               DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag)
    825. 

  825.               DO k = kts, k_end
    826. 

  826.               DO i = 1, bdyzone
    827. 

  827.                 dat(ide+i,k,j) = dat(ide-i,k,j)  ! phi(ide+1) = - phi(ide-1), etc.
    828. 

  828.               ENDDO
    829. 

  829.               ENDDO
    830. 

  830.               ENDDO
    831. 

  831. 

  832.              END IF
    833. 

  833. 

  834.           END IF 
    835. 

  835. 

  836.         END IF symmetry_xe
    837. 

  837. 

  838. !  set open b.c in X copy into boundary zone here.  WCS, 19 March 2000
    839. 

  839. 

  840.         open_xs: IF( ( config_flags%open_xs   .or. &
    841. 

  841.                        config_flags%specified .or. &
    842. 

  842.                        config_flags%nested            ) .and.  &
    843. 

  843.                          ( its == ids ) .and. open_bc_copy  )  THEN
    844. 

  844. 

  845.             DO j = jts-bdyzone, MIN(jte,jde+jstag)+bdyzone
    846. 

  846.             DO k = kts, k_end
    847. 

  847.               dat(ids-1,k,j) = dat(ids,k,j) !  here, dat(0) = dat(1), etc
    848. 

  848.               dat(ids-2,k,j) = dat(ids,k,j)
    849. 

  849.               dat(ids-3,k,j) = dat(ids,k,j)
    850. 

  850.             ENDDO
    851. 

  851.             ENDDO
    852. 

  852. 

  853.         ENDIF open_xs
    854. 

  854. 

  855. 

  856. !  now the open_xe boundary copy 
    857. 

  857. 

  858.         open_xe: IF( ( config_flags%open_xe   .or. &
    859. 

  859.                        config_flags%specified .or. &
    860. 

  860.                        config_flags%nested            ) .and.  &
    861. 

  861.                          ( ite == ide ) .and. open_bc_copy )  THEN
    862. 

  862. 

  863.           IF (variable /= 'u' .and. variable /= 'x' ) THEN
    864. 

  864. 

  865.             DO j = jts-bdyzone, MIN(jte,jde+jstag)+bdyzone
    866. 

  866.             DO k = kts, k_end
    867. 

  867.               dat(ide  ,k,j) = dat(ide-1,k,j)
    868. 

  868.               dat(ide+1,k,j) = dat(ide-1,k,j)
    869. 

  869.               dat(ide+2,k,j) = dat(ide-1,k,j)
    870. 

  870.             ENDDO
    871. 

  871.             ENDDO
    872. 

  872. 

  873.           ELSE
    874. 

  874. 

  875. !!!!!!! I am not sure about this one!  JM 20020402
    876. 

  876.             DO j = MAX(jds,jts-1)-bdyzone, MIN(jte+1,jde+jstag)+bdyzone
    877. 

  877.             DO k = kts, k_end
    878. 

  878.               dat(ide+1,k,j) = dat(ide,k,j)
    879. 

  879.               dat(ide+2,k,j) = dat(ide,k,j)
    880. 

  880.               dat(ide+3,k,j) = dat(ide,k,j)
    881. 

  881.             ENDDO
    882. 

  882.             ENDDO
    883. 

  883. 

  884.           END IF 
    885. 

  885. 

  886.         END IF open_xe
    887. 

  887. 

  888. !  end open b.c in X copy into boundary zone addition.  WCS, 19 March 2000
    889. 

  889. 

  890.       END IF periodicity_x
    891. 

  891. 

  892. !  same procedure in y
    893. 

  893. 

  894.       periodicity_y:  IF( ( config_flags%periodic_y ) ) THEN
    895. 

  895.         IF ( ( jds == jps ) .and. ( jde == jpe ) )  THEN      ! test if both north and south on processor
    896. 

  896.           IF( jts == jds ) then
    897. 

  897. 

  898.             DO j = 0, -(bdyzone-1), -1
    899. 

  899.             DO k = kts, k_end
    900. 

  900.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    901. 

  901.               dat(i,k,jds+j-1) = dat(i,k,jde+j-1)
    902. 

  902.             ENDDO
    903. 

  903.             ENDDO
    904. 

  904.             ENDDO
    905. 

  905. 

  906.           END IF
    907. 

  907. 

  908.           IF( jte == jde ) then
    909. 

  909. 

  910.             DO j = -jstag, bdyzone
    911. 

  911.             DO k = kts, k_end
    912. 

  912.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    913. 

  913.               dat(i,k,jde+j+jstag) = dat(i,k,jds+j+jstag)
    914. 

  914.             ENDDO
    915. 

  915.             ENDDO
    916. 

  916.             ENDDO
    917. 

  917. 

  918.           END IF
    919. 

  919. 

  920.         END IF
    921. 

  921. 

  922.       ELSE
    923. 

  923. 

  924.         symmetry_ys: IF( ( config_flags%symmetric_ys ) .and.  &
    925. 

  925.                          ( jts == jds)                   )  THEN
    926. 

  926. 

  927.           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
    928. 

  928. 

  929.             DO j = 1, bdyzone
    930. 

  930.             DO k = kts, k_end
    931. 

  931.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    932. 

  932.               dat(i,k,jds-j) = dat(i,k,jds+j-1) 
    933. 

  933.             ENDDO                               
    934. 

  934.             ENDDO
    935. 

  935.             ENDDO
    936. 

  936. 

  937.           ELSE
    938. 

  938. 

  939.             IF (variable == 'v') THEN
    940. 

  940. 

  941.               DO j = 1, bdyzone
    942. 

  942.               DO k = kts, k_end
    943. 

  943.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    944. 

  944.                 dat(i,k,jds-j) = - dat(i,k,jds+j) 
    945. 

  945.               ENDDO              
    946. 

  946.               ENDDO
    947. 

  947.               ENDDO
    948. 

  948. 

  949.             ELSE
    950. 

  950. 

  951.               DO j = 1, bdyzone
    952. 

  952.               DO k = kts, k_end
    953. 

  953.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    954. 

  954.                 dat(i,k,jds-j) = dat(i,k,jds+j) 
    955. 

  955.               ENDDO              
    956. 

  956.               ENDDO
    957. 

  957.               ENDDO
    958. 

  958. 

  959.             END IF
    960. 

  960. 

  961.           ENDIF
    962. 

  962. 

  963.         ENDIF symmetry_ys
    964. 

  964. 

  965. !  now the symmetry boundary at ye
    966. 

  966. 

  967.         symmetry_ye: IF( ( config_flags%symmetric_ye ) .and.  &
    968. 

  968.                          ( jte == jde )                  )  THEN
    969. 

  969. 

  970.           IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN
    971. 

  971. 

  972.             DO j = 1, bdyzone
    973. 

  973.             DO k = kts, k_end
    974. 

  974.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    975. 

  975.               dat(i,k,jde+j-1) = dat(i,k,jde-j) 
    976. 

  976.             ENDDO                               
    977. 

  977.             ENDDO
    978. 

  978.             ENDDO
    979. 

  979. 

  980.           ELSE
    981. 

  981. 

  982.             IF ( variable == 'v' ) THEN
    983. 

  983. 

  984.               DO j = 1, bdyzone
    985. 

  985.               DO k = kts, k_end
    986. 

  986.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    987. 

  987.                 dat(i,k,jde+j) = - dat(i,k,jde-j) 
    988. 

  988.               ENDDO                               
    989. 

  989.               ENDDO
    990. 

  990.               ENDDO
    991. 

  991. 

  992.             ELSE
    993. 

  993. 

  994.               DO j = 1, bdyzone
    995. 

  995.               DO k = kts, k_end
    996. 

  996.               DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    997. 

  997.                 dat(i,k,jde+j) = dat(i,k,jde-j) 
    998. 

  998.               ENDDO                               
    999. 

  999.               ENDDO
    1000. 

  1000.               ENDDO
    1001. 

  1001. 

  1002.             END IF
    1003. 

  1003. 

  1004.           ENDIF
    1005. 

  1005. 

  1006.         END IF symmetry_ye
    1007. 

  1007.       
    1008. 

  1008. !  set open b.c in Y copy into boundary zone here.  WCS, 19 March 2000
    1009. 

  1009. 

  1010.         open_ys: IF( ( config_flags%open_ys   .or. &
    1011. 

  1011.                        config_flags%polar     .or. &
    1012. 

  1012.                        config_flags%specified .or. &
    1013. 

  1013.                        config_flags%nested            ) .and.  &
    1014. 

  1014.                          ( jts == jds) .and. open_bc_copy )  THEN
    1015. 

  1015. 

  1016.             DO k = kts, k_end
    1017. 

  1017.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    1018. 

  1018.               dat(i,k,jds-1) = dat(i,k,jds) 
    1019. 

  1019.               dat(i,k,jds-2) = dat(i,k,jds) 
    1020. 

  1020.               dat(i,k,jds-3) = dat(i,k,jds) 
    1021. 

  1021.             ENDDO
    1022. 

  1022.             ENDDO
    1023. 

  1023. 

  1024.         ENDIF open_ys
    1025. 

  1025. 

  1026. !  now the open boundary copy at ye
    1027. 

  1027. 

  1028.         open_ye: IF( ( config_flags%open_ye   .or. &
    1029. 

  1029.                        config_flags%polar     .or. &
    1030. 

  1030.                        config_flags%specified .or. &
    1031. 

  1031.                        config_flags%nested            ) .and.  &
    1032. 

  1032.                          ( jte == jde ) .and. open_bc_copy )  THEN
    1033. 

  1033. 

  1034.           IF (variable /= 'v' .and. variable /= 'y' ) THEN
    1035. 

  1035. 

  1036.             DO k = kts, k_end
    1037. 

  1037.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    1038. 

  1038.               dat(i,k,jde  ) = dat(i,k,jde-1) 
    1039. 

  1039.               dat(i,k,jde+1) = dat(i,k,jde-1) 
    1040. 

  1040.               dat(i,k,jde+2) = dat(i,k,jde-1) 
    1041. 

  1041.             ENDDO                               
    1042. 

  1042.             ENDDO
    1043. 

  1043. 

  1044.           ELSE
    1045. 

  1045. 

  1046.             DO k = kts, k_end
    1047. 

  1047.             DO i = MAX(ids,its-1), MIN(ite+1,ide+istag)
    1048. 

  1048.               dat(i,k,jde+1) = dat(i,k,jde) 
    1049. 

  1049.               dat(i,k,jde+2) = dat(i,k,jde) 
    1050. 

  1050.               dat(i,k,jde+3) = dat(i,k,jde) 
    1051. 

  1051.             ENDDO                               
    1052. 

  1052.             ENDDO
    1053. 

  1053. 

  1054.           ENDIF
    1055. 

  1055. 

  1056.       END IF open_ye
    1057. 

  1057. 

  1058. !  end open b.c in Y copy into boundary zone addition.  WCS, 19 March 2000
    1059. 

  1059. 

  1060.       END IF periodicity_y
    1061. 

  1061. 

  1062. !  fix corners for doubly periodic domains
    1063. 

  1063. 

  1064.       IF ( config_flags%periodic_x .and. config_flags%periodic_y &
    1065. 

  1065.            .and. (ids == ips) .and. (ide == ipe)                 &
    1066. 

  1066.            .and. (jds == jps) .and. (jde == jpe)                   ) THEN
    1067. 

  1067. 

  1068.          IF ( (its == ids) .and. (jts == jds) ) THEN  ! lower left corner fill
    1069. 

  1069.            DO j = 0, -(bdyzone-1), -1
    1070. 

  1070.            DO k = kts, k_end
    1071. 

  1071.            DO i = 0, -(bdyzone-1), -1
    1072. 

  1072.              dat(ids+i-1,k,jds+j-1) = dat(ide+i-1,k,jde+j-1)
    1073. 

  1073.            ENDDO
    1074. 

  1074.            ENDDO
    1075. 

  1075.            ENDDO
    1076. 

  1076.          END IF
    1077. 

  1077. 

  1078.          IF ( (ite == ide) .and. (jts == jds) ) THEN  ! lower right corner fill
    1079. 

  1079.            DO j = 0, -(bdyzone-1), -1
    1080. 

  1080.            DO k = kts, k_end
    1081. 

  1081.            DO i = 1, bdyzone
    1082. 

  1082.              dat(ide+i+istag,k,jds+j-1) = dat(ids+i+istag,k,jde+j-1)
    1083. 

  1083.            ENDDO
    1084. 

  1084.            ENDDO
    1085. 

  1085.            ENDDO
    1086. 

  1086.          END IF
    1087. 

  1087. 

  1088.          IF ( (ite == ide) .and. (jte == jde) ) THEN  ! upper right corner fill
    1089. 

  1089.            DO j = 1, bdyzone
    1090. 

  1090.            DO k = kts, k_end
    1091. 

  1091.            DO i = 1, bdyzone
    1092. 

  1092.              dat(ide+i+istag,k,jde+j+jstag) = dat(ids+i+istag,k,jds+j+jstag)
    1093. 

  1093.            ENDDO
    1094. 

  1094.            ENDDO
    1095. 

  1095.            ENDDO
    1096. 

  1096.          END IF
    1097. 

  1097. 

  1098.          IF ( (its == ids) .and. (jte == jde) ) THEN  ! upper left corner fill
    1099. 

  1099.            DO j = 1, bdyzone
    1100. 

  1100.            DO k = kts, k_end
    1101. 

  1101.            DO i = 0, -(bdyzone-1), -1
    1102. 

  1102.              dat(ids+i-1,k,jde+j+jstag) = dat(ide+i-1,k,jds+j+jstag)
    1103. 

  1103.            ENDDO
    1104. 

  1104.            ENDDO
    1105. 

  1105.            ENDDO
    1106. 

  1106.          END IF
    1107. 

  1107. 

  1108.        END IF
    1109. 

  1109. 

  1110.    END SUBROUTINE set_physical_bc3d
    1111. 

  1111. 

  1112.    SUBROUTINE init_module_bc
    1113. 

  1113.    END SUBROUTINE init_module_bc
    1114. 

  1114. 

  1115. !------------------------------------------------------------------------
    1116. 

  1116. 

  1117. ! a couple versions of this call to allow a smaller-than-memory dimensioned field (e.g. tile sized)
    1118. 

  1118. ! to be passed in as the first argument.  Both of these call the _core version defined below.
    1119. 

  1119.    SUBROUTINE relax_bdytend   ( field, field_tend,                     &
    1120. 

  1120.                                 field_bdy_xs, field_bdy_xe,            &
    1121. 

  1121.                                 field_bdy_ys, field_bdy_ye,            &
    1122. 

  1122.                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
    1123. 

  1123.                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
    1124. 

  1124.                                 variable_in, config_flags,             &
    1125. 

  1125.                                 spec_bdy_width, spec_zone, relax_zone, &
    1126. 

  1126.                                 dtbc, fcx, gcx,             &
    1127. 

  1127.                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
    1128. 

  1128.                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
    1129. 

  1129.                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1130. 

  1130.                                 its,ite, jts,jte, kts,kte   &
    1131. 

  1131.                                 )
    1132. 

  1132. 

  1133.       IMPLICIT NONE
    1134. 

  1134. 

  1135.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1136. 

  1136.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1137. 

  1137.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1138. 

  1138.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1139. 

  1139.       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
    1140. 

  1140.       REAL,         INTENT(IN   )    :: dtbc
    1141. 

  1141.       CHARACTER,    INTENT(IN   )    :: variable_in
    1142. 

  1142. 

  1143.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field
    1144. 

  1144.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
    1145. 

  1145.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
    1146. 

  1146.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
    1147. 

  1147.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
    1148. 

  1148.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
    1149. 

  1149.       REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
    1150. 

  1150.       TYPE( grid_config_rec_type ) config_flags
    1151. 

  1151. 

  1152.       CALL relax_bdytend_core   ( field, field_tend,                     &
    1153. 

  1153.                                 field_bdy_xs, field_bdy_xe,            &
    1154. 

  1154.                                 field_bdy_ys, field_bdy_ye,            &
    1155. 

  1155.                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
    1156. 

  1156.                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
    1157. 

  1157.                                 variable_in, config_flags,             &
    1158. 

  1158.                                 spec_bdy_width, spec_zone, relax_zone, &
    1159. 

  1159.                                 dtbc, fcx, gcx,             &
    1160. 

  1160.                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
    1161. 

  1161.                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
    1162. 

  1162.                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1163. 

  1163.                                 its,ite, jts,jte, kts,kte,  & ! patch  dims
    1164. 

  1164.                                 ims,ime, jms,jme, kms,kme )  ! dimension of the field argument
    1165. 

  1165.    END SUBROUTINE relax_bdytend
    1166. 

  1166. 

  1167. ! version that allows tile-sized version of field. Note, caller should define the
    1168. 

  1168. ! field to be -+1 of tile size in each dimension because routine is going off onto halo
    1169. 

  1169. ! for example, see relax_bdytend in dyn_em/module_bc_em.F 
    1170. 

  1170.    SUBROUTINE relax_bdytend_tile   ( field, field_tend,                     &
    1171. 

  1171.                                 field_bdy_xs, field_bdy_xe,            &
    1172. 

  1172.                                 field_bdy_ys, field_bdy_ye,            &
    1173. 

  1173.                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
    1174. 

  1174.                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
    1175. 

  1175.                                 variable_in, config_flags,             &
    1176. 

  1176.                                 spec_bdy_width, spec_zone, relax_zone, &
    1177. 

  1177.                                 dtbc, fcx, gcx,             &
    1178. 

  1178.                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
    1179. 

  1179.                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
    1180. 

  1180.                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1181. 

  1181.                                 its,ite, jts,jte, kts,kte,  &
    1182. 

  1182.                                 iXs,iXe, jXs,jXe, kXs,kXe   &  ! dims of first argument
    1183. 

  1183.                                 )
    1184. 

  1184. 

  1185.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1186. 

  1186.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1187. 

  1187.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1188. 

  1188.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1189. 

  1189.       INTEGER,      INTENT(IN   )    :: iXs,iXe, jXs,jXe, kXs,kXe
    1190. 

  1190.       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
    1191. 

  1191.       REAL,         INTENT(IN   )    :: dtbc
    1192. 

  1192.       CHARACTER,    INTENT(IN   )    :: variable_in
    1193. 

  1193. 

  1194.       REAL,  DIMENSION( iXs:iXe , kXs:kXe , jXs:jXe ), INTENT(IN   ) :: field
    1195. 

  1195.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
    1196. 

  1196.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
    1197. 

  1197.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
    1198. 

  1198.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
    1199. 

  1199.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
    1200. 

  1200.       REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
    1201. 

  1201.       TYPE( grid_config_rec_type ) config_flags
    1202. 

  1202. 

  1203.       CALL relax_bdytend_core   ( field, field_tend,                     &
    1204. 

  1204.                                 field_bdy_xs, field_bdy_xe,            &
    1205. 

  1205.                                 field_bdy_ys, field_bdy_ye,            &
    1206. 

  1206.                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
    1207. 

  1207.                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
    1208. 

  1208.                                 variable_in, config_flags,             &
    1209. 

  1209.                                 spec_bdy_width, spec_zone, relax_zone, &
    1210. 

  1210.                                 dtbc, fcx, gcx,             &
    1211. 

  1211.                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
    1212. 

  1212.                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
    1213. 

  1213.                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1214. 

  1214.                                 its,ite, jts,jte, kts,kte,  &
    1215. 

  1215.                                 iXs,iXe, jXs,jXe, kXs,kXe )  ! dimension of the field argument
    1216. 

  1216.    END SUBROUTINE relax_bdytend_tile
    1217. 

  1217. 

  1218.    SUBROUTINE relax_bdytend_core   ( field, field_tend,                     &
    1219. 

  1219.                                 field_bdy_xs, field_bdy_xe,            &
    1220. 

  1220.                                 field_bdy_ys, field_bdy_ye,            &
    1221. 

  1221.                                 field_bdy_tend_xs, field_bdy_tend_xe,  &
    1222. 

  1222.                                 field_bdy_tend_ys, field_bdy_tend_ye,  &
    1223. 

  1223.                                 variable_in, config_flags,             &
    1224. 

  1224.                                 spec_bdy_width, spec_zone, relax_zone, &
    1225. 

  1225.                                 dtbc, fcx, gcx,             &
    1226. 

  1226.                                 ids,ide, jds,jde, kds,kde,  & ! domain dims
    1227. 

  1227.                                 ims,ime, jms,jme, kms,kme,  & ! memory dims
    1228. 

  1228.                                 ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1229. 

  1229.                                 its,ite, jts,jte, kts,kte,  & ! patch  dims
    1230. 

  1230.                                 iXs,iXe, jXs,jXe, kXs,kXe   & ! field (1st arg) dims; might be tile or patch
    1231. 

  1231.                                 )
    1232. 

  1232. 

  1233. !  This subroutine adds the tendencies in the boundary relaxation region, for specified
    1234. 

  1234. !  boundary conditions.  
    1235. 

  1235. !  spec_bdy_width is only used to dimension the boundary arrays.
    1236. 

  1236. !  relax_zone is the inner edge of the boundary relaxation zone treated here.
    1237. 

  1237. !  spec_zone is the width of the outer specified b.c.s that are not changed here.
    1238. 

  1238. !  (JD July 2000)
    1239. 

  1239. 

  1240.       IMPLICIT NONE
    1241. 

  1241. 

  1242.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1243. 

  1243.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1244. 

  1244.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1245. 

  1245.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1246. 

  1246.       INTEGER,      INTENT(IN   )    :: iXs,iXe, jXs,jXe, kXs,kXe
    1247. 

  1247.       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone, relax_zone
    1248. 

  1248.       REAL,         INTENT(IN   )    :: dtbc
    1249. 

  1249.       CHARACTER,    INTENT(IN   )    :: variable_in
    1250. 

  1250. 

  1251. 

  1252.       REAL,  DIMENSION( iXs:iXe , kXs:kXe , jXs:jXe ), INTENT(IN   ) :: field
    1253. 

  1253.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field_tend
    1254. 

  1254.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
    1255. 

  1255.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
    1256. 

  1256.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
    1257. 

  1257.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye
    1258. 

  1258.       REAL,  DIMENSION( spec_bdy_width ), INTENT(IN   ) :: fcx, gcx
    1259. 

  1259.       TYPE( grid_config_rec_type ) config_flags
    1260. 

  1260. 

  1261.       CHARACTER  :: variable
    1262. 

  1262.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, im1, ip1
    1263. 

  1263.       INTEGER    :: b_dist, b_limit
    1264. 

  1264.       REAL       :: fls0, fls1, fls2, fls3, fls4
    1265. 

  1265.       LOGICAL    :: periodic_x
    1266. 

  1266. 

  1267.       periodic_x = config_flags%periodic_x
    1268. 

  1268.       variable = variable_in
    1269. 

  1269. 

  1270.       IF (variable == 'U') variable = 'u'
    1271. 

  1271.       IF (variable == 'V') variable = 'v'
    1272. 

  1272.       IF (variable == 'M') variable = 'm'
    1273. 

  1273.       IF (variable == 'H') variable = 'h'
    1274. 

  1274. 

  1275.       ibs = ids
    1276. 

  1276.       ibe = ide-1
    1277. 

  1277.       itf = min(ite,ide-1)
    1278. 

  1278.       jbs = jds
    1279. 

  1279.       jbe = jde-1
    1280. 

  1280.       jtf = min(jte,jde-1)
    1281. 

  1281.       ktf = kde-1
    1282. 

  1282.       IF (variable == 'u') ibe = ide
    1283. 

  1283.       IF (variable == 'u') itf = min(ite,ide)
    1284. 

  1284.       IF (variable == 'v') jbe = jde
    1285. 

  1285.       IF (variable == 'v') jtf = min(jte,jde)
    1286. 

  1286.       IF (variable == 'm') ktf = kte
    1287. 

  1287.       IF (variable == 'h') ktf = kte
    1288. 

  1288. 

  1289. 

  1290.       IF (jts - jbs .lt. relax_zone) THEN
    1291. 

  1291. ! Y-start boundary
    1292. 

  1292.         DO j = max(jts,jbs+spec_zone), min(jtf,jbs+relax_zone-1)
    1293. 

  1293.           b_dist = j - jbs
    1294. 

  1294.           b_limit = b_dist
    1295. 

  1295.           IF(periodic_x)b_limit = 0
    1296. 

  1296.           DO k = kts, ktf
    1297. 

  1297.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1298. 

  1298.               im1 = max(i-1,ibs)
    1299. 

  1299.               ip1 = min(i+1,ibe)
    1300. 

  1300.               fls0 = field_bdy_ys(i, k, b_dist+1) &
    1301. 

  1301.                    + dtbc * field_bdy_tend_ys(i, k, b_dist+1) &
    1302. 

  1302.                    - field(i,k,j)
    1303. 

  1303.               fls1 = field_bdy_ys(im1, k, b_dist+1) &
    1304. 

  1304.                    + dtbc * field_bdy_tend_ys(im1, k, b_dist+1) &
    1305. 

  1305.                    - field(im1,k,j)
    1306. 

  1306.               fls2 = field_bdy_ys(ip1, k, b_dist+1) &
    1307. 

  1307.                    + dtbc * field_bdy_tend_ys(ip1, k, b_dist+1) &
    1308. 

  1308.                    - field(ip1,k,j)
    1309. 

  1309.               fls3 = field_bdy_ys(i, k, b_dist) &
    1310. 

  1310.                    + dtbc * field_bdy_tend_ys(i, k, b_dist) &
    1311. 

  1311.                    - field(i,k,j-1)
    1312. 

  1312.               fls4 = field_bdy_ys(i, k, b_dist+2) &
    1313. 

  1313.                    + dtbc * field_bdy_tend_ys(i, k, b_dist+2) &
    1314. 

  1314.                    - field(i,k,j+1)
    1315. 

  1315.               field_tend(i,k,j) = field_tend(i,k,j) &
    1316. 

  1316.                                 + fcx(b_dist+1)*fls0 &
    1317. 

  1317.                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
    1318. 

  1318.             ENDDO
    1319. 

  1319.           ENDDO
    1320. 

  1320.         ENDDO
    1321. 

  1321.       ENDIF
    1322. 

  1322. 

  1323.       IF (jbe - jtf .lt. relax_zone) THEN
    1324. 

  1324. 

  1325. 

  1326. ! Y-end boundary
    1327. 

  1327.         DO j = max(jts,jbe-relax_zone+1), min(jtf,jbe-spec_zone)
    1328. 

  1328.           b_dist = jbe - j
    1329. 

  1329.           b_limit = b_dist
    1330. 

  1330.           IF(periodic_x)b_limit = 0
    1331. 

  1331. 

  1332. 

  1333.           DO k = kts, ktf
    1334. 

  1334.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1335. 

  1335.               im1 = max(i-1,ibs)
    1336. 

  1336.               ip1 = min(i+1,ibe)
    1337. 

  1337.               fls0 = field_bdy_ye(i, k, b_dist+1) &
    1338. 

  1338.                    + dtbc * field_bdy_tend_ye(i, k, b_dist+1) &
    1339. 

  1339.                    - field(i,k,j)
    1340. 

  1340.               fls1 = field_bdy_ye(im1, k, b_dist+1) &
    1341. 

  1341.                    + dtbc * field_bdy_tend_ye(im1, k, b_dist+1) &
    1342. 

  1342.                    - field(im1,k,j)
    1343. 

  1343.               fls2 = field_bdy_ye(ip1, k, b_dist+1) &
    1344. 

  1344.                    + dtbc * field_bdy_tend_ye(ip1, k, b_dist+1) &
    1345. 

  1345.                    - field(ip1,k,j)
    1346. 

  1346.               fls3 = field_bdy_ye(i, k, b_dist) &
    1347. 

  1347.                    + dtbc * field_bdy_tend_ye(i, k, b_dist) &
    1348. 

  1348.                    - field(i,k,j+1)
    1349. 

  1349.               fls4 = field_bdy_ye(i, k, b_dist+2) &
    1350. 

  1350.                    + dtbc * field_bdy_tend_ye(i, k, b_dist+2) &
    1351. 

  1351.                    - field(i,k,j-1)
    1352. 

  1352.               field_tend(i,k,j) = field_tend(i,k,j) &
    1353. 

  1353.                                 + fcx(b_dist+1)*fls0 &
    1354. 

  1354.                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
    1355. 

  1355. 

  1356.             ENDDO
    1357. 

  1357.           ENDDO
    1358. 

  1358.         ENDDO
    1359. 

  1359.       ENDIF
    1360. 

  1360. 

  1361.     IF(.NOT.periodic_x)THEN
    1362. 

  1362.       IF (its - ibs .lt. relax_zone) THEN
    1363. 

  1363. ! X-start boundary
    1364. 

  1364.         DO i = max(its,ibs+spec_zone), min(itf,ibs+relax_zone-1)
    1365. 

  1365.           b_dist = i - ibs
    1366. 

  1366.           DO k = kts, ktf
    1367. 

  1367.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1368. 

  1368.               fls0 = field_bdy_xs(j, k, b_dist+1) &
    1369. 

  1369.                    + dtbc * field_bdy_tend_xs(j, k, b_dist+1) &
    1370. 

  1370.                    - field(i,k,j)
    1371. 

  1371.               fls1 = field_bdy_xs(j-1, k, b_dist+1) &
    1372. 

  1372.                    + dtbc * field_bdy_tend_xs(j-1, k, b_dist+1) &
    1373. 

  1373.                    - field(i,k,j-1)
    1374. 

  1374.               fls2 = field_bdy_xs(j+1, k, b_dist+1) &
    1375. 

  1375.                    + dtbc * field_bdy_tend_xs(j+1, k, b_dist+1) &
    1376. 

  1376.                    - field(i,k,j+1)
    1377. 

  1377.               fls3 = field_bdy_xs(j, k, b_dist) &
    1378. 

  1378.                    + dtbc * field_bdy_tend_xs(j, k, b_dist) &
    1379. 

  1379.                    - field(i-1,k,j)
    1380. 

  1380.               fls4 = field_bdy_xs(j, k, b_dist+2) &
    1381. 

  1381.                    + dtbc * field_bdy_tend_xs(j, k, b_dist+2) &
    1382. 

  1382.                    - field(i+1,k,j)
    1383. 

  1383.               field_tend(i,k,j) = field_tend(i,k,j) &
    1384. 

  1384.                                 + fcx(b_dist+1)*fls0 &
    1385. 

  1385.                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
    1386. 

  1386. 

  1387.             ENDDO
    1388. 

  1388.           ENDDO
    1389. 

  1389.         ENDDO
    1390. 

  1390.       ENDIF
    1391. 

  1391. 

  1392.       IF (ibe - itf .lt. relax_zone) THEN
    1393. 

  1393. ! X-end boundary
    1394. 

  1394.         DO i = max(its,ibe-relax_zone+1), min(itf,ibe-spec_zone)
    1395. 

  1395.           b_dist = ibe - i
    1396. 

  1396.           DO k = kts, ktf
    1397. 

  1397.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1398. 

  1398.               fls0 = field_bdy_xe(j, k, b_dist+1) &
    1399. 

  1399.                    + dtbc * field_bdy_tend_xe(j, k, b_dist+1) &
    1400. 

  1400.                    - field(i,k,j)
    1401. 

  1401.               fls1 = field_bdy_xe(j-1, k, b_dist+1) &
    1402. 

  1402.                    + dtbc * field_bdy_tend_xe(j-1, k, b_dist+1) &
    1403. 

  1403.                    - field(i,k,j-1)
    1404. 

  1404.               fls2 = field_bdy_xe(j+1, k, b_dist+1) &
    1405. 

  1405.                    + dtbc * field_bdy_tend_xe(j+1, k, b_dist+1) &
    1406. 

  1406.                    - field(i,k,j+1)
    1407. 

  1407.               fls3 = field_bdy_xe(j, k, b_dist) &
    1408. 

  1408.                    + dtbc * field_bdy_tend_xe(j, k, b_dist) &
    1409. 

  1409.                    - field(i+1,k,j)
    1410. 

  1410.               fls4 = field_bdy_xe(j, k, b_dist+2) &
    1411. 

  1411.                    + dtbc * field_bdy_tend_xe(j, k, b_dist+2) &
    1412. 

  1412.                    - field(i-1,k,j)
    1413. 

  1413.               field_tend(i,k,j) = field_tend(i,k,j) &
    1414. 

  1414.                                 + fcx(b_dist+1)*fls0 &
    1415. 

  1415.                                 - gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
    1416. 

  1416.             ENDDO
    1417. 

  1417.           ENDDO
    1418. 

  1418.         ENDDO
    1419. 

  1419.       ENDIF
    1420. 

  1420.     ENDIF
    1421. 

  1421. 

  1422. 

  1423. 

  1424.    END SUBROUTINE relax_bdytend_core
    1425. 

  1425. !------------------------------------------------------------------------
    1426. 

  1426. 

  1427.    SUBROUTINE spec_bdytend   ( field_tend,                           &
    1428. 

  1428.                                field_bdy_xs, field_bdy_xe,           &
    1429. 

  1429.                                field_bdy_ys, field_bdy_ye,           &
    1430. 

  1430.                                field_bdy_tend_xs, field_bdy_tend_xe, &
    1431. 

  1431.                                field_bdy_tend_ys, field_bdy_tend_ye, &
    1432. 

  1432.                                variable_in, config_flags, & 
    1433. 

  1433.                                spec_bdy_width, spec_zone, &
    1434. 

  1434.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    1435. 

  1435.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    1436. 

  1436.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1437. 

  1437.                                its,ite, jts,jte, kts,kte )
    1438. 

  1438. 

  1439. !  This subroutine sets the tendencies in the boundary specified region.
    1440. 

  1440. !  spec_bdy_width is only used to dimension the boundary arrays.
    1441. 

  1441. !  spec_zone is the width of the outer specified b.c.s that are set here.
    1442. 

  1442. !  (JD July 2000)
    1443. 

  1443. 

  1444.       IMPLICIT NONE
    1445. 

  1445. 

  1446.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1447. 

  1447.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1448. 

  1448.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1449. 

  1449.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1450. 

  1450.       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone
    1451. 

  1451.       CHARACTER,    INTENT(IN   )    :: variable_in
    1452. 

  1452. 

  1453. 

  1454.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT  ) :: field_tend
    1455. 

  1455.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
    1456. 

  1456.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye 
    1457. 

  1457.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_xs, field_bdy_tend_xe
    1458. 

  1458.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_tend_ys, field_bdy_tend_ye 
    1459. 

  1459.       TYPE( grid_config_rec_type ) config_flags
    1460. 

  1460. 

  1461.       CHARACTER  :: variable
    1462. 

  1462.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
    1463. 

  1463.       INTEGER    :: b_dist, b_limit
    1464. 

  1464.       LOGICAL    :: periodic_x
    1465. 

  1465. 

  1466.       periodic_x = config_flags%periodic_x
    1467. 

  1467. 

  1468.       variable = variable_in
    1469. 

  1469. 

  1470.       IF (variable == 'U') variable = 'u'
    1471. 

  1471.       IF (variable == 'V') variable = 'v'
    1472. 

  1472.       IF (variable == 'M') variable = 'm'
    1473. 

  1473.       IF (variable == 'H') variable = 'h'
    1474. 

  1474. 

  1475.       ibs = ids
    1476. 

  1476.       ibe = ide-1
    1477. 

  1477.       itf = min(ite,ide-1)
    1478. 

  1478.       jbs = jds
    1479. 

  1479.       jbe = jde-1
    1480. 

  1480.       jtf = min(jte,jde-1)
    1481. 

  1481.       ktf = kde-1
    1482. 

  1482.       IF (variable == 'u') ibe = ide
    1483. 

  1483.       IF (variable == 'u') itf = min(ite,ide)
    1484. 

  1484.       IF (variable == 'v') jbe = jde
    1485. 

  1485.       IF (variable == 'v') jtf = min(jte,jde)
    1486. 

  1486.       IF (variable == 'm') ktf = kte
    1487. 

  1487.       IF (variable == 'h') ktf = kte
    1488. 

  1488. 

  1489.       IF (jts - jbs .lt. spec_zone) THEN
    1490. 

  1490. ! Y-start boundary
    1491. 

  1491.         DO j = jts, min(jtf,jbs+spec_zone-1)
    1492. 

  1492.           b_dist = j - jbs
    1493. 

  1493.           b_limit = b_dist
    1494. 

  1494.           IF(periodic_x)b_limit = 0
    1495. 

  1495.           DO k = kts, ktf
    1496. 

  1496.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1497. 

  1497.               field_tend(i,k,j) = field_bdy_tend_ys(i, k, b_dist+1)
    1498. 

  1498.             ENDDO
    1499. 

  1499.           ENDDO
    1500. 

  1500.         ENDDO
    1501. 

  1501.       ENDIF 
    1502. 

  1502.       IF (jbe - jtf .lt. spec_zone) THEN 
    1503. 

  1503. 

  1504. 

  1505. ! Y-end boundary 
    1506. 

  1506.         DO j = max(jts,jbe-spec_zone+1), jtf 
    1507. 

  1507.           b_dist = jbe - j 
    1508. 

  1508.           b_limit = b_dist
    1509. 

  1509.           IF(periodic_x)b_limit = 0
    1510. 

  1510. 

  1511. 

  1512.           DO k = kts, ktf 
    1513. 

  1513.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1514. 

  1514.               field_tend(i,k,j) = field_bdy_tend_ye(i, k, b_dist+1)
    1515. 

  1515.             ENDDO
    1516. 

  1516.           ENDDO
    1517. 

  1517.         ENDDO
    1518. 

  1518.       ENDIF 
    1519. 

  1519. 

  1520.     IF(.NOT.periodic_x)THEN
    1521. 

  1521.       IF (its - ibs .lt. spec_zone) THEN
    1522. 

  1522. ! X-start boundary
    1523. 

  1523.         DO i = its, min(itf,ibs+spec_zone-1)
    1524. 

  1524.           b_dist = i - ibs
    1525. 

  1525.           DO k = kts, ktf
    1526. 

  1526.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1527. 

  1527.               field_tend(i,k,j) = field_bdy_tend_xs(j, k, b_dist+1)
    1528. 

  1528.             ENDDO
    1529. 

  1529.           ENDDO
    1530. 

  1530.         ENDDO
    1531. 

  1531.       ENDIF 
    1532. 

  1532. 

  1533.       IF (ibe - itf .lt. spec_zone) THEN
    1534. 

  1534. ! X-end boundary
    1535. 

  1535.         DO i = max(its,ibe-spec_zone+1), itf
    1536. 

  1536.           b_dist = ibe - i
    1537. 

  1537.           DO k = kts, ktf
    1538. 

  1538.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1539. 

  1539.               field_tend(i,k,j) = field_bdy_tend_xe(j, k, b_dist+1)
    1540. 

  1540.             ENDDO
    1541. 

  1541.           ENDDO
    1542. 

  1542.         ENDDO
    1543. 

  1543.       ENDIF 
    1544. 

  1544.     ENDIF
    1545. 

  1545. 

  1546.    END SUBROUTINE spec_bdytend
    1547. 

  1547. !------------------------------------------------------------------------
    1548. 

  1548. 

  1549.    SUBROUTINE spec_bdyfield   ( field,                     &
    1550. 

  1550.                                field_bdy_xs, field_bdy_xe,           &
    1551. 

  1551.                                field_bdy_ys, field_bdy_ye,           &
    1552. 

  1552.                                variable_in, config_flags,  & 
    1553. 

  1553.                                spec_bdy_width, spec_zone, &
    1554. 

  1554.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    1555. 

  1555.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    1556. 

  1556.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1557. 

  1557.                                its,ite, jts,jte, kts,kte )
    1558. 

  1558. 

  1559. !  This subroutine sets the tendencies in the boundary specified region.
    1560. 

  1560. !  spec_bdy_width is only used to dimension the boundary arrays.
    1561. 

  1561. !  spec_zone is the width of the outer specified b.c.s that are set here.
    1562. 

  1562. !  (JD July 2000)
    1563. 

  1563. 

  1564.       IMPLICIT NONE
    1565. 

  1565. 

  1566.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1567. 

  1567.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1568. 

  1568.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1569. 

  1569.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1570. 

  1570.       INTEGER,      INTENT(IN   )    :: spec_bdy_width, spec_zone
    1571. 

  1571.       CHARACTER,    INTENT(IN   )    :: variable_in
    1572. 

  1572. 

  1573. 

  1574.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT  ) :: field
    1575. 

  1575.       REAL,  DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_xs, field_bdy_xe
    1576. 

  1576.       REAL,  DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN   ) :: field_bdy_ys, field_bdy_ye
    1577. 

  1577.       TYPE( grid_config_rec_type ) config_flags
    1578. 

  1578. 

  1579.       CHARACTER  :: variable
    1580. 

  1580.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
    1581. 

  1581.       INTEGER    :: b_dist, b_limit
    1582. 

  1582.       LOGICAL    :: periodic_x
    1583. 

  1583. 

  1584.       periodic_x = config_flags%periodic_x
    1585. 

  1585. 

  1586.       variable = variable_in
    1587. 

  1587. 

  1588.       IF (variable == 'U') variable = 'u'
    1589. 

  1589.       IF (variable == 'V') variable = 'v'
    1590. 

  1590.       IF (variable == 'M') variable = 'm'
    1591. 

  1591.       IF (variable == 'H') variable = 'h'
    1592. 

  1592. 

  1593.       ibs = ids
    1594. 

  1594.       ibe = ide-1
    1595. 

  1595.       itf = min(ite,ide-1)
    1596. 

  1596.       jbs = jds
    1597. 

  1597.       jbe = jde-1
    1598. 

  1598.       jtf = min(jte,jde-1)
    1599. 

  1599.       ktf = kde-1
    1600. 

  1600.       IF (variable == 'u') ibe = ide
    1601. 

  1601.       IF (variable == 'u') itf = min(ite,ide)
    1602. 

  1602.       IF (variable == 'v') jbe = jde
    1603. 

  1603.       IF (variable == 'v') jtf = min(jte,jde)
    1604. 

  1604.       IF (variable == 'm') ktf = kte
    1605. 

  1605.       IF (variable == 'h') ktf = kte
    1606. 

  1606. 

  1607.       IF (jts - jbs .lt. spec_zone) THEN
    1608. 

  1608. ! Y-start boundary
    1609. 

  1609.         DO j = jts, min(jtf,jbs+spec_zone-1)
    1610. 

  1610.           b_dist = j - jbs
    1611. 

  1611.           b_limit = b_dist
    1612. 

  1612.           IF(periodic_x)b_limit = 0
    1613. 

  1613.           DO k = kts, ktf
    1614. 

  1614.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1615. 

  1615.               field(i,k,j) = field_bdy_ys(i, k, b_dist+1)
    1616. 

  1616.             ENDDO
    1617. 

  1617.           ENDDO
    1618. 

  1618.         ENDDO
    1619. 

  1619.       ENDIF
    1620. 

  1620.       IF (jbe - jtf .lt. spec_zone) THEN
    1621. 

  1621. ! Y-end boundary
    1622. 

  1622.         DO j = max(jts,jbe-spec_zone+1), jtf
    1623. 

  1623.           b_dist = jbe - j
    1624. 

  1624.           b_limit = b_dist
    1625. 

  1625.           IF(periodic_x)b_limit = 0
    1626. 

  1626.           DO k = kts, ktf
    1627. 

  1627.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1628. 

  1628.               field(i,k,j) = field_bdy_ye(i, k, b_dist+1)
    1629. 

  1629.             ENDDO
    1630. 

  1630.           ENDDO
    1631. 

  1631.         ENDDO
    1632. 

  1632.       ENDIF
    1633. 

  1633. 

  1634.     IF(.NOT.periodic_x)THEN
    1635. 

  1635.       IF (its - ibs .lt. spec_zone) THEN
    1636. 

  1636. ! X-start boundary
    1637. 

  1637.         DO i = its, min(itf,ibs+spec_zone-1)
    1638. 

  1638.           b_dist = i - ibs
    1639. 

  1639.           DO k = kts, ktf
    1640. 

  1640.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1641. 

  1641.               field(i,k,j) = field_bdy_xs(j, k, b_dist+1)
    1642. 

  1642.             ENDDO
    1643. 

  1643.           ENDDO
    1644. 

  1644.         ENDDO
    1645. 

  1645.       ENDIF
    1646. 

  1646. 

  1647.       IF (ibe - itf .lt. spec_zone) THEN
    1648. 

  1648. ! X-end boundary
    1649. 

  1649.         DO i = max(its,ibe-spec_zone+1), itf
    1650. 

  1650.           b_dist = ibe - i
    1651. 

  1651.           DO k = kts, ktf
    1652. 

  1652.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1653. 

  1653.               field(i,k,j) = field_bdy_xe(j, k, b_dist+1)
    1654. 

  1654.             ENDDO
    1655. 

  1655.           ENDDO
    1656. 

  1656.         ENDDO
    1657. 

  1657.       ENDIF
    1658. 

  1658.     ENDIF
    1659. 

  1659. 

  1660.    END SUBROUTINE spec_bdyfield
    1661. 

  1661. !------------------------------------------------------------------------
    1662. 

  1662. 

  1663.    SUBROUTINE spec_bdyupdate(  field,      &
    1664. 

  1664.                                field_tend, dt,            &
    1665. 

  1665.                                variable_in, config_flags, & 
    1666. 

  1666.                                spec_zone,                  &
    1667. 

  1667.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    1668. 

  1668.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    1669. 

  1669.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1670. 

  1670.                                its,ite, jts,jte, kts,kte )
    1671. 

  1671. 

  1672. !  This subroutine adds the tendencies in the boundary specified region.
    1673. 

  1673. !  spec_zone is the width of the outer specified b.c.s that are set here.
    1674. 

  1674. !  (JD August 2000)
    1675. 

  1675. 

  1676.       IMPLICIT NONE
    1677. 

  1677. 

  1678.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1679. 

  1679.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1680. 

  1680.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1681. 

  1681.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1682. 

  1682.       INTEGER,      INTENT(IN   )    :: spec_zone
    1683. 

  1683.       CHARACTER,    INTENT(IN   )    :: variable_in
    1684. 

  1684.       REAL,         INTENT(IN   )    :: dt
    1685. 

  1685. 

  1686. 

  1687.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
    1688. 

  1688.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: field_tend
    1689. 

  1689.       TYPE( grid_config_rec_type ) config_flags
    1690. 

  1690. 

  1691.       CHARACTER  :: variable
    1692. 

  1692.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
    1693. 

  1693.       INTEGER    :: b_dist, b_limit
    1694. 

  1694.       LOGICAL    :: periodic_x
    1695. 

  1695. 

  1696.       periodic_x = config_flags%periodic_x
    1697. 

  1697. 

  1698.       variable = variable_in
    1699. 

  1699. 

  1700.       IF (variable == 'U') variable = 'u'
    1701. 

  1701.       IF (variable == 'V') variable = 'v'
    1702. 

  1702.       IF (variable == 'M') variable = 'm'
    1703. 

  1703.       IF (variable == 'H') variable = 'h'
    1704. 

  1704. 

  1705.       ibs = ids
    1706. 

  1706.       ibe = ide-1
    1707. 

  1707.       itf = min(ite,ide-1)
    1708. 

  1708.       jbs = jds
    1709. 

  1709.       jbe = jde-1
    1710. 

  1710.       jtf = min(jte,jde-1)
    1711. 

  1711.       ktf = kde-1
    1712. 

  1712.       IF (variable == 'u') ibe = ide
    1713. 

  1713.       IF (variable == 'u') itf = min(ite,ide)
    1714. 

  1714.       IF (variable == 'v') jbe = jde
    1715. 

  1715.       IF (variable == 'v') jtf = min(jte,jde)
    1716. 

  1716.       IF (variable == 'm') ktf = kte
    1717. 

  1717.       IF (variable == 'h') ktf = kte
    1718. 

  1718. 

  1719.       IF (jts - jbs .lt. spec_zone) THEN
    1720. 

  1720. ! Y-start boundary
    1721. 

  1721.         DO j = jts, min(jtf,jbs+spec_zone-1)
    1722. 

  1722.           b_dist = j - jbs
    1723. 

  1723.           b_limit = b_dist
    1724. 

  1724.           IF(periodic_x)b_limit = 0
    1725. 

  1725.           DO k = kts, ktf
    1726. 

  1726.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1727. 

  1727.               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
    1728. 

  1728.             ENDDO
    1729. 

  1729.           ENDDO
    1730. 

  1730.         ENDDO
    1731. 

  1731.       ENDIF 
    1732. 

  1732.       IF (jbe - jtf .lt. spec_zone) THEN 
    1733. 

  1733. ! Y-end boundary 
    1734. 

  1734.         DO j = max(jts,jbe-spec_zone+1), jtf 
    1735. 

  1735.           b_dist = jbe - j 
    1736. 

  1736.           b_limit = b_dist
    1737. 

  1737.           IF(periodic_x)b_limit = 0
    1738. 

  1738.           DO k = kts, ktf 
    1739. 

  1739.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1740. 

  1740.               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
    1741. 

  1741.             ENDDO
    1742. 

  1742.           ENDDO
    1743. 

  1743.         ENDDO
    1744. 

  1744.       ENDIF 
    1745. 

  1745. 

  1746.     IF(.NOT.periodic_x)THEN
    1747. 

  1747.       IF (its - ibs .lt. spec_zone) THEN
    1748. 

  1748. ! X-start boundary
    1749. 

  1749.         DO i = its, min(itf,ibs+spec_zone-1)
    1750. 

  1750.           b_dist = i - ibs
    1751. 

  1751.           DO k = kts, ktf
    1752. 

  1752.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1753. 

  1753.               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
    1754. 

  1754.             ENDDO
    1755. 

  1755.           ENDDO
    1756. 

  1756.         ENDDO
    1757. 

  1757.       ENDIF 
    1758. 

  1758. 

  1759.       IF (ibe - itf .lt. spec_zone) THEN
    1760. 

  1760. ! X-end boundary
    1761. 

  1761.         DO i = max(its,ibe-spec_zone+1), itf
    1762. 

  1762.           b_dist = ibe - i
    1763. 

  1763.           DO k = kts, ktf
    1764. 

  1764.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1765. 

  1765.               field(i,k,j) = field(i,k,j) + dt*field_tend(i,k,j) 
    1766. 

  1766.             ENDDO
    1767. 

  1767.           ENDDO
    1768. 

  1768.         ENDDO
    1769. 

  1769.       ENDIF 
    1770. 

  1770.     ENDIF
    1771. 

  1771. 

  1772.    END SUBROUTINE spec_bdyupdate
    1773. 

  1773. !------------------------------------------------------------------------
    1774. 

  1774. 

  1775.    SUBROUTINE zero_grad_bdy (  field,                     &
    1776. 

  1776.                                variable_in, config_flags, & 
    1777. 

  1777.                                spec_zone,                  &
    1778. 

  1778.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    1779. 

  1779.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    1780. 

  1780.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1781. 

  1781.                                its,ite, jts,jte, kts,kte )
    1782. 

  1782. 

  1783. !  This subroutine sets zero gradient conditions in the boundary specified region.
    1784. 

  1784. !  spec_zone is the width of the outer specified b.c.s that are set here.
    1785. 

  1785. !  (JD August 2000)
    1786. 

  1786. 

  1787.       IMPLICIT NONE
    1788. 

  1788. 

  1789.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1790. 

  1790.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1791. 

  1791.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1792. 

  1792.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1793. 

  1793.       INTEGER,      INTENT(IN   )    :: spec_zone
    1794. 

  1794.       CHARACTER,    INTENT(IN   )    :: variable_in
    1795. 

  1795. 

  1796. 

  1797.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
    1798. 

  1798.       TYPE( grid_config_rec_type ) config_flags
    1799. 

  1799. 

  1800.       CHARACTER  :: variable
    1801. 

  1801.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
    1802. 

  1802.       INTEGER    :: b_dist, b_limit
    1803. 

  1803.       LOGICAL    :: periodic_x
    1804. 

  1804. 

  1805.       periodic_x = config_flags%periodic_x
    1806. 

  1806. 

  1807.       variable = variable_in
    1808. 

  1808. 

  1809.       IF (variable == 'U') variable = 'u'
    1810. 

  1810.       IF (variable == 'V') variable = 'v'
    1811. 

  1811. 

  1812.       ibs = ids
    1813. 

  1813.       ibe = ide-1
    1814. 

  1814.       itf = min(ite,ide-1)
    1815. 

  1815.       jbs = jds
    1816. 

  1816.       jbe = jde-1
    1817. 

  1817.       jtf = min(jte,jde-1)
    1818. 

  1818.       ktf = kde-1
    1819. 

  1819.       IF (variable == 'u') ibe = ide
    1820. 

  1820.       IF (variable == 'u') itf = min(ite,ide)
    1821. 

  1821.       IF (variable == 'v') jbe = jde
    1822. 

  1822.       IF (variable == 'v') jtf = min(jte,jde)
    1823. 

  1823.       IF (variable == 'w') ktf = kde
    1824. 

  1824. 

  1825.       IF (jts - jbs .lt. spec_zone) THEN
    1826. 

  1826. ! Y-start boundary
    1827. 

  1827.         DO j = jts, min(jtf,jbs+spec_zone-1)
    1828. 

  1828.           b_dist = j - jbs
    1829. 

  1829.           b_limit = b_dist
    1830. 

  1830.           IF(periodic_x)b_limit = 0
    1831. 

  1831.           DO k = kts, ktf
    1832. 

  1832.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1833. 

  1833.               i_inner = max(i,ibs+spec_zone)
    1834. 

  1834.               i_inner = min(i_inner,ibe-spec_zone)
    1835. 

  1835.               IF(periodic_x)i_inner = i
    1836. 

  1836.               field(i,k,j) = field(i_inner,k,jbs+spec_zone)
    1837. 

  1837.             ENDDO
    1838. 

  1838.           ENDDO
    1839. 

  1839.         ENDDO
    1840. 

  1840.       ENDIF 
    1841. 

  1841.       IF (jbe - jtf .lt. spec_zone) THEN 
    1842. 

  1842. ! Y-end boundary 
    1843. 

  1843.         DO j = max(jts,jbe-spec_zone+1), jtf 
    1844. 

  1844.           b_dist = jbe - j 
    1845. 

  1845.           b_limit = b_dist
    1846. 

  1846.           IF(periodic_x)b_limit = 0
    1847. 

  1847.           DO k = kts, ktf 
    1848. 

  1848.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1849. 

  1849.               i_inner = max(i,ibs+spec_zone)
    1850. 

  1850.               i_inner = min(i_inner,ibe-spec_zone)
    1851. 

  1851.               IF(periodic_x)i_inner = i
    1852. 

  1852.               field(i,k,j) = field(i_inner,k,jbe-spec_zone)
    1853. 

  1853.             ENDDO
    1854. 

  1854.           ENDDO
    1855. 

  1855.         ENDDO
    1856. 

  1856.       ENDIF 
    1857. 

  1857. 

  1858.     IF(.NOT.periodic_x)THEN
    1859. 

  1859.       IF (its - ibs .lt. spec_zone) THEN
    1860. 

  1860. ! X-start boundary
    1861. 

  1861.         DO i = its, min(itf,ibs+spec_zone-1)
    1862. 

  1862.           b_dist = i - ibs
    1863. 

  1863.           DO k = kts, ktf
    1864. 

  1864.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1865. 

  1865.               j_inner = max(j,jbs+spec_zone)
    1866. 

  1866.               j_inner = min(j_inner,jbe-spec_zone)
    1867. 

  1867.               field(i,k,j) = field(ibs+spec_zone,k,j_inner)
    1868. 

  1868.             ENDDO
    1869. 

  1869.           ENDDO
    1870. 

  1870.         ENDDO
    1871. 

  1871.       ENDIF 
    1872. 

  1872. 

  1873.       IF (ibe - itf .lt. spec_zone) THEN
    1874. 

  1874. ! X-end boundary
    1875. 

  1875.         DO i = max(its,ibe-spec_zone+1), itf
    1876. 

  1876.           b_dist = ibe - i
    1877. 

  1877.           DO k = kts, ktf
    1878. 

  1878.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1879. 

  1879.               j_inner = max(j,jbs+spec_zone)
    1880. 

  1880.               j_inner = min(j_inner,jbe-spec_zone)
    1881. 

  1881.               field(i,k,j) = field(ibe-spec_zone,k,j_inner)
    1882. 

  1882.             ENDDO
    1883. 

  1883.           ENDDO
    1884. 

  1884.         ENDDO
    1885. 

  1885.       ENDIF 
    1886. 

  1886.     ENDIF
    1887. 

  1887. 

  1888.    END SUBROUTINE zero_grad_bdy
    1889. 

  1889. !------------------------------------------------------------------------
    1890. 

  1890. 

  1891.    SUBROUTINE flow_dep_bdy  (  field,                     &
    1892. 

  1892.                                u, v, config_flags, & 
    1893. 

  1893.                                spec_zone,                  &
    1894. 

  1894.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    1895. 

  1895.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    1896. 

  1896.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    1897. 

  1897.                                its,ite, jts,jte, kts,kte )
    1898. 

  1898. 

  1899. !  This subroutine sets zero gradient conditions for outflow and zero value
    1900. 

  1900. !  for inflow in the boundary specified region. Note that field must be unstaggered.
    1901. 

  1901. !  The velocities, u and v, will only be used to check their sign (coupled vels OK)
    1902. 

  1902. !  spec_zone is the width of the outer specified b.c.s that are set here.
    1903. 

  1903. !  (JD August 2000)
    1904. 

  1904. 

  1905.       IMPLICIT NONE
    1906. 

  1906. 

  1907.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    1908. 

  1908.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    1909. 

  1909.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    1910. 

  1910.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    1911. 

  1911.       INTEGER,      INTENT(IN   )    :: spec_zone
    1912. 

  1912. 

  1913. 

  1914.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
    1915. 

  1915.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: u
    1916. 

  1916.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: v
    1917. 

  1917.       TYPE( grid_config_rec_type ) config_flags
    1918. 

  1918. 

  1919.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
    1920. 

  1920.       INTEGER    :: b_dist, b_limit
    1921. 

  1921.       LOGICAL    :: periodic_x
    1922. 

  1922. 

  1923.       periodic_x = config_flags%periodic_x
    1924. 

  1924. 

  1925.       ibs = ids
    1926. 

  1926.       ibe = ide-1
    1927. 

  1927.       itf = min(ite,ide-1)
    1928. 

  1928.       jbs = jds
    1929. 

  1929.       jbe = jde-1
    1930. 

  1930.       jtf = min(jte,jde-1)
    1931. 

  1931.       ktf = kde-1
    1932. 

  1932. 

  1933.       IF (jts - jbs .lt. spec_zone) THEN
    1934. 

  1934. ! Y-start boundary
    1935. 

  1935.         DO j = jts, min(jtf,jbs+spec_zone-1)
    1936. 

  1936.           b_dist = j - jbs
    1937. 

  1937.           b_limit = b_dist
    1938. 

  1938.           IF(periodic_x)b_limit = 0
    1939. 

  1939.           DO k = kts, ktf
    1940. 

  1940.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1941. 

  1941.               i_inner = max(i,ibs+spec_zone)
    1942. 

  1942.               i_inner = min(i_inner,ibe-spec_zone)
    1943. 

  1943.               IF(periodic_x)i_inner = i
    1944. 

  1944.               IF(v(i,k,j) .lt. 0.)THEN
    1945. 

  1945.                 field(i,k,j) = field(i_inner,k,jbs+spec_zone)
    1946. 

  1946.               ELSE
    1947. 

  1947.                 field(i,k,j) = 0.
    1948. 

  1948.               ENDIF
    1949. 

  1949.             ENDDO
    1950. 

  1950.           ENDDO
    1951. 

  1951.         ENDDO
    1952. 

  1952.       ENDIF 
    1953. 

  1953.       IF (jbe - jtf .lt. spec_zone) THEN 
    1954. 

  1954. ! Y-end boundary 
    1955. 

  1955.         DO j = max(jts,jbe-spec_zone+1), jtf 
    1956. 

  1956.           b_dist = jbe - j 
    1957. 

  1957.           b_limit = b_dist
    1958. 

  1958.           IF(periodic_x)b_limit = 0
    1959. 

  1959.           DO k = kts, ktf 
    1960. 

  1960.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    1961. 

  1961.               i_inner = max(i,ibs+spec_zone)
    1962. 

  1962.               i_inner = min(i_inner,ibe-spec_zone)
    1963. 

  1963.               IF(periodic_x)i_inner = i
    1964. 

  1964.               IF(v(i,k,j+1) .gt. 0.)THEN
    1965. 

  1965.                 field(i,k,j) = field(i_inner,k,jbe-spec_zone)
    1966. 

  1966.               ELSE
    1967. 

  1967.                 field(i,k,j) = 0.
    1968. 

  1968.               ENDIF
    1969. 

  1969.             ENDDO
    1970. 

  1970.           ENDDO
    1971. 

  1971.         ENDDO
    1972. 

  1972.       ENDIF 
    1973. 

  1973. 

  1974.     IF(.NOT.periodic_x)THEN
    1975. 

  1975.       IF (its - ibs .lt. spec_zone) THEN
    1976. 

  1976. ! X-start boundary
    1977. 

  1977.         DO i = its, min(itf,ibs+spec_zone-1)
    1978. 

  1978.           b_dist = i - ibs
    1979. 

  1979.           DO k = kts, ktf
    1980. 

  1980.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1981. 

  1981.               j_inner = max(j,jbs+spec_zone)
    1982. 

  1982.               j_inner = min(j_inner,jbe-spec_zone)
    1983. 

  1983.               IF(u(i,k,j) .lt. 0.)THEN
    1984. 

  1984.                 field(i,k,j) = field(ibs+spec_zone,k,j_inner)
    1985. 

  1985.               ELSE
    1986. 

  1986.                 field(i,k,j) = 0.
    1987. 

  1987.               ENDIF
    1988. 

  1988.             ENDDO
    1989. 

  1989.           ENDDO
    1990. 

  1990.         ENDDO
    1991. 

  1991.       ENDIF 
    1992. 

  1992. 

  1993.       IF (ibe - itf .lt. spec_zone) THEN
    1994. 

  1994. ! X-end boundary
    1995. 

  1995.         DO i = max(its,ibe-spec_zone+1), itf
    1996. 

  1996.           b_dist = ibe - i
    1997. 

  1997.           DO k = kts, ktf
    1998. 

  1998.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    1999. 

  1999.               j_inner = max(j,jbs+spec_zone)
    2000. 

  2000.               j_inner = min(j_inner,jbe-spec_zone)
    2001. 

  2001.               IF(u(i+1,k,j) .gt. 0.)THEN
    2002. 

  2002.                 field(i,k,j) = field(ibe-spec_zone,k,j_inner)
    2003. 

  2003.               ELSE
    2004. 

  2004.                 field(i,k,j) = 0.
    2005. 

  2005.               ENDIF
    2006. 

  2006.             ENDDO
    2007. 

  2007.           ENDDO
    2008. 

  2008.         ENDDO
    2009. 

  2009.       ENDIF 
    2010. 

  2010.     ENDIF
    2011. 

  2011. 

  2012.    END SUBROUTINE flow_dep_bdy
    2013. 

  2013. 

  2014. !------------------------------------------------------------------------------
    2015. 

  2015. 

  2016.    SUBROUTINE flow_dep_bdy_qnn  (  field,          &
    2017. 

  2017.                                u, v, config_flags, &
    2018. 

  2018.                                spec_zone,                  &
    2019. 

  2019.                                ids,ide, jds,jde, kds,kde,  & ! domain dims
    2020. 

  2020.                                ims,ime, jms,jme, kms,kme,  & ! memory dims
    2021. 

  2021.                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
    2022. 

  2022.                                its,ite, jts,jte, kts,kte )
    2023. 

  2023. 

  2024. !  This subroutine sets zero gradient conditions for outflow and zero value
    2025. 

  2025. !  for inflow in the boundary specified region. Note that field must be unstaggered.
    2026. 

  2026. !  The velocities, u and v, will only be used to check their sign (coupled vels OK)
    2027. 

  2027. !  spec_zone is the width of the outer specified b.c.s that are set here.
    2028. 

  2028. !  (JD August 2000)
    2029. 

  2029. 

  2030.       IMPLICIT NONE
    2031. 

  2031. 

  2032.       INTEGER,      INTENT(IN   )    :: ids,ide, jds,jde, kds,kde
    2033. 

  2033.       INTEGER,      INTENT(IN   )    :: ims,ime, jms,jme, kms,kme
    2034. 

  2034.       INTEGER,      INTENT(IN   )    :: ips,ipe, jps,jpe, kps,kpe
    2035. 

  2035.       INTEGER,      INTENT(IN   )    :: its,ite, jts,jte, kts,kte
    2036. 

  2036.       INTEGER,      INTENT(IN   )    :: spec_zone
    2037. 

  2037. 

  2038. 

  2039.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
    2040. 

  2040.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: u
    2041. 

  2041.       REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN   ) :: v
    2042. 

  2042.       TYPE( grid_config_rec_type ) config_flags
    2043. 

  2043. 

  2044.       INTEGER    :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf, i_inner, j_inner
    2045. 

  2045.       INTEGER    :: b_dist, b_limit
    2046. 

  2046.       LOGICAL    :: periodic_x
    2047. 

  2047. 

  2048.       periodic_x = config_flags%periodic_x
    2049. 

  2049. 

  2050.       ibs = ids
    2051. 

  2051.       ibe = ide-1
    2052. 

  2052.       itf = min(ite,ide-1)
    2053. 

  2053.       jbs = jds
    2054. 

  2054.       jbe = jde-1
    2055. 

  2055.       jtf = min(jte,jde-1)
    2056. 

  2056.       ktf = kde-1
    2057. 

  2057. 

  2058.       IF (jts - jbs .lt. spec_zone) THEN
    2059. 

  2059. ! Y-start boundary
    2060. 

  2060.         DO j = jts, min(jtf,jbs+spec_zone-1)
    2061. 

  2061.           b_dist = j - jbs
    2062. 

  2062.           b_limit = b_dist
    2063. 

  2063.           IF(periodic_x)b_limit = 0
    2064. 

  2064.           DO k = kts, ktf
    2065. 

  2065.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    2066. 

  2066.               i_inner = max(i,ibs+spec_zone)
    2067. 

  2067.               i_inner = min(i_inner,ibe-spec_zone)
    2068. 

  2068.               IF(periodic_x)i_inner = i
    2069. 

  2069.               IF(v(i,k,j) .lt. 0.)THEN
    2070. 

  2070.                 field(i,k,j) = field(i_inner,k,jbs+spec_zone)
    2071. 

  2071.               ELSE
    2072. 

  2072.                 field(i,k,j) = n_ccn0
    2073. 

  2073.               ENDIF
    2074. 

  2074.             ENDDO
    2075. 

  2075.           ENDDO
    2076. 

  2076.         ENDDO 
    2077. 

  2077.       ENDIF   
    2078. 

  2078.       IF (jbe - jtf .lt. spec_zone) THEN
    2079. 

  2079. ! Y-end boundary
    2080. 

  2080.         DO j = max(jts,jbe-spec_zone+1), jtf
    2081. 

  2081.           b_dist = jbe - j
    2082. 

  2082.           b_limit = b_dist
    2083. 

  2083.           IF(periodic_x)b_limit = 0
    2084. 

  2084.           DO k = kts, ktf
    2085. 

  2085.             DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
    2086. 

  2086.               i_inner = max(i,ibs+spec_zone)
    2087. 

  2087.               i_inner = min(i_inner,ibe-spec_zone)
    2088. 

  2088.               IF(periodic_x)i_inner = i
    2089. 

  2089.               IF(v(i,k,j+1) .gt. 0.)THEN
    2090. 

  2090.                 field(i,k,j) = field(i_inner,k,jbe-spec_zone)
    2091. 

  2091.               ELSE
    2092. 

  2092.                 field(i,k,j) = n_ccn0
    2093. 

  2093.               ENDIF
    2094. 

  2094.             ENDDO
    2095. 

  2095.           ENDDO
    2096. 

  2096.         ENDDO
    2097. 

  2097.       ENDIF
    2098. 

  2098. 

  2099.     IF(.NOT.periodic_x)THEN
    2100. 

  2100.       IF (its - ibs .lt. spec_zone) THEN
    2101. 

  2101. ! X-start boundary
    2102. 

  2102.         DO i = its, min(itf,ibs+spec_zone-1)
    2103. 

  2103.           b_dist = i - ibs
    2104. 

  2104.           DO k = kts, ktf
    2105. 

  2105.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    2106. 

  2106.               j_inner = max(j,jbs+spec_zone)
    2107. 

  2107.               j_inner = min(j_inner,jbe-spec_zone)
    2108. 

  2108.               IF(u(i,k,j) .lt. 0.)THEN
    2109. 

  2109.                 field(i,k,j) = field(ibs+spec_zone,k,j_inner)
    2110. 

  2110.               ELSE
    2111. 

  2111.                 field(i,k,j) = n_ccn0
    2112. 

  2112.               ENDIF
    2113. 

  2113.             ENDDO
    2114. 

  2114.           ENDDO
    2115. 

  2115.         ENDDO
    2116. 

  2116.       ENDIF
    2117. 

  2117. 

  2118.       IF (ibe - itf .lt. spec_zone) THEN
    2119. 

  2119. ! X-end boundary
    2120. 

  2120.         DO i = max(its,ibe-spec_zone+1), itf
    2121. 

  2121.           b_dist = ibe - i
    2122. 

  2122.           DO k = kts, ktf
    2123. 

  2123.             DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
    2124. 

  2124.               j_inner = max(j,jbs+spec_zone)
    2125. 

  2125.               j_inner = min(j_inner,jbe-spec_zone)
    2126. 

  2126.               IF(u(i+1,k,j) .gt. 0.)THEN
    2127. 

  2127.                 field(i,k,j) = field(ibe-spec_zone,k,j_inner)
    2128. 

  2128.               ELSE
    2129. 

  2129.                 field(i,k,j) = n_ccn0
    2130. 

  2130.               ENDIF
    2131. 

  2131.             ENDDO
    2132. 

  2132.           ENDDO
    2133. 

  2133.         ENDDO
    2134. 

  2134.       ENDIF
    2135. 

  2135.     ENDIF
    2136. 

  2136. 

  2137.    END SUBROUTINE flow_dep_bdy_qnn
    2138. 

  2138. 

  2139. !------------------------------------------------------------------------------
    2140. 

  2140. 

  2141.  SUBROUTINE stuff_bdy_new ( data3d , space_bdy_xs, space_bdy_xe, space_bdy_ys, space_bdy_ye, &
    2142. 

  2142.                              char_stagger , &
    2143. 

  2143.                              spec_bdy_width , &
    2144. 

  2144.                              ids, ide, jds, jde, kds, kde , &
    2145. 

  2145.                              ims, ime, jms, jme, kms, kme , & 
    2146. 

  2146.                              its, ite, jts, jte, kts, kte )
    2147. 

  2147.  
    2148. 

  2148.  !  This routine puts the data in the 3d arrays into the proper locations
    2149. 

  2149.  !  for the lateral boundary arrays.
    2150. 

  2150.  
    2151. 

  2151.     USE module_state_description
    2152. 

  2152.     
    2153. 

  2153.     IMPLICIT NONE
    2154. 

  2154.  
    2155. 

  2155.     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
    2156. 

  2156.     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
    2157. 

  2157.     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
    2158. 

  2158.     INTEGER , INTENT(IN) :: spec_bdy_width
    2159. 

  2159.     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3d
    2160. 

  2160.     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
    2161. 

  2161.     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
    2162. 

  2162.     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
    2163. 

  2163.  
    2164. 

  2164.     INTEGER :: i , ii , j , jj , k
    2165. 

  2165.  
    2166. 

  2166.     !  There are four lateral boundary locations that are stored.
    2167. 

  2167.  
    2168. 

  2168.     !  X start boundary
    2169. 

  2169.  
    2170. 

  2170.     IF ( char_stagger .EQ. 'W' ) THEN
    2171. 

  2171.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2172. 

  2172.        DO k = kds , kde
    2173. 

  2173.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2174. 

  2174.           space_bdy_xs(j,k,i) = data3d(i,k,j)
    2175. 

  2175.        END DO
    2176. 

  2176.        END DO
    2177. 

  2177.        END DO
    2178. 

  2178.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2179. 

  2179.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2180. 

  2180.        DO k = kds , kde
    2181. 

  2181.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2182. 

  2182.           space_bdy_xs(j,k,i) = data3d(i,k,j)
    2183. 

  2183.        END DO
    2184. 

  2184.        END DO
    2185. 

  2185.        END DO
    2186. 

  2186.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2187. 

  2187.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2188. 

  2188.        DO k = kds , kde - 1
    2189. 

  2189.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2190. 

  2190.           space_bdy_xs(j,k,i) = data3d(i,k,j)
    2191. 

  2191.        END DO
    2192. 

  2192.        END DO
    2193. 

  2193.        END DO
    2194. 

  2194.     ELSE
    2195. 

  2195.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2196. 

  2196.        DO k = kds , kde - 1
    2197. 

  2197.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2198. 

  2198.           space_bdy_xs(j,k,i) = data3d(i,k,j)
    2199. 

  2199.        END DO
    2200. 

  2200.        END DO
    2201. 

  2201.        END DO
    2202. 

  2202.     END IF
    2203. 

  2203.  
    2204. 

  2204.     !  X end boundary
    2205. 

  2205.  
    2206. 

  2206.     IF      ( char_stagger .EQ. 'U' ) THEN
    2207. 

  2207.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2208. 

  2208.        DO k = kds , kde - 1
    2209. 

  2209.        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
    2210. 

  2210.           ii = ide - i + 1
    2211. 

  2211.           space_bdy_xe(j,k,ii) = data3d(i,k,j)
    2212. 

  2212.        END DO
    2213. 

  2213.        END DO
    2214. 

  2214.        END DO
    2215. 

  2215.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2216. 

  2216.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2217. 

  2217.        DO k = kds , kde - 1
    2218. 

  2218.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2219. 

  2219.           ii = ide - i
    2220. 

  2220.           space_bdy_xe(j,k,ii) = data3d(i,k,j)
    2221. 

  2221.        END DO
    2222. 

  2222.        END DO
    2223. 

  2223.        END DO
    2224. 

  2224.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2225. 

  2225.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2226. 

  2226.        DO k = kds , kde
    2227. 

  2227.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2228. 

  2228.           ii = ide - i
    2229. 

  2229.           space_bdy_xe(j,k,ii) = data3d(i,k,j)
    2230. 

  2230.        END DO
    2231. 

  2231.        END DO
    2232. 

  2232.        END DO
    2233. 

  2233.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2234. 

  2234.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2235. 

  2235.        DO k = kds , kde
    2236. 

  2236.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2237. 

  2237.           ii = ide - i
    2238. 

  2238.           space_bdy_xe(j,k,ii) = data3d(i,k,j)
    2239. 

  2239.        END DO
    2240. 

  2240.        END DO
    2241. 

  2241.        END DO
    2242. 

  2242.     ELSE
    2243. 

  2243.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2244. 

  2244.        DO k = kds , kde - 1
    2245. 

  2245.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2246. 

  2246.           ii = ide - i
    2247. 

  2247.           space_bdy_xe(j,k,ii) = data3d(i,k,j)
    2248. 

  2248.        END DO
    2249. 

  2249.        END DO
    2250. 

  2250.        END DO
    2251. 

  2251.     END IF
    2252. 

  2252.  
    2253. 

  2253.     !  Y start boundary
    2254. 

  2254.  
    2255. 

  2255.     IF ( char_stagger .EQ. 'W' ) THEN
    2256. 

  2256.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2257. 

  2257.        DO k = kds , kde
    2258. 

  2258.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2259. 

  2259.           space_bdy_ys(i,k,j) = data3d(i,k,j)
    2260. 

  2260.        END DO
    2261. 

  2261.        END DO
    2262. 

  2262.        END DO
    2263. 

  2263.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2264. 

  2264.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2265. 

  2265.        DO k = kds , kde
    2266. 

  2266.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2267. 

  2267.           space_bdy_ys(i,k,j) = data3d(i,k,j)
    2268. 

  2268.        END DO
    2269. 

  2269.        END DO
    2270. 

  2270.        END DO
    2271. 

  2271.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2272. 

  2272.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2273. 

  2273.        DO k = kds , kde - 1
    2274. 

  2274.        DO i = MAX(ids,its) , MIN(ide,ite)
    2275. 

  2275.           space_bdy_ys(i,k,j) = data3d(i,k,j)
    2276. 

  2276.        END DO
    2277. 

  2277.        END DO
    2278. 

  2278.        END DO
    2279. 

  2279.     ELSE
    2280. 

  2280.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2281. 

  2281.        DO k = kds , kde - 1
    2282. 

  2282.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2283. 

  2283.           space_bdy_ys(i,k,j) = data3d(i,k,j)
    2284. 

  2284.        END DO
    2285. 

  2285.        END DO
    2286. 

  2286.        END DO
    2287. 

  2287.     END IF
    2288. 

  2288.  
    2289. 

  2289.     !  Y end boundary
    2290. 

  2290.  
    2291. 

  2291.     IF      ( char_stagger .EQ. 'V' ) THEN
    2292. 

  2292.        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
    2293. 

  2293.        DO k = kds , kde - 1
    2294. 

  2294.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2295. 

  2295.           jj = jde - j + 1
    2296. 

  2296.           space_bdy_ye(i,k,jj) = data3d(i,k,j)
    2297. 

  2297.        END DO
    2298. 

  2298.        END DO
    2299. 

  2299.        END DO
    2300. 

  2300.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2301. 

  2301.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2302. 

  2302.        DO k = kds , kde - 1
    2303. 

  2303.        DO i = MAX(ids,its) , MIN(ide,ite)
    2304. 

  2304.           jj = jde - j
    2305. 

  2305.           space_bdy_ye(i,k,jj) = data3d(i,k,j)
    2306. 

  2306.        END DO
    2307. 

  2307.        END DO
    2308. 

  2308.        END DO
    2309. 

  2309.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2310. 

  2310.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2311. 

  2311.        DO k = kds , kde
    2312. 

  2312.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2313. 

  2313.           jj = jde - j
    2314. 

  2314.           space_bdy_ye(i,k,jj) = data3d(i,k,j)
    2315. 

  2315.        END DO
    2316. 

  2316.        END DO
    2317. 

  2317.        END DO
    2318. 

  2318.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2319. 

  2319.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2320. 

  2320.        DO k = kds , kde
    2321. 

  2321.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2322. 

  2322.           jj = jde - j
    2323. 

  2323.           space_bdy_ye(i,k,jj) = data3d(i,k,j)
    2324. 

  2324.        END DO
    2325. 

  2325.        END DO
    2326. 

  2326.        END DO
    2327. 

  2327.     ELSE
    2328. 

  2328.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2329. 

  2329.        DO k = kds , kde - 1
    2330. 

  2330.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2331. 

  2331.           jj = jde - j
    2332. 

  2332.           space_bdy_ye(i,k,jj) = data3d(i,k,j)
    2333. 

  2333.        END DO
    2334. 

  2334.        END DO
    2335. 

  2335.        END DO
    2336. 

  2336.     END IF
    2337. 

  2337.     
    2338. 

  2338.  END SUBROUTINE stuff_bdy_new
    2339. 

  2339.  
    2340. 

  2340.  SUBROUTINE stuff_bdytend_new ( data3dnew , data3dold , time_diff , &
    2341. 

  2341.                              space_bdy_xs, space_bdy_xe, space_bdy_ys, space_bdy_ye, &
    2342. 

  2342.                              char_stagger , &
    2343. 

  2343.                              spec_bdy_width , &
    2344. 

  2344.                              ids, ide, jds, jde, kds, kde , &
    2345. 

  2345.                              ims, ime, jms, jme, kms, kme , & 
    2346. 

  2346.                              its, ite, jts, jte, kts, kte )
    2347. 

  2347.  
    2348. 

  2348.  !  This routine puts the tendency data into the proper locations
    2349. 

  2349.  !  for the lateral boundary arrays.
    2350. 

  2350.  
    2351. 

  2351.     USE module_state_description
    2352. 

  2352.     
    2353. 

  2353.     IMPLICIT NONE
    2354. 

  2354.  
    2355. 

  2355.     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
    2356. 

  2356.     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
    2357. 

  2357.     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
    2358. 

  2358.     INTEGER , INTENT(IN) :: spec_bdy_width
    2359. 

  2359.     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
    2360. 

  2360.     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
    2361. 

  2361.     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
    2362. 

  2362.     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
    2363. 

  2363.     REAL , INTENT(IN) :: time_diff ! seconds
    2364. 

  2364.  
    2365. 

  2365.     INTEGER :: i , ii , j , jj , k
    2366. 

  2366. 

  2367. #if 0
    2368. 

  2368.     !  Here is the easy way to zero out the boundary tendencies for
    2369. 

  2369.     !  time-dependent boundaries.
    2370. 

  2370. 

  2371.     space_bdy_xs = 0.
    2372. 

  2372.     space_bdy_xe = 0.
    2373. 

  2373.     space_bdy_ys = 0.
    2374. 

  2374.     space_bdy_ye = 0.
    2375. 

  2375.     return
    2376. 

  2376. #else
    2377. 

  2377.     !  There are four lateral boundary locations that are stored.
    2378. 

  2378.  
    2379. 

  2379.     !  X start boundary
    2380. 

  2380.  
    2381. 

  2381.     IF ( char_stagger .EQ. 'W' ) THEN
    2382. 

  2382.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2383. 

  2383.        DO k = kds , kde
    2384. 

  2384.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2385. 

  2385.           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2386. 

  2386.        END DO
    2387. 

  2387.        END DO
    2388. 

  2388.        END DO
    2389. 

  2389.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2390. 

  2390.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2391. 

  2391.        DO k = kds , kde
    2392. 

  2392.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2393. 

  2393.           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2394. 

  2394.        END DO
    2395. 

  2395.        END DO
    2396. 

  2396.        END DO
    2397. 

  2397.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2398. 

  2398.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2399. 

  2399.        DO k = kds , kde - 1
    2400. 

  2400.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2401. 

  2401.           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2402. 

  2402.        END DO
    2403. 

  2403.        END DO
    2404. 

  2404.        END DO
    2405. 

  2405.     ELSE
    2406. 

  2406.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2407. 

  2407.        DO k = kds , kde - 1
    2408. 

  2408.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2409. 

  2409.           space_bdy_xs(j,k,i) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2410. 

  2410.        END DO
    2411. 

  2411.        END DO
    2412. 

  2412.        END DO
    2413. 

  2413.     END IF
    2414. 

  2414.  
    2415. 

  2415.     !  X end boundary
    2416. 

  2416.  
    2417. 

  2417.     IF      ( char_stagger .EQ. 'U' ) THEN
    2418. 

  2418.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2419. 

  2419.        DO k = kds , kde - 1
    2420. 

  2420.        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
    2421. 

  2421.           ii = ide - i + 1
    2422. 

  2422.           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2423. 

  2423.        END DO
    2424. 

  2424.        END DO
    2425. 

  2425.        END DO
    2426. 

  2426.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2427. 

  2427.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2428. 

  2428.        DO k = kds , kde - 1
    2429. 

  2429.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2430. 

  2430.           ii = ide - i
    2431. 

  2431.           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2432. 

  2432.        END DO
    2433. 

  2433.        END DO
    2434. 

  2434.        END DO
    2435. 

  2435.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2436. 

  2436.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2437. 

  2437.        DO k = kds , kde
    2438. 

  2438.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2439. 

  2439.           ii = ide - i
    2440. 

  2440.           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2441. 

  2441.        END DO
    2442. 

  2442.        END DO
    2443. 

  2443.        END DO
    2444. 

  2444.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2445. 

  2445.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2446. 

  2446.        DO k = kds , kde
    2447. 

  2447.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2448. 

  2448.           ii = ide - i
    2449. 

  2449.           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2450. 

  2450.        END DO
    2451. 

  2451.        END DO
    2452. 

  2452.        END DO
    2453. 

  2453.     ELSE
    2454. 

  2454.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2455. 

  2455.        DO k = kds , kde - 1
    2456. 

  2456.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2457. 

  2457.           ii = ide - i
    2458. 

  2458.           space_bdy_xe(j,k,ii) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2459. 

  2459.        END DO
    2460. 

  2460.        END DO
    2461. 

  2461.        END DO
    2462. 

  2462.     END IF
    2463. 

  2463.  
    2464. 

  2464.     !  Y start boundary
    2465. 

  2465.  
    2466. 

  2466.     IF ( char_stagger .EQ. 'W' ) THEN
    2467. 

  2467.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2468. 

  2468.        DO k = kds , kde
    2469. 

  2469.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2470. 

  2470.           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2471. 

  2471.        END DO
    2472. 

  2472.        END DO
    2473. 

  2473.        END DO
    2474. 

  2474.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2475. 

  2475.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2476. 

  2476.        DO k = kds , kde
    2477. 

  2477.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2478. 

  2478.           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2479. 

  2479.        END DO
    2480. 

  2480.        END DO
    2481. 

  2481.        END DO
    2482. 

  2482.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2483. 

  2483.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2484. 

  2484.        DO k = kds , kde - 1
    2485. 

  2485.        DO i = MAX(ids,its) , MIN(ide,ite)
    2486. 

  2486.           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2487. 

  2487.        END DO
    2488. 

  2488.        END DO
    2489. 

  2489.        END DO
    2490. 

  2490.     ELSE
    2491. 

  2491.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2492. 

  2492.        DO k = kds , kde - 1
    2493. 

  2493.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2494. 

  2494.           space_bdy_ys(i,k,j) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2495. 

  2495.        END DO
    2496. 

  2496.        END DO
    2497. 

  2497.        END DO
    2498. 

  2498.     END IF
    2499. 

  2499.  
    2500. 

  2500.     !  Y end boundary
    2501. 

  2501.  
    2502. 

  2502.     IF      ( char_stagger .EQ. 'V' ) THEN
    2503. 

  2503.        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
    2504. 

  2504.        DO k = kds , kde - 1
    2505. 

  2505.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2506. 

  2506.           jj = jde - j + 1
    2507. 

  2507.           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2508. 

  2508.        END DO
    2509. 

  2509.        END DO
    2510. 

  2510.        END DO
    2511. 

  2511.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2512. 

  2512.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2513. 

  2513.        DO k = kds , kde - 1
    2514. 

  2514.        DO i = MAX(ids,its) , MIN(ide,ite)
    2515. 

  2515.           jj = jde - j
    2516. 

  2516.           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2517. 

  2517.        END DO
    2518. 

  2518.        END DO
    2519. 

  2519.        END DO
    2520. 

  2520.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2521. 

  2521.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2522. 

  2522.        DO k = kds , kde
    2523. 

  2523.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2524. 

  2524.           jj = jde - j
    2525. 

  2525.           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2526. 

  2526.        END DO
    2527. 

  2527.        END DO
    2528. 

  2528.        END DO
    2529. 

  2529.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2530. 

  2530.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2531. 

  2531.        DO k = kds , kde
    2532. 

  2532.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2533. 

  2533.           jj = jde - j
    2534. 

  2534.           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2535. 

  2535.        END DO
    2536. 

  2536.        END DO
    2537. 

  2537.        END DO
    2538. 

  2538.     ELSE
    2539. 

  2539.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2540. 

  2540.        DO k = kds , kde - 1
    2541. 

  2541.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2542. 

  2542.           jj = jde - j
    2543. 

  2543.           space_bdy_ye(i,k,jj) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2544. 

  2544.        END DO
    2545. 

  2545.        END DO
    2546. 

  2546.        END DO
    2547. 

  2547.     END IF
    2548. 

  2548. #endif
    2549. 

  2549.     
    2550. 

  2550.  END SUBROUTINE stuff_bdytend_new
    2551. 

  2551. 

  2552. !--- old versions for use with modules that use the old bdy data structures ---
    2553. 

  2553. 

  2554.  SUBROUTINE stuff_bdy_old ( data3d , space_bdy , char_stagger , &
    2555. 

  2555.                              ijds , ijde , spec_bdy_width , &
    2556. 

  2556.                              ids, ide, jds, jde, kds, kde , &
    2557. 

  2557.                              ims, ime, jms, jme, kms, kme , & 
    2558. 

  2558.                              its, ite, jts, jte, kts, kte )
    2559. 

  2559.  
    2560. 

  2560.  !  This routine puts the data in the 3d arrays into the proper locations
    2561. 

  2561.  !  for the lateral boundary arrays.
    2562. 

  2562.  
    2563. 

  2563.     USE module_state_description
    2564. 

  2564.     
    2565. 

  2565.     IMPLICIT NONE
    2566. 

  2566.  
    2567. 

  2567.     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
    2568. 

  2568.     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
    2569. 

  2569.     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
    2570. 

  2570.     INTEGER , INTENT(IN) :: ijds , ijde , spec_bdy_width
    2571. 

  2571.     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3d
    2572. 

  2572.     REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4) , INTENT(OUT) :: space_bdy
    2573. 

  2573.     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
    2574. 

  2574.  
    2575. 

  2575.     INTEGER :: i , ii , j , jj , k
    2576. 

  2576.  
    2577. 

  2577.     !  There are four lateral boundary locations that are stored.
    2578. 

  2578.  
    2579. 

  2579.     !  X start boundary
    2580. 

  2580.  
    2581. 

  2581.     IF ( char_stagger .EQ. 'W' ) THEN
    2582. 

  2582.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2583. 

  2583.        DO k = kds , kde
    2584. 

  2584.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2585. 

  2585.           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
    2586. 

  2586.        END DO
    2587. 

  2587.        END DO
    2588. 

  2588.        END DO
    2589. 

  2589.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2590. 

  2590.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2591. 

  2591.        DO k = kds , kde
    2592. 

  2592.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2593. 

  2593.           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
    2594. 

  2594.        END DO
    2595. 

  2595.        END DO
    2596. 

  2596.        END DO
    2597. 

  2597.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2598. 

  2598.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2599. 

  2599.        DO k = kds , kde - 1
    2600. 

  2600.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2601. 

  2601.           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
    2602. 

  2602.        END DO
    2603. 

  2603.        END DO
    2604. 

  2604.        END DO
    2605. 

  2605.     ELSE
    2606. 

  2606.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2607. 

  2607.        DO k = kds , kde - 1
    2608. 

  2608.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2609. 

  2609.           space_bdy(j,k,i,P_XSB) = data3d(i,k,j)
    2610. 

  2610.        END DO
    2611. 

  2611.        END DO
    2612. 

  2612.        END DO
    2613. 

  2613.     END IF
    2614. 

  2614.  
    2615. 

  2615.     !  X end boundary
    2616. 

  2616.  
    2617. 

  2617.     IF      ( char_stagger .EQ. 'U' ) THEN
    2618. 

  2618.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2619. 

  2619.        DO k = kds , kde - 1
    2620. 

  2620.        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
    2621. 

  2621.           ii = ide - i + 1
    2622. 

  2622.           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
    2623. 

  2623.        END DO
    2624. 

  2624.        END DO
    2625. 

  2625.        END DO
    2626. 

  2626.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2627. 

  2627.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2628. 

  2628.        DO k = kds , kde - 1
    2629. 

  2629.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2630. 

  2630.           ii = ide - i
    2631. 

  2631.           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
    2632. 

  2632.        END DO
    2633. 

  2633.        END DO
    2634. 

  2634.        END DO
    2635. 

  2635.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2636. 

  2636.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2637. 

  2637.        DO k = kds , kde
    2638. 

  2638.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2639. 

  2639.           ii = ide - i
    2640. 

  2640.           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
    2641. 

  2641.        END DO
    2642. 

  2642.        END DO
    2643. 

  2643.        END DO
    2644. 

  2644.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2645. 

  2645.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2646. 

  2646.        DO k = kds , kde
    2647. 

  2647.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2648. 

  2648.           ii = ide - i
    2649. 

  2649.           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
    2650. 

  2650.        END DO
    2651. 

  2651.        END DO
    2652. 

  2652.        END DO
    2653. 

  2653.     ELSE
    2654. 

  2654.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2655. 

  2655.        DO k = kds , kde - 1
    2656. 

  2656.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2657. 

  2657.           ii = ide - i
    2658. 

  2658.           space_bdy(j,k,ii,P_XEB) = data3d(i,k,j)
    2659. 

  2659.        END DO
    2660. 

  2660.        END DO
    2661. 

  2661.        END DO
    2662. 

  2662.     END IF
    2663. 

  2663.  
    2664. 

  2664.     !  Y start boundary
    2665. 

  2665.  
    2666. 

  2666.     IF ( char_stagger .EQ. 'W' ) THEN
    2667. 

  2667.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2668. 

  2668.        DO k = kds , kde
    2669. 

  2669.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2670. 

  2670.           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
    2671. 

  2671.        END DO
    2672. 

  2672.        END DO
    2673. 

  2673.        END DO
    2674. 

  2674.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2675. 

  2675.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2676. 

  2676.        DO k = kds , kde
    2677. 

  2677.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2678. 

  2678.           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
    2679. 

  2679.        END DO
    2680. 

  2680.        END DO
    2681. 

  2681.        END DO
    2682. 

  2682.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2683. 

  2683.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2684. 

  2684.        DO k = kds , kde - 1
    2685. 

  2685.        DO i = MAX(ids,its) , MIN(ide,ite)
    2686. 

  2686.           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
    2687. 

  2687.        END DO
    2688. 

  2688.        END DO
    2689. 

  2689.        END DO
    2690. 

  2690.     ELSE
    2691. 

  2691.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2692. 

  2692.        DO k = kds , kde - 1
    2693. 

  2693.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2694. 

  2694.           space_bdy(i,k,j,P_YSB) = data3d(i,k,j)
    2695. 

  2695.        END DO
    2696. 

  2696.        END DO
    2697. 

  2697.        END DO
    2698. 

  2698.     END IF
    2699. 

  2699.  
    2700. 

  2700.     !  Y end boundary
    2701. 

  2701.  
    2702. 

  2702.     IF      ( char_stagger .EQ. 'V' ) THEN
    2703. 

  2703.        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
    2704. 

  2704.        DO k = kds , kde - 1
    2705. 

  2705.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2706. 

  2706.           jj = jde - j + 1
    2707. 

  2707.           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
    2708. 

  2708.        END DO
    2709. 

  2709.        END DO
    2710. 

  2710.        END DO
    2711. 

  2711.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2712. 

  2712.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2713. 

  2713.        DO k = kds , kde - 1
    2714. 

  2714.        DO i = MAX(ids,its) , MIN(ide,ite)
    2715. 

  2715.           jj = jde - j
    2716. 

  2716.           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
    2717. 

  2717.        END DO
    2718. 

  2718.        END DO
    2719. 

  2719.        END DO
    2720. 

  2720.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2721. 

  2721.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2722. 

  2722.        DO k = kds , kde
    2723. 

  2723.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2724. 

  2724.           jj = jde - j
    2725. 

  2725.           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
    2726. 

  2726.        END DO
    2727. 

  2727.        END DO
    2728. 

  2728.        END DO
    2729. 

  2729.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2730. 

  2730.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2731. 

  2731.        DO k = kds , kde
    2732. 

  2732.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2733. 

  2733.           jj = jde - j
    2734. 

  2734.           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
    2735. 

  2735.        END DO
    2736. 

  2736.        END DO
    2737. 

  2737.        END DO
    2738. 

  2738.     ELSE
    2739. 

  2739.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2740. 

  2740.        DO k = kds , kde - 1
    2741. 

  2741.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2742. 

  2742.           jj = jde - j
    2743. 

  2743.           space_bdy(i,k,jj,P_YEB) = data3d(i,k,j)
    2744. 

  2744.        END DO
    2745. 

  2745.        END DO
    2746. 

  2746.        END DO
    2747. 

  2747.     END IF
    2748. 

  2748.     
    2749. 

  2749.  END SUBROUTINE stuff_bdy_old
    2750. 

  2750.  
    2751. 

  2751.  SUBROUTINE stuff_bdytend_old ( data3dnew , data3dold , time_diff , space_bdy , char_stagger , &
    2752. 

  2752.                              ijds , ijde , spec_bdy_width , &
    2753. 

  2753.                              ids, ide, jds, jde, kds, kde , &
    2754. 

  2754.                              ims, ime, jms, jme, kms, kme , & 
    2755. 

  2755.                              its, ite, jts, jte, kts, kte )
    2756. 

  2756.  
    2757. 

  2757.  !  This routine puts the tendency data into the proper locations
    2758. 

  2758.  !  for the lateral boundary arrays.
    2759. 

  2759.  
    2760. 

  2760.     USE module_state_description
    2761. 

  2761.     
    2762. 

  2762.     IMPLICIT NONE
    2763. 

  2763.  
    2764. 

  2764.     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
    2765. 

  2765.     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
    2766. 

  2766.     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
    2767. 

  2767.     INTEGER , INTENT(IN) :: ijds , ijde , spec_bdy_width
    2768. 

  2768.     REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
    2769. 

  2769. !    REAL , DIMENSION(:,:,:,:) , INTENT(OUT) :: space_bdy
    2770. 

  2770.     REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4) , INTENT(OUT) :: space_bdy
    2771. 

  2771.     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
    2772. 

  2772.     REAL , INTENT(IN) :: time_diff ! seconds
    2773. 

  2773.  
    2774. 

  2774.     INTEGER :: i , ii , j , jj , k
    2775. 

  2775.  
    2776. 

  2776.     !  There are four lateral boundary locations that are stored.
    2777. 

  2777.  
    2778. 

  2778.     !  X start boundary
    2779. 

  2779.  
    2780. 

  2780.     IF ( char_stagger .EQ. 'W' ) THEN
    2781. 

  2781.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2782. 

  2782.        DO k = kds , kde
    2783. 

  2783.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2784. 

  2784.           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2785. 

  2785. !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
    2786. 

  2786.        END DO
    2787. 

  2787.        END DO
    2788. 

  2788.        END DO
    2789. 

  2789.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2790. 

  2790.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2791. 

  2791.        DO k = kds , kde
    2792. 

  2792.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2793. 

  2793.           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2794. 

  2794. !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
    2795. 

  2795.        END DO
    2796. 

  2796.        END DO
    2797. 

  2797.        END DO
    2798. 

  2798.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2799. 

  2799.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2800. 

  2800.        DO k = kds , kde - 1
    2801. 

  2801.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2802. 

  2802.           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2803. 

  2803. !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
    2804. 

  2804.        END DO
    2805. 

  2805.        END DO
    2806. 

  2806.        END DO
    2807. 

  2807.     ELSE
    2808. 

  2808.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2809. 

  2809.        DO k = kds , kde - 1
    2810. 

  2810.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    2811. 

  2811.           space_bdy(j,k,i,P_XSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2812. 

  2812. !         space_bdy(j,k,i,P_XSB) = 0. ! zeroout
    2813. 

  2813.        END DO
    2814. 

  2814.        END DO
    2815. 

  2815.        END DO
    2816. 

  2816.     END IF
    2817. 

  2817.  
    2818. 

  2818.     !  X end boundary
    2819. 

  2819.  
    2820. 

  2820.     IF      ( char_stagger .EQ. 'U' ) THEN
    2821. 

  2821.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2822. 

  2822.        DO k = kds , kde - 1
    2823. 

  2823.        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
    2824. 

  2824.           ii = ide - i + 1
    2825. 

  2825.           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2826. 

  2826. !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
    2827. 

  2827.        END DO
    2828. 

  2828.        END DO
    2829. 

  2829.        END DO
    2830. 

  2830.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    2831. 

  2831.        DO j = MAX(jds,jts) , MIN(jde,jte)
    2832. 

  2832.        DO k = kds , kde - 1
    2833. 

  2833.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2834. 

  2834.           ii = ide - i
    2835. 

  2835.           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2836. 

  2836. !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
    2837. 

  2837.        END DO
    2838. 

  2838.        END DO
    2839. 

  2839.        END DO
    2840. 

  2840.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2841. 

  2841.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2842. 

  2842.        DO k = kds , kde
    2843. 

  2843.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2844. 

  2844.           ii = ide - i
    2845. 

  2845.           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2846. 

  2846. !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
    2847. 

  2847.        END DO
    2848. 

  2848.        END DO
    2849. 

  2849.        END DO
    2850. 

  2850.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2851. 

  2851.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2852. 

  2852.        DO k = kds , kde
    2853. 

  2853.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2854. 

  2854.           ii = ide - i
    2855. 

  2855.           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2856. 

  2856. !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
    2857. 

  2857.        END DO
    2858. 

  2858.        END DO
    2859. 

  2859.        END DO
    2860. 

  2860.     ELSE
    2861. 

  2861.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    2862. 

  2862.        DO k = kds , kde - 1
    2863. 

  2863.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    2864. 

  2864.           ii = ide - i
    2865. 

  2865.           space_bdy(j,k,ii,P_XEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2866. 

  2866. !         space_bdy(j,k,ii,P_XEB) = 0. ! zeroout
    2867. 

  2867.        END DO
    2868. 

  2868.        END DO
    2869. 

  2869.        END DO
    2870. 

  2870.     END IF
    2871. 

  2871.  
    2872. 

  2872.     !  Y start boundary
    2873. 

  2873.  
    2874. 

  2874.     IF ( char_stagger .EQ. 'W' ) THEN
    2875. 

  2875.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2876. 

  2876.        DO k = kds , kde
    2877. 

  2877.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2878. 

  2878.           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2879. 

  2879. !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
    2880. 

  2880.        END DO
    2881. 

  2881.        END DO
    2882. 

  2882.        END DO
    2883. 

  2883.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2884. 

  2884.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2885. 

  2885.        DO k = kds , kde
    2886. 

  2886.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2887. 

  2887.           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2888. 

  2888. !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
    2889. 

  2889.        END DO
    2890. 

  2890.        END DO
    2891. 

  2891.        END DO
    2892. 

  2892.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2893. 

  2893.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2894. 

  2894.        DO k = kds , kde - 1
    2895. 

  2895.        DO i = MAX(ids,its) , MIN(ide,ite)
    2896. 

  2896.           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2897. 

  2897. !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
    2898. 

  2898.        END DO
    2899. 

  2899.        END DO
    2900. 

  2900.        END DO
    2901. 

  2901.     ELSE
    2902. 

  2902.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    2903. 

  2903.        DO k = kds , kde - 1
    2904. 

  2904.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2905. 

  2905.           space_bdy(i,k,j,P_YSB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2906. 

  2906. !         space_bdy(i,k,j,P_YSB) = 0. ! zeroout
    2907. 

  2907.        END DO
    2908. 

  2908.        END DO
    2909. 

  2909.        END DO
    2910. 

  2910.     END IF
    2911. 

  2911.  
    2912. 

  2912.     !  Y end boundary
    2913. 

  2913.  
    2914. 

  2914.     IF      ( char_stagger .EQ. 'V' ) THEN
    2915. 

  2915.        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
    2916. 

  2916.        DO k = kds , kde - 1
    2917. 

  2917.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2918. 

  2918.           jj = jde - j + 1
    2919. 

  2919.           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2920. 

  2920. !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
    2921. 

  2921.        END DO
    2922. 

  2922.        END DO
    2923. 

  2923.        END DO
    2924. 

  2924.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    2925. 

  2925.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2926. 

  2926.        DO k = kds , kde - 1
    2927. 

  2927.        DO i = MAX(ids,its) , MIN(ide,ite)
    2928. 

  2928.           jj = jde - j
    2929. 

  2929.           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2930. 

  2930. !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
    2931. 

  2931.        END DO
    2932. 

  2932.        END DO
    2933. 

  2933.        END DO
    2934. 

  2934.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    2935. 

  2935.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2936. 

  2936.        DO k = kds , kde
    2937. 

  2937.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2938. 

  2938.           jj = jde - j
    2939. 

  2939.           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2940. 

  2940. !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
    2941. 

  2941.        END DO
    2942. 

  2942.        END DO
    2943. 

  2943.        END DO
    2944. 

  2944.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    2945. 

  2945.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2946. 

  2946.        DO k = kds , kde
    2947. 

  2947.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2948. 

  2948.           jj = jde - j
    2949. 

  2949.           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2950. 

  2950. !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
    2951. 

  2951.        END DO
    2952. 

  2952.        END DO
    2953. 

  2953.        END DO
    2954. 

  2954.     ELSE
    2955. 

  2955.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    2956. 

  2956.        DO k = kds , kde - 1
    2957. 

  2957.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    2958. 

  2958.           jj = jde - j
    2959. 

  2959.           space_bdy(i,k,jj,P_YEB) = ( data3dnew(i,k,j) - data3dold(i,k,j) ) / time_diff
    2960. 

  2960. !         space_bdy(i,k,jj,P_YEB) = 0. ! zeroout
    2961. 

  2961.        END DO
    2962. 

  2962.        END DO
    2963. 

  2963.        END DO
    2964. 

  2964.     END IF
    2965. 

  2965.     
    2966. 

  2966.  END SUBROUTINE stuff_bdytend_old
    2967. 

  2967. 

  2968.  SUBROUTINE stuff_bdy_ijk ( data3d , space_bdy_xs, space_bdy_xe, &
    2969. 

  2969.                              space_bdy_ys, space_bdy_ye, &
    2970. 

  2970.                              char_stagger , spec_bdy_width, &
    2971. 

  2971.                              ids, ide, jds, jde, kds, kde , &
    2972. 

  2972.                              ims, ime, jms, jme, kms, kme , & 
    2973. 

  2973.                              its, ite, jts, jte, kts, kte )
    2974. 

  2974.  
    2975. 

  2975.  !  This routine puts the data in the 3d arrays into the proper locations
    2976. 

  2976.  !  for the lateral boundary arrays.
    2977. 

  2977.  
    2978. 

  2978.     USE module_state_description
    2979. 

  2979.     
    2980. 

  2980.     IMPLICIT NONE
    2981. 

  2981.  
    2982. 

  2982.     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
    2983. 

  2983.     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
    2984. 

  2984.     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
    2985. 

  2985.     INTEGER , INTENT(IN) :: spec_bdy_width
    2986. 

  2986.     REAL , DIMENSION(ims:ime,jms:jme,kms:kme) , INTENT(IN) :: data3d
    2987. 

  2987. !    REAL , DIMENSION(:,:,:,:) , INTENT(OUT) :: space_bdy
    2988. 

  2988. !    REAL , DIMENSION(ijds:ijde,kds:kde,spec_bdy_width,4,1) , INTENT(OUT) :: space_bdy
    2989. 

  2989.     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
    2990. 

  2990.     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
    2991. 

  2991.     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
    2992. 

  2992.  
    2993. 

  2993.     INTEGER :: i , ii , j , jj , k
    2994. 

  2994.  
    2995. 

  2995.     !  There are four lateral boundary locations that are stored.
    2996. 

  2996.  
    2997. 

  2997.     !  X start boundary
    2998. 

  2998.  
    2999. 

  2999.     IF ( char_stagger .EQ. 'W' ) THEN
    3000. 

  3000.        DO k = kds , kde
    3001. 

  3001.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3002. 

  3002.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3003. 

  3003.           space_bdy_xs(j,k,i) = data3d(i,j,k)
    3004. 

  3004.        END DO
    3005. 

  3005.        END DO
    3006. 

  3006.        END DO
    3007. 

  3007.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3008. 

  3008.        DO k = kds , kde
    3009. 

  3009.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3010. 

  3010.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3011. 

  3011.           space_bdy_xs(j,k,i) = data3d(i,j,k)
    3012. 

  3012.        END DO
    3013. 

  3013.        END DO
    3014. 

  3014.        END DO
    3015. 

  3015.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    3016. 

  3016.        DO k = kds , kde - 1
    3017. 

  3017.        DO j = MAX(jds,jts) , MIN(jde,jte)
    3018. 

  3018.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3019. 

  3019.           space_bdy_xs(j,k,i) = data3d(i,j,k)
    3020. 

  3020.        END DO
    3021. 

  3021.        END DO
    3022. 

  3022.        END DO
    3023. 

  3023.     ELSE
    3024. 

  3024.        DO k = kds , kde - 1
    3025. 

  3025.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3026. 

  3026.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3027. 

  3027.           space_bdy_xs(j,k,i) = data3d(i,j,k)
    3028. 

  3028.        END DO
    3029. 

  3029.        END DO
    3030. 

  3030.        END DO
    3031. 

  3031.     END IF
    3032. 

  3032.  
    3033. 

  3033.     !  X end boundary
    3034. 

  3034.  
    3035. 

  3035.     IF      ( char_stagger .EQ. 'U' ) THEN
    3036. 

  3036.        DO k = kds , kde - 1
    3037. 

  3037.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3038. 

  3038.        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
    3039. 

  3039.           ii = ide - i + 1
    3040. 

  3040.           space_bdy_xe(j,k,ii) = data3d(i,j,k)
    3041. 

  3041.        END DO
    3042. 

  3042.        END DO
    3043. 

  3043.        END DO
    3044. 

  3044.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    3045. 

  3045.        DO k = kds , kde - 1
    3046. 

  3046.        DO j = MAX(jds,jts) , MIN(jde,jte)
    3047. 

  3047.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3048. 

  3048.           ii = ide - i
    3049. 

  3049.           space_bdy_xe(j,k,ii) = data3d(i,j,k)
    3050. 

  3050.        END DO
    3051. 

  3051.        END DO
    3052. 

  3052.        END DO
    3053. 

  3053.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    3054. 

  3054.        DO k = kds , kde
    3055. 

  3055.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3056. 

  3056.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3057. 

  3057.           ii = ide - i
    3058. 

  3058.           space_bdy_xe(j,k,ii) = data3d(i,j,k)
    3059. 

  3059.        END DO
    3060. 

  3060.        END DO
    3061. 

  3061.        END DO
    3062. 

  3062.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3063. 

  3063.        DO k = kds , kde
    3064. 

  3064.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3065. 

  3065.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3066. 

  3066.           ii = ide - i
    3067. 

  3067.           space_bdy_xe(j,k,ii) = data3d(i,j,k)
    3068. 

  3068.        END DO
    3069. 

  3069.        END DO
    3070. 

  3070.        END DO
    3071. 

  3071.     ELSE
    3072. 

  3072.        DO k = kds , kde - 1
    3073. 

  3073.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3074. 

  3074.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3075. 

  3075.           ii = ide - i
    3076. 

  3076.           space_bdy_xe(j,k,ii) = data3d(i,j,k)
    3077. 

  3077.        END DO
    3078. 

  3078.        END DO
    3079. 

  3079.        END DO
    3080. 

  3080.     END IF
    3081. 

  3081.  
    3082. 

  3082.     !  Y start boundary
    3083. 

  3083.  
    3084. 

  3084.     IF ( char_stagger .EQ. 'W' ) THEN
    3085. 

  3085.        DO k = kds , kde
    3086. 

  3086.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3087. 

  3087.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3088. 

  3088.           space_bdy_ys(i,k,j) = data3d(i,j,k)
    3089. 

  3089.        END DO
    3090. 

  3090.        END DO
    3091. 

  3091.        END DO
    3092. 

  3092.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3093. 

  3093.        DO k = kds , kde
    3094. 

  3094.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3095. 

  3095.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3096. 

  3096.           space_bdy_ys(i,k,j) = data3d(i,j,k)
    3097. 

  3097.        END DO
    3098. 

  3098.        END DO
    3099. 

  3099.        END DO
    3100. 

  3100.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    3101. 

  3101.        DO k = kds , kde - 1
    3102. 

  3102.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3103. 

  3103.        DO i = MAX(ids,its) , MIN(ide,ite)
    3104. 

  3104.           space_bdy_ys(i,k,j) = data3d(i,j,k)
    3105. 

  3105.        END DO
    3106. 

  3106.        END DO
    3107. 

  3107.        END DO
    3108. 

  3108.     ELSE
    3109. 

  3109.        DO k = kds , kde - 1
    3110. 

  3110.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3111. 

  3111.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3112. 

  3112.           space_bdy_ys(i,k,j) = data3d(i,j,k)
    3113. 

  3113.        END DO
    3114. 

  3114.        END DO
    3115. 

  3115.        END DO
    3116. 

  3116.     END IF
    3117. 

  3117.  
    3118. 

  3118.     !  Y end boundary
    3119. 

  3119.  
    3120. 

  3120.     IF      ( char_stagger .EQ. 'V' ) THEN
    3121. 

  3121.        DO k = kds , kde - 1
    3122. 

  3122.        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
    3123. 

  3123.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3124. 

  3124.           jj = jde - j + 1
    3125. 

  3125.           space_bdy_ye(i,k,jj) = data3d(i,j,k)
    3126. 

  3126.        END DO
    3127. 

  3127.        END DO
    3128. 

  3128.        END DO
    3129. 

  3129.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    3130. 

  3130.        DO k = kds , kde - 1
    3131. 

  3131.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3132. 

  3132.        DO i = MAX(ids,its) , MIN(ide,ite)
    3133. 

  3133.           jj = jde - j
    3134. 

  3134.           space_bdy_ye(i,k,jj) = data3d(i,j,k)
    3135. 

  3135.        END DO
    3136. 

  3136.        END DO
    3137. 

  3137.        END DO
    3138. 

  3138.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    3139. 

  3139.        DO k = kds , kde
    3140. 

  3140.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3141. 

  3141.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3142. 

  3142.           jj = jde - j
    3143. 

  3143.           space_bdy_ye(i,k,jj) = data3d(i,j,k)
    3144. 

  3144.        END DO
    3145. 

  3145.        END DO
    3146. 

  3146.        END DO
    3147. 

  3147.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3148. 

  3148.        DO k = kds , kde
    3149. 

  3149.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3150. 

  3150.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3151. 

  3151.           jj = jde - j
    3152. 

  3152.           space_bdy_ye(i,k,jj) = data3d(i,j,k)
    3153. 

  3153.        END DO
    3154. 

  3154.        END DO
    3155. 

  3155.        END DO
    3156. 

  3156.     ELSE
    3157. 

  3157.        DO k = kds , kde - 1
    3158. 

  3158.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3159. 

  3159.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3160. 

  3160.           jj = jde - j
    3161. 

  3161.           space_bdy_ye(i,k,jj) = data3d(i,j,k)
    3162. 

  3162. !        if (K .eq. 54 .and. I .eq. 369) then
    3163. 

  3163. !	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)
    3164. 

  3164. !	endif
    3165. 

  3165. 

  3166.        END DO
    3167. 

  3167.        END DO
    3168. 

  3168.        END DO
    3169. 

  3169.     END IF
    3170. 

  3170.     
    3171. 

  3171.  END SUBROUTINE stuff_bdy_ijk
    3172. 

  3172.  
    3173. 

  3173.  SUBROUTINE stuff_bdytend_ijk ( data3dnew , data3dold , time_diff , &
    3174. 

  3174.                              space_bdy_xs, space_bdy_xe, space_bdy_ys, space_bdy_ye, &
    3175. 

  3175.                              char_stagger , &
    3176. 

  3176.                              spec_bdy_width , &
    3177. 

  3177.                              ids, ide, jds, jde, kds, kde , &
    3178. 

  3178.                              ims, ime, jms, jme, kms, kme , & 
    3179. 

  3179.                              its, ite, jts, jte, kts, kte )
    3180. 

  3180.  
    3181. 

  3181.  !  This routine puts the tendency data into the proper locations
    3182. 

  3182.  !  for the lateral boundary arrays.
    3183. 

  3183.  
    3184. 

  3184.     USE module_state_description
    3185. 

  3185.     
    3186. 

  3186.     IMPLICIT NONE
    3187. 

  3187.  
    3188. 

  3188.     INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde
    3189. 

  3189.     INTEGER , INTENT(IN) :: ims, ime, jms, jme, kms, kme
    3190. 

  3190.     INTEGER , INTENT(IN) :: its, ite, jts, jte, kts, kte
    3191. 

  3191.     INTEGER , INTENT(IN) :: spec_bdy_width
    3192. 

  3192. !    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN) :: data3dnew , data3dold
    3193. 

  3193.     REAL , DIMENSION(ims:ime,jms:jme,kms:kme) , INTENT(IN) :: data3dnew , data3dold
    3194. 

  3194.     REAL , DIMENSION(jms:jme,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_xs, space_bdy_xe
    3195. 

  3195.     REAL , DIMENSION(ims:ime,kds:kde,spec_bdy_width) , INTENT(OUT) :: space_bdy_ys, space_bdy_ye
    3196. 

  3196. 

  3197.     CHARACTER (LEN=1) , INTENT(IN) :: char_stagger
    3198. 

  3198.     REAL , INTENT(IN) :: time_diff ! seconds
    3199. 

  3199.  
    3200. 

  3200.     INTEGER :: i , ii , j , jj , k
    3201. 

  3201.  
    3202. 

  3202.     !  There are four lateral boundary locations that are stored.
    3203. 

  3203.  
    3204. 

  3204.     !  X start boundary
    3205. 

  3205.  
    3206. 

  3206.     IF ( char_stagger .EQ. 'W' ) THEN
    3207. 

  3207.        DO k = kds , kde
    3208. 

  3208.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3209. 

  3209.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3210. 

  3210.           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3211. 

  3211.        END DO
    3212. 

  3212.        END DO
    3213. 

  3213.        END DO
    3214. 

  3214.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3215. 

  3215.        DO k = kds , kde
    3216. 

  3216.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3217. 

  3217.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3218. 

  3218.           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3219. 

  3219.        END DO
    3220. 

  3220.        END DO
    3221. 

  3221.        END DO
    3222. 

  3222.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    3223. 

  3223.        DO k = kds , kde - 1
    3224. 

  3224.        DO j = MAX(jds,jts) , MIN(jde,jte)
    3225. 

  3225.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3226. 

  3226.           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3227. 

  3227.        END DO
    3228. 

  3228.        END DO
    3229. 

  3229.        END DO
    3230. 

  3230.     ELSE
    3231. 

  3231.        DO k = kds , kde - 1
    3232. 

  3232.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3233. 

  3233.        DO i = MAX(ids,its) , MIN(ids + spec_bdy_width - 1,ite)
    3234. 

  3234.           space_bdy_xs(j,k,i) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3235. 

  3235.        END DO
    3236. 

  3236.        END DO
    3237. 

  3237.        END DO
    3238. 

  3238.     END IF
    3239. 

  3239.  
    3240. 

  3240.     !  X end boundary
    3241. 

  3241.  
    3242. 

  3242.     IF      ( char_stagger .EQ. 'U' ) THEN
    3243. 

  3243.        DO k = kds , kde - 1
    3244. 

  3244.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3245. 

  3245.        DO i = MIN(ide,ite) , MAX(ide - spec_bdy_width + 1,its) , -1
    3246. 

  3246.           ii = ide - i + 1
    3247. 

  3247.           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3248. 

  3248.        END DO
    3249. 

  3249.        END DO
    3250. 

  3250.        END DO
    3251. 

  3251.     ELSE IF ( char_stagger .EQ. 'V' ) THEN
    3252. 

  3252.        DO k = kds , kde - 1
    3253. 

  3253.        DO j = MAX(jds,jts) , MIN(jde,jte)
    3254. 

  3254.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3255. 

  3255.           ii = ide - i
    3256. 

  3256.           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3257. 

  3257.        END DO
    3258. 

  3258.        END DO
    3259. 

  3259.        END DO
    3260. 

  3260.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    3261. 

  3261.        DO k = kds , kde
    3262. 

  3262.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3263. 

  3263.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3264. 

  3264.           ii = ide - i
    3265. 

  3265.           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3266. 

  3266.        END DO
    3267. 

  3267.        END DO
    3268. 

  3268.        END DO
    3269. 

  3269.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3270. 

  3270.        DO k = kds , kde
    3271. 

  3271.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3272. 

  3272.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3273. 

  3273.           ii = ide - i
    3274. 

  3274.           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3275. 

  3275.        END DO
    3276. 

  3276.        END DO
    3277. 

  3277.        END DO
    3278. 

  3278.     ELSE
    3279. 

  3279.        DO k = kds , kde - 1
    3280. 

  3280.        DO j = MAX(jds,jts) , MIN(jde-1,jte)
    3281. 

  3281.        DO i = MIN(ide - 1,ite) , MAX(ide - spec_bdy_width,its) , -1
    3282. 

  3282.           ii = ide - i
    3283. 

  3283.           space_bdy_xe(j,k,ii) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3284. 

  3284.        END DO
    3285. 

  3285.        END DO
    3286. 

  3286.        END DO
    3287. 

  3287.     END IF
    3288. 

  3288.  
    3289. 

  3289.     !  Y start boundary
    3290. 

  3290.  
    3291. 

  3291.     IF ( char_stagger .EQ. 'W' ) THEN
    3292. 

  3292.        DO k = kds , kde
    3293. 

  3293.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3294. 

  3294.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3295. 

  3295.           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3296. 

  3296.        END DO
    3297. 

  3297.        END DO
    3298. 

  3298.        END DO
    3299. 

  3299.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3300. 

  3300.        DO k = kds , kde
    3301. 

  3301.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3302. 

  3302.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3303. 

  3303.           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3304. 

  3304.        END DO
    3305. 

  3305.        END DO
    3306. 

  3306.        END DO
    3307. 

  3307.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    3308. 

  3308.        DO k = kds , kde - 1
    3309. 

  3309.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3310. 

  3310.        DO i = MAX(ids,its) , MIN(ide,ite)
    3311. 

  3311.           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3312. 

  3312.        END DO
    3313. 

  3313.        END DO
    3314. 

  3314.        END DO
    3315. 

  3315.     ELSE
    3316. 

  3316.        DO k = kds , kde - 1
    3317. 

  3317.        DO j = MAX(jds,jts) , MIN(jds + spec_bdy_width - 1,jte)
    3318. 

  3318.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3319. 

  3319.           space_bdy_ys(i,k,j) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3320. 

  3320.        END DO
    3321. 

  3321.        END DO
    3322. 

  3322.        END DO
    3323. 

  3323.     END IF
    3324. 

  3324.  
    3325. 

  3325.     !  Y end boundary
    3326. 

  3326.  
    3327. 

  3327.     IF      ( char_stagger .EQ. 'V' ) THEN
    3328. 

  3328.        DO k = kds , kde - 1
    3329. 

  3329.        DO j = MIN(jde,jte) , MAX(jde - spec_bdy_width + 1,jts) , -1
    3330. 

  3330.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3331. 

  3331.           jj = jde - j + 1
    3332. 

  3332.           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3333. 

  3333.        END DO
    3334. 

  3334.        END DO
    3335. 

  3335.        END DO
    3336. 

  3336.     ELSE IF ( char_stagger .EQ. 'U' ) THEN
    3337. 

  3337.        DO k = kds , kde - 1
    3338. 

  3338.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3339. 

  3339.        DO i = MAX(ids,its) , MIN(ide,ite)
    3340. 

  3340.           jj = jde - j
    3341. 

  3341.           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3342. 

  3342.        END DO
    3343. 

  3343.        END DO
    3344. 

  3344.        END DO
    3345. 

  3345.     ELSE IF ( char_stagger .EQ. 'W' ) THEN
    3346. 

  3346.        DO k = kds , kde
    3347. 

  3347.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3348. 

  3348.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3349. 

  3349.           jj = jde - j
    3350. 

  3350.           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3351. 

  3351.        END DO
    3352. 

  3352.        END DO
    3353. 

  3353.        END DO
    3354. 

  3354.     ELSE IF ( char_stagger .EQ. 'M' ) THEN
    3355. 

  3355.        DO k = kds , kde
    3356. 

  3356.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3357. 

  3357.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3358. 

  3358.           jj = jde - j
    3359. 

  3359.           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3360. 

  3360.        END DO
    3361. 

  3361.        END DO
    3362. 

  3362.        END DO
    3363. 

  3363.     ELSE
    3364. 

  3364.        DO k = kds , kde - 1
    3365. 

  3365.        DO j = MIN(jde-1,jte) , MAX(jde - spec_bdy_width,jts) , -1
    3366. 

  3366.        DO i = MAX(ids,its) , MIN(ide-1,ite)
    3367. 

  3367.           jj = jde - j
    3368. 

  3368.           space_bdy_ye(i,k,jj) = ( data3dnew(i,j,k) - data3dold(i,j,k) ) / time_diff
    3369. 

  3369. !        if (K .eq. 54 .and. I .eq. 369) then
    3370. 

  3370. !	write(0,*) 'N bound i,k,jj,data3dnew,data3dold: ', i,k,jj,data3dnew(I,j,k),data3dold(i,j,k)
    3371. 

  3371. !	endif
    3372. 

  3372.        END DO
    3373. 

  3373.        END DO
    3374. 

  3374.        END DO
    3375. 

  3375.     END IF
    3376. 

  3376.     
    3377. 

  3377.  END SUBROUTINE stuff_bdytend_ijk
    3378. 

  3378. 

  3379. END MODULE module_bc
    3380. 

  3380. 

  3381. SUBROUTINE get_bdyzone_x ( bzx )
    3382. 

  3382.   USE module_bc
    3383. 

  3383.   IMPLICIT NONE
    3384. 

  3384.   INTEGER bzx
    3385. 

  3385.   bzx = bdyzone_x
    3386. 

  3386. END SUBROUTINE get_bdyzone_x
    3387. 

  3387. 

  3388. SUBROUTINE get_bdyzone_y ( bzy)
    3389. 

  3389.   USE module_bc
    3390. 

  3390.   IMPLICIT NONE
    3391. 

  3391.   INTEGER bzy
    3392. 

  3392.   bzy = bdyzone_y
    3393. 

  3393. END SUBROUTINE get_bdyzone_y
    3394. 

  3394. 

  3395. SUBROUTINE get_bdyzone ( bz)
    3396. 

  3396.   USE module_bc
    3397. 

  3397.   IMPLICIT NONE
    3398. 

  3398.   INTEGER bz
    3399. 

  3399.   bz = bdyzone
    3400. 

  3400. END SUBROUTINE get_bdyzone
    3401. 

  3401.