Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 667


Ignore:
Timestamp:
Dec 23, 2010 12:06:00 PM (14 years ago)
Author:
suehring
Message:

summary:

Gryschka:

  • Coupling with different resolution and different numbers of PEs in ocean and atmosphere is available
  • Exchange of u and v from ocean surface to atmosphere surface
  • Mirror boundary condition for u and v at the bottom are replaced by dirichlet boundary conditions
  • Inflow turbulence is now defined by flucuations around spanwise mean
  • Bugfixes for cyclic_fill and constant_volume_flow

Suehring:

  • New advection added ( Wicker and Skamarock 5th order ), therefore:
    • New module advec_ws.f90
    • Modified exchange of ghost boundaries.
    • Modified evaluation of turbulent fluxes
    • New index bounds nxlg, nxrg, nysg, nyng

advec_ws.f90

Advection scheme for scalars and momentum using the flux formulation of
Wicker and Skamarock 5th order.
Additionally the module contains of a routine using for initialisation and
steering of the statical evaluation. The computation of turbulent fluxes takes
place inside the advection routines.
In case of vector architectures Dirichlet and Radiation boundary conditions are
outstanding and not available. Furthermore simulations within topography are
not possible so far. A further routine local_diss_ij is available and is used
if a control of dissipative fluxes is desired.

check_parameters.f90

Exchange of parameters between ocean and atmosphere via PE0
Check for illegal combination of ws-scheme and timestep scheme.
Check for topography and ws-scheme.
Check for not cyclic boundary conditions in combination with ws-scheme and
loop_optimization = 'vector'.
Check for call_psolver_at_all_substeps and ws-scheme for momentum_advec.

Different processor/grid topology in atmosphere and ocean is now allowed!
Bugfixes in checking for conserve_volume_flow_mode.

exchange_horiz.f90

Dynamic exchange of ghost points with nbgp_local to ensure that no useless
ghost points exchanged in case of multigrid. type_yz(0) and type_xz(0) used for
normal grid, the remaining types used for the several grid levels.
Exchange is done via MPI-Vectors with a dynamic value of ghost points which
depend on the advection scheme. Exchange of left and right PEs is 10% faster
with MPI-Vectors than without.

flow_statistics.f90

When advection is computed with ws-scheme, turbulent fluxes are already
computed in the respective advection routines and buffered in arrays
sums_xxxx_ws_l(). This is due to a consistent treatment of statistics
with the numerics and to avoid unphysical kinks near the surface. So some if-
requests has to be done to dicern between fluxes from ws-scheme other advection
schemes. Furthermore the computation of z_i is only done if the heat flux
exceeds a minimum value. This affects only simulations of a neutral boundary
layer and is due to reasons of computations in the advection scheme.

inflow_turbulence.f90

Using nbgp recycling planes for a better resolution of the turbulent flow near
the inflow.

init_grid.f90

Definition of new array bounds nxlg, nxrg, nysg, nyng on each PE.
Furthermore the allocation of arrays and steering of loops is done with these
parameters. Call of exchange_horiz are modified.
In case of dirichlet bounday condition at the bottom zu(0)=0.0
dzu_mg has to be set explicitly for a equally spaced grid near bottom.
ddzu_pres added to use a equally spaced grid near bottom.

init_pegrid.f90

Moved determination of target_id's from init_coupling
Determination of parameters needed for coupling (coupling_topology, ngp_a, ngp_o)
with different grid/processor-topology in ocean and atmosphere

Adaption of ngp_xy, ngp_y to a dynamic number of ghost points.
The maximum_grid_level changed from 1 to 0. 0 is the normal grid, 1 to
maximum_grid_level the grids for multigrid, in which 0 and 1 are normal grids.
This distinction is due to reasons of data exchange and performance for the
normal grid and grids in poismg.
The definition of MPI-Vectors adapted to a dynamic numer of ghost points.
New MPI-Vectors for data exchange between left and right boundaries added.
This is due to reasons of performance (10% faster).

ATTENTION: nnz_x undefined problem still has to be solved!!!!!!!!
TEST OUTPUT (TO BE REMOVED) logging mpi2 ierr values

parin.f90

Steering parameter dissipation_control added in inipar.

Makefile

Module advec_ws added.

Modules

Removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc

For coupling with different resolution in ocean and atmophere:
+nx_a, +nx_o, ny_a, +ny_o, ngp_a, ngp_o, +total_2d_o, +total_2d_a,
+coupling_topology

Buffer arrays for the left sided advective fluxes added in arrays_3d.
+flux_s_u, +flux_s_v, +flux_s_w, +diss_s_u, +diss_s_v, +diss_s_w,
+flux_s_pt, +diss_s_pt, +flux_s_e, +diss_s_e, +flux_s_q, +diss_s_q,
+flux_s_sa, +diss_s_sa
3d arrays for dissipation control added. (only necessary for vector arch.)
+var_x, +var_y, +var_z, +gamma_x, +gamma_y, +gamma_z
Default of momentum_advec and scalar_advec changed to 'ws-scheme' .
+exchange_mg added in control_parameters to steer the data exchange.
Parameters +nbgp, +nxlg, +nxrg, +nysg, +nyng added in indices.
flag array +boundary_flags added in indices to steer the degradation of order
of the advective fluxes when non-cyclic boundaries are used.
MPI-datatypes +type_y, +type_y_int and +type_yz for data_exchange added in
pegrid.
+sums_wsus_ws_l, +sums_wsvs_ws_l, +sums_us2_ws_l, +sums_vs2_ws_l,
+sums_ws2_ws_l, +sums_wspts_ws_l, +sums_wssas_ws_l, +sums_wsqs_ws_l
and +weight_substep added in statistics to steer the statistical evaluation
of turbulent fluxes in the advection routines.
LOGICALS +ws_scheme_sca and +ws_scheme_mom added to get a better performance
in prognostic_equations.
LOGICAL +dissipation_control control added to steer numerical dissipation
in ws-scheme.

Changed length of string run_description_header

pres.f90

New allocation of tend when ws-scheme and multigrid is used. This is due to
reasons of perforance of the data_exchange. The same is done with p after
poismg is called.
nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng when no
multigrid is used. Calls of exchange_horiz are modified.

bugfix: After pressure correction no volume flow correction in case of
non-cyclic boundary conditions
(has to be done only before pressure correction)

Call of SOR routine is referenced with ddzu_pres.

prognostic_equations.f90

Calls of the advection routines with WS5 added.
Calls of ws_statistics added to set the statistical arrays to zero after each
time step.

advec_particles.f90

Declaration of de_dx, de_dy, de_dz adapted to additional ghost points.
Furthermore the calls of exchange_horiz were modified.

asselin_filter.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

average_3d_data.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

boundary_conds.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
Removed mirror boundary conditions for u and v at the bottom in case of
ibc_uv_b == 0. Instead, dirichelt boundary conditions (u=v=0) are set
in init_3d_model

calc_liquid_water_content.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

calc_spectra.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for
allocation of tend.

check_open.f90

Output of total array size was adapted to nbgp.

data_output_2d.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
allocation of arrays local_2d and total_2d.
Calls of exchange_horiz are modified.

data_output_2d.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
allocation of arrays. Calls of exchange_horiz are modified.
Skip-value skip_do_avs changed to a dynamic adaption of ghost points.

data_output_mask.f90

Calls of exchange_horiz are modified.

diffusion_e.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

diffusion_s.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

diffusion_u.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

diffusion_v.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

diffusion_w.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

diffusivities.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

diffusivities.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
Calls of exchange_horiz are modified.

exchange_horiz_2d.f90

Dynamic exchange of ghost points with nbgp, which depends on the advection
scheme. Exchange between left and right PEs is now done with MPI-vectors.

global_min_max.f90

Adapting of the index arrays, because MINLOC assumes lowerbound
at 1 and not at nbgp.

init_3d_model.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
allocation of arrays. Calls of exchange_horiz are modified.
Call ws_init to initialize arrays needed for statistical evaluation and
optimization when ws-scheme is used.
Initial volume flow is now calculated by using the variable hom_sum.
Therefore the correction of initial volume flow for non-flat topography
removed (removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc)
Changed surface boundary conditions for u and v in case of ibc_uv_b == 0 from
mirror bc to dirichlet boundary conditions (u=v=0), so that k=nzb is
representative for the height z0

Bugfix: type conversion of '1' to 64bit for the MAX function (ngp_3d_inner)

init_coupling.f90

determination of target_id's moved to init_pegrid

init_pt_anomaly.f90

Call of exchange_horiz are modified.

init_rankine.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
Calls of exchange_horiz are modified.

init_slope.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.

header.f90

Output of advection scheme.

poismg.f90

Calls of exchange_horiz are modified.

prandtl_fluxes.f90

Changed surface boundary conditions for u and v from mirror bc to dirichelt bc,
therefore u(uzb,:,:) and v(nzb,:,:) is now representative for the height z0
nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

production_e.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng

read_3d_binary.f90

+/- 1 replaced with +/- nbgp when swapping and allocating variables.

sor.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
Call of exchange_horiz are modified.
bug removed in declaration of ddzw(), nz replaced by nzt+1

subsidence.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.

sum_up_3d_data.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.

surface_coupler.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in
MPI_SEND() and MPI_RECV.
additional case for nonequivalent processor and grid topopolgy in ocean and
atmosphere added (coupling_topology = 1)

Added exchange of u and v from Ocean to Atmosphere

time_integration.f90

Calls of exchange_horiz are modified.
Adaption to slooping surface.

timestep.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.

user_3d_data_averaging.f90, user_data_output_2d.f90, user_data_output_3d.f90,
user_actions.f90, user_init.f90, user_init_plant_canopy.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.

user_read_restart_data.f90

Allocation with nbgp.

wall_fluxes.f90

nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.

write_compressed.f90

Array bounds and nx, ny adapted with nbgp.

sor.f90

bug removed in declaration of ddzw(), nz replaced by nzt+1

Location:
palm/trunk/SOURCE
Files:
66 edited
1 copied

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE

    • Property svn:mergeinfo set to (toggle deleted branches)
      /palm/branches/suehring423-666

  • TabularUnified palm/trunk/SOURCE/Makefile

    r482 r667  
    44# Current revisions:
    55# ------------------
    6 #
     6# +advec_ws
    77#
    88# Former revisions:
    … …  
    5757
    5858RCS = advec_particles.f90 advec_s_bc.f90 advec_s_pw.f90 advec_s_up.f90 \
    59         advec_s_ups.f90 advec_u_pw.f90 advec_u_up.f90 advec_u_ups.f90 \
    60         advec_v_pw.f90 advec_v_up.f90 advec_v_ups.f90 advec_w_pw.f90 \
    61         advec_w_up.f90 advec_w_ups.f90 asselin_filter.f90 average_3d_data.f90 \
    62         boundary_conds.f90 buoyancy.f90 calc_liquid_water_content.f90 \
    63         calc_precipitation.f90 calc_radiation.f90 calc_spectra.f90 \
    64         check_for_restart.f90 check_open.f90 check_parameters.f90 \
    65         close_file.f90 compute_vpt.f90 coriolis.f90 cpu_log.f90 \
    66         cpu_statistics.f90 data_log.f90 data_output_dvrp.f90 \
    67         data_output_mask.f90 data_output_profiles.f90 data_output_ptseries.f90 \
    68         data_output_spectra.f90 data_output_tseries.f90 data_output_2d.f90 \
    69         data_output_3d.f90 diffusion_e.f90 diffusion_s.f90 diffusion_u.f90 \
    70         diffusion_v.f90 diffusion_w.f90 diffusivities.f90 disturb_field.f90 \
    71         disturb_heatflux.f90 eqn_state_seawater.f90 exchange_horiz.f90 \
    72         exchange_horiz_2d.f90 \
     59        advec_ws.f90 advec_s_ups.f90 advec_u_pw.f90 advec_u_up.f90 \
     60        advec_u_ups.f90 advec_v_pw.f90 advec_v_up.f90 advec_v_ups.f90 \
     61        advec_w_pw.f90 advec_w_up.f90 advec_w_ups.f90 asselin_filter.f90 \
     62        average_3d_data.f90 boundary_conds.f90 buoyancy.f90 \
     63        calc_liquid_water_content.f90 calc_precipitation.f90 \
     64        calc_radiation.f90 calc_spectra.f90 check_for_restart.f90 \
     65        check_open.f90 check_parameters.f90 close_file.f90 compute_vpt.f90 \
     66        coriolis.f90 cpu_log.f90 cpu_statistics.f90 data_log.f90 \
     67        data_output_dvrp.f90 data_output_mask.f90 data_output_profiles.f90 \
     68        data_output_ptseries.f90 data_output_spectra.f90 data_output_tseries.f90 \
     69        data_output_2d.f90 data_output_3d.f90 diffusion_e.f90 diffusion_s.f90 \
     70        diffusion_u.f90 diffusion_v.f90 diffusion_w.f90 diffusivities.f90 \
     71        disturb_field.f90 disturb_heatflux.f90 eqn_state_seawater.f90 \
     72        exchange_horiz.f90 exchange_horiz_2d.f90 \
    7373        fft_xy.f90 flow_statistics.f90 global_min_max.f90 \
    7474        header.f90 impact_of_latent_heat.f90 inflow_turbulence.f90 \
    … …  
    7777        init_masks.f90 init_ocean.f90 init_particles.f90 init_pegrid.f90 \
    7878        init_pt_anomaly.f90 init_rankine.f90 init_slope.f90 \
    79         interaction_droplets_ptq.f90 local_flush.f90 local_getenv.f90 \
    80         local_stop.f90 local_system.f90 local_tremain.f90 \
     79        interaction_droplets_ptq.f90 local_flush.f90 \
     80        local_getenv.f90 local_stop.f90 local_system.f90 local_tremain.f90 \
    8181        local_tremain_ini.f90 message.f90 modules.f90 netcdf.f90 \
    8282        package_parin.f90 palm.f90 parin.f90 particle_boundary_conds.f90 \
    … …  
    106106OBJS =  advec_particles.o advec_s_bc.o advec_s_pw.o advec_s_up.o \
    107107        advec_s_ups.o advec_u_pw.o advec_u_up.o advec_u_ups.o \
    108         advec_v_pw.o advec_v_up.o advec_v_ups.o advec_w_pw.o \
     108        advec_ws.o advec_v_pw.o advec_v_up.o advec_v_ups.o advec_w_pw.o \
    109109        advec_w_up.o advec_w_ups.o asselin_filter.o average_3d_data.o \
    110110        boundary_conds.o buoyancy.o calc_liquid_water_content.o \
    … …  
    184184advec_v_up.o: modules.o
    185185advec_v_ups.o: modules.o
     186advec_ws.o: modules.o
    186187advec_w_pw.o: modules.o
    187188advec_w_up.o: modules.o
    … …  
    230231inflow_turbulence.o: modules.o
    231232init_1d_model.o: modules.o
    232 init_3d_model.o: modules.o random_function.o
     233init_3d_model.o: modules.o random_function.o advec_ws.o
    233234init_advec.o: modules.o
    234235init_cloud_physics.o: modules.o
    … …  
    264265production_e.o: modules.o wall_fluxes.o
    265266prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_u_pw.o \
     267        advec_ws.o \
    266268        advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o  \
    267269        buoyancy.o calc_precipitation.o calc_radiation.o coriolis.o \

  • TabularUnified palm/trunk/SOURCE/advec_particles.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
     6! Declaration of de_dx, de_dy, de_dz adapted to additional
     7! ghost points. Furthermore the calls of exchange_horiz were modified.
    68!
    79! TEST: PRINT statements on unit 9 (commented out)
    … …  
    153155    REAL    ::  location(1:30,1:3)
    154156
    155     REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  de_dx, de_dy, de_dz
     157    REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  de_dx, de_dy, de_dz
    156158
    157159    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  trlpt, trnpt, trrpt, trspt
    … …  
    768770!
    769771!--    Lateral boundary conditions
    770        CALL exchange_horiz( de_dx )
    771        CALL exchange_horiz( de_dy )
    772        CALL exchange_horiz( de_dz )
    773        CALL exchange_horiz( diss  )
     772       CALL exchange_horiz( de_dx, nbgp )
     773       CALL exchange_horiz( de_dy, nbgp )
     774       CALL exchange_horiz( de_dz, nbgp )
     775       CALL exchange_horiz( diss, nbgp  )
    774776
    775777!

  • TabularUnified palm/trunk/SOURCE/advec_w_pw.f90

    r484 r667  
    8989       REAL    ::  gu, gv
    9090
    91 
    9291       gu = 2.0 * u_gtrans
    9392       gv = 2.0 * v_gtrans
    … …  
    103102                                                )
    104103       ENDDO
    105 
    106104    END SUBROUTINE advec_w_pw_ij
    107105

  • TabularUnified palm/trunk/SOURCE/asselin_filter.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    4949!$OMP PARALLEL PRIVATE (i,j,k)
    5050!$OMP DO
    51     DO  i = nxl-1, nxr+1
    52        DO  j = nys-1, nyn+1
     51    DO  i = nxlg, nxrg
     52       DO  j = nysg, nyng
    5353
    5454          DO  k = nzb_2d(j,i), nzt+1

  • TabularUnified palm/trunk/SOURCE/average_3d_data.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    5858
    5959          CASE ( 'e' )
    60              DO  i = nxl-1, nxr+1
    61                 DO  j = nys-1, nyn+1
     60             DO  i = nxlg, nxrg
     61                DO  j = nysg, nyng
    6262                   DO  k = nzb, nzt+1
    6363                      e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d )
    … …  
    6767
    6868          CASE ( 'qsws*' )
    69              DO  i = nxl-1, nxr+1
    70                 DO  j = nys-1, nyn+1
     69             DO  i = nxlg, nxrg
     70                DO  j = nysg, nyng
    7171                   qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d )
    7272                ENDDO
    … …  
    7474
    7575          CASE ( 'lwp*' )
    76              DO  i = nxl-1, nxr+1
    77                 DO  j = nys-1, nyn+1
     76             DO  i = nxlg, nxrg
     77                DO  j = nysg, nyng
    7878                   lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d )
    7979                ENDDO
    … …  
    8181
    8282          CASE ( 'p' )
    83              DO  i = nxl-1, nxr+1
    84                 DO  j = nys-1, nyn+1
     83             DO  i = nxlg, nxrg
     84                DO  j = nysg, nyng
    8585                   DO  k = nzb, nzt+1
    8686                      p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d )
    … …  
    108108
    109109          CASE ( 'prr*' )
    110              DO  i = nxl-1, nxr+1
    111                 DO  j = nys-1, nyn+1
     110             DO  i = nxlg, nxrg
     111                DO  j = nysg, nyng
    112112                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) / &
    113113                                                REAL( average_count_3d )
    … …  
    116116
    117117          CASE ( 'pt' )
    118              DO  i = nxl-1, nxr+1
    119                 DO  j = nys-1, nyn+1
     118             DO  i = nxlg, nxrg
     119                DO  j = nysg, nyng
    120120                   DO  k = nzb, nzt+1
    121121                      pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d )
    … …  
    125125
    126126          CASE ( 'q' )
    127              DO  i = nxl-1, nxr+1
    128                 DO  j = nys-1, nyn+1
     127             DO  i = nxlg, nxrg
     128                DO  j = nysg, nyng
    129129                   DO  k = nzb, nzt+1
    130130                      q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d )
    … …  
    134134
    135135          CASE ( 'ql' )
    136              DO  i = nxl-1, nxr+1
    137                 DO  j = nys-1, nyn+1
     136             DO  i = nxlg, nxrg
     137                DO  j = nysg, nyng
    138138                   DO  k = nzb, nzt+1
    139139                      ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d )
    … …  
    143143
    144144          CASE ( 'ql_c' )
    145              DO  i = nxl-1, nxr+1
    146                 DO  j = nys-1, nyn+1
     145             DO  i = nxlg, nxrg
     146                DO  j = nysg, nyng
    147147                   DO  k = nzb, nzt+1
    148148                      ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d )
    … …  
    152152
    153153          CASE ( 'ql_v' )
    154              DO  i = nxl-1, nxr+1
    155                 DO  j = nys-1, nyn+1
     154             DO  i = nxlg, nxrg
     155                DO  j = nysg, nyng
    156156                   DO  k = nzb, nzt+1
    157157                      ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d )
    … …  
    161161
    162162          CASE ( 'ql_vp' )
    163              DO  i = nxl-1, nxr+1
    164                 DO  j = nys-1, nyn+1
     163             DO  i = nxlg, nxrg
     164                DO  j = nysg, nyng
    165165                   DO  k = nzb, nzt+1
    166166                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / &
    … …  
    171171
    172172          CASE ( 'qv' )
    173              DO  i = nxl-1, nxr+1
    174                 DO  j = nys-1, nyn+1
     173             DO  i = nxlg, nxrg
     174                DO  j = nysg, nyng
    175175                   DO  k = nzb, nzt+1
    176176                      qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d )
    … …  
    180180
    181181          CASE ( 'rho' )
    182              DO  i = nxl-1, nxr+1
    183                 DO  j = nys-1, nyn+1
     182             DO  i = nxlg, nxrg
     183                DO  j = nysg, nyng
    184184                   DO  k = nzb, nzt+1
    185185                      rho_av(k,j,i) = rho_av(k,j,i) / REAL( average_count_3d )
    … …  
    189189
    190190          CASE ( 's' )
    191              DO  i = nxl-1, nxr+1
    192                 DO  j = nys-1, nyn+1
     191             DO  i = nxlg, nxrg
     192                DO  j = nysg, nyng
    193193                   DO  k = nzb, nzt+1
    194194                      s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d )
    … …  
    198198
    199199          CASE ( 'sa' )
    200              DO  i = nxl-1, nxr+1
    201                 DO  j = nys-1, nyn+1
     200             DO  i = nxlg, nxrg
     201                DO  j = nysg, nyng
    202202                   DO  k = nzb, nzt+1
    203203                      sa_av(k,j,i) = sa_av(k,j,i) / REAL( average_count_3d )
    … …  
    207207
    208208         CASE ( 'shf*' )
    209              DO  i = nxl-1, nxr+1
    210                 DO  j = nys-1, nyn+1
     209             DO  i = nxlg, nxrg
     210                DO  j = nysg, nyng
    211211                   shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d )
    212212                ENDDO
    … …  
    214214
    215215          CASE ( 't*' )
    216              DO  i = nxl-1, nxr+1
    217                 DO  j = nys-1, nyn+1
     216             DO  i = nxlg, nxrg
     217                DO  j = nysg, nyng
    218218                   ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d )
    219219                ENDDO
    … …  
    221221
    222222          CASE ( 'u' )
    223              DO  i = nxl-1, nxr+1
    224                 DO  j = nys-1, nyn+1
     223             DO  i = nxlg, nxrg
     224                DO  j = nysg, nyng
    225225                   DO  k = nzb, nzt+1
    226226                      u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d )
    … …  
    230230
    231231          CASE ( 'u*' )
    232              DO  i = nxl-1, nxr+1
    233                 DO  j = nys-1, nyn+1
     232             DO  i = nxlg, nxrg
     233                DO  j = nysg, nyng
    234234                   us_av(j,i) = us_av(j,i) / REAL( average_count_3d )
    235235                ENDDO
    … …  
    237237
    238238          CASE ( 'v' )
    239              DO  i = nxl-1, nxr+1
    240                 DO  j = nys-1, nyn+1
     239             DO  i = nxlg, nxrg
     240                DO  j = nysg, nyng
    241241                   DO  k = nzb, nzt+1
    242242                      v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d )
    … …  
    246246
    247247          CASE ( 'vpt' )
    248              DO  i = nxl-1, nxr+1
    249                 DO  j = nys-1, nyn+1
     248             DO  i = nxlg, nxrg
     249                DO  j = nysg, nyng
    250250                   DO  k = nzb, nzt+1
    251251                      vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d )
    … …  
    255255
    256256          CASE ( 'w' )
    257              DO  i = nxl-1, nxr+1
    258                 DO  j = nys-1, nyn+1
     257             DO  i = nxlg, nxrg
     258                DO  j = nysg, nyng
    259259                   DO  k = nzb, nzt+1
    260260                      w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d )
    … …  
    264264
    265265          CASE ( 'z0*' )
    266              DO  i = nxl-1, nxr+1
    267                 DO  j = nys-1, nyn+1
     266             DO  i = nxlg, nxrg
     267                DO  j = nysg, nyng
    268268                   z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d )
    269269                ENDDO

  • TabularUnified palm/trunk/SOURCE/boundary_conds.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
     6!
     7! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
     8!
    69!
    7 !
     10! Removed mirror boundary conditions for u and v at the bottom in case of
     11! ibc_uv_b == 0. Instead, dirichelt boundary conditions (u=v=0) are set
     12! in init_3d_model
     13! 
    814! Former revisions:
    915! -----------------
    … …  
    7076    IF ( range == 'main')  THEN
    7177!
    72 !--    Bottom boundary
    73        IF ( ibc_uv_b == 0 )  THEN
    74 !
    75 !--       Satisfying the Dirichlet condition with an extra layer below the
    76 !--       surface where the u and v component change their sign
    77           u_p(nzb,:,:) = -u_p(nzb+1,:,:)
    78           v_p(nzb,:,:) = -v_p(nzb+1,:,:)
    79        ELSE
     78!--    Bottom boundary
     79       IF ( ibc_uv_b == 1 )  THEN
    8080          u_p(nzb,:,:) = u_p(nzb+1,:,:)
    8181          v_p(nzb,:,:) = v_p(nzb+1,:,:)
    8282       ENDIF
    83        DO  i = nxl-1, nxr+1
    84           DO  j = nys-1, nyn+1
     83       DO  i = nxlg, nxrg
     84          DO  j = nysg, nyng
    8585             w_p(nzb_w_inner(j,i),j,i) = 0.0
    8686          ENDDO
    … …  
    9090!--    Top boundary
    9191       IF ( ibc_uv_t == 0 )  THEN
    92           u_p(nzt+1,:,:) = ug(nzt+1)
    93           v_p(nzt+1,:,:) = vg(nzt+1)
     92           u_p(nzt+1,:,:) = ug(nzt+1)
     93           v_p(nzt+1,:,:) = vg(nzt+1)
    9494       ELSE
    95           u_p(nzt+1,:,:) = u_p(nzt,:,:)
    96           v_p(nzt+1,:,:) = v_p(nzt,:,:)
     95           u_p(nzt+1,:,:) = u_p(nzt,:,:)
     96           v_p(nzt+1,:,:) = v_p(nzt,:,:)
    9797       ENDIF
    9898       w_p(nzt:nzt+1,:,:) = 0.0  ! nzt is not a prognostic level (but cf. pres)
    … …  
    103103!--    the sea surface temperature of the coupled ocean model.
    104104       IF ( ibc_pt_b == 0 )  THEN
    105           DO  i = nxl-1, nxr+1
    106              DO  j = nys-1, nyn+1
     105          DO  i = nxlg, nxrg
     106             DO  j = nysg, nyng
    107107                pt_p(nzb_s_inner(j,i),j,i) = pt(nzb_s_inner(j,i),j,i)
    108108             ENDDO
    109109          ENDDO
    110110       ELSEIF ( ibc_pt_b == 1 )  THEN
    111           DO  i = nxl-1, nxr+1
    112              DO  j = nys-1, nyn+1
     111          DO  i = nxlg, nxrg
     112             DO  j = nysg, nyng
    113113                pt_p(nzb_s_inner(j,i),j,i) = pt_p(nzb_s_inner(j,i)+1,j,i)
    114114             ENDDO
    … …  
    119119!--    Temperature at top boundary
    120120       IF ( ibc_pt_t == 0 )  THEN
    121           pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
     121           pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
    122122       ELSEIF ( ibc_pt_t == 1 )  THEN
    123           pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
     123           pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
    124124       ELSEIF ( ibc_pt_t == 2 )  THEN
    125           pt_p(nzt+1,:,:) = pt_p(nzt,:,:)   + bc_pt_t_val * dzu(nzt+1)
     125           pt_p(nzt+1,:,:) = pt_p(nzt,:,:)   + bc_pt_t_val * dzu(nzt+1)
    126126       ENDIF
    127127
    … …  
    130130!--    Generally Neumann conditions with de/dz=0 are assumed
    131131       IF ( .NOT. constant_diffusion )  THEN
    132           DO  i = nxl-1, nxr+1
    133              DO  j = nys-1, nyn+1
     132          DO  i = nxlg, nxrg
     133             DO  j = nysg, nyng
    134134                e_p(nzb_s_inner(j,i),j,i) = e_p(nzb_s_inner(j,i)+1,j,i)
    135135             ENDDO
    … …  
    144144!--       Bottom boundary: Neumann condition because salinity flux is always
    145145!--       given
    146           DO  i = nxl-1, nxr+1
    147              DO  j = nys-1, nyn+1
     146          DO  i = nxlg, nxrg
     147             DO  j = nysg, nyng
    148148                sa_p(nzb_s_inner(j,i),j,i) = sa_p(nzb_s_inner(j,i)+1,j,i)
    149149             ENDDO
    … …  
    153153!--       Top boundary: Dirichlet or Neumann
    154154          IF ( ibc_sa_t == 0 )  THEN
    155              sa_p(nzt+1,:,:) = sa(nzt+1,:,:)
     155              sa_p(nzt+1,:,:) = sa(nzt+1,:,:)
    156156          ELSEIF ( ibc_sa_t == 1 )  THEN
    157              sa_p(nzt+1,:,:) = sa_p(nzt,:,:)
     157              sa_p(nzt+1,:,:) = sa_p(nzt,:,:)
    158158          ENDIF
    159159
    … …  
    167167!--       Surface conditions for constant_humidity_flux
    168168          IF ( ibc_q_b == 0 ) THEN
    169              DO  i = nxl-1, nxr+1
    170                 DO  j = nys-1, nyn+1
     169             DO  i = nxlg, nxrg
     170                DO  j = nysg, nyng
    171171                   q_p(nzb_s_inner(j,i),j,i) = q(nzb_s_inner(j,i),j,i)
    172172                ENDDO
    173173             ENDDO
    174174          ELSE
    175              DO  i = nxl-1, nxr+1
    176                 DO  j = nys-1, nyn+1
     175             DO  i = nxlg, nxrg
     176                DO  j = nysg, nyng
    177177                   q_p(nzb_s_inner(j,i),j,i) = q_p(nzb_s_inner(j,i)+1,j,i)
    178178                ENDDO
    … …  
    182182!--       Top boundary
    183183          q_p(nzt+1,:,:) = q_p(nzt,:,:)   + bc_q_t_val * dzu(nzt+1)
     184
     185
    184186       ENDIF
    185187
    … …  
    226228       c_max = dy / dt_3d
    227229
    228        DO i = nxl-1, nxr+1
     230       DO i = nxlg, nxrg
    229231          DO k = nzb+1, nzt+1
    230232
    … …  
    299301!--    Bottom boundary at the outflow
    300302       IF ( ibc_uv_b == 0 )  THEN
    301           u_p(nzb,-1,:) = -u_p(nzb+1,-1,:)
    302           v_p(nzb,0,:)  = -v_p(nzb+1,0,:) 
     303          u_p(nzb,-1,:) = 0.0
     304          v_p(nzb,0,:)  = 0.0 
    303305       ELSE                   
    304306          u_p(nzb,-1,:) =  u_p(nzb+1,-1,:)
    … …  
    324326       c_max = dy / dt_3d
    325327
    326        DO i = nxl-1, nxr+1
     328       DO i = nxlg, nxrg
    327329          DO k = nzb+1, nzt+1
    328330
    … …  
    397399!--    Bottom boundary at the outflow
    398400       IF ( ibc_uv_b == 0 )  THEN
    399           u_p(nzb,ny+1,:) = -u_p(nzb+1,ny+1,:)
    400           v_p(nzb,ny+1,:) = -v_p(nzb+1,ny+1,:) 
     401          u_p(nzb,ny+1,:) = 0.0
     402          v_p(nzb,ny+1,:) = 0.0  
    401403       ELSE                   
    402404          u_p(nzb,ny+1,:) =  u_p(nzb+1,ny+1,:)
    … …  
    422424       c_max = dx / dt_3d
    423425
    424        DO j = nys-1, nyn+1
     426       DO j = nysg, nyng
    425427          DO k = nzb+1, nzt+1
    426428
    … …  
    495497!--    Bottom boundary at the outflow
    496498       IF ( ibc_uv_b == 0 )  THEN
    497           u_p(nzb,:,-1) = -u_p(nzb+1,:,-1)
    498           v_p(nzb,:,-1) = -v_p(nzb+1,:,-1) 
     499          u_p(nzb,:,0)  = 0.0
     500          v_p(nzb,:,-1) = 0.0
    499501       ELSE                   
    500           u_p(nzb,:,-1) =  u_p(nzb+1,:,-1)
     502          u_p(nzb,:,0)  =  u_p(nzb+1,:,0)
    501503          v_p(nzb,:,-1) =  v_p(nzb+1,:,-1)
    502504       ENDIF
    … …  
    520522       c_max = dx / dt_3d
    521523
    522        DO j = nys-1, nyn+1
     524       DO j = nysg, nyng
    523525          DO k = nzb+1, nzt+1
    524526
    … …  
    593595!--    Bottom boundary at the outflow
    594596       IF ( ibc_uv_b == 0 )  THEN
    595           u_p(nzb,:,nx+1) = -u_p(nzb+1,:,nx+1)
    596           v_p(nzb,:,nx+1) = -v_p(nzb+1,:,nx+1)
     597          u_p(nzb,:,nx+1) = 0.0
     598          v_p(nzb,:,nx+1) = 0.0
    597599       ELSE                   
    598600          u_p(nzb,:,nx+1) =  u_p(nzb+1,:,nx+1)

  • TabularUnified palm/trunk/SOURCE/calc_liquid_water_content.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    4747    REAL :: alpha, e_s, q_s, t_l
    4848
    49     DO  i = nxl-1, nxr+1
    50        DO  j = nys-1, nyn+1
     49    DO  i = nxlg, nxrg
     50       DO  j = nysg, nyng
    5151          DO  k = nzb_2d(j,i)+1, nzt
    5252

  • TabularUnified palm/trunk/SOURCE/calc_precipitation.f90

    r484 r667  
    88! Former revisions:
    99! -----------------
    10 ! $Id$
     10! $Id: calc_precipitation.f90 484 2010-02-05 07:36:54Z raasch
    1111!
    1212! 403 2009-10-22 13:57:16Z franke

  • TabularUnified palm/trunk/SOURCE/calc_spectra.f90

    r392 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation
     7! of tend
    78!
    89! Former revisions:
    … …  
    152153    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
    153154       DEALLOCATE( tend )
    154        ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     155       ALLOCATE( tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    155156    ENDIF
    156157

  • TabularUnified palm/trunk/SOURCE/check_for_restart.f90

    r623 r667  
    55! -----------------
    66!
     7! Exchange of terminate_coupled between ocean and atmosphere by PE0
    78!
    89! Former revisions:
    … …  
    9394       terminate_coupled = 3
    9495#if defined( __parallel )
    95        CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,          &
    96                           target_id, 0,                                      &
    97                           terminate_coupled_remote, 1, MPI_INTEGER,          &
    98                           target_id, 0,                                      &
    99                           comm_inter, status, ierr )
     96       IF ( myid == 0 ) THEN
     97          CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,          &
     98                             target_id, 0,                                      &
     99                             terminate_coupled_remote, 1, MPI_INTEGER,          &
     100                             target_id, 0,                                      &
     101                             comm_inter, status, ierr )
     102       ENDIF
     103       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr)
    100104#endif
    101105    ENDIF
    … …  
    140144             ENDIF
    141145#if defined( __parallel )
    142              CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,    &
    143                                 target_id,  0,                               &
    144                                 terminate_coupled_remote, 1, MPI_INTEGER,    &
    145                                 target_id,  0,                               &
    146                                 comm_inter, status, ierr )
     146             IF ( myid == 0 ) THEN
     147                CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER,    &
     148                                   target_id,  0,                               &
     149                                   terminate_coupled_remote, 1, MPI_INTEGER,    &
     150                                   target_id,  0,                               &
     151                                   comm_inter, status, ierr )   
     152             ENDIF
     153             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr) 
     154           
    147155#endif
    148156          ENDIF

  • TabularUnified palm/trunk/SOURCE/check_open.f90

    r601 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Output of total array size was adapted to nbgp.
    77!
    88! Former revisions:
    … …  
    278278!--          Output for combine_plot_fields
    279279             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
    280                 WRITE (21)  -1, nx+1, -1, ny+1    ! total array size
     280                WRITE (21)  -nbgp, nx+nbgp, -nbgp, ny+nbgp    ! total array size
    281281                WRITE (21)   0, nx+1,  0, ny+1    ! output part
    282282             ENDIF
    … …  
    319319!--          Output for combine_plot_fields
    320320             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
    321                 WRITE (22)  -1, nx+1, 0, nz+1    ! total array size
     321                WRITE (22)  -nbgp, nx+nbgp, 0, nz+1    ! total array size
    322322                WRITE (22)   0, nx+1, 0, nz+1    ! output part
    323323             ENDIF
    … …  
    357357!--          Output for combine_plot_fields
    358358             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
    359                 WRITE (23)  -1, ny+1, 0, nz+1    ! total array size
     359                WRITE (23)  -nbgp, ny+nbgp, 0, nz+1    ! total array size
    360360                WRITE (23)   0, ny+1, 0, nz+1    ! output part
    361361             ENDIF
    … …  
    392392!--          Specifications for combine_plot_fields
    393393             IF ( .NOT. do3d_compress )  THEN
    394                 WRITE ( 30 )  -1,nx+1,-1,ny+1,0,nz_do3d
     394                WRITE ( 30 )  -nbgp,nx+nbgp,-nbgp,ny+nbgp, 0 ,nz_do3d
    395395                WRITE ( 30 )  0,nx+1,0,ny+1,0,nz_do3d
    396396             ENDIF
    … …  
    503503                openfile(33)%opened = .TRUE.
    504504                WRITE ( 33, 3300 )  TRIM( avs_coor_file ), &
    505                                     TRIM( avs_coor_file ), (nx+2)*4, &
    506                                     TRIM( avs_coor_file ), (nx+2)*4+(ny+2)*4
     505                                    TRIM( avs_coor_file ), (nx+2*nbgp)*4, &
     506                                    TRIM( avs_coor_file ), (nx+2*nbgp)*4+(ny+2*nbgp)*4
    507507           
    508508
    … …  
    548548!--       corresponding partial array of a PE only once at the top of the file
    549549          IF ( avs_output  .AND.  do3d_compress )  THEN
    550              WRITE ( 30 )  nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
     550             WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb, nz_do3d
    551551          ENDIF
    552552
    … …  
    929929#endif
    930930             ENDIF
    931 
     931             
    932932             CALL handle_netcdf_error( 'check_open', 26 )
    933933!
    … …  
    13251325#endif
    13261326             ENDIF
    1327 
     1327             
    13281328             CALL handle_netcdf_error( 'check_open', 43 ) 
    13291329

  • TabularUnified palm/trunk/SOURCE/check_parameters.f90

    r601 r667  
    44! Current revisions:
    55! -----------------
     6!
    67!
     8! Exchange of parameters between ocean and atmosphere via PE0
     9! Check for illegal combination of ws-scheme and timestep scheme.
     10! Check for topography and ws-scheme.
     11! Check for not cyclic boundary conditions in combination with ws-scheme and
     12! loop_optimization = 'vector'.
     13! Check for call_psolver_at_all_substeps and ws-scheme for momentum_advec.
     14!
     15! Different processor/grid topology in atmosphere and ocean is now allowed!
     16!
     17! Bugfixes in checking for conserve_volume_flow_mode
     18!
     19! Adapt error messages.
    720!
    821! Former revisions:
    … …  
    180193!
    181194!-- Check dt_coupling, restart_time, dt_restart, end_time, dx, dy, nx and ny
    182     IF ( coupling_mode /= 'uncoupled' )  THEN
     195    IF ( coupling_mode /= 'uncoupled')  THEN
    183196
    184197       IF ( dt_coupling == 9999999.9 )  THEN
    … …  
    189202
    190203#if defined( __parallel )
    191        CALL MPI_SEND( dt_coupling, 1, MPI_REAL, target_id, 11, comm_inter, &
    192                       ierr )
    193        CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 11, comm_inter, &
    194                       status, ierr )
     204       IF ( myid == 0 ) THEN
     205          CALL MPI_SEND( dt_coupling, 1, MPI_REAL, target_id, 11, comm_inter, &
     206                         ierr )
     207          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 11, comm_inter, &
     208                         status, ierr )
     209       ENDIF
     210       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     211       
    195212       IF ( dt_coupling /= remote )  THEN
    196213          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    … …  
    200217       ENDIF
    201218       IF ( dt_coupling <= 0.0 )  THEN
    202           CALL MPI_SEND( dt_max, 1, MPI_REAL, target_id, 19, comm_inter, ierr )
    203           CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 19, comm_inter, &
    204                          status, ierr )
     219          IF ( myid == 0  ) THEN
     220             CALL MPI_SEND( dt_max, 1, MPI_REAL, target_id, 19, comm_inter, ierr )
     221             CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 19, comm_inter, &
     222                            status, ierr )
     223          ENDIF   
     224          CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     225         
    205226          dt_coupling = MAX( dt_max, remote )
    206227          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    … …  
    209230          CALL message( 'check_parameters', 'PA0005', 0, 1, 0, 6, 0 )
    210231       ENDIF
    211 
    212        CALL MPI_SEND( restart_time, 1, MPI_REAL, target_id, 12, comm_inter, &
    213                       ierr )
    214        CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 12, comm_inter, &
    215                       status, ierr )
     232       IF ( myid == 0 ) THEN
     233          CALL MPI_SEND( restart_time, 1, MPI_REAL, target_id, 12, comm_inter, &
     234                         ierr )
     235          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 12, comm_inter, &
     236                         status, ierr )
     237       ENDIF
     238       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     239     
    216240       IF ( restart_time /= remote )  THEN
    217241          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    … …  
    220244          CALL message( 'check_parameters', 'PA0006', 1, 2, 0, 6, 0 )
    221245       ENDIF
    222 
    223        CALL MPI_SEND( dt_restart, 1, MPI_REAL, target_id, 13, comm_inter, &
    224                       ierr )
    225        CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 13, comm_inter, &
    226                       status, ierr )
     246       IF ( myid == 0 ) THEN
     247          CALL MPI_SEND( dt_restart, 1, MPI_REAL, target_id, 13, comm_inter, &
     248                         ierr )
     249          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 13, comm_inter, &
     250                         status, ierr )
     251       ENDIF   
     252       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     253     
    227254       IF ( dt_restart /= remote )  THEN
    228255          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    … …  
    233260
    234261       simulation_time_since_reference = end_time - coupling_start_time
    235        CALL MPI_SEND( simulation_time_since_reference, 1, MPI_REAL, target_id, &
    236                       14, comm_inter, ierr )
    237        CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 14, comm_inter, &
    238                       status, ierr )
     262       IF  ( myid == 0 ) THEN
     263          CALL MPI_SEND( simulation_time_since_reference, 1, MPI_REAL, target_id, &
     264                         14, comm_inter, ierr )
     265          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 14, comm_inter, &
     266                         status, ierr )   
     267       ENDIF
     268       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     269     
    239270       IF ( simulation_time_since_reference /= remote )  THEN
    240271          WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    … …  
    245276       ENDIF
    246277
    247        CALL MPI_SEND( dx, 1, MPI_REAL, target_id, 15, comm_inter, ierr )
    248        CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 15, comm_inter, &
    249                       status, ierr )
    250        IF ( dx /= remote )  THEN
    251           WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    252                  '":  dx = ', dx, '& is not equal to dx_remote = ', remote
    253           CALL message( 'check_parameters', 'PA0009', 1, 2, 0, 6, 0 )
    254        ENDIF
    255 
    256        CALL MPI_SEND( dy, 1, MPI_REAL, target_id, 16, comm_inter, ierr )
    257        CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 16, comm_inter, &
    258                       status, ierr )
    259        IF ( dy /= remote )  THEN
    260           WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    261                  '":  dy = ', dy, '& is not equal to dy_remote = ', remote
    262           CALL message( 'check_parameters', 'PA0010', 1, 2, 0, 6, 0 )
    263        ENDIF
    264 
    265        CALL MPI_SEND( nx, 1, MPI_INTEGER, target_id, 17, comm_inter, ierr )
    266        CALL MPI_RECV( iremote, 1, MPI_INTEGER, target_id, 17, comm_inter, &
    267                       status, ierr )
    268        IF ( nx /= iremote )  THEN
    269           WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    270                  '": nx = ', nx, '& is not equal to nx_remote = ', iremote
    271           CALL message( 'check_parameters', 'PA0011', 1, 2, 0, 6, 0 )
    272        ENDIF
    273 
    274        CALL MPI_SEND( ny, 1, MPI_INTEGER, target_id, 18, comm_inter, ierr )
    275        CALL MPI_RECV( iremote, 1, MPI_INTEGER, target_id, 18, comm_inter, &
    276                       status, ierr )
    277        IF ( ny /= iremote )  THEN
    278           WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), &
    279                  '": ny = ', ny, '& is not equal to ny_remote = ', iremote
    280           CALL message( 'check_parameters', 'PA0012', 1, 2, 0, 6, 0 )
     278 
     279       IF ( myid == 0 ) THEN
     280          CALL MPI_SEND( dx, 1, MPI_REAL, target_id, 15, comm_inter, ierr )
     281          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 15, comm_inter, &
     282                                                             status, ierr )
     283       ENDIF
     284       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     285
     286
     287       IF ( coupling_mode == 'atmosphere_to_ocean') THEN
     288
     289          IF ( dx < remote ) THEN
     290             WRITE( message_string, * ) 'coupling mode "', &
     291                   TRIM( coupling_mode ),                  &
     292           '": dx in Atmosphere is not equal to or not larger then dx in ocean'
     293             CALL message( 'check_parameters', 'PA0009', 1, 2, 0, 6, 0 )
     294          ENDIF
     295
     296          IF ( (nx_a+1)*dx /= (nx_o+1)*remote )  THEN
     297             WRITE( message_string, * ) 'coupling mode "', &
     298                    TRIM( coupling_mode ), &
     299             '": Domain size in x-direction is not equal in ocean and atmosphere'
     300             CALL message( 'check_parameters', 'PA0010', 1, 2, 0, 6, 0 )
     301          ENDIF
     302
     303       ENDIF
     304
     305       IF ( myid == 0) THEN
     306          CALL MPI_SEND( dy, 1, MPI_REAL, target_id, 16, comm_inter, ierr )
     307          CALL MPI_RECV( remote, 1, MPI_REAL, target_id, 16, comm_inter, &
     308                         status, ierr )
     309       ENDIF
     310       CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr)
     311
     312       IF ( coupling_mode == 'atmosphere_to_ocean') THEN
     313
     314          IF ( dy < remote )  THEN
     315             WRITE( message_string, * ) 'coupling mode "', &
     316                    TRIM( coupling_mode ), &
     317                 '": dy in Atmosphere is not equal to or not larger then dy in ocean'
     318             CALL message( 'check_parameters', 'PA0011', 1, 2, 0, 6, 0 )
     319          ENDIF
     320
     321          IF ( (ny_a+1)*dy /= (ny_o+1)*remote )  THEN
     322             WRITE( message_string, * ) 'coupling mode "', &
     323                   TRIM( coupling_mode ), &
     324             '": Domain size in y-direction is not equal in ocean and atmosphere'
     325             CALL message( 'check_parameters', 'PA0012', 1, 2, 0, 6, 0 )
     326          ENDIF
     327
     328          IF ( MOD(nx_o+1,nx_a+1) /= 0 )  THEN
     329             WRITE( message_string, * ) 'coupling mode "', &
     330                   TRIM( coupling_mode ), &
     331             '": nx+1 in ocean is not divisible without remainder with nx+1 in', &
     332             ' atmosphere'
     333             CALL message( 'check_parameters', 'PA0339', 1, 2, 0, 6, 0 )
     334          ENDIF
     335
     336          IF ( MOD(ny_o+1,ny_a+1) /= 0 )  THEN
     337             WRITE( message_string, * ) 'coupling mode "', &
     338                   TRIM( coupling_mode ), &
     339             '": ny+1 in ocean is not divisible without remainder with ny+1 in', &
     340             ' atmosphere'
     341             CALL message( 'check_parameters', 'PA0340', 1, 2, 0, 6, 0 )
     342          ENDIF
     343
    281344       ENDIF
    282345#else
    … …  
    290353!
    291354!-- Exchange via intercommunicator
    292     IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
     355    IF ( coupling_mode == 'atmosphere_to_ocean' .AND. myid == 0 )  THEN
    293356       CALL MPI_SEND( humidity, 1, MPI_LOGICAL, target_id, 19, comm_inter, &
    294357                      ierr )
    295     ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
     358    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' .AND. myid == 0)  THEN
    296359       CALL MPI_RECV( humidity_remote, 1, MPI_LOGICAL, target_id, 19, &
    297360                      comm_inter, status, ierr )
    298361    ENDIF
     362    CALL MPI_BCAST( humidity_remote, 1, MPI_LOGICAL, 0, comm2d, ierr)
     363   
    299364#endif
    300365
    … …  
    372437          CALL message( 'check_parameters', 'PA0014', 1, 2, 0, 6, 0 )
    373438       ENDIF
     439       IF ( momentum_advec == 'ws-scheme' .OR. scalar_advec == 'ws-scheme' ) &
     440       THEN
     441          message_string = 'topography is still not allowed with ' // &
     442                           'momentum_advec = "' // TRIM( momentum_advec ) //  &
     443                           '"or scalar_advec = "' // TRIM( scalar_advec ) //'"'
     444   ! message number still needs modification
     445           CALL message( 'check_parameters', 'PA0341', 1, 2, 0, 6, 0 )
     446       END IF
     447         
    374448!
    375449!--    In case of non-flat topography, check whether the convention how to
    … …  
    492566       CALL message( 'check_parameters', 'PA0021', 1, 2, 0, 6, 0 )
    493567    ENDIF
    494 
     568   
     569    IF( momentum_advec == 'ws-scheme' .AND. &
     570        call_psolver_at_all_substeps == .FALSE. ) THEN
     571        message_string = 'psolver must be called at each RK3 substep when "'//&
     572                      TRIM(momentum_advec) // ' "is used for momentum_advec'
     573        CALL message( 'check_parameters', 'PA0343', 1, 2, 0, 6, 0 )
     574    END IF
    495575!
    496576!-- Advection schemes:
    497     IF ( momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ups-scheme' ) &
    498     THEN
     577    IF ( momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ws-scheme' .AND. &
     578         momentum_advec /= 'ups-scheme' ) THEN
    499579       message_string = 'unknown advection scheme: momentum_advec = "' // &
    500580                        TRIM( momentum_advec ) // '"'
    501581       CALL message( 'check_parameters', 'PA0022', 1, 2, 0, 6, 0 )
    502582    ENDIF
    503     IF ( ( momentum_advec == 'ups-scheme'  .OR.  scalar_advec == 'ups-scheme' )&
    504                                       .AND.  timestep_scheme /= 'euler' )  THEN
    505        message_string = 'momentum_advec = "' // TRIM( momentum_advec ) // &
    506                         '" is not allowed with timestep_scheme = "' //    &
    507                         TRIM( timestep_scheme ) // '"'
     583    IF ((( momentum_advec == 'ups-scheme'  .OR.  scalar_advec == 'ups-scheme' )&
     584           .AND.  timestep_scheme /= 'euler' ) .OR. (( momentum_advec == 'ws-scheme'&
     585           .OR.  scalar_advec == 'ws-scheme') .AND. (timestep_scheme == 'euler' .OR. &
     586           timestep_scheme == 'leapfrog+euler' .OR. timestep_scheme == 'leapfrog'    &
     587           .OR. timestep_scheme == 'runge-kutta-2'))) THEN
     588       message_string = 'momentum_advec or scalar_advec = "' &
     589         // TRIM( momentum_advec ) // '" is not allowed with timestep_scheme = "' // &
     590         TRIM( timestep_scheme ) // '"'
    508591       CALL message( 'check_parameters', 'PA0023', 1, 2, 0, 6, 0 )
    509592    ENDIF
    510 
    511     IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'bc-scheme'  .AND.&
    512          scalar_advec /= 'ups-scheme' )  THEN
     593    IF ( scalar_advec /= 'pw-scheme'  .AND.  scalar_advec /= 'ws-scheme' .AND. &
     594        scalar_advec /= 'bc-scheme'  .AND.  scalar_advec /= 'ups-scheme' )  THEN
    513595       message_string = 'unknown advection scheme: scalar_advec = "' // &
    514596                        TRIM( scalar_advec ) // '"'
    … …  
    563645    ENDIF
    564646
    565     IF ( momentum_advec /= 'pw-scheme' .AND. timestep_scheme(1:5) == 'runge' ) &
    566     THEN
     647    IF ( (momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ws-scheme') &
     648         .AND. timestep_scheme(1:5) == 'runge' ) THEN
    567649       message_string = 'momentum advection scheme "' // &
    568650                        TRIM( momentum_advec ) // '" & does not work with ' // &
    … …  
    712794          ug_vertical_gradient_level_ind(1) = nzt+1
    713795          ug(nzt+1) = ug_surface
    714           DO  k = nzt, 0, -1
     796          DO  k = nzt, nzb, -1
    715797             IF ( i < 11 ) THEN
    716798                IF ( ug_vertical_gradient_level(i) > zu(k)  .AND. &
    … …  
    778860          vg_vertical_gradient_level_ind(1) = nzt+1
    779861          vg(nzt+1) = vg_surface
    780           DO  k = nzt, 0, -1
     862          DO  k = nzt, nzb, -1
    781863             IF ( i < 11 ) THEN
    782864                IF ( vg_vertical_gradient_level(i) > zu(k)  .AND. &
    … …  
    10201102 
    10211103             
     1104
    10221105!
    10231106!-- Compute Coriolis parameter
    … …  
    11591242!
    11601243!-- Non-cyclic lateral boundaries require the multigrid method and Piascek-
    1161 !-- Willimas advection scheme. Several schemes and tools do not work with
    1162 !-- non-cyclic boundary conditions.
     1244!-- Willimas or Wicker - Skamarock advection scheme. Several schemes
     1245!-- and tools do not work with non-cyclic boundary conditions.
    11631246    IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
    11641247       IF ( psolver /= 'multigrid' )  THEN
    … …  
    11671250          CALL message( 'check_parameters', 'PA0051', 1, 2, 0, 6, 0 )
    11681251       ENDIF
    1169        IF ( momentum_advec /= 'pw-scheme' )  THEN
     1252       IF ( momentum_advec /= 'pw-scheme' .AND. &
     1253            momentum_advec /= 'ws-scheme')  THEN
    11701254          message_string = 'non-cyclic lateral boundaries do not allow ' // &
    11711255                           'momentum_advec = "' // TRIM( momentum_advec ) // '"'
    11721256          CALL message( 'check_parameters', 'PA0052', 1, 2, 0, 6, 0 )
    11731257       ENDIF
    1174        IF ( scalar_advec /= 'pw-scheme' )  THEN
     1258       IF ( scalar_advec /= 'pw-scheme' .AND. &
     1259            scalar_advec /= 'ws-scheme' )  THEN
    11751260          message_string = 'non-cyclic lateral boundaries do not allow ' // &
    11761261                           'scalar_advec = "' // TRIM( scalar_advec ) // '"'
    11771262          CALL message( 'check_parameters', 'PA0053', 1, 2, 0, 6, 0 )
    11781263       ENDIF
     1264       IF ( (scalar_advec == 'ws-scheme' .OR. momentum_advec == 'ws-scheme' ) &
     1265          .AND. loop_optimization == 'vector' ) THEN
     1266          message_string = 'non-cyclic lateral boundaries do not allow ' // &
     1267                           'loop_optimization = vector and ' //  &
     1268                           'scalar_advec = "' // TRIM( scalar_advec ) // '"'
     1269  ! The error message number still needs modification.
     1270          CALL message( 'check_parameters', 'PA0342', 1, 2, 0, 6, 0 )
     1271       END IF
    11791272       IF ( galilei_transformation )  THEN
    11801273          message_string = 'non-cyclic lateral boundaries do not allow ' // &
    … …  
    14071500                        TRIM( bc_uv_b ) // '"'
    14081501       CALL message( 'check_parameters', 'PA0076', 1, 2, 0, 6, 0 )
     1502    ENDIF
     1503!
     1504!-- In case of coupled simulations u and v at the ground in atmosphere will be
     1505!-- assigned with the u and v values of the ocean surface
     1506    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
     1507       ibc_uv_b = 2
    14091508    ENDIF
    14101509
    … …  
    21092208             hom(:,2,57,:) = SPREAD( zu, 2, statistic_regions+1 )
    21102209
     2210
    21112211          CASE ( 'u"pt"' )
    21122212             dopr_index(i) = 58
    … …  
    22442344
    22452345       END SELECT
     2346
    22462347!
    22472348!--    Check to which of the predefined coordinate systems the profile belongs
    … …  
    25842685!-- Upper plot limit (grid point value) for 1D profiles
    25852686    IF ( z_max_do1d == -1.0 )  THEN
     2687
    25862688       nz_do1d = nzt+1
     2689
    25872690    ELSE
    25882691       DO  k = nzb+1, nzt+1
    … …  
    27372840
    27382841!
     2842
    27392843!-- Check netcdf precison
    27402844    ldum = .FALSE.
    … …  
    30703174    IF ( conserve_volume_flow )  THEN
    30713175       IF ( TRIM( conserve_volume_flow_mode ) == 'default' )  THEN
    3072           IF ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' )  THEN
    3073              conserve_volume_flow_mode = 'inflow_profile'
    3074           ELSE
    3075              conserve_volume_flow_mode = 'initial_profiles'
    3076           ENDIF
     3176
     3177          conserve_volume_flow_mode = 'initial_profiles'
     3178
    30773179       ELSEIF ( TRIM( conserve_volume_flow_mode ) /= 'initial_profiles' .AND.  &
    30783180            TRIM( conserve_volume_flow_mode ) /= 'inflow_profile' .AND.  &
    … …  
    30823184          CALL message( 'check_parameters', 'PA0154', 1, 2, 0, 6, 0 )
    30833185       ENDIF
    3084        IF ( ( bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic' ) .AND. &
    3085             TRIM( conserve_volume_flow_mode ) /= 'inflow_profile' )  THEN
    3086           WRITE( message_string, * )  'noncyclic boundary conditions ', &
    3087                'require & conserve_volume_flow_mode = ''inflow_profile'''
     3186       IF ( (bc_lr /= 'cyclic'  .OR.  bc_ns /= 'cyclic') .AND. &
     3187          TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
     3188          WRITE( message_string, * )  'non-cyclic boundary conditions ', &
     3189               'require  conserve_volume_flow_mode = ''initial_profiles'''
    30883190          CALL message( 'check_parameters', 'PA0155', 1, 2, 0, 6, 0 )
    30893191       ENDIF
    … …  
    30913193            TRIM( conserve_volume_flow_mode ) == 'inflow_profile' )  THEN
    30923194          WRITE( message_string, * )  'cyclic boundary conditions ', &
    3093                'require & conserve_volume_flow_mode = ''initial_profiles''', &
     3195               'require conserve_volume_flow_mode = ''initial_profiles''', &
    30943196               ' or ''bulk_velocity'''
    30953197          CALL message( 'check_parameters', 'PA0156', 1, 2, 0, 6, 0 )
    … …  
    31003202         TRIM( conserve_volume_flow_mode ) /= 'bulk_velocity' ) )  THEN
    31013203       WRITE( message_string, * )  'nonzero bulk velocity requires ', &
    3102             'conserve_volume_flow = .T. and & ', &
     3204            'conserve_volume_flow = .T. and ', &
    31033205            'conserve_volume_flow_mode = ''bulk_velocity'''
    31043206       CALL message( 'check_parameters', 'PA0157', 1, 2, 0, 6, 0 )
    … …  
    31393241
    31403242
     3243
    31413244 END SUBROUTINE check_parameters

  • TabularUnified palm/trunk/SOURCE/data_output_2d.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
     7! allocation of arrays local_2d and total_2d.
     8! Calls of exchange_horiz are modiefied.
    79!
    810! Former revisions:
    … …  
    112114
    113115       CASE ( 'xy' )
    114 
    115116          s = 1
    116           ALLOCATE( level_z(0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
     117          ALLOCATE( level_z(nzb:nzt+1), local_2d(nxlg:nxrg,nysg:nyng) )
    117118
    118119!
    … …  
    130131                IF ( iso2d_output )  CALL check_open( 21 )
    131132#if defined( __parallel )
    132                 ALLOCATE( total_2d(-1:nx+1,-1:ny+1) )
     133                ALLOCATE( total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp) )
    133134#endif
    134135             ENDIF
    … …  
    136137
    137138       CASE ( 'xz' )
    138 
    139139          s = 2
    140           ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
     140          ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) )
    141141
    142142!
    … …  
    154154                IF ( iso2d_output )  CALL check_open( 22 )
    155155#if defined( __parallel )
    156                 ALLOCATE( total_2d(-1:nx+1,nzb:nzt+1) )
     156                ALLOCATE( total_2d(-nbgp:nx+nbgp,nzb:nzt+1) )
    157157#endif
    158158             ENDIF
    … …  
    162162
    163163          s = 3
    164           ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
     164          ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) )
    165165
    166166!
    … …  
    178178                IF ( iso2d_output )  CALL check_open( 23 )
    179179#if defined( __parallel )
    180                 ALLOCATE( total_2d(-1:ny+1,nzb:nzt+1) )
     180                ALLOCATE( total_2d(-nbgp:ny+nbgp,nzb:nzt+1) )
    181181#endif
    182182             ENDIF
    … …  
    192192!
    193193!-- Allocate a temporary array for resorting (kji -> ijk).
    194     ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) )
     194    ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) )
    195195
    196196!
    … …  
    219219             CASE ( 'lwp*_xy' )        ! 2d-array
    220220                IF ( av == 0 )  THEN
    221                    DO  i = nxl-1, nxr+1
    222                       DO  j = nys-1, nyn+1
     221                   DO  i = nxlg, nxrg
     222                      DO  j = nysg, nyng
    223223                         local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
    224224                                                    dzw(1:nzt+1) )
    … …  
    226226                   ENDDO
    227227                ELSE
    228                    DO  i = nxl-1, nxr+1
    229                       DO  j = nys-1, nyn+1
     228                   DO  i = nxlg, nxrg
     229                      DO  j = nysg, nyng
    230230                         local_pf(i,j,nzb+1) = lwp_av(j,i)
    231231                      ENDDO
    … …  
    248248                   IF ( simulated_time >= particle_advection_start )  THEN
    249249                      tend = prt_count
    250                       CALL exchange_horiz( tend )
     250                      CALL exchange_horiz( tend, nbgp )
    251251                   ELSE
    252252                      tend = 0.0
    253253                   ENDIF
    254                    DO  i = nxl-1, nxr+1
    255                       DO  j = nys-1, nyn+1
     254                   DO  i = nxlg, nxrg
     255                      DO  j = nysg, nyng
    256256                         DO  k = nzb, nzt+1
    257257                            local_pf(i,j,k) = tend(k,j,i)
    … …  
    261261                   resorted = .TRUE.
    262262                ELSE
    263                    CALL exchange_horiz( pc_av )
     263                   CALL exchange_horiz( pc_av, nbgp )
    264264                   to_be_resorted => pc_av
    265265                ENDIF
    … …  
    287287                         ENDDO
    288288                      ENDDO
    289                       CALL exchange_horiz( tend )
     289                      CALL exchange_horiz( tend, nbgp )
    290290                   ELSE
    291291                      tend = 0.0
    292                    ENDIF
    293                    DO  i = nxl-1, nxr+1
    294                       DO  j = nys-1, nyn+1
     292                   END IF
     293                   DO  i = nxlg, nxrg
     294                      DO  j = nysg, nyng
    295295                         DO  k = nzb, nzt+1
    296296                            local_pf(i,j,k) = tend(k,j,i)
    … …  
    300300                   resorted = .TRUE.
    301301                ELSE
    302                    CALL exchange_horiz( pr_av )
     302                   CALL exchange_horiz( pr_av, nbgp )
    303303                   to_be_resorted => pr_av
    304304                ENDIF
    … …  
    306306             CASE ( 'pra*_xy' )        ! 2d-array / integral quantity => no av
    307307                CALL exchange_horiz_2d( precipitation_amount )
    308                 DO  i = nxl-1, nxr+1
    309                    DO  j = nys-1, nyn+1
     308                   DO  i = nxlg, nxrg
     309                      DO  j = nysg, nyng
    310310                      local_pf(i,j,nzb+1) =  precipitation_amount(j,i)
    311311                   ENDDO
    … …  
    319319                IF ( av == 0 )  THEN
    320320                   CALL exchange_horiz_2d( precipitation_rate )
    321                    DO  i = nxl-1, nxr+1
    322                       DO  j = nys-1, nyn+1
     321                   DO  i = nxlg, nxrg
     322                      DO  j = nysg, nyng
    323323                         local_pf(i,j,nzb+1) =  precipitation_rate(j,i)
    324324                      ENDDO
    … …  
    326326                ELSE
    327327                   CALL exchange_horiz_2d( precipitation_rate_av )
    328                    DO  i = nxl-1, nxr+1
    329                       DO  j = nys-1, nyn+1
     328                   DO  i = nxlg, nxrg
     329                      DO  j = nysg, nyng
    330330                         local_pf(i,j,nzb+1) =  precipitation_rate_av(j,i)
    331331                      ENDDO
    … …  
    341341                      to_be_resorted => pt
    342342                   ELSE
    343                       DO  i = nxl-1, nxr+1
    344                          DO  j = nys-1, nyn+1
     343                   DO  i = nxlg, nxrg
     344                      DO  j = nysg, nyng
    345345                            DO  k = nzb, nzt+1
    346346                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
    … …  
    399399             CASE ( 'qsws*_xy' )        ! 2d-array
    400400                IF ( av == 0 ) THEN
    401                    DO  i = nxl-1, nxr+1
    402                       DO  j = nys-1, nyn+1
     401                   DO  i = nxlg, nxrg
     402                      DO  j = nysg, nyng
    403403                         local_pf(i,j,nzb+1) =  qsws(j,i)
    404404                      ENDDO
    405405                   ENDDO
    406406                ELSE
    407                    DO  i = nxl-1, nxr+1
    408                       DO  j = nys-1, nyn+1
     407                   DO  i = nxlg, nxrg
     408                      DO  j = nysg, nyng
    409409                         local_pf(i,j,nzb+1) =  qsws_av(j,i)
    410410                      ENDDO
    … …  
    417417             CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
    418418                IF ( av == 0 )  THEN
    419                    DO  i = nxl-1, nxr+1
    420                       DO  j = nys-1, nyn+1
     419                   DO  i = nxlg, nxrg
     420                      DO  j = nysg, nyng
    421421                         DO  k = nzb, nzt+1
    422422                            local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
    … …  
    453453             CASE ( 'shf*_xy' )        ! 2d-array
    454454                IF ( av == 0 ) THEN
    455                    DO  i = nxl-1, nxr+1
    456                       DO  j = nys-1, nyn+1
     455                   DO  i = nxlg, nxrg
     456                      DO  j = nysg, nyng
    457457                         local_pf(i,j,nzb+1) =  shf(j,i)
    458458                      ENDDO
    459459                   ENDDO
    460460                ELSE
    461                    DO  i = nxl-1, nxr+1
    462                       DO  j = nys-1, nyn+1
     461                   DO  i = nxlg, nxrg
     462                      DO  j = nysg, nyng
    463463                         local_pf(i,j,nzb+1) =  shf_av(j,i)
    464464                      ENDDO
    … …  
    471471             CASE ( 't*_xy' )        ! 2d-array
    472472                IF ( av == 0 )  THEN
    473                    DO  i = nxl-1, nxr+1
    474                       DO  j = nys-1, nyn+1
     473                   DO  i = nxlg, nxrg
     474                      DO  j = nysg, nyng
    475475                         local_pf(i,j,nzb+1) = ts(j,i)
    476476                      ENDDO
    477477                   ENDDO
    478478                ELSE
    479                    DO  i = nxl-1, nxr+1
    480                       DO  j = nys-1, nyn+1
     479                   DO  i = nxlg, nxrg
     480                      DO  j = nysg, nyng
    481481                         local_pf(i,j,nzb+1) = ts_av(j,i)
    482482                      ENDDO
    … …  
    503503             CASE ( 'u*_xy' )        ! 2d-array
    504504                IF ( av == 0 )  THEN
    505                    DO  i = nxl-1, nxr+1
    506                       DO  j = nys-1, nyn+1
     505                   DO  i = nxlg, nxrg
     506                      DO  j = nysg, nyng
    507507                         local_pf(i,j,nzb+1) = us(j,i)
    508508                      ENDDO
    509509                   ENDDO
    510510                ELSE
    511                    DO  i = nxl-1, nxr+1
    512                       DO  j = nys-1, nyn+1
     511                   DO  i = nxlg, nxrg
     512                      DO  j = nysg, nyng
    513513                         local_pf(i,j,nzb+1) = us_av(j,i)
    514514                      ENDDO
    … …  
    551551             CASE ( 'z0*_xy' )        ! 2d-array
    552552                IF ( av == 0 ) THEN
    553                    DO  i = nxl-1, nxr+1
    554                       DO  j = nys-1, nyn+1
     553                   DO  i = nxlg, nxrg
     554                      DO  j = nysg, nyng
    555555                         local_pf(i,j,nzb+1) =  z0(j,i)
    556556                      ENDDO
    557557                   ENDDO
    558558                ELSE
    559                    DO  i = nxl-1, nxr+1
    560                       DO  j = nys-1, nyn+1
     559                   DO  i = nxlg, nxrg
     560                      DO  j = nysg, nyng
    561561                         local_pf(i,j,nzb+1) =  z0_av(j,i)
    562562                      ENDDO
    … …  
    593593!--       Resort the array to be output, if not done above
    594594          IF ( .NOT. resorted )  THEN
    595              DO  i = nxl-1, nxr+1
    596                 DO  j = nys-1, nyn+1
     595             DO  i = nxlg, nxrg
     596                DO  j = nysg, nyng
    597597                   DO  k = nzb, nzt+1
    598598                      local_pf(i,j,k) = to_be_resorted(k,j,i)
    … …  
    647647!--                   Carry out the averaging (all data are on the PE)
    648648                      DO  k = nzb, nzt+1
    649                          DO  j = nys-1, nyn+1
    650                             DO  i = nxl-1, nxr+1
     649                         DO  j = nysg, nyng
     650                            DO  i = nxlg, nxrg
    651651                               local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
    652652                            ENDDO
    … …  
    654654                      ENDDO
    655655
    656                       local_2d = local_2d / ( nzt -nzb + 2.0 )
     656                      local_2d = local_2d / ( nzt -nzb + 2.0)
    657657
    658658                   ELSE
    … …  
    723723                         ENDIF
    724724#endif
    725                          WRITE ( 21 )  nxl-1, nxr+1, nys-1, nyn+1
     725                         WRITE ( 21 )  nxlg, nxrg, nysg, nyng
    726726                         WRITE ( 21 )  local_2d
    727727
    … …  
    734734                         CALL MPI_BARRIER( comm2d, ierr )
    735735
    736                          ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 )
     736                         ngp = ( nxrg-nxlg+1 ) * ( nyng-nysg+1 )
    737737                         IF ( myid == 0 )  THEN
    738738!
    739739!--                         Local array can be relocated directly.
    740                             total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d
     740                            total_2d(nxlg:nxrg,nysg:nyng) = local_2d
    741741!
    742742!--                         Receive data from all other PEs.
    … …  
    760760!--                         Output of the total cross-section.
    761761                            IF ( iso2d_output )  THEN
    762                                WRITE (21)  total_2d(0:nx+1,0:ny+1)
     762                               WRITE (21)  total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp)
    763763                            ENDIF
    764764!
    765765!--                         Relocate the local array for the next loop increment
    766766                            DEALLOCATE( local_2d )
    767                             ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
     767                            ALLOCATE( local_2d(nxlg:nxrg,nysg:nyng) )
    768768
    769769#if defined( __netcdf )
    … …  
    789789!
    790790!--                         First send the local index limits to PE0
    791                             ind(1) = nxl-1; ind(2) = nxr+1
    792                             ind(3) = nys-1; ind(4) = nyn+1
     791                            ind(1) = nxlg; ind(2) = nxrg
     792                            ind(3) = nysg; ind(4) = nyng
    793793                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
    794794                                           comm2d, ierr )
    795795!
    796796!--                         Send data to PE0
    797                             CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, &
     797                            CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &
    798798                                           MPI_REAL, 0, 1, comm2d, ierr )
    799799                         ENDIF
    … …  
    882882
    883883                   ENDIF
     884
    884885!
    885886!--                If required, carry out averaging along y
    886887                   IF ( section(is,s) == -1 )  THEN
    887888
    888                       ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) )
     889                      ALLOCATE( local_2d_l(nxlg:nxrg,nzb:nzt+1) )
    889890                      local_2d_l = 0.0
    890                       ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
     891                      ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 )
    891892!
    892893!--                   First local averaging on the PE
    893894                      DO  k = nzb, nzt+1
    894895                         DO  j = nys, nyn
    895                             DO  i = nxl-1, nxr+1
     896                            DO  i = nxlg, nxrg
    896897                               local_2d_l(i,k) = local_2d_l(i,k) + &
    897898                                                 local_pf(i,j,k)
    … …  
    903904!--                   Now do the averaging over all PEs along y
    904905                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    905                       CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb),              &
    906                                           local_2d(nxl-1,nzb), ngp, MPI_REAL, &
     906                      CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb),              &
     907                                          local_2d(nxlg,nzb), ngp, MPI_REAL, &
    907908                                          MPI_SUM, comm1dy, ierr )
    908909#else
    … …  
    936937!--                   BEGIN WORKAROUND---------------------------------------
    937938                      IF ( npey /= 1  .AND.  section(is,s) /= -1)  THEN
    938                          ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) )
     939                         ALLOCATE( local_2d_l(nxlg:nxrg,nzb:nzt+1) )
    939940                         local_2d_l = 0.0
    940941                         IF ( section(is,s) >= nys .AND. section(is,s) <= nyn )&
    … …  
    945946!
    946947!--                      Distribute data over all PEs along y
    947                          ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
     948                         ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 )
    948949                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
    949                          CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb),            &
    950                                              local_2d(nxl-1,nzb), ngp,         &
     950                         CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb),            &
     951                                             local_2d(nxlg,nzb), ngp,         &
    951952                                             MPI_REAL, MPI_SUM, comm1dy, ierr )
    952953#else
    … …  
    10221023                              ( section(is,s) == -1  .AND.  nys-1 == -1 ) )  &
    10231024                         THEN
    1024                             WRITE (22)  nxl-1, nxr+1, nzb, nzt+1
     1025                            WRITE (22)  nxlg, nxrg, nzb, nzt+1
    10251026                            WRITE (22)  local_2d
    10261027                         ELSE
    … …  
    10361037                         CALL MPI_BARRIER( comm2d, ierr )
    10371038
    1038                          ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
     1039                         ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 )
    10391040                         IF ( myid == 0 )  THEN
    10401041!
    … …  
    10441045                                 ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
    10451046                            THEN
    1046                                total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d
     1047                               total_2d(nxlg:nxrg,nzb:nzt+1) = local_2d
    10471048                            ENDIF
    10481049!
    … …  
    10731074!--                         Output of the total cross-section.
    10741075                            IF ( iso2d_output )  THEN
    1075                                WRITE (22)  total_2d(0:nx+1,nzb:nzt+1)
     1076                               WRITE (22)  total_2d(-nbgp:nx+nbgp,nzb:nzt+1)
    10761077                            ENDIF
    10771078!
    10781079!--                         Relocate the local array for the next loop increment
    10791080                            DEALLOCATE( local_2d )
    1080                             ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
     1081                            ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) )
    10811082
    10821083#if defined( __netcdf )
    … …  
    10991100                                 ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
    11001101                            THEN
    1101                                ind(1) = nxl-1; ind(2) = nxr+1
     1102                               ind(1) = nxlg; ind(2) = nxrg
    11021103                               ind(3) = nzb;   ind(4) = nzt+1
    11031104                            ELSE
    … …  
    11101111!--                         If applicable, send data to PE0.
    11111112                            IF ( ind(1) /= -9999 )  THEN
    1112                                CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, &
     1113                               CALL MPI_SEND( local_2d(nxlg,nzb), ngp, &
    11131114                                              MPI_REAL, 0, 1, comm2d, ierr )
    11141115                            ENDIF
    … …  
    11871188                   IF ( section(is,s) == -1 )  THEN
    11881189
    1189                       ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) )
     1190                      ALLOCATE( local_2d_l(nysg:nyng,nzb:nzt+1) )
    11901191                      local_2d_l = 0.0
    1191                       ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
     1192                      ngp = ( nyng-nysg+1 ) * ( nzt-nzb+2 )
    11921193!
    11931194!--                   First local averaging on the PE
    11941195                      DO  k = nzb, nzt+1
    1195                          DO  j = nys-1, nyn+1
     1196                         DO  j = nysg, nyng
    11961197                            DO  i = nxl, nxr
    11971198                               local_2d_l(j,k) = local_2d_l(j,k) + &
    … …  
    12041205!--                   Now do the averaging over all PEs along x
    12051206                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    1206                       CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb),              &
    1207                                           local_2d(nys-1,nzb), ngp, MPI_REAL, &
     1207                      CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb),              &
     1208                                          local_2d(nysg,nzb), ngp, MPI_REAL, &
    12081209                                          MPI_SUM, comm1dx, ierr )
    12091210#else
    … …  
    12371238!--                   BEGIN WORKAROUND---------------------------------------
    12381239                      IF ( npex /= 1  .AND.  section(is,s) /= -1)  THEN
    1239                          ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) )
     1240                         ALLOCATE( local_2d_l(nysg:nyng,nzb:nzt+1) )
    12401241                         local_2d_l = 0.0
    12411242                         IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr )&
    … …  
    12461247!
    12471248!--                      Distribute data over all PEs along x
    1248                          ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
     1249                         ngp = ( nyng-nysg+1 ) * ( nzt-nzb + 2 )
    12491250                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
    1250                          CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb),            &
    1251                                              local_2d(nys-1,nzb), ngp,         &
     1251                         CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb),            &
     1252                                             local_2d(nysg,nzb), ngp,         &
    12521253                                             MPI_REAL, MPI_SUM, comm1dx, ierr )
    12531254#else
    … …  
    13231324                              ( section(is,s) == -1  .AND.  nxl-1 == -1 ) )  &
    13241325                         THEN
    1325                             WRITE (23)  nys-1, nyn+1, nzb, nzt+1
     1326                            WRITE (23)  nysg, nyng, nzb, nzt+1
    13261327                            WRITE (23)  local_2d
    13271328                         ELSE
    … …  
    13371338                         CALL MPI_BARRIER( comm2d, ierr )
    13381339
    1339                          ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
     1340                         ngp = ( nyng-nysg+1 ) * ( nzt-nzb+2 )
    13401341                         IF ( myid == 0 )  THEN
    13411342!
    … …  
    13451346                                 ( section(is,s) == -1  .AND.  nxl-1 == -1 ) ) &
    13461347                            THEN
    1347                                total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d
     1348                               total_2d(nysg:nyng,nzb:nzt+1) = local_2d
    13481349                            ENDIF
    13491350!
    … …  
    13791380!--                         Relocate the local array for the next loop increment
    13801381                            DEALLOCATE( local_2d )
    1381                             ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
     1382                            ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) )
    13821383
    13831384#if defined( __netcdf )
    … …  
    14001401                                 ( section(is,s) == -1  .AND.  nxl-1 == -1 ) ) &
    14011402                            THEN
    1402                                ind(1) = nys-1; ind(2) = nyn+1
     1403                               ind(1) = nysg; ind(2) = nyng
    14031404                               ind(3) = nzb;   ind(4) = nzt+1
    14041405                            ELSE
    … …  
    14111412!--                         If applicable, send data to PE0.
    14121413                            IF ( ind(1) /= -9999 )  THEN
    1413                                CALL MPI_SEND( local_2d(nys-1,nzb), ngp, &
     1414                               CALL MPI_SEND( local_2d(nysg,nzb), ngp, &
    14141415                                              MPI_REAL, 0, 1, comm2d, ierr )
    14151416                            ENDIF

  • TabularUnified palm/trunk/SOURCE/data_output_3d.f90

    r647 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
     7! allocation of arrays.  Calls of exchange_horiz are modified.
     8! Skip-value skip_do_avs changed to a dynamic adaption of ghost points.
    79!
    810! Former revisions:
    … …  
    102104!
    103105!-- Allocate a temporary array with the desired output dimensions.
    104     ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do3d) )
     106    ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nz_do3d) )
    105107
    106108!
    … …  
    157159             IF ( av == 0 )  THEN
    158160                tend = prt_count
    159                 CALL exchange_horiz( tend )
    160                 DO  i = nxl-1, nxr+1
    161                    DO  j = nys-1, nyn+1
     161                CALL exchange_horiz( tend, nbgp )
     162                DO  i = nxlg, nxrg
     163                   DO  j = nysg, nyng
    162164                      DO  k = nzb, nz_do3d
    163165                         local_pf(i,j,k) = tend(k,j,i)
    … …  
    167169                resorted = .TRUE.
    168170             ELSE
    169                 CALL exchange_horiz( pc_av )
     171                CALL exchange_horiz( pc_av, nbgp )
    170172                to_be_resorted => pc_av
    171173             ENDIF
    … …  
    192194                   ENDDO
    193195                ENDDO
    194                 CALL exchange_horiz( tend )
    195                 DO  i = nxl-1, nxr+1
    196                    DO  j = nys-1, nyn+1
     196                CALL exchange_horiz( tend, nbgp )
     197                DO  i = nxlg, nxrg
     198                   DO  j = nysg, nyng
    197199                      DO  k = nzb, nzt+1
    198200                         local_pf(i,j,k) = tend(k,j,i)
    … …  
    202204                resorted = .TRUE.
    203205             ELSE
    204                 CALL exchange_horiz( pr_av )
     206                CALL exchange_horiz( pr_av, nbgp )
    205207                to_be_resorted => pr_av
    206208             ENDIF
    … …  
    211213                   to_be_resorted => pt
    212214                ELSE
    213                    DO  i = nxl-1, nxr+1
    214                       DO  j = nys-1, nyn+1
     215                   DO  i = nxlg, nxrg
     216                      DO  j = nysg, nyng
    215217                         DO  k = nzb, nz_do3d
    216218                            local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
    … …  
    263265          CASE ( 'qv' )
    264266             IF ( av == 0 )  THEN
    265                 DO  i = nxl-1, nxr+1
    266                    DO  j = nys-1, nyn+1
     267                DO  i = nxlg, nxrg
     268                   DO  j = nysg, nyng
    267269                      DO  k = nzb, nz_do3d
    268270                         local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
    … …  
    342344!--    Resort the array to be output, if not done above
    343345       IF ( .NOT. resorted )  THEN
    344           DO  i = nxl-1, nxr+1
    345              DO  j = nys-1, nyn+1
     346          DO  i = nxlg, nxrg
     347             DO  j = nysg, nyng
    346348                DO  k = nzb, nz_do3d
    347349                   local_pf(i,j,k) = to_be_resorted(k,j,i)
    … …  
    376378!--       Determine the Skip-value for the next array. Record end and start
    377379!--       require 4 byte each.
    378           skip_do_avs = skip_do_avs + ( ((nx+2)*(ny+2)*(nz_do3d+1)) * 4 + 8 )
     380          skip_do_avs = skip_do_avs + ( ((nx+2*nbgp)*(ny+2*nbgp)*(nz_do3d+1)) * 4 + 8 )
    379381       ENDIF
    380382
    … …  
    386388!--       of compressed data.
    387389          CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
    388                                  nzb, nz_do3d, prec )
     390                                 nzb, nz_do3d, prec, nbgp )
    389391       ELSE
    390392!
    … …  
    400402                   WRITE ( 30 )  simulated_time, do3d_time_count(av), av
    401403                ENDIF
    402                 WRITE ( 30 )  nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
     404                WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb, nz_do3d
    403405                WRITE ( 30 )  local_pf
    404406
    … …  
    411413                IF ( nxr == nx  .AND.  nyn /= ny )  THEN
    412414                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    413                                   local_pf(nxl:nxr+1,nys:nyn,nzb:nz_do3d),    &
     415                                  local_pf(nxl:nxrg,nys:nyn,nzb:nz_do3d),    &
    414416                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
    415                       count = (/ nxr-nxl+2, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
     417                      count = (/ nxr-nxl+1+nbgp, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
    416418                ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
    417419                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    418                                   local_pf(nxl:nxr,nys:nyn+1,nzb:nz_do3d),    &
     420                                  local_pf(nxl:nxr,nys:nyng,nzb:nz_do3d),    &
    419421                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
    420                       count = (/ nxr-nxl+1, nyn-nys+2, nz_do3d-nzb+1, 1 /) )
     422                      count = (/ nxr-nxl+1, nyn-nys+1+nbgp, nz_do3d-nzb+1, 1 /) )
    421423                ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
    422424                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    423                                   local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d),  &
     425                                  local_pf(nxl:nxrg,nys:nyng,nzb:nz_do3d),  &
    424426                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
    425                       count = (/ nxr-nxl+2, nyn-nys+2, nz_do3d-nzb+1, 1 /) )
     427                      count = (/ nxr-nxl+1+nbgp, nyn-nys+1+nbgp, nz_do3d-nzb+1, 1 /) )
    426428                ELSE
    427429                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &

  • TabularUnified palm/trunk/SOURCE/data_output_mask.f90

    r565 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Calls of exchange_horiz are modified.
    77!
    88! Former revisions:
    … …  
    123123             IF ( av == 0 )  THEN
    124124                tend = prt_count
    125                 CALL exchange_horiz( tend )
     125                CALL exchange_horiz( tend, nbgp )
    126126                DO  i = 1, mask_size_l(mid,1)
    127127                   DO  j = 1, mask_size_l(mid,2)
    … …  
    134134                resorted = .TRUE.
    135135             ELSE
    136                 CALL exchange_horiz( pc_av )
     136                CALL exchange_horiz( pc_av, nbgp )
    137137                to_be_resorted => pc_av
    138138             ENDIF
    … …  
    159159                   ENDDO
    160160                ENDDO
    161                 CALL exchange_horiz( tend )
     161                CALL exchange_horiz( tend, nbgp )
    162162                DO  i = 1, mask_size_l(mid,1)
    163163                   DO  j = 1, mask_size_l(mid,2)
    … …  
    170170                resorted = .TRUE.
    171171             ELSE
    172                 CALL exchange_horiz( pr_av )
     172                CALL exchange_horiz( pr_av, nbgp )
    173173                to_be_resorted => pr_av
    174174             ENDIF
    … …  
    439439
    440440       if = if + 1
     441
    441442    ENDDO
    442443

  • TabularUnified palm/trunk/SOURCE/diffusion_e.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    6868       REAL            ::  dvar_dz, l_stable, phi_m, var_reference
    6969       REAL            ::  ddzu(1:nzt+1), dd2zu(1:nzt), ddzw(1:nzt+1), &
    70                            l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1)
    71        REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: diss, tend
     70                           l_grid(1:nzt), zu(nzb:nzt+1), zw(nzb:nzt+1)
     71       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: diss, tend
    7272       REAL, DIMENSION(:,:), POINTER   ::  rif
    7373       REAL, DIMENSION(:,:,:), POINTER ::  e, km, var
    … …  
    289289       REAL            ::  dvar_dz, l_stable, phi_m, var_reference
    290290       REAL            ::  ddzu(1:nzt+1), dd2zu(1:nzt), ddzw(1:nzt+1), &
    291                            l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1)
    292        REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: diss, tend
     291                           l_grid(1:nzt), zu(nzb:nzt+1), zw(nzb:nzt+1)
     292       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: diss, tend
    293293       REAL, DIMENSION(:,:), POINTER   ::  rif
    294294       REAL, DIMENSION(:,:,:), POINTER ::  e, km, var

  • TabularUnified palm/trunk/SOURCE/diffusion_s.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    6464       REAL    ::  vertical_gridspace
    6565       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1)
    66        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     66       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    6767       REAL    ::  wall_s_flux(0:4)
    6868       REAL, DIMENSION(:,:),   POINTER ::  s_flux_b, s_flux_t
    … …  
    176176       REAL    ::  vertical_gridspace
    177177       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1)
    178        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     178       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    179179       REAL    ::  wall_s_flux(0:4)
    180180       REAL, DIMENSION(:,:),   POINTER ::  s_flux_b, s_flux_t

  • TabularUnified palm/trunk/SOURCE/diffusion_u.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    7272       INTEGER ::  i, j, k
    7373       REAL    ::  kmym_x, kmym_y, kmyp_x, kmyp_y, kmzm, kmzp
    74        REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_y(nys-1:nyn+1)
    75        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     74       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_y(nysg:nyng)
     75       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    7676       REAL, DIMENSION(:,:),   POINTER ::  usws, uswst
    7777       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
    … …  
    177177                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k) &
    178178                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx     &
    179                       &            )                                         &
     179                      &            )                                          &
    180180                      &   ) * ddzw(k)
    181181             ENDDO
    … …  
    248248       INTEGER ::  i, j, k
    249249       REAL    ::  kmym_x, kmym_y, kmyp_x, kmyp_y, kmzm, kmzp
    250        REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_y(nys-1:nyn+1)
    251        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     250       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_y(nysg:nyng)
     251       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    252252       REAL, DIMENSION(nzb:nzt+1)      ::  usvs
    253253       REAL, DIMENSION(:,:),   POINTER ::  usws, uswst

  • TabularUnified palm/trunk/SOURCE/diffusion_v.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    7070       INTEGER ::  i, j, k
    7171       REAL    ::  kmxm_x, kmxm_y, kmxp_x, kmxp_y, kmzm, kmzp
    72        REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1)
    73        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     72       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxlg:nxrg)
     73       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    7474       REAL, DIMENSION(:,:),   POINTER ::  vsws, vswst
    7575       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
    … …  
    246246       INTEGER ::  i, j, k
    247247       REAL    ::  kmxm_x, kmxm_y, kmxp_x, kmxp_y, kmzm, kmzp
    248        REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1)
    249        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     248       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxlg:nxrg)
     249       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    250250       REAL, DIMENSION(nzb:nzt+1)      ::  vsus
    251251       REAL, DIMENSION(:,:),   POINTER ::  vsws, vswst

  • TabularUnified palm/trunk/SOURCE/diffusion_w.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    6464       REAL    ::  kmxm_x, kmxm_z, kmxp_x, kmxp_z, kmym_y, kmym_z, kmyp_y, &
    6565                   kmyp_z
    66        REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1), &
    67                    km_damp_y(nys-1:nyn+1)
    68        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     66       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxlg:nxrg),        &
     67                   km_damp_y(nysg:nyng)
     68       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    6969       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w
    7070       REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus, wsvs
    … …  
    211211       REAL    ::  kmxm_x, kmxm_z, kmxp_x, kmxp_z, kmym_y, kmym_z, kmyp_y, &
    212212                   kmyp_z
    213        REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1), &
    214                    km_damp_y(nys-1:nyn+1)
    215        REAL    ::  tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     213       REAL    ::  ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxlg:nxrg),        &
     214                   km_damp_y(nysg:nyng)
     215       REAL    ::  tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    216216       REAL, DIMENSION(nzb:nzt+1)      ::  wsus, wsvs
    217217       REAL, DIMENSION(:,:,:), POINTER ::  km, u, v, w

  • TabularUnified palm/trunk/SOURCE/diffusivities.f90

    r510 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    5454    REAL, SAVE ::  phi_m = 1.0
    5555
    56     REAL    ::  var(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     56    REAL    ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    5757
    5858    REAL, DIMENSION(1:nzt) ::  l, ll, sqrt_e
    … …  
    7373
    7474    !$OMP DO
    75     DO  i = nxl-1, nxr+1
    76        DO  j = nys-1, nyn+1
     75    DO  i = nxlg, nxrg
     76       DO  j = nysg, nyng
    7777
    7878!
    … …  
    157157
    158158    sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! quasi boundary-condition for
    159                                                 ! data output
     159                                                  ! data output
    160160
    161161    !$OMP END PARALLEL
    … …  
    167167!-- values of the diffusivities are not needed
    168168    !$OMP PARALLEL DO
    169     DO  i = nxl-1, nxr+1
    170        DO  j = nys-1, nyn+1
     169    DO  i = nxlg, nxrg
     170       DO  j = nysg, nyng
    171171          km(nzb_s_inner(j,i),j,i) = km(nzb_s_inner(j,i)+1,j,i)
    172172          km(nzt+1,j,i)            = km(nzt,j,i)

  • TabularUnified palm/trunk/SOURCE/disturb_field.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
     7! Calls of exchange_horiz are modified.
    78!
    89! Former revisions:
    … …  
    4445
    4546    INTEGER ::  i, j, k
    46     INTEGER ::  nzb_uv_inner(nys-1:nyn+1,nxl-1:nxr+1)
     47    INTEGER ::  nzb_uv_inner(nysg:nyng,nxlg:nxrg)
    4748
    4849    REAL    ::  randomnumber,                             &
    49                 dist1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    50                 field(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     50                dist1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     51                field(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    5152    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  dist2
    5253
    … …  
    5758!-- Create an additional temporary array and initialize the arrays needed
    5859!-- to store the disturbance
    59     ALLOCATE( dist2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     60    ALLOCATE( dist2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    6061    dist1 = 0.0
    6162    dist2 = 0.0
    … …  
    102103!-- Exchange of ghost points for the random perturbation
    103104
    104     CALL exchange_horiz( dist1 )
    105 
     105    CALL exchange_horiz( dist1, nbgp )
    106106!
    107107!-- Applying the Shuman filter in order to smooth the perturbations.
    … …  
    128128!-- Exchange of ghost points for the filtered perturbation.
    129129!-- Afterwards, filter operation and exchange of ghost points are repeated.
    130     CALL exchange_horiz( dist2 )
     130    CALL exchange_horiz( dist2, nbgp )
    131131
    132132    DO  i = nxl, nxr
    … …  
    141141    ENDDO
    142142
    143     CALL exchange_horiz( dist1 )
     143    CALL exchange_horiz( dist1, nbgp )
    144144
    145145!
    … …  
    148148!-- (diffusion criterion))
    149149    IF ( TRIM( topography ) /= 'flat' )  THEN
    150        DO  i = nxl-1, nxr+1
    151           DO  j = nys-1, nyn+1
     150       DO  i = nxlg, nxrg
     151          DO  j = nysg, nyng
    152152             dist1(nzb:nzb_uv_inner(j,i)+1,j,i) = 0.0
    153153          ENDDO
    … …  
    157157!
    158158!-- Random perturbation is added to the array to be disturbed.
    159     DO  i = nxl-1, nxr+1
    160        DO  j = nys-1, nyn+1
     159    DO  i = nxlg, nxrg
     160       DO  j = nysg, nyng
    161161          DO  k = disturbance_level_ind_b-2, disturbance_level_ind_t+2
    162162             field(k,j,i) = field(k,j,i) + dist1(k,j,i)

  • TabularUnified palm/trunk/SOURCE/exchange_horiz.f90

    r484 r667  
    1  SUBROUTINE exchange_horiz( ar )
     1 SUBROUTINE exchange_horiz( ar, nbgp_local)
    22
    33!------------------------------------------------------------------------------!
    44! Current revisions:
    55! -----------------
    6 !
     6! Dynamic exchange of ghost points with nbgp_local to ensure that no useless
     7! ghost points exchanged in case of multigrid. type_yz(0) and type_xz(0)
     8! used for normal grid, the remaining types used for the several grid levels.
     9! Exchange is done via MPI-Vectors with a dynamic value of ghost points which
     10! depend on the advection scheme. Exchange of left and right PEs is 10% faster
     11! with MPI-Vectors than without.
    712!
    813! Former revisions:
    … …  
    4146    INTEGER, DIMENSION(MPI_STATUS_SIZE,4) ::  wait_stat
    4247#endif
    43 
    44     REAL ::  ar(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
    45 
     48    INTEGER :: i,nbgp_local
     49    REAL, DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
     50                    nxl-nbgp_local:nxr+nbgp_local) ::  ar
    4651
    4752    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
    4853
     54    IF ( exchange_mg == .TRUE. ) THEN
     55      i = grid_level
     56    ELSE
     57      i = 0
     58    END IF
    4959#if defined( __parallel )
    5060
    … …  
    5666!--    within the PE memory
    5767       IF ( bc_lr == 'cyclic' )  THEN
    58           ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
    59           ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
     68          ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
     69          ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
    6070       ENDIF
    6171
    … …  
    6575!
    6676!--    Send left boundary, receive right one
    67        CALL MPI_ISEND(                                                     &
    68                ar(nzb,nys-1,nxl), ngp_yz(grid_level), MPI_REAL, pleft,  0, &
    69                           comm2d, req(1), ierr )
    70        CALL MPI_IRECV(                                                       &
    71                ar(nzb,nys-1,nxr+1), ngp_yz(grid_level), MPI_REAL, pright, 0, &
    72                           comm2d, req(2), ierr )
     77       CALL MPI_ISEND(ar(nzb,nys-nbgp_local,nxl),1,type_yz(i),pleft,0,comm2d,&
     78                      req(1),ierr)
     79       CALL MPI_IRECV(ar(nzb,nys-nbgp_local,nxr+1),1,type_yz(i),pright,0,&
     80                     comm2d,req(2),ierr)
    7381!
    7482!--    Send right boundary, receive left one
    75        CALL MPI_ISEND(                                                     &
    76                ar(nzb,nys-1,nxr), ngp_yz(grid_level), MPI_REAL, pright, 1, &
    77                           comm2d, req(3), ierr )
    78        CALL MPI_IRECV(                                                       &
    79                ar(nzb,nys-1,nxl-1), ngp_yz(grid_level), MPI_REAL, pleft,  1, &
    80                           comm2d, req(4), ierr )
     83
     84
     85       CALL MPI_ISEND(ar(nzb,nys-nbgp_local,nxr+1-nbgp_local),1,type_yz(i),pright, 1,  &
     86                      comm2d, req(3), ierr )
     87       CALL MPI_IRECV(ar(nzb,nys-nbgp_local,nxl-nbgp_local),1,type_yz(i),pleft,1,&
     88                      comm2d,req(4), ierr)
     89
    8190       CALL MPI_WAITALL( 4, req, wait_stat, ierr )
    8291
    … …  
    8998!--    within the PE memory
    9099       IF ( bc_ns == 'cyclic' )  THEN
    91           ar(:,nys-1,:) = ar(:,nyn,:)
    92           ar(:,nyn+1,:) = ar(:,nys,:)
     100          ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
     101          ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
    93102       ENDIF
    94103
    … …  
    98107!
    99108!--    Send front boundary, receive rear one
    100        CALL MPI_ISEND( ar(nzb,nys,nxl-1),   1, type_xz(grid_level), psouth, 0, &
     109!--    MPI_ISEND initial send adress changed, type_xz() is sendet nbgp times
     110
     111       CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local),1, type_xz(i), psouth, 0, &
    101112                       comm2d, req(1), ierr )
    102        CALL MPI_IRECV( ar(nzb,nyn+1,nxl-1), 1, type_xz(grid_level), pnorth, 0, &
     113       CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local),1, type_xz(i), pnorth, 0, &
    103114                       comm2d, req(2), ierr )
    104115!
    105116!--    Send rear boundary, receive front one
    106        CALL MPI_ISEND( ar(nzb,nyn,nxl-1),   1, type_xz(grid_level), pnorth, 1, &
     117       CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local),1, type_xz(i), pnorth, 1, &
    107118                       comm2d, req(3), ierr )
    108        CALL MPI_IRECV( ar(nzb,nys-1,nxl-1), 1, type_xz(grid_level), psouth, 1, &
     119       CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),1, type_xz(i), psouth, 1, &
    109120                       comm2d, req(4), ierr )
    110121       call MPI_WAITALL( 4, req, wait_stat, ierr )
    111122
    112123    ENDIF
    113 
    114124
    115125#else
    … …  
    118128!-- Lateral boundary conditions in the non-parallel case
    119129    IF ( bc_lr == 'cyclic' )  THEN
    120        ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
    121        ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
     130        ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
     131        ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
    122132    ENDIF
    123133
    124134    IF ( bc_ns == 'cyclic' )  THEN
    125        ar(:,nys-1,:) = ar(:,nyn,:)
    126        ar(:,nyn+1,:) = ar(:,nys,:)
     135        ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
     136        ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
    127137    ENDIF
    128138
    129139#endif
    130 
    131140    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
    132141
     142
    133143 END SUBROUTINE exchange_horiz

  • TabularUnified palm/trunk/SOURCE/exchange_horiz_2d.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Dynamic exchange of ghost points with nbgp, which depends on the advection
     7! scheme. Exchange between left and right PEs is now done with MPI-vectors.
    78!
    89! Former revisions:
    … …  
    3738    IMPLICIT NONE
    3839
    39     REAL ::  ar(nys-1:nyn+1,nxl-1:nxr+1)
     40    REAL ::  ar(nysg:nyng,nxlg:nxrg)
     41    INTEGER :: i
    4042
    4143
    … …  
    5153!--    One-dimensional decomposition along y, boundary values can be exchanged
    5254!--    within the PE memory
    53        ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
    54        ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
     55       ar(:,nxl-nbgp:nxl-1) = ar(:,nxr-nbgp+1:nxr)
     56       ar(:,nxr+1:nxr+nbgp) = ar(:,nxl:nxl+nbgp-1)
    5557
    5658    ELSE
    5759!
    5860!--    Send left boundary, receive right one
    59        CALL MPI_SENDRECV( ar(nys,nxl),   ngp_y, MPI_REAL, pleft,  0, &
    60                           ar(nys,nxr+1), ngp_y, MPI_REAL, pright, 0, &
     61
     62       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0, &
     63                          ar(nysg,nxr+1), 1, type_y, pright, 0, &
    6164                          comm2d, status, ierr )
    6265!
    6366!--    Send right boundary, receive left one
    64        CALL MPI_SENDRECV( ar(nys,nxr),   ngp_y, MPI_REAL, pright,  1, &
    65                           ar(nys,nxl-1), ngp_y, MPI_REAL, pleft,   1, &
     67       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1, &
     68                          ar(nysg,nxlg), 1, type_y, pleft,   1, &
    6669                          comm2d, status, ierr )
    6770    ENDIF
    … …  
    7174!--    One-dimensional decomposition along x, boundary values can be exchanged
    7275!--    within the PE memory
    73        ar(nys-1,:) = ar(nyn,:)
    74        ar(nyn+1,:) = ar(nys,:)
     76       ar(nys-nbgp:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
     77       ar(nyn+1:nyn+nbgp,:) = ar(nys:nys+nbgp-1,:)
    7578
    7679    ELSE
    7780!
    7881!--    Send front boundary, receive rear one
    79        CALL MPI_SENDRECV( ar(nys,nxl-1),   1, type_x, psouth, 0, &
    80                           ar(nyn+1,nxl-1), 1, type_x, pnorth, 0, &
     82
     83       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0, &        !replace number of sended elements from
     84                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0, &      ! nbgp to 1
    8185                          comm2d, status, ierr )
    8286!
    8387!--    Send rear boundary, receive front one
    84        CALL MPI_SENDRECV( ar(nyn,nxl-1),   1, type_x, pnorth, 1, &
    85                           ar(nys-1,nxl-1), 1, type_x, psouth, 1, &
    86                           comm2d, status, ierr )
     88       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1, &
     89                          ar(nysg,nxlg), 1, type_x, psouth, 1, &
     90                          comm2d, status, ierr )
     91
    8792    ENDIF
    8893
    … …  
    9297!-- Lateral boundary conditions in the non-parallel case
    9398    IF ( bc_lr == 'cyclic' )  THEN
    94        ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
    95        ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
     99       ar(:,nxl-nbgp:nxl-1) = ar(:,nxr-nbgp+1:nxr)
     100       ar(:,nxr+1:nxr+nbgp) = ar(:,nxl:nxl+nbgp-1)
    96101    ENDIF
    97102
    98103    IF ( bc_ns == 'cyclic' )  THEN
    99        ar(nys-1,:) = ar(nyn,:)
    100        ar(nyn+1,:) = ar(nys,:)
    101     ENDIF
     104       ar(nys-nbgp:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
     105       ar(nyn+1:nyn+nbgp,:) = ar(nys:nys+nbgp-1,:)
     106    ENDIF
     107
    102108
    103109#endif
    … …  
    106112!-- Neumann-conditions at inflow/outflow in case of non-cyclic boundary
    107113!-- conditions
    108     IF ( inflow_l .OR. outflow_l )  ar(:,nxl-1) = ar(:,nxl)
    109     IF ( inflow_r .OR. outflow_r )  ar(:,nxr+1) = ar(:,nxr)
    110     IF ( inflow_s .OR. outflow_s )  ar(nys-1,:) = ar(nys,:)
    111     IF ( inflow_n .OR. outflow_n )  ar(nyn+1,:) = ar(nyn,:)
    112 
     114    IF ( inflow_l .OR. outflow_l )  THEN
     115       DO i=nbgp, 1, -1
     116         ar(:,nxl-i) = ar(:,nxl)
     117       END DO
     118    END IF
     119    IF ( inflow_r .OR. outflow_r )  THEN
     120       DO i=1, nbgp
     121          ar(:,nxr+i) = ar(:,nxr)
     122       END DO
     123    END IF
     124    IF ( inflow_s .OR. outflow_s )  THEN
     125       DO i=nbgp, 1, -1
     126         ar(nys-i,:) = ar(nys,:)
     127       END DO
     128    END IF
     129    IF ( inflow_n .OR. outflow_n )  THEN
     130       DO i=1, nbgp
     131         ar(nyn+i,:) = ar(nyn,:)
     132       END DO
     133    END IF
    113134    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
    114135
    … …  
    134155    IMPLICIT NONE
    135156
    136     INTEGER ::  ar(nys-1:nyn+1,nxl-1:nxr+1)
     157    REAL ::  ar(nysg:nyng,nxlg:nxrg)
     158    INTEGER :: i
     159
    137160
    138161
    … …  
    154177!
    155178!--    Send left boundary, receive right one
    156        CALL MPI_SENDRECV( ar(nys,nxl),   ngp_y, MPI_INTEGER, pleft,  0, &
    157                           ar(nys,nxr+1), ngp_y, MPI_INTEGER, pright, 0, &
     179       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y_int, pleft,  0, &
     180                          ar(nysg,nxr+1), 1, type_y_int, pright, 0, &
    158181                          comm2d, status, ierr )
    159182!
    160183!--    Send right boundary, receive left one
    161        CALL MPI_SENDRECV( ar(nys,nxr),   ngp_y, MPI_INTEGER, pright,  1, &
    162                           ar(nys,nxl-1), ngp_y, MPI_INTEGER, pleft,   1, &
    163                           comm2d, status, ierr )
     184       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y_int, pright,  1, &
     185                          ar(nysg,nxlg), 1, type_y_int, pleft,   1, &
     186                          comm2d, status, ierr )
     187
    164188    ENDIF
    165189
    … …  
    168192!--    One-dimensional decomposition along x, boundary values can be exchanged
    169193!--    within the PE memory
    170        ar(nys-1,:) = ar(nyn,:)
    171        ar(nyn+1,:) = ar(nys,:)
     194       ar(nysg:nys-1,:) = ar(nyn+1-nbgp:nyn,:)
     195       ar(nyn+1:nyng,:) = ar(nys:nys-1+nbgp,:)
     196
    172197
    173198    ELSE
    174199!
    175200!--    Send front boundary, receive rear one
    176        CALL MPI_SENDRECV( ar(nys,nxl-1),   1, type_x_int, psouth, 0, &
    177                           ar(nyn+1,nxl-1), 1, type_x_int, pnorth, 0, &
    178                           comm2d, status, ierr )
     201       CALL MPI_SENDRECV( ar(nys,nxlg),1, type_x_int, psouth, 0, &
     202                          ar(nyn+1,nxlg),1, type_x_int, pnorth, 0, &
     203                          comm2d, status, ierr )
     204
    179205!
    180206!--    Send rear boundary, receive front one
    181        CALL MPI_SENDRECV( ar(nyn,nxl-1),   1, type_x_int, pnorth, 1, &
    182                           ar(nys-1,nxl-1), 1, type_x_int, psouth, 1, &
    183                           comm2d, status, ierr )
     207       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), nbgp, type_x_int, pnorth, 1, &
     208                          ar(nysg,nxlg), nbgp, type_x_int, psouth, 1, &
     209                          comm2d, status, ierr )
     210
    184211    ENDIF
    185212
    … …  
    194221
    195222    IF ( bc_ns == 'cyclic' )  THEN
    196        ar(nys-1,:) = ar(nyn,:)
    197        ar(nyn+1,:) = ar(nys,:)
     223       ar(nysg:nys-1,:) = ar(nyn+1-nbgp:nyn,:)
     224       ar(nyn+1:nyng,:) = ar(nys:nys-1+nbgp,:)
    198225    ENDIF
    199226

  • TabularUnified palm/trunk/SOURCE/flow_statistics.f90

    r625 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! When advection is computed with ws-scheme, turbulent fluxes are already
     7! computed in the respective advection routines and buffered in arrays
     8! sums_xx_ws_l(). This is due to a consistent treatment of statistics with the
     9! numerics and to avoid unphysical kinks near the surface.
     10! So some if requests has to be done to dicern between fluxes from ws-scheme
     11! other advection schemes.
     12! Furthermore the computation of z_i is only done if the heat flux exceeds a
     13! minimum value. This affects only simulations of a neutral boundary layer and
     14! is due to reasons of computations in the advection scheme.
     15!
    716!
    817! Former revisions:
    … …  
    102111    REAL    ::  sums_ll(nzb:nzt+1,2)
    103112
    104 
    105113    CALL cpu_log( log_point(10), 'flow_statistics', 'start' )
    106114
    … …  
    133141       sums_l(nzb+10,pr_palm,0) = sums_divnew_l(sr)  ! new divergence from pres
    134142
     143!
     144!--    Copy the turbulent quantities, evaluated in the advection routines to
     145!--    the local array sums_l() for further computations
     146       IF ( ws_scheme_mom )  THEN
     147!       
     148!--       Boundary condition for u'u' and v'v', because below the surface no
     149!--       computation for these quantities is done.
     150          DO  i = nxl, nxr
     151             DO  j =  nys, nyn
     152                sums_us2_ws_l(nzb_u_inner(j,i),sr) =                          &
     153                    sums_us2_ws_l(nzb_u_inner(j,i)+1,sr)
     154                sums_vs2_ws_l(nzb_v_inner(j,i),sr) =                          & 
     155                    sums_vs2_ws_l(nzb_v_inner(j,i)+1,sr)
     156             ENDDO
     157          ENDDO
     158!         
     159!--       Swap the turbulent quantities evaluated in advec_ws.
     160          sums_l(:,13,0) = sums_wsus_ws_l(:,sr)       ! w*u*
     161          sums_l(:,15,0) = sums_wsvs_ws_l(:,sr)       ! w*v*
     162          sums_l(:,30,0) = sums_us2_ws_l(:,sr)        ! u*2
     163          sums_l(:,31,0) = sums_vs2_ws_l(:,sr)        ! v*2
     164          sums_l(:,32,0) = sums_ws2_ws_l(:,sr)        ! w*2
     165          sums_l(:,34,0) = sums_l(:,34,0) + 0.5 *                             &
     166                (sums_us2_ws_l(:,sr) + sums_vs2_ws_l(:,sr)                    &
     167                + sums_ws2_ws_l(:,sr))                      ! e*
     168          DO  k = nzb, nzt
     169             sums_l(nzb+5,pr_palm,0) = sums_l(nzb+5,pr_palm,0) + 0.5 * (      &
     170                sums_us2_ws_l(k,sr) + sums_vs2_ws_l(k,sr) +                   &
     171                sums_ws2_ws_l(k,sr))
     172          ENDDO
     173       ENDIF
     174       IF ( ws_scheme_sca )  THEN
     175          sums_l(:,17,0) = sums_wspts_ws_l(:,sr)      ! w*pts* from advec_s_ws
     176          IF ( ocean ) sums_l(:,66,0) = sums_wssas_ws_l(:,sr) ! w*sa*
     177          IF ( humidity  .OR.  passive_scalar ) sums_l(:,49,0) =              &
     178                                                   sums_wsqs_ws_l(:,sr) !w*q*
     179       ENDIF
    135180!
    136181!--    Horizontally averaged profiles of horizontal velocities and temperature.
    … …  
    138183!--    for other horizontal averages.
    139184       tn = 0
     185
    140186       !$OMP PARALLEL PRIVATE( i, j, k, tn )
    141187#if defined( __intel_openmp_bug )
    … …  
    215261       ENDIF
    216262       !$OMP END PARALLEL
    217 
    218263!
    219264!--    Summation of thread sums
    … …  
    304349       hom(:,1,2,sr) = sums(:,2)             ! v
    305350       hom(:,1,4,sr) = sums(:,4)             ! pt
     351
    306352
    307353!
    … …  
    354400          DO  j =  nys, nyn
    355401             sums_l_etot = 0.0
    356              sums_l_eper = 0.0
    357402             DO  k = nzb_s_inner(j,i), nzt+1
    358                 u2   = u(k,j,i)**2
    359                 v2   = v(k,j,i)**2
    360                 w2   = w(k,j,i)**2
    361                 ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
    362                 vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
    363403!
    364404!--             Prognostic and diagnostic variables
    … …  
    369409                sums_l(k,40,tn) = sums_l(k,40,tn) + p(k,j,i)
    370410
    371 !
    372 !--             Variances
    373                 sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)
    374                 sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)
    375                 sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)
    376411                sums_l(k,33,tn) = sums_l(k,33,tn) + &
    377412                                  ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)
    … …  
    381416                                  ( q(k,j,i)-hom(k,1,41,sr) )**2 * rmask(j,i,sr)
    382417                ENDIF
    383 !
    384 !--             Higher moments
    385 !--             (Computation of the skewness of w further below)
    386                 sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i) * w2 * &
    387                                                     rmask(j,i,sr)
    388 !
    389 !--             Perturbation energy
    390                 sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5 * ( ust2 + vst2 + w2 ) &
    391                                                     * rmask(j,i,sr)
     418
    392419                sums_l_etot  = sums_l_etot + &
    393                                         0.5 * ( u2 + v2 + w2 ) * rmask(j,i,sr)
    394                 sums_l_eper  = sums_l_eper + &
    395                                         0.5 * ( ust2+vst2+w2 ) * rmask(j,i,sr)
     420                                        0.5 * ( u(k,j,i)**2 + v(k,j,i)**2 +    &
     421                                        w(k,j,i)**2 ) * rmask(j,i,sr)
    396422             ENDDO
    397423!
    … …  
    401427!--          allow vectorization of that loop.
    402428             sums_l(nzb+4,pr_palm,tn) = sums_l(nzb+4,pr_palm,tn) + sums_l_etot
    403              sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn) + sums_l_eper
    404429!
    405430!--          2D-arrays (being collected in the last column of sums_l)
    … …  
    420445
    421446!
     447!--    Computation of statistics when ws-scheme is not used. Else these
     448!--    quantities are evaluated in the advection routines.
     449       IF ( .NOT. ws_scheme_mom )  THEN
     450          !$OMP DO
     451          DO  i = nxl, nxr
     452             DO  j =  nys, nyn
     453                sums_l_eper = 0.0
     454                DO  k = nzb_s_inner(j,i), nzt+1
     455                   u2   = u(k,j,i)**2
     456                   v2   = v(k,j,i)**2
     457                   w2   = w(k,j,i)**2
     458                   ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
     459                   vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
     460
     461                   sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)
     462                   sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)
     463                   sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)
     464!
     465!--   Higher moments
     466!--  (Computation of the skewness of w further below)
     467                   sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i) * w2 * &
     468                                                    rmask(j,i,sr)
     469!
     470!--             Perturbation energy
     471
     472                   sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5 *       &
     473                                  ( ust2 + vst2 + w2 ) * rmask(j,i,sr)
     474                   sums_l_eper  = sums_l_eper + &
     475                                        0.5 * ( ust2+vst2+w2 ) * rmask(j,i,sr)
     476
     477                ENDDO
     478                sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn)   &
     479                     + sums_l_eper
     480             ENDDO
     481          ENDDO
     482       ELSE
     483          !$OMP DO
     484          DO  i = nxl, nxr
     485             DO  j =  nys, nyn
     486                DO  k = nzb_s_inner(j,i), nzt + 1
     487                   w2   = w(k,j,i)**2
     488!
     489!--                Higher moments
     490!--                (Computation of the skewness of w further below)
     491                   sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i) * w2 * &
     492                                                    rmask(j,i,sr)
     493                ENDDO
     494             ENDDO
     495          ENDDO
     496       ENDIF
     497
     498!
    422499!--    Horizontally averaged profiles of the vertical fluxes
     500
    423501       !$OMP DO
    424502       DO  i = nxl, nxr
    … …  
    587665                pts = 0.5 * ( pt(k,j,i)   - hom(k,1,4,sr) + &
    588666                              pt(k+1,j,i) - hom(k+1,1,4,sr) )
    589 !
    590 !--             Momentum flux w*u*
    591                 sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5 *                     &
    592                                                     ( w(k,j,i-1) + w(k,j,i) ) &
    593                                                     * ust * rmask(j,i,sr)
    594 !
    595 !--             Momentum flux w*v*
    596                 sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5 *                     &
    597                                                     ( w(k,j-1,i) + w(k,j,i) ) &
    598                                                     * vst * rmask(j,i,sr)
    599 !
    600 !--             Heat flux w*pt*
    601 !--             The following formula (comment line, not executed) does not
    602 !--             work if applied to subregions
    603 !                sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5 *                     &
    604 !                                                    ( pt(k,j,i)+pt(k+1,j,i) ) &
    605 !                                                    * w(k,j,i) * rmask(j,i,sr)
    606                 sums_l(k,17,tn) = sums_l(k,17,tn) + pts * w(k,j,i) * &
    607                                                     rmask(j,i,sr)
    608 !
     667
    609668!--             Higher moments
    610669                sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 * &
    … …  
    617676!--             but so far there is no other suitable place to calculate)
    618677                IF ( ocean )  THEN
    619                    pts = 0.5 * ( sa(k,j,i)   - hom(k,1,23,sr) + &
     678                   IF( .NOT. ws_scheme_sca )  THEN
     679                      pts = 0.5 * ( sa(k,j,i)   - hom(k,1,23,sr) + &
    620680                                 sa(k+1,j,i) - hom(k+1,1,23,sr) )
    621                    sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) * &
     681                      sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) * &
    622682                                                       rmask(j,i,sr)
     683                   ENDIF
    623684                   sums_l(k,64,tn) = sums_l(k,64,tn) + rho(k,j,i) * &
    624685                                                       rmask(j,i,sr)
    … …  
    635696                   sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) * &
    636697                                                       rmask(j,i,sr)
    637                    pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
    638                                  q(k+1,j,i) - hom(k+1,1,41,sr) )
    639                    sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
    640                                                        rmask(j,i,sr)
     698
    641699                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
    642700                      pts = 0.5 *                                            &
    … …  
    652710!
    653711!--             Passive scalar flux
    654                 IF ( passive_scalar )  THEN
     712                IF ( passive_scalar .AND. ( .NOT. ws_scheme_sca ))  THEN
    655713                   pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
    656714                                 q(k+1,j,i) - hom(k+1,1,41,sr) )
    … …  
    661719!
    662720!--             Energy flux w*e*
    663                 sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5 *           &
    664                                               ( ust**2 + vst**2 + w(k,j,i)**2 )&
    665                                               * rmask(j,i,sr)
    666          
     721!--             has to be adjusted
     722                sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5 *          &
     723                                             ( ust**2 + vst**2 + w(k,j,i)**2 )&
     724                                             * rmask(j,i,sr)
    667725             ENDDO
    668726          ENDDO
    669727       ENDDO
     728!-     for reasons of speed optimization the loop is splitted, to avoid if-else
     729!-     statements inside the loop
     730!-     Fluxes which have been computed in part directly inside the advection routines
     731!-     treated seperatly.
     732!-     First treat the momentum fluxes
     733       IF ( .NOT. ws_scheme_mom )  THEN
     734         !$OMP DO
     735         DO  i = nxl, nxr
     736            DO  j = nys, nyn
     737               DO  k = nzb_diff_s_inner(j,i)-1, nzt_diff
     738                  ust = 0.5 * ( u(k,j,i)   - hom(k,1,1,sr) + &
     739                              u(k+1,j,i) - hom(k+1,1,1,sr) )
     740                  vst = 0.5 * ( v(k,j,i)   - hom(k,1,2,sr) + &
     741                              v(k+1,j,i) - hom(k+1,1,2,sr) )
     742!                             
     743!--               Momentum flux w*u*
     744                  sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5 *                   &
     745                                                    ( w(k,j,i-1) + w(k,j,i) ) &
     746                                                    * ust * rmask(j,i,sr)
     747!
     748!--               Momentum flux w*v*
     749                  sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5 *                   &
     750                                                    ( w(k,j-1,i) + w(k,j,i) ) &
     751                                                    * vst * rmask(j,i,sr)
     752               ENDDO
     753            ENDDO
     754         ENDDO
     755
     756       ENDIF
     757       IF ( .NOT. ws_scheme_sca )  THEN
     758         !$OMP DO
     759         DO  i = nxl, nxr
     760            DO  j = nys, nyn
     761               DO  k = nzb_diff_s_inner(j,i) - 1, nzt_diff
     762!-                vertical heat flux
     763                  sums_l(k,17,tn) = sums_l(k,17,tn) +  0.5 * &
     764                           ( pt(k,j,i)   - hom(k,1,4,sr) + &
     765                           pt(k+1,j,i) - hom(k+1,1,4,sr) ) &
     766                           * w(k,j,i) * rmask(j,i,sr)
     767                  IF ( humidity )  THEN
     768                     pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
     769                                q(k+1,j,i) - hom(k+1,1,41,sr) )
     770                     sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
     771                                                      rmask(j,i,sr)
     772                  ENDIF
     773               ENDDO
     774            ENDDO
     775         ENDDO
     776
     777       ENDIF
     778
    670779
    671780!
    … …  
    814923
    815924#if defined( __parallel )
     925
    816926!
    817927!--    Compute total sum from local sums
    … …  
    843953          sums(k,70:pr_palm-2)    = sums(k,70:pr_palm-2)/ ngp_2dh_s_inner(k,sr)
    844954       ENDDO
     955
    845956!--    Upstream-parts
    846957       sums(nzb:nzb+11,pr_palm-1) = sums(nzb:nzb+11,pr_palm-1) / ngp_3d(sr)
    … …  
    868979          ENDDO
    869980       ENDIF
    870 
    871981!
    872982!--    Collect horizontal average in hom.
    … …  
    9341044                                       ! upstream-parts u_x, u_y, u_z, v_x,
    9351045                                       ! v_y, usw. (in last but one profile)
    936        hom(:,1,pr_palm,sr) =   sums(:,pr_palm) 
     1046       hom(:,1,pr_palm,sr) =   sums(:,pr_palm)
    9371047                                       ! u*, w'u', w'v', t* (in last profile)
    9381048
    … …  
    9511061       z_i(1) = 0.0
    9521062       first = .TRUE.
     1063
    9531064       IF ( ocean )  THEN
    9541065          DO  k = nzt, nzb+1, -1
    955              IF ( first .AND. hom(k,1,18,sr) < 0.0 )  THEN
     1066             IF ( first .AND. hom(k,1,18,sr) < 0.0 &
     1067                .AND. abs(hom(k,1,18,sr)) > 1.0E-8)  THEN
    9561068                first = .FALSE.
    9571069                height = zw(k)
    9581070             ENDIF
    9591071             IF ( hom(k,1,18,sr) < 0.0  .AND. &
     1072                  abs(hom(k,1,18,sr)) > 1.0E-8 .AND. &
    9601073                  hom(k-1,1,18,sr) > hom(k,1,18,sr) )  THEN
    9611074                IF ( zw(k) < 1.5 * height )  THEN
    … …  
    9691082       ELSE
    9701083          DO  k = nzb, nzt-1
    971              IF ( first .AND. hom(k,1,18,sr) < 0.0 )  THEN
     1084             IF ( first .AND. hom(k,1,18,sr) < 0.0 &
     1085                .AND. abs(hom(k,1,18,sr)) > 1.0E-8 )  THEN
    9721086                first = .FALSE.
    9731087                height = zw(k)
    9741088             ENDIF
    975              IF ( hom(k,1,18,sr) < 0.0  .AND. &
     1089             IF ( hom(k,1,18,sr) < 0.0  .AND. &
     1090                  abs(hom(k,1,18,sr)) > 1.0E-8 .AND. &
    9761091                  hom(k+1,1,18,sr) > hom(k,1,18,sr) )  THEN
    9771092                IF ( zw(k) < 1.5 * height )  THEN
    … …  
    10261141!--    the characteristic convective boundary layer temperature.
    10271142!--    The horizontal average at nzb+1 is input for the average temperature.
    1028        IF ( hom(nzb,1,18,sr) > 0.0  .AND.  z_i(1) /= 0.0 )  THEN
     1143       IF ( hom(nzb,1,18,sr) > 0.0 .AND. abs(hom(nzb,1,18,sr)) > 1.0E-8 &
     1144           .AND.  z_i(1) /= 0.0 )  THEN
    10291145          hom(nzb+8,1,pr_palm,sr)  = ( g / hom(nzb+1,1,4,sr) * &
    10301146                                       hom(nzb,1,18,sr) *      &

  • TabularUnified palm/trunk/SOURCE/global_min_max.f90

    r623 r667  
    55! Current revisions:
    66! -----------------
    7 !
     7! Adapting of the index arrays, because MINLOC assumes lowerbound at 1 and not
     8! at nbgp.
    89!
    910! Former revisions:
    … …  
    5960!--    Determine the local minimum
    6061       fmin_ijk_l = MINLOC( ar )
    61        fmin_ijk_l(1) = i1 + fmin_ijk_l(1) - 1    ! MINLOC assumes lowerbound = 1
    62        fmin_ijk_l(2) = j1 + fmin_ijk_l(2) - 1
     62       fmin_ijk_l(1) = i1 + fmin_ijk_l(1) - nbgp    ! MINLOC assumes lowerbound = 1
     63       fmin_ijk_l(2) = j1 + fmin_ijk_l(2) - nbgp
    6364       fmin_ijk_l(3) = k1 + fmin_ijk_l(3) - 1
    6465       fmin_l(1)  = ar(fmin_ijk_l(1),fmin_ijk_l(2),fmin_ijk_l(3))
    … …  
    100101!--    Determine the local maximum
    101102       fmax_ijk_l = MAXLOC( ar )
    102        fmax_ijk_l(1) = i1 + fmax_ijk_l(1) - 1    ! MAXLOC assumes lowerbound = 1
    103        fmax_ijk_l(2) = j1 + fmax_ijk_l(2) - 1
     103       fmax_ijk_l(1) = i1 + fmax_ijk_l(1) - nbgp    ! MAXLOC assumes lowerbound = 1
     104       fmax_ijk_l(2) = j1 + fmax_ijk_l(2) - nbgp
    104105       fmax_ijk_l(3) = k1 + fmax_ijk_l(3) - 1
    105106       fmax_l(1) = ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3))
    … …  
    221222          IF ( fmax_ijk(1) < 0 )  THEN
    222223             value        = -value
    223              value_ijk(1) = -value_ijk(1) - 10
     224             value_ijk(1) = -value_ijk(1) - 10         !???
    224225          ENDIF
    225226
    … …  
    228229!
    229230!-- Limit index values to the range 0..nx, 0..ny
    230     IF ( value_ijk(3) ==   -1 )  value_ijk(3) = nx
    231     IF ( value_ijk(3) == nx+1 )  value_ijk(3) =  0
    232     IF ( value_ijk(2) ==   -1 )  value_ijk(2) = ny
    233     IF ( value_ijk(2) == ny+1 )  value_ijk(2) =  0
     231    IF ( value_ijk(3) < 0  ) value_ijk(3) = nx +1 + value_ijk(3)
     232    IF ( value_ijk(3) > nx ) value_ijk(3) = value_ijk(3) - (nx+1)
     233    IF ( value_ijk(2) < 0  ) value_ijk(2) = ny +1 + value_ijk(2)
     234    IF ( value_ijk(2) > ny ) value_ijk(2) = value_ijk(2) - (ny+1)
    234235
    235236

  • TabularUnified palm/trunk/SOURCE/header.f90

    r581 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Output of advection scheme.
     7! Modified output of Prandtl-layer height.
    78!
    89! Former revisions:
    … …  
    250251    IF ( momentum_advec == 'pw-scheme' )  THEN
    251252       WRITE ( io, 113 )
    252     ELSE
     253    ELSEIF (momentum_advec == 'ws-scheme' ) THEN
     254       WRITE ( io, 503 )
     255    ELSEIF (momentum_advec == 'ups-scheme' ) THEN
    253256       WRITE ( io, 114 )
    254257       IF ( cut_spline_overshoot )  WRITE ( io, 124 )
    … …  
    267270    IF ( scalar_advec == 'pw-scheme' )  THEN
    268271       WRITE ( io, 116 )
     272    ELSEIF ( scalar_advec == 'ws-scheme' )  THEN
     273       WRITE ( io, 504 )
    269274    ELSEIF ( scalar_advec == 'ups-scheme' )  THEN
    270275       WRITE ( io, 117 )
    … …  
    575580    ELSEIF( ibc_pt_t == 2 )  THEN
    576581       roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
     582
    577583    ENDIF
    578584
    … …  
    662668
    663669    IF ( prandtl_layer )  THEN
    664        WRITE ( io, 305 )  0.5 * (zu(1)-zu(0)), roughness_length, kappa, &
     670       WRITE ( io, 305 )  (zu(1)-zu(0)), roughness_length, kappa, &
    665671                          rif_min, rif_max
    666672       IF ( .NOT. constant_heatflux )  WRITE ( io, 308 )
    … …  
    19811987            '    Dissipation calculation:           ',A/)
    19821988502 FORMAT ('    Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
     1989503 FORMAT (' --> Momentum advection via Wicker-Skamarock-Scheme 5th order')
     1990504 FORMAT (' --> Scalar advection via Wicker-Skamarock-Scheme 5th order')
    19831991
    19841992

  • TabularUnified palm/trunk/SOURCE/inflow_turbulence.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Using nbgp recycling planes for a better resolution of the turbulent flow
     7! near the inflow.
    78!
    89! Former revisions:
    … …  
    3536    IMPLICIT NONE
    3637
    37     INTEGER ::  i, imax, j, k, ngp_ifd, ngp_pr
     38    INTEGER ::  i, imax, j, k, l, ngp_ifd, ngp_pr
    3839
    3940    REAL, DIMENSION(1:2) ::  volume_flow_l, volume_flow_offset
    40     REAL, DIMENSION(nzb:nzt+1,5) ::  avpr, avpr_l
    41     REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,5) ::  inflow_dist
     41    REAL, DIMENSION(nzb:nzt+1,5,nbgp) ::  avpr, avpr_l
     42    REAL, DIMENSION(nzb:nzt+1,nysg:nyng,5,nbgp) ::  inflow_dist
    4243
    4344    CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' )
    4445
    4546!
    46 !-- Carry out horizontal averaging in the recycling plane
     47!-- Carry out spanwise averaging in the recycling plane
    4748    avpr_l = 0.0
    48     ngp_pr = ( nzt - nzb + 2 ) * 5
    49     ngp_ifd = ngp_pr * ( nyn - nys + 3 )
     49    ngp_pr = ( nzt - nzb + 2 ) * 5 * nbgp
     50    ngp_ifd = ngp_pr * ( nyn - nys + 1 + 2 * nbgp )
    5051
    5152!
    5253!-- First, local averaging within the recycling domain
    53     IF ( recycling_plane >= nxl )  THEN
    54 
    55        imax = MIN( nxr, recycling_plane )
    56 
    57        DO  i = nxl, imax
     54
     55    i = recycling_plane
     56
     57#if defined( __parallel )
     58    IF ( myidx == id_recycling )  THEN
     59       
     60       DO  l = 1, nbgp
    5861          DO  j = nys, nyn
    59              DO  k = nzb, nzt+1
    60 
    61                 avpr_l(k,1) = avpr_l(k,1) + u(k,j,i)
    62                 avpr_l(k,2) = avpr_l(k,2) + v(k,j,i)
    63                 avpr_l(k,3) = avpr_l(k,3) + w(k,j,i)
    64                 avpr_l(k,4) = avpr_l(k,4) + pt(k,j,i)
    65                 avpr_l(k,5) = avpr_l(k,5) + e(k,j,i)
     62             DO  k = nzb, nzt + 1
     63
     64                avpr_l(k,1,l) = avpr_l(k,1,l) + u(k,j,i)
     65                avpr_l(k,2,l) = avpr_l(k,2,l) + v(k,j,i)
     66                avpr_l(k,3,l) = avpr_l(k,3,l) + w(k,j,i)
     67                avpr_l(k,4,l) = avpr_l(k,4,l) + pt(k,j,i)
     68                avpr_l(k,5,l) = avpr_l(k,5,l) + e(k,j,i)
    6669
    6770             ENDDO
    6871          ENDDO
    69        ENDDO
    70 
    71     ENDIF
    72 
    73 !    WRITE (9,*) '*** averaged profiles avpr_l'
    74 !    DO  k = nzb, nzt+1
    75 !       WRITE (9,'(F5.1,1X,F5.1,1X,F5.1,1X,F6.1,1X,F7.2)') avpr_l(k,1),avpr_l(k,2),avpr_l(k,3),avpr_l(k,4),avpr_l(k,5)
    76 !    ENDDO
    77 !    WRITE (9,*) ' '
    78 
    79 #if defined( __parallel )
     72          i = i + 1
     73       ENDDO
     74
     75    ENDIF
    8076!
    8177!-- Now, averaging over all PEs
    8278    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    83     CALL MPI_ALLREDUCE( avpr_l(nzb,1), avpr(nzb,1), ngp_pr, MPI_REAL, MPI_SUM, &
    84                         comm2d, ierr )
     79    CALL MPI_ALLREDUCE( avpr_l(nzb,1,1), avpr(nzb,1,1), ngp_pr,  &
     80                    MPI_REAL, MPI_SUM, comm2d, ierr )
     81
    8582#else
     83    DO  l = 1, nbgp
     84       DO  j = nys, nyn
     85          DO  k = nzb, nzt + 1
     86
     87             avpr_l(k,1,l) = avpr_l(k,1,l) + u(k,j,i)
     88             avpr_l(k,2,l) = avpr_l(k,2,l) + v(k,j,i)
     89             avpr_l(k,3,l) = avpr_l(k,3,l) + w(k,j,i)
     90             avpr_l(k,4,l) = avpr_l(k,4,l) + pt(k,j,i)
     91             avpr_l(k,5,l) = avpr_l(k,5,l) + e(k,j,i)
     92
     93          ENDDO
     94       ENDDO
     95       i = i + 1
     96    ENDDO
     97   
    8698    avpr = avpr_l
    8799#endif
    88100
    89     avpr = avpr / ( ( ny + 1 ) * ( recycling_plane + 1 ) )
    90 
    91 !    WRITE (9,*) '*** averaged profiles'
    92 !    DO  k = nzb, nzt+1
    93 !       WRITE (9,'(F5.1,1X,F5.1,1X,F5.1,1X,F6.1,1X,F7.2)') avpr(k,1),avpr(k,2),avpr(k,3),avpr(k,4),avpr(k,5)
    94 !    ENDDO
    95 !    WRITE (9,*) ' '
    96 
     101    avpr = avpr / ( ny + 1 )
    97102!
    98103!-- Calculate the disturbances at the recycling plane
    … …  
    101106#if defined( __parallel )
    102107    IF ( myidx == id_recycling )  THEN
    103 
    104        DO  j = nys-1, nyn+1
     108       DO  l = 1, nbgp
     109          DO  j = nysg, nyng
     110             DO  k = nzb, nzt + 1
     111
     112                inflow_dist(k,j,1,l) = u(k,j,i+1) - avpr(k,1,l)
     113                inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
     114                inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
     115                inflow_dist(k,j,4,l) = pt(k,j,i)  - avpr(k,4,l)
     116                inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
     117             
     118            ENDDO
     119          ENDDO
     120          i = i + 1
     121       ENDDO
     122
     123    ENDIF
     124#else
     125    DO  l = 1, nbgp
     126       DO  j = nysg, nyng
    105127          DO  k = nzb, nzt+1
    106128
    107               inflow_dist(k,j,1) = u(k,j,i+1) - avpr(k,1)
    108               inflow_dist(k,j,2) = v(k,j,i)   - avpr(k,2)
    109               inflow_dist(k,j,3) = w(k,j,i)   - avpr(k,3)
    110               inflow_dist(k,j,4) = pt(k,j,i)  - avpr(k,4)
    111               inflow_dist(k,j,5) = e(k,j,i)   - avpr(k,5)
    112 
    113           ENDDO
    114        ENDDO
    115 
    116     ENDIF
    117 #else
    118     DO  j = nys-1, nyn+1
    119        DO  k = nzb, nzt+1
    120 
    121           inflow_dist(k,j,1) = u(k,j,i+1) - avpr(k,1)
    122           inflow_dist(k,j,2) = v(k,j,i)   - avpr(k,2)
    123           inflow_dist(k,j,3) = w(k,j,i)   - avpr(k,3)
    124           inflow_dist(k,j,4) = pt(k,j,i)  - avpr(k,4)
    125           inflow_dist(k,j,5) = e(k,j,i)   - avpr(k,5)
    126 
    127        ENDDO
     129             inflow_dist(k,j,1,l) = u(k,j,i+1) - avpr(k,1,l)
     130             inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
     131             inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
     132             inflow_dist(k,j,4,l) = pt(k,j,i)  - avpr(k,4,l)
     133             inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
     134             
     135          ENDDO
     136       ENDDO
     137       i = i + 1
    128138    ENDDO
    129139#endif
    … …  
    134144    IF ( myidx == id_recycling  .AND.  myidx /= id_inflow )  THEN
    135145
    136        CALL MPI_SEND( inflow_dist(nzb,nys-1,1), ngp_ifd, MPI_REAL, &
     146       CALL MPI_SEND( inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL, &
    137147                      id_inflow, 1, comm1dx, ierr )
    138148
    … …  
    140150
    141151       inflow_dist = 0.0
    142        CALL MPI_RECV( inflow_dist(nzb,nys-1,1), ngp_ifd, MPI_REAL, &
     152       CALL MPI_RECV( inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL, &
    143153                      id_recycling, 1, comm1dx, status, ierr )
    144154
    … …  
    150160    IF ( nxl == 0 )  THEN
    151161
    152        DO  j = nys-1, nyn+1
    153           DO  k = nzb, nzt+1
    154 
    155 !              WRITE (9,*) 'j=',j,' k=',k
    156 !              WRITE (9,*) 'mean_u = ', mean_inflow_profiles(k,1), ' dist_u = ',&
    157 !                          inflow_dist(k,j,1)
    158 !              WRITE (9,*) 'mean_v = ', mean_inflow_profiles(k,2), ' dist_v = ',&
    159 !                          inflow_dist(k,j,2)
    160 !              WRITE (9,*) 'mean_w = 0.0', ' dist_w = ',&
    161 !                          inflow_dist(k,j,3)
    162 !              WRITE (9,*) 'mean_pt = ', mean_inflow_profiles(k,4), ' dist_pt = ',&
    163 !                          inflow_dist(k,j,4)
    164 !              WRITE (9,*) 'mean_e = ', mean_inflow_profiles(k,5), ' dist_e = ',&
    165 !                          inflow_dist(k,j,5)
    166               u(k,j,0)   = mean_inflow_profiles(k,1) + &
    167                            inflow_dist(k,j,1) * inflow_damping_factor(k)
    168               v(k,j,-1)  = mean_inflow_profiles(k,2) + &
    169                            inflow_dist(k,j,2) * inflow_damping_factor(k)
    170               w(k,j,-1)  = inflow_dist(k,j,3) * inflow_damping_factor(k)
    171               pt(k,j,-1) = mean_inflow_profiles(k,4) + &
    172                            inflow_dist(k,j,4) * inflow_damping_factor(k)
    173               e(k,j,-1)  = mean_inflow_profiles(k,5) + &
    174                            inflow_dist(k,j,5) * inflow_damping_factor(k)
    175               e(k,j,-1)  = MAX( e(k,j,-1), 0.0 )
     162       DO  j = nysg, nyng
     163          DO  k = nzb, nzt + 1
     164
     165              u(k,j,-nbgp+1:0)   = mean_inflow_profiles(k,1) + &
     166                           inflow_dist(k,j,1,1:nbgp) * inflow_damping_factor(k)
     167              v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) + &
     168                           inflow_dist(k,j,2,1:nbgp) * inflow_damping_factor(k)
     169              w(k,j,-nbgp:-1)  = inflow_dist(k,j,3,1:nbgp) * inflow_damping_factor(k)
     170              pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) + &
     171                           inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
     172              e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) + &
     173                           inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k)
     174              e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0 )
    176175
    177176          ENDDO

  • TabularUnified palm/trunk/SOURCE/init_1d_model.f90

    r392 r667  
    6363              l1d_m(nzb:nzt+1),  rif1d(nzb:nzt+1),   te_e(nzb:nzt+1),  &
    6464              te_em(nzb:nzt+1),  te_u(nzb:nzt+1),    te_um(nzb:nzt+1), &
    65               te_v(nzb:nzt+1),   te_vm(nzb:nzt+1),   u1d(nzb:nzt+1),   &
     65              te_v(nzb:nzt+1),   te_vm(nzb:nzt+1),    u1d(nzb:nzt+1),   &
    6666              u1d_m(nzb:nzt+1),  u1d_p(nzb:nzt+1),   v1d(nzb:nzt+1),   &
    6767              v1d_m(nzb:nzt+1),  v1d_p(nzb:nzt+1) )
    … …  
    385385!--       boundary condition applies to u and v.
    386386!--       The boundary condition for e is set further below ( (u*/cm)**2 ).
    387           u1d_p(nzb) = -u1d_p(nzb+1)
    388           v1d_p(nzb) = -v1d_p(nzb+1)
     387         ! u1d_p(nzb) = -u1d_p(nzb+1)
     388         ! v1d_p(nzb) = -v1d_p(nzb+1)
     389
     390          u1d_p(nzb) = 0.0
     391          v1d_p(nzb) = 0.0
    389392
    390393!

  • TabularUnified palm/trunk/SOURCE/init_3d_model.f90

    r631 r667  
    77! Current revisions:
    88! -----------------
    9 ! Bugfix: type conversion of '1' to 64bit for the MAX function (ngp_3d_inner)
     9! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
     10! allocation of arrays. Calls of exchange_horiz are modified.
     11! Call ws_init to initialize arrays needed for statistical evaluation and
     12! optimization when ws-scheme is used.
     13!
     14!
     15! Initial volume flow is now calculated by using the variable hom_sum.
     16! Therefore the correction of initial volume flow for non-flat topography
     17! removed (removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc)
     18!
     19! Changed surface boundary conditions for u and v in case of ibc_uv_b == 0 from
     20! mirror bc to dirichlet boundary conditions (u=v=0), so that k=nzb is
     21! representative for the height z0
     22!
     23! Bugfix: type conversion of '1' to 64bit for the MAX function (ngp_3d_inner)
    1024!
    1125! Former revisions:
    … …  
    101115!------------------------------------------------------------------------------!
    102116
     117    USE advec_ws
    103118    USE arrays_3d
    104119    USE averaging
    … …  
    147162              ngp_2dh_s_inner(nzb:nzt+1,0:statistic_regions),               &
    148163              ngp_2dh_s_inner_l(nzb:nzt+1,0:statistic_regions),             &
    149               rmask(nys-1:nyn+1,nxl-1:nxr+1,0:statistic_regions),           &
     164              rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions),           &
    150165              sums(nzb:nzt+1,pr_palm+max_pr_user),                          &
    151166              sums_l(nzb:nzt+1,pr_palm+max_pr_user,0:threads_per_task-1),   &
    … …  
    154169              sums_wsts_bc_l(nzb:nzt+1,0:statistic_regions),                &
    155170              ts_value(dots_max,0:statistic_regions) )
    156     ALLOCATE( km_damp_x(nxl-1:nxr+1), km_damp_y(nys-1:nyn+1) )
    157 
    158     ALLOCATE( rif_1(nys-1:nyn+1,nxl-1:nxr+1), shf_1(nys-1:nyn+1,nxl-1:nxr+1), &
    159               ts(nys-1:nyn+1,nxl-1:nxr+1), tswst_1(nys-1:nyn+1,nxl-1:nxr+1),  &
    160               us(nys-1:nyn+1,nxl-1:nxr+1), usws_1(nys-1:nyn+1,nxl-1:nxr+1),   &
    161               uswst_1(nys-1:nyn+1,nxl-1:nxr+1),                               &
    162               vsws_1(nys-1:nyn+1,nxl-1:nxr+1),                                &
    163               vswst_1(nys-1:nyn+1,nxl-1:nxr+1), z0(nys-1:nyn+1,nxl-1:nxr+1) )
     171    ALLOCATE( km_damp_x(nxlg:nxrg), km_damp_y(nysg:nyng) )
     172
     173    ALLOCATE( rif_1(nysg:nyng,nxlg:nxrg), shf_1(nysg:nyng,nxlg:nxrg), &
     174              ts(nysg:nyng,nxlg:nxrg), tswst_1(nysg:nyng,nxlg:nxrg),  &
     175              us(nysg:nyng,nxlg:nxrg), usws_1(nysg:nyng,nxlg:nxrg),   &
     176              uswst_1(nysg:nyng,nxlg:nxrg),                               &
     177              vsws_1(nysg:nyng,nxlg:nxrg),                                &
     178              vswst_1(nysg:nyng,nxlg:nxrg), z0(nysg:nyng,nxlg:nxrg) )
    164179
    165180    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    166181!
    167182!--    Leapfrog scheme needs two timelevels of diffusion quantities
    168        ALLOCATE( rif_2(nys-1:nyn+1,nxl-1:nxr+1),   &
    169                  shf_2(nys-1:nyn+1,nxl-1:nxr+1),   &
    170                  tswst_2(nys-1:nyn+1,nxl-1:nxr+1), &
    171                  usws_2(nys-1:nyn+1,nxl-1:nxr+1),  &
    172                  uswst_2(nys-1:nyn+1,nxl-1:nxr+1), &
    173                  vswst_2(nys-1:nyn+1,nxl-1:nxr+1), &
    174                  vsws_2(nys-1:nyn+1,nxl-1:nxr+1) )
     183       ALLOCATE( rif_2(nysg:nyng,nxlg:nxrg),   &
     184                 shf_2(nysg:nyng,nxlg:nxrg),   &
     185                 tswst_2(nysg:nyng,nxlg:nxrg), &
     186                 usws_2(nysg:nyng,nxlg:nxrg),  &
     187                 uswst_2(nysg:nyng,nxlg:nxrg), &
     188                 vswst_2(nysg:nyng,nxlg:nxrg), &
     189                 vsws_2(nysg:nyng,nxlg:nxrg) )
    175190    ENDIF
    176191
    177192    ALLOCATE( d(nzb+1:nzta,nys:nyna,nxl:nxra),         &
    178               e_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    179               e_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    180               e_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    181               kh_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    182               km_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    183               p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),    &
    184               pt_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    185               pt_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    186               pt_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    187               tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    188               u_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    189               u_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    190               u_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    191               v_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    192               v_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    193               v_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    194               w_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    195               w_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    196               w_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     193              e_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     194              e_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     195              e_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     196              kh_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     197              km_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     198              p(nzb:nzt+1,nysg:nyng,nxlg:nxrg),    &
     199              pt_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     200              pt_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     201              pt_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     202              tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     203              u_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     204              u_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     205              u_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     206              v_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     207              v_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     208              v_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     209              w_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     210              w_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     211              w_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    197212
    198213    IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    199        ALLOCATE( kh_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    200                  km_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     214       ALLOCATE( kh_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     215                 km_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    201216    ENDIF
    202217
    … …  
    204219!
    205220!--    2D-humidity/scalar arrays
    206        ALLOCATE ( qs(nys-1:nyn+1,nxl-1:nxr+1),     &
    207                   qsws_1(nys-1:nyn+1,nxl-1:nxr+1), &
    208                   qswst_1(nys-1:nyn+1,nxl-1:nxr+1) )
     221       ALLOCATE ( qs(nysg:nyng,nxlg:nxrg),     &
     222                  qsws_1(nysg:nyng,nxlg:nxrg), &
     223                  qswst_1(nysg:nyng,nxlg:nxrg) )
    209224
    210225       IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    211           ALLOCATE( qsws_2(nys-1:nyn+1,nxl-1:nxr+1), &
    212                     qswst_2(nys-1:nyn+1,nxl-1:nxr+1) )
     226          ALLOCATE( qsws_2(nysg:nyng,nxlg:nxrg), &
     227                    qswst_2(nysg:nyng,nxlg:nxrg) )
    213228       ENDIF
    214229!
    215230!--    3D-humidity/scalar arrays
    216        ALLOCATE( q_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    217                  q_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    218                  q_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     231       ALLOCATE( q_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     232                 q_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     233                 q_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    219234
    220235!
    221236!--    3D-arrays needed for humidity only
    222237       IF ( humidity )  THEN
    223           ALLOCATE( vpt_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     238          ALLOCATE( vpt_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    224239
    225240          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    226              ALLOCATE( vpt_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     241             ALLOCATE( vpt_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    227242          ENDIF
    228243
    … …  
    230245!
    231246!--          Liquid water content
    232              ALLOCATE ( ql_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     247             ALLOCATE ( ql_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    233248!
    234249!--          Precipitation amount and rate (only needed if output is switched)
    235              ALLOCATE( precipitation_amount(nys-1:nyn+1,nxl-1:nxr+1), &
    236                        precipitation_rate(nys-1:nyn+1,nxl-1:nxr+1) )
     250             ALLOCATE( precipitation_amount(nysg:nyng,nxlg:nxrg), &
     251                       precipitation_rate(nysg:nyng,nxlg:nxrg) )
    237252          ENDIF
    238253
    … …  
    241256!--          Liquid water content, change in liquid water content,
    242257!--          real volume of particles (with weighting), volume of particles
    243              ALLOCATE ( ql_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    244                         ql_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    245                         ql_v(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    246                         ql_vp(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     258             ALLOCATE ( ql_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     259                        ql_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     260                        ql_v(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     261                        ql_vp(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    247262          ENDIF
    248263
    … …  
    252267
    253268    IF ( ocean )  THEN
    254        ALLOCATE( saswsb_1(nys-1:nyn+1,nxl-1:nxr+1), &
    255                  saswst_1(nys-1:nyn+1,nxl-1:nxr+1) )
    256        ALLOCATE( prho_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
    257                  rho_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    258                  sa_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),   &
    259                  sa_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),   &
    260                  sa_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     269       ALLOCATE( saswsb_1(nysg:nyng,nxlg:nxrg), &
     270                 saswst_1(nysg:nyng,nxlg:nxrg) )
     271       ALLOCATE( prho_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
     272                 rho_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     273                 sa_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),   &
     274                 sa_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),   &
     275                 sa_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    261276       prho => prho_1
    262277       rho  => rho_1  ! routines calc_mean_profile and diffusion_e require
    263278                      ! density to be apointer
    264279       IF ( humidity_remote )  THEN
    265           ALLOCATE( qswst_remote(nys-1:nyn+1,nxl-1:nxr+1) )
     280          ALLOCATE( qswst_remote(nysg:nyng,nxlg:nxrg))
    266281          qswst_remote = 0.0
    267282       ENDIF
    … …  
    272287!-- particle velocities
    273288    IF ( use_sgs_for_particles )  THEN
    274        ALLOCATE ( diss(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     289       ALLOCATE ( diss(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    275290    ELSE
    276291       ALLOCATE ( diss(2,2,2) )  ! required because diss is used as a
    … …  
    288303!-- 3D-arrays for the leaf area density and the canopy drag coefficient
    289304    IF ( plant_canopy ) THEN
    290        ALLOCATE ( lad_s(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    291                   lad_u(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    292                   lad_v(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    293                   lad_w(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),  &
    294                   cdc(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     305       ALLOCATE ( lad_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     306                  lad_u(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     307                  lad_v(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     308                  lad_w(nzb:nzt+1,nysg:nyng,nxlg:nxrg),  &
     309                  cdc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    295310
    296311       IF ( passive_scalar ) THEN
    297           ALLOCATE ( sls(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),   &
    298                      sec(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     312          ALLOCATE ( sls(nzb:nzt+1,nysg:nyng,nxlg:nxrg),   &
     313                     sec(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    299314       ENDIF
    300315
    301316       IF ( cthf /= 0.0 ) THEN
    302           ALLOCATE ( lai(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),   &
    303                      canopy_heat_flux(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     317          ALLOCATE ( lai(nzb:nzt+1,nysg:nyng,nxlg:nxrg),   &
     318                     canopy_heat_flux(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    304319       ENDIF
    305320
    … …  
    309324!-- 4D-array for storing the Rif-values at vertical walls
    310325    IF ( topography /= 'flat' )  THEN
    311        ALLOCATE( rif_wall(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1,1:4) )
     326       ALLOCATE( rif_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:4) )
    312327       rif_wall = 0.0
    313     ENDIF
    314 
    315 !
    316 !-- Velocities at nzb+1 needed for volume flow control
    317     IF ( conserve_volume_flow )  THEN
    318        ALLOCATE( u_nzb_p1_for_vfc(nys:nyn), v_nzb_p1_for_vfc(nxl:nxr) )
    319        u_nzb_p1_for_vfc = 0.0
    320        v_nzb_p1_for_vfc = 0.0
    321328    ENDIF
    322329
    … …  
    325332!-- are needed for radiation boundary conditions
    326333    IF ( outflow_l )  THEN
    327        ALLOCATE( u_m_l(nzb:nzt+1,nys-1:nyn+1,1:2), &
    328                  v_m_l(nzb:nzt+1,nys-1:nyn+1,0:1), &
    329                  w_m_l(nzb:nzt+1,nys-1:nyn+1,0:1) )
     334       ALLOCATE( u_m_l(nzb:nzt+1,nysg:nyng,1:2), &
     335                 v_m_l(nzb:nzt+1,nysg:nyng,0:1), &
     336                 w_m_l(nzb:nzt+1,nysg:nyng,0:1) )
    330337    ENDIF
    331338    IF ( outflow_r )  THEN
    332        ALLOCATE( u_m_r(nzb:nzt+1,nys-1:nyn+1,nx-1:nx), &
    333                  v_m_r(nzb:nzt+1,nys-1:nyn+1,nx-1:nx), &
    334                  w_m_r(nzb:nzt+1,nys-1:nyn+1,nx-1:nx) )
     339       ALLOCATE( u_m_r(nzb:nzt+1,nysg:nyng,nx-1:nx), &
     340                 v_m_r(nzb:nzt+1,nysg:nyng,nx-1:nx), &
     341                 w_m_r(nzb:nzt+1,nysg:nyng,nx-1:nx) )
    335342    ENDIF
    336343    IF ( outflow_l  .OR.  outflow_r )  THEN
    337        ALLOCATE( c_u(nzb:nzt+1,nys-1:nyn+1), c_v(nzb:nzt+1,nys-1:nyn+1), &
    338                  c_w(nzb:nzt+1,nys-1:nyn+1) )
     344       ALLOCATE( c_u(nzb:nzt+1,nysg:nyng), c_v(nzb:nzt+1,nysg:nyng), &
     345                 c_w(nzb:nzt+1,nysg:nyng) )
    339346    ENDIF
    340347    IF ( outflow_s )  THEN
    341        ALLOCATE( u_m_s(nzb:nzt+1,0:1,nxl-1:nxr+1), &
    342                  v_m_s(nzb:nzt+1,1:2,nxl-1:nxr+1), &
    343                  w_m_s(nzb:nzt+1,0:1,nxl-1:nxr+1) )
     348       ALLOCATE( u_m_s(nzb:nzt+1,0:1,nxlg:nxrg), &
     349                 v_m_s(nzb:nzt+1,1:2,nxlg:nxrg), &
     350                 w_m_s(nzb:nzt+1,0:1,nxlg:nxrg) )
    344351    ENDIF
    345352    IF ( outflow_n )  THEN
    346        ALLOCATE( u_m_n(nzb:nzt+1,ny-1:ny,nxl-1:nxr+1), &
    347                  v_m_n(nzb:nzt+1,ny-1:ny,nxl-1:nxr+1), &
    348                  w_m_n(nzb:nzt+1,ny-1:ny,nxl-1:nxr+1) )
     353       ALLOCATE( u_m_n(nzb:nzt+1,ny-1:ny,nxlg:nxrg), &
     354                 v_m_n(nzb:nzt+1,ny-1:ny,nxlg:nxrg), &
     355                 w_m_n(nzb:nzt+1,ny-1:ny,nxlg:nxrg) )
    349356    ENDIF
    350357    IF ( outflow_s  .OR.  outflow_n )  THEN
    351        ALLOCATE( c_u(nzb:nzt+1,nxl-1:nxr+1), c_v(nzb:nzt+1,nxl-1:nxr+1), &
    352                  c_w(nzb:nzt+1,nxl-1:nxr+1) )
     358       ALLOCATE( c_u(nzb:nzt+1,nxlg:nxrg), c_v(nzb:nzt+1,nxlg:nxrg), &
     359                 c_w(nzb:nzt+1,nxlg:nxrg) )
    353360    ENDIF
    354361
    … …  
    435442!
    436443!--       Transfer initial profiles to the arrays of the 3D model
    437           DO  i = nxl-1, nxr+1
    438              DO  j = nys-1, nyn+1
     444          DO  i = nxlg, nxrg
     445             DO  j = nysg, nyng
    439446                e(:,j,i)  = e1d
    440447                kh(:,j,i) = kh1d
    … …  
    447454
    448455          IF ( humidity  .OR.  passive_scalar )  THEN
    449              DO  i = nxl-1, nxr+1
    450                 DO  j = nys-1, nyn+1
     456             DO  i = nxlg, nxrg
     457                DO  j = nysg, nyng
    451458                   q(:,j,i) = q_init
    452459                ENDDO
    … …  
    455462
    456463          IF ( .NOT. constant_diffusion )  THEN
    457              DO  i = nxl-1, nxr+1
    458                 DO  j = nys-1, nyn+1
     464             DO  i = nxlg, nxrg
     465                DO  j = nysg, nyng
    459466                   e(:,j,i)  = e1d
    460467                ENDDO
    … …  
    505512                ENDDO
    506513             ENDDO
    507              IF ( conserve_volume_flow )  THEN
    508                 IF ( nxr == nx )  THEN
    509                    DO  j = nys, nyn
    510                       DO  k = nzb + 1, nzb_u_inner(j,nx)
    511                          u_nzb_p1_for_vfc(j) = u_nzb_p1_for_vfc(j) + &
    512                                                u1d(k) * dzu(k)
    513                       ENDDO
    514                    ENDDO
    515                 ENDIF
    516                 IF ( nyn == ny )  THEN
    517                    DO  i = nxl, nxr
    518                       DO  k = nzb + 1, nzb_v_inner(ny,i)
    519                          v_nzb_p1_for_vfc(i) = v_nzb_p1_for_vfc(i) + &
    520                                                v1d(k) * dzu(k)
    521                       ENDDO
    522                    ENDDO
    523                 ENDIF
    524              ENDIF
     514             
    525515!
    526516!--          WARNING: The extra boundary conditions set after running the
    … …  
    530520!--          ---------  advection scheme: keep u and v zero one layer below
    531521!--                     the topography.
    532              IF ( ibc_uv_b == 0 )  THEN
    533 !
    534 !--             Satisfying the Dirichlet condition with an extra layer below
    535 !--             the surface where the u and v component change their sign.
    536                 DO  i = nxl-1, nxr+1
    537                    DO  j = nys-1, nyn+1
    538                       IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = -u(1,j,i)
    539                       IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = -v(1,j,i)
    540                    ENDDO
    541                 ENDDO
    542 
    543              ELSE
     522!
     523!--           Following was removed, because mirror boundary condition are
     524!--           replaced by dirichlet boundary conditions
     525!
     526!             IF ( ibc_uv_b == 0 )  THEN
     527!!
     528!!--             Satisfying the Dirichlet condition with an extra layer below
     529!!--             the surface where the u and v component change their sign.
     530!                DO  i = nxl-1, nxr+1
     531!                   DO  j = nys-1, nyn+1
     532!                      IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = -u(1,j,i)
     533!                      IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = -v(1,j,i)
     534!                   ENDDO
     535!                ENDDO
     536!
     537!             ELSE
     538             IF ( ibc_uv_b == 1 )  THEN
    544539!
    545540!--             Neumann condition
    … …  
    560555!--       Use constructed initial profiles (velocity constant with height,
    561556!--       temperature profile with constant gradient)
    562           DO  i = nxl-1, nxr+1
    563              DO  j = nys-1, nyn+1
     557          DO  i = nxlg, nxrg
     558             DO  j = nysg, nyng
    564559                pt(:,j,i) = pt_init
    565560                u(:,j,i)  = u_init
    … …  
    574569!--       in the limiting formula!). The original values are stored to be later
    575570!--       used for volume flow control.
    576           DO  i = nxl-1, nxr+1
    577              DO  j = nys-1, nyn+1
     571          DO  i = nxlg, nxrg
     572             DO  j = nysg, nyng
    578573                u(nzb:nzb_u_inner(j,i)+1,j,i) = 0.0
    579574                v(nzb:nzb_v_inner(j,i)+1,j,i) = 0.0
    580575             ENDDO
    581576          ENDDO
    582           IF ( conserve_volume_flow )  THEN
    583              IF ( nxr == nx )  THEN
    584                 DO  j = nys, nyn
    585                    DO  k = nzb + 1, nzb_u_inner(j,nx) + 1
    586                       u_nzb_p1_for_vfc(j) = u_nzb_p1_for_vfc(j) + &
    587                                             u_init(k) * dzu(k)
    588                    ENDDO
    589                 ENDDO
    590              ENDIF
    591              IF ( nyn == ny )  THEN
    592                 DO  i = nxl, nxr
    593                    DO  k = nzb + 1, nzb_v_inner(ny,i) + 1
    594                       v_nzb_p1_for_vfc(i) = v_nzb_p1_for_vfc(i) + &
    595                                             v_init(k) * dzu(k)
    596                    ENDDO
    597                 ENDDO
    598              ENDIF
    599           ENDIF
    600577
    601578          IF ( humidity  .OR.  passive_scalar )  THEN
    602              DO  i = nxl-1, nxr+1
    603                 DO  j = nys-1, nyn+1
     579             DO  i = nxlg, nxrg
     580                DO  j = nysg, nyng
    604581                   q(:,j,i) = q_init
    605582                ENDDO
    … …  
    608585
    609586          IF ( ocean )  THEN
    610              DO  i = nxl-1, nxr+1
    611                 DO  j = nys-1, nyn+1
     587             DO  i = nxlg, nxrg
     588                DO  j = nysg, nyng
    612589                   sa(:,j,i) = sa_init
    613590                ENDDO
    … …  
    660637
    661638       ENDIF
     639!
     640!--    Bottom boundary
     641       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2  )  THEN
     642          u(nzb,:,:) = 0.0
     643          v(nzb,:,:) = 0.0
     644       ENDIF
    662645
    663646!
    … …  
    683666       hom(:,1,5,:) = SPREAD( u(:,nys,nxl), 2, statistic_regions+1 )
    684667       hom(:,1,6,:) = SPREAD( v(:,nys,nxl), 2, statistic_regions+1 )
    685        IF ( ibc_uv_b == 0 )  THEN
    686           hom(nzb,1,5,:) = -hom(nzb+1,1,5,:)  ! due to satisfying the Dirichlet
    687           hom(nzb,1,6,:) = -hom(nzb+1,1,6,:)  ! condition with an extra layer
    688               ! below the surface where the u and v component change their sign
     668       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2)  THEN
     669          hom(nzb,1,5,:) = 0.0   
     670          hom(nzb,1,6,:) = 0.0 
    689671       ENDIF
    690672       hom(:,1,7,:)  = SPREAD( pt(:,nys,nxl), 2, statistic_regions+1 )
    … …  
    733715!--             Over topography surface_heatflux is replaced by wall_heatflux(0)
    734716                IF ( TRIM( topography ) /= 'flat' )  THEN
    735                    DO  i = nxl-1, nxr+1
    736                       DO  j = nys-1, nyn+1
     717                   DO  i = nxlg, nxrg
     718                      DO  j = nysg, nyng
    737719                         IF ( nzb_s_inner(j,i) /= 0 )  THEN
    738720                            shf(j,i) = wall_heatflux(0)
    … …  
    755737                IF ( TRIM( topography ) /= 'flat' )  THEN
    756738                   wall_qflux = wall_humidityflux
    757                    DO  i = nxl-1, nxr+1
    758                       DO  j = nys-1, nyn+1
     739                   DO  i = nxlg, nxrg
     740                      DO  j = nysg, nyng
    759741                         IF ( nzb_s_inner(j,i) /= 0 )  THEN
    760742                            qsws(j,i) = wall_qflux(0)
    … …  
    827809       ENDIF
    828810
    829 !
    830 !--    Calculate the initial volume flow at the right and north boundary
    831        IF ( conserve_volume_flow )  THEN
    832 
    833           volume_flow_initial_l = 0.0
    834           volume_flow_area_l    = 0.0
    835  
    836           IF ( nxr == nx )  THEN
    837              DO  j = nys, nyn
    838                 DO  k = nzb_2d(j,nx) + 1, nzt
    839                    volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
    840                                               u(k,j,nx) * dzu(k)
    841                    volume_flow_area_l(1)    = volume_flow_area_l(1) + dzu(k)
    842                 ENDDO
    843 !
    844 !--             Correction if velocity at nzb+1 has been set zero further above
    845                 volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
    846                                            u_nzb_p1_for_vfc(j)
    847              ENDDO
    848           ENDIF
    849 
    850           IF ( nyn == ny )  THEN
    851              DO  i = nxl, nxr
    852                 DO  k = nzb_2d(ny,i) + 1, nzt 
    853                    volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
    854                                               v(k,ny,i) * dzu(k)
    855                    volume_flow_area_l(2)    = volume_flow_area_l(2) + dzu(k)
    856                 ENDDO
    857 !
    858 !--             Correction if velocity at nzb+1 has been set zero further above
    859                 volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
    860                                            v_nzb_p1_for_vfc(i)
    861              ENDDO
    862           ENDIF
    863 
    864 #if defined( __parallel )
    865           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    866           CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1),&
    867                               2, MPI_REAL, MPI_SUM, comm2d, ierr )
    868           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    869           CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1),      &
    870                               2, MPI_REAL, MPI_SUM, comm2d, ierr )
    871 #else
    872           volume_flow_initial = volume_flow_initial_l
    873           volume_flow_area    = volume_flow_area_l
    874 #endif
    875 !
    876 !--       In case of 'bulk_velocity' mode, volume_flow_initial is overridden
    877 !--       and calculated from u|v_bulk instead.
    878           IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
    879              volume_flow_initial(1) = u_bulk * volume_flow_area(1)
    880              volume_flow_initial(2) = v_bulk * volume_flow_area(2)
    881           ENDIF
    882 
    883        ENDIF
    884811
    885812!
    … …  
    968895          sa_p  = sa
    969896       ENDIF
    970 
     897       
    971898
    972899    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.    &
    973              TRIM( initializing_actions ) == 'cyclic_fill' )  &
     900         TRIM( initializing_actions ) == 'cyclic_fill' )  &
    974901    THEN
    975902!
    … …  
    978905       IF ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
    979906
    980           WRITE (9,*) 'before read_parts_of_var_list'
    981           CALL local_flush( 9 )
    982907          CALL read_parts_of_var_list
    983           WRITE (9,*) 'after read_parts_of_var_list'
    984           CALL local_flush( 9 )
    985908          CALL close_file( 13 )
    986909
    … …  
    1002925!--          conditions are used)
    1003926             IF ( inflow_l )  THEN
    1004                 DO  j = nys-1, nyn+1
     927                DO  j = nysg, nyng
    1005928                   DO  k = nzb, nzt+1
    1006                       u(k,j,-1)  = mean_inflow_profiles(k,1)
    1007                       v(k,j,-1)  = mean_inflow_profiles(k,2)
    1008                       w(k,j,-1)  = 0.0
    1009                       pt(k,j,-1) = mean_inflow_profiles(k,4)
    1010                       e(k,j,-1)  = mean_inflow_profiles(k,5)
     929                      u(k,j,nxlg:-1)  = mean_inflow_profiles(k,1)
     930                      v(k,j,nxlg:-1)  = mean_inflow_profiles(k,2)
     931                      w(k,j,nxlg:-1)  = 0.0
     932                      pt(k,j,nxlg:-1) = mean_inflow_profiles(k,4)
     933                      e(k,j,nxlg:-1)  = mean_inflow_profiles(k,5)
    1011934                   ENDDO
    1012935                ENDDO
    … …  
    1064987!
    1065988!--    Read binary data from restart file
    1066           WRITE (9,*) 'before read_3d_binary'
    1067           CALL local_flush( 9 )
     989
    1068990       CALL read_3d_binary
    1069           WRITE (9,*) 'after read_3d_binary'
    1070           CALL local_flush( 9 )
    1071991
    1072992!
    … …  
    1074994       IF ( TRIM( initializing_actions ) == 'cyclic_fill' .AND.  &
    1075995            topography /= 'flat' )  THEN
    1076 !
    1077 !--       Correction of initial volume flow
    1078           IF ( conserve_volume_flow )  THEN
    1079              IF ( nxr == nx )  THEN
    1080                 DO  j = nys, nyn
    1081                    DO  k = nzb + 1, nzb_u_inner(j,nx)
    1082                       u_nzb_p1_for_vfc(j) = u_nzb_p1_for_vfc(j) + &
    1083                                             u(k,j,nx) * dzu(k)
    1084                    ENDDO
    1085                 ENDDO
    1086              ENDIF
    1087              IF ( nyn == ny )  THEN
    1088                 DO  i = nxl, nxr
    1089                    DO  k = nzb + 1, nzb_v_inner(ny,i)
    1090                       v_nzb_p1_for_vfc(i) = v_nzb_p1_for_vfc(i) + &
    1091                                             v(k,ny,i) * dzu(k)
    1092                    ENDDO
    1093                 ENDDO
    1094              ENDIF
    1095           ENDIF
    1096 
    1097996!
    1098997!--       Inside buildings set velocities and TKE back to zero.
    … …  
    1100999!--       maybe revise later.
    11011000          IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1102              DO  i = nxl-1, nxr+1
    1103                 DO  j = nys-1, nyn+1
     1001             DO  i = nxlg, nxrg
     1002                DO  j = nysg, nyng
    11041003                   u  (nzb:nzb_u_inner(j,i),j,i) = 0.0
    11051004                   v  (nzb:nzb_v_inner(j,i),j,i) = 0.0
    … …  
    11181017             ENDDO
    11191018          ELSE
    1120              DO  i = nxl-1, nxr+1
    1121                 DO  j = nys-1, nyn+1
     1019             DO  i = nxlg, nxrg
     1020                DO  j = nysg, nyng
    11221021                   u  (nzb:nzb_u_inner(j,i),j,i) = 0.0
    11231022                   v  (nzb:nzb_v_inner(j,i),j,i) = 0.0
    … …  
    11391038
    11401039!
    1141 !--    Calculate the initial volume flow at the right and north boundary
    1142        IF ( conserve_volume_flow  .AND.  &
    1143             TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
    1144 
    1145           volume_flow_initial_l = 0.0
    1146           volume_flow_area_l    = 0.0
    1147  
    1148           IF ( nxr == nx )  THEN
    1149              DO  j = nys, nyn
    1150                 DO  k = nzb_2d(j,nx) + 1, nzt
    1151                    volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
    1152                                               u(k,j,nx) * dzu(k)
    1153                    volume_flow_area_l(1)    = volume_flow_area_l(1) + dzu(k)
    1154                 ENDDO
    1155 !
    1156 !--             Correction if velocity inside buildings has been set to zero
    1157 !--             further above
    1158                 volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
    1159                                            u_nzb_p1_for_vfc(j)
    1160              ENDDO
    1161           ENDIF
    1162 
    1163           IF ( nyn == ny )  THEN
    1164              DO  i = nxl, nxr
    1165                 DO  k = nzb_2d(ny,i) + 1, nzt 
    1166                    volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
    1167                                               v(k,ny,i) * dzu(k)
    1168                    volume_flow_area_l(2)    = volume_flow_area_l(2) + dzu(k)
    1169                 ENDDO
    1170 !
    1171 !--             Correction if velocity inside buildings has been set to zero
    1172 !--             further above
    1173                 volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
    1174                                            v_nzb_p1_for_vfc(i)
    1175              ENDDO
    1176           ENDIF
    1177 
    1178 #if defined( __parallel )
    1179           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    1180           CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1),&
    1181                               2, MPI_REAL, MPI_SUM, comm2d, ierr )
    1182           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    1183           CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1),      &
    1184                               2, MPI_REAL, MPI_SUM, comm2d, ierr )
    1185 #else
    1186           volume_flow_initial = volume_flow_initial_l
    1187           volume_flow_area    = volume_flow_area_l
    1188 #endif 
    1189        ENDIF
    1190 
    1191 
    1192 !
    11931040!--    Calculate initial temperature field and other constants used in case
    11941041!--    of a sloping surface
    … …  
    12431090          w_m_n(:,:,:) = w(:,ny-1:ny,:)
    12441091       ENDIF
    1245 
    1246     ENDIF
    1247 
     1092       
     1093    ENDIF
     1094!
     1095!-- Calculate the initial volume flow at the right and north boundary
     1096    IF ( conserve_volume_flow ) THEN
     1097
     1098       volume_flow_initial_l = 0.0
     1099       volume_flow_area_l    = 0.0
     1100 
     1101       IF  ( TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
     1102
     1103          IF ( nxr == nx )  THEN
     1104             DO  j = nys, nyn
     1105                DO  k = nzb_2d(j,nx) + 1, nzt
     1106                   volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
     1107                                              hom_sum(k,1,0) * dzw(k)
     1108                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)
     1109                ENDDO
     1110             ENDDO
     1111          ENDIF
     1112         
     1113          IF ( nyn == ny )  THEN
     1114             DO  i = nxl, nxr
     1115                DO  k = nzb_2d(ny,i) + 1, nzt 
     1116                   volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
     1117                                               hom_sum(k,2,0) * dzw(k)
     1118                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)
     1119                ENDDO
     1120             ENDDO
     1121          ENDIF
     1122
     1123       ELSEIF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
     1124
     1125          IF ( nxr == nx )  THEN
     1126             DO  j = nys, nyn
     1127                DO  k = nzb_2d(j,nx) + 1, nzt
     1128                   volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
     1129                                               u(k,j,nx) * dzw(k)
     1130                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)
     1131                ENDDO
     1132             ENDDO
     1133          ENDIF
     1134         
     1135          IF ( nyn == ny )  THEN
     1136             DO  i = nxl, nxr
     1137                DO  k = nzb_2d(ny,i) + 1, nzt 
     1138                   volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
     1139                                              v(k,ny,i) * dzw(k)
     1140                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)
     1141                ENDDO
     1142             ENDDO
     1143          ENDIF
     1144
     1145       ENDIF
     1146
     1147#if defined( __parallel )
     1148          CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1),&
     1149                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
     1150          CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1),      &
     1151                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
     1152
     1153          CALL MPI_ALLREDUCE( volume_flow_initial_l(2), volume_flow_initial(2),&
     1154                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
     1155          CALL MPI_ALLREDUCE( volume_flow_area_l(2), volume_flow_area(2),      &
     1156                              2, MPI_REAL, MPI_SUM, comm2d, ierr )
     1157
     1158#else
     1159          volume_flow_initial = volume_flow_initial_l
     1160          volume_flow_area    = volume_flow_area_l
     1161#endif 
     1162
     1163!
     1164!--       In case of 'bulk_velocity' mode, volume_flow_initial is overridden
     1165!--       and calculated from u|v_bulk instead.
     1166          IF ( TRIM( conserve_volume_flow_mode ) == 'bulk_velocity' )  THEN
     1167             volume_flow_initial(1) = u_bulk * volume_flow_area(1)
     1168             volume_flow_initial(2) = v_bulk * volume_flow_area(2)
     1169          ENDIF
     1170
     1171       ENDIF
    12481172!
    12491173!-- Initialization of the leaf area density
    … …  
    12541178          CASE( 'block' )
    12551179
    1256              DO  i = nxl-1, nxr+1
    1257                 DO  j = nys-1, nyn+1
     1180             DO  i = nxlg, nxrg
     1181                DO  j = nysg, nyng
    12581182                   lad_s(:,j,i) = lad(:)
    12591183                   cdc(:,j,i)   = drag_coefficient
    … …  
    12771201          END SELECT
    12781202
    1279        CALL exchange_horiz( lad_s )
    1280        CALL exchange_horiz( cdc )
     1203       CALL exchange_horiz( lad_s, nbgp )
     1204       CALL exchange_horiz( cdc, nbgp )
    12811205
    12821206       IF ( passive_scalar ) THEN
    1283           CALL exchange_horiz( sls )
    1284           CALL exchange_horiz( sec )
     1207          CALL exchange_horiz( sls, nbgp )
     1208          CALL exchange_horiz( sec, nbgp )
    12851209       ENDIF
    12861210
    … …  
    13111235       lad_w(nzt+1,:,:)     = lad_w(nzt,:,:)
    13121236
    1313        CALL exchange_horiz( lad_u )
    1314        CALL exchange_horiz( lad_v )
    1315        CALL exchange_horiz( lad_w )
     1237       CALL exchange_horiz( lad_u, nbgp )
     1238       CALL exchange_horiz( lad_v, nbgp )
     1239       CALL exchange_horiz( lad_w, nbgp )
    13161240
    13171241!
    … …  
    13221246!--       integration of the leaf area density
    13231247          lai(:,:,:) = 0.0
    1324           DO  i = nxl-1, nxr+1
    1325              DO  j = nys-1, nyn+1
     1248          DO  i = nxlg, nxrg
     1249             DO  j = nysg, nyng
    13261250                DO  k = pch_index-1, 0, -1
    13271251                   lai(k,j,i) = lai(k+1,j,i) +                   &
    … …  
    13391263!--       Evaluation of the upward kinematic vertical heat flux within the
    13401264!--       canopy
    1341           DO  i = nxl-1, nxr+1
    1342              DO  j = nys-1, nyn+1
     1265          DO  i = nxlg, nxrg
     1266             DO  j = nysg, nyng
    13431267                DO  k = 0, pch_index
    13441268                   canopy_heat_flux(k,j,i) = cthf *                    &
    … …  
    13841308!-- Initialize quantities for special advections schemes
    13851309    CALL init_advec
     1310    IF ( momentum_advec == 'ws-scheme' .OR.  &
     1311         scalar_advec == 'ws-scheme' ) CALL ws_init
    13861312
    13871313!
    … …  
    14391365    IF ( bc_lr == 'dirichlet/radiation' )  THEN
    14401366
    1441        DO  i = nxl-1, nxr+1
     1367       DO  i = nxlg, nxrg
    14421368          IF ( i >= nx - outflow_damping_width )  THEN
    14431369             km_damp_x(i) = km_damp_max * MIN( 1.0,                    &
    … …  
    14521378    ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
    14531379
    1454        DO  i = nxl-1, nxr+1
     1380       DO  i = nxlg, nxrg
    14551381          IF ( i <= outflow_damping_width )  THEN
    14561382             km_damp_x(i) = km_damp_max * MIN( 1.0,                    &
    … …  
    14671393    IF ( bc_ns == 'dirichlet/radiation' )  THEN
    14681394
    1469        DO  j = nys-1, nyn+1
     1395       DO  j = nysg, nyng
    14701396          IF ( j >= ny - outflow_damping_width )  THEN
    14711397             km_damp_y(j) = km_damp_max * MIN( 1.0,                    &
    … …  
    14801406    ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
    14811407
    1482        DO  j = nys-1, nyn+1
     1408       DO  j = nysg, nyng
    14831409          IF ( j <= outflow_damping_width )  THEN
    14841410             km_damp_y(j) = km_damp_max * MIN( 1.0,                    &
    … …  
    15941520!-- buoyancy, etc. A zero value will occur for cases where all grid points of
    15951521!-- the respective subdomain lie below the surface topography
    1596     ngp_2dh_outer   = MAX( 1, ngp_2dh_outer(:,:)   )
     1522    ngp_2dh_outer   = MAX( 1, ngp_2dh_outer(:,:)   ) 
    15971523    ngp_3d_inner    = MAX( INT(1, KIND = SELECTED_INT_KIND( 18 )),            &
    15981524                           ngp_3d_inner(:) )
    1599     ngp_2dh_s_inner = MAX( 1, ngp_2dh_s_inner(:,:) )
     1525    ngp_2dh_s_inner = MAX( 1, ngp_2dh_s_inner(:,:) ) 
    16001526
    16011527    DEALLOCATE( ngp_2dh_l, ngp_2dh_outer_l, ngp_3d_inner_l, ngp_3d_inner_tmp )

  • TabularUnified palm/trunk/SOURCE/init_advec.f90

    r484 r667  
    88! Former revisions:
    99! -----------------
    10 ! $Id$
     10! $Id: init_advec.f90 484 2010-02-05 07:36:54Z raasch
    1111! RCS Log replace by Id keyword, revision history cleaned up
    1212!

  • TabularUnified palm/trunk/SOURCE/init_coupling.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6!
     7! determination of target_id's moved to init_pegrid
     8!
    79!
    810! Former revisions:
    … …  
    2426    USE pegrid
    2527    USE control_parameters
     28    USE indices
    2629
    2730    IMPLICIT NONE
    … …  
    4851!-- ATTENTION: numprocs will be reset according to the new communicators
    4952#if defined ( __parallel )
     53
     54!myid_absolut = myid
    5055    IF ( myid == 0 )  THEN
    5156       READ (*,*,ERR=10,END=10)  coupling_mode, bc_data(1), bc_data(2)
    … …  
    9499
    95100       IF ( myid < bc_data(1) ) THEN
    96           inter_color = 0
    97           numprocs = bc_data(1)
     101          inter_color     = 0
     102          numprocs        = bc_data(1)
     103          coupling_mode   = 'atmosphere_to_ocean'
    98104       ELSE
    99           inter_color = 1
    100           numprocs = bc_data(2)
     105          inter_color     = 1
     106          numprocs        = bc_data(2)
     107          coupling_mode   = 'ocean_to_atmosphere'
    101108       ENDIF
    102 !
    103 !--    Calculate the target PE for coupling and set up the new communicators.
    104 !--    Currently only 1:1 topologies are supported.
    105        target_id = myid - ISIGN( numprocs, inter_color - 1 )
    106        IF ( inter_color == 0 ) THEN
    107           coupling_mode = 'atmosphere_to_ocean'
    108        ELSE
    109           coupling_mode = 'ocean_to_atmosphere'
    110        ENDIF
     109
    111110       CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, inter_color, 0, comm_palm, ierr )
    112111       comm2d = comm_palm

  • TabularUnified palm/trunk/SOURCE/init_grid.f90

    r559 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Definition of new array bounds nxlg, nxrg, nysg, nyng on each PE.
     7! Furthermore the allocation of arrays and steering of loops is done with these
     8! parameters. Call of exchange_horiz are modified.
     9! In case of dirichlet bounday condition at the bottom zu(0)=0.0
     10! dzu_mg has to be set explicitly for a equally spaced grid near bottom.
     11! ddzu_pres added to use a equally spaced grid near bottom.
    712!
    813! Former revisions:
    … …  
    7681
    7782    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  distance
    78 
     83   
     84!
     85!   Computation of the array bounds.
     86    nxlg = nxl - nbgp
     87    nxrg = nxr + nbgp
     88    nysg = nys - nbgp
     89    nyng = nyn + nbgp
    7990!
    8091!-- Allocate grid arrays
    8192    ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1), &
    82               dzw(1:nzt+1), l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1) )
     93              dzw(1:nzt+1), l_grid(1:nzt), zu(nzb:nzt+1), zw(nzb:nzt+1) )
    8394
    8495!
    … …  
    97108!
    98109!--    Grid for atmosphere with surface at z=0 (k=0, w-grid).
    99 !--    Since the w-level lies on the surface, the first u-level (staggered!)
    100 !--    lies below the surface (used for "mirror" boundary condition).
    101110!--    The first u-level above the surface corresponds to the top of the
    102111!--    Prandtl-layer.
    103        zu(0) = - dz * 0.5
     112
     113       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2 ) THEN
     114          zu(0) = 0.0
     115      !    zu(0) = - dz * 0.5
     116       ELSE
     117          zu(0) = - dz * 0.5
     118       ENDIF
    104119       zu(1) =   dz * 0.5
    105120
    … …  
    173188       dd2zu(k) = 1.0 / ( dzu(k) + dzu(k+1) )
    174189    ENDDO
     190   
     191!   
     192!-- In case of FFT method or SOR swap inverse grid lenght ddzu to ddzu_fft and
     193!-- modify the lowest entry. This is necessary for atmosphere runs, because
     194!-- zu(0) and so ddzu(1) changed. Accompanied with this modified arrays
     195!-- pressure solver uses wrong values and this causes kinks in the profiles
     196!-- of turbulent quantities. 
     197    IF ( psolver /= 'multigrid' ) THEN
     198       ALLOCATE( ddzu_pres(1:nzt+1) )
     199       ddzu_pres = ddzu
     200       IF( .NOT. ocean ) ddzu_pres(1) = ddzu_pres(2)
     201    ENDIF   
    175202
    176203!
    … …  
    187214
    188215       dzu_mg(:,maximum_grid_level) = dzu
     216!       
     217!--    To ensure a equally spaced grid. For ocean runs this is not necessary,
     218!--    because zu(0) does not changed so far. Also this would cause errors
     219!--    if a vertical stretching for ocean runs is used.
     220       IF ( .NOT. ocean ) dzu_mg(1,maximum_grid_level) = dzu(2)
    189221       dzw_mg(:,maximum_grid_level) = dzw
    190222       nzt_l = nzt
    … …  
    239271!-- the flag arrays needed for the multigrid method
    240272    gls = 2**( maximum_grid_level )
     273
    241274    ALLOCATE( corner_nl(nys:nyn,nxl:nxr), corner_nr(nys:nyn,nxl:nxr),       &
    242275              corner_sl(nys:nyn,nxl:nxr), corner_sr(nys:nyn,nxl:nxr),       &
    243               nzb_local(-gls:ny+gls,-gls:nx+gls), nzb_tmp(-1:ny+1,-1:nx+1), &
     276              nzb_local(-gls:ny+gls,-gls:nx+gls),                                   &
     277              nzb_tmp(-nbgp:ny+nbgp,-nbgp:nx+nbgp),                         &
    244278              wall_l(nys:nyn,nxl:nxr), wall_n(nys:nyn,nxl:nxr),             &
    245279              wall_r(nys:nyn,nxl:nxr), wall_s(nys:nyn,nxl:nxr) )
    246     ALLOCATE( fwxm(nys-1:nyn+1,nxl-1:nxr+1), fwxp(nys-1:nyn+1,nxl-1:nxr+1), &
    247               fwym(nys-1:nyn+1,nxl-1:nxr+1), fwyp(nys-1:nyn+1,nxl-1:nxr+1), &
    248               fxm(nys-1:nyn+1,nxl-1:nxr+1), fxp(nys-1:nyn+1,nxl-1:nxr+1),   &
    249               fym(nys-1:nyn+1,nxl-1:nxr+1), fyp(nys-1:nyn+1,nxl-1:nxr+1),   &
    250               nzb_s_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
    251               nzb_s_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
    252               nzb_u_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
    253               nzb_u_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
    254               nzb_v_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
    255               nzb_v_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
    256               nzb_w_inner(nys-1:nyn+1,nxl-1:nxr+1),                         &
    257               nzb_w_outer(nys-1:nyn+1,nxl-1:nxr+1),                         &
    258               nzb_diff_s_inner(nys-1:nyn+1,nxl-1:nxr+1),                    &
    259               nzb_diff_s_outer(nys-1:nyn+1,nxl-1:nxr+1),                    &
    260               nzb_diff_u(nys-1:nyn+1,nxl-1:nxr+1),                          &
    261               nzb_diff_v(nys-1:nyn+1,nxl-1:nxr+1),                          &
    262               nzb_2d(nys-1:nyn+1,nxl-1:nxr+1),                              &
    263               wall_e_x(nys-1:nyn+1,nxl-1:nxr+1),                            &
    264               wall_e_y(nys-1:nyn+1,nxl-1:nxr+1),                            &
    265               wall_u(nys-1:nyn+1,nxl-1:nxr+1),                              &
    266               wall_v(nys-1:nyn+1,nxl-1:nxr+1),                              &
    267               wall_w_x(nys-1:nyn+1,nxl-1:nxr+1),                            &
    268               wall_w_y(nys-1:nyn+1,nxl-1:nxr+1) )
    269 
    270     ALLOCATE( l_wall(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     280    ALLOCATE( fwxm(nysg:nyng,nxlg:nxrg), fwxp(nysg:nyng,nxlg:nxrg),         &
     281              fwym(nysg:nyng,nxlg:nxrg), fwyp(nysg:nyng,nxlg:nxrg),         &
     282              fxm(nysg:nyng,nxlg:nxrg), fxp(nysg:nyng,nxlg:nxrg),           &
     283              fym(nysg:nyng,nxlg:nxrg), fyp(nysg:nyng,nxlg:nxrg),           &
     284              nzb_s_inner(nysg:nyng,nxlg:nxrg),                             &
     285              nzb_s_outer(nysg:nyng,nxlg:nxrg),                             &
     286              nzb_u_inner(nysg:nyng,nxlg:nxrg),                             &
     287              nzb_u_outer(nysg:nyng,nxlg:nxrg),                             &
     288              nzb_v_inner(nysg:nyng,nxlg:nxrg),                             &
     289              nzb_v_outer(nysg:nyng,nxlg:nxrg),                             &
     290              nzb_w_inner(nysg:nyng,nxlg:nxrg),                             &
     291              nzb_w_outer(nysg:nyng,nxlg:nxrg),                             &
     292              nzb_diff_s_inner(nysg:nyng,nxlg:nxrg),                        &
     293              nzb_diff_s_outer(nysg:nyng,nxlg:nxrg),                        &
     294              nzb_diff_u(nysg:nyng,nxlg:nxrg),                              &
     295              nzb_diff_v(nysg:nyng,nxlg:nxrg),                              &
     296              nzb_2d(nysg:nyng,nxlg:nxrg),                                  &
     297              wall_e_x(nysg:nyng,nxlg:nxrg),                                &
     298              wall_e_y(nysg:nyng,nxlg:nxrg),                                &
     299              wall_u(nysg:nyng,nxlg:nxrg),                                  &
     300              wall_v(nysg:nyng,nxlg:nxrg),                                  &
     301              wall_w_x(nysg:nyng,nxlg:nxrg),                                &
     302              wall_w_y(nysg:nyng,nxlg:nxrg) )
     303
     304
     305
     306    ALLOCATE( l_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    271307
    272308    nzb_s_inner = nzb;  nzb_s_outer = nzb
    … …  
    327363    vertical_influence(0) = vertical_influence(1)
    328364
    329     DO  i = nxl-1, nxr+1
    330        DO  j = nys-1, nyn+1
     365    DO  i = nxlg, nxrg
     366       DO  j = nysg, nyng
    331367          DO  k = nzb_s_inner(j,i) + 1, &
    332368                  nzb_s_inner(j,i) + vertical_influence(nzb_s_inner(j,i))
    … …  
    477513          nzb_local(:,-gls:-1)        = nzb_local(:,nx-gls+1:nx)
    478514          nzb_local(:,nx+1:nx+gls)    = nzb_local(:,0:gls-1)
     515
     516
    479517     
    480518          GOTO 12
    … …  
    588626!--    nzb_s_outer:
    589627!--    extend nzb_local east-/westwards first, then north-/southwards
    590        nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
     628       nzb_tmp = nzb_local(-nbgp:ny+nbgp,-nbgp:nx+nbgp)
    591629       DO  j = -1, ny + 1
    592630          DO  i = 0, nx
    … …  
    620658!--    nzb_u_inner:
    621659!--    extend nzb_local rightwards only
    622        nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
     660       nzb_tmp = nzb_local(-nbgp:ny+nbgp,-nbgp:nx+nbgp)
    623661       DO  j = -1, ny + 1
    624662          DO  i = 0, nx + 1
    … …  
    626664          ENDDO
    627665       ENDDO
    628        nzb_u_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
     666       nzb_u_inner = nzb_tmp(nysg:nyng,nxlg:nxrg)
    629667
    630668!
    … …  
    652690!--    nzb_v_inner:
    653691!--    extend nzb_local northwards only
    654        nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
     692       nzb_tmp = nzb_local(-nbgp:ny+nbgp,-nbgp:nx+nbgp)
    655693       DO  i = -1, nx + 1
    656694          DO  j = 0, ny + 1
    … …  
    658696          ENDDO
    659697       ENDDO
    660        nzb_v_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
     698       nzb_v_inner = nzb_tmp(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp)
    661699
    662700!
    … …  
    10961134!
    10971135!-- Need to set lateral boundary conditions for l_wall
    1098     CALL exchange_horiz( l_wall )
     1136
     1137    CALL exchange_horiz( l_wall, nbgp )
    10991138
    11001139    DEALLOCATE( corner_nl, corner_nr, corner_sl, corner_sr, nzb_local, &

  • TabularUnified palm/trunk/SOURCE/init_particles.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation
     7! of arrays.
    78!
    89! Former revisions:
    … …  
    185186       ENDIF
    186187
    187        ALLOCATE( prt_count(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),       &
    188                  prt_start_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
     188       ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg),       &
     189                 prt_start_index(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
    189190                 particle_mask(maximum_number_of_particles),         &
    190191                 particles(maximum_number_of_particles) )
    … …  
    209210!--    particles, which can be also periodically released at later times.
    210211!--    Also allocate array for particle tail coordinates, if needed.
    211        ALLOCATE( prt_count(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1),       &
    212                  prt_start_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
     212       ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg),       &
     213                 prt_start_index(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
    213214                 particle_mask(maximum_number_of_particles),         &
    214215                 particles(maximum_number_of_particles) )

  • TabularUnified palm/trunk/SOURCE/init_pegrid.f90

    r647 r667  
    44! Current revisions:
    55! -----------------
     6!
     7! Moved determination of target_id's from init_coupling
     8!
     9! Determination of parameters needed for coupling (coupling_topology, ngp_a, ngp_o)
     10! with different grid/processor-topology in ocean and atmosphere
     11!
     12!
     13! Adaption of ngp_xy, ngp_y to a dynamic number of ghost points.
     14! The maximum_grid_level changed from 1 to 0. 0 is the normal grid, 1 to
     15! maximum_grid_level the grids for multigrid, in which 0 and 1 are normal grids.
     16! This distinction is due to reasons of data exchange and performance for the
     17! normal grid and grids in poismg.
     18! The definition of MPI-Vectors adapted to a dynamic numer of ghost points.
     19! New MPI-Vectors for data exchange between left and right boundaries added.
     20! This is due to reasons of performance (10% faster).
    621!
    722! ATTENTION: nnz_x undefined problem still has to be solved!!!!!!!!
    … …  
    7994
    8095
     96
    8197    IMPLICIT NONE
    8298
    … …  
    88104
    89105    INTEGER, DIMENSION(:), ALLOCATABLE ::  ind_all, nxlf, nxrf, nynf, nysf
     106
     107    INTEGER, DIMENSION(2) :: pdims_remote
    90108
    91109    LOGICAL ::  found
    … …  
    103121
    104122#if defined( __parallel )
     123
    105124!
    106125!-- Determine the processor topology or check it, if prescribed by the user
    … …  
    624643#endif
    625644
     645!
     646!-- Determine the number of ghost points
     647    IF (scalar_advec == 'ws-scheme' .OR. momentum_advec == 'ws-scheme') THEN
     648       nbgp = 3
     649    ELSE
     650       nbgp = 1
     651    END IF
     652
    626653!
    627654!-- In case of coupled runs, create a new MPI derived datatype for the
    628655!-- exchange of surface (xy) data .
    629656!-- Gridpoint number for the exchange of ghost points (xy-plane)
    630     ngp_xy  = ( nxr - nxl + 3 ) * ( nyn - nys + 3 )
     657
     658    ngp_xy  = ( nxr - nxl + 1 + 2 * nbgp ) * ( nyn - nys + 1 + 2 * nbgp )
    631659
    632660!
    … …  
    635663    CALL MPI_TYPE_VECTOR( ngp_xy, 1, nzt-nzb+2, MPI_REAL, type_xy, ierr )
    636664    CALL MPI_TYPE_COMMIT( type_xy, ierr )
     665
     666
     667    IF ( TRIM( coupling_mode ) .NE. 'uncoupled' ) THEN
     668   
     669!
     670!--    Pass the number of grid points of the atmosphere model to
     671!--    the ocean model and vice versa
     672       IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
     673
     674          nx_a = nx
     675          ny_a = ny
     676
     677          IF ( myid == 0 ) THEN
     678             CALL MPI_SEND( nx_a, 1, MPI_INTEGER, numprocs, 1, &
     679                            comm_inter, ierr )
     680             CALL MPI_SEND( ny_a, 1, MPI_INTEGER, numprocs, 2, &
     681                            comm_inter, ierr )
     682             CALL MPI_SEND( pdims, 2, MPI_INTEGER, numprocs, 3, &
     683                            comm_inter, ierr )
     684             CALL MPI_RECV( nx_o, 1, MPI_INTEGER, numprocs, 4, &
     685                            comm_inter, status, ierr )
     686             CALL MPI_RECV( ny_o, 1, MPI_INTEGER, numprocs, 5, &
     687                            comm_inter, status, ierr )
     688             CALL MPI_RECV( pdims_remote, 2, MPI_INTEGER, numprocs, 6, &
     689                            comm_inter, status, ierr )
     690          ENDIF
     691
     692          CALL MPI_BCAST( nx_o, 1, MPI_INTEGER, 0, comm2d, ierr)
     693          CALL MPI_BCAST( ny_o, 1, MPI_INTEGER, 0, comm2d, ierr)
     694          CALL MPI_BCAST( pdims_remote, 2, MPI_INTEGER, 0, comm2d, ierr)
     695       
     696       ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
     697
     698          nx_o = nx
     699          ny_o = ny
     700
     701          IF ( myid == 0 ) THEN
     702             CALL MPI_RECV( nx_a, 1, MPI_INTEGER, 0, 1, &
     703                            comm_inter, status, ierr )
     704             CALL MPI_RECV( ny_a, 1, MPI_INTEGER, 0, 2, &
     705                            comm_inter, status, ierr )
     706             CALL MPI_RECV( pdims_remote, 2, MPI_INTEGER, 0, 3, &
     707                            comm_inter, status, ierr )
     708             CALL MPI_SEND( nx_o, 1, MPI_INTEGER, 0, 4, &
     709                            comm_inter, ierr )
     710             CALL MPI_SEND( ny_o, 1, MPI_INTEGER, 0, 5, &
     711                            comm_inter, ierr )
     712             CALL MPI_SEND( pdims, 2, MPI_INTEGER, 0, 6, &
     713                            comm_inter, ierr )
     714          ENDIF
     715
     716          CALL MPI_BCAST( nx_a, 1, MPI_INTEGER, 0, comm2d, ierr)
     717          CALL MPI_BCAST( ny_a, 1, MPI_INTEGER, 0, comm2d, ierr)
     718          CALL MPI_BCAST( pdims_remote, 2, MPI_INTEGER, 0, comm2d, ierr)
     719
     720       ENDIF
     721 
     722       ngp_a = (nx_a+1+2*nbgp)*(ny_a+1+2*nbgp)
     723       ngp_o = (nx_o+1+2*nbgp)*(ny_o+1+2*nbgp)
     724
     725!
     726!--    determine if the horizontal grid and the number of PEs
     727!--    in ocean and atmosphere is same or not
     728!--    (different number of PEs still not implemented)
     729       IF ( nx_o == nx_a .AND. ny_o == ny_a .AND.  &
     730            pdims(1) == pdims_remote(1) .AND. pdims(2) == pdims_remote(2) ) &
     731       THEN
     732          coupling_topology = 0
     733       ELSE
     734          coupling_topology = 1
     735       ENDIF
     736
     737!
     738!--    Determine the target PEs for the exchange between ocean and
     739!--    atmosphere (comm2d)
     740       IF ( coupling_topology == 0) THEN
     741          IF ( TRIM( coupling_mode ) .EQ. 'atmosphere_to_ocean' ) THEN
     742             target_id = myid + numprocs
     743          ELSE
     744             target_id = myid
     745          ENDIF
     746
     747       ELSE
     748
     749!
     750!--       In case of nonequivalent topology in ocean and atmosphere only for
     751!--       PE0 in ocean and PE0 in atmosphere a target_id is needed, since
     752!--       data echxchange between ocean and atmosphere will be done only by
     753!--       those PEs.   
     754          IF ( myid == 0 ) THEN
     755             IF ( TRIM( coupling_mode ) .EQ. 'atmosphere_to_ocean' ) THEN
     756                target_id = numprocs
     757             ELSE
     758                target_id = 0
     759             ENDIF
     760 print*, coupling_mode, myid, " -> ", target_id, "numprocs: ", numprocs
     761          ENDIF
     762       ENDIF
     763
     764    ENDIF
     765
     766
    637767#endif
    638768
    … …  
    854984    ELSE
    855985
    856        maximum_grid_level = 1
     986       maximum_grid_level = 0
    857987
    858988    ENDIF
    … …  
    863993!
    864994!-- Gridpoint number for the exchange of ghost points (y-line for 2D-arrays)
    865     ngp_y  = nyn - nys + 1
     995    ngp_y  = nyn - nys + 1 + 2 * nbgp
    866996
    867997!
    868998!-- Define a new MPI derived datatype for the exchange of ghost points in
    869999!-- y-direction for 2D-arrays (line)
    870     CALL MPI_TYPE_VECTOR( nxr-nxl+3, 1, ngp_y+2, MPI_REAL, type_x, ierr )
     1000    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_REAL, type_x, ierr )
    8711001    CALL MPI_TYPE_COMMIT( type_x, ierr )
    872     CALL MPI_TYPE_VECTOR( nxr-nxl+3, 1, ngp_y+2, MPI_INTEGER, type_x_int, ierr )
     1002    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_INTEGER, type_x_int, ierr )
    8731003    CALL MPI_TYPE_COMMIT( type_x_int, ierr )
     1004
     1005    CALL MPI_TYPE_VECTOR( nbgp, ngp_y, ngp_y, MPI_REAL, type_y, ierr )
     1006    CALL MPI_TYPE_COMMIT( type_y, ierr )
     1007    CALL MPI_TYPE_VECTOR( nbgp, ngp_y, ngp_y, MPI_INTEGER, type_y_int, ierr )
     1008    CALL MPI_TYPE_COMMIT( type_y_int, ierr )
     1009
    8741010
    8751011!
    … …  
    8791015!-- Do these calculations for the model grid and (if necessary) also
    8801016!-- for the coarser grid levels used in the multigrid method
    881     ALLOCATE ( ngp_yz(maximum_grid_level), type_xz(maximum_grid_level) )
     1017    ALLOCATE ( ngp_yz(0:maximum_grid_level), type_xz(0:maximum_grid_level),&
     1018               type_yz(0:maximum_grid_level) )
    8821019
    8831020    nxl_l = nxl; nxr_l = nxr; nys_l = nys; nyn_l = nyn; nzb_l = nzb; nzt_l = nzt
    884          
    885     DO i = maximum_grid_level, 1 , -1
    886        ngp_yz(i) = (nzt_l - nzb_l + 2) * (nyn_l - nys_l + 3)
    887 
    888        CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz(i), &
     1021!
     1022!-- Discern between the model grid, which needs nbgp ghost points and
     1023!-- grid levels for the multigrid scheme. In the latter case only one
     1024!-- ghost point is necessary.
     1025!-- First definition of mpi-vectors for exchange of ghost layers on normal
     1026!-- grid. The following loop is needed for data exchange in poismg.f90.
     1027!
     1028!-- Determine number of grid points of yz-layer for exchange
     1029    ngp_yz(0) = (nzt - nzb + 2) * (nyn - nys + 1 + 2 * nbgp)
     1030!
     1031!-- Define a new mpi datatype for the exchange of left - right boundaries.
     1032!-- Indeed the data are connected in the physical memory and no mpi-vector
     1033!-- is necessary, but the data exchange between left and right PE's using
     1034!-- mpi-vectors is 10% faster than without.
     1035    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp*(nzt-nzb+2), ngp_yz(0), &
     1036                             MPI_REAL, type_xz(0), ierr )
     1037    CALL MPI_TYPE_COMMIT( type_xz(0), ierr )
     1038
     1039    CALL MPI_TYPE_VECTOR( nbgp, ngp_yz(0), ngp_yz(0), MPI_REAL, type_yz(0), ierr)
     1040    CALL MPI_TYPE_COMMIT( type_yz(0), ierr )
     1041!
     1042!-- Definition of mpi-vectors for multigrid
     1043    IF ( psolver == 'multigrid' )  THEN
     1044!   
     1045!--   The definition of mpi-vectors as aforementioned, but only 1 ghost point is used.
     1046       DO i = maximum_grid_level, 1 , -1
     1047          ngp_yz(i) = (nzt_l - nzb_l + 2) * (nyn_l - nys_l + 3)
     1048
     1049          CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz(i), &
    8891050                             MPI_REAL, type_xz(i), ierr )
    890        CALL MPI_TYPE_COMMIT( type_xz(i), ierr )
    891 
    892        nxl_l = nxl_l / 2
    893        nxr_l = nxr_l / 2
    894        nys_l = nys_l / 2
    895        nyn_l = nyn_l / 2
    896        nzt_l = nzt_l / 2
    897     ENDDO
     1051          CALL MPI_TYPE_COMMIT( type_xz(i), ierr )
     1052
     1053          CALL MPI_TYPE_VECTOR( 1, ngp_yz(i), ngp_yz(i), MPI_REAL, type_yz(i), ierr)
     1054          CALL MPI_TYPE_COMMIT( type_yz(i), ierr )
     1055
     1056          nxl_l = nxl_l / 2
     1057          nxr_l = nxr_l / 2
     1058          nys_l = nys_l / 2
     1059          nyn_l = nyn_l / 2
     1060          nzt_l = nzt_l / 2
     1061       ENDDO
     1062    END IF
    8981063#endif
    8991064

  • TabularUnified palm/trunk/SOURCE/init_pt_anomaly.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Call of exchange_horiz are modified.
    77!
    88! Former revisions:
    … …  
    7373!
    7474!-- Exchange of boundary values for temperature
    75     CALL exchange_horiz( pt )
     75    CALL exchange_horiz( pt, nbgp )
    7676
    7777

  • TabularUnified palm/trunk/SOURCE/init_rankine.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
     7! Calls of exchange_horiz are modified.
    78!
    89! Former revisions:
    … …  
    5556!-- Reset initial profiles to constant profiles
    5657    IF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )  THEN
    57        DO  i = nxl-1, nxr+1
    58           DO  j = nys-1, nyn+1
     58       DO  i = nxlg, nxrg
     59          DO  j = nysg, nyng
    5960             pt(:,j,i) = pt_init
    6061             u(:,j,i)  = u_init
    … …  
    148149!
    149150!-- Exchange of boundary values for the velocities.
    150     CALL exchange_horiz( u )
    151     CALL exchange_horiz( v )
     151    CALL exchange_horiz( u, nbgp)
     152    CALL exchange_horiz( v, nbgp )
    152153!
    153154!-- Make velocity field nondivergent.

  • TabularUnified palm/trunk/SOURCE/init_slope.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    4646!
    4747!-- Calculate reference temperature field needed for computing buoyancy
    48     ALLOCATE( pt_slope_ref(nzb:nzt+1,nxl-1:nxr+1) )
     48    ALLOCATE( pt_slope_ref(nzb:nzt+1,nxlg:nxrg) )
    4949
    50     DO  i = nxl-1, nxr+1
     50    DO  i = nxlg, nxrg
    5151       DO  k = nzb, nzt+1
    5252
    … …  
    9090!
    9191!--    Set initial temperature equal to the reference temperature field
    92        DO  j = nys-1, nyn+1
     92       DO  j = nysg, nyng
    9393          pt(:,j,:) = pt_slope_ref
    9494       ENDDO

  • TabularUnified palm/trunk/SOURCE/local_stop.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Exchange of terminate_coupled between ocean and atmosphere via PE0
    77!
    88! Former revisions:
    … …  
    6363             IF ( terminate_coupled == 0 )  THEN
    6464                terminate_coupled = 1
    65                 CALL MPI_SENDRECV( &
    66                      terminate_coupled,        1, MPI_INTEGER, target_id,  0, &
    67                      terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0, &
    68                      comm_inter, status, ierr )
     65                IF ( myid == 0 ) THEN
     66                   CALL MPI_SENDRECV( &
     67                        terminate_coupled,        1, MPI_INTEGER, target_id,  0, &
     68                        terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0, &
     69                        comm_inter, status, ierr )
     70                ENDIF
     71                CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_REAL, 0, comm2d, ierr)
    6972             ENDIF
    7073             CALL MPI_FINALIZE( ierr )

  • TabularUnified palm/trunk/SOURCE/modules.f90

    r623 r667  
    55! Current revisions:
    66! -----------------
     7!
     8! Removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc
     9!
     10! For coupling with different resolution in ocean and atmophere:
     11! +nx_a, +nx_o, ny_a, +ny_o, ngp_a, ngp_o, +total_2d_o, +total_2d_a,
     12! +coupling_topology
     13!
     14!
     15! Buffer arrays for the left sided advective fluxes added in arrays_3d.
     16! +flux_s_u, +flux_s_v, +flux_s_w, +diss_s_u, +diss_s_v, +diss_s_w,
     17! +flux_s_pt, +diss_s_pt, +flux_s_e, +diss_s_e, +flux_s_q, +diss_s_q,
     18! +flux_s_sa, +diss_s_sa
     19! 3d arrays for dissipation control added. (only necessary for vector arch.)
     20! +var_x, +var_y, +var_z, +gamma_x, +gamma_y, +gamma_z
     21! Default of momentum_advec and scalar_advec changed to 'ws-scheme' .
     22! +exchange_mg added in control_parameters to steer the data exchange.
     23! Parameters +nbgp, +nxlg, +nxrg, +nysg, +nyng added in indices.
     24! flag array +boundary_flags added in indices to steer the degradation of order
     25! of the advective fluxes when non-cyclic boundaries are used.
     26! MPI-datatypes +type_y, +type_y_int and +type_yz for data_exchange added in
     27! pegrid.
     28! +sums_wsus_ws_l, +sums_wsvs_ws_l, +sums_us2_ws_l, +sums_vs2_ws_l,
     29! +sums_ws2_ws_l, +sums_wspts_ws_l, +sums_wssas_ws_l, +sums_wsqs_ws_l
     30! and +weight_substep added in statistics to steer the statistical evaluation
     31! of turbulent fluxes in the advection routines.
     32! LOGICALS +ws_scheme_sca and +ws_scheme_mom added to get a better performance
     33! in prognostic_equations.
     34! LOGICAL +dissipation_control control added to steer numerical dissipation
     35! in ws-scheme.
    736!
     37!
     38! Changed length of string run_description_header
    839!
    940! Former revisions:
    … …  
    5182! ws_vertical_gradient_level_ind, w_subs
    5283!
    53 ! 410 2009-12-04 17:05:40Z letzel
    54 ! masked data output: + dt_domask, mask_01~20_x|y|z, mask_01~20_x|y|z_loop,
     84! Branch revisions:
     85! -----------------
     86! Masked data output: + dt_domask, mask_01~20_x|y|z, mask_01~20_x|y|z_loop,
    5587! mask_scale|_x|y|z, masks, skip_time_domask
     88!
     89! control_parameters: scalar and momentum advection set to 'ws-scheme' as
     90! default scheme
     91! indices: nbgp=3 set as default value
     92!
     93! Former revisions:
     94! -----------------
     95! $Id$
    5696!
    5797! 388 2009-09-23 09:40:33Z raasch
    … …  
    190230
    191231    REAL, DIMENSION(:), ALLOCATABLE ::                                         &
    192           ddzu, dd2zu, dzu, ddzw, dzw, hyp, inflow_damping_factor, km_damp_x,  &
    193           km_damp_y, lad, l_grid, pt_init, q_init, rdf, sa_init, ug, u_init,   &
    194           u_nzb_p1_for_vfc, vg, v_init, v_nzb_p1_for_vfc, w_subs, zu, zw
     232          ddzu, ddzu_pres, dd2zu, dzu, ddzw, dzw, hyp, inflow_damping_factor,  &
     233          km_damp_x, km_damp_y, lad, l_grid, pt_init, q_init, rdf, sa_init,    &
     234          ug, u_init, u_nzb_p1_for_vfc, vg, v_init, v_nzb_p1_for_vfc, w_subs,  &
     235          zu, zw, flux_s_u, flux_s_v, flux_s_w, diss_s_u, diss_s_v, diss_s_w,  &
     236          flux_s_pt, diss_s_pt, flux_s_e, diss_s_e, flux_s_q, diss_s_q,        &
     237          flux_s_sa, diss_s_sa
    195238
    196239    REAL, DIMENSION(:,:), ALLOCATABLE ::                                       &
    197240          c_u, c_v, c_w, dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg,                  &
    198           mean_inflow_profiles, pt_slope_ref, qs, qswst_remote, ts, us, z0
     241          mean_inflow_profiles, pt_slope_ref, qs, qswst_remote, ts, us, z0,    &
     242          flux_l_u, flux_l_v, flux_l_w, diss_l_u, diss_l_v, diss_l_w,          &
     243          flux_l_pt, diss_l_pt, flux_l_e, diss_l_e, flux_l_q, diss_l_q,        &
     244          flux_l_sa, diss_l_sa, total_2d_o, total_2d_a
    199245
    200246    REAL, DIMENSION(:,:), ALLOCATABLE, TARGET ::                               &
    … …  
    227273
    228274    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  rif_wall
     275
     276    REAL, DIMENSION(:,:,:), ALLOCATABLE :: var_x, var_y, var_z, gamma_x,        &
     277                                           gamma_y, gamma_z
    229278
    230279    SAVE
    … …  
    290339
    291340    REAL    ::  pi = 3.141592654
     341    REAL    ::  adv_sca_5, adv_sca_3, adv_mom_5, adv_mom_3
     342   
    292343
    293344    SAVE
    … …  
    336387    CHARACTER (LEN=16)   ::  conserve_volume_flow_mode = 'default', &
    337388                             loop_optimization = 'default', &
    338                              momentum_advec = 'pw-scheme', &
     389                             momentum_advec = 'ws-scheme', &
    339390                             psolver = 'poisfft', &
    340                              scalar_advec = 'pw-scheme'
     391                             scalar_advec = 'ws-scheme'
    341392    CHARACTER (LEN=20)   ::  bc_e_b = 'neumann', bc_lr = 'cyclic', &
    342393                             bc_ns = 'cyclic', bc_p_b = 'neumann', &
    … …  
    359410    CHARACTER (LEN=64)   ::  host = ' '
    360411    CHARACTER (LEN=80)   ::  log_message, run_identifier
    361     CHARACTER (LEN=100)  ::  initializing_actions = ' ', run_description_header
     412    CHARACTER (LEN=100)  ::  initializing_actions = ' '
     413    CHARACTER (LEN=110)  ::  run_description_header
    362414    CHARACTER (LEN=1000) ::  message_string = ' '
    363415
    … …  
    378430    INTEGER ::  abort_mode = 1, average_count_pr = 0, average_count_sp = 0, &
    379431                average_count_3d = 0, current_timestep_number = 0, &
     432                coupling_topology = 0, &
    380433                dist_range = 0, disturbance_level_ind_b, &
    381434                disturbance_level_ind_t, doav_n = 0, dopr_n = 0, &
    … …  
    432485                constant_waterflux = .TRUE., create_disturbances = .TRUE., &
    433486                cut_spline_overshoot = .TRUE., &
    434                 data_output_2d_on_each_pe = .TRUE., do2d_at_begin = .FALSE., &
     487                data_output_2d_on_each_pe = .TRUE., &
     488                dissipation_control = .FALSE., do2d_at_begin = .FALSE., &
    435489                do3d_at_begin = .FALSE., do3d_compress = .FALSE., &
    436490                do_sum = .FALSE., dp_external = .FALSE., dp_smooth = .FALSE., &
    437491                dt_changed = .FALSE., dt_fixed = .FALSE., &
    438492                disturbance_created = .FALSE., &
     493                exchange_mg = .FALSE., &
    439494                first_call_advec_particles = .TRUE., &
    440495                force_print_header = .FALSE., galilei_transformation = .FALSE.,&
    … …  
    457512                use_surface_fluxes = .FALSE., use_top_fluxes = .FALSE., &
    458513                use_ug_for_galilei_tr = .TRUE., use_upstream_for_tke = .FALSE.,&
    459                 wall_adjustment = .TRUE.
     514                wall_adjustment = .TRUE., ws_scheme_sca = .FALSE.,             &
     515                ws_scheme_mom = .FALSE.
    460516
    461517    LOGICAL ::  data_output_xy(0:1) = .FALSE., data_output_xz(0:1) = .FALSE., &
    … …  
    761817!------------------------------------------------------------------------------!
    762818
    763     INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxlu, nxr, nxra, nx_on_file,  &
    764                 nny, ny = 0, nya, nyn, nyna, nys, nysv, ny_on_file, nnz,       &
    765                 nz = 0, nza, nzb, nzb_diff, nzt, nzta, nzt_diff
     819    INTEGER ::  nbgp = 3, ngp_sums, nnx, nx = 0, nx_a, nx_o, nxa, nxl, nxlg,   &
     820                nxlu, nxr, nxra, nxrg, nx_on_file, nny, ny = 0, ny_a, ny_o,    &
     821                nya, nyn, nyna, nyng, nys, nysg, nysv, ny_on_file, nnz, nz = 0,&
     822                nza, nzb, nzb_diff, nzt, nzta, nzt_diff
     823
    766824
    767825    INTEGER( KIND = SELECTED_INT_KIND(18) ), DIMENSION(:), ALLOCATABLE ::      &
    … …  
    771829                ngp_2dh, nnx_pe, nny_pe, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg
    772830
    773     INTEGER, DIMENSION(:,:), ALLOCATABLE ::                                    &
     831
     832    INTEGER, DIMENSION(:,:), ALLOCATABLE :: boundary_flags,                    &
    774833                ngp_2dh_outer, ngp_2dh_s_inner, mg_loc_ind, nzb_diff_s_inner,  &
    775834                nzb_diff_s_outer, nzb_diff_u, nzb_diff_v, nzb_inner, nzb_outer,&
    … …  
    11571216
    11581217    INTEGER ::  comm1dx, comm1dy, comm2d, comm_inter, comm_palm, ierr, myidx,  &
    1159                 myidy, ndim = 2, ngp_xy, ngp_y, pleft, pnorth, pright, psouth, &
     1218                myidy, ndim = 2, ngp_a, ngp_o, ngp_xy, ngp_y,                  &
     1219                pleft, pnorth, pright, psouth,                                 &
    11601220                sendrecvcount_xy, sendrecvcount_yz, sendrecvcount_zx,          &
    11611221                sendrecvcount_zyd, sendrecvcount_yxd,                          &
    1162                 type_x, type_x_int, type_xy
     1222                type_x, type_x_int, type_xy, type_y, type_y_int
    11631223
    11641224    INTEGER ::  ibuf(12), pcoord(2), pdims(2), status(MPI_STATUS_SIZE)
    11651225
    1166     INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_yz, type_xz
     1226    INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_yz, type_xz, type_yz
    11671227
    11681228    LOGICAL ::  collective_wait = .FALSE., reorder = .TRUE.
    … …  
    13251385    LOGICAL ::  flow_statistics_called = .FALSE.
    13261386    REAL ::     u_max, v_max, w_max
    1327     REAL, DIMENSION(:), ALLOCATABLE       ::  sums_divnew_l, sums_divold_l
    1328     REAL, DIMENSION(:,:), ALLOCATABLE     ::  sums, sums_wsts_bc_l, ts_value
     1387    REAL, DIMENSION(:), ALLOCATABLE       ::  sums_divnew_l, sums_divold_l, &
     1388                                              weight_substep
     1389    REAL, DIMENSION(:,:), ALLOCATABLE     ::  sums, sums_wsts_bc_l,        &
     1390                                              sums_wsus_ws_l, sums_wsvs_ws_l,&
     1391                                              sums_us2_ws_l, sums_vs2_ws_l, &
     1392                                              sums_ws2_ws_l,                 &
     1393                                              sums_wspts_ws_l, sums_wssas_ws_l, &
     1394                                              sums_wsqs_ws_l, ts_value
    13291395    REAL, DIMENSION(:,:,:), ALLOCATABLE   ::  hom_sum, rmask, spectrum_x, &
    13301396                                              spectrum_y, sums_l, sums_l_l, &

  • TabularUnified palm/trunk/SOURCE/palm.f90

    r559 r667  
    142142    CALL check_parameters
    143143
     144
    144145!
    145146!-- Initialize all necessary variables
    … …  
    185186!-- If required, repeat output of header including the required CPU-time
    186187    IF ( myid == 0 )  CALL header
    187 
    188188!
    189189!-- If required, final user-defined actions, and

  • TabularUnified palm/trunk/SOURCE/parin.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Steering parameter dissipation_control added in inipar. (commented out)
    77!
    88! Former revisions:
    … …  
    124124             collective_wait, conserve_volume_flow, conserve_volume_flow_mode, &
    125125             coupling_start_time, cthf, cut_spline_overshoot, &
    126              cycle_mg, damp_level_1d, dissipation_1d, dp_external, dp_level_b, &
    127              dp_smooth, dpdxy, drag_coefficient, dt, dt_pr_1d, &
    128              dt_run_control_1d, dx, dy, dz, dz_max, dz_stretch_factor, &
    129              dz_stretch_level, e_init, e_min, end_time_1d, fft_method, &
    130              galilei_transformation, grid_matching, humidity, &
     126             cycle_mg, damp_level_1d, dissipation_1d, & !dissipation_control, &
     127             dp_external, dp_level_b, dp_smooth, dpdxy, drag_coefficient, &
     128             dt, dt_pr_1d, dt_run_control_1d, dx, dy, dz, dz_max, &
     129             dz_stretch_factor, dz_stretch_level, e_init, e_min, end_time_1d, &
     130             fft_method, galilei_transformation, grid_matching, humidity, &
    131131             inflow_damping_height, inflow_damping_width, &
    132132             inflow_disturbance_begin, inflow_disturbance_end, &
    … …  
    190190    NAMELIST /envpar/  host, local_dvrserver_running, maximum_cpu_time_allowed,  &
    191191                       revision, return_addres, return_username, run_identifier, &
    192                        tasks_per_node, write_binary
     192                       tasks_per_node, write_binary                     
    193193
    194194!
    … …  
    278278                 hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),        &
    279279                 hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
     280
    280281       hom = 0.0
    281282

  • TabularUnified palm/trunk/SOURCE/poisfft.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! ddzu replaced by ddzu_pres due to changes in zu(0).
    77!
    88! Former revisions:
    … …  
    287287       DO  k = 0, nz-1
    288288          DO  i = nxl_z, nxr_z
    289              tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
    290              tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
     289             tri(2,i,k) = ddzu_pres(k+1) * ddzw(k+1)
     290             tri(3,i,k) = ddzu_pres(k+2) * ddzw(k+1)
    291291          ENDDO
    292292       ENDDO
    … …  
    367367             ENDIF
    368368             DO  k = 0,nz-1
    369                 a = -1.0 * ddzu(k+2) * ddzw(k+1)
    370                 c = -1.0 * ddzu(k+1) * ddzw(k+1)
     369                a = -1.0 * ddzu_pres(k+2) * ddzw(k+1)
     370                c = -1.0 * ddzu_pres(k+1) * ddzw(k+1)
    371371                tri(1,i,k) = a + c - ll(i)
    372372             ENDDO
    … …  
    379379                           ( dy * dy )
    380380             DO  k = 0, nz-1
    381                 a = -1.0 * ddzu(k+2) * ddzw(k+1)
    382                 c = -1.0 * ddzu(k+1) * ddzw(k+1)
     381                a = -1.0 * ddzu_pres(k+2) * ddzw(k+1)
     382                c = -1.0 * ddzu_pres(k+1) * ddzw(k+1)
    383383                tri(1,i,k) = a + c - ll(i)
    384384                IF ( i >= 1 .and. i < nnxh )  THEN
    … …  
    13631363       DO  k = 0, nz-1
    13641364          DO  i = 0,nx
    1365              tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
    1366              tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
     1365             tri(2,i,k) = ddzu_pres(k+1) * ddzw(k+1)
     1366             tri(3,i,k) = ddzu_pres(k+2) * ddzw(k+1)
    13671367          ENDDO
    13681368       ENDDO
    … …  
    14391439          DO  k = 0, nz-1
    14401440             DO  i = 0, nx
    1441                 a = -1.0 * ddzu(k+2) * ddzw(k+1)
    1442                 c = -1.0 * ddzu(k+1) * ddzw(k+1)
     1441                a = -1.0 * ddzu_pres(k+2) * ddzw(k+1)
     1442                c = -1.0 * ddzu_pres(k+1) * ddzw(k+1)
    14431443                tri(1,i,k) = a + c - l(i)
    14441444             ENDDO

  • TabularUnified palm/trunk/SOURCE/poisfft_hybrid.f90

    r482 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! ddzu replaced by ddzu_pres due to changes in zu(0).
    77!
    88! Former revisions:
    … …  
    848848       DO  k = 0, nz-1
    849849          DO  i = 0,nx
    850              tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
    851              tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
     850             tri(2,i,k) = ddzu_pres(k+1) * ddzw(k+1)
     851             tri(3,i,k) = ddzu_pres(k+2) * ddzw(k+1)
    852852          ENDDO
    853853       ENDDO
    … …  
    908908          DO  k = 0,nz-1
    909909             DO  i = 0, nx
    910                 a = -1.0 * ddzu(k+2) * ddzw(k+1)
    911                 c = -1.0 * ddzu(k+1) * ddzw(k+1)
     910                a = -1.0 * ddzu_pres(k+2) * ddzw(k+1)
     911                c = -1.0 * ddzu_pres(k+1) * ddzw(k+1)
    912912                tri(1,i,k) = a + c - l(i)
    913913             ENDDO

  • TabularUnified palm/trunk/SOURCE/poismg.f90

    r623 r667  
    88! Current revisions:
    99! -----------------
    10 !
     10! Calls of exchange_horiz are modified.
    1111!
    1212! Former revisions:
    … …  
    7070    CALL cpu_log( log_point_s(29), 'poismg', 'start' )
    7171
    72 
    7372!
    7473!-- Initialize arrays and variables used in this subroutine
    … …  
    7877!
    7978!-- Some boundaries have to be added to divergence array
    80     CALL exchange_horiz( d )
     79    CALL exchange_horiz( d, 1)
    8180    d(nzb,:,:) = d(nzb+1,:,:)
    8281
    … …  
    220219!
    221220!-- Horizontal boundary conditions
    222     CALL exchange_horiz( r )
     221    CALL exchange_horiz( r, 1)
    223222
    224223    IF ( bc_lr /= 'cyclic' )  THEN
    … …  
    393392!
    394393!-- Horizontal boundary conditions
    395     CALL exchange_horiz( f_mg )
     394    CALL exchange_horiz( f_mg, 1)
    396395
    397396    IF ( bc_lr /= 'cyclic' )  THEN
    … …  
    491490!
    492491!-- Horizontal boundary conditions
    493     CALL exchange_horiz( temp )
     492    CALL exchange_horiz( temp, 1)
    494493
    495494    IF ( bc_lr /= 'cyclic' )  THEN
    … …  
    861860!
    862861!--       Horizontal boundary conditions
    863           CALL exchange_horiz( p_mg )
     862          CALL exchange_horiz( p_mg, 1 )
    864863
    865864          IF ( bc_lr /= 'cyclic' )  THEN
    … …  
    936935!
    937936!-- One more time horizontal boundary conditions
    938     CALL exchange_horiz( p_mg )
     937    CALL exchange_horiz( p_mg, 1)
    939938
    940939 END SUBROUTINE redblack

  • TabularUnified palm/trunk/SOURCE/prandtl_fluxes.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6!
     7! Changed surface boundary conditions for u and v from mirror bc to dirichelt bc,
     8! therefore u(uzb,:,:) and v(nzb,:,:) is now representative for the height z0
     9!
     10! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    711!
    812! Former revisions:
    … …  
    5357    REAL    ::  a, b, e_q, rifm, uv_total, z_p
    5458
    55 !
     59! 
    5660!-- Compute theta*
    5761    IF ( constant_heatflux )  THEN
    … …  
    6064!--    for u* use the value from the previous time step
    6165       !$OMP PARALLEL DO
    62        DO  i = nxl-1, nxr+1
    63           DO  j = nys-1, nyn+1
     66       DO  i = nxlg, nxrg
     67          DO  j = nysg, nyng
    6468             ts(j,i) = -shf(j,i) / ( us(j,i) + 1E-30 )
    6569!
    … …  
    7680!--    (the Richardson number is still the one from the previous time step)
    7781       !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
    78        DO  i = nxl-1, nxr+1
    79           DO  j = nys-1, nyn+1
     82       DO  i = nxlg, nxrg
     83          DO  j = nysg, nyng
    8084
    8185             k   = nzb_s_inner(j,i)
    … …  
    108112    IF ( .NOT. humidity )  THEN
    109113       !$OMP PARALLEL DO PRIVATE( k, z_p )
    110        DO  i = nxl-1, nxr+1
    111           DO  j = nys-1, nyn+1
     114       DO  i = nxlg, nxrg
     115          DO  j = nysg, nyng
    112116             k   = nzb_s_inner(j,i)
    113117             z_p = zu(k+1) - zw(k)
    … …  
    126130    ELSE
    127131       !$OMP PARALLEL DO PRIVATE( k, z_p )
    128        DO  i = nxl-1, nxr+1
    129           DO  j = nys-1, nyn+1
     132       DO  i = nxlg, nxrg
     133          DO  j = nysg, nyng
    130134             k   = nzb_s_inner(j,i)
    131135             z_p = zu(k+1) - zw(k)
    … …  
    155159
    156160!
    157 !--       Compute the absolute value of the horizontal velocity
    158           uv_total = SQRT( ( 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) ) )**2 + &
    159                            ( 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) ) )**2   &
    160                          )
     161!--       Compute the absolute value of the horizontal velocity
     162!--       (relative to the surface)
     163          uv_total = SQRT( ( 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1)        &
     164                                   - u(k,j,i)   - u(k,j,i+1) ) )**2 + &
     165                           ( 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i)        &
     166                                   - v(k,j,i)   - v(k,j+1,i) ) )**2 )   
     167
    161168
    162169          IF ( rif(j,i) >= 0.0 )  THEN
    … …  
    203210!
    204211!--          Stable stratification
    205              usws(j,i) = kappa * u(k+1,j,i) / (                           &
     212             usws(j,i) = kappa * ( u(k+1,j,i) - u(k,j,i) )/ (              &
    206213                                     LOG( z_p / z0(j,i) ) +               &
    207214                                     5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
    … …  
    213220             b = SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
    214221
    215              usws(j,i) = kappa * u(k+1,j,i) / (                           &
     222             usws(j,i) = kappa * ( u(k+1,j,i) - u(k,j,i) ) / (            &
    216223                         LOG( z_p / z0(j,i) ) -                           &
    217224                         LOG( (1.0 + a )**2 * ( 1.0 + a**2 ) / (          &
    … …  
    240247!
    241248!--          Stable stratification
    242              vsws(j,i) = kappa * v(k+1,j,i) / (                           &
     249             vsws(j,i) = kappa * ( v(k+1,j,i) -  v(k,j,i) ) / (           &
    243250                                     LOG( z_p / z0(j,i) ) +               &
    244251                                     5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
    … …  
    250257             b = SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
    251258
    252              vsws(j,i) = kappa * v(k+1,j,i) / (                           &
     259             vsws(j,i) = kappa * ( v(k+1,j,i) - v(k,j,i) ) / (            &
    253260                         LOG( z_p / z0(j,i) ) -                           &
    254261                         LOG( (1.0 + a )**2 * ( 1.0 + a**2 ) / (          &
    … …  
    268275!--       For a given water flux in the Prandtl layer:
    269276          !$OMP PARALLEL DO
    270           DO  i = nxl-1, nxr+1
    271              DO  j = nys-1, nyn+1
     277          DO  i = nxlg, nxrg
     278             DO  j = nysg, nyng
    272279                qs(j,i) = -qsws(j,i) / ( us(j,i) + 1E-30 )
    273280             ENDDO
    … …  
    276283       ELSE         
    277284          !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
    278           DO  i = nxl-1, nxr+1
    279              DO  j = nys-1, nyn+1
     285          DO  i = nxlg, nxrg
     286             DO  j = nysg, nyng
    280287
    281288                k   = nzb_s_inner(j,i)
    … …  
    325332    IF ( .NOT. constant_heatflux )  THEN
    326333       !$OMP PARALLEL DO
    327        DO  i = nxl-1, nxr+1
    328           DO  j = nys-1, nyn+1
     334       DO  i = nxlg, nxrg
     335          DO  j = nysg, nyng
    329336             shf(j,i) = -ts(j,i) * us(j,i)
    330337          ENDDO
    … …  
    336343    IF ( .NOT. constant_waterflux .AND. ( humidity .OR. passive_scalar ) ) THEN
    337344       !$OMP PARALLEL DO
    338        DO  i = nxl-1, nxr+1
    339           DO  j = nys-1, nyn+1
     345       DO  i = nxlg, nxrg
     346          DO  j = nysg, nyng
    340347             qsws(j,i) = -qs(j,i) * us(j,i)
    341348          ENDDO
    … …  
    347354    IF ( ibc_e_b == 2 )  THEN
    348355       !$OMP PARALLEL DO
    349        DO  i = nxl-1, nxr+1
    350           DO  j = nys-1, nyn+1
     356       DO  i = nxlg, nxrg
     357          DO  j = nysg, nyng
    351358             e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.1 )**2
    352359!

  • TabularUnified palm/trunk/SOURCE/pres.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! New allocation of tend when ws-scheme and multigrid is used. This is due to
     7! reasons of perforance of the data_exchange. The same is done with p after
     8! poismg is called.
     9! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng when no
     10! multigrid is used. Calls of exchange_horiz are modified.
     11!
     12! bugfix: After pressure correction no volume flow correction in case of
     13! non-cyclic boundary conditions
     14! (has to be done only before pressure correction)
     15!
     16! Call of SOR routine is referenced with ddzu_pres.
    717!
    818! Former revisions:
    … …  
    7484
    7585!
    76 !-- Multigrid method needs additional grid points for the divergence array
     86!-- Multigrid method expects 1 additional grid point for the arrays
     87!-- d, tend and p
    7788    IF ( psolver == 'multigrid' )  THEN
     89     
    7890       DEALLOCATE( d )
    79        ALLOCATE( d(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     91       ALLOCATE( d(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     92       
     93       IF ( ws_scheme_mom  .OR. ws_scheme_sca )  THEN
     94       
     95          DEALLOCATE( tend )
     96          ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     97          DEALLOCATE( p )
     98          ALLOCATE( p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     99         
     100       ENDIF
     101       
    80102    ENDIF
    81103
    … …  
    103125!--       Sum up the volume flow through the south/north boundary
    104126          DO  k = nzb_2d(j,i) + 1, nzt
    105              volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzu(k)
     127             volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k)
    106128          ENDDO
    107129       ENDDO
    … …  
    117139                               / volume_flow_area(1)
    118140
    119        DO  j = nys-1, nyn+1
    120           DO  k = nzb_v_inner(j,i) + 1, nzt
     141       DO  j = nysg, nyng
     142          DO  k = nzb_2d(j,i) + 1, nzt
    121143             u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
    122144          ENDDO
    … …  
    142164!--       Sum up the volume flow through the south/north boundary
    143165          DO  k = nzb_2d(j,i) + 1, nzt
    144              volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzu(k)
     166             volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k)
    145167          ENDDO
    146168       ENDDO
    … …  
    156178                               / volume_flow_area(2)
    157179
    158        DO  i = nxl-1, nxr+1
     180       DO  i = nxlg, nxrg
    159181          DO  k = nzb_v_inner(j,i) + 1, nzt
    160182             v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
    … …  
    186208             w_l(k) = w_l(k) / ngp_2dh_outer(k,0)
    187209          ENDDO
    188           DO  i = nxl-1, nxr+1
    189              DO  j = nys-1, nyn+1
     210          DO  i = nxlg, nxrg
     211             DO  j = nysg, nyng
    190212                DO  k = nzb_w_inner(j,i)+1, nzt
    191213                   w(k,j,i) = w(k,j,i) - w_l(k)
    … …  
    267289          DO  j = nys, nyn
    268290             DO  k = nzb_s_inner(j,i)+1, nzt
    269                 d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
    270                              ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
    271                              ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
     291             d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
     292                          ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
     293                          ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
    272294             ENDDO
    273295          ENDDO
    … …  
    298320             DO  k = nzb_s_inner(j,i)+1, nzt
    299321                d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
    300                              ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
    301                              ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
     322                          ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
     323                          ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
    302324             ENDDO
    303325          ENDDO
    … …  
    331353!-- comment line)
    332354!    CALL global_min_max( nzb+1, nzt, nys, nyn, nxl, nxr, d, 'abs', divmax, &
    333 !                         divmax_ijk )
     355!                        divmax_ijk )
    334356
    335357    CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
    … …  
    364386       IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
    365387          DEALLOCATE( tend )
    366           ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     388          ALLOCATE( tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    367389       ENDIF
    368390
    … …  
    387409!--       Neumann (dp/dz = 0)
    388410          !$OMP PARALLEL DO
    389           DO  i = nxl-1, nxr+1
    390              DO  j = nys-1, nyn+1
     411          DO  i = nxlg, nxrg
     412             DO  j = nysg, nyng
    391413                tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
    392414             ENDDO
    … …  
    400422!--       the computation (cf. above: computation of divergences).
    401423          !$OMP PARALLEL DO
    402           DO  i = nxl-1, nxr+1
    403              DO  j = nys-1, nyn+1
     424          DO  i = nxlg, nxrg
     425             DO  j = nysg, nyng
    404426                tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
    405427             ENDDO
    … …  
    410432!--       Dirichlet
    411433          !$OMP PARALLEL DO
    412           DO  i = nxl-1, nxr+1
    413              DO  j = nys-1, nyn+1
     434          DO  i = nxlg, nxrg
     435             DO  j = nysg, nyng
    414436                tend(nzb_s_inner(j,i),j,i) = 0.0
    415437             ENDDO
    … …  
    424446!--       Neumann
    425447          !$OMP PARALLEL DO
    426           DO  i = nxl-1, nxr+1
    427              DO  j = nys-1, nyn+1
     448          DO  i = nxlg, nxrg
     449             DO  j = nysg, nyng
    428450                tend(nzt+1,j,i) = tend(nzt,j,i)
    429451             ENDDO
    … …  
    434456!--       Dirichlet
    435457          !$OMP PARALLEL DO
    436           DO  i = nxl-1, nxr+1
    437              DO  j = nys-1, nyn+1
     458          DO  i = nxlg, nxrg
     459             DO  j = nysg, nyng
    438460                tend(nzt+1,j,i) = 0.0
    439461             ENDDO
    … …  
    444466!
    445467!--    Exchange boundaries for p
    446        CALL exchange_horiz( tend )
     468       CALL exchange_horiz( tend, nbgp )
    447469     
    448470    ELSEIF ( psolver == 'sor' )  THEN
    … …  
    451473!--    Solve Poisson equation for perturbation pressure using SOR-Red/Black
    452474!--    scheme
    453        CALL sor( d, ddzu, ddzw, p )
     475       CALL sor( d, ddzu_pres, ddzw, p )
    454476       tend = p
    455477
    … …  
    458480!
    459481!--    Solve Poisson equation for perturbation pressure using Multigrid scheme,
    460 !--    array tend is used to store the residuals
     482!--    array tend is used to store the residuals, logical exchange_mg is used
     483!--    to discern data exchange in multigrid ( 1 ghostpoint ) and normal grid
     484!--    ( nbgp ghost points ).
     485       exchange_mg = .TRUE.
    461486       CALL poismg( tend )
    462  
     487       exchange_mg = .FALSE.
    463488!
    464489!--    Restore perturbation pressure on tend because this array is used
    465490!--    further below to correct the velocity fields
     491
    466492       tend = p
     493       IF( ws_scheme_mom .OR. ws_scheme_sca )  THEN
     494!       
     495!--       Allocate p to its normal size and restore pressure.         
     496          DEALLOCATE( p )
     497          ALLOCATE( p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     498          DO  i = nxl, nxr
     499             DO  j = nys, nyn
     500                DO  k = nzb_s_inner(j,i), nzt
     501                   p(k,j,i) = tend(k,j,i)
     502                ENDDO
     503             ENDDO
     504          ENDDO
     505       ENDIF
    467506
    468507    ENDIF
    … …  
    476515!--    optimization
    477516       !$OMP PARALLEL DO
    478        DO  j = nys-1, nyn+1
     517       DO  j = nysg, nyng
    479518          DO  k = nzb, nzt+1
    480              p(k,j,nxl-1) = tend(k,j,nxl-1)
    481              p(k,j,nxr+1) = tend(k,j,nxr+1)
     519             p(k,j,nxlg:nxl-1) = tend(k,j,nxlg:nxl-1)
     520             p(k,j,nxr+1:nxrg) = tend(k,j,nxr+1:nxrg)
    482521          ENDDO
    483522       ENDDO
    … …  
    496535    DO  i = nxl, nxr
    497536       IF ( psolver(1:7) == 'poisfft' )  THEN
    498           DO  j = nys-1, nyn+1
     537          DO  j = nysg, nyng
    499538             DO  k = nzb, nzt+1
    500539                p(k,j,i) = tend(k,j,i)
    … …  
    517556!--       Sum up the volume flow through the right and north boundary
    518557          IF ( conserve_volume_flow  .AND.  bc_lr == 'cyclic'  .AND. &
    519                i == nx )  THEN
     558               bc_ns == 'cyclic' .AND. i == nx )  THEN
    520559             !$OMP CRITICAL
    521560             DO  k = nzb_2d(j,i) + 1, nzt
    522                 volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzu(k)
     561                volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k)
    523562             ENDDO
    524563             !$OMP END CRITICAL
    525564          ENDIF
    526565          IF ( conserve_volume_flow  .AND.  bc_ns == 'cyclic'  .AND. &
    527                j == ny )  THEN
     566               bc_lr == 'cyclic' .AND. j == ny )  THEN
    528567             !$OMP CRITICAL
    529568             DO  k = nzb_2d(j,i) + 1, nzt
    530                 volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzu(k)
     569                volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k)
    531570             ENDDO
    532571             !$OMP END CRITICAL
    … …  
    538577
    539578!
     579!-- Resize tend to its normal size in case of multigrid and ws-scheme.
     580    IF ( psolver == 'multigrid' .AND. ( ws_scheme_mom        &
     581                                   .OR. ws_scheme_sca ) )  THEN
     582       DEALLOCATE( tend )
     583       ALLOCATE( tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     584    ENDIF
     585
     586!
    540587!-- Conserve the volume flow
    541588    IF ( conserve_volume_flow  .AND. &
    542          ( bc_lr == 'cyclic'  .OR.  bc_ns == 'cyclic' ) )  THEN
     589         ( bc_lr == 'cyclic'  .AND.  bc_ns == 'cyclic' ) )  THEN
    543590
    544591#if defined( __parallel )   
    … …  
    557604       DO  i = nxl, nxr
    558605          DO  j = nys, nyn
    559              IF ( bc_lr == 'cyclic' )  THEN
    560                 DO  k = nzb_u_inner(j,i) + 1, nzt
    561                    u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
    562                 ENDDO
    563              ENDIF
    564              IF ( bc_ns == 'cyclic' )  THEN
    565                 DO  k = nzb_v_inner(j,i) + 1, nzt
    566                    v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
    567                 ENDDO
    568              ENDIF
    569           ENDDO
    570        ENDDO
     606             DO  k = nzb_u_inner(j,i) + 1, nzt
     607                u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
     608                v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
     609             ENDDO
     610          ENDDO
     611       ENDDO
     612
    571613       !$OMP END PARALLEL
    572614
    … …  
    575617!
    576618!-- Exchange of boundaries for the velocities
    577     CALL exchange_horiz( u )
    578     CALL exchange_horiz( v )
    579     CALL exchange_horiz( w )
     619    CALL exchange_horiz( u, nbgp )
     620    CALL exchange_horiz( v, nbgp )
     621    CALL exchange_horiz( w, nbgp )
    580622
    581623!
    … …  
    620662    ENDDO
    621663#endif
     664
    622665    localsum = localsum + threadsum
    623666    !$OMP END PARALLEL
    … …  
    631674
    632675    CALL cpu_log( log_point(8), 'pres', 'stop' )
     676   
    633677
    634678

  • TabularUnified palm/trunk/SOURCE/production_e.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    77!
    88! Former revisions:
    … …  
    11091109
    11101110          IF ( first_call )  THEN
    1111              ALLOCATE( u_0(nys-1:nyn+1,nxl-1:nxr+1), &
    1112                        v_0(nys-1:nyn+1,nxl-1:nxr+1) )
     1111             ALLOCATE( u_0(nysg:nyng,nxlg:nxrg), &
     1112                       v_0(nysg:nyng,nxlg:nxrg) )
    11131113             first_call = .FALSE.
    11141114          ENDIF

  • TabularUnified palm/trunk/SOURCE/prognostic_equations.f90

    r532 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Calls of the advection routines with WS5 added.
     7! Calls of ws_statistics added to set the statistical arrays to zero after each
     8! time step.
    79!
    810! Former revisions:
    … …  
    7981    USE pointer_interfaces
    8082    USE statistics
    81 
     83    USE advec_ws
    8284    USE advec_s_pw_mod
    8385    USE advec_s_up_mod
    … …  
    144146    IF ( ocean    )  CALL calc_mean_profile( rho, 64 )
    145147    IF ( humidity )  CALL calc_mean_profile( vpt, 44 )
     148    IF ( ( ws_scheme_mom .OR. ws_scheme_sca ) .AND. &
     149       intermediate_timestep_count == 1 )  CALL ws_statistics
    146150
    147151!
    … …  
    164168          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    165169             tend(:,j,i) = 0.0
    166              CALL advec_u_pw( i, j )
     170             IF ( ws_scheme_mom )  THEN
     171                 CALL advec_u_ws( i, j )
     172             ELSE
     173                 CALL advec_u_pw( i, j )
     174             ENDIF
     175
    167176          ELSE
    168177             IF ( momentum_advec /= 'ups-scheme' )  THEN
    … …  
    245254          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    246255             tend(:,j,i) = 0.0
    247              CALL advec_v_pw( i, j )
     256             IF ( ws_scheme_mom )  THEN
     257                 CALL advec_v_ws( i, j )
     258             ELSE
     259                 CALL advec_v_pw( i, j )
     260             ENDIF
     261
    248262          ELSE
    249263             IF ( momentum_advec /= 'ups-scheme' )  THEN
    … …  
    325339          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    326340             tend(:,j,i) = 0.0
    327              CALL advec_w_pw( i, j )
     341             IF ( ws_scheme_mom )  THEN
     342                 CALL advec_w_ws( i, j )
     343             ELSE 
     344                 CALL advec_w_pw( i, j )
     345             ENDIF
     346
    328347          ELSE
    329348             IF ( momentum_advec /= 'ups-scheme' )  THEN
    … …  
    425444             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    426445                tend(:,j,i) = 0.0
    427                 CALL advec_s_pw( i, j, pt )
     446                IF ( ws_scheme_sca )  THEN
     447                   CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, &
     448                                 diss_s_pt, flux_l_pt, diss_l_pt )
     449                ELSE
     450                    CALL advec_s_pw( i, j, pt )
     451                ENDIF
    428452             ELSE
    429453                IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    541565                IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) THEN
    542566                   tend(:,j,i) = 0.0
    543                    CALL advec_s_pw( i, j, sa )
     567                   IF ( ws_scheme_sca )  THEN
     568                       CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa,  &
     569                                    diss_s_sa, flux_l_sa, diss_l_sa )
     570                   ELSE
     571                       CALL advec_s_pw( i, j, sa )
     572                   ENDIF
     573
    544574                ELSE
    545575                   IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    634664                IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) THEN
    635665                   tend(:,j,i) = 0.0
    636                    CALL advec_s_pw( i, j, q )
     666                   IF ( ws_scheme_sca )  THEN
     667                       CALL advec_s_ws( i, j, q, 'q', flux_s_q, &
     668                                   diss_s_q, flux_l_q, diss_l_q )
     669                   ELSE
     670                       CALL advec_s_pw( i, j, q )
     671                   ENDIF
    637672                ELSE
    638673                   IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    661696!--          Sink or source of scalar concentration due to canopy elements
    662697             IF ( plant_canopy ) CALL plant_canopy_model( i, j, 5 )
    663 
     698             
    664699!
    665700!--          If required compute influence of large-scale subsidence/ascent
    … …  
    769804                   THEN
    770805                      tend(:,j,i) = 0.0
    771                       CALL advec_s_pw( i, j, e )
     806                      IF ( ws_scheme_sca )  THEN
     807                          CALL advec_s_ws( i, j, e, 'e', flux_s_e, &
     808                                      diss_s_e, flux_l_e, diss_l_e )
     809                      ELSE
     810                          CALL advec_s_pw( i, j, e )
     811                      ENDIF
    772812                   ELSE
    773813                      IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    884924    IF ( humidity )  CALL calc_mean_profile( vpt, 44 )
    885925    IF ( .NOT. constant_diffusion )  CALL production_e_init
     926    IF ( ( ws_scheme_mom .OR. ws_scheme_sca ) .AND. &
     927       intermediate_timestep_count == 1 )  CALL ws_statistics
    886928
    887929
    … …  
    898940             tend(:,j,i) = 0.0
    899941             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    900                 CALL advec_u_pw( i, j )
    901              ELSE
     942                IF ( ws_scheme_mom )  THEN
     943    !               CALL local_diss( i, j, u)    ! dissipation control
     944                   CALL advec_u_ws( i, j )
     945                ELSE
     946                   CALL advec_u_pw( i, j )
     947                ENDIF
     948            ELSE
    902949                CALL advec_u_up( i, j )
    903950             ENDIF
    … …  
    9621009             tend(:,j,i) = 0.0
    9631010             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    964                 CALL advec_v_pw( i, j )
     1011                IF ( ws_scheme_mom )  THEN
     1012                 !   CALL local_diss( i, j, v)
     1013                    CALL advec_v_ws( i, j )
     1014                ELSE
     1015                    CALL advec_v_pw( i, j )
     1016                ENDIF
    9651017             ELSE
    9661018                CALL advec_v_up( i, j )
    … …  
    10221074          tend(:,j,i) = 0.0
    10231075          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    1024              CALL advec_w_pw( i, j )
     1076             IF ( ws_scheme_mom )  THEN
     1077             !   CALL local_diss( i, j, w)
     1078                CALL advec_w_ws( i, j )
     1079             ELSE
     1080                CALL advec_w_pw( i, j )
     1081             END IF
    10251082          ELSE
    10261083             CALL advec_w_up( i, j )
    … …  
    10811138          tend(:,j,i) = 0.0
    10821139          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    1083              CALL advec_s_pw( i, j, pt )
     1140                IF ( ws_scheme_sca )  THEN
     1141       !            CALL local_diss( i, j, pt )
     1142                   CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, &
     1143                             diss_s_pt, flux_l_pt, diss_l_pt )
     1144                ELSE
     1145                   CALL advec_s_pw( i, j, pt )
     1146                ENDIF
    10841147          ELSE
    10851148             CALL advec_s_up( i, j, pt )
    … …  
    11191182          ENDIF
    11201183
     1184
    11211185          CALL user_actions( i, j, 'pt-tendency' )
    11221186
    … …  
    11561220             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
    11571221             THEN
    1158                 CALL advec_s_pw( i, j, sa )
     1222                IF ( ws_scheme_sca )  THEN
     1223            !        CALL local_diss( i, j, sa )
     1224                    CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa,  &
     1225                                diss_s_sa, flux_l_sa, diss_l_sa  )
     1226                ELSE
     1227                    CALL advec_s_pw( i, j, sa )
     1228                ENDIF
    11591229             ELSE
    11601230                CALL advec_s_up( i, j, sa )
    … …  
    12081278             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
    12091279             THEN
    1210                 CALL advec_s_pw( i, j, q )
     1280                IF ( ws_scheme_sca )  THEN
     1281          !         CALL local_diss( i, j, q )
     1282                   CALL advec_s_ws( i, j, q, 'q', flux_s_q, &
     1283                                diss_s_q, flux_l_q, diss_l_q )
     1284                ELSE
     1285                   CALL advec_s_pw( i, j, q )
     1286                ENDIF
    12111287             ELSE
    12121288                CALL advec_s_up( i, j, q )
    … …  
    12321308             IF ( plant_canopy ) CALL plant_canopy_model( i, j, 5 )
    12331309
    1234 
    12351310!--          If required compute influence of large-scale subsidence/ascent
    12361311             IF ( large_scale_subsidence ) THEN
    12371312                CALL subsidence ( i, j, tend, q, q_init )
    12381313             ENDIF
    1239 
    12401314
    12411315             CALL user_actions( i, j, 'q-tendency' )
    … …  
    12791353             tend(:,j,i) = 0.0
    12801354             IF ( ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  &
    1281                   .AND.  .NOT. use_upstream_for_tke )  THEN
    1282                 CALL advec_s_pw( i, j, e )
     1355                 .AND.  .NOT. use_upstream_for_tke )  THEN
     1356                 IF ( ws_scheme_sca )  THEN
     1357                 !    CALL local_diss( i, j, e )
     1358                     CALL advec_s_ws( i, j, e, 'e', flux_s_e, &
     1359                                diss_s_e, flux_l_e, diss_l_e  )
     1360                 ELSE
     1361                     CALL advec_s_pw( i, j, e )
     1362                 ENDIF
    12831363             ELSE
    12841364                CALL advec_s_up( i, j, e )
    … …  
    13791459    IF ( ocean    )  CALL calc_mean_profile( rho, 64 )
    13801460    IF ( humidity )  CALL calc_mean_profile( vpt, 44 )
     1461    IF ( ( ws_scheme_mom .OR. ws_scheme_sca ) .AND. &
     1462       intermediate_timestep_count == 1 )  CALL ws_statistics
    13811463
    13821464!
    … …  
    13951477    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    13961478       tend = 0.0
    1397        CALL advec_u_pw
     1479       IF ( ws_scheme_mom )  THEN
     1480          CALL advec_u_ws
     1481       ELSE
     1482          CALL advec_u_pw
     1483       ENDIF
    13981484    ELSE
    13991485       IF ( momentum_advec /= 'ups-scheme' )  THEN
    … …  
    14841570    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    14851571       tend = 0.0
    1486        CALL advec_v_pw
     1572       IF ( ws_scheme_mom )  THEN
     1573          CALL advec_v_ws
     1574       ELSE
     1575          CALL advec_v_pw
     1576       END IF
    14871577    ELSE
    14881578       IF ( momentum_advec /= 'ups-scheme' )  THEN
    … …  
    15721662    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    15731663       tend = 0.0
    1574        CALL advec_w_pw
     1664       IF ( ws_scheme_mom )  THEN
     1665          CALL advec_w_ws
     1666       ELSE
     1667          CALL advec_w_pw
     1668       ENDIF
    15751669    ELSE
    15761670       IF ( momentum_advec /= 'ups-scheme' )  THEN
    … …  
    16761770       IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    16771771          tend = 0.0
    1678           CALL advec_s_pw( pt )
     1772          IF ( ws_scheme_sca )  THEN
     1773             CALL advec_s_ws( pt, 'pt' )
     1774          ELSE
     1775             CALL advec_s_pw( pt )
     1776          ENDIF
    16791777       ELSE
    16801778          IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    17951893          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    17961894             tend = 0.0
    1797              CALL advec_s_pw( sa )
     1895             IF ( ws_scheme_sca )  THEN
     1896                 CALL advec_s_ws( sa, 'sa' )
     1897             ELSE
     1898                 CALL advec_s_pw( sa )
     1899             ENDIF
    17981900          ELSE
    17991901             IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    18941996          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    18951997             tend = 0.0
    1896              CALL advec_s_pw( q )
     1998             IF ( ws_scheme_sca )  THEN
     1999                CALL advec_s_ws( q, 'q' )
     2000             ELSE
     2001                CALL advec_s_pw( q )
     2002             ENDIF
    18972003          ELSE
    18982004             IF ( scalar_advec /= 'ups-scheme' )  THEN
    … …  
    19202026!--    Sink or source of scalar concentration due to canopy elements
    19212027       IF ( plant_canopy ) CALL plant_canopy_model( 5 )
    1922 
     2028       
    19232029!
    19242030!--    If required compute influence of large-scale subsidence/ascent
    … …  
    20292135             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
    20302136                tend = 0.0
    2031                 CALL advec_s_pw( e )
     2137                IF ( ws_scheme_sca )  THEN
     2138                   CALL advec_s_ws( e, 'e' )
     2139                ELSE
     2140                   CALL advec_s_pw( e )
     2141                ENDIF
    20322142             ELSE
    20332143                IF ( scalar_advec /= 'ups-scheme' )  THEN

  • TabularUnified palm/trunk/SOURCE/read_3d_binary.f90

    r449 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! +/- 1 replaced with +/- nbgp when swapping and allocating variables.
     7! Bugfix: When using initializing_actions = 'cyclic_fill' in some cases
     8! not the whole model domain was filled with data of the prerun.
    79!
    810! Former revisions:
    … …  
    128130!--    matches another time(s) in the current subdomain by shifting it
    129131!--    for nx_on_file+1, ny_on_file+1 respectively
    130 
     132   
    131133       shift_y = 0
    132        j       = 0  ! counter for the number of files to be opened
    133 
    134        DO WHILE ( nyspr+shift_y <= nyn-offset_y  .AND.  &
    135                   nynpr+shift_y >= nys-offset_y )
    136 
    137           shift_x = 0
    138 
    139           DO WHILE ( nxlpr+shift_x <= nxr-offset_x  .AND. &
    140                      nxrpr+shift_x >= nxl-offset_x )
    141 
    142              j = j +1
    143 
    144              IF ( j > 1000 )  THEN
    145 !
    146 !--             Array bound exceeded
    147                 message_string = 'data from subdomain of previous' // &
    148                                  ' run mapped more than 1000 times'
    149                 CALL message( 'read_3d_binary', 'PA0284', 2, 2, -1, 6, 1 )
    150  
    151              ENDIF
    152 
    153              IF ( j == 1 )  THEN
    154                 files_to_be_opened = files_to_be_opened + 1
    155                 file_list(files_to_be_opened) = i-1
    156              ENDIF
    157 
    158              offset_xa(files_to_be_opened,j) = offset_x + shift_x
    159              offset_ya(files_to_be_opened,j) = offset_y + shift_y
    160 
    161 !
    162 !--          Index bounds of overlapping data
    163              nxlfa(files_to_be_opened,j) = MAX( nxl-offset_x-shift_x, nxlpr )
    164              nxrfa(files_to_be_opened,j) = MIN( nxr-offset_x-shift_x, nxrpr )
    165              nysfa(files_to_be_opened,j) = MAX( nys-offset_y, nyspr )
    166              nynfa(files_to_be_opened,j) = MIN( nyn-offset_y, nynpr )
    167 
    168              shift_x = shift_x + ( nx_on_file + 1 )
    169 
    170           ENDDO
    171 
    172           shift_y = shift_y + ( ny_on_file + 1 )
    173 
     134       j       = 0
     135       DO WHILE (  nyspr+shift_y <= nyn-offset_y )
     136         
     137          IF ( nynpr+shift_y >= nys-offset_y ) THEN
     138
     139             shift_x = 0
     140             DO WHILE ( nxlpr+shift_x <= nxr-offset_x )
     141               
     142                IF ( nxrpr+shift_x >= nxl-offset_x ) THEN
     143                   j = j +1
     144                   IF ( j > 1000 )  THEN
     145!
     146!--                   Array bound exceeded
     147                      message_string = 'data from subdomain of previous' // &
     148                                       ' run mapped more than 1000 times'
     149                      CALL message( 'read_3d_binary', 'PA0284', 2, 2, -1,   &
     150                                       6, 1 )
     151                   ENDIF
     152
     153                   IF ( j == 1 )  THEN
     154                      files_to_be_opened = files_to_be_opened + 1
     155                      file_list(files_to_be_opened) = i-1
     156                   ENDIF
     157                     
     158                   offset_xa(files_to_be_opened,j) = offset_x + shift_x
     159                   offset_ya(files_to_be_opened,j) = offset_y + shift_y
     160!
     161!--                Index bounds of overlapping data
     162                   nxlfa(files_to_be_opened,j) = MAX( nxl-offset_x-shift_x, nxlpr )
     163                   nxrfa(files_to_be_opened,j) = MIN( nxr-offset_x-shift_x, nxrpr )
     164                   nysfa(files_to_be_opened,j) = MAX( nys-offset_y-shift_y, nyspr )
     165                   nynfa(files_to_be_opened,j) = MIN( nyn-offset_y-shift_y, nynpr )
     166
     167                ENDIF
     168
     169                shift_x = shift_x + ( nx_on_file + 1 )
     170             ENDDO
     171       
     172          ENDIF
     173             
     174          shift_y = shift_y + ( ny_on_file + 1 )             
    174175       ENDDO
    175 
     176         
    176177       IF ( j > 0 )  overlap_count(files_to_be_opened) = j
    177178
    … …  
    180181       IF ( j > 0 )  THEN
    181182          WRITE (9,*) '*** reading from file: ', i, j, ' times'
    182           WRITE (9,*) '    nxl = ', nxl, ' nxr = ', nxr, ' nys = ', nys, ' nyn = ', nyn
     183          WRITE (9,*) '    nxl = ', nxl, ' nxr = ', nxr, ' nys = ', &
     184                                    nys, ' nyn = ', nyn
    183185          WRITE (9,*) ' '
    184186          DO  k = 1, j
    185187             WRITE (9,*) 'k = ', k
    186              WRITE (9,'(6(A,I4))')  'nxlfa = ', nxlfa(files_to_be_opened,k), &
    187                          ' nxrfa = ', nxrfa(files_to_be_opened,k), &
    188                          ' offset_xa = ', offset_xa(files_to_be_opened,k), &
    189                          ' nysfa = ', nysfa(files_to_be_opened,k), &
    190                          ' nynfa = ', nynfa(files_to_be_opened,k), &
    191                          ' offset_ya = ', offset_ya(files_to_be_opened,k)
     188             WRITE (9,'(6(A,I4))') 'nxlfa = ', nxlfa(files_to_be_opened,k),&
     189                     ' nxrfa = ', nxrfa(files_to_be_opened,k), &
     190                     ' offset_xa = ', offset_xa(files_to_be_opened,k), &
     191                     ' nysfa = ', nysfa(files_to_be_opened,k), &
     192                     ' nynfa = ', nynfa(files_to_be_opened,k), &
     193                     ' offset_ya = ', offset_ya(files_to_be_opened,k)
    192194          ENDDO
    193195          CALL local_flush( 9 )
    194196       ENDIF
    195197
     198         
    196199    ENDDO
    197 
     200   
    198201!
    199202!-- Save the id-string of the current process, since myid_char may now be used
    200203!-- to open files created by PEs with other id.
    201     myid_char_save = myid_char
     204          myid_char_save = myid_char
    202205
    203206!
    204207!-- Test output (remove later)
     208         
    205209    DO i = 1, numprocs_previous_run
    206210       WRITE (9,*) 'i=',i-1, ' ibs= ',hor_index_bounds_previous_run(1:4,i-1)
    … …  
    311315!
    312316!--    Allocate temporary arrays sized as the arrays on the restart file
    313        ALLOCATE( tmp_2d(nys_on_file-1:nyn_on_file+1,           &
    314                         nxl_on_file-1:nxr_on_file+1),          &
    315                  tmp_3d(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
    316                         nxl_on_file-1:nxr_on_file+1) )
     317       ALLOCATE( tmp_2d(nys_on_file-nbgp:nyn_on_file+nbgp,           &
     318                        nxl_on_file-nbgp:nxr_on_file+nbgp),          &
     319                 tmp_3d(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp, &
     320                        nxl_on_file-nbgp:nxr_on_file+nbgp) )
    317321
    318322!
    … …  
    349353                CASE ( 'e' )
    350354                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    351                    e(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    352                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     355                   e(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     356                           tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    353357
    354358                CASE ( 'e_av' )
    355359                   IF ( .NOT. ALLOCATED( e_av ) )  THEN
    356                       ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    357                    ENDIF
    358                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    359                    e_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    360                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     360                      ALLOCATE( e_av(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
     361                   ENDIF
     362                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     363                   e_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     364                            tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    361365
    362366                CASE ( 'e_m' )
    363367                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    364                    e_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    365                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     368                   e_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     369                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    366370
    367371                CASE ( 'iran' ) ! matching random numbers is still unresolved
    … …  
    371375                CASE ( 'kh' )
    372376                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    373                    kh(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    374                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     377                   kh(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     378                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    375379
    376380                CASE ( 'kh_m' )
    377381                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    378                    kh_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    379                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     382                   kh_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     383                              tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    380384
    381385                CASE ( 'km' )
    382386                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    383                    km(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    384                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     387                   km(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     388                               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    385389
    386390                CASE ( 'km_m' )
    387391                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    388                    km_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    389                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     392                   km_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     393                                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    390394
    391395                CASE ( 'lwp_av' )
    392396                   IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
    393                       ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
    394                    ENDIF
    395                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    396                    lwp_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    397                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     397                      ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
     398                   ENDIF
     399                   IF ( k == 1 )  READ ( 13 )  tmp_2d
     400                   lwp_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     401                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    398402
    399403                CASE ( 'p' )
    400404                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    401                    p(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    402                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     405                   p(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     406                                 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    403407
    404408                CASE ( 'p_av' )
    405409                   IF ( .NOT. ALLOCATED( p_av ) )  THEN
    406                       ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    407                    ENDIF
    408                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    409                    p_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    410                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     410                      ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     411                   ENDIF
     412                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     413                   p_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     414                                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    411415
    412416                CASE ( 'pc_av' )
    413417                   IF ( .NOT. ALLOCATED( pc_av ) )  THEN
    414                       ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    415                    ENDIF
    416                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    417                    pc_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    418                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     418                      ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     419                   ENDIF
     420                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     421                   pc_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     422                                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    419423
    420424                CASE ( 'pr_av' )
    421425                   IF ( .NOT. ALLOCATED( pr_av ) )  THEN
    422                       ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    423                    ENDIF
    424                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    425                    pr_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    426                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     426                      ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     427                   ENDIF
     428                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     429                   pr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     430                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    427431
    428432                CASE ( 'precipitation_amount' )
    429433                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    430                    precipitation_amount(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    431                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     434                   precipitation_amount(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     435                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    432436
    433437                CASE ( 'precipitation_rate_a' )
    434438                   IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
    435                       ALLOCATE( precipitation_rate_av(nys-1:nyn+1,nxl-1:nxr+1) )
    436                    ENDIF
    437                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    438                    precipitation_rate_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    439                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     439                      ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
     440                   ENDIF
     441                   IF ( k == 1 )  READ ( 13 )  tmp_2d
     442                   precipitation_rate_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     443                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    440444
    441445                CASE ( 'pt' )
    442446                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    443                    pt(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    444                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     447                   pt(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     448                                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    445449
    446450                CASE ( 'pt_av' )
    447451                   IF ( .NOT. ALLOCATED( pt_av ) )  THEN
    448                       ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    449                    ENDIF
    450                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    451                    pt_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    452                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     452                      ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     453                   ENDIF
     454                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     455                   pt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     456                                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    453457
    454458                CASE ( 'pt_m' )
    455459                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    456                    pt_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    457                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     460                   pt_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     461                                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    458462
    459463                CASE ( 'q' )
    460464                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    461                    q(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    462                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     465                   q(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     466                                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    463467
    464468                CASE ( 'q_av' )
    465469                   IF ( .NOT. ALLOCATED( q_av ) )  THEN
    466                       ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    467                    ENDIF
    468                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    469                    q_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    470                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     470                      ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg ))
     471                   ENDIF
     472                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     473                   q_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     474                                     tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    471475
    472476                CASE ( 'q_m' )
    473477                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    474                    q_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    475                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     478                   q_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     479                                      tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    476480
    477481                CASE ( 'ql' )
    478482                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    479                    ql(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    480                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     483                   ql(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     484                                       tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    481485
    482486                CASE ( 'ql_av' )
    483487                   IF ( .NOT. ALLOCATED( ql_av ) )  THEN
    484                       ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    485                    ENDIF
    486                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    487                    ql_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    488                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     488                      ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     489                   ENDIF
     490                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     491                   ql_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     492                                       tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    489493
    490494                CASE ( 'ql_c_av' )
    491495                   IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
    492                       ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    493                    ENDIF
    494                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    495                    ql_c_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    496                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     496                      ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     497                   ENDIF
     498                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     499                   ql_c_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     500                                        tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    497501
    498502                CASE ( 'ql_v_av' )
    499503                   IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
    500                       ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    501                    ENDIF
    502                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    503                    ql_v_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    504                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     504                      ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     505                   ENDIF
     506                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     507                   ql_v_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     508                                        tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    505509
    506510                CASE ( 'ql_vp_av' )
    507511                   IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
    508                       ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    509                    ENDIF
    510                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    511                    ql_vp_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    512                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     512                      ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     513                   ENDIF
     514                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     515                   ql_vp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     516                                        tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    513517
    514518                CASE ( 'qs' )
    515519                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    516                    qs(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    517                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     520                   qs(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     521                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    518522
    519523                CASE ( 'qsws' )
    520524                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    521                    qsws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    522                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     525                   qsws(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     526                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    523527
    524528                CASE ( 'qsws_m' )
    525529                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    526                    qsws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    527                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     530                   qsws_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     531                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    528532
    529533                CASE ( 'qsws_av' )
    530534                   IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
    531                       ALLOCATE( qsws_av(nys-1:nyn+1,nxl-1:nxr+1) )
     535                      ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
    532536                   ENDIF 
    533537                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    534                    qsws_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    535                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     538                   qsws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     539                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    536540
    537541                CASE ( 'qswst' )
    538542                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    539                    qswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    540                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     543                   qswst(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     544                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    541545
    542546                CASE ( 'qswst_m' )
    543547                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    544                    qswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    545                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     548                   qswst_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     549                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    546550
    547551                CASE ( 'qv_av' )
    548552                   IF ( .NOT. ALLOCATED( qv_av ) )  THEN
    549                       ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    550                    ENDIF
    551                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    552                    qv_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    553                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     553                      ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     554                   ENDIF
     555                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     556                   qv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     557                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    554558
    555559                CASE ( 'random_iv' )  ! still unresolved issue
    … …  
    559563                CASE ( 'rho_av' )
    560564                   IF ( .NOT. ALLOCATED( rho_av ) )  THEN
    561                       ALLOCATE( rho_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    562                    ENDIF
    563                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    564                    rho_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    565                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     565                      ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     566                   ENDIF
     567                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     568                   rho_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     569                                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    566570
    567571                CASE ( 'rif' )
    568572                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    569                    rif(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    570                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     573                   rif(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     574                                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    571575
    572576                CASE ( 'rif_m' )
    573577                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    574                    rif_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    575                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     578                   rif_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     579                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    576580
    577581                CASE ( 'rif_wall' )
    578582                   IF ( k == 1 )  THEN
    579                       ALLOCATE( tmp_4d(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
    580                                        nxl_on_file-1:nxr_on_file+1,1:4) )
     583                      ALLOCATE( tmp_4d(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp, &
     584                                       nxl_on_file-nbgp:nxr_on_file+nbgp,1:4) )
    581585                      READ ( 13 )  tmp_4d
    582586                   ENDIF
    583                    rif_wall(:,nysc-1:nync+1,nxlc-1:nxrc+1,:) = &
    584                                          tmp_4d(:,nysf-1:nynf+1,nxlf-1:nxrf+1,:)
     587                   rif_wall(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,:) = &
     588                            tmp_4d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp,:)
    585589
    586590                CASE ( 's_av' )
    587591                   IF ( .NOT. ALLOCATED( s_av ) )  THEN
    588                       ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    589                    ENDIF
    590                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    591                    s_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    592                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     592                      ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
     593                   ENDIF
     594                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     595                   s_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     596                                 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    593597
    594598                CASE ( 'sa' )
    595599                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    596                    sa(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    597                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     600                   sa(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     601                                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    598602
    599603                CASE ( 'sa_av' )
    600604                   IF ( .NOT. ALLOCATED( sa_av ) )  THEN
    601                       ALLOCATE( sa_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    602                    ENDIF
    603                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    604                    sa_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    605                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     605                      ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     606                   ENDIF
     607                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     608                   sa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     609                                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    606610
    607611                CASE ( 'saswsb' )
    608612                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    609                    saswsb(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    610                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     613                   saswsb(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     614                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    611615
    612616                CASE ( 'saswst' )
    613617                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    614                    saswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    615                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     618                   saswst(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     619                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    616620
    617621                CASE ( 'shf' )
    618622                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    619                    shf(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    620                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     623                   shf(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     624                      tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    621625
    622626                CASE ( 'shf_m' )
    623627                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    624                    shf_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    625                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     628                   shf_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     629                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    626630                CASE ( 'shf_av' )
    627631                   IF ( .NOT. ALLOCATED( shf_av ) )  THEN
    628                       ALLOCATE( shf_av(nys-1:nyn+1,nxl-1:nxr+1) )
    629                    ENDIF
    630                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    631                    shf_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    632                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     632                      ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
     633                   ENDIF
     634                   IF ( k == 1 )  READ ( 13 )  tmp_2d
     635                   shf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     636                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    633637                CASE ( 'spectrum_x' )
    634638                   IF ( k == 1 )  THEN
    … …  
    663667                CASE ( 'ts' )
    664668                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    665                    ts(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    666                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     669                   ts(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     670                     tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    667671
    668672                CASE ( 'ts_av' )
    669673                   IF ( .NOT. ALLOCATED( ts_av ) )  THEN
    670                       ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
    671                    ENDIF
    672                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    673                    ts_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    674                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     674                      ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
     675                   ENDIF
     676                   IF ( k == 1 )  READ ( 13 )  tmp_2d
     677                   ts_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     678                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    675679
    676680                CASE ( 'tswst' )
    677681                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    678                    tswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    679                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     682                   tswst(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     683                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    680684
    681685                CASE ( 'tswst_m' )
    682686                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    683                    tswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    684                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     687                   tswst_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     688                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    685689
    686690                CASE ( 'u' )
    687691                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    688                    u(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    689                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     692                   u(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     693                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    690694
    691695                CASE ( 'u_av' )
    692696                   IF ( .NOT. ALLOCATED( u_av ) )  THEN
    693                       ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    694                    ENDIF
    695                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    696                    u_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    697                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     697                      ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     698                   ENDIF
     699                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     700                   u_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     701                               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    698702
    699703                CASE ( 'u_m' )
    700704                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    701                    u_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    702                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     705                   u_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     706                                 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    703707
    704708                CASE ( 'u_m_l' )
    705709                   IF ( k == 1 )  THEN
    706710                      ALLOCATE( tmp_3dwul(nzb:nzt+1, &
    707                                           nys_on_file-1:nyn_on_file+1,1:2) )
     711                                          nys_on_file-nbgp:nyn_on_file+nbgp,1:2) )
    708712                      READ ( 13 )  tmp_3dwul
    709713                   ENDIF
    710714                   IF ( outflow_l )  THEN
    711                       u_m_l(:,nysc-1:nync+1,:) = tmp_3dwul(:,nysf-1:nynf+1,:)
     715                      u_m_l(:,nysc-nbgp:nync+nbgp,:) = tmp_3dwul(:,nysf-nbgp:nynf+nbgp,:)
    712716                   ENDIF
    713717
    … …  
    715719                   IF ( k == 1 )  THEN
    716720                      ALLOCATE( tmp_3dwun(nzb:nzt+1,ny-1:ny, &
    717                                           nxl_on_file-1:nxr_on_file+1) )
     721                                          nxl_on_file-nbgp:nxr_on_file+nbgp) )
    718722                      READ ( 13 )  tmp_3dwun
    719723                   ENDIF
    720724                   IF ( outflow_n )  THEN
    721                       u_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dwun(:,:,nxlf-1:nxrf+1)
     725                      u_m_n(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3dwun(:,:,nxlf-nbgp:nxrf+nbgp)
    722726                   ENDIF
    723727
    … …  
    725729                   IF ( k == 1 )  THEN
    726730                      ALLOCATE( tmp_3dwur(nzb:nzt+1,&
    727                                           nys_on_file-1:nyn_on_file+1,nx-1:nx) )
     731                                          nys_on_file-nbgp:nyn_on_file+nbgp,nx-1:nx) )
    728732                      READ ( 13 )  tmp_3dwur
    729733                   ENDIF
    730734                   IF ( outflow_r )  THEN
    731                       u_m_r(:,nysc-1:nync+1,:) = tmp_3dwur(:,nysf-1:nynf+1,:)
     735                      u_m_r(:,nysc-nbgp:nync+nbgp,:) = tmp_3dwur(:,nysf-nbgp:nynf+nbgp,:)
    732736                   ENDIF
    733737
    … …  
    735739                   IF ( k == 1 )  THEN
    736740                      ALLOCATE( tmp_3dwus(nzb:nzt+1,0:1, &
    737                                           nxl_on_file-1:nxr_on_file+1) )
     741                                          nxl_on_file-nbgp:nxr_on_file+nbgp) )
    738742                      READ ( 13 )  tmp_3dwus
    739743                   ENDIF
    740744                   IF ( outflow_s )  THEN
    741                       u_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dwus(:,:,nxlf-1:nxrf+1)
     745                      u_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3dwus(:,:,nxlf-nbgp:nxrf+nbgp)
    742746                   ENDIF
    743747
    744748                CASE ( 'us' )
    745749                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    746                    us(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    747                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     750                   us(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     751                     tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    748752
    749753                CASE ( 'usws' )
    750754                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    751                    usws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    752                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     755                   usws(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     756                       tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    753757
    754758                CASE ( 'uswst' )
    755759                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    756                    uswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    757                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     760                   uswst(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     761                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    758762
    759763                CASE ( 'usws_m' )
    760764                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    761                    usws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    762                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     765                   usws_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     766                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    763767
    764768                CASE ( 'uswst_m' )
    765769                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    766                    uswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    767                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     770                   uswst_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     771                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    768772
    769773                CASE ( 'us_av' )
    770774                   IF ( .NOT. ALLOCATED( us_av ) )  THEN
    771                       ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
    772                    ENDIF
    773                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    774                    us_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    775                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     775                      ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
     776                   ENDIF
     777                   IF ( k == 1 )  READ ( 13 )  tmp_2d
     778                   us_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     779                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    776780
    777781                CASE ( 'v' )
    778782                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    779                    v(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    780                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     783                   v(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     784                              tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    781785
    782786                CASE ( 'v_av' )
    783787                   IF ( .NOT. ALLOCATED( v_av ) )  THEN
    784                       ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    785                    ENDIF
    786                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    787                    v_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    788                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     788                      ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     789                   ENDIF
     790                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     791                   v_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     792                               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    789793
    790794                CASE ( 'v_m' )
    791795                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    792                    v_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    793                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     796                   v_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     797                                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    794798
    795799                CASE ( 'v_m_l' )
    796800                   IF ( k == 1 )  THEN
    797801                      ALLOCATE( tmp_3dwvl(nzb:nzt+1,&
    798                                           nys_on_file-1:nyn_on_file+1,0:1) )
     802                                          nys_on_file-nbgp:nyn_on_file+nbgp,0:1) )
    799803                      READ ( 13 )  tmp_3dwvl
    800804                   ENDIF
    801805                   IF ( outflow_l )  THEN
    802                       v_m_l(:,nysc-1:nync+1,:) = tmp_3dwvl(:,nysf-1:nynf+1,:)
     806                      v_m_l(:,nysc-nbgp:nync+nbgp,:) = tmp_3dwvl(:,nysf-nbgp:nynf+nbgp,:)
    803807                   ENDIF
    804808
    … …  
    806810                   IF ( k == 1 )  THEN
    807811                      ALLOCATE( tmp_3dwvn(nzb:nzt+1,ny-1:ny, &
    808                                           nxl_on_file-1:nxr_on_file+1) )
     812                                          nxl_on_file-nbgp:nxr_on_file+nbgp) )
    809813                      READ ( 13 )  tmp_3dwvn
    810814                   ENDIF
    811815                   IF ( outflow_n )  THEN
    812                       v_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dwvn(:,:,nxlf-1:nxrf+1)
     816                      v_m_n(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3dwvn(:,:,nxlf-nbgp:nxrf+nbgp)
    813817                   ENDIF
    814818
    … …  
    816820                   IF ( k == 1 )  THEN
    817821                      ALLOCATE( tmp_3dwvr(nzb:nzt+1,&
    818                                           nys_on_file-1:nyn_on_file+1,nx-1:nx) )
     822                                          nys_on_file-nbgp:nyn_on_file+nbgp,nx-1:nx) )
    819823                      READ ( 13 )  tmp_3dwvr
    820824                   ENDIF
    821825                   IF ( outflow_r )  THEN
    822                       v_m_r(:,nysc-1:nync+1,:) = tmp_3dwvr(:,nysf-1:nynf+1,:)
     826                      v_m_r(:,nysc-nbgp:nync+nbgp,:) = tmp_3dwvr(:,nysf-nbgp:nynf+nbgp,:)
    823827                   ENDIF
    824828
    … …  
    826830                   IF ( k == 1 )  THEN
    827831                      ALLOCATE( tmp_3dwvs(nzb:nzt+1,1:2, &
    828                                           nxl_on_file-1:nxr_on_file+1) )
     832                                          nxl_on_file-nbgp:nxr_on_file+nbgp) )
    829833                      READ ( 13 )  tmp_3dwvs
    830834                   ENDIF
    831835                   IF ( outflow_s )  THEN
    832                       v_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dwvs(:,:,nxlf-1:nxrf+1)
     836                      v_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3dwvs(:,:,nxlf-nbgp:nxrf+nbgp)
    833837                   ENDIF
    834838
    835839                CASE ( 'vpt' )
    836840                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    837                    vpt(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    838                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     841                   vpt(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     842                               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    839843
    840844                CASE ( 'vpt_av' )
    841845                   IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
    842                       ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    843                    ENDIF
    844                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    845                    vpt_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    846                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     846                      ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     847                   ENDIF
     848                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     849                   vpt_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     850                               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    847851
    848852                CASE ( 'vpt_m' )
    849853                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    850                    vpt_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    851                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     854                   vpt_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     855                                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    852856
    853857                CASE ( 'vsws' )
    854858                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    855                    vsws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    856                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     859                   vsws(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     860                       tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    857861
    858862                CASE ( 'vswst' )
    859863                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    860                    vswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    861                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     864                   vswst(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     865                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    862866
    863867                CASE ( 'vsws_m' )
    864868                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    865                    vsws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    866                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     869                   vsws_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     870                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    867871
    868872                CASE ( 'vswst_m' )
    869873                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    870                    vswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    871                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     874                   vswst_m(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     875                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    872876
    873877                CASE ( 'w' )
    874878                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    875                    w(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    876                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     879                   w(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     880                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    877881
    878882                CASE ( 'w_av' )
    879883                   IF ( .NOT. ALLOCATED( w_av ) )  THEN
    880                       ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    881                    ENDIF
    882                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    883                    w_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    884                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     884                      ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     885                   ENDIF
     886                   IF ( k == 1 )  READ ( 13 )  tmp_3d
     887                   w_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     888                               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    885889
    886890                CASE ( 'w_m' )
    887891                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    888                    w_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    889                                           tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
     892                   w_m(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     893                                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    890894
    891895                CASE ( 'w_m_l' )
    892896                   IF ( k == 1 )  THEN
    893897                      ALLOCATE( tmp_3dwwl(nzb:nzt+1,&
    894                                           nys_on_file-1:nyn_on_file+1,0:1) )
     898                                          nys_on_file-nbgp:nyn_on_file+nbgp,0:1) )
    895899                      READ ( 13 )  tmp_3dwwl
    896900                   ENDIF
    897901                   IF ( outflow_l )  THEN
    898                       w_m_l(:,nysc-1:nync+1,:) = tmp_3dwwl(:,nysf-1:nynf+1,:)
     902                      w_m_l(:,nysc-nbgp:nync+nbgp,:) = tmp_3dwwl(:,nysf-nbgp:nynf+nbgp,:)
    899903                   ENDIF
    900904
    … …  
    902906                   IF ( k == 1 )  THEN
    903907                      ALLOCATE( tmp_3dwwn(nzb:nzt+1,ny-1:ny, &
    904                                           nxl_on_file-1:nxr_on_file+1) )
     908                                          nxl_on_file-nbgp:nxr_on_file+nbgp) )
    905909                      READ ( 13 )  tmp_3dwwn
    906910                   ENDIF
    907911                   IF ( outflow_n )  THEN
    908                       w_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dwwn(:,:,nxlf-1:nxrf+1)
     912                      w_m_n(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3dwwn(:,:,nxlf-nbgp:nxrf+nbgp)
    909913                   ENDIF
    910914
    … …  
    912916                   IF ( k == 1 )  THEN
    913917                      ALLOCATE( tmp_3dwwr(nzb:nzt+1,&
    914                                           nys_on_file-1:nyn_on_file+1,nx-1:nx) )
     918                                          nys_on_file-nbgp:nyn_on_file+nbgp,nx-1:nx) )
    915919                      READ ( 13 )  tmp_3dwwr
    916920                   ENDIF
    917921                   IF ( outflow_r )  THEN
    918                       w_m_r(:,nysc-1:nync+1,:) = tmp_3dwwr(:,nysf-1:nynf+1,:)
     922                      w_m_r(:,nysc-nbgp:nync+nbgp,:) = tmp_3dwwr(:,nysf-nbgp:nynf+nbgp,:)
    919923                   ENDIF
    920924
    … …  
    922926                   IF ( k == 1 )  THEN
    923927                      ALLOCATE( tmp_3dwws(nzb:nzt+1,0:1, &
    924                                           nxl_on_file-1:nxr_on_file+1) )
     928                                          nxl_on_file-nbgp:nxr_on_file+nbgp) )
    925929                      READ ( 13 )  tmp_3dwws
    926930                   ENDIF
    927931                   IF ( outflow_s )  THEN
    928                       w_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dwws(:,:,nxlf-1:nxrf+1)
     932                      w_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3dwws(:,:,nxlf-nbgp:nxrf+nbgp)
    929933                   ENDIF
    930934                   DEALLOCATE( tmp_3dwws )
    … …  
    932936                CASE ( 'z0' )
    933937                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    934                    z0(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    935                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     938                   z0(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     939                     tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    936940
    937941                CASE ( 'z0_av' )
    938942                   IF ( .NOT. ALLOCATED( z0_av ) )  THEN
    939                       ALLOCATE( z0_av(nys-1:nyn+1,nxl-1:nxr+1) )
    940                    ENDIF
    941                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    942                    z0_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    943                                           tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
     943                      ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
     944                   ENDIF
     945                   IF ( k == 1 )  READ ( 13 )  tmp_2d
     946                   z0_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     947                       tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    944948
    945949                CASE DEFAULT

  • TabularUnified palm/trunk/SOURCE/sor.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
     7! Call of exchange_horiz are modified.
     8! bug removed in declaration of ddzw(), nz replaced by nzt+1
    79!
    810! Former revisions:
    … …  
    3638
    3739    INTEGER ::  i, j, k, n, nxl1, nxl2, nys1, nys2
    38     REAL    ::  ddzu(1:nz+1), ddzw(1:nz)
     40    REAL    ::  ddzu(1:nz+1), ddzw(1:nzt+1)
    3941    REAL    ::  d(nzb+1:nzt,nys:nyn,nxl:nxr),         &
    40                 p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
     42                p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    4143    REAL, DIMENSION(:), ALLOCATABLE ::  f1, f2, f3
    4244
    … …  
    102104!
    103105!--    Exchange of boundary values for p.
    104        CALL exchange_horiz( p )
     106       CALL exchange_horiz( p, nbgp )
    105107
    106108!
    … …  
    147149!
    148150!--    Exchange of boundary values for p.
    149        CALL exchange_horiz( p )
     151       CALL exchange_horiz( p, nbgp )
    150152
    151153!
    152154!--    Boundary conditions top/bottom.
    153155!--    Bottom boundary
    154        IF ( ibc_p_b == 1 )  THEN
    155 !
    156 !--       Neumann
     156       IF ( ibc_p_b == 1 )  THEN       !       Neumann
    157157          p(nzb,:,:) = p(nzb+1,:,:)
    158        ELSE
    159 !
    160 !--       Dirichlet
     158       ELSE                            !       Dirichlet
    161159          p(nzb,:,:) = 0.0
    162160       ENDIF
    … …  
    164162!
    165163!--    Top boundary
    166        IF ( ibc_p_t == 1 )  THEN
    167 !
    168 !--       Neumann
     164       IF ( ibc_p_t == 1 )  THEN                 !  Neumann
    169165          p(nzt+1,:,:) = p(nzt,:,:)
    170        ELSE
    171 !
    172 !--       Dirichlet
     166       ELSE                      !  Dirichlet
    173167          p(nzt+1,:,:) = 0.0
    174168       ENDIF
    … …  
    185179       ENDIF
    186180
     181
    187182    ENDDO
    188183

  • TabularUnified palm/trunk/SOURCE/subsidence.f90

    r581 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    121121       REAL :: tmp_grad
    122122   
    123        REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: var, tendency
     123       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var, tendency
    124124       REAL, DIMENSION(nzb:nzt+1) :: var_init, var_mod
    125125
    … …  
    197197       REAL :: tmp_grad
    198198   
    199        REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: var, tendency
     199       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var, tendency
    200200       REAL, DIMENSION(nzb:nzt+1) :: var_init, var_mod
    201201

  • TabularUnified palm/trunk/SOURCE/sum_up_3d_data.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 ! 
     6!  nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    6565             CASE ( 'e' )
    6666                IF ( .NOT. ALLOCATED( e_av ) )  THEN
    67                    ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     67                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    6868                ENDIF
    6969                e_av = 0.0
    … …  
    7171             CASE ( 'lwp*' )
    7272                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
    73                    ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
     73                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
    7474                ENDIF
    7575                lwp_av = 0.0
    … …  
    7777             CASE ( 'p' )
    7878                IF ( .NOT. ALLOCATED( p_av ) )  THEN
    79                    ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     79                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    8080                ENDIF
    8181                p_av = 0.0
    … …  
    8383             CASE ( 'pc' )
    8484                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
    85                    ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     85                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    8686                ENDIF
    8787                pc_av = 0.0
    … …  
    8989             CASE ( 'pr' )
    9090                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
    91                    ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     91                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    9292                ENDIF
    9393                pr_av = 0.0
    … …  
    9595             CASE ( 'prr*' )
    9696                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
    97                    ALLOCATE( precipitation_rate_av(nys-1:nyn+1,nxl-1:nxr+1) )
     97                   ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
    9898                ENDIF
    9999                precipitation_rate_av = 0.0
    … …  
    101101             CASE ( 'pt' )
    102102                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
    103                    ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     103                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    104104                ENDIF
    105105                pt_av = 0.0
    … …  
    107107             CASE ( 'q' )
    108108                IF ( .NOT. ALLOCATED( q_av ) )  THEN
    109                    ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     109                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    110110                ENDIF
    111111                q_av = 0.0
    … …  
    113113             CASE ( 'ql' )
    114114                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
    115                    ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     115                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    116116                ENDIF
    117117                ql_av = 0.0
    … …  
    119119             CASE ( 'ql_c' )
    120120                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
    121                    ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     121                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    122122                ENDIF
    123123                ql_c_av = 0.0
    … …  
    125125             CASE ( 'ql_v' )
    126126                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
    127                    ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     127                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    128128                ENDIF
    129129                ql_v_av = 0.0
    … …  
    131131             CASE ( 'ql_vp' )
    132132                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
    133                    ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     133                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    134134                ENDIF
    135135                ql_vp_av = 0.0
    … …  
    137137             CASE ( 'qsws*' )
    138138                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
    139                    ALLOCATE( qsws_av(nys-1:nyn+1,nxl-1:nxr+1) )
     139                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
    140140                ENDIF
    141141                qsws_av = 0.0
    … …  
    143143             CASE ( 'qv' )
    144144                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
    145                    ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     145                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    146146                ENDIF
    147147                qv_av = 0.0
    … …  
    149149             CASE ( 'rho' )
    150150                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
    151                    ALLOCATE( rho_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     151                   ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    152152                ENDIF
    153153                rho_av = 0.0
    … …  
    155155             CASE ( 's' )
    156156                IF ( .NOT. ALLOCATED( s_av ) )  THEN
    157                    ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     157                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    158158                ENDIF
    159159                s_av = 0.0
    … …  
    161161             CASE ( 'sa' )
    162162                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
    163                    ALLOCATE( sa_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     163                   ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    164164                ENDIF
    165165                sa_av = 0.0
    … …  
    167167             CASE ( 'shf*' )
    168168                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
    169                    ALLOCATE( shf_av(nys-1:nyn+1,nxl-1:nxr+1) )
     169                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
    170170                ENDIF
    171171                shf_av = 0.0
    … …  
    173173             CASE ( 't*' )
    174174                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
    175                    ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
     175                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
    176176                ENDIF
    177177                ts_av = 0.0
    … …  
    179179             CASE ( 'u' )
    180180                IF ( .NOT. ALLOCATED( u_av ) )  THEN
    181                    ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     181                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    182182                ENDIF
    183183                u_av = 0.0
    … …  
    185185             CASE ( 'u*' )
    186186                IF ( .NOT. ALLOCATED( us_av ) )  THEN
    187                    ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
     187                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
    188188                ENDIF
    189189                us_av = 0.0
    … …  
    191191             CASE ( 'v' )
    192192                IF ( .NOT. ALLOCATED( v_av ) )  THEN
    193                    ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     193                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    194194                ENDIF
    195195                v_av = 0.0
    … …  
    197197             CASE ( 'vpt' )
    198198                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
    199                    ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     199                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    200200                ENDIF
    201201                vpt_av = 0.0
    … …  
    203203             CASE ( 'w' )
    204204                IF ( .NOT. ALLOCATED( w_av ) )  THEN
    205                    ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     205                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    206206                ENDIF
    207207                w_av = 0.0
    … …  
    209209             CASE ( 'z0*' )
    210210                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
    211                    ALLOCATE( z0_av(nys-1:nyn+1,nxl-1:nxr+1) )
     211                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
    212212                ENDIF
    213213                z0_av = 0.0
    … …  
    233233
    234234          CASE ( 'e' )
    235              DO  i = nxl-1, nxr+1
    236                 DO  j = nys-1, nyn+1
     235             DO  i = nxlg, nxrg
     236                DO  j = nysg, nyng
    237237                   DO  k = nzb, nzt+1
    238238                      e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
    … …  
    242242
    243243          CASE ( 'lwp*' )
    244              DO  i = nxl-1, nxr+1
    245                 DO  j = nys-1, nyn+1
     244             DO  i = nxlg, nxrg
     245                DO  j = nysg, nyng
    246246                   lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * &
    247247                                                    dzw(1:nzt+1) )
    … …  
    250250
    251251          CASE ( 'p' )
    252              DO  i = nxl-1, nxr+1
    253                 DO  j = nys-1, nyn+1
     252             DO  i = nxlg, nxrg
     253                DO  j = nysg, nyng
    254254                   DO  k = nzb, nzt+1
    255255                      p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
    … …  
    289289
    290290          CASE ( 'pr*' )
    291              DO  i = nxl-1, nxr+1
    292                 DO  j = nys-1, nyn+1
     291             DO  i = nxlg, nxrg
     292                DO  j = nysg, nyng
    293293                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
    294294                                                precipitation_rate(j,i)
    … …  
    298298          CASE ( 'pt' )
    299299             IF ( .NOT. cloud_physics ) THEN
    300                 DO  i = nxl-1, nxr+1
    301                    DO  j = nys-1, nyn+1
    302                       DO  k = nzb, nzt+1
     300             DO  i = nxlg, nxrg
     301                DO  j = nysg, nyng
     302                   DO  k = nzb, nzt+1
    303303                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
    304304                      ENDDO
    … …  
    306306                ENDDO
    307307             ELSE
    308                 DO  i = nxl-1, nxr+1
    309                    DO  j = nys-1, nyn+1
    310                       DO  k = nzb, nzt+1
     308             DO  i = nxlg, nxrg
     309                DO  j = nysg, nyng
     310                   DO  k = nzb, nzt+1
    311311                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
    312312                                                       pt_d_t(k) * ql(k,j,i)
    … …  
    317317
    318318          CASE ( 'q' )
    319              DO  i = nxl-1, nxr+1
    320                 DO  j = nys-1, nyn+1
     319             DO  i = nxlg, nxrg
     320                DO  j = nysg, nyng
    321321                   DO  k = nzb, nzt+1
    322322                      q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
    … …  
    326326
    327327          CASE ( 'ql' )
    328              DO  i = nxl-1, nxr+1
    329                 DO  j = nys-1, nyn+1
     328             DO  i = nxlg, nxrg
     329                DO  j = nysg, nyng
    330330                   DO  k = nzb, nzt+1
    331331                      ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
    … …  
    335335
    336336          CASE ( 'ql_c' )
    337              DO  i = nxl-1, nxr+1
    338                 DO  j = nys-1, nyn+1
     337             DO  i = nxlg, nxrg
     338                DO  j = nysg, nyng
    339339                   DO  k = nzb, nzt+1
    340340                      ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
    … …  
    344344
    345345          CASE ( 'ql_v' )
    346              DO  i = nxl-1, nxr+1
    347                 DO  j = nys-1, nyn+1
     346             DO  i = nxlg, nxrg
     347                DO  j = nysg, nyng
    348348                   DO  k = nzb, nzt+1
    349349                      ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
    … …  
    353353
    354354          CASE ( 'ql_vp' )
    355              DO  i = nxl-1, nxr+1
    356                 DO  j = nys-1, nyn+1
     355             DO  i = nxlg, nxrg
     356                DO  j = nysg, nyng
    357357                   DO  k = nzb, nzt+1
    358358                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + ql_vp(k,j,i)
    … …  
    362362
    363363          CASE ( 'qsws*' )
    364              DO  i = nxl-1, nxr+1
    365                 DO  j = nys-1, nyn+1
     364             DO  i = nxlg, nxrg
     365                DO  j = nysg, nyng
    366366                   qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
    367367                ENDDO
    … …  
    369369
    370370          CASE ( 'qv' )
    371              DO  i = nxl-1, nxr+1
    372                 DO  j = nys-1, nyn+1
     371             DO  i = nxlg, nxrg
     372                DO  j = nysg, nyng
    373373                   DO  k = nzb, nzt+1
    374374                      qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
    … …  
    378378
    379379          CASE ( 'rho' )
    380              DO  i = nxl-1, nxr+1
    381                 DO  j = nys-1, nyn+1
     380             DO  i = nxlg, nxrg
     381                DO  j = nysg, nyng
    382382                   DO  k = nzb, nzt+1
    383383                      rho_av(k,j,i) = rho_av(k,j,i) + rho(k,j,i)
    … …  
    387387
    388388          CASE ( 's' )
    389              DO  i = nxl-1, nxr+1
    390                 DO  j = nys-1, nyn+1
     389             DO  i = nxlg, nxrg
     390                DO  j = nysg, nyng
    391391                   DO  k = nzb, nzt+1
    392392                      s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
    … …  
    396396
    397397          CASE ( 'sa' )
    398              DO  i = nxl-1, nxr+1
    399                 DO  j = nys-1, nyn+1
     398             DO  i = nxlg, nxrg
     399                DO  j = nysg, nyng
    400400                   DO  k = nzb, nzt+1
    401401                      sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
    … …  
    405405
    406406          CASE ( 'shf*' )
    407              DO  i = nxl-1, nxr+1
    408                 DO  j = nys-1, nyn+1
     407             DO  i = nxlg, nxrg
     408                DO  j = nysg, nyng
    409409                   shf_av(j,i) = shf_av(j,i) + shf(j,i)
    410410                ENDDO
    … …  
    412412
    413413          CASE ( 't*' )
    414              DO  i = nxl-1, nxr+1
    415                 DO  j = nys-1, nyn+1
     414             DO  i = nxlg, nxrg
     415                DO  j = nysg, nyng
    416416                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
    417417                ENDDO
    … …  
    419419
    420420          CASE ( 'u' )
    421              DO  i = nxl-1, nxr+1
    422                 DO  j = nys-1, nyn+1
     421             DO  i = nxlg, nxrg
     422                DO  j = nysg, nyng
    423423                   DO  k = nzb, nzt+1
    424424                      u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
    … …  
    428428
    429429          CASE ( 'u*' )
    430              DO  i = nxl-1, nxr+1
    431                 DO  j = nys-1, nyn+1
     430             DO  i = nxlg, nxrg
     431                DO  j = nysg, nyng
    432432                   us_av(j,i) = us_av(j,i) + us(j,i)
    433433                ENDDO
    … …  
    435435
    436436          CASE ( 'v' )
    437              DO  i = nxl-1, nxr+1
    438                 DO  j = nys-1, nyn+1
     437             DO  i = nxlg, nxrg
     438                DO  j = nysg, nyng
    439439                   DO  k = nzb, nzt+1
    440440                      v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
    … …  
    444444
    445445          CASE ( 'vpt' )
    446              DO  i = nxl-1, nxr+1
    447                 DO  j = nys-1, nyn+1
     446             DO  i = nxlg, nxrg
     447                DO  j = nysg, nyng
    448448                   DO  k = nzb, nzt+1
    449449                      vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
    … …  
    453453
    454454          CASE ( 'w' )
    455              DO  i = nxl-1, nxr+1
    456                 DO  j = nys-1, nyn+1
     455             DO  i = nxlg, nxrg
     456                DO  j = nysg, nyng
    457457                   DO  k = nzb, nzt+1
    458458                      w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
    … …  
    462462
    463463          CASE ( 'z0*' )
    464              DO  i = nxl-1, nxr+1
    465                 DO  j = nys-1, nyn+1
     464             DO  i = nxlg, nxrg
     465                DO  j = nysg, nyng
    466466                   z0_av(j,i) = z0_av(j,i) + z0(j,i)
    467467                ENDDO

  • TabularUnified palm/trunk/SOURCE/surface_coupler.f90

    r392 r667  
    55! -----------------
    66!
     7! additional case for nonequivalent processor and grid topopolgy in ocean and
     8! atmosphere added (coupling_topology = 1)
     9!
     10!
     11! Added exchange of u and v from Ocean to Atmosphere
     12!
    713!
    814! Former revisions:
    … …  
    3945
    4046    REAL    ::  time_since_reference_point_rem
     47    REAL    ::  total_2d(-nbgp:ny+nbgp,-nbgp:nx+nbgp)
    4148
    4249#if defined( __parallel )
    4350
    44        CALL cpu_log( log_point(39), 'surface_coupler', 'start' )
     51    CALL cpu_log( log_point(39), 'surface_coupler', 'start' )
     52
     53
    4554
    4655!
    … …  
    5160!-- If necessary, the coupler will be called at the beginning of the next
    5261!-- restart run.
    53     CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, target_id,  &
    54                        0, &
    55                        terminate_coupled_remote, 1, MPI_INTEGER, target_id,  &
    56                        0, comm_inter, status, ierr )
     62
     63    IF ( coupling_topology == 0 ) THEN
     64       CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, target_id,  &
     65                          0,                                                    &
     66                          terminate_coupled_remote, 1, MPI_INTEGER, target_id,  &
     67                          0, comm_inter, status, ierr )
     68    ELSE
     69       IF ( myid == 0) THEN
     70          CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, &
     71                             target_id, 0,                             &
     72                             terminate_coupled_remote, 1, MPI_INTEGER, &
     73                             target_id, 0,                             &
     74                             comm_inter, status, ierr )
     75       ENDIF
     76       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr)
     77
     78       ALLOCATE( total_2d_a(-nbgp:ny_a+nbgp,-nbgp:nx_a+nbgp),       &
     79                 total_2d_o(-nbgp:ny_o+nbgp,-nbgp:nx_o+nbgp) )
     80
     81    ENDIF
     82
    5783    IF ( terminate_coupled_remote > 0 )  THEN
    5884       WRITE( message_string, * ) 'remote model "',                         &
    … …  
    6490                                  '" has',                                  &
    6591                                  '&terminate_coupled = ',                  &
    66                                   terminate_coupled
     92                                   terminate_coupled
    6793       CALL message( 'surface_coupler', 'PA0310', 1, 2, 0, 6, 0 )
    6894       RETURN
    6995    ENDIF
     96 
    7097
    7198!
    7299!-- Exchange the current simulated time between the models,
    73 !-- currently just for testing
    74     CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, target_id, 11, &
    75                    comm_inter, ierr )
    76     CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, target_id, 11, &
    77                    comm_inter, status, ierr )
     100!-- currently just for total_2ding
     101    IF ( coupling_topology == 0 ) THEN   
     102       CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, &
     103                      target_id, 11, comm_inter, ierr )
     104       CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, &
     105                      target_id, 11, comm_inter, status, ierr )
     106    ELSE
     107       IF ( myid == 0 ) THEN
     108          CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, &
     109                         target_id, 11, comm_inter, ierr )
     110          CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, &
     111                         target_id, 11, comm_inter, status, ierr )
     112       ENDIF
     113       CALL MPI_BCAST( time_since_reference_point_rem, 1, MPI_REAL, &
     114                       0, comm2d, ierr )
     115    ENDIF
    78116    WRITE ( 9, * ) 'simulated time: ', simulated_time
    79117    WRITE ( 9, * ) 'time since start of coupling: ', &
    80                    time_since_reference_point, ' remote: ', &
    81                    time_since_reference_point_rem
    82     CALL local_flush( 9 )
     118                  time_since_reference_point, ' remote: ', &
     119                  time_since_reference_point_rem
     120   CALL local_flush( 9 )
     121 
    83122
    84123!
    85124!-- Exchange the interface data
    86125    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
    87 
    88 !
    89 !--    Send heat flux at bottom surface to the ocean model
    90        WRITE ( 9, * )  '*** send shf to ocean'
    91        CALL local_flush( 9 )
    92        CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 12, &
    93                       comm_inter, ierr )
    94 
    95 !
    96 !--    Send humidity flux at bottom surface to the ocean model
    97        IF ( humidity )  THEN
    98           WRITE ( 9, * )  '*** send qsws to ocean'
     126   
     127!
     128!--    Horizontal grid size and number of processors is equal
     129!--    in ocean and atmosphere
     130       IF ( coupling_topology == 0 ) THEN
     131
     132!
     133!--       Send heat flux at bottom surface to the ocean model
     134          CALL MPI_SEND( shf(nysg,nxlg), ngp_xy, MPI_REAL, &
     135                         target_id, 12, comm_inter, ierr )
     136
     137!
     138!--       Send humidity flux at bottom surface to the ocean model
     139          IF ( humidity )  THEN
     140             CALL MPI_SEND( qsws(nysg,nxlg), ngp_xy, MPI_REAL, &
     141                            target_id, 13, comm_inter, ierr )
     142          ENDIF
     143
     144!
     145!--       Receive temperature at the bottom surface from the ocean model
     146          WRITE ( 9, * )  '*** receive pt from ocean'
    99147          CALL local_flush( 9 )
    100           CALL MPI_SEND( qsws(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 13, &
    101                comm_inter, ierr )
     148          CALL MPI_RECV( pt(0,nysg,nxlg), 1, type_xy, &
     149                         target_id, 14, comm_inter, status, ierr )
     150
     151!
     152!--       Send the momentum flux (u) at bottom surface to the ocean model
     153          CALL MPI_SEND( usws(nysg,nxlg), ngp_xy, MPI_REAL, &
     154                         target_id, 15, comm_inter, ierr )
     155
     156!
     157!--       Send the momentum flux (v) at bottom surface to the ocean model
     158          CALL MPI_SEND( vsws(nysg,nxlg), ngp_xy, MPI_REAL, &
     159                         target_id, 16, comm_inter, ierr )
     160
     161!
     162!--       Receive u at the bottom surface from the ocean model
     163          CALL MPI_RECV( u(0,nysg,nxlg), 1, type_xy, &
     164                         target_id, 17, comm_inter, status, ierr )
     165
     166!
     167!--       Receive v at the bottom surface from the ocean model
     168          CALL MPI_RECV( v(0,nysg,nxlg), 1, type_xy, &
     169                         target_id, 18,  comm_inter, status, ierr )
     170
     171!
     172!--    Horizontal grid size or number of processors differs between
     173!--    ocean and atmosphere
     174       ELSE
     175     
     176!
     177!--       Send heat flux at bottom surface to the ocean model
     178          total_2d_a = 0.0
     179          total_2d = 0.0
     180          total_2d(nys:nyn,nxl:nxr) = shf(nys:nyn,nxl:nxr)
     181          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
     182                           MPI_SUM, 0, comm2d, ierr )
     183          CALL interpolate_to_ocean(12)
     184   
     185!
     186!--       Send humidity flux at bottom surface to the ocean model
     187          IF ( humidity ) THEN
     188             total_2d_a = 0.0
     189             total_2d = 0.0
     190             total_2d(nys:nyn,nxl:nxr) = qsws(nys:nyn,nxl:nxr)
     191             CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
     192                              MPI_SUM, 0, comm2d, ierr )
     193             CALL interpolate_to_ocean(13)
     194          ENDIF
     195
     196!
     197!--       Receive temperature at the bottom surface from the ocean model
     198          IF ( myid == 0 ) THEN
     199             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     200                            target_id, 14, comm_inter, status, ierr )   
     201          ENDIF
     202          CALL MPI_BARRIER( comm2d, ierr )
     203          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     204                          0, comm2d, ierr )
     205          pt(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
     206
     207!
     208!--       Send momentum flux (u) at bottom surface to the ocean model
     209          total_2d_a = 0.0
     210          total_2d = 0.0
     211          total_2d(nys:nyn,nxl:nxr) = usws(nys:nyn,nxl:nxr)
     212          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
     213                           MPI_SUM, 0, comm2d, ierr )
     214          CALL interpolate_to_ocean(15)
     215
     216!
     217!--       Send momentum flux (v) at bottom surface to the ocean model
     218          total_2d_a = 0.0
     219          total_2d = 0.0
     220          total_2d(nys:nyn,nxl:nxr) = vsws(nys:nyn,nxl:nxr)
     221          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
     222                           MPI_SUM, 0, comm2d, ierr )
     223          CALL interpolate_to_ocean(16)
     224
     225!
     226!--       Receive u at the bottom surface from the ocean model
     227          IF ( myid == 0 ) THEN
     228             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     229                            target_id, 17, comm_inter, status, ierr )           
     230          ENDIF
     231          CALL MPI_BARRIER( comm2d, ierr )
     232          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     233                          0, comm2d, ierr )
     234          u(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
     235   
     236!
     237!--       Receive v at the bottom surface from the ocean model
     238          IF ( myid == 0 ) THEN
     239             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     240                            target_id, 18, comm_inter, status, ierr )           
     241          ENDIF
     242          CALL MPI_BARRIER( comm2d, ierr )
     243          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     244                          0, comm2d, ierr )
     245          v(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
     246
    102247       ENDIF
    103248
    104 !
    105 !--    Receive temperature at the bottom surface from the ocean model
    106        WRITE ( 9, * )  '*** receive pt from ocean'
    107        CALL local_flush( 9 )
    108        CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, target_id, 14, &
    109                       comm_inter, status, ierr )
    110 
    111 !
    112 !--    Send the momentum flux (u) at bottom surface to the ocean model
    113        WRITE ( 9, * )  '*** send usws to ocean'
    114        CALL local_flush( 9 )
    115        CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 15, &
    116                       comm_inter, ierr )
    117 
    118 !
    119 !--    Send the momentum flux (v) at bottom surface to the ocean model
    120        WRITE ( 9, * )  '*** send vsws to ocean'
    121        CALL local_flush( 9 )
    122        CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 16, &
    123                       comm_inter, ierr )
    124 
    125249    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
    126250
    127251!
    128 !--    Receive heat flux at the sea surface (top) from the atmosphere model
    129        WRITE ( 9, * )  '*** receive tswst from atmosphere'
    130        CALL local_flush( 9 )
    131        CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 12, &
    132                       comm_inter, status, ierr )
    133 
    134 !
    135 !--    Receive humidity flux from the atmosphere model (bottom)
    136 !--    and add it to the heat flux at the sea surface (top)...
     252!--    Horizontal grid size and number of processors is equal
     253!--    in ocean and atmosphere
     254       IF ( coupling_topology == 0 ) THEN
     255!
     256!--       Receive heat flux at the sea surface (top) from the atmosphere model
     257          CALL MPI_RECV( tswst(nysg,nxlg), ngp_xy, MPI_REAL, &
     258                         target_id, 12, comm_inter, status, ierr )
     259
     260
     261!
     262!--       Receive humidity flux from the atmosphere model (bottom)
     263!--       and add it to the heat flux at the sea surface (top)...
     264          IF ( humidity_remote )  THEN
     265             CALL MPI_RECV( qswst_remote(nysg,nxlg), ngp_xy, MPI_REAL, &
     266                            target_id, 13, comm_inter, status, ierr )
     267
     268          ENDIF
     269
     270!
     271!--       Send sea surface temperature to the atmosphere model
     272          CALL MPI_SEND( pt(nzt,nysg,nxlg), 1, type_xy, &
     273                         target_id, 14, comm_inter, ierr )
     274
     275!
     276!--       Receive momentum flux (u) at the sea surface (top) from the atmosphere
     277!--       model
     278          WRITE ( 9, * )  '*** receive uswst from atmosphere'
     279          CALL local_flush( 9 )
     280          CALL MPI_RECV( uswst(nysg,nxlg), ngp_xy, MPI_REAL, &
     281                         target_id, 15, comm_inter, status, ierr )
     282
     283!
     284!--       Receive momentum flux (v) at the sea surface (top) from the atmosphere
     285!--       model
     286          CALL MPI_RECV( vswst(nysg,nxlg), ngp_xy, MPI_REAL, &
     287                         target_id, 16, comm_inter, status, ierr )
     288
     289!--       Send u to the atmosphere model
     290          CALL MPI_SEND( u(nzt,nysg,nxlg), 1, type_xy, &
     291                         target_id, 17, comm_inter, ierr )
     292
     293!
     294!--       Send v to the atmosphere model
     295          CALL MPI_SEND( v(nzt,nysg,nxlg), 1, type_xy, &
     296                         target_id, 18, comm_inter, ierr )
     297
     298!
     299!--    Horizontal gridsize or number of processors differs between
     300!--    ocean and atmosphere
     301       ELSE
     302
     303!
     304!--       Receive heat flux at the sea surface (top) from the atmosphere model
     305          IF ( myid == 0 ) THEN
     306             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     307                            target_id, 12, comm_inter, status, ierr )           
     308          ENDIF
     309          CALL MPI_BARRIER( comm2d, ierr )
     310          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     311                          0, comm2d, ierr)
     312          tswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     313
     314!
     315!--       Receive humidity flux at the sea surface (top) from the
     316!--       atmosphere model
     317          IF ( humidity_remote ) THEN
     318             IF ( myid == 0 ) THEN
     319                CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     320                               target_id, 13, comm_inter, status, ierr )           
     321             ENDIF
     322             CALL MPI_BARRIER( comm2d, ierr )
     323             CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     324                             0, comm2d, ierr)
     325             qswst_remote(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     326          ENDIF
     327
     328!
     329!--       Send surface temperature to atmosphere
     330          total_2d_o = 0.0
     331          total_2d = 0.0
     332          total_2d(nys:nyn,nxl:nxr) = pt(nzt,nys:nyn,nxl:nxr)
     333
     334          CALL MPI_REDUCE(total_2d, total_2d_o, ngp_o, &
     335                          MPI_REAL, MPI_SUM, 0, comm2d, ierr)
     336
     337          CALL interpolate_to_atmos(14)
     338
     339!
     340!--       Receive momentum flux (u) at the sea surface (top) from the
     341!--       atmosphere model
     342          IF ( myid == 0 ) THEN
     343             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     344                            target_id, 15, comm_inter, status, ierr )           
     345          ENDIF
     346          CALL MPI_BARRIER( comm2d, ierr )
     347          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     348                          0, comm2d, ierr)
     349          uswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     350
     351!
     352!--       Receive momentum flux (v) at the sea surface (top) from the
     353!--       atmosphere model
     354          IF ( myid == 0 ) THEN
     355             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     356                            target_id, 16, comm_inter, status, ierr )           
     357          ENDIF
     358          CALL MPI_BARRIER( comm2d, ierr )
     359          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     360                          0, comm2d, ierr)
     361          vswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     362
     363!
     364!--       Send u to atmosphere
     365          total_2d_o = 0.0 
     366          total_2d = 0.0
     367          total_2d(nys:nyn,nxl:nxr) = u(nzt,nys:nyn,nxl:nxr)
     368          CALL MPI_REDUCE(total_2d, total_2d_o, ngp_o, MPI_REAL, &
     369                          MPI_SUM, 0, comm2d, ierr) 
     370          CALL interpolate_to_atmos(17)
     371
     372!
     373!--       Send v to atmosphere
     374          total_2d_o = 0.0
     375          total_2d = 0.0
     376          total_2d(nys:nyn,nxl:nxr) = v(nzt,nys:nyn,nxl:nxr)
     377          CALL MPI_REDUCE(total_2d, total_2d_o, ngp_o, MPI_REAL, &
     378                          MPI_SUM, 0, comm2d, ierr) 
     379          CALL interpolate_to_atmos(18)
     380       
     381       ENDIF
     382
     383!
     384!--    Conversions of fluxes received from atmosphere
    137385       IF ( humidity_remote )  THEN
    138           WRITE ( 9, * )  '*** receive qswst_remote from atmosphere'
    139           CALL local_flush( 9 )
    140           CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, &
    141                          target_id, 13, comm_inter, status, ierr )
    142 
    143386          !here tswst is still the sum of atmospheric bottom heat fluxes
    144387          tswst = tswst + qswst_remote * 2.2626108e6 / 1005.0
    … …  
    146389          !/(rho_atm(=1.0)*c_p)
    147390!
    148 !--    ...and convert it to a salinity flux at the sea surface (top)
     391!--        ...and convert it to a salinity flux at the sea surface (top)
    149392!--       following Steinhorn (1991), JPO 21, pp. 1681-1683:
    150393!--       S'w' = -S * evaporation / ( rho_water * ( 1 - S ) )
    151394          saswst = -1.0 * sa(nzt,:,:) * qswst_remote /  &
    152                ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) )
     395                    ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) )
    153396       ENDIF
    154397
    … …  
    156399!--    Adjust the kinematic heat flux with respect to ocean density
    157400!--    (constants are the specific heat capacities for air and water)
    158        !now tswst is the ocean top heat flux
     401!--    now tswst is the ocean top heat flux
    159402       tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0
    160 
    161 !
    162 !--    Send sea surface temperature to the atmosphere model
    163        WRITE ( 9, * )  '*** send pt to atmosphere'
    164        CALL local_flush( 9 )
    165        CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, target_id, 14, &
    166                       comm_inter, ierr )
    167 
    168 !
    169 !--    Receive momentum flux (u) at the sea surface (top) from the atmosphere
    170 !--    model
    171        WRITE ( 9, * )  '*** receive uswst from atmosphere'
    172        CALL local_flush( 9 )
    173        CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 15, &
    174                       comm_inter, status, ierr )
    175 
    176 !
    177 !--    Receive momentum flux (v) at the sea surface (top) from the atmosphere
    178 !--    model
    179        WRITE ( 9, * )  '*** receive vswst from atmosphere'
    180        CALL local_flush( 9 )
    181        CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 16, &
    182                       comm_inter, status, ierr )
    183403
    184404!
    … …  
    187407       vswst = vswst / rho(nzt,:,:)
    188408
     409
     410    ENDIF
     411
     412    IF ( coupling_topology == 1 ) THEN
     413       DEALLOCATE( total_2d_o, total_2d_a )
    189414    ENDIF
    190415
    … …  
    193418#endif
    194419
    195  END SUBROUTINE surface_coupler
     420  END SUBROUTINE surface_coupler
     421
     422
     423
     424  SUBROUTINE interpolate_to_atmos(tag)
     425
     426    USE arrays_3d
     427    USE control_parameters
     428    USE grid_variables
     429    USE indices
     430    USE pegrid
     431
     432    IMPLICIT NONE
     433
     434 
     435    INTEGER             ::  dnx, dnx2, dny, dny2, i, ii, j, jj
     436    INTEGER, intent(in) ::  tag
     437
     438    CALL MPI_BARRIER( comm2d, ierr )
     439
     440    IF ( myid == 0 ) THEN
     441
     442!
     443!--    cyclic boundary conditions for the total 2D-grid
     444       total_2d_o(-nbgp:-1,:) = total_2d_o(ny+1-nbgp:ny,:)
     445       total_2d_o(:,-nbgp:-1) = total_2d_o(:,nx+1-nbgp:nx)
     446
     447       total_2d_o(ny+1:ny+nbgp,:) = total_2d_o(0:nbgp-1,:)
     448       total_2d_o(:,nx+1:nx+nbgp) = total_2d_o(:,0:nbgp-1)
     449
     450!
     451!--    Number of gridpoints of the fine grid within one mesh of the coarse grid
     452       dnx = (nx_o+1) / (nx_a+1)
     453       dny = (ny_o+1) / (ny_a+1)
     454
     455!
     456!--    Distance for interpolation around coarse grid points within the fine grid
     457!--    (note: 2*dnx2 must not be equal with dnx) 
     458       dnx2 = 2 * ( dnx / 2 )
     459       dny2 = 2 * ( dny / 2 )
     460
     461       total_2d_a = 0.0
     462!
     463!--    Interpolation from ocean-grid-layer to atmosphere-grid-layer
     464       DO  j = 0, ny_a
     465          DO  i = 0, nx_a
     466             DO  jj = 0, dny2
     467                DO  ii = 0, dnx2
     468                   total_2d_a(j,i) = total_2d_a(j,i) &
     469                                     + total_2d_o(j*dny+jj,i*dnx+ii)
     470                ENDDO
     471             ENDDO
     472             total_2d_a(j,i) = total_2d_a(j,i) / ( ( dnx2 + 1 ) * ( dny2 + 1 ) )
     473          ENDDO
     474       ENDDO
     475!
     476!--    cyclic boundary conditions for atmosphere grid
     477       total_2d_a(-nbgp:-1,:) = total_2d_a(ny_a+1-nbgp:ny_a,:)
     478       total_2d_a(:,-nbgp:-1) = total_2d_a(:,nx_a+1-nbgp:nx_a)
     479       
     480       total_2d_a(ny_a+1:ny_a+nbgp,:) = total_2d_a(0:nbgp-1,:)
     481       total_2d_a(:,nx_a+1:nx_a+nbgp) = total_2d_a(:,0:nbgp-1)
     482!
     483!--    Transfer of the atmosphere-grid-layer to the atmosphere
     484       CALL MPI_SEND( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
     485                      target_id, tag, comm_inter, ierr )
     486
     487    ENDIF
     488
     489    CALL MPI_BARRIER( comm2d, ierr )
     490
     491  END SUBROUTINE interpolate_to_atmos
     492
     493
     494  SUBROUTINE interpolate_to_ocean(tag)
     495
     496    USE arrays_3d
     497    USE control_parameters
     498    USE grid_variables
     499    USE indices
     500    USE pegrid
     501
     502    IMPLICIT NONE
     503
     504    REAL                ::  fl, fr, myl, myr
     505    INTEGER             ::  dnx, dny, i, ii, j, jj
     506    INTEGER, intent(in) ::  tag
     507
     508    CALL MPI_BARRIER( comm2d, ierr )
     509
     510    IF ( myid == 0 ) THEN   
     511
     512!
     513!      Number of gridpoints of the fine grid within one mesh of the coarse grid
     514       dnx = ( nx_o + 1 ) / ( nx_a + 1 )
     515       dny = ( ny_o + 1 ) / ( ny_a + 1 )
     516
     517!
     518!--    cyclic boundary conditions for atmosphere grid
     519       total_2d_a(-nbgp:-1,:) = total_2d_a(ny+1-nbgp:ny,:)
     520       total_2d_a(:,-nbgp:-1) = total_2d_a(:,nx+1-nbgp:nx)
     521       
     522       total_2d_a(ny+1:ny+nbgp,:) = total_2d_a(0:nbgp-1,:)
     523       total_2d_a(:,nx+1:nx+nbgp) = total_2d_a(:,0:nbgp-1)
     524!
     525!--    Bilinear Interpolation from atmosphere-grid-layer to ocean-grid-layer
     526       DO  j = 0, ny
     527          DO  i = 0, nx
     528             myl = ( total_2d_a(j+1,i)   - total_2d_a(j,i)   ) / dny
     529             myr = ( total_2d_a(j+1,i+1) - total_2d_a(j,i+1) ) / dny
     530             DO  jj = 0, dny-1
     531                fl = myl*jj  + total_2d_a(j,i) 
     532                fr = myr*jj  + total_2d_a(j,i+1) 
     533                DO  ii = 0, dnx-1
     534                   total_2d_o(j*dny+jj,i*dnx+ii) = ( fr - fl ) / dnx * ii + fl
     535                ENDDO
     536             ENDDO
     537          ENDDO
     538       ENDDO
     539!
     540!--    cyclic boundary conditions for ocean grid
     541       total_2d_o(-nbgp:-1,:) = total_2d_o(ny_o+1-nbgp:ny_o,:)
     542       total_2d_o(:,-nbgp:-1) = total_2d_o(:,nx_o+1-nbgp:nx_o)
     543
     544       total_2d_o(ny_o+1:ny_o+nbgp,:) = total_2d_o(0:nbgp-1,:)
     545       total_2d_o(:,nx_o+1:nx_o+nbgp) = total_2d_o(:,0:nbgp-1)
     546       
     547
     548       CALL MPI_SEND( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     549                      target_id, tag, comm_inter, ierr )
     550
     551    ENDIF
     552
     553    CALL MPI_BARRIER( comm2d, ierr ) 
     554
     555  END SUBROUTINE interpolate_to_ocean

  • TabularUnified palm/trunk/SOURCE/time_integration.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! Calls of exchange_horiz are modified.
     7! Adaption to slooping surface.
    78!
    89! Former revisions:
    … …  
    9495!-- determine and print out the run control parameters
    9596    IF ( simulated_time == 0.0 )  CALL timestep
     97
    9698    CALL run_control
     99
    97100
    98101!
    … …  
    126129
    127130       CALL cpu_log( log_point_s(10), 'timesteps', 'start' )
    128 
    129131!
    130132!--    Determine size of next time step
    … …  
    189191!--       Exchange of ghost points (lateral boundary conditions)
    190192          CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'start' )
    191           CALL exchange_horiz( u_p )
    192           CALL exchange_horiz( v_p )
    193           CALL exchange_horiz( w_p )
    194           CALL exchange_horiz( pt_p )
    195           IF ( .NOT. constant_diffusion       )  CALL exchange_horiz( e_p )
     193          CALL exchange_horiz( u_p, nbgp )
     194          CALL exchange_horiz( v_p, nbgp )
     195          CALL exchange_horiz( w_p, nbgp )
     196          CALL exchange_horiz( pt_p, nbgp )
     197          IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e_p, nbgp )
    196198          IF ( ocean )  THEN
    197              CALL exchange_horiz( sa_p )
    198              CALL exchange_horiz( rho )
    199              CALL exchange_horiz( prho )
    200           ENDIF
    201           IF ( humidity  .OR.  passive_scalar )  CALL exchange_horiz( q_p )
     199             CALL exchange_horiz( sa_p, nbgp )
     200             CALL exchange_horiz( rho, nbgp )
     201             CALL exchange_horiz( prho, nbgp )
     202          ENDIF
     203          IF (humidity  .OR.  passive_scalar) CALL exchange_horiz( q_p, nbgp )
    202204          IF ( cloud_droplets )  THEN
    203              CALL exchange_horiz( ql )
    204              CALL exchange_horiz( ql_c )
    205              CALL exchange_horiz( ql_v )
    206              CALL exchange_horiz( ql_vp )
     205             CALL exchange_horiz( ql, nbgp )
     206             CALL exchange_horiz( ql_c, nbgp )
     207             CALL exchange_horiz( ql_v, nbgp )
     208             CALL exchange_horiz( ql_vp, nbgp )
    207209          ENDIF
    208210
    … …  
    228230!--       when a sloping surface is used
    229231          IF ( sloping_surface )  THEN
    230              IF ( nxl ==  0 )  pt(:,:,nxl-1) = pt(:,:,nxl-1) - pt_slope_offset
    231              IF ( nxr == nx )  pt(:,:,nxr+1) = pt(:,:,nxr+1) + pt_slope_offset
     232             IF ( nxl ==  0 ) pt(:,:,nxlg:nxl-1) = pt(:,:,nxlg:nxl-1) - pt_slope_offset
     233             IF ( nxr == nx )  pt(:,:,nxr+1:nxrg) = pt(:,:,nxr+1:nxrg) + pt_slope_offset
    232234          ENDIF
    233235
    … …  
    563565       CALL cpu_log( log_point_s(10), 'timesteps', 'stop' )
    564566
     567
    565568    ENDDO   ! time loop
    566569

  • TabularUnified palm/trunk/SOURCE/timestep.f90

    r623 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6!
     7!
     8! Exchange of terminate_coupled between ocean and atmosphere via PE0
     9!
     10! Minimum grid spacing dxyz2_min(k) is now calculated using dzw instead of dzu
     11!
    712!
    813! Former revisions:
    … …  
    6065    REAL, DIMENSION(nzb+1:nzt) ::  dxyz2_min
    6166
     67
     68
    6269    CALL cpu_log( log_point(12), 'calculate_timestep', 'start' )
    6370
    6471!
    6572!-- Determine the maxima of the velocity components.
    66     CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, u, 'abs', &
     73    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', &
    6774                         u_max, u_max_ijk )
    68     CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, v, 'abs', &
     75    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', &
    6976                         v_max, v_max_ijk )
    70     CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, w, 'abs', &
     77    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', &
    7178                         w_max, w_max_ijk )
    7279
    … …  
    152159
    153160       DO  k = nzb+1, nzt
    154            dxyz2_min(k) = MIN( dx2, dy2, dzu(k)*dzu(k) ) * 0.125
     161           dxyz2_min(k) = MIN( dx2, dy2, dzw(k)*dzw(k) ) * 0.125
    155162       ENDDO
    156163
    … …  
    323330          IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 )  THEN
    324331             terminate_coupled = 2
    325              CALL MPI_SENDRECV( &
    326                   terminate_coupled,        1, MPI_INTEGER, target_id,  0, &
    327                   terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0, &
    328                   comm_inter, status, ierr )
     332             IF ( myid == 0 ) THEN
     333                CALL MPI_SENDRECV( &
     334                     terminate_coupled,        1, MPI_INTEGER, target_id,  0, &
     335                     terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0, &
     336                     comm_inter, status, ierr )
     337             ENDIF
     338             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr)
    329339          ENDIF
    330340#endif

  • TabularUnified palm/trunk/SOURCE/user_3d_data_averaging.f90

    r484 r667  
    4141!          CASE ( 'u2' )
    4242!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
    43 !                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     43!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    4444!             ENDIF
    4545!             u2_av = 0.0
    … …  
    6060!--       Sample for user-defined output:
    6161!          CASE ( 'u2' )
    62 !             DO  i = nxl-1, nxr+1
    63 !                DO  j = nys-1, nyn+1
     62!             DO  i = nxlg, nxrg
     63!                DO  j = nysg, nyng
    6464!                   DO  k = nzb, nzt+1
    6565!                      u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
    … …  
    8383!--       Sample for user-defined output:
    8484!          CASE ( 'u2' )
    85 !             DO  i = nxl-1, nxr+1
    86 !                DO  j = nys-1, nyn+1
     85!             DO  i = nxlg, nxrg
     86!                DO  j = nysg, nyng
    8787!                   DO  k = nzb, nzt+1
    8888!                      u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )

  • TabularUnified palm/trunk/SOURCE/user_actions.f90

    r392 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    6969!--          data output)
    7070!--          Sample for user-defined output:
    71 !             DO  i = nxl-1, nxr+1
    72 !                DO  j = nys-1, nyn+1
    73 !                   DO  k = nzb, nzt+1
     71!             DO  i = nxlg, nxrg
     72!                DO  j = nysg, nyng
     73!                   DO  k = nzb, nzt
    7474!                      u2(k,j,i) = u(k,j,i)**2
    7575!                   ENDDO
    7676!                ENDDO
    7777!             ENDDO
    78 !             DO  i = nxl-1, nxr
    79 !                DO  j = nys-1, nyn
     78!             DO  i = nxlg, nxr
     79!                DO  j = nysg, nyn
    8080!                   DO  k = nzb, nzt+1
    8181!                      ustvst(k,j,i) =  &

  • TabularUnified palm/trunk/SOURCE/user_data_output_2d.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    3434    LOGICAL ::  found, two_d
    3535
    36     REAL, DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) ::  local_pf
     36    REAL, DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nzt+1) ::  local_pf
    3737
    3838
    … …  
    4848!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
    4949!          IF ( av == 0 )  THEN
    50 !             DO  i = nxl-1, nxr+1
    51 !                DO  j = nys-1, nyn+1
     50!             DO  i = nxlg, nxrg
     51!                DO  j = nysg, nyng
    5252!                   DO  k = nzb, nzt+1
    5353!                      local_pf(i,j,k) = u2(k,j,i)
    … …  
    5656!             ENDDO
    5757!          ELSE
    58 !             DO  i = nxl-1, nxr+1
    59 !                DO  j = nys-1, nyn+1
     58!             DO  i = nxlg, nxrg
     59!                DO  j = nysg, nyng
    6060!                   DO  k = nzb, nzt+1
    6161!                      local_pf(i,j,k) = u2_av(k,j,i)

  • TabularUnified palm/trunk/SOURCE/user_data_output_3d.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    3131    LOGICAL ::  found
    3232
    33     REAL(spk), DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do) ::  local_pf
     33   REAL(spk), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nz_do) ::  local_pf
    3434
    3535
    … …  
    4545!       CASE ( 'u2' )
    4646!          IF ( av == 0 )  THEN
    47 !             DO  i = nxl-1, nxr+1
    48 !                DO  j = nys-1, nyn+1
     47!             DO  i = nxlg, nxrg
     48!                DO  j = nysg, nyng
    4949!                   DO  k = nzb, nz_do
    5050!                      local_pf(i,j,k) = u2(k,j,i)
    … …  
    5353!             ENDDO
    5454!          ELSE
    55 !             DO  i = nxl-1, nxr+1
    56 !                DO  j = nys-1, nyn+1
     55!             DO  i = nxlg, nxrg
     56!                DO  j = nysg, nyng
    5757!                   DO  k = nzb, nz_do
    5858!                      local_pf(i,j,k) = u2_av(k,j,i)

  • TabularUnified palm/trunk/SOURCE/user_init.f90

    r484 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    3030!-- Here the user-defined initializing actions follow:
    3131!-- Sample for user-defined output
    32 !    ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
    33 !    ALLOCATE( ustvst(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) );  ustvst = 0.0
     32!    ALLOCATE( u2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     33!    ALLOCATE( ustvst(nzb:nzt+1,nysg:nyng,nxlg:nxrg) );  ustvst = 0.0
    3434
    3535!-- Sample for user-defined time series

  • TabularUnified palm/trunk/SOURCE/user_init_plant_canopy.f90

    r392 r667  
    44! Current revisions:
    55! -----------------
    6 !
     6! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    77!
    88! Former revisions:
    … …  
    4949!--       plant canopy extends only over the second half of the
    5050!--       model domain along x
    51 !          DO  i = nxl-1, nxr+1
     51!          DO  i = nxlg, nxrg
    5252!             IF ( i >= INT(nx+1/2) ) THEN
    53 !                DO  j = nys-1, nyn+1
     53!                DO  j = nysg, nyng
    5454!                   lad_s(:,j,i) = lad(:)
    5555!                   cdc(:,j,i)   = drag_coefficient

  • TabularUnified palm/trunk/SOURCE/user_read_restart_data.f90

    r584 r667  
    77! Current revisions:
    88! -----------------
    9 !
     9! Allocation with nbgp.
    1010!
    1111! Former revisions:
    … …  
    5050                                                       offset_ya
    5151
    52     REAL, DIMENSION(nys_on_file-1:nyn_on_file+1,nxl_on_file-1:nxr_on_file+1) ::&
     52    REAL, DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: &
    5353          tmp_2d
    5454
    55     REAL, DIMENSION(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
    56                     nxl_on_file-1:nxr_on_file+1) ::        &
     55    REAL, DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: &
    5756          tmp_3d
    5857

  • TabularUnified palm/trunk/SOURCE/wall_fluxes.f90

    r484 r667  
    6262       INTEGER ::  i, j, k, wall_index
    6363
    64        INTEGER, DIMENSION(nys-1:nyn+1,nxl-1:nxr+1) ::  nzb_uvw_inner, &
     64       INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg) ::  nzb_uvw_inner, &
    6565                                                       nzb_uvw_outer
    6666       REAL ::  a, b, c1, c2, h1, h2, zp
    6767       REAL ::  pts, pt_i, rifs, u_i, v_i, us_wall, vel_total, ws, wspts
    6868
    69        REAL, DIMENSION(nys-1:nyn+1,nxl-1:nxr+1)   ::  wall
     69       REAL, DIMENSION(nysg:nyng,nxlg:nxrg)   ::  wall
    7070       REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wall_flux
    7171
    … …  
    348348       REAL ::  rifs
    349349
    350        REAL, DIMENSION(nys-1:nyn+1,nxl-1:nxr+1)   ::  wall
     350       REAL, DIMENSION(nysg:nyng,nxlg:nxrg)   ::  wall
    351351       REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wall_flux
    352352

  • TabularUnified palm/trunk/SOURCE/write_compressed.f90

    r623 r667  
    11 SUBROUTINE write_compressed( field, fid_avs, fid_fld, my_id, nxl, nxr, nyn, &
    2                               nys, nzb, nz_do3d, prec )
     2                              nys, nzb, nz_do3d, prec, nbgp )
    33
    44!------------------------------------------------------------------------------!
    55! Current revisions:
    66! -----------------
    7 !
     7! Array bounds and nx, ny adapted with nbgp.
    88!
    99! Former revisions:
    … …  
    5858
    5959    INTEGER, INTENT(IN) ::  fid_avs, fid_fld, my_id, nxl, nxr, nyn, nys, nzb, &
    60                             nz_do3d, prec
    61 
    62     REAL(spk), INTENT(IN) :: field(1:((nxr-nxl+3)*(nyn-nys+3)*(nz_do3d-nzb+1)))
     60                            nz_do3d, prec, nbgp
     61
     62    REAL(spk), INTENT(IN) :: field(1:((nxr-nxl+1+2*nbgp)*(nyn-nys+1+2*nbgp)*(nz_do3d-nzb+1)))
    6363
    6464!
    … …  
    7373    ENDDO
    7474
    75     nx     = nxr - nxl + 2
    76     ny     = nyn - nys + 2
     75    nx     = nxr - nxl + 2*nbgp
     76    ny     = nyn - nys + 2*nbgp
    7777    nz     = nz_do3d - nzb
    7878    length = (nx+1) * (ny+1) * (nz+1)
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |