Ignore:
Timestamp:
Aug 21, 2017 2:59:59 PM (7 years ago)
Author:
kanani
Message:

Vertical nesting implemented (SadiqHuq?)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/init_grid.f90

    r2319 r2365  
    2525! -----------------
    2626! $Id$
     27! Vertical nesting implemented (SadiqHuq)
     28!
     29! 2319 2017-07-20 17:33:17Z suehring
    2730! Remove print statements
    2831!
     
    250253               canyon_height, canyon_wall_left, canyon_wall_south,             &
    251254               canyon_width_x, canyon_width_y, constant_flux_layer,            &
    252                coupling_char, dp_level_ind_b, dz, dz_max, dz_stretch_factor,   &
     255               coupling_char, coupling_mode,                                   &
     256               dp_level_ind_b, dz, dz_max, dz_stretch_factor,                  &
    253257               dz_stretch_level, dz_stretch_level_index, grid_level, ibc_uv_b, &
    254258               io_blocks, io_group, inflow_l, inflow_n, inflow_r, inflow_s,    &
     
    285289    USE surface_mod,                                                           &
    286290        ONLY:  get_topography_top_index, init_bc
     291
     292    USE vertical_nesting_mod,                                                  &
     293        ONLY:  vnested, vnest_init_grid
    287294
    288295    IMPLICIT NONE
     
    20002007    CALL exchange_horiz( l_wall, nbgp )     
    20012008
     2009!
     2010!-- Vertical nesting: communicate vertical grid level arrays between fine and
     2011!-- coarse grid
     2012    IF ( vnested )  CALL vnest_init_grid
    20022013
    20032014 END SUBROUTINE init_grid
Note: See TracChangeset for help on using the changeset viewer.