Ignore:
Timestamp:
Aug 16, 2007 2:30:26 PM (17 years ago)
Author:
raasch
Message:

preliminary update of bugfixes and extensions for non-cyclic BCs

File:
1 edited

Legend:

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

    r103 r106  
    66! -----------------
    77! +comm_inter, constant_top_momentumflux, coupling_char, coupling_mode,
    8 ! dt_coupling, ngp_xy, port_name, time_coupling, top_momentumflux_u|v,
    9 ! type_xy, uswst*, vswst*
     8! c_u, c_v, c_w, dt_coupling, ngp_xy, nxlu, nysv, port_name, time_coupling,
     9! top_momentumflux_u|v, type_xy, uswst*, vswst*
    1010!
    1111! Former revisions:
     
    105105
    106106    REAL, DIMENSION(:,:), ALLOCATABLE ::                                       &
    107           dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg, pt_slope_ref, qs, ts, us, z0
     107          c_u, c_v, c_w, dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg, pt_slope_ref,    &
     108          qs, ts, us, z0
    108109
    109110    REAL, DIMENSION(:,:), ALLOCATABLE, TARGET ::                               &
     
    565566!------------------------------------------------------------------------------!
    566567
    567     INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxr, nxra, nny, ny = 0, nya, &
    568                 nyn, nyna, nys, nnz, nz = 0, nza, nzb, nzb_diff, nzt, nzta,    &
    569                 nzt_diff
     568    INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxlu, nxr, nxra, nny, ny = 0, &
     569                nya, nyn, nyna, nys, nysv, nnz, nz = 0, nza, nzb, nzb_diff,    &
     570                nzt, nzta, nzt_diff
    570571
    571572    INTEGER, DIMENSION(:), ALLOCATABLE ::                                      &
Note: See TracChangeset for help on using the changeset viewer.