Home


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

Changeset 2232


Ignore:
Timestamp:
May 30, 2017 5:47:52 PM (8 years ago)
Author:
suehring
Message:

Adjustments according new topography and surface-modelling concept implemented

Location:
palm/trunk/SOURCE
Files:
1 added
1 deleted
73 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/Makefile

    r2176 r2232  
    2020# Current revisions:
    2121# ------------------
    22 #
     22# +dependencies for surface_mod
     23# -wall_fluxes
    2324#
    2425# Former revisions:
    … …  
    351352        read_3d_binary.f90 read_var_list.f90 run_control.f90 \
    352353        set_slicer_attributes_dvrp.f90 singleton_mod.f90 sor.f90 spectra_mod.f90 \
    353         subsidence_mod.f90 sum_up_3d_data.f90 \
     354        subsidence_mod.f90 sum_up_3d_data.f90 surface_mod.f90 \
    354355        surface_coupler.f90 surface_layer_fluxes_mod.f90 swap_timelevel.f90 temperton_fft_mod.f90 \
    355356        time_integration.f90 time_to_string.f90 timestep.f90 \
    … …  
    369370        user_lpm_init.f90 user_lpm_set_attributes.f90 user_module.f90 \
    370371        user_parin.f90 user_read_restart_data.f90 \
    371         user_spectra.f90 user_statistics.f90 virtual_flight_mod.f90 wall_fluxes.f90 \
     372        user_spectra.f90 user_statistics.f90 virtual_flight_mod.f90 \
    372373        wind_turbine_model_mod.f90 write_3d_binary.f90 write_var_list.f90
    373374
    … …  
    413414advec_w_pw.o: modules.o mod_kinds.o
    414415advec_w_up.o: modules.o mod_kinds.o
    415 average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
     416average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o exchange_horiz_2d.o land_surface_model_mod.o \
    416417        radiation_model_mod.o urban_surface_mod.o
    417 boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o
     418boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o surface_mod.o
    418419buoyancy.o: modules.o mod_kinds.o
    419420calc_mean_profile.o: modules.o mod_kinds.o
    … …  
    445446data_output_2d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
    446447   netcdf_interface_mod.o land_surface_model_mod.o radiation_model_mod.o \
    447    urban_surface_mod.o
     448   surface_mod.o urban_surface_mod.o
    448449data_output_3d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
    449450   netcdf_interface_mod.o land_surface_model_mod.o urban_surface_mod.o
    450451diffusion_e.o: modules.o mod_kinds.o microphysics_mod.o \
    451    mod_particle_attributes.o
    452 diffusion_s.o: modules.o mod_kinds.o
    453 diffusion_u.o: modules.o mod_kinds.o wall_fluxes.o
    454 diffusion_v.o: modules.o mod_kinds.o wall_fluxes.o
    455 diffusion_w.o: modules.o mod_kinds.o wall_fluxes.o
    456 diffusivities.o: modules.o mod_kinds.o
     452   mod_particle_attributes.o surface_mod.o
     453diffusion_s.o: modules.o mod_kinds.o surface_mod.o
     454diffusion_u.o: modules.o mod_kinds.o surface_mod.o
     455diffusion_v.o: modules.o mod_kinds.o surface_mod.o
     456diffusion_w.o: modules.o mod_kinds.o surface_mod.o
     457diffusivities.o: modules.o mod_kinds.o surface_mod.o
    457458disturb_field.o: modules.o cpulog_mod.o mod_kinds.o random_function_mod.o \
    458459                 random_generator_parallel_mod.o
    459 disturb_heatflux.o: modules.o cpulog_mod.o mod_kinds.o
    460 eqn_state_seawater.o: modules.o mod_kinds.o
     460disturb_heatflux.o: modules.o cpulog_mod.o mod_kinds.o random_generator_parallel_mod.o surface_mod.o
     461eqn_state_seawater.o: modules.o mod_kinds.o surface_mod.o
    461462exchange_horiz.o: modules.o cpulog_mod.o mod_kinds.o
    462463exchange_horiz_2d.o: modules.o cpulog_mod.o mod_kinds.o pmc_interface_mod.o
    463464fft_xy_mod.o: modules.o mod_kinds.o singleton_mod.o temperton_fft_mod.o
    464465flow_statistics.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
    465    netcdf_interface_mod.o radiation_model_mod.o
     466   netcdf_interface_mod.o radiation_model_mod.o surface_mod.o
    466467global_min_max.o: modules.o mod_kinds.o
    467468header.o: modules.o cpulog_mod.o mod_kinds.o netcdf_interface_mod.o land_surface_model_mod.o\
    … …  
    470471inflow_turbulence.o: modules.o cpulog_mod.o mod_kinds.o
    471472init_1d_model.o: modules.o mod_kinds.o
    472 init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o land_surface_model_mod.o \
     473init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o disturb_heatflux.o land_surface_model_mod.o \
    473474   lpm_init.o ls_forcing_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o \
    474475   radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
    475    surface_layer_fluxes_mod.o microphysics_mod.o mod_particle_attributes.o \
    476    urban_surface_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
     476   microphysics_mod.o mod_particle_attributes.o surface_layer_fluxes_mod.o \
     477   urban_surface_mod.o virtual_flight_mod.o surface_mod.o wind_turbine_model_mod.o
    477478init_advec.o: modules.o mod_kinds.o
    478479init_cloud_physics.o: modules.o mod_kinds.o
    479480init_coupling.o: modules.o mod_kinds.o
    480481init_dvrp.o: modules.o mod_kinds.o
    481 init_grid.o: modules.o mod_kinds.o advec_ws.o
     482init_grid.o: modules.o mod_kinds.o advec_ws.o netcdf_interface_mod.o surface_mod.o
    482483init_masks.o: modules.o mod_kinds.o netcdf_interface_mod.o
    483484init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o
    … …  
    487488init_slope.o: modules.o mod_kinds.o
    488489interaction_droplets_ptq.o: modules.o mod_kinds.o
    489 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o
     490land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o surface_mod.o
    490491local_stop.o: modules.o mod_kinds.o pmc_interface_mod.o
    491492local_tremain.o: modules.o cpulog_mod.o mod_kinds.o
    … …  
    519520ls_forcing_mod.o: modules.o cpulog_mod.o mod_kinds.o
    520521message.o: modules.o mod_kinds.o pmc_interface_mod.o
    521 microphysics_mod.o: modules.o cpulog_mod.o mod_kinds.o
     522microphysics_mod.o: modules.o cpulog_mod.o mod_kinds.o surface_mod.o
    522523modules.o: modules.f90 mod_kinds.o
    523524mod_kinds.o: mod_kinds.f90
    … …  
    546547poismg_noopt.o: modules.o cpulog_mod.o mod_kinds.o
    547548posix_calls_from_fortran.o: posix_calls_from_fortran.f90
    548 pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o pmc_interface_mod.o
     549pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o pmc_interface_mod.o \
     550   surface_mod.o
    549551print_1d.o: modules.o cpulog_mod.o mod_kinds.o
    550 production_e.o: modules.o mod_kinds.o wall_fluxes.o
     552production_e.o: modules.o mod_kinds.o surface_mod.o
    551553prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_s_bc.o advec_u_pw.o \
    552554        advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o \
    … …  
    555557        eqn_state_seawater.o mod_kinds.o microphysics_mod.o \
    556558        nudging_mod.o plant_canopy_model_mod.o production_e.o radiation_model_mod.o \
    557         subsidence_mod.o urban_surface_mod.o user_actions.o wind_turbine_model_mod.o
     559        subsidence_mod.o surface_mod.o user_actions.o wind_turbine_model_mod.o
    558560progress_bar_mod.o: modules.o mod_kinds.o
    559561radiation_model_mod.o : modules.o mod_particle_attributes.o microphysics_mod.o
    … …  
    563565read_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o \
    564566   land_surface_model_mod.o radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
    565    spectra_mod.o
     567   spectra_mod.o surface_mod.o
    566568read_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o \
    567569   spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o
    … …  
    573575subsidence_mod.o: modules.o mod_kinds.o
    574576sum_up_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
    575                   radiation_model_mod.o urban_surface_mod.o
     577                  radiation_model_mod.o surface_mod.o urban_surface_mod.o
    576578surface_coupler.o: modules.o cpulog_mod.o mod_kinds.o
    577 surface_layer_fluxes_mod.o: modules.o mod_kinds.o land_surface_model_mod.o \
    578         urban_surface_mod.o
     579surface_layer_fluxes_mod.o: modules.o mod_kinds.o exchange_horiz_2d.o land_surface_model_mod.o \
     580        urban_surface_mod.o surface_mod.o
     581surface_mod.o: modules.o mod_kinds.o init_pegrid.o
    579582swap_timelevel.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
    580583   pmc_interface_mod.o urban_surface_mod.o
    581584temperton_fft_mod.o: modules.o mod_kinds.o
    582585time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \
    583         cpulog_mod.o data_output_flight.o interaction_droplets_ptq.o land_surface_model_mod.o \
     586        cpulog_mod.o data_output_flight.o disturb_heatflux.o interaction_droplets_ptq.o land_surface_model_mod.o \
    584587        ls_forcing_mod.o mod_kinds.o nudging_mod.o pmc_interface_mod.o production_e.o \
    585588        prognostic_equations.o progress_bar_mod.o radiation_model_mod.o \
    586         spectra_mod.o user_actions.o surface_layer_fluxes_mod.o microphysics_mod.o \
     589        spectra_mod.o user_actions.o microphysics_mod.o surface_layer_fluxes_mod.o surface_mod.o \
    587590        urban_surface_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
    588591time_to_string.o: mod_kinds.o
    … …  
    600603   netcdf_interface_mod.o
    601604user_check_parameters.o: modules.o mod_kinds.o user_module.o
    602 user_data_output_2d.o: modules.o mod_kinds.o user_module.o
     605user_data_output_2d.o: modules.o mod_kinds.o surface_mod.o user_module.o
    603606user_data_output_3d.o: modules.o mod_kinds.o user_module.o
    604607user_data_output_mask.o: modules.o mod_kinds.o user_module.o
    … …  
    609612user_header.o: modules.o mod_kinds.o user_module.o
    610613user_init.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o
    611 user_init_3d_model.o: modules.o mod_kinds.o user_module.o
     614user_init_3d_model.o: modules.o mod_kinds.o surface_mod.o user_module.o
    612615user_init_flight.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o
    613616user_init_grid.o: modules.o mod_kinds.o user_module.o
    614 user_init_land_surface.o: modules.o mod_kinds.o user_module.o land_surface_model_mod.o netcdf_interface_mod.o
     617user_init_land_surface.o: modules.o mod_kinds.o surface_mod.o user_module.o land_surface_model_mod.o netcdf_interface_mod.o
    615618user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model_mod.o
    616619user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model_mod.o
    617 user_init_urban_surface.o: modules.o mod_kinds.o user_module.o urban_surface_mod.o
     620user_init_urban_surface.o: modules.o mod_kinds.o surface_mod.o user_module.o urban_surface_mod.o
    618621user_last_actions.o: modules.o mod_kinds.o user_module.o
    619622user_lpm_advec.o: modules.o mod_kinds.o user_module.o
    … …  
    626629user_statistics.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o
    627630virtual_flight_mod.o: modules.o cpulog_mod.o mod_kinds.o netcdf_interface_mod.o user_init_flight.o user_flight.o
    628 wall_fluxes.o: modules.o mod_kinds.o
    629631wind_turbine_model_mod.o: modules.o cpulog_mod.o mod_kinds.o
    630632write_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o \
    631633        radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
    632         spectra_mod.o
     634        spectra_mod.o surface_mod.o
    633635write_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o\
    634636   spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o

  • palm/trunk/SOURCE/advec_s_pw.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    104104
    105105       USE indices,                                                            &
    106            ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
    107                   nzt
     106           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
     107                  nzt, wall_flags_0
    108108
    109109       USE kinds
    … …  
    125125       DO  i = nxl, nxr
    126126          DO  j = nys, nyn
    127              DO  k = nzb_s_inner(j,i)+1, nzt
    128                 tend(k,j,i) = tend(k,j,i)                                      &
    129               -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
     127             DO  k = nzb+1, nzt
     128                tend(k,j,i) = tend(k,j,i) +                                       &
     129            ( -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
    130130                        - ( u(k,j,i)   - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
    131131                        ) * ddx                                                   &
    … …  
    135135              -         (   w(k,j,i)                * ( sk(k+1,j,i) - sk(k,j,i) ) &
    136136                        -   w(k-1,j,i)              * ( sk(k-1,j,i) - sk(k,j,i) ) &
    137                         ) * dd2zu(k)
     137                        ) * dd2zu(k)                                              &
     138            ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    138139             ENDDO
    139140          ENDDO
    … …  
    160161
    161162       USE indices,                                                            &
    162            ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
     163           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
    163164
    164165       USE kinds
    … …  
    178179
    179180
    180        DO  k = nzb_s_inner(j,i)+1, nzt
    181           tend(k,j,i) = tend(k,j,i)                                            &
    182               -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
     181       DO  k = nzb+1, nzt
     182          tend(k,j,i) = tend(k,j,i) +                                             &
     183            ( -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
    183184                        - ( u(k,j,i)   - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
    184185                        ) * ddx                                                   &
    … …  
    188189              -         (   w(k,j,i)                * ( sk(k+1,j,i) - sk(k,j,i) ) &
    189190                        -   w(k-1,j,i)              * ( sk(k-1,j,i) - sk(k,j,i) ) &
    190                         ) * dd2zu(k)
     191                        ) * dd2zu(k)                                              &
     192            ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    191193       ENDDO
    192194

  • palm/trunk/SOURCE/advec_s_up.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    104104
    105105       USE indices,                                                            &
    106            ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
    107                   nzt
     106           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt,        &
     107                  wall_flags_0
    108108
    109109       USE kinds
    … …  
    128128       DO  i = nxl, nxr
    129129          DO  j = nys, nyn
    130              DO  k = nzb_s_inner(j,i)+1, nzt
     130             DO  k = nzb+1, nzt
    131131!
    132132!--             x-direction
    … …  
    134134                IF ( ukomp > 0.0_wp )  THEN
    135135                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    136                                          ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
     136                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx     &
     137                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     138                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    137139                ELSE
    138140                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    139                                          ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
     141                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx     &
     142                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     143                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    140144                ENDIF
    141145!
    … …  
    144148                IF ( vkomp > 0.0_wp )  THEN
    145149                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    146                                          ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
     150                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy     &
     151                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     152                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    147153                ELSE
    148154                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    149                                          ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
     155                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy     &
     156                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     157                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    150158                ENDIF
    151159!
    … …  
    154162                IF ( wkomp > 0.0_wp )  THEN
    155163                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    156                                          ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
     164                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) &
     165                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     166                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    157167                ELSE
    158168                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    159                                          ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
     169                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) &
     170                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     171                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    160172                ENDIF
    161173
    … …  
    184196
    185197       USE indices,                                                            &
    186            ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
     198           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
    187199
    188200       USE kinds
    … …  
    206218
    207219
    208        DO  k = nzb_s_inner(j,i)+1, nzt
     220       DO  k = nzb+1, nzt
    209221!
    210222!--       x-direction
    … …  
    212224          IF ( ukomp > 0.0_wp )  THEN
    213225             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    214                                          ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
     226                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx     &
     227                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     228                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    215229          ELSE
    216230             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    217                                          ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
     231                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx     &
     232                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     233                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    218234          ENDIF
    219235!
    … …  
    222238          IF ( vkomp > 0.0_wp )  THEN
    223239             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    224                                          ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
     240                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy     &
     241                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     242                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    225243          ELSE
    226244             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    227                                          ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
     245                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy     &
     246                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     247                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    228248          ENDIF
    229249!
    … …  
    232252          IF ( wkomp > 0.0_wp )  THEN
    233253             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    234                                          ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
     254                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) &
     255                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     256                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    235257          ELSE
    236258             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    237                                          ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
     259                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) &
     260                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     261                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    238262          ENDIF
    239263

  • palm/trunk/SOURCE/advec_u_pw.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    9696
    9797       USE indices,                                                            &
    98            ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
     98           ONLY:  nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
    9999
    100100       USE kinds
    … …  
    114114       DO  i = nxlu, nxr
    115115          DO  j = nys, nyn
    116              DO  k = nzb_u_inner(j,i)+1, nzt
     116             DO  k = nzb+1, nzt
    117117                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
    118118                         ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu )         &
    … …  
    123123                         - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) )        &
    124124                                                                  * ddzw(k)    &
    125                                                       )
     125                                                      )                        &
     126                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     127                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    126128             ENDDO
    127129          ENDDO
    … …  
    148150
    149151       USE indices,                                                            &
    150            ONLY:  nzb_u_inner, nzt
     152           ONLY:  nzb, nzt, wall_flags_0
    151153
    152154       USE kinds
    … …  
    164166       gu = 2.0_wp * u_gtrans
    165167       gv = 2.0_wp * v_gtrans
    166        DO  k = nzb_u_inner(j,i)+1, nzt
     168       DO  k = nzb+1, nzt
    167169          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
    168170                         ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu )         &
    … …  
    173175                         - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) )        &
    174176                                                                  * ddzw(k)    &
    175                                                 )
     177                                                )                              &
     178                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     179                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    176180       ENDDO
    177181

  • palm/trunk/SOURCE/advec_u_up.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    9595
    9696       USE indices,                                                            &
    97            ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
     97           ONLY:  nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
    9898
    9999       USE kinds
    … …  
    113113       DO  i = nxlu, nxr
    114114          DO  j = nys, nyn
    115              DO  k = nzb_u_inner(j,i)+1, nzt
     115             DO  k = nzb+1, nzt
    116116!
    117117!--             x-direction
    … …  
    119119                IF ( ukomp > 0.0_wp )  THEN
    120120                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    121                                          ( u(k,j,i) - u(k,j,i-1) ) * ddx
     121                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx       &
     122                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     123                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    122124                ELSE
    123125                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    124                                           ( u(k,j,i+1) - u(k,j,i) ) * ddx
     126                                          ( u(k,j,i+1) - u(k,j,i) ) * ddx      &
     127                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     128                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    125129                ENDIF
    126130!
    … …  
    130134                IF ( vkomp > 0.0_wp )  THEN
    131135                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    132                                          ( u(k,j,i) - u(k,j-1,i) ) * ddy
     136                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
     137                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     138                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    133139                ELSE
    134140                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    135                                          ( u(k,j+1,i) - u(k,j,i) ) * ddy
     141                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy       &
     142                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     143                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    136144                ENDIF
    137145!
    … …  
    141149                IF ( wkomp > 0.0_wp )  THEN
    142150                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    143                                          ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
     151                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)   &
     152                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     153                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    144154                ELSE
    145155                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    146                                          ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
     156                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
     157                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     158                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    147159                ENDIF
    148160
    … …  
    171183
    172184       USE indices,                                                            &
    173            ONLY:  nzb_u_inner, nzt
     185           ONLY:  nzb, nzt, wall_flags_0
    174186
    175187       USE kinds
    … …  
    187199
    188200
    189        DO  k = nzb_u_inner(j,i)+1, nzt
     201       DO  k = nzb+1, nzt
    190202!
    191203!--       x-direction
    … …  
    193205          IF ( ukomp > 0.0_wp )  THEN
    194206             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    195                                          ( u(k,j,i) - u(k,j,i-1) ) * ddx
     207                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx       &
     208                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     209                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    196210          ELSE
    197211             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    198                                          ( u(k,j,i+1) - u(k,j,i) ) * ddx
     212                                         ( u(k,j,i+1) - u(k,j,i) ) * ddx       &
     213                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     214                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    199215          ENDIF
    200216!
    … …  
    204220          IF ( vkomp > 0.0_wp )  THEN
    205221             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    206                                          ( u(k,j,i) - u(k,j-1,i) ) * ddy
     222                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
     223                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     224                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    207225          ELSE
    208226             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    209                                          ( u(k,j+1,i) - u(k,j,i) ) * ddy
     227                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy       &
     228                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     229                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    210230          ENDIF
    211231!
    … …  
    214234          IF ( wkomp > 0.0_wp )  THEN
    215235             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    216                                          ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
     236                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)   &
     237                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     238                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    217239          ELSE
    218240             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    219                                          ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
     241                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
     242                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     243                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    220244          ENDIF
    221245

  • palm/trunk/SOURCE/advec_v_pw.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    9696
    9797       USE indices,                                                            &
    98            ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
     98           ONLY:  nxl, nxr, nyn, nysv, nzb, nzt, wall_flags_0
    9999
    100100       USE kinds
    … …  
    115115       DO  i = nxl, nxr
    116116          DO  j = nysv, nyn
    117              DO  k = nzb_v_inner(j,i)+1, nzt
     117             DO  k = nzb+1, nzt
    118118                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
    119119                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
    … …  
    124124                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
    125125                                                                  * ddzw(k)    &
    126                                                       )
     126                                                      )                        &
     127                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     128                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    127129             ENDDO
    128130          ENDDO
    … …  
    149151
    150152       USE indices,                                                            &
    151            ONLY:  nzb_v_inner, nzt
     153           ONLY:  nzb, nzt, wall_flags_0
    152154
    153155       USE kinds
    … …  
    166168       gu = 2.0_wp * u_gtrans
    167169       gv = 2.0_wp * v_gtrans
    168        DO  k = nzb_v_inner(j,i)+1, nzt
     170       DO  k = nzb+1, nzt
    169171          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
    170172                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
    … …  
    175177                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
    176178                                                                  * ddzw(k)    &
    177                                                 )
     179                                                )                              &
     180                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     181                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    178182       ENDDO
    179183 

  • palm/trunk/SOURCE/advec_v_up.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    9595
    9696       USE indices,                                                            &
    97            ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
     97           ONLY:  nxl, nxr, nyn, nysv, nzb, nzt, wall_flags_0
    9898
    9999       USE kinds
    … …  
    113113       DO  i = nxl, nxr
    114114          DO  j = nysv, nyn
    115              DO  k = nzb_v_inner(j,i)+1, nzt
     115             DO  k = nzb+1, nzt
    116116!
    117117!--             x-direction
    … …  
    120120                IF ( ukomp > 0.0_wp )  THEN
    121121                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    122                                          ( v(k,j,i) - v(k,j,i-1) ) * ddx
     122                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
     123                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     124                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    123125                ELSE
    124126                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    125                                          ( v(k,j,i+1) - v(k,j,i) ) * ddx
     127                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx       &
     128                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     129                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    126130                ENDIF
    127131!
    … …  
    130134                IF ( vkomp > 0.0_wp )  THEN
    131135                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    132                                          ( v(k,j,i) - v(k,j-1,i) ) * ddy
     136                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy       &
     137                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     138                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    133139                ELSE
    134140                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    135                                          ( v(k,j+1,i) - v(k,j,i) ) * ddy
     141                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy       &
     142                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     143                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    136144                ENDIF
    137145!
    … …  
    141149                IF ( wkomp > 0.0_wp )  THEN
    142150                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    143                                          ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
     151                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)   &
     152                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     153                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    144154                ELSE
    145155                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    146                                          ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
     156                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
     157                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     158                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    147159                ENDIF
    148160
    … …  
    171183
    172184       USE indices,                                                            &
    173            ONLY:  nzb_v_inner, nzt
     185           ONLY:  nzb, nzt, wall_flags_0
    174186
    175187       USE kinds
    … …  
    187199
    188200
    189        DO  k = nzb_v_inner(j,i)+1, nzt
     201       DO  k = nzb+1, nzt
    190202!
    191203!--       x-direction
    … …  
    194206          IF ( ukomp > 0.0_wp )  THEN
    195207             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    196                                          ( v(k,j,i) - v(k,j,i-1) ) * ddx
     208                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
     209                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     210                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    197211          ELSE
    198212             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    199                                          ( v(k,j,i+1) - v(k,j,i) ) * ddx
     213                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx       &
     214                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     215                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    200216          ENDIF
    201217!
    … …  
    204220          IF ( vkomp > 0.0_wp )  THEN
    205221             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    206                                          ( v(k,j,i) - v(k,j-1,i) ) * ddy
     222                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy       &
     223                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     224                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    207225          ELSE
    208226             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    209                                          ( v(k,j+1,i) - v(k,j,i) ) * ddy
     227                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy       &
     228                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     229                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    210230          ENDIF
    211231!
    … …  
    214234          IF ( wkomp > 0.0_wp )  THEN
    215235             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    216                                          ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
     236                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)   &
     237                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     238                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    217239          ELSE
    218240             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    219                                          ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
     241                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
     242                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     243                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    220244          ENDIF
    221245

  • palm/trunk/SOURCE/advec_w_pw.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    9696
    9797       USE indices,                                                            &
    98            ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
     98           ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    9999
    100100       USE kinds
    … …  
    115115       DO  i = nxl, nxr
    116116          DO  j = nys, nyn
    117              DO  k = nzb_w_inner(j,i)+1, nzt
     117             DO  k = nzb+1, nzt
    118118                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
    119119                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
    … …  
    124124                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
    125125                                                                  * ddzu(k+1)  &
    126                                                       )
     126                                                      )                        &
     127                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     128                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    127129             ENDDO
    128130          ENDDO
    … …  
    149151
    150152       USE indices,                                                            &
    151            ONLY:  nzb_w_inner, nzt
     153           ONLY:  nzb, nzt, wall_flags_0
    152154
    153155       USE kinds
    … …  
    165167       gu = 2.0_wp * u_gtrans
    166168       gv = 2.0_wp * v_gtrans
    167        DO  k = nzb_w_inner(j,i)+1, nzt
     169       DO  k = nzb+1, nzt
    168170          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
    169171                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
    … …  
    174176                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
    175177                                                                  * ddzu(k+1)  &
    176                                                 )
     178                                                )                              &
     179                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     180                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    177181       ENDDO
    178182    END SUBROUTINE advec_w_pw_ij

  • palm/trunk/SOURCE/advec_w_up.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! topography representation via flags
    2323!
    2424! Former revisions:
    … …  
    9595
    9696       USE indices,                                                            &
    97            ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
     97           ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    9898
    9999       USE kinds
    … …  
    112112       DO  i = nxl, nxr
    113113          DO  j = nys, nyn
    114              DO  k = nzb_w_inner(j,i)+1, nzt-1
     114             DO  k = nzb+1, nzt-1
    115115!
    116116!--             x-direction
    … …  
    119119                IF ( ukomp > 0.0_wp )  THEN
    120120                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    121                                          ( w(k,j,i) - w(k,j,i-1) ) * ddx
     121                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx       &
     122                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     123                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    122124                ELSE
    123125                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    124                                          ( w(k,j,i+1) - w(k,j,i) ) * ddx
     126                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx       &
     127                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     128                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    125129                ENDIF
    126130!
    … …  
    130134                IF ( vkomp > 0.0_wp )  THEN
    131135                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    132                                          ( w(k,j,i) - w(k,j-1,i) ) * ddy
     136                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy       &
     137                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     138                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    133139                ELSE
    134140                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    135                                          ( w(k,j+1,i) - w(k,j,i) ) * ddy
     141                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy       &
     142                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     143                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    136144                ENDIF
    137145!
    … …  
    139147                IF ( w(k,j,i) > 0.0_wp )  THEN
    140148                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
    141                                          ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
     149                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)   &
     150                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     151                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    142152                ELSE
    143153                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
    144                                          ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
     154                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
     155                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     156                                               BTEST( wall_flags_0(k,j,i), 3 ) )
    145157                ENDIF
    146158
    … …  
    169181
    170182       USE indices,                                                            &
    171            ONLY:  nzb_w_inner, nzt
     183           ONLY:  nzb, nzt, wall_flags_0
    172184
    173185       USE kinds
    … …  
    184196
    185197
    186        DO  k = nzb_w_inner(j,i)+1, nzt-1
     198       DO  k = nzb+1, nzt-1
    187199!
    188200!--       x-direction

  • palm/trunk/SOURCE/advec_ws.f90

    r2201 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Rename wall_flags_0 and wall_flags_00 into advc_flags_1 and advc_flags_2,
     23! respectively.
     24! Set advc_flags_1/2 on basis of wall_flags_0/00 instead of nzb_s/u/v/w_inner.
     25! Setting advc_flags_1/2 also for downward-facing walls
    2326!
    2427! Former revisions:
    … …  
    147150! vector version.
    148151! Degradation of the applied order of scheme is now steered by multiplying with
    149 ! Integer wall_flags_0. 2nd order scheme, WS3 and WS5 are calculated on each
     152! Integer advc_flags_1. 2nd order scheme, WS3 and WS5 are calculated on each
    150153! grid point and mulitplied with the appropriate flag.
    151154! 2nd order numerical dissipation term changed. Now the appropriate 2nd order
    … …  
    406409
    407410       USE indices,                                                            &
    408            ONLY:  nbgp, nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzb_s_inner,      &
    409                   nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt, wall_flags_0,    &
    410                   wall_flags_00
     411           ONLY:  advc_flags_1, advc_flags_2, nbgp, nxl, nxlu, nxr, nyn, nys,  &
     412                  nysv, nzb, nzt, wall_flags_0
    411413
    412414       USE kinds
    … …  
    414416       IMPLICIT NONE
    415417
    416        INTEGER(iwp) ::  i  !< index variable along x
    417        INTEGER(iwp) ::  j  !< index variable along y
    418        INTEGER(iwp) ::  k  !< index variable along z
    419 
     418       INTEGER(iwp) ::  i     !< index variable along x
     419       INTEGER(iwp) ::  j     !< index variable along y
     420       INTEGER(iwp) ::  k     !< index variable along z
     421       INTEGER(iwp) ::  k_mm  !< dummy index along z
     422       INTEGER(iwp) ::  k_pp  !< dummy index along z
     423       INTEGER(iwp) ::  k_ppp !< dummy index along z
     424       
    420425       LOGICAL      ::  flag_set !< steering variable for advection flags
    421426   
    … …  
    425430!--       Set flags to steer the degradation of the advection scheme in advec_ws
    426431!--       near topography, inflow- and outflow boundaries as well as bottom and
    427 !--       top of model domain. wall_flags_0 remains zero for all non-prognostic
     432!--       top of model domain. advc_flags_1 remains zero for all non-prognostic
    428433!--       grid points.
    429434          DO  i = nxl, nxr
    430435             DO  j = nys, nyn
    431                 DO  k = nzb_s_inner(j,i)+1, nzt
     436                DO  k = nzb+1, nzt
    432437!
    433438!--                scalar - x-direction
    434439!--                WS1 (0), WS3 (1), WS5 (2)
    435                    IF ( ( k <= nzb_s_inner(j,i+1) .OR. k <= nzb_s_inner(j,i+2) &   
    436                      .OR. k <= nzb_s_inner(j,i-1) )                            &
    437                        .OR. ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
    438                               .AND. i == nxl   )    .OR.                       &
     440                   IF ( ( .NOT. BTEST(wall_flags_0(k,j,i+1),0)                 &
     441                    .OR.  .NOT. BTEST(wall_flags_0(k,j,i+2),0)                 &   
     442                    .OR.  .NOT. BTEST(wall_flags_0(k,j,i-1),0) )               &
     443                      .OR.  ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
     444                            .AND.  i == nxl   )                                &
     445                      .OR.  ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
     446                            .AND.  i == nxr   ) )                              &
     447                   THEN
     448                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 0 )
     449                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+3),0)             &
     450                       .AND.        BTEST(wall_flags_0(k,j,i+1),0)             &
     451                       .AND.        BTEST(wall_flags_0(k,j,i+2),0)             &
     452                       .AND.        BTEST(wall_flags_0(k,j,i-1),0)             &
     453                            )                       .OR.                       &
     454                            ( .NOT. BTEST(wall_flags_0(k,j,i-2),0)             &
     455                       .AND.        BTEST(wall_flags_0(k,j,i+1),0)             &
     456                       .AND.        BTEST(wall_flags_0(k,j,i+2),0)             &
     457                       .AND.        BTEST(wall_flags_0(k,j,i-1),0)             &
     458                            )                                                  &
     459                                                    .OR.                       &
    439460                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
    440                               .AND. i == nxr   ) )                             &
     461                              .AND. i == nxr-1 )    .OR.                       &
     462                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
     463                              .AND. i == nxlu  ) )                             &
    441464                   THEN
    442                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 )
    443                    ELSEIF ( ( k <= nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i+1)&
    444                                                       .AND. k > nzb_s_inner(j,i+2)&
    445                                                       .AND. k > nzb_s_inner(j,i-1)&
    446                             )                       .OR.                          &
    447                             ( k <= nzb_s_inner(j,i-2) .AND. k > nzb_s_inner(j,i+1)&
    448                                                       .AND. k > nzb_s_inner(j,i+2)&
    449                                                       .AND. k > nzb_s_inner(j,i-1)&
    450                             )                                                     &
    451                                                     .OR.                          &
    452                             ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
    453                               .AND. i == nxr-1 )    .OR.                          &
    454                             ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
    455                               .AND. i == nxlu  ) )                                &
    456                    THEN
    457                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 )
    458                    ELSEIF ( k > nzb_s_inner(j,i+1) .AND. k > nzb_s_inner(j,i+2)&
    459                       .AND. k > nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i-1)&
    460                       .AND. k > nzb_s_inner(j,i-2) )                           &
     465                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 1 )
     466                   ELSEIF ( BTEST(wall_flags_0(k,j,i+1),0)                     &
     467                      .AND. BTEST(wall_flags_0(k,j,i+2),0)                     &
     468                      .AND. BTEST(wall_flags_0(k,j,i+3),0)                     &
     469                      .AND. BTEST(wall_flags_0(k,j,i-1),0)                     &
     470                      .AND. BTEST(wall_flags_0(k,j,i-2),0) )                   &
    461471                   THEN
    462                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )
     472                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 2 )
    463473                   ENDIF
    464474!
    465475!--                scalar - y-direction
    466476!--                WS1 (3), WS3 (4), WS5 (5)
    467                    IF ( ( k <= nzb_s_inner(j+1,i)  .OR. k <= nzb_s_inner(j+2,i)   &   
    468                                                    .OR. k <= nzb_s_inner(j-1,i) ) &
    469                                                     .OR.                          &
    470                             ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
    471                               .AND. j == nys   )    .OR.                          &
    472                             ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
    473                               .AND. j == nyn   ) )                                &
     477                   IF ( ( .NOT. BTEST(wall_flags_0(k,j+1,i),0)                 &
     478                    .OR.  .NOT. BTEST(wall_flags_0(k,j+2,i),0)                 &   
     479                    .OR.  .NOT. BTEST(wall_flags_0(k,j-1,i),0))                &
     480                      .OR.  ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
     481                            .AND.  j == nys   )                                &
     482                      .OR.  ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
     483                            .AND.  j == nyn   ) )                              &
    474484                   THEN
    475                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )
     485                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 3 )
    476486!
    477487!--                WS3
    478                    ELSEIF ( ( k <= nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j+1,i)&
    479                                                       .AND. k > nzb_s_inner(j+2,i)&
    480                                                       .AND. k > nzb_s_inner(j-1,i)&
    481                             )                           .OR.                      &
    482                             ( k <= nzb_s_inner(j-2,i) .AND. k > nzb_s_inner(j+1,i)&
    483                                                       .AND. k > nzb_s_inner(j+2,i)&
    484                                                       .AND. k > nzb_s_inner(j-1,i)&
    485                             )                                                     &
    486                                                         .OR.                      &
    487                             ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
    488                               .AND. j == nysv  )    .OR.                          &
    489                             ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
    490                               .AND. j == nyn-1 ) )                                &
     488                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+3,i),0)             &
     489                       .AND.        BTEST(wall_flags_0(k,j+1,i),0)             &
     490                       .AND.        BTEST(wall_flags_0(k,j+2,i),0)             &
     491                       .AND.        BTEST(wall_flags_0(k,j-1,i),0)             &
     492                            )                       .OR.                       &
     493                            ( .NOT. BTEST(wall_flags_0(k,j-2,i),0)             &
     494                       .AND.        BTEST(wall_flags_0(k,j+1,i),0)             &
     495                       .AND.        BTEST(wall_flags_0(k,j+2,i),0)             &
     496                       .AND.        BTEST(wall_flags_0(k,j-1,i),0)             &
     497                            )                                                  &
     498                                                    .OR.                       &
     499                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
     500                              .AND. j == nysv  )    .OR.                       &
     501                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
     502                              .AND. j == nyn-1 ) )                             &         
    491503                   THEN
    492                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 4 )
     504                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 4 )
    493505!
    494506!--                WS5
    495                    ELSEIF ( k > nzb_s_inner(j+1,i) .AND. k > nzb_s_inner(j+2,i)&
    496                       .AND. k > nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j-1,i)&
    497                       .AND. k > nzb_s_inner(j-2,i) )                           &
     507                   ELSEIF ( BTEST(wall_flags_0(k,j+1,i),0)                     &
     508                      .AND. BTEST(wall_flags_0(k,j+2,i),0)                     &
     509                      .AND. BTEST(wall_flags_0(k,j+3,i),0)                     &
     510                      .AND. BTEST(wall_flags_0(k,j-1,i),0)                     &
     511                      .AND. BTEST(wall_flags_0(k,j-2,i),0) )                   &
    498512                   THEN
    499                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 5 )
     513                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 5 )
    500514                   ENDIF
    501515!
    502516!--                scalar - z-direction
    503517!--                WS1 (6), WS3 (7), WS5 (8)
     518                   IF ( k == nzb+1 )  THEN
     519                      k_mm = nzb
     520                   ELSE
     521                      k_mm = k - 2
     522                   ENDIF
     523                   IF ( k > nzt-1 )  THEN
     524                      k_pp = nzt+1
     525                   ELSE
     526                      k_pp = k + 2
     527                   ENDIF
     528                   IF ( k > nzt-2 )  THEN
     529                      k_ppp = nzt+1
     530                   ELSE
     531                      k_ppp = k + 3
     532                   ENDIF
     533
    504534                   flag_set = .FALSE.
    505                    IF ( k == nzb_s_inner(j,i) + 1 .OR. k == nzt )  THEN
    506                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 6 )
     535                   IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),0)  .AND.            &
     536                              BTEST(wall_flags_0(k,j,i),0)    .OR.             &
     537                        .NOT. BTEST(wall_flags_0(k_pp,j,i),0) .AND.            &                             
     538                              BTEST(wall_flags_0(k,j,i),0)    .OR.             &
     539                        k == nzt )                                             &
     540                   THEN
     541                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 6 )
    507542                      flag_set = .TRUE.
    508                    ELSEIF ( k == nzb_s_inner(j,i) + 2 .OR. k == nzt - 1 )  THEN
    509                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 7 )
     543                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),0)    .OR.    &
     544                              .NOT. BTEST(wall_flags_0(k_ppp,j,i),0) ) .AND.   &
     545                                  BTEST(wall_flags_0(k-1,j,i),0)  .AND.        &
     546                                  BTEST(wall_flags_0(k,j,i),0)    .AND.        &
     547                                  BTEST(wall_flags_0(k+1,j,i),0)  .AND.        &
     548                                  BTEST(wall_flags_0(k_pp,j,i),0) .OR.         &   
     549                            k == nzt - 1 )                                     &
     550                   THEN
     551                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 7 )
    510552                      flag_set = .TRUE.
    511                    ELSEIF ( k > nzb_s_inner(j,i) .AND. .NOT. flag_set )  THEN
    512                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 )
     553                   ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),0)                    &
     554                     .AND.  BTEST(wall_flags_0(k-1,j,i),0)                     &
     555                     .AND.  BTEST(wall_flags_0(k,j,i),0)                       &
     556                     .AND.  BTEST(wall_flags_0(k+1,j,i),0)                     &
     557                     .AND.  BTEST(wall_flags_0(k_pp,j,i),0)                    &
     558                     .AND.  BTEST(wall_flags_0(k_ppp,j,i),0)                   &
     559                     .AND. .NOT. flag_set )                                    &
     560                   THEN
     561                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 8 )
    513562                   ENDIF
    514563
    … …  
    520569       IF ( momentum_advec == 'ws-scheme' )  THEN
    521570!
    522 !--       Set wall_flags_0 to steer the degradation of the advection scheme in advec_ws
     571!--       Set advc_flags_1 to steer the degradation of the advection scheme in advec_ws
    523572!--       near topography, inflow- and outflow boundaries as well as bottom and
    524 !--       top of model domain. wall_flags_0 remains zero for all non-prognostic
     573!--       top of model domain. advc_flags_1 remains zero for all non-prognostic
    525574!--       grid points.
    526575          DO  i = nxl, nxr
    … …  
    532581!--                in order to handle the left/south flux.
    533582!--                near vertical walls.
    534                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )
    535                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )
     583                   advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 9 )
     584                   advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 12 )
    536585!
    537586!--                u component - x-direction
    538587!--                WS1 (9), WS3 (10), WS5 (11)
    539                    IF ( k <= nzb_u_inner(j,i+1)     .OR.                       &
     588                   IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),1)  .OR.             &
    540589                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
    541590                              .AND. i <= nxlu  )    .OR.                       &
    … …  
    543592                              .AND. i == nxr   ) )                             &
    544593                   THEN
    545                        wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )
    546                    ELSEIF ( ( k <= nzb_u_inner(j,i+2) .AND.                    &
    547                               k >  nzb_u_inner(j,i+1) ) .OR.                   &
    548                               k <= nzb_u_inner(j,i-1)                          &
     594                       advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 9 )
     595                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),1)  .AND.      &
     596                                    BTEST(wall_flags_0(k,j,i+1),1)  .OR.       &
     597                              .NOT. BTEST(wall_flags_0(k,j,i-1),1) )           &
    549598                                                        .OR.                   &
    550599                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
    … …  
    553602                              .AND. i == nxlu+1) )                             &
    554603                   THEN
    555                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 10 )
     604                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 10 )
    556605!
    557606!--                   Clear flag for WS1
    558                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 )
    559                    ELSEIF ( k > nzb_u_inner(j,i+1) .AND. k > nzb_u_inner(j,i+2)   &
    560                                                    .AND. k > nzb_u_inner(j,i-1) ) &
     607                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 9 )
     608                   ELSEIF ( BTEST(wall_flags_0(k,j,i+1),1)  .AND.              &
     609                            BTEST(wall_flags_0(k,j,i+2),1)  .AND.              &
     610                            BTEST(wall_flags_0(k,j,i-1),1) )                   &
    561611                   THEN   
    562                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 11 )
     612                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 11 )
    563613!
    564614!--                   Clear flag for WS1
    565                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 )
     615                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 9 )
    566616                   ENDIF
    567617!
    568618!--                u component - y-direction
    569619!--                WS1 (12), WS3 (13), WS5 (14)
    570                    IF ( k <= nzb_u_inner(j+1,i) .OR.                           &
     620                   IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),1)   .OR.            &
    571621                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
    572622                              .AND. j == nys   )    .OR.                       &
    … …  
    574624                              .AND. j == nyn   ) )                             &
    575625                   THEN
    576                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )
    577                    ELSEIF ( ( k <= nzb_u_inner(j+2,i) .AND.                    &
    578                               k >  nzb_u_inner(j+1,i) ) .OR.                   &
    579                               k <= nzb_u_inner(j-1,i)                          &
     626                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 12 )
     627                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),1)  .AND.      &
     628                                    BTEST(wall_flags_0(k,j+1,i),1)  .OR.       &
     629                              .NOT. BTEST(wall_flags_0(k,j-1,i),1) )           &
    580630                                                        .OR.                   &
    581631                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
    … …  
    584634                              .AND. j == nyn-1 ) )                             &
    585635                   THEN
    586                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 )
     636                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 13 )
    587637!
    588638!--                   Clear flag for WS1
    589                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 )
    590                    ELSEIF ( k > nzb_u_inner(j+1,i) .AND. k > nzb_u_inner(j+2,i)   &
    591                                                    .AND. k > nzb_u_inner(j-1,i) ) &
     639                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 12 )
     640                   ELSEIF ( BTEST(wall_flags_0(k,j+1,i),1)  .AND.              &
     641                            BTEST(wall_flags_0(k,j+2,i),1)  .AND.              &
     642                            BTEST(wall_flags_0(k,j-1,i),1) )                   &
    592643                   THEN
    593                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 )
     644                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 14 )
    594645!
    595646!--                   Clear flag for WS1
    596                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 )
     647                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 12 )
    597648                   ENDIF
    598649!
    599650!--                u component - z-direction
    600651!--                WS1 (15), WS3 (16), WS5 (17)
     652                   IF ( k == nzb+1 )  THEN
     653                      k_mm = nzb
     654                   ELSE
     655                      k_mm = k - 2
     656                   ENDIF
     657                   IF ( k > nzt-1 )  THEN
     658                      k_pp = nzt+1
     659                   ELSE
     660                      k_pp = k + 2
     661                   ENDIF
     662                   IF ( k > nzt-2 )  THEN
     663                      k_ppp = nzt+1
     664                   ELSE
     665                      k_ppp = k + 3
     666                   ENDIF                   
     667
    601668                   flag_set = .FALSE.
    602                    IF ( k == nzb_u_inner(j,i) + 1 .OR. k == nzt )  THEN
    603                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 15 )
     669                   IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),1)  .AND.            &
     670                              BTEST(wall_flags_0(k,j,i),1)    .OR.             &
     671                        .NOT. BTEST(wall_flags_0(k_pp,j,i),1) .AND.            &                             
     672                              BTEST(wall_flags_0(k,j,i),1)    .OR.             &
     673                        k == nzt )                                             &
     674                   THEN
     675                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 15 )
     676                      flag_set = .TRUE.                     
     677                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),1)    .OR.    &
     678                              .NOT. BTEST(wall_flags_0(k_ppp,j,i),1) ) .AND.   &
     679                                  BTEST(wall_flags_0(k-1,j,i),1)  .AND.        &
     680                                  BTEST(wall_flags_0(k,j,i),1)    .AND.        &
     681                                  BTEST(wall_flags_0(k+1,j,i),1)  .AND.        &
     682                                  BTEST(wall_flags_0(k_pp,j,i),1) .OR.         &
     683                                  k == nzt - 1 )                               &
     684                   THEN
     685                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 16 )
    604686                      flag_set = .TRUE.
    605                    ELSEIF ( k == nzb_u_inner(j,i) + 2 .OR. k == nzt - 1 )  THEN
    606                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 16 )
    607                       flag_set = .TRUE.
    608                    ELSEIF ( k > nzb_u_inner(j,i) .AND. .NOT. flag_set )  THEN
    609                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 17 )
     687                   ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),1)  .AND.             &
     688                            BTEST(wall_flags_0(k-1,j,i),1)   .AND.             &
     689                            BTEST(wall_flags_0(k,j,i),1)     .AND.             &
     690                            BTEST(wall_flags_0(k+1,j,i),1)   .AND.             &
     691                            BTEST(wall_flags_0(k_pp,j,i),1)  .AND.             &
     692                            BTEST(wall_flags_0(k_ppp,j,i),1) .AND.             &
     693                            .NOT. flag_set )                                   &
     694                   THEN
     695                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 17 )
    610696                   ENDIF
    611697
    … …  
    621707!--                Since fluxes are swapped in advec_ws.f90, this is necessary to
    622708!--                in order to handle the left/south flux.
    623                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )
    624                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )
     709                   advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 18 )
     710                   advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 21 )
    625711!
    626712!--                v component - x-direction
    627713!--                WS1 (18), WS3 (19), WS5 (20)
    628                    IF ( k <= nzb_v_inner(j,i+1) .OR.                           &
     714                   IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),2)  .OR.             &
    629715                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
    630716                              .AND. i == nxl   )    .OR.                       &
    … …  
    632718                              .AND. i == nxr   ) )                             &
    633719                  THEN
    634                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )
     720                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 18 )
    635721!
    636722!--                WS3
    637                    ELSEIF ( ( k <= nzb_v_inner(j,i+2) .AND.                    &
    638                               k >  nzb_v_inner(j,i+1) ) .OR.                   &
    639                               k <= nzb_v_inner(j,i-1)                          &
     723                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),2)   .AND.     &
     724                                    BTEST(wall_flags_0(k,j,i+1),2) ) .OR.      &
     725                              .NOT. BTEST(wall_flags_0(k,j,i-1),2)             &
    640726                                                    .OR.                       &
    641727                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
    … …  
    644730                              .AND. i == nxlu  ) )                             &
    645731                   THEN
    646                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 19 )
     732                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 19 )
    647733!
    648734!--                   Clear flag for WS1
    649                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 )
    650                    ELSEIF ( k > nzb_v_inner(j,i+1) .AND. k > nzb_v_inner(j,i+2)   &
    651                                                    .AND. k > nzb_v_inner(j,i-1) ) &
     735                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 18 )
     736                   ELSEIF ( BTEST(wall_flags_0(k,j,i+1),2)  .AND.              &
     737                            BTEST(wall_flags_0(k,j,i+2),2)  .AND.              &
     738                            BTEST(wall_flags_0(k,j,i-1),2) )                   &
    652739                   THEN
    653                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 20 )
     740                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 20 )
    654741!
    655742!--                   Clear flag for WS1
    656                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 )
     743                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 18 )
    657744                   ENDIF
    658745!
    659746!--                v component - y-direction
    660747!--                WS1 (21), WS3 (22), WS5 (23)
    661                    IF ( k <= nzb_v_inner(j+1,i) .OR.                           &
     748                   IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),2) .OR.              &
    662749                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
    663750                              .AND. j <= nysv  )    .OR.                       &
    … …  
    665752                              .AND. j == nyn   ) )                             &
    666753                   THEN
    667                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )
    668                    ELSEIF ( ( k <= nzb_v_inner(j+2,i) .AND.                    &
    669                               k >  nzb_v_inner(j+1,i) ) .OR.                   &
    670                               k <= nzb_v_inner(j-1,i)                          &
     754                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 21 )
     755                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),2)  .AND.      &
     756                                    BTEST(wall_flags_0(k,j+1,i),2)  .OR.       &
     757                              .NOT. BTEST(wall_flags_0(k,j-1,i),2) )           &
    671758                                                        .OR.                   &
    672759                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
    … …  
    675762                              .AND. j == nyn-1 ) )                             &
    676763                   THEN
    677                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )
     764                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 22 )
    678765!
    679766!--                   Clear flag for WS1
    680                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 )
    681                    ELSEIF ( k > nzb_v_inner(j+1,i) .AND. k > nzb_v_inner(j+2,i)   &
    682                                                    .AND. k > nzb_v_inner(j-1,i) ) &
     767                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 21 )
     768                   ELSEIF ( BTEST(wall_flags_0(k,j+1,i),2)  .AND.              &
     769                            BTEST(wall_flags_0(k,j+2,i),2)  .AND.              &
     770                            BTEST(wall_flags_0(k,j-1,i),2) )                   &
    683771                   THEN
    684                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )
     772                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 23 )
    685773!
    686774!--                   Clear flag for WS1
    687                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 )
     775                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 21 )
    688776                   ENDIF
    689777!
    690778!--                v component - z-direction
    691779!--                WS1 (24), WS3 (25), WS5 (26)
     780                   IF ( k == nzb+1 )  THEN
     781                      k_mm = nzb
     782                   ELSE
     783                      k_mm = k - 2
     784                   ENDIF
     785                   IF ( k > nzt-1 )  THEN
     786                      k_pp = nzt+1
     787                   ELSE
     788                      k_pp = k + 2
     789                   ENDIF
     790                   IF ( k > nzt-2 )  THEN
     791                      k_ppp = nzt+1
     792                   ELSE
     793                      k_ppp = k + 3
     794                   ENDIF 
     795                   
    692796                   flag_set = .FALSE.
    693                    IF ( k == nzb_v_inner(j,i) + 1 .OR. k == nzt )  THEN
    694                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 )
     797                   IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),2)  .AND.            &
     798                              BTEST(wall_flags_0(k,j,i),2)    .OR.             &
     799                        .NOT. BTEST(wall_flags_0(k_pp,j,i),2) .AND.            &                             
     800                              BTEST(wall_flags_0(k,j,i),2)    .OR.             &
     801                        k == nzt )                                             &
     802                   THEN
     803                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 24 )
    695804                      flag_set = .TRUE.
    696                    ELSEIF ( k == nzb_v_inner(j,i) + 2 .OR. k == nzt - 1 )  THEN
    697                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 25 )
     805                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),2)    .OR.    &
     806                              .NOT. BTEST(wall_flags_0(k_ppp,j,i),2) ) .AND.   &
     807                                  BTEST(wall_flags_0(k-1,j,i),2)  .AND.        &
     808                                  BTEST(wall_flags_0(k,j,i),2)    .AND.        &
     809                                  BTEST(wall_flags_0(k+1,j,i),2)  .AND.        &
     810                                  BTEST(wall_flags_0(k_pp,j,i),2)  .OR.        &
     811                                  k == nzt - 1 )                               &
     812                   THEN
     813                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 25 )
    698814                      flag_set = .TRUE.
    699                    ELSEIF ( k > nzb_v_inner(j,i) .AND. .NOT. flag_set )  THEN
    700                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 26 )
     815                   ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),2)  .AND.             &
     816                            BTEST(wall_flags_0(k-1,j,i),2)   .AND.             &
     817                            BTEST(wall_flags_0(k,j,i),2)     .AND.             &
     818                            BTEST(wall_flags_0(k+1,j,i),2)   .AND.             &
     819                            BTEST(wall_flags_0(k_pp,j,i),2)  .AND.             &
     820                            BTEST(wall_flags_0(k_ppp,j,i),2) .AND.             &
     821                            .NOT. flag_set )                                   &
     822                   THEN
     823                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 26 )
    701824                   ENDIF
    702825
    … …  
    711834!--                Since fluxes are swapped in advec_ws.f90, this is necessary to
    712835!--                in order to handle the left/south flux.
    713                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )
    714                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )
     836                   advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 27 )
     837                   advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 30 )
    715838!
    716839!--                w component - x-direction
    717840!--                WS1 (27), WS3 (28), WS5 (29)
    718                    IF ( k <= nzb_w_inner(j,i+1) .OR.                           &
     841                   IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),3) .OR.              &
    719842                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
    720843                              .AND. i == nxl   )    .OR.                       &
    … …  
    722845                              .AND. i == nxr   ) )                             &
    723846                   THEN
    724                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )
    725                    ELSEIF ( ( k <= nzb_w_inner(j,i+2) .AND.                    &
    726                               k >  nzb_w_inner(j,i+1) ) .OR.                   &
    727                               k <= nzb_w_inner(j,i-1)                          &
     847                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 27 )
     848                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),3)  .AND.      &
     849                                    BTEST(wall_flags_0(k,j,i+1),3)  .OR.       &
     850                              .NOT. BTEST(wall_flags_0(k,j,i-1),3) )           &
    728851                                                        .OR.                   &
    729852                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
    … …  
    732855                              .AND. i == nxlu  ) )                             &
    733856                   THEN
    734                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 28 )
     857                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 28 )
    735858!   
    736859!--                   Clear flag for WS1
    737                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 )
    738                    ELSEIF ( k > nzb_w_inner(j,i+1) .AND. k > nzb_w_inner(j,i+2)   &
    739                                                    .AND. k > nzb_w_inner(j,i-1) ) &
     860                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 27 )
     861                   ELSEIF ( BTEST(wall_flags_0(k,j,i+1),3)  .AND.              &
     862                            BTEST(wall_flags_0(k,j,i+2),3)  .AND.              &
     863                            BTEST(wall_flags_0(k,j,i-1),3) )                   &
    740864                   THEN
    741                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i),29 )
     865                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i),29 )
    742866!   
    743867!--                   Clear flag for WS1
    744                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 )
     868                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 27 )
    745869                   ENDIF
    746870!
    747871!--                w component - y-direction
    748872!--                WS1 (30), WS3 (31), WS5 (32)
    749                    IF ( k <= nzb_w_inner(j+1,i) .OR.                           &
     873                   IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),3) .OR.              &
    750874                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
    751875                              .AND. j == nys   )    .OR.                       &
    … …  
    753877                              .AND. j == nyn   ) )                             &
    754878                   THEN
    755                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )
    756                    ELSEIF ( ( k <= nzb_w_inner(j+2,i) .AND.                    &
    757                               k >  nzb_w_inner(j+1,i) ) .OR.                   &
    758                                k <= nzb_w_inner(j-1,i)                         &
     879                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 30 )
     880                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),3)  .AND.      &
     881                                    BTEST(wall_flags_0(k,j+1,i),3)  .OR.       &
     882                              .NOT. BTEST(wall_flags_0(k,j-1,i),3) )           &
    759883                                                        .OR.                   &
    760884                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
    … …  
    763887                              .AND. j == nyn-1 ) )                             &
    764888                   THEN
    765                       wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 31 )
     889                      advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 31 )
    766890!
    767891!--                   Clear flag for WS1
    768                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 )
    769                    ELSEIF ( k > nzb_w_inner(j+1,i) .AND. k > nzb_w_inner(j+2,i)   &
    770                                                    .AND. k > nzb_w_inner(j-1,i) ) &
     892                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 30 )
     893                   ELSEIF ( BTEST(wall_flags_0(k,j+1,i),3)  .AND.              &
     894                            BTEST(wall_flags_0(k,j+2,i),3)  .AND.              &
     895                            BTEST(wall_flags_0(k,j-1,i),3) )                   &
    771896                   THEN
    772                       wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 0 )
     897                      advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 0 )
    773898!
    774899!--                   Clear flag for WS1
    775                       wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 )
     900                      advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 30 )
    776901                   ENDIF
    777902!
    … …  
    779904!--                WS1 (33), WS3 (34), WS5 (35)
    780905                   flag_set = .FALSE.
    781                    IF ( k == nzb_w_inner(j,i) .OR. k == nzb_w_inner(j,i) + 1   &
    782                                               .OR. k == nzt )  THEN
     906                   IF ( k == nzb+1 )  THEN
     907                      k_mm = nzb
     908                   ELSE
     909                      k_mm = k - 2
     910                   ENDIF
     911                   IF ( k > nzt-1 )  THEN
     912                      k_pp = nzt+1
     913                   ELSE
     914                      k_pp = k + 2
     915                   ENDIF
     916                   IF ( k > nzt-2 )  THEN
     917                      k_ppp = nzt+1
     918                   ELSE
     919                      k_ppp = k + 3
     920                   ENDIF 
     921                   
     922                   IF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3)  .AND.          &
     923                          .NOT. BTEST(wall_flags_0(k,j,i),3)    .AND.          &
     924                                BTEST(wall_flags_0(k+1,j,i),3) )  .OR.         &
     925                        ( .NOT. BTEST(wall_flags_0(k-1,j,i),3)  .AND.          &
     926                                BTEST(wall_flags_0(k,j,i),3) )  .OR.           &
     927                        ( .NOT. BTEST(wall_flags_0(k+1,j,i),3)  .AND.          &
     928                                BTEST(wall_flags_0(k,j,i),3) )  .OR.           &       
     929                        k == nzt )                                             &
     930                   THEN
    783931!
    784932!--                   Please note, at k == nzb_w_inner(j,i) a flag is explictely
    … …  
    787935!--                   because flux_t(nzb_w_inner(j,i)) is used for the tendency
    788936!--                   at k == nzb_w_inner(j,i)+1.
    789                       wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 1 )
     937                      advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 1 )
    790938                      flag_set = .TRUE.
    791                    ELSEIF ( k == nzb_w_inner(j,i) + 2 .OR. k == nzt - 1 )  THEN
    792                       wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 2 )
     939                   ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),3)     .OR.   &
     940                              .NOT. BTEST(wall_flags_0(k_ppp,j,i),3) ) .AND.   &
     941                                    BTEST(wall_flags_0(k-1,j,i),3)  .AND.      &
     942                                    BTEST(wall_flags_0(k,j,i),3)    .AND.      &
     943                                    BTEST(wall_flags_0(k+1,j,i),3)  .OR.       &
     944                            k == nzt - 1 )                                     &
     945                   THEN
     946                      advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 2 )
    793947                      flag_set = .TRUE.
    794                    ELSEIF ( k > nzb_w_inner(j,i) .AND. .NOT. flag_set )  THEN
    795                       wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 3 )
     948                   ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),3)  .AND.             &
     949                            BTEST(wall_flags_0(k-1,j,i),3)   .AND.             &
     950                            BTEST(wall_flags_0(k,j,i),3)     .AND.             &
     951                            BTEST(wall_flags_0(k+1,j,i),3)   .AND.             &
     952                            BTEST(wall_flags_0(k_pp,j,i),3)  .AND.             &
     953                            BTEST(wall_flags_0(k_ppp,j,i),3) .AND.             &
     954                            .NOT. flag_set )                                   &
     955                   THEN
     956                      advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 3 )
    796957                   ENDIF
    797958
    … …  
    809970!
    810971!--       Exchange ghost points for advection flags
    811           CALL exchange_horiz_int( wall_flags_0, nbgp )
    812           CALL exchange_horiz_int( wall_flags_00, nbgp )
     972          CALL exchange_horiz_int( advc_flags_1, nbgp )
     973          CALL exchange_horiz_int( advc_flags_2, nbgp )
    813974!
    814975!--       Set boundary flags at inflow and outflow boundary in case of
    815976!--       non-cyclic boundary conditions.
    816977         IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
    817              wall_flags_0(:,:,nxl-1)  = wall_flags_0(:,:,nxl)
    818              wall_flags_00(:,:,nxl-1) = wall_flags_00(:,:,nxl)
     978             advc_flags_1(:,:,nxl-1) = advc_flags_1(:,:,nxl)
     979             advc_flags_2(:,:,nxl-1) = advc_flags_2(:,:,nxl)
    819980         ENDIF
    820981
    821982         IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
    822             wall_flags_0(:,:,nxr+1)  = wall_flags_0(:,:,nxr)
    823             wall_flags_00(:,:,nxr+1) = wall_flags_00(:,:,nxr)
     983            advc_flags_1(:,:,nxr+1) = advc_flags_1(:,:,nxr)
     984            advc_flags_2(:,:,nxr+1) = advc_flags_2(:,:,nxr)
    824985          ENDIF
    825986
    826987          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
    827              wall_flags_0(:,nyn+1,:)  = wall_flags_0(:,nyn,:)
    828              wall_flags_00(:,nyn+1,:) = wall_flags_00(:,nyn,:)
     988             advc_flags_1(:,nyn+1,:) = advc_flags_1(:,nyn,:)
     989             advc_flags_2(:,nyn+1,:) = advc_flags_2(:,nyn,:)
    829990          ENDIF
    830991
    831992          IF ( inflow_s .OR. outflow_s  .OR. nest_bound_s )  THEN
    832              wall_flags_0(:,nys-1,:)  = wall_flags_0(:,nys,:)
    833              wall_flags_00(:,nys-1,:) = wall_flags_00(:,nys,:)
     993             advc_flags_1(:,nys-1,:) = advc_flags_1(:,nys,:)
     994             advc_flags_2(:,nys-1,:) = advc_flags_2(:,nys,:)
    834995          ENDIF
    835996 
    … …  
    9101071       USE indices,                                                            &
    9111072           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,    &
    912                   nzt, wall_flags_0
     1073                  nzt, advc_flags_1
    9131074
    9141075       USE kinds
    … …  
    9761137          DO  k = nzb+1, nzb_max
    9771138
    978              ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
    979              ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
    980              ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
     1139             ibit5 = IBITS(advc_flags_1(k,j-1,i),5,1)
     1140             ibit4 = IBITS(advc_flags_1(k,j-1,i),4,1)
     1141             ibit3 = IBITS(advc_flags_1(k,j-1,i),3,1)
    9811142
    9821143             v_comp                  = v(k,j,i) - v_gtrans
    … …  
    10371198          DO  k = nzb+1, nzb_max
    10381199
    1039              ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
    1040              ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
    1041              ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
     1200             ibit2 = IBITS(advc_flags_1(k,j,i-1),2,1)
     1201             ibit1 = IBITS(advc_flags_1(k,j,i-1),1,1)
     1202             ibit0 = IBITS(advc_flags_1(k,j,i-1),0,1)
    10421203
    10431204             u_comp                     = u(k,j,i) - u_gtrans
    … …  
    11061267!--       flux at the end.
    11071268
    1108           ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
    1109           ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
    1110           ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
     1269          ibit2 = IBITS(advc_flags_1(k,j,i),2,1)
     1270          ibit1 = IBITS(advc_flags_1(k,j,i),1,1)
     1271          ibit0 = IBITS(advc_flags_1(k,j,i),0,1)
    11111272
    11121273          u_comp    = u(k,j,i+1) - u_gtrans
    … …  
    11411302                                       )
    11421303
    1143           ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
    1144           ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
    1145           ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
     1304          ibit5 = IBITS(advc_flags_1(k,j,i),5,1)
     1305          ibit4 = IBITS(advc_flags_1(k,j,i),4,1)
     1306          ibit3 = IBITS(advc_flags_1(k,j,i),3,1)
    11461307
    11471308          v_comp    = v(k,j+1,i) - v_gtrans
    … …  
    11781339!--       k index has to be modified near bottom and top, else array
    11791340!--       subscripts will be exceeded.
    1180           ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
    1181           ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
    1182           ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
     1341          ibit8 = IBITS(advc_flags_1(k,j,i),8,1)
     1342          ibit7 = IBITS(advc_flags_1(k,j,i),7,1)
     1343          ibit6 = IBITS(advc_flags_1(k,j,i),6,1)
    11831344
    11841345          k_ppp = k + 3 * ibit8
    … …  
    12201381!--       by a not sufficient reduction of divergences near topography.
    12211382          div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
    1222                           - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
    1223                                          + IBITS(wall_flags_0(k,j,i-1),1,1)    &
    1224                                          + IBITS(wall_flags_0(k,j,i-1),2,1)    &
     1383                          - u(k,j,i)   * ( IBITS(advc_flags_1(k,j,i-1),0,1)    &
     1384                                         + IBITS(advc_flags_1(k,j,i-1),1,1)    &
     1385                                         + IBITS(advc_flags_1(k,j,i-1),2,1)    &
    12251386                                         )                                     &
    12261387                          ) * rho_air(k) * ddx                                 &
    12271388                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
    1228                           - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
    1229                                          + IBITS(wall_flags_0(k,j-1,i),4,1)    &
    1230                                          + IBITS(wall_flags_0(k,j-1,i),5,1)    &
     1389                          - v(k,j,i)   * ( IBITS(advc_flags_1(k,j-1,i),3,1)    &
     1390                                         + IBITS(advc_flags_1(k,j-1,i),4,1)    &
     1391                                         + IBITS(advc_flags_1(k,j-1,i),5,1)    &
    12311392                                         )                                     &
    12321393                          ) * rho_air(k) * ddy                                 &
    … …  
    12341395                                         ( ibit6 + ibit7 + ibit8 )             &
    12351396                          - w(k-1,j,i) * rho_air_zw(k-1) *                     &
    1236                                          ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
    1237                                          + IBITS(wall_flags_0(k-1,j,i),7,1)    &
    1238                                          + IBITS(wall_flags_0(k-1,j,i),8,1)    &
     1397                                         ( IBITS(advc_flags_1(k-1,j,i),6,1)    &
     1398                                         + IBITS(advc_flags_1(k-1,j,i),7,1)    &
     1399                                         + IBITS(advc_flags_1(k-1,j,i),8,1)    &
    12391400                                         )                                     &     
    12401401                          ) * ddzw(k)
    … …  
    12871448!--       k index has to be modified near bottom and top, else array
    12881449!--       subscripts will be exceeded.
    1289           ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
    1290           ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
    1291           ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
     1450          ibit8 = IBITS(advc_flags_1(k,j,i),8,1)
     1451          ibit7 = IBITS(advc_flags_1(k,j,i),7,1)
     1452          ibit6 = IBITS(advc_flags_1(k,j,i),6,1)
    12921453
    12931454          k_ppp = k + 3 * ibit8
    … …  
    14501611
    14511612       USE indices,                                                           &
    1452            ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
     1613           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1
    14531614
    14541615       USE kinds
    … …  
    15021663          DO  k = nzb+1, nzb_max
    15031664
    1504              ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
    1505              ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
    1506              ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
     1665             ibit14 = IBITS(advc_flags_1(k,j-1,i),14,1)
     1666             ibit13 = IBITS(advc_flags_1(k,j-1,i),13,1)
     1667             ibit12 = IBITS(advc_flags_1(k,j-1,i),12,1)
    15071668
    15081669             v_comp      = v(k,j,i) + v(k,j,i-1) - gv
    … …  
    15601721          DO  k = nzb+1, nzb_max
    15611722
    1562              ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
    1563              ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
    1564              ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
     1723             ibit11 = IBITS(advc_flags_1(k,j,i-1),11,1)
     1724             ibit10 = IBITS(advc_flags_1(k,j,i-1),10,1)
     1725             ibit9  = IBITS(advc_flags_1(k,j,i-1),9,1)
    15651726
    15661727             u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
    … …  
    16221783       DO  k = nzb+1, nzb_max
    16231784
    1624           ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
    1625           ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
    1626           ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
     1785          ibit11 = IBITS(advc_flags_1(k,j,i),11,1)
     1786          ibit10 = IBITS(advc_flags_1(k,j,i),10,1)
     1787          ibit9  = IBITS(advc_flags_1(k,j,i),9,1)
    16271788
    16281789          u_comp(k) = u(k,j,i+1) + u(k,j,i)
    … …  
    16571818                                                )
    16581819
    1659           ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
    1660           ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
    1661           ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
     1820          ibit14 = IBITS(advc_flags_1(k,j,i),14,1)
     1821          ibit13 = IBITS(advc_flags_1(k,j,i),13,1)
     1822          ibit12 = IBITS(advc_flags_1(k,j,i),12,1)
    16621823
    16631824          v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
    … …  
    16941855!--       k index has to be modified near bottom and top, else array
    16951856!--       subscripts will be exceeded.
    1696           ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
    1697           ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
    1698           ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
     1857          ibit17 = IBITS(advc_flags_1(k,j,i),17,1)
     1858          ibit16 = IBITS(advc_flags_1(k,j,i),16,1)
     1859          ibit15 = IBITS(advc_flags_1(k,j,i),15,1)
    16991860
    17001861          k_ppp = k + 3 * ibit17
    … …  
    17381899          div = ( ( u_comp(k)       * ( ibit9 + ibit10 + ibit11 )             &
    17391900                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
    1740                                     * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
    1741                                       + IBITS(wall_flags_0(k,j,i-1),10,1)     &
    1742                                       + IBITS(wall_flags_0(k,j,i-1),11,1)     &
     1901                                    * ( IBITS(advc_flags_1(k,j,i-1),9,1)      &
     1902                                      + IBITS(advc_flags_1(k,j,i-1),10,1)     &
     1903                                      + IBITS(advc_flags_1(k,j,i-1),11,1)     &
    17431904                                      )                                       &
    17441905                  ) * rho_air(k) * ddx                                        &
    17451906               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
    17461907                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
    1747                                     * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
    1748                                       + IBITS(wall_flags_0(k,j-1,i),13,1)     &
    1749                                       + IBITS(wall_flags_0(k,j-1,i),14,1)     &
     1908                                    * ( IBITS(advc_flags_1(k,j-1,i),12,1)     &
     1909                                      + IBITS(advc_flags_1(k,j-1,i),13,1)     &
     1910                                      + IBITS(advc_flags_1(k,j-1,i),14,1)     &
    17501911                                      )                                       &
    17511912                  ) * rho_air(k) * ddy                                        &
    17521913               +  ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 )     &
    17531914                - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1)             &
    1754                                     * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
    1755                                       + IBITS(wall_flags_0(k-1,j,i),16,1)     &
    1756                                       + IBITS(wall_flags_0(k-1,j,i),17,1)     &
     1915                                    * ( IBITS(advc_flags_1(k-1,j,i),15,1)     &
     1916                                      + IBITS(advc_flags_1(k-1,j,i),16,1)     &
     1917                                      + IBITS(advc_flags_1(k-1,j,i),17,1)     &
    17571918                                      )                                       & 
    17581919                  ) * ddzw(k)   &
    … …  
    18231984!--       k index has to be modified near bottom and top, else array
    18241985!--       subscripts will be exceeded.
    1825           ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
    1826           ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
    1827           ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
     1986          ibit17 = IBITS(advc_flags_1(k,j,i),17,1)
     1987          ibit16 = IBITS(advc_flags_1(k,j,i),16,1)
     1988          ibit15 = IBITS(advc_flags_1(k,j,i),15,1)
    18281989
    18291990          k_ppp = k + 3 * ibit17
    … …  
    19422103
    19432104       USE indices,                                                            &
    1944            ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
     2105           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, advc_flags_1
    19452106
    19462107       USE kinds
    … …  
    19952156          DO  k = nzb+1, nzb_max
    19962157
    1997              ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
    1998              ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
    1999              ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
     2158             ibit20 = IBITS(advc_flags_1(k,j,i-1),20,1)
     2159             ibit19 = IBITS(advc_flags_1(k,j,i-1),19,1)
     2160             ibit18 = IBITS(advc_flags_1(k,j,i-1),18,1)
    20002161
    20012162             u_comp           = u(k,j-1,i) + u(k,j,i) - gu
    … …  
    20532214          DO  k = nzb+1, nzb_max
    20542215
    2055              ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
    2056              ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
    2057              ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
     2216             ibit23 = IBITS(advc_flags_1(k,j-1,i),23,1)
     2217             ibit22 = IBITS(advc_flags_1(k,j-1,i),22,1)
     2218             ibit21 = IBITS(advc_flags_1(k,j-1,i),21,1)
    20582219
    20592220             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
    … …  
    21152276       DO  k = nzb+1, nzb_max
    21162277
    2117           ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
    2118           ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
    2119           ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
     2278          ibit20 = IBITS(advc_flags_1(k,j,i),20,1)
     2279          ibit19 = IBITS(advc_flags_1(k,j,i),19,1)
     2280          ibit18 = IBITS(advc_flags_1(k,j,i),18,1)
    21202281 
    21212282          u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
    … …  
    21502311                                        )
    21512312
    2152           ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
    2153           ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
    2154           ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
     2313          ibit23 = IBITS(advc_flags_1(k,j,i),23,1)
     2314          ibit22 = IBITS(advc_flags_1(k,j,i),22,1)
     2315          ibit21 = IBITS(advc_flags_1(k,j,i),21,1)
    21552316
    21562317
    … …  
    21882349!--       k index has to be modified near bottom and top, else array
    21892350!--       subscripts will be exceeded.
    2190           ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
    2191           ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
    2192           ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
     2351          ibit26 = IBITS(advc_flags_1(k,j,i),26,1)
     2352          ibit25 = IBITS(advc_flags_1(k,j,i),25,1)
     2353          ibit24 = IBITS(advc_flags_1(k,j,i),24,1)
    21932354
    21942355          k_ppp = k + 3 * ibit26
    … …  
    22332394                                       * ( ibit18 + ibit19 + ibit20 )         &
    22342395                  - ( u(k,j-1,i) + u(k,j,i) )                                 &
    2235                                        * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
    2236                                          + IBITS(wall_flags_0(k,j,i-1),19,1)  &
    2237                                          + IBITS(wall_flags_0(k,j,i-1),20,1)  &
     2396                                       * ( IBITS(advc_flags_1(k,j,i-1),18,1)  &
     2397                                         + IBITS(advc_flags_1(k,j,i-1),19,1)  &
     2398                                         + IBITS(advc_flags_1(k,j,i-1),20,1)  &
    22382399                                         )                                    &
    22392400                  ) * rho_air(k) * ddx                                        &
    … …  
    22412402                                       * ( ibit21 + ibit22 + ibit23 )         &
    22422403                - ( v(k,j,i)     + v(k,j-1,i) )                               &
    2243                                        * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
    2244                                          + IBITS(wall_flags_0(k,j-1,i),22,1)  &
    2245                                          + IBITS(wall_flags_0(k,j-1,i),23,1)  &
     2404                                       * ( IBITS(advc_flags_1(k,j-1,i),21,1)  &
     2405                                         + IBITS(advc_flags_1(k,j-1,i),22,1)  &
     2406                                         + IBITS(advc_flags_1(k,j-1,i),23,1)  &
    22462407                                         )                                    &
    22472408                  ) * rho_air(k) * ddy                                        &
    22482409               +  ( w_comp * rho_air_zw(k) * ( ibit24 + ibit25 + ibit26 )     &
    22492410                - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)             &
    2250                                        * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
    2251                                          + IBITS(wall_flags_0(k-1,j,i),25,1)  &
    2252                                          + IBITS(wall_flags_0(k-1,j,i),26,1)  &
     2411                                       * ( IBITS(advc_flags_1(k-1,j,i),24,1)  &
     2412                                         + IBITS(advc_flags_1(k-1,j,i),25,1)  &
     2413                                         + IBITS(advc_flags_1(k-1,j,i),26,1)  &
    22532414                                         )                                    &
    22542415                   ) * ddzw(k)   &
    … …  
    23242485!--       k index has to be modified near bottom and top, else array
    23252486!--       subscripts will be exceeded.
    2326           ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
    2327           ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
    2328           ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
     2487          ibit26 = IBITS(advc_flags_1(k,j,i),26,1)
     2488          ibit25 = IBITS(advc_flags_1(k,j,i),25,1)
     2489          ibit24 = IBITS(advc_flags_1(k,j,i),24,1)
    23292490
    23302491          k_ppp = k + 3 * ibit26
    … …  
    24432604
    24442605       USE indices,                                                           &
    2445            ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,        &
    2446                   wall_flags_00
     2606           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1,        &
     2607                  advc_flags_2
    24472608
    24482609       USE kinds
    … …  
    24952656
    24962657          DO  k = nzb+1, nzb_max
    2497              ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
    2498              ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
    2499              ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
     2658             ibit32 = IBITS(advc_flags_2(k,j-1,i),0,1)
     2659             ibit31 = IBITS(advc_flags_1(k,j-1,i),31,1)
     2660             ibit30 = IBITS(advc_flags_1(k,j-1,i),30,1)
    25002661
    25012662             v_comp         = v(k+1,j,i) + v(k,j,i) - gv
    … …  
    25532714          DO  k = nzb+1, nzb_max
    25542715
    2555              ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
    2556              ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
    2557              ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
     2716             ibit29 = IBITS(advc_flags_1(k,j,i-1),29,1)
     2717             ibit28 = IBITS(advc_flags_1(k,j,i-1),28,1)
     2718             ibit27 = IBITS(advc_flags_1(k,j,i-1),27,1)
    25582719
    25592720             u_comp           = u(k+1,j,i) + u(k,j,i) - gu
    … …  
    26082769!--    The lower flux has to be calculated explicetely for the tendency at
    26092770!--    the first w-level. For topography wall this is done implicitely by
    2610 !--    wall_flags_0.
     2771!--    advc_flags_1.
    26112772       k         = nzb + 1
    26122773       w_comp    = w(k,j,i) + w(k-1,j,i)
    … …  
    26202781       DO  k = nzb+1, nzb_max
    26212782
    2622           ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
    2623           ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
    2624           ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
     2783          ibit29 = IBITS(advc_flags_1(k,j,i),29,1)
     2784          ibit28 = IBITS(advc_flags_1(k,j,i),28,1)
     2785          ibit27 = IBITS(advc_flags_1(k,j,i),27,1)
    26252786
    26262787          u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
    … …  
    26552816                                        )
    26562817
    2657           ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
    2658           ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
    2659           ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
     2818          ibit32 = IBITS(advc_flags_2(k,j,i),0,1)
     2819          ibit31 = IBITS(advc_flags_1(k,j,i),31,1)
     2820          ibit30 = IBITS(advc_flags_1(k,j,i),30,1)
    26602821
    26612822          v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
    … …  
    26922853!--       k index has to be modified near bottom and top, else array
    26932854!--       subscripts will be exceeded.
    2694           ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
    2695           ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
    2696           ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
     2855          ibit35 = IBITS(advc_flags_2(k,j,i),3,1)
     2856          ibit34 = IBITS(advc_flags_2(k,j,i),2,1)
     2857          ibit33 = IBITS(advc_flags_2(k,j,i),1,1)
    26972858
    26982859          k_ppp = k + 3 * ibit35
    … …  
    27372898          div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )            &
    27382899                  - ( u(k+1,j,i) + u(k,j,i)   )                               &
    2739                                     * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
    2740                                       + IBITS(wall_flags_0(k,j,i-1),28,1)     &
    2741                                       + IBITS(wall_flags_0(k,j,i-1),29,1)     &
     2900                                    * ( IBITS(advc_flags_1(k,j,i-1),27,1)     &
     2901                                      + IBITS(advc_flags_1(k,j,i-1),28,1)     &
     2902                                      + IBITS(advc_flags_1(k,j,i-1),29,1)     &
    27422903                                      )                                       &
    27432904                  ) * rho_air_zw(k) * ddx                                     &
    27442905              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            &
    27452906                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
    2746                                     * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
    2747                                       + IBITS(wall_flags_0(k,j-1,i),31,1)     &
    2748                                       + IBITS(wall_flags_00(k,j-1,i),0,1)     &
     2907                                    * ( IBITS(advc_flags_1(k,j-1,i),30,1)     &
     2908                                      + IBITS(advc_flags_1(k,j-1,i),31,1)     &
     2909                                      + IBITS(advc_flags_2(k,j-1,i),0,1)      &
    27492910                                      )                                       &
    27502911                  ) * rho_air_zw(k) * ddy                                     &
    27512912              +   ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 )      &
    27522913                - ( w(k,j,i)   + w(k-1,j,i)   ) * rho_air(k)                  &
    2753                                     * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
    2754                                       + IBITS(wall_flags_00(k-1,j,i),2,1)     &
    2755                                       + IBITS(wall_flags_00(k-1,j,i),3,1)     &
     2914                                    * ( IBITS(advc_flags_2(k-1,j,i),1,1)      &
     2915                                      + IBITS(advc_flags_2(k-1,j,i),2,1)      &
     2916                                      + IBITS(advc_flags_2(k-1,j,i),3,1)      &
    27562917                                      )                                       &
    27572918                  ) * ddzu(k+1)   &
    … …  
    28142975!--       k index has to be modified near bottom and top, else array
    28152976!--       subscripts will be exceeded.
    2816           ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
    2817           ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
    2818           ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
     2977          ibit35 = IBITS(advc_flags_2(k,j,i),3,1)
     2978          ibit34 = IBITS(advc_flags_2(k,j,i),2,1)
     2979          ibit33 = IBITS(advc_flags_2(k,j,i),1,1)
    28192980
    28202981          k_ppp = k + 3 * ibit35
    … …  
    29193080       USE indices,                                                           &
    29203081           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,   &
    2921                   nzt, wall_flags_0
     3082                  nzt, advc_flags_1
    29223083           
    29233084       USE kinds
    … …  
    29833144          DO  k = nzb+1, nzb_max
    29843145
    2985              ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
    2986              ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
    2987              ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
     3146             ibit2 = IBITS(advc_flags_1(k,j,i-1),2,1)
     3147             ibit1 = IBITS(advc_flags_1(k,j,i-1),1,1)
     3148             ibit0 = IBITS(advc_flags_1(k,j,i-1),0,1)
    29883149
    29893150             u_comp                 = u(k,j,i) - u_gtrans
    … …  
    30443205          DO  k = nzb+1, nzb_max
    30453206
    3046              ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
    3047              ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
    3048              ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
     3207             ibit5 = IBITS(advc_flags_1(k,j-1,i),5,1)
     3208             ibit4 = IBITS(advc_flags_1(k,j-1,i),4,1)
     3209             ibit3 = IBITS(advc_flags_1(k,j-1,i),3,1)
    30493210
    30503211             v_comp               = v(k,j,i) - v_gtrans
    … …  
    31073268             DO  k = nzb+1, nzb_max
    31083269
    3109                 ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
    3110                 ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
    3111                 ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
     3270                ibit2 = IBITS(advc_flags_1(k,j,i),2,1)
     3271                ibit1 = IBITS(advc_flags_1(k,j,i),1,1)
     3272                ibit0 = IBITS(advc_flags_1(k,j,i),0,1)
    31123273
    31133274                u_comp    = u(k,j,i+1) - u_gtrans
    … …  
    31423303                                             )
    31433304
    3144                 ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
    3145                 ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
    3146                 ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
     3305                ibit5 = IBITS(advc_flags_1(k,j,i),5,1)
     3306                ibit4 = IBITS(advc_flags_1(k,j,i),4,1)
     3307                ibit3 = IBITS(advc_flags_1(k,j,i),3,1)
    31473308
    31483309                v_comp    = v(k,j+1,i) - v_gtrans
    … …  
    31793340!--             k index has to be modified near bottom and top, else array
    31803341!--             subscripts will be exceeded.
    3181                 ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
    3182                 ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
    3183                 ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
     3342                ibit8 = IBITS(advc_flags_1(k,j,i),8,1)
     3343                ibit7 = IBITS(advc_flags_1(k,j,i),7,1)
     3344                ibit6 = IBITS(advc_flags_1(k,j,i),6,1)
    31843345
    31853346                k_ppp = k + 3 * ibit8
    … …  
    32213382!--             by a not sufficient reduction of divergences near topography.
    32223383                div   =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
    3223                           - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
    3224                                          + IBITS(wall_flags_0(k,j,i-1),1,1)    &
    3225                                          + IBITS(wall_flags_0(k,j,i-1),2,1)    &
     3384                          - u(k,j,i)   * ( IBITS(advc_flags_1(k,j,i-1),0,1)    &
     3385                                         + IBITS(advc_flags_1(k,j,i-1),1,1)    &
     3386                                         + IBITS(advc_flags_1(k,j,i-1),2,1)    &
    32263387                                         )                                     &
    32273388                          ) * rho_air(k) * ddx                                 &
    32283389                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
    3229                           - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
    3230                                          + IBITS(wall_flags_0(k,j-1,i),4,1)    &
    3231                                          + IBITS(wall_flags_0(k,j-1,i),5,1)    &
     3390                          - v(k,j,i)   * ( IBITS(advc_flags_1(k,j-1,i),3,1)    &
     3391                                         + IBITS(advc_flags_1(k,j-1,i),4,1)    &
     3392                                         + IBITS(advc_flags_1(k,j-1,i),5,1)    &
    32323393                                         )                                     &
    32333394                          ) * rho_air(k) * ddy                                 &
    … …  
    32353396                                         ( ibit6 + ibit7 + ibit8 )             &
    32363397                          - w(k-1,j,i) * rho_air_zw(k-1) *                     &
    3237                                          ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
    3238                                          + IBITS(wall_flags_0(k-1,j,i),7,1)    &
    3239                                          + IBITS(wall_flags_0(k-1,j,i),8,1)    &
     3398                                         ( IBITS(advc_flags_1(k-1,j,i),6,1)    &
     3399                                         + IBITS(advc_flags_1(k-1,j,i),7,1)    &
     3400                                         + IBITS(advc_flags_1(k-1,j,i),8,1)    &
    32403401                                         )                                     &     
    32413402                          ) * ddzw(k)
    … …  
    32853446!--             k index has to be modified near bottom and top, else array
    32863447!--             subscripts will be exceeded.
    3287                 ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
    3288                 ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
    3289                 ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
     3448                ibit8 = IBITS(advc_flags_1(k,j,i),8,1)
     3449                ibit7 = IBITS(advc_flags_1(k,j,i),7,1)
     3450                ibit6 = IBITS(advc_flags_1(k,j,i),6,1)
    32903451
    32913452                k_ppp = k + 3 * ibit8
    … …  
    34293590
    34303591
    3431 
    34323592!------------------------------------------------------------------------------!
    34333593! Description:
    … …  
    34503610
    34513611       USE indices,                                                            &
    3452            ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
     3612           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1
    34533613           
    34543614       USE kinds
    … …  
    35073667          DO  k = nzb+1, nzb_max
    35083668
    3509              ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
    3510              ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
    3511              ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
     3669             ibit11 = IBITS(advc_flags_1(k,j,i-1),11,1)
     3670             ibit10 = IBITS(advc_flags_1(k,j,i-1),10,1)
     3671             ibit9  = IBITS(advc_flags_1(k,j,i-1),9,1)
    35123672
    35133673             u_comp(k)                = u(k,j,i) + u(k,j,i-1) - gu
    … …  
    35653725          DO  k = nzb+1, nzb_max
    35663726
    3567              ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
    3568              ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
    3569              ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
     3727             ibit14 = IBITS(advc_flags_1(k,j-1,i),14,1)
     3728             ibit13 = IBITS(advc_flags_1(k,j-1,i),13,1)
     3729             ibit12 = IBITS(advc_flags_1(k,j-1,i),12,1)
    35703730
    35713731             v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
    … …  
    36263786             DO  k = nzb+1, nzb_max
    36273787
    3628                 ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
    3629                 ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
    3630                 ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
     3788                ibit11 = IBITS(advc_flags_1(k,j,i),11,1)
     3789                ibit10 = IBITS(advc_flags_1(k,j,i),10,1)
     3790                ibit9  = IBITS(advc_flags_1(k,j,i),9,1)
    36313791
    36323792                u_comp(k) = u(k,j,i+1) + u(k,j,i)
    … …  
    36613821                                                     )
    36623822
    3663                 ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
    3664                 ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
    3665                 ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
     3823                ibit14 = IBITS(advc_flags_1(k,j,i),14,1)
     3824                ibit13 = IBITS(advc_flags_1(k,j,i),13,1)
     3825                ibit12 = IBITS(advc_flags_1(k,j,i),12,1)
    36663826
    36673827                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
    … …  
    36983858!--             k index has to be modified near bottom and top, else array
    36993859!--             subscripts will be exceeded.
    3700                 ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
    3701                 ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
    3702                 ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
     3860                ibit17 = IBITS(advc_flags_1(k,j,i),17,1)
     3861                ibit16 = IBITS(advc_flags_1(k,j,i),16,1)
     3862                ibit15 = IBITS(advc_flags_1(k,j,i),15,1)
    37033863
    37043864                k_ppp = k + 3 * ibit17
    … …  
    37423902                div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 )             &
    37433903                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
    3744                                     * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
    3745                                       + IBITS(wall_flags_0(k,j,i-1),10,1)     &
    3746                                       + IBITS(wall_flags_0(k,j,i-1),11,1)     &
     3904                                    * ( IBITS(advc_flags_1(k,j,i-1),9,1)      &
     3905                                      + IBITS(advc_flags_1(k,j,i-1),10,1)     &
     3906                                      + IBITS(advc_flags_1(k,j,i-1),11,1)     &
    37473907                                      )                                       &
    37483908                  ) * rho_air(k) * ddx                                        &
    37493909               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
    37503910                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
    3751                                     * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
    3752                                       + IBITS(wall_flags_0(k,j-1,i),13,1)     &
    3753                                       + IBITS(wall_flags_0(k,j-1,i),14,1)     &
     3911                                    * ( IBITS(advc_flags_1(k,j-1,i),12,1)     &
     3912                                      + IBITS(advc_flags_1(k,j-1,i),13,1)     &
     3913                                      + IBITS(advc_flags_1(k,j-1,i),14,1)     &
    37543914                                      )                                       &
    37553915                  ) * rho_air(k) * ddy                                        &
    37563916               +  ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 )     &
    37573917                - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1)             &
    3758                                     * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
    3759                                       + IBITS(wall_flags_0(k-1,j,i),16,1)     &
    3760                                       + IBITS(wall_flags_0(k-1,j,i),17,1)     &
     3918                                    * ( IBITS(advc_flags_1(k-1,j,i),15,1)     &
     3919                                      + IBITS(advc_flags_1(k-1,j,i),16,1)     &
     3920                                      + IBITS(advc_flags_1(k-1,j,i),17,1)     &
    37613921                                      )                                       & 
    37623922                  ) * ddzw(k)   &
    … …  
    38293989!--             k index has to be modified near bottom and top, else array
    38303990!--             subscripts will be exceeded.
    3831                 ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
    3832                 ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
    3833                 ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
     3991                ibit17 = IBITS(advc_flags_1(k,j,i),17,1)
     3992                ibit16 = IBITS(advc_flags_1(k,j,i),16,1)
     3993                ibit15 = IBITS(advc_flags_1(k,j,i),15,1)
    38343994
    38353995                k_ppp = k + 3 * ibit17
    … …  
    39254085    END SUBROUTINE advec_u_ws
    39264086   
    3927    
     4087
    39284088!------------------------------------------------------------------------------!
    39294089! Description:
    … …  
    39464106
    39474107       USE indices,                                                            &
    3948            ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
     4108           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, advc_flags_1
    39494109
    39504110       USE kinds
    … …  
    40034163          DO  k = nzb+1, nzb_max
    40044164
    4005              ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
    4006              ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
    4007              ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
     4165             ibit20 = IBITS(advc_flags_1(k,j,i-1),20,1)
     4166             ibit19 = IBITS(advc_flags_1(k,j,i-1),19,1)
     4167             ibit18 = IBITS(advc_flags_1(k,j,i-1),18,1)
    40084168
    40094169             u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
    … …  
    40614221          DO  k = nzb+1, nzb_max
    40624222
    4063              ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
    4064              ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
    4065              ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
     4223             ibit23 = IBITS(advc_flags_1(k,j-1,i),23,1)
     4224             ibit22 = IBITS(advc_flags_1(k,j-1,i),22,1)
     4225             ibit21 = IBITS(advc_flags_1(k,j-1,i),21,1)
    40664226
    40674227             v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
    … …  
    41214281             DO  k = nzb+1, nzb_max
    41224282
    4123                 ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
    4124                 ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
    4125                 ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
     4283                ibit20 = IBITS(advc_flags_1(k,j,i),20,1)
     4284                ibit19 = IBITS(advc_flags_1(k,j,i),19,1)
     4285                ibit18 = IBITS(advc_flags_1(k,j,i),18,1)
    41264286
    41274287                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
    … …  
    41564316                                              )
    41574317
    4158                 ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
    4159                 ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
    4160                 ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
     4318                ibit23 = IBITS(advc_flags_1(k,j,i),23,1)
     4319                ibit22 = IBITS(advc_flags_1(k,j,i),22,1)
     4320                ibit21 = IBITS(advc_flags_1(k,j,i),21,1)
    41614321
    41624322                v_comp(k) = v(k,j+1,i) + v(k,j,i)
    … …  
    41934353!--             k index has to be modified near bottom and top, else array
    41944354!--             subscripts will be exceeded.
    4195                 ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
    4196                 ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
    4197                 ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
     4355                ibit26 = IBITS(advc_flags_1(k,j,i),26,1)
     4356                ibit25 = IBITS(advc_flags_1(k,j,i),25,1)
     4357                ibit24 = IBITS(advc_flags_1(k,j,i),24,1)
    41984358
    41994359                k_ppp = k + 3 * ibit26
    … …  
    42384398                                       * ( ibit18 + ibit19 + ibit20 )         &
    42394399                - ( u(k,j-1,i)   + u(k,j,i) )                                 &
    4240                                        * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
    4241                                          + IBITS(wall_flags_0(k,j,i-1),19,1)  &
    4242                                          + IBITS(wall_flags_0(k,j,i-1),20,1)  &
     4400                                       * ( IBITS(advc_flags_1(k,j,i-1),18,1)  &
     4401                                         + IBITS(advc_flags_1(k,j,i-1),19,1)  &
     4402                                         + IBITS(advc_flags_1(k,j,i-1),20,1)  &
    42434403                                         )                                    &
    42444404                  ) * rho_air(k) * ddx                                        &
    … …  
    42464406                                       * ( ibit21 + ibit22 + ibit23 )         &
    42474407                - ( v(k,j,i)     + v(k,j-1,i) )                               &
    4248                                        * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
    4249                                          + IBITS(wall_flags_0(k,j-1,i),22,1)  &
    4250                                          + IBITS(wall_flags_0(k,j-1,i),23,1)  &
     4408                                       * ( IBITS(advc_flags_1(k,j-1,i),21,1)  &
     4409                                         + IBITS(advc_flags_1(k,j-1,i),22,1)  &
     4410                                         + IBITS(advc_flags_1(k,j-1,i),23,1)  &
    42514411                                         )                                    &
    42524412                  ) * rho_air(k) * ddy                                        &
    … …  
    42544414                                       * ( ibit24 + ibit25 + ibit26 )         &
    42554415                - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)             &
    4256                                        * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
    4257                                          + IBITS(wall_flags_0(k-1,j,i),25,1)  &
    4258                                          + IBITS(wall_flags_0(k-1,j,i),26,1)  &
     4416                                       * ( IBITS(advc_flags_1(k-1,j,i),24,1)  &
     4417                                         + IBITS(advc_flags_1(k-1,j,i),25,1)  &
     4418                                         + IBITS(advc_flags_1(k-1,j,i),26,1)  &
    42594419                                         )                                    &
    42604420                   ) * ddzw(k)   &
    … …  
    43324492!--             k index has to be modified near bottom and top, else array
    43334493!--             subscripts will be exceeded.
    4334                 ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
    4335                 ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
    4336                 ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
     4494                ibit26 = IBITS(advc_flags_1(k,j,i),26,1)
     4495                ibit25 = IBITS(advc_flags_1(k,j,i),25,1)
     4496                ibit24 = IBITS(advc_flags_1(k,j,i),24,1)
    43374497
    43384498                k_ppp = k + 3 * ibit26
    … …  
    44334593   
    44344594   
    4435    
    4436    
    44374595!------------------------------------------------------------------------------!
    44384596! Description:
    … …  
    44554613
    44564614       USE indices,                                                            &
    4457            ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,         &
    4458                   wall_flags_00
     4615           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1,         &
     4616                  advc_flags_2
    44594617
    44604618       USE kinds
    … …  
    45124670          DO  k = nzb+1, nzb_max
    45134671
    4514              ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
    4515              ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
    4516              ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
     4672             ibit29 = IBITS(advc_flags_1(k,j,i-1),29,1)
     4673             ibit28 = IBITS(advc_flags_1(k,j,i-1),28,1)
     4674             ibit27 = IBITS(advc_flags_1(k,j,i-1),27,1)
    45174675
    45184676             u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
    … …  
    45704728          DO  k = nzb+1, nzb_max
    45714729
    4572              ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
    4573              ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
    4574              ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
     4730             ibit32 = IBITS(advc_flags_2(k,j-1,i),0,1)
     4731             ibit31 = IBITS(advc_flags_1(k,j-1,i),31,1)
     4732             ibit30 = IBITS(advc_flags_1(k,j-1,i),30,1)
    45754733
    45764734             v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
    … …  
    46264784!--          The lower flux has to be calculated explicetely for the tendency
    46274785!--          at the first w-level. For topography wall this is done implicitely
    4628 !--          by wall_flags_0.
     4786!--          by advc_flags_1.
    46294787             k         = nzb + 1
    46304788             w_comp    = w(k,j,i) + w(k-1,j,i)
    … …  
    46364794             DO  k = nzb+1, nzb_max
    46374795
    4638                 ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
    4639                 ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
    4640                 ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
     4796                ibit29 = IBITS(advc_flags_1(k,j,i),29,1)
     4797                ibit28 = IBITS(advc_flags_1(k,j,i),28,1)
     4798                ibit27 = IBITS(advc_flags_1(k,j,i),27,1)
    46414799
    46424800                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
    … …  
    46714829                                              )
    46724830
    4673                 ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
    4674                 ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
    4675                 ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
     4831                ibit32 = IBITS(advc_flags_2(k,j,i),0,1)
     4832                ibit31 = IBITS(advc_flags_1(k,j,i),31,1)
     4833                ibit30 = IBITS(advc_flags_1(k,j,i),30,1)
    46764834
    46774835                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
    … …  
    47084866!--             k index has to be modified near bottom and top, else array
    47094867!--             subscripts will be exceeded.
    4710                 ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
    4711                 ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
    4712                 ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
     4868                ibit35 = IBITS(advc_flags_2(k,j,i),3,1)
     4869                ibit34 = IBITS(advc_flags_2(k,j,i),2,1)
     4870                ibit33 = IBITS(advc_flags_2(k,j,i),1,1)
    47134871
    47144872                k_ppp = k + 3 * ibit35
    … …  
    47524910                div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )      &
    47534911                  - ( u(k+1,j,i) + u(k,j,i)   )                               &
    4754                                     * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
    4755                                       + IBITS(wall_flags_0(k,j,i-1),28,1)     &
    4756                                       + IBITS(wall_flags_0(k,j,i-1),29,1)     &
     4912                                    * ( IBITS(advc_flags_1(k,j,i-1),27,1)     &
     4913                                      + IBITS(advc_flags_1(k,j,i-1),28,1)     &
     4914                                      + IBITS(advc_flags_1(k,j,i-1),29,1)     &
    47574915                                      )                                       &
    47584916                  ) * rho_air_zw(k) * ddx                                     &
    47594917              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            &
    47604918                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
    4761                                     * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
    4762                                       + IBITS(wall_flags_0(k,j-1,i),31,1)     &
    4763                                       + IBITS(wall_flags_00(k,j-1,i),0,1)     &
     4919                                    * ( IBITS(advc_flags_1(k,j-1,i),30,1)     &
     4920                                      + IBITS(advc_flags_1(k,j-1,i),31,1)     &
     4921                                      + IBITS(advc_flags_2(k,j-1,i),0,1)      &
    47644922                                      )                                       &
    47654923                  ) * rho_air_zw(k) * ddy                                     &
    47664924              +   ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 )      &
    47674925                - ( w(k,j,i)   + w(k-1,j,i)   ) * rho_air(k)                  &
    4768                                     * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
    4769                                       + IBITS(wall_flags_00(k-1,j,i),2,1)     &
    4770                                       + IBITS(wall_flags_00(k-1,j,i),3,1)     &
     4926                                    * ( IBITS(advc_flags_2(k-1,j,i),1,1)      &
     4927                                      + IBITS(advc_flags_2(k-1,j,i),2,1)      &
     4928                                      + IBITS(advc_flags_2(k-1,j,i),3,1)      &
    47714929                                      )                                       &
    47724930                  ) * ddzu(k+1)   &
    … …  
    48314989!--             k index has to be modified near bottom and top, else array
    48324990!--             subscripts will be exceeded.
    4833                 ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
    4834                 ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
    4835                 ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
     4991                ibit35 = IBITS(advc_flags_2(k,j,i),3,1)
     4992                ibit34 = IBITS(advc_flags_2(k,j,i),2,1)
     4993                ibit33 = IBITS(advc_flags_2(k,j,i),1,1)
    48364994
    48374995                k_ppp = k + 3 * ibit35
    … …  
    49165074    END SUBROUTINE advec_w_ws
    49175075
    4918 
    49195076 END MODULE advec_ws

  • palm/trunk/SOURCE/average_3d_data.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new surface concept - additional ghost point exchange
     23! of surface variable required
    2324!
    2425! Former revisions:
    … …  
    104105
    105106    USE control_parameters,                                                    &
    106         ONLY:  average_count_3d, doav, doav_n, urban_surface, varnamelength
     107        ONLY:  average_count_3d, doav, doav_n, land_surface, urban_surface,    &
     108               varnamelength
    107109
    108110    USE cpulog,                                                                &
    … …  
    110112
    111113    USE indices,                                                               &
    112         ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     114        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
    113115
    114116    USE kinds
    115117
    116118    USE land_surface_model_mod,                                                &
    117         ONLY:  land_surface, lsm_3d_data_averaging
     119        ONLY:  lsm_3d_data_averaging
    118120
    119121    USE radiation_model_mod,                                                   &
    … …  
    171173                ENDDO
    172174             ENDDO
     175             CALL exchange_horiz_2d( qsws_av, nbgp )
    173176
    174177          CASE ( 'lpt' )
    … …  
    203206                ENDDO
    204207             ENDDO
     208             CALL exchange_horiz_2d( ol_av, nbgp )
    205209
    206210          CASE ( 'p' )
    … …  
    354358                ENDDO
    355359             ENDDO
     360             CALL exchange_horiz_2d( shf_av, nbgp )
    356361
    357362          CASE ( 'ssws*' )
    … …  
    361366                ENDDO
    362367             ENDDO
     368             CALL exchange_horiz_2d( ssws_av, nbgp )
    363369
    364370          CASE ( 't*' )
    … …  
    368374                ENDDO
    369375             ENDDO
     376             CALL exchange_horiz_2d( ts_av, nbgp )
    370377
    371378          CASE ( 'u' )
    … …  
    384391                ENDDO
    385392             ENDDO
     393             CALL exchange_horiz_2d( us_av, nbgp )
    386394
    387395          CASE ( 'v' )
    … …  
    418426                ENDDO
    419427             ENDDO
     428             CALL exchange_horiz_2d( z0_av, nbgp )
    420429
    421430          CASE ( 'z0h*' )
    … …  
    425434                ENDDO
    426435             ENDDO
     436             CALL exchange_horiz_2d( z0h_av, nbgp )
    427437!             
    428438!--       Block of urban surface model outputs   

  • palm/trunk/SOURCE/boundary_conds.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Set boundary conditions on topography top using flag method.
    2323!
    2424! Former revisions:
    … …  
    168168    USE indices,                                                               &
    169169        ONLY:  nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,             &
    170                nzb, nzb_s_inner, nzb_w_inner, nzt
     170               nzb, nzt, wall_flags_0
    171171
    172172    USE kinds
    … …  
    177177        ONLY : nesting_mode
    178178
     179    USE surface_mod,                                                           &
     180        ONLY :  bc_h
    179181
    180182    IMPLICIT NONE
    181183
    182     INTEGER(iwp) ::  i !<
    183     INTEGER(iwp) ::  j !<
    184     INTEGER(iwp) ::  k !<
     184    INTEGER(iwp) ::  i  !< grid index x direction
     185    INTEGER(iwp) ::  j  !< grid index y direction
     186    INTEGER(iwp) ::  k  !< grid index z direction
     187    INTEGER(iwp) ::  kb !< variable to set respective boundary value, depends on facing.
     188    INTEGER(iwp) ::  l  !< running index boundary type, for up- and downward-facing walls
     189    INTEGER(iwp) ::  m  !< running index surface elements
    185190
    186191    REAL(wp)    ::  c_max !<
    … …  
    194199       v_p(nzb,:,:) = v_p(nzb+1,:,:)
    195200    ENDIF
    196 
    197     DO  i = nxlg, nxrg
    198        DO  j = nysg, nyng
    199           w_p(nzb_w_inner(j,i),j,i) = 0.0_wp
     201!
     202!-- Set zero vertical velocity at topography top (l=0), or bottom (l=1) in case
     203!-- of downward-facing surfaces.
     204    DO  l = 0, 1
     205!
     206!--    Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     207!--    for downward-facing surfaces at topography bottom (k+1).
     208       kb = MERGE( -1, 1, l == 0 )
     209       !$OMP PARALLEL DO PRIVATE( i, j, k )
     210       DO  m = 1, bc_h(l)%ns
     211          i = bc_h(l)%i(m)           
     212          j = bc_h(l)%j(m)
     213          k = bc_h(l)%k(m)
     214          w_p(k+kb,j,i) = 0.0_wp
    200215       ENDDO
    201216    ENDDO
    … …  
    216231
    217232!
    218 !-- Temperature at bottom boundary.
     233!-- Temperature at bottom and top boundary.
    219234!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by
    220235!-- the sea surface temperature of the coupled ocean model.
     236!-- Dirichlet
    221237    IF ( ibc_pt_b == 0 )  THEN
    222        DO  i = nxlg, nxrg
    223           DO  j = nysg, nyng
    224              pt_p(nzb_s_inner(j,i),j,i) = pt(nzb_s_inner(j,i),j,i)
     238       DO  l = 0, 1
     239!
     240!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     241!--       for downward-facing surfaces at topography bottom (k+1).
     242          kb = MERGE( -1, 1, l == 0 )
     243          !$OMP PARALLEL DO PRIVATE( i, j, k )
     244          DO  m = 1, bc_h(l)%ns
     245             i = bc_h(l)%i(m)           
     246             j = bc_h(l)%j(m)
     247             k = bc_h(l)%k(m)
     248             pt_p(k+kb,j,i) = pt(k+kb,j,i)
    225249          ENDDO
    226250       ENDDO
     251!
     252!-- Neumann, zero-gradient
    227253    ELSEIF ( ibc_pt_b == 1 )  THEN
    228        DO  i = nxlg, nxrg
    229           DO  j = nysg, nyng
    230              pt_p(nzb_s_inner(j,i),j,i) = pt_p(nzb_s_inner(j,i)+1,j,i)
     254       DO  l = 0, 1
     255!
     256!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     257!--       for downward-facing surfaces at topography bottom (k+1).
     258          kb = MERGE( -1, 1, l == 0 )
     259          !$OMP PARALLEL DO PRIVATE( i, j, k )
     260          DO  m = 1, bc_h(l)%ns
     261             i = bc_h(l)%i(m)           
     262             j = bc_h(l)%j(m)
     263             k = bc_h(l)%k(m)
     264             pt_p(k+kb,j,i) = pt_p(k,j,i)
    231265          ENDDO
    232266       ENDDO
    … …  
    253287!-- Generally Neumann conditions with de/dz=0 are assumed
    254288    IF ( .NOT. constant_diffusion )  THEN
    255        DO  i = nxlg, nxrg
    256           DO  j = nysg, nyng
    257              e_p(nzb_s_inner(j,i),j,i) = e_p(nzb_s_inner(j,i)+1,j,i)
     289
     290       DO  l = 0, 1
     291!
     292!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     293!--       for downward-facing surfaces at topography bottom (k+1).
     294          kb = MERGE( -1, 1, l == 0 )
     295          !$OMP PARALLEL DO PRIVATE( i, j, k )
     296          DO  m = 1, bc_h(l)%ns
     297             i = bc_h(l)%i(m)           
     298             j = bc_h(l)%j(m)
     299             k = bc_h(l)%k(m)
     300             e_p(k+kb,j,i) = e_p(k,j,i)
    258301          ENDDO
    259302       ENDDO
     303
    260304       IF ( .NOT. nest_domain )  THEN
    261305          e_p(nzt+1,:,:) = e_p(nzt,:,:)
    … …  
    268312!
    269313!--    Bottom boundary: Neumann condition because salinity flux is always
    270 !--    given
    271        DO  i = nxlg, nxrg
    272           DO  j = nysg, nyng
    273              sa_p(nzb_s_inner(j,i),j,i) = sa_p(nzb_s_inner(j,i)+1,j,i)
     314!--    given.
     315       DO  l = 0, 1
     316!
     317!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     318!--       for downward-facing surfaces at topography bottom (k+1).
     319          kb = MERGE( -1, 1, l == 0 )
     320          !$OMP PARALLEL DO PRIVATE( i, j, k )
     321          DO  m = 1, bc_h(l)%ns
     322             i = bc_h(l)%i(m)           
     323             j = bc_h(l)%j(m)
     324             k = bc_h(l)%k(m)
     325             sa_p(k+kb,j,i) = sa_p(k,j,i)
    274326          ENDDO
    275327       ENDDO
    276 
    277328!
    278329!--    Top boundary: Dirichlet or Neumann
    … …  
    291342!
    292343!--    Surface conditions for constant_humidity_flux
     344!--    Run loop over all non-natural and natural walls. Note, in wall-datatype
     345!--    the k coordinate belongs to the atmospheric grid point, therefore, set
     346!--    q_p at k-1
    293347       IF ( ibc_q_b == 0 ) THEN
    294           DO  i = nxlg, nxrg
    295              DO  j = nysg, nyng
    296                 q_p(nzb_s_inner(j,i),j,i) = q(nzb_s_inner(j,i),j,i)
     348
     349          DO  l = 0, 1
     350!
     351!--          Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     352!--          for downward-facing surfaces at topography bottom (k+1).
     353             kb = MERGE( -1, 1, l == 0 )
     354             !$OMP PARALLEL DO PRIVATE( i, j, k )
     355             DO  m = 1, bc_h(l)%ns
     356                i = bc_h(l)%i(m)           
     357                j = bc_h(l)%j(m)
     358                k = bc_h(l)%k(m)
     359                q_p(k+kb,j,i) = q(k+kb,j,i)
    297360             ENDDO
    298361          ENDDO
     362         
    299363       ELSE
    300           DO  i = nxlg, nxrg
    301              DO  j = nysg, nyng
    302                 q_p(nzb_s_inner(j,i),j,i) = q_p(nzb_s_inner(j,i)+1,j,i)
     364          !$OMP PARALLEL DO PRIVATE( i, j, k )
     365          DO  m = 1, bc_h(0)%ns
     366             i = bc_h(0)%i(m)           
     367             j = bc_h(0)%j(m)
     368             k = bc_h(0)%k(m)
     369             q_p(k-1,j,i) = q_p(k,j,i)
     370          ENDDO
     371         
     372          DO  l = 0, 1
     373!
     374!--          Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     375!--          for downward-facing surfaces at topography bottom (k+1).
     376             kb = MERGE( -1, 1, l == 0 )
     377             !$OMP PARALLEL DO PRIVATE( i, j, k )
     378             DO  m = 1, bc_h(l)%ns
     379                i = bc_h(l)%i(m)           
     380                j = bc_h(l)%j(m)
     381                k = bc_h(l)%k(m)
     382                q_p(k+kb,j,i) = q_p(k,j,i)
    303383             ENDDO
    304384          ENDDO
    … …  
    315395!             
    316396!--       Surface conditions rain water (Dirichlet)
    317           DO  i = nxlg, nxrg
    318              DO  j = nysg, nyng
    319                 qr_p(nzb_s_inner(j,i),j,i) = 0.0_wp
    320                 nr_p(nzb_s_inner(j,i),j,i) = 0.0_wp
    321              ENDDO
     397!--       Run loop over all non-natural and natural walls. Note, in wall-datatype
     398!--       the k coordinate belongs to the atmospheric grid point, therefore, set
     399!--       qr_p and nr_p at k-1
     400          !$OMP PARALLEL DO PRIVATE( i, j, k )
     401          DO  m = 1, bc_h(0)%ns
     402             i = bc_h(0)%i(m)           
     403             j = bc_h(0)%j(m)
     404             k = bc_h(0)%k(m)
     405             qr_p(k-1,j,i) = 0.0_wp
     406             nr_p(k-1,j,i) = 0.0_wp
    322407          ENDDO
    323408!
    … …  
    334419!
    335420!--    Surface conditions for constant_humidity_flux
     421!--    Run loop over all non-natural and natural walls. Note, in wall-datatype
     422!--    the k coordinate belongs to the atmospheric grid point, therefore, set
     423!--    s_p at k-1
    336424       IF ( ibc_s_b == 0 ) THEN
    337           DO  i = nxlg, nxrg
    338              DO  j = nysg, nyng
    339                 s_p(nzb_s_inner(j,i),j,i) = s(nzb_s_inner(j,i),j,i)
     425         
     426          DO  l = 0, 1
     427!
     428!--          Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     429!--          for downward-facing surfaces at topography bottom (k+1).
     430             kb = MERGE( -1, 1, l == 0 )
     431             !$OMP PARALLEL DO PRIVATE( i, j, k )
     432             DO  m = 1, bc_h(l)%ns
     433                i = bc_h(l)%i(m)           
     434                j = bc_h(l)%j(m)
     435                k = bc_h(l)%k(m)
     436                s_p(k+kb,j,i) = s(k+kb,j,i)
    340437             ENDDO
    341438          ENDDO
     439         
    342440       ELSE
    343           DO  i = nxlg, nxrg
    344              DO  j = nysg, nyng
    345                 s_p(nzb_s_inner(j,i),j,i) = s_p(nzb_s_inner(j,i)+1,j,i)
     441          !$OMP PARALLEL DO PRIVATE( i, j, k )
     442          DO  m = 1, bc_h(0)%ns
     443             i = bc_h(0)%i(m)           
     444             j = bc_h(0)%j(m)
     445             k = bc_h(0)%k(m)
     446             s_p(k-1,j,i) = s_p(k,j,i)
     447          ENDDO
     448         
     449          DO  l = 0, 1
     450!
     451!--          Set kb, for upward-facing surfaces value at topography top (k-1) is set,
     452!--          for downward-facing surfaces at topography bottom (k+1).
     453             kb = MERGE( -1, 1, l == 0 )
     454             !$OMP PARALLEL DO PRIVATE( i, j, k )
     455             DO  m = 1, bc_h(l)%ns
     456                i = bc_h(l)%i(m)           
     457                j = bc_h(l)%j(m)
     458                k = bc_h(l)%k(m)
     459                s_p(k+kb,j,i) = s_p(k,j,i)
    346460             ENDDO
    347461          ENDDO
    … …  
    394508    IF ( outflow_s )  THEN
    395509       pt_p(:,nys-1,:)     = pt_p(:,nys,:)
    396        IF ( .NOT. constant_diffusion     )  e_p(:,nys-1,:) = e_p(:,nys,:)
     510       IF ( .NOT. constant_diffusion )  e_p(:,nys-1,:) = e_p(:,nys,:)
    397511       IF ( humidity )  THEN
    398512          q_p(:,nys-1,:) = q_p(:,nys,:)

  • palm/trunk/SOURCE/buoyancy.f90

    r2119 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    131131       USE indices,                                                            &
    132132           ONLY:  nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nzb,       &
    133                   nzb_s_inner, nzt
     133                  nzt, wall_flags_0
    134134
    135135       USE kinds
    … …  
    157157          DO  i = nxl, nxr
    158158             DO  j = nys, nyn
    159                 DO  k = nzb_s_inner(j,i)+1, nzt-1
    160                    tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * &
    161                           (                                                    &
     159                DO  k = nzb+1, nzt-1
     160                   tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp *  &
     161                          (                                                     &
    162162                             ( var(k,j,i)   - ref_state(k) )   / ref_state(k) + &
    163163                             ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) &
    164                           )
     164                          ) * MERGE( 1.0_wp, 0.0_wp,                            &
     165                                     BTEST( wall_flags_0(k,j,i), 0 ) )
    165166                ENDDO
    166167             ENDDO
    … …  
    178179             DO  i = nxlu, nxr
    179180                DO  j = nys, nyn
    180                    DO  k = nzb_s_inner(j,i)+1, nzt-1
    181                       tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
     181                   DO  k = nzb+1, nzt-1
     182                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *         &
    182183                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
    183184                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
    184                                     ) / pt_surface
     185                                    ) / pt_surface                                &
     186                                      * MERGE( 1.0_wp, 0.0_wp,                    &
     187                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    185188                   ENDDO
    186189                ENDDO
    … …  
    191194             DO  i = nxl, nxr
    192195                DO  j = nys, nyn
    193                    DO  k = nzb_s_inner(j,i)+1, nzt-1
    194                       tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
     196                   DO  k = nzb+1, nzt-1
     197                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *         &
    195198                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
    196199                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
    197                                     ) / pt_surface
     200                                    ) / pt_surface                                &
     201                                      * MERGE( 1.0_wp, 0.0_wp,                    &
     202                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    198203                   ENDDO
    199204                ENDDO
    … …  
    231236
    232237       USE indices,                                                            &
    233            ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
     238           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
    234239
    235240       USE kinds
    … …  
    256261!
    257262!--       Normal case: horizontal surface
    258           DO  k = nzb_s_inner(j,i)+1, nzt-1
     263          DO  k = nzb+1, nzt-1
    259264              tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * (    &
    260265                        ( var(k,j,i)   - ref_state(k)   ) / ref_state(k)   +   &
    261266                        ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1)     &
    262                                                                           )
     267                                                                          )    &
     268                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     269                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    263270          ENDDO
    264271
    … …  
    272279          IF ( wind_component == 1 )  THEN
    273280
    274              DO  k = nzb_s_inner(j,i)+1, nzt-1
    275                 tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *            &
     281             DO  k = nzb+1, nzt-1
     282                tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *               &
    276283                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
    277284                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
    278                                     ) / pt_surface
     285                                    ) / pt_surface                                &
     286                                      * MERGE( 1.0_wp, 0.0_wp,                    &
     287                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    279288             ENDDO
    280289
    281290          ELSEIF ( wind_component == 3 )  THEN
    282291
    283              DO  k = nzb_s_inner(j,i)+1, nzt-1
    284                 tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *            &
     292             DO  k = nzb+1, nzt-1
     293                tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *               &
    285294                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
    286295                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
    287                                     ) / pt_surface
     296                                    ) / pt_surface                                &
     297                                      * MERGE( 1.0_wp, 0.0_wp,                    &
     298                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    288299             ENDDO
    289300

  • palm/trunk/SOURCE/calc_liquid_water_content.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    8383
    8484    USE indices,                                                               &
    85         ONLY:  nxlg, nxrg, nyng, nysg, nzb_s_inner, nzt
     85        ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
    8686
    8787    USE kinds
    … …  
    103103    DO  i = nxlg, nxrg
    104104       DO  j = nysg, nyng
    105           DO  k = nzb_s_inner(j,i)+1, nzt
     105          DO  k = nzb+1, nzt
    106106
    107107!
    … …  
    131131             IF ( microphysics_seifert )  THEN
    132132                IF ( ( q(k,j,i) - q_s - qr(k,j,i) ) > 0.0_wp ) THEN
    133                    qc(k,j,i) = q(k,j,i) - q_s - qr(k,j,i)
    134                    ql(k,j,i) = qc(k,j,i) + qr(k,j,i)
     133                   qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) )                  &
     134                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     135                                               BTEST( wall_flags_0(k,j,i), 0 ) )
     136                   ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) )                       &
     137                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     138                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    135139                ELSE
    136140                   IF ( q(k,j,i) < qr(k,j,i) )  q(k,j,i) = qr(k,j,i)
    137141                   qc(k,j,i) = 0.0_wp
    138                    ql(k,j,i) = qr(k,j,i)
     142                   ql(k,j,i) = qr(k,j,i)                                       &
     143                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     144                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    139145                ENDIF
    140146             ELSE
    141147                IF ( ( q(k,j,i) - q_s ) > 0.0_wp ) THEN
    142                    qc(k,j,i) = q(k,j,i) - q_s
    143                    ql(k,j,i) = qc(k,j,i)
     148                   qc(k,j,i) = ( q(k,j,i) - q_s )                              &
     149                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     150                                               BTEST( wall_flags_0(k,j,i), 0 ) )
     151                   ql(k,j,i) = qc(k,j,i)                                       &
     152                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     153                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    144154                ELSE
    145155                   qc(k,j,i) = 0.0_wp

  • palm/trunk/SOURCE/calc_mean_profile.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    7575
    7676       USE indices,                                                            &
    77            ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
     77           ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb, nzt,          &
     78                  wall_flags_0
    7879
    7980       USE kinds
    … …  
    118119          DO  i = nxl, nxr
    119120             DO  j =  nys, nyn
    120                 DO  k = nzb_s_inner(j,i), nzt+1
    121                    sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i)
     121                DO  k = nzb, nzt+1
     122                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i)              &
     123                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     124                                              BTEST( wall_flags_0(k,j,i), 22 ) )
    122125                ENDDO
    123126             ENDDO

  • palm/trunk/SOURCE/calc_radiation.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    105105
    106106       USE indices,                                                            &
    107            ONLY:  nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
     107           ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    108108
    109109       USE kinds
    … …  
    153153             blackbody_emission(nzb) = sigma * temperature**4
    154154
    155              DO  k = nzb_s_inner(j,i)+1, nzt
     155             DO  k = nzb+1, nzt
    156156
    157157                k_help = ( nzt+nzb+1 ) - k
    … …  
    163163
    164164                temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
    165                 blackbody_emission(k) = sigma * temperature**4
     165                blackbody_emission(k) = sigma * temperature**4                 &
     166                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     167                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    166168
    167169             ENDDO
    … …  
    179181             impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp
    180182
    181              DO  k = nzb_s_inner(j,i)+1, nzt
     183             DO  k = nzb+1, nzt
    182184!
    183185!--             Save some computational time, but this may cause load
    … …  
    222224                   tend(k,j,i) = tend(k,j,i) -                                 &
    223225                                ( pt_d_t(k) / ( rho_surface * cp ) *           &
    224                                   ( df_p - df_m ) / dzw(k) )
     226                                  ( df_p - df_m ) / dzw(k) )                   &
     227                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     228                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    225229
    226230                ENDIF
    … …  
    250254
    251255       USE indices,                                                            &
    252            ONLY:  nzb, nzb_s_inner, nzt
     256           ONLY:  nzb, nzt, wall_flags_0
    253257
    254258       USE kinds
    … …  
    295299       blackbody_emission(nzb) = sigma * temperature**4
    296300
    297        DO  k = nzb_s_inner(j,i)+1, nzt
     301       DO  k = nzb+1, nzt
    298302          k_help = ( nzt+nzb+1 ) - k
    299303          lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k)
    … …  
    303307
    304308          temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
    305           blackbody_emission(k) = sigma * temperature**4
     309          blackbody_emission(k) = sigma * temperature**4                       &
     310                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     311                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    306312
    307313       ENDDO
    … …  
    318324       impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp
    319325
    320        DO  k = nzb_s_inner(j,i)+1, nzt
     326       DO  k = nzb+1, nzt
    321327!
    322328!--       Store some computational time,
    … …  
    356362!--          Compute tendency term         
    357363             tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) *  &
    358                                          ( df_p - df_m ) / dzw(k) )
     364                                         ( df_p - df_m ) / dzw(k) )            &
     365                                      * MERGE( 1.0_wp, 0.0_wp,                 &
     366                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    359367
    360368          ENDIF

  • palm/trunk/SOURCE/check_parameters.f90

    r2210 r2232  
    466466    USE indices
    467467    USE land_surface_model_mod,                                                &
    468         ONLY: land_surface, lsm_check_data_output, lsm_check_data_output_pr,   &
     468        ONLY: lsm_check_data_output, lsm_check_data_output_pr,                 &
    469469              lsm_check_parameters
    470470
    … …  
    859859                        'momentum_advec = "ws-scheme"'
    860860       CALL message( 'check_parameters', 'PA0447', 1, 2, 0, 6, 0 )
     861    ENDIF
     862    IF ( TRIM( approximation ) == 'anelastic'   .AND.   &
     863         TRIM( psolver ) == 'multigrid' )  THEN
     864       message_string = 'Anelastic approximation currently only supports: ' // &
     865                        'psolver = "poisfft", ' // &
     866                        'psolver = "sor" and ' // &
     867                        'psolver = "multigrid_noopt"'
     868       CALL message( 'check_parameters', 'PA0448', 1, 2, 0, 6, 0 )
    861869    ENDIF
    862870    IF ( TRIM( approximation ) == 'anelastic'   .AND.   &

  • palm/trunk/SOURCE/coriolis.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    102102           
    103103       USE indices,                                                            &
    104            ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner,    &
    105                   nzb_w_inner, nzt
     104           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_0
    106105                   
    107106       USE kinds
    … …  
    110109
    111110       INTEGER(iwp) ::  component  !<
    112        INTEGER(iwp) ::  i          !<
    113        INTEGER(iwp) ::  j          !<
    114        INTEGER(iwp) ::  k          !<
    115 
    116 
     111       INTEGER(iwp) ::  i          !< running index x direction
     112       INTEGER(iwp) ::  j          !< running index y direction
     113       INTEGER(iwp) ::  k          !< running index z direction
     114
     115       REAL(wp)     ::  flag       !< flag to mask topography
    117116!
    118117!--    Compute Coriolis terms for the three velocity components
    … …  
    124123             DO  i = nxlu, nxr
    125124                DO  j = nys, nyn
    126                    DO  k = nzb_u_inner(j,i)+1, nzt
     125                   DO  k = nzb+1, nzt
     126!
     127!--                    Predetermine flag to mask topography
     128                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
     129                                    BTEST( wall_flags_0(k,j,i), 1 ) )
     130
    127131                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
    128132                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
    129                                      v(k,j+1,i) ) - vg(k) )                    &
     133                                     v(k,j+1,i) ) - vg(k)   ) * flag           &
    130134                                                - fs *    ( 0.25_wp *          &
    131135                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
    132                                      w(k,j,i)   ) &
    133                                                           )
     136                                     w(k,j,i)   )                              &
     137                                                          )   * flag
    134138                   ENDDO
    135139                ENDDO
    … …  
    141145             DO  i = nxl, nxr
    142146                DO  j = nysv, nyn
    143                    DO  k = nzb_v_inner(j,i)+1, nzt
     147                   DO  k = nzb+1, nzt
    144148                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
    145149                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
    146                                      u(k,j,i+1) ) - ug(k) )
     150                                     u(k,j,i+1) ) - ug(k) ) *                  &
     151                                      MERGE( 1.0_wp, 0.0_wp,                   &
     152                                             BTEST( wall_flags_0(k,j,i), 2 ) )
    147153                   ENDDO
    148154                ENDDO
    … …  
    154160             DO  i = nxl, nxr
    155161                DO  j = nys, nyn
    156                    DO  k = nzb_w_inner(j,i)+1, nzt
     162                   DO  k = nzb+1, nzt
    157163                      tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *               &
    158164                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
    159                                      u(k+1,j,i+1) )
     165                                     u(k+1,j,i+1) ) *                          &
     166                                      MERGE( 1.0_wp, 0.0_wp,                   &
     167                                             BTEST( wall_flags_0(k,j,i), 3 ) )
    160168                   ENDDO
    161169                ENDDO
    … …  
    186194           
    187195       USE indices,                                                            &
    188            ONLY:  nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
     196           ONLY:  nzb, nzt, wall_flags_0
    189197           
    190198       USE kinds
    … …  
    193201
    194202       INTEGER(iwp) ::  component  !<
    195        INTEGER(iwp) ::  i          !<
    196        INTEGER(iwp) ::  j          !<
    197        INTEGER(iwp) ::  k          !<
     203       INTEGER(iwp) ::  i          !< running index x direction
     204       INTEGER(iwp) ::  j          !< running index y direction
     205       INTEGER(iwp) ::  k          !< running index z direction
     206
     207       REAL(wp)     ::  flag       !< flag to mask topography
    198208
    199209!
    … …  
    204214!--       u-component
    205215          CASE ( 1 )
    206              DO  k = nzb_u_inner(j,i)+1, nzt
    207                 tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *                &
     216             DO  k = nzb+1, nzt
     217!
     218!--             Predetermine flag to mask topography
     219                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
     220
     221                tend(k,j,i) = tend(k,j,i) + f  *     ( 0.25_wp *               &
    208222                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
    209                                   v(k,j+1,i) ) - vg(k) )                       &
     223                                  v(k,j+1,i) ) - vg(k) ) * flag                &
    210224                                          - fs *    ( 0.25_wp *                &
    211225                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
    212                                   w(k,j,i)   ) )
     226                                  w(k,j,i)   )      ) * flag
    213227             ENDDO
    214228
    … …  
    216230!--       v-component
    217231          CASE ( 2 )
    218              DO  k = nzb_v_inner(j,i)+1, nzt
    219                 tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *                &
     232             DO  k = nzb+1, nzt
     233                tend(k,j,i) = tend(k,j,i) - f *        ( 0.25_wp *             &
    220234                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
    221                                   u(k,j,i+1) ) - ug(k) )
     235                                  u(k,j,i+1) ) - ug(k) ) *                     &
     236                                      MERGE( 1.0_wp, 0.0_wp,                   &
     237                                             BTEST( wall_flags_0(k,j,i), 2 ) )
    222238             ENDDO
    223239
    … …  
    225241!--       w-component
    226242          CASE ( 3 )
    227              DO  k = nzb_w_inner(j,i)+1, nzt
     243             DO  k = nzb+1, nzt
    228244                tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
    229245                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
    230                                   u(k+1,j,i+1) )
     246                                  u(k+1,j,i+1) ) *                             &
     247                                      MERGE( 1.0_wp, 0.0_wp,                   &
     248                                             BTEST( wall_flags_0(k,j,i), 3 ) )
    231249             ENDDO
    232250

  • palm/trunk/SOURCE/data_output_2d.f90

    r2191 r2232  
    2020! Current revisions:
    2121! -----------------
     22! Adjustments to new surface concept
    2223!
    2324!
    … …  
    162163
    163164    USE arrays_3d,                                                             &
    164         ONLY:  dzw, e, nr, ol, p, pt, precipitation_amount, precipitation_rate,&
    165                prr,q, qc, ql, ql_c, ql_v, ql_vp, qr, qsws, rho_ocean, s, sa, shf,    &
    166                ssws, tend, ts, u, us, v, vpt, w, z0, z0h, z0q, zu, zw
     165        ONLY:  dzw, e, nr, p, pt, precipitation_amount, precipitation_rate,    &
     166               prr, q, qc, ql, ql_c, ql_v, ql_vp, qr, rho_ocean, s, sa,        &
     167               tend, u, v, vpt, w, zu, zw
    167168       
    168169    USE averaging
    … …  
    177178               do2d_xz_last_time, do2d_xz_n, do2d_xz_time_count,               &
    178179               do2d_yz_last_time, do2d_yz_n, do2d_yz_time_count,               &
    179                ibc_uv_b, io_blocks, io_group, message_string,                  &
     180               ibc_uv_b, io_blocks, io_group, land_surface, message_string,    &
    180181               ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz,                          &
    181182               psolver, section, simulated_time, simulated_time_chr,           &
    … …  
    195196   
    196197    USE land_surface_model_mod,                                                &
    197         ONLY:  land_surface, lsm_data_output_2d, zs
     198        ONLY:  lsm_data_output_2d, zs
    198199   
    199200#if defined( __netcdf )
    … …  
    214215    USE radiation_model_mod,                                                   &
    215216        ONLY:  radiation, radiation_data_output_2d
     217
     218    USE surface_mod,                                                           &
     219        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
    216220
    217221    IMPLICIT NONE
    … …  
    234238    INTEGER(iwp) ::  l         !<
    235239    INTEGER(iwp) ::  layer_xy  !<
     240    INTEGER(iwp) ::  m         !<
    236241    INTEGER(iwp) ::  n         !<
    237242    INTEGER(iwp) ::  nis       !<
    … …  
    255260    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  local_2d            !<
    256261    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  local_2d_l          !<
     262    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  tmp_2d              !< temporary field used to exchange surface-related quantities
     263
    257264    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf            !<
    258265    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_2d_sections   !<
    … …  
    417424!-- Allocate a temporary array for resorting (kji -> ijk).
    418425    ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) )
     426    local_pf = 0.0
     427!
     428!-- Allocate temporary array used for exchanging ghoist points of surface-data
     429    ALLOCATE( tmp_2d(nysg:nyng,nxlg:nxrg) )
     430    tmp_2d = 0.0
    419431
    420432!
    … …  
    485497             CASE ( 'ol*_xy' )        ! 2d-array
    486498                IF ( av == 0 ) THEN
    487                    DO  i = nxlg, nxrg
    488                       DO  j = nysg, nyng
    489                          local_pf(i,j,nzb+1) = ol(j,i)
    490                       ENDDO
    491                    ENDDO
     499                   DO  m = 1, surf_def_h(0)%ns
     500                      i = surf_def_h(0)%i(m)
     501                      j = surf_def_h(0)%j(m)
     502                      tmp_2d(j,i) = surf_def_h(0)%ol(m)
     503                   ENDDO
     504                   DO  m = 1, surf_lsm_h%ns
     505                      i = surf_lsm_h%i(m)
     506                      j = surf_lsm_h%j(m)
     507                      tmp_2d(j,i) = surf_lsm_h%ol(m)
     508                   ENDDO
     509                   DO  m = 1, surf_usm_h%ns
     510                      i = surf_usm_h%i(m)
     511                      j = surf_usm_h%j(m)
     512                      tmp_2d(j,i) = surf_usm_h%ol(m)
     513                   ENDDO
     514
     515                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     516
     517                   DO  i = nxlg, nxrg
     518                      DO  j = nysg, nyng
     519                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
     520                      ENDDO
     521                   ENDDO
     522
    492523                ELSE
    493524                   DO  i = nxlg, nxrg
    … …  
    740771             CASE ( 'qsws*_xy' )        ! 2d-array
    741772                IF ( av == 0 ) THEN
    742                    DO  i = nxlg, nxrg
    743                       DO  j = nysg, nyng
    744                          local_pf(i,j,nzb+1) =  qsws(j,i)
     773                   DO  m = 1, surf_def_h(0)%ns
     774                      i = surf_def_h(0)%i(m)
     775                      j = surf_def_h(0)%j(m)
     776                      tmp_2d(j,i) = surf_def_h(0)%qsws(m)
     777                   ENDDO
     778                   DO  m = 1, surf_lsm_h%ns
     779                      i = surf_lsm_h%i(m)
     780                      j = surf_lsm_h%j(m)
     781                      tmp_2d(j,i) = surf_lsm_h%qsws(m)
     782                   ENDDO
     783                   DO  m = 1, surf_usm_h%ns
     784                      i = surf_usm_h%i(m)
     785                      j = surf_usm_h%j(m)
     786                      tmp_2d(j,i) = surf_usm_h%qsws(m)
     787                   ENDDO
     788
     789                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     790
     791                   DO  i = nxlg, nxrg
     792                      DO  j = nysg, nyng
     793                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
    745794                      ENDDO
    746795                   ENDDO
    … …  
    796845             CASE ( 'shf*_xy' )        ! 2d-array
    797846                IF ( av == 0 ) THEN
    798                    DO  i = nxlg, nxrg
    799                       DO  j = nysg, nyng
    800                          local_pf(i,j,nzb+1) =  shf(j,i)
     847                   DO  m = 1, surf_def_h(0)%ns
     848                      i = surf_def_h(0)%i(m)
     849                      j = surf_def_h(0)%j(m)
     850                      tmp_2d(j,i) = surf_def_h(0)%shf(m)
     851                   ENDDO
     852                   DO  m = 1, surf_lsm_h%ns
     853                      i = surf_lsm_h%i(m)
     854                      j = surf_lsm_h%j(m)
     855                      tmp_2d(j,i) = surf_lsm_h%shf(m)
     856                   ENDDO
     857                   DO  m = 1, surf_usm_h%ns
     858                      i = surf_usm_h%i(m)
     859                      j = surf_usm_h%j(m)
     860                      tmp_2d(j,i) = surf_usm_h%shf(m)
     861                   ENDDO
     862
     863                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     864
     865                   DO  i = nxlg, nxrg
     866                      DO  j = nysg, nyng
     867                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
    801868                      ENDDO
    802869                   ENDDO
    … …  
    814881             CASE ( 'ssws*_xy' )        ! 2d-array
    815882                IF ( av == 0 ) THEN
    816                    DO  i = nxlg, nxrg
    817                       DO  j = nysg, nyng
    818                          local_pf(i,j,nzb+1) =  ssws(j,i)
     883                   DO  m = 1, surf_def_h(0)%ns
     884                      i = surf_def_h(0)%i(m)
     885                      j = surf_def_h(0)%j(m)
     886                      tmp_2d(j,i) = surf_def_h(0)%ssws(m)
     887                   ENDDO
     888                   DO  m = 1, surf_lsm_h%ns
     889                      i = surf_lsm_h%i(m)
     890                      j = surf_lsm_h%j(m)
     891                      tmp_2d(j,i) = surf_lsm_h%ssws(m)
     892                   ENDDO
     893                   DO  m = 1, surf_usm_h%ns
     894                      i = surf_usm_h%i(m)
     895                      j = surf_usm_h%j(m)
     896                      tmp_2d(j,i) = surf_usm_h%ssws(m)
     897                   ENDDO
     898
     899                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     900
     901                   DO  i = nxlg, nxrg
     902                      DO  j = nysg, nyng
     903                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
    819904                      ENDDO
    820905                   ENDDO
    … …  
    832917             CASE ( 't*_xy' )        ! 2d-array
    833918                IF ( av == 0 )  THEN
    834                    DO  i = nxlg, nxrg
    835                       DO  j = nysg, nyng
    836                          local_pf(i,j,nzb+1) = ts(j,i)
    837                       ENDDO
    838                    ENDDO
     919                   DO  m = 1, surf_def_h(0)%ns
     920                      i = surf_def_h(0)%i(m)
     921                      j = surf_def_h(0)%j(m)
     922                      tmp_2d(j,i) = surf_def_h(0)%ts(m)
     923                   ENDDO
     924                   DO  m = 1, surf_lsm_h%ns
     925                      i = surf_lsm_h%i(m)
     926                      j = surf_lsm_h%j(m)
     927                      tmp_2d(j,i) = surf_lsm_h%ts(m)
     928                   ENDDO
     929                   DO  m = 1, surf_usm_h%ns
     930                      i = surf_usm_h%i(m)
     931                      j = surf_usm_h%j(m)
     932                      tmp_2d(j,i) = surf_usm_h%ts(m)
     933                   ENDDO
     934
     935                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     936
     937                   DO  i = nxlg, nxrg
     938                      DO  j = nysg, nyng
     939                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
     940                      ENDDO
     941                   ENDDO
     942
    839943                ELSE
    840944                   DO  i = nxlg, nxrg
    … …  
    864968             CASE ( 'u*_xy' )        ! 2d-array
    865969                IF ( av == 0 )  THEN
    866                    DO  i = nxlg, nxrg
    867                       DO  j = nysg, nyng
    868                          local_pf(i,j,nzb+1) = us(j,i)
     970                   DO  m = 1, surf_def_h(0)%ns
     971                      i = surf_def_h(0)%i(m)
     972                      j = surf_def_h(0)%j(m)
     973                      tmp_2d(j,i) = surf_def_h(0)%us(m)
     974                   ENDDO
     975                   DO  m = 1, surf_lsm_h%ns
     976                      i = surf_lsm_h%i(m)
     977                      j = surf_lsm_h%j(m)
     978                      tmp_2d(j,i) = surf_lsm_h%us(m)
     979                   ENDDO
     980                   DO  m = 1, surf_usm_h%ns
     981                      i = surf_usm_h%i(m)
     982                      j = surf_usm_h%j(m)
     983                      tmp_2d(j,i) = surf_usm_h%us(m)
     984                   ENDDO
     985
     986                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     987
     988                   DO  i = nxlg, nxrg
     989                      DO  j = nysg, nyng
     990                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
    869991                      ENDDO
    870992                   ENDDO
    … …  
    9121034             CASE ( 'z0*_xy' )        ! 2d-array
    9131035                IF ( av == 0 ) THEN
    914                    DO  i = nxlg, nxrg
    915                       DO  j = nysg, nyng
    916                          local_pf(i,j,nzb+1) =  z0(j,i)
    917                       ENDDO
    918                    ENDDO
     1036                   DO  m = 1, surf_def_h(0)%ns
     1037                      i = surf_def_h(0)%i(m)
     1038                      j = surf_def_h(0)%j(m)
     1039                      tmp_2d(j,i) = surf_def_h(0)%z0(m)
     1040                   ENDDO
     1041                   DO  m = 1, surf_lsm_h%ns
     1042                      i = surf_lsm_h%i(m)
     1043                      j = surf_lsm_h%j(m)
     1044                      tmp_2d(j,i) = surf_lsm_h%z0(m)
     1045                   ENDDO
     1046                   DO  m = 1, surf_usm_h%ns
     1047                      i = surf_usm_h%i(m)
     1048                      j = surf_usm_h%j(m)
     1049                      tmp_2d(j,i) = surf_usm_h%z0(m)
     1050                   ENDDO
     1051
     1052                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     1053
     1054                   DO  i = nxlg, nxrg
     1055                      DO  j = nysg, nyng
     1056                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
     1057                      ENDDO
     1058                   ENDDO
     1059
    9191060                ELSE
    9201061                   DO  i = nxlg, nxrg
    … …  
    9301071             CASE ( 'z0h*_xy' )        ! 2d-array
    9311072                IF ( av == 0 ) THEN
    932                    DO  i = nxlg, nxrg
    933                       DO  j = nysg, nyng
    934                          local_pf(i,j,nzb+1) =  z0h(j,i)
     1073                   DO  m = 1, surf_def_h(0)%ns
     1074                      i = surf_def_h(0)%i(m)
     1075                      j = surf_def_h(0)%j(m)
     1076                      tmp_2d(j,i) = surf_def_h(0)%z0h(m)
     1077                   ENDDO
     1078                   DO  m = 1, surf_lsm_h%ns
     1079                      i = surf_lsm_h%i(m)
     1080                      j = surf_lsm_h%j(m)
     1081                      tmp_2d(j,i) = surf_lsm_h%z0h(m)
     1082                   ENDDO
     1083                   DO  m = 1, surf_usm_h%ns
     1084                      i = surf_usm_h%i(m)
     1085                      j = surf_usm_h%j(m)
     1086                      tmp_2d(j,i) = surf_usm_h%z0h(m)
     1087                   ENDDO
     1088
     1089                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     1090
     1091                   DO  i = nxlg, nxrg
     1092                      DO  j = nysg, nyng
     1093                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
    9351094                      ENDDO
    9361095                   ENDDO
    … …  
    9481107             CASE ( 'z0q*_xy' )        ! 2d-array
    9491108                IF ( av == 0 ) THEN
    950                    DO  i = nxlg, nxrg
    951                       DO  j = nysg, nyng
    952                          local_pf(i,j,nzb+1) =  z0q(j,i)
     1109                   DO  m = 1, surf_def_h(0)%ns
     1110                      i = surf_def_h(0)%i(m)
     1111                      j = surf_def_h(0)%j(m)
     1112                      tmp_2d(j,i) = surf_def_h(0)%z0q(m)
     1113                   ENDDO
     1114                   DO  m = 1, surf_lsm_h%ns
     1115                      i = surf_lsm_h%i(m)
     1116                      j = surf_lsm_h%j(m)
     1117                      tmp_2d(j,i) = surf_lsm_h%z0q(m)
     1118                   ENDDO
     1119                   DO  m = 1, surf_usm_h%ns
     1120                      i = surf_usm_h%i(m)
     1121                      j = surf_usm_h%j(m)
     1122                      tmp_2d(j,i) = surf_usm_h%z0q(m)
     1123                   ENDDO
     1124
     1125                   CALL exchange_horiz_2d( tmp_2d, nbgp )
     1126
     1127                   DO  i = nxlg, nxrg
     1128                      DO  j = nysg, nyng
     1129                         local_pf(i,j,nzb+1) = tmp_2d(j,i)
    9531130                      ENDDO
    9541131                   ENDDO

  • palm/trunk/SOURCE/data_output_3d.f90

    r2210 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    152152
    153153    USE arrays_3d,                                                             &
    154         ONLY:  e, nr, p, pt, prr, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, tend, &
    155                u, v, vpt, w
     154        ONLY:  e, nr, p, pt, prr, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, &
     155               tend, u, v, vpt, w
    156156       
    157157    USE averaging
    … …  
    162162    USE control_parameters,                                                    &
    163163        ONLY:  cloud_physics, do3d, do3d_no, do3d_time_count, io_blocks,       &
    164                io_group, message_string, ntdim_3d, nz_do3d, psolver,           &
    165                simulated_time, time_since_reference_point, urban_surface,      &
    166                varnamelength
     164               io_group, land_surface, message_string, ntdim_3d, nz_do3d,      &
     165               psolver, simulated_time, time_since_reference_point,            &
     166               urban_surface, varnamelength
    167167       
    168168    USE cpulog,                                                                &
    … …  
    175175   
    176176    USE land_surface_model_mod,                                                &
    177         ONLY: land_surface, lsm_data_output_3d, nzb_soil, nzt_soil
     177        ONLY: lsm_data_output_3d, nzb_soil, nzt_soil
    178178
    179179#if defined( __netcdf )

  • palm/trunk/SOURCE/diffusion_e.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    129129
    130130       USE arrays_3d,                                                          &
    131            ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw,        &
     131           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, l_wall, tend, zu, zw,&
    132132                  drho_air, rho_air_zw
    133133           
    … …  
    140140           
    141141       USE indices,                                                            &
    142            ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
    143                   nzt
     142           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,    &
     143                  nzt, wall_flags_0
    144144           
    145145       USE kinds
    … …  
    151151           ONLY:  use_sgs_for_particles, wang_kernel
    152152
     153       USE surface_mod,                                                        &
     154          ONLY :  bc_h
     155
    153156       IMPLICIT NONE
    154157
    155        INTEGER(iwp) ::  i              !<
    156        INTEGER(iwp) ::  j              !<
    157        INTEGER(iwp) ::  k              !<
     158       INTEGER(iwp) ::  i              !< running index x direction
     159       INTEGER(iwp) ::  j              !< running index y direction
     160       INTEGER(iwp) ::  k              !< running index z direction
     161       INTEGER(iwp) ::  m              !< running index surface elements
     162 
    158163       REAL(wp)     ::  dvar_dz        !<
     164       REAL(wp)     ::  flag           !< flag to mask topography
    159165       REAL(wp)     ::  l_stable       !<
    160166       REAL(wp)     ::  var_reference  !<
    … …  
    177183          DO  i = nxl, nxr
    178184             DO  j = nys, nyn
    179                 DO  k = nzb_s_inner(j,i)+1, nzt
     185                DO  k = nzb+1, nzt
    180186!
    181187!--                Calculate the mixing length (for dissipation)
    … …  
    191197!--                Adjustment of the mixing length
    192198                   IF ( wall_adjustment )  THEN
    193                       l(k,j)  = MIN( wall_adjustment_factor *          &
    194                                      ( zu(k) - zw(nzb_s_inner(j,i)) ), &
     199                      l(k,j)  = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
    195200                                     l_grid(k), l_stable )
    196                       ll(k,j) = MIN( wall_adjustment_factor *          &
    197                                      ( zu(k) - zw(nzb_s_inner(j,i)) ), &
     201                      ll(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
    198202                                     l_grid(k) )
    199203                   ELSE
    … …  
    208212!--          Calculate the tendency terms
    209213             DO  j = nys, nyn
    210                 DO  k = nzb_s_inner(j,i)+1, nzt
    211 
    212                     dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
     214                DO  k = nzb+1, nzt
     215!
     216!--                Predetermine flag to mask topography
     217                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     218
     219                   dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
    213220                                       e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
    214221
    215                     tend(k,j,i) = tend(k,j,i)                                  &
     222                   tend(k,j,i) = tend(k,j,i)                                   &
    216223                                        + (                                    &
    217224                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
    218225                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
    219                                           ) * ddx2                             &
     226                                          ) * ddx2  * flag                     &
    220227                                        + (                                    &
    221228                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
    222229                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
    223                                           ) * ddy2                             &
     230                                          ) * ddy2  * flag                     &
    224231                                        + (                                    &
    225232               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
    … …  
    227234             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
    228235                                                             * rho_air_zw(k-1) &
    229                                           ) * ddzw(k) * drho_air(k)            &
    230                              - dissipation(k,j)
     236                                          ) * ddzw(k) * drho_air(k) * flag     &
     237                             - dissipation(k,j) * flag
    231238
    232239                ENDDO
    … …  
    239246                  collision_turbulence )  THEN
    240247                DO  j = nys, nyn
    241                    DO  k = nzb_s_inner(j,i)+1, nzt
    242                       diss(k,j,i) = dissipation(k,j)
     248                   DO  k = nzb+1, nzt
     249                      diss(k,j,i) = dissipation(k,j) *                         &
     250                                        MERGE( 1.0_wp, 0.0_wp,                 &
     251                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    243252                   ENDDO
    244253                ENDDO
    … …  
    251260          DO  i = nxl, nxr
    252261             DO  j = nys, nyn
    253                 DO  k = nzb_s_inner(j,i)+1, nzt
     262                DO  k = nzb+1, nzt
    254263!
    255264!--                Calculate the mixing length (for dissipation)
    … …  
    265274!--                Adjustment of the mixing length
    266275                   IF ( wall_adjustment )  THEN
    267                       l(k,j)  = MIN( wall_adjustment_factor *          &
    268                                      ( zu(k) - zw(nzb_s_inner(j,i)) ), &
     276                      l(k,j)  = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
    269277                                     l_grid(k), l_stable )
    270                       ll(k,j) = MIN( wall_adjustment_factor *          &
    271                                      ( zu(k) - zw(nzb_s_inner(j,i)) ), &
     278                      ll(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
    272279                                     l_grid(k) )
    273280                   ELSE
    … …  
    282289!--          Calculate the tendency terms
    283290             DO  j = nys, nyn
    284                 DO  k = nzb_s_inner(j,i)+1, nzt
    285 
    286                     dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
     291                DO  k = nzb+1, nzt
     292!
     293!--                Predetermine flag to mask topography
     294                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     295
     296                   dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) )   *&
    287297                                             e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
    288298
    289                     tend(k,j,i) = tend(k,j,i)                                  &
     299                   tend(k,j,i) = tend(k,j,i)                                   &
    290300                                        + (                                    &
    291301                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
    292302                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
    293                                           ) * ddx2                             &
     303                                          ) * ddx2  * flag                     &
    294304                                        + (                                    &
    295305                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
    296306                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
    297                                           ) * ddy2                             &
     307                                          ) * ddy2  * flag                     &
    298308                                        + (                                    &
    299309               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
    … …  
    301311             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
    302312                                                             * rho_air_zw(k-1) &
    303                                           ) * ddzw(k) * drho_air(k)            &
    304                              - dissipation(k,j)
     313                                          ) * ddzw(k) * drho_air(k) * flag     &
     314                             - dissipation(k,j) * flag
    305315
    306316                ENDDO
    … …  
    313323                  collision_turbulence )  THEN
    314324                DO  j = nys, nyn
    315                    DO  k = nzb_s_inner(j,i)+1, nzt
    316                       diss(k,j,i) = dissipation(k,j)
     325                   DO  k = nzb+1, nzt
     326                      diss(k,j,i) = dissipation(k,j) *                         &
     327                                        MERGE( 1.0_wp, 0.0_wp,                 &
     328                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    317329                   ENDDO
    318330                ENDDO
    … …  
    324336
    325337!
    326 !--    Boundary condition for dissipation
     338!--    Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
    327339       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  &
    328340            collision_turbulence )  THEN
    329           DO  i = nxl, nxr
    330              DO  j = nys, nyn
    331                 diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
    332              ENDDO
    333           ENDDO
     341!
     342!--       Upward facing surfaces
     343          DO  m = 1, bc_h(0)%ns
     344             i = bc_h(0)%i(m)           
     345             j = bc_h(0)%j(m)
     346             k = bc_h(0)%k(m)
     347             diss(k-1,j,i) = diss(k,j,i)
     348          ENDDO
     349!
     350!--       Downward facing surfaces
     351          DO  m = 1, bc_h(1)%ns
     352             i = bc_h(1)%i(m)           
     353             j = bc_h(1)%j(m)
     354             k = bc_h(1)%k(m)
     355             diss(k+1,j,i) = diss(k,j,i)
     356          ENDDO
     357
    334358       ENDIF
    335359
    … …  
    345369
    346370       USE arrays_3d,                                                          &
    347            ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw,        &
     371           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, l_wall, tend, zu, zw,&
    348372                  drho_air, rho_air_zw
    349373         
    … …  
    356380           
    357381       USE indices,                                                            &
    358            ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
     382           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    359383           
    360384       USE kinds
    … …  
    366390           ONLY:  use_sgs_for_particles, wang_kernel
    367391
     392       USE surface_mod,                                                        &
     393          ONLY :  bc_h
     394
    368395       IMPLICIT NONE
    369396
    370        INTEGER(iwp) ::  i              !<
    371        INTEGER(iwp) ::  j              !<
    372        INTEGER(iwp) ::  k              !<
     397       INTEGER(iwp) ::  i              !< running index x direction
     398       INTEGER(iwp) ::  j              !< running index y direction
     399       INTEGER(iwp) ::  k              !< running index z direction
     400       INTEGER(iwp) ::  m              !< running index surface elements
     401       INTEGER(iwp) ::  surf_e         !< End index of surface elements at (j,i)-gridpoint
     402       INTEGER(iwp) ::  surf_s         !< Start index of surface elements at (j,i)-gridpoint
     403
    373404       REAL(wp)     ::  dvar_dz        !<
     405       REAL(wp)     ::  flag           !< flag to mask topography
    374406       REAL(wp)     ::  l_stable       !<
    375407       REAL(wp)     ::  var_reference  !<
    … …  
    384416       REAL(wp), DIMENSION(nzb+1:nzt) ::  ll           !<
    385417
    386 
    387418!
    388419!--    Calculate the mixing length (for dissipation)
    389        DO  k = nzb_s_inner(j,i)+1, nzt
     420       DO  k = nzb+1, nzt
     421!
     422!--       Predetermine flag to mask topography
     423          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     424
    390425          dvar_dz = atmos_ocean_sign * &
    391426                    ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    … …  
    404439!--       Adjustment of the mixing length
    405440          IF ( wall_adjustment )  THEN
    406              l(k)  = MIN( wall_adjustment_factor *                     &
    407                           ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k), &
    408                           l_stable )
    409              ll(k) = MIN( wall_adjustment_factor *                     &
    410                           ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k) )
     441             l(k)  = MIN( wall_adjustment_factor * l_wall(k,j,i),              &
     442                          l_grid(k), l_stable )
     443             ll(k) = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) )
    411444          ELSE
    412445             l(k)  = MIN( l_grid(k), l_stable )
    … …  
    415448!
    416449!--       Calculate the tendency term
    417           dissipation(k) = ( 0.19_wp + 0.74_wp * l(k) / ll(k) ) * e(k,j,i) * &
     450          dissipation(k) = ( 0.19_wp + 0.74_wp * l(k) / ll(k) ) * e(k,j,i) *   &
    418451                                 SQRT( e(k,j,i) ) / l(k)
    419452
    420           tend(k,j,i) = tend(k,j,i)                                           &
    421                                        + (                                    &
    422                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
    423                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
    424                                          ) * ddx2                             &
    425                                        + (                                    &
    426                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
    427                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
    428                                          ) * ddy2                             &
    429                                        + (                                    &
    430               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
    431                                                             * rho_air_zw(k)   &
    432             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
    433                                                             * rho_air_zw(k-1) &
    434                                          ) * ddzw(k) * drho_air(k)            &
    435                                        - dissipation(k)
     453          tend(k,j,i) = tend(k,j,i)                                            &
     454                                       + (                                     &
     455                         ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )   &
     456                       - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )   &
     457                                         ) * ddx2  * flag                      &
     458                                       + (                                     &
     459                         ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )   &
     460                       - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )   &
     461                                         ) * ddy2  * flag                      &
     462                                       + (                                     &
     463              ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1)  &
     464                                                            * rho_air_zw(k)    &
     465            - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)    &
     466                                                            * rho_air_zw(k-1)  &
     467                                         ) * ddzw(k) * drho_air(k) * flag      &
     468                                       - dissipation(k) * flag
    436469
    437470       ENDDO
    … …  
    441474       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.                     &
    442475            collision_turbulence )  THEN
    443           DO  k = nzb_s_inner(j,i)+1, nzt
    444              diss(k,j,i) = dissipation(k)
    445           ENDDO
    446 !
    447 !--       Boundary condition for dissipation
    448           diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
     476          DO  k = nzb+1, nzt
     477             diss(k,j,i) = dissipation(k) *                                    &
     478                                        MERGE( 1.0_wp, 0.0_wp,                 &
     479                                               BTEST( wall_flags_0(k,j,i), 0 ) )
     480          ENDDO
     481!
     482!--       Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
     483!--       For each surface type determine start and end index (in case of elevated
     484!--       toopography several up/downward facing surfaces may exist.
     485          surf_s = bc_h(0)%start_index(j,i)   
     486          surf_e = bc_h(0)%end_index(j,i)   
     487          DO  m = surf_s, surf_e
     488             k             = bc_h(0)%k(m)
     489             diss(k-1,j,i) = diss(k,j,i)
     490          ENDDO
     491!
     492!--       Downward facing surfaces
     493          surf_s = bc_h(1)%start_index(j,i)   
     494          surf_e = bc_h(1)%end_index(j,i)   
     495          DO  m = surf_s, surf_e
     496             k             = bc_h(1)%k(m)
     497             diss(k+1,j,i) = diss(k,j,i)
     498          ENDDO
    449499       ENDIF
    450500

  • palm/trunk/SOURCE/diffusion_s.f90

    r2119 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    110110!> Call for all grid points
    111111!------------------------------------------------------------------------------!
    112     SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
     112    SUBROUTINE diffusion_s( s, s_flux_def_h_up,    s_flux_def_h_down,          &
     113                               s_flux_t,                                       &
     114                               s_flux_lsm_h_up,    s_flux_usm_h_up,            &
     115                               s_flux_def_v_north, s_flux_def_v_south,         &
     116                               s_flux_def_v_east,  s_flux_def_v_west,          &
     117                               s_flux_lsm_v_north, s_flux_lsm_v_south,         &
     118                               s_flux_lsm_v_east,  s_flux_lsm_v_west,          &
     119                               s_flux_usm_v_north, s_flux_usm_v_south,         &
     120                               s_flux_usm_v_east,  s_flux_usm_v_west )
    113121
    114122       USE arrays_3d,                                                          &
    … …  
    119127       
    120128       USE grid_variables,                                                     &
    121            ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     129           ONLY:  ddx2, ddy2
    122130       
    123131       USE indices,                                                            &
    124132           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
    125                   nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
     133                  nzt, wall_flags_0
    126134       
    127135       USE kinds
    128136
     137       USE surface_mod,                                                        &
     138           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     139                   surf_usm_v
     140
    129141       IMPLICIT NONE
    130142
    131        INTEGER(iwp) ::  i                 !<
    132        INTEGER(iwp) ::  j                 !<
    133        INTEGER(iwp) ::  k                 !<
    134        REAL(wp)     ::  wall_s_flux(0:4)  !<
    135        REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t !<
     143       INTEGER(iwp) ::  i             !< running index x direction
     144       INTEGER(iwp) ::  j             !< running index y direction
     145       INTEGER(iwp) ::  k             !< running index z direction
     146       INTEGER(iwp) ::  m             !< running index surface elements
     147       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     148       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
     149
     150       REAL(wp) ::  flag              !< flag to mask topography grid points
     151       REAL(wp) ::  mask_bottom       !< flag to mask vertical upward-facing surface     
     152       REAL(wp) ::  mask_east         !< flag to mask vertical surface east of the grid point
     153       REAL(wp) ::  mask_north        !< flag to mask vertical surface north of the grid point
     154       REAL(wp) ::  mask_south        !< flag to mask vertical surface south of the grid point
     155       REAL(wp) ::  mask_west         !< flag to mask vertical surface west of the grid point
     156       REAL(wp) ::  mask_top          !< flag to mask vertical downward-facing surface 
     157
     158       REAL(wp), DIMENSION(1:surf_def_v(0)%ns) ::  s_flux_def_v_north !< flux at north-facing vertical default-type surfaces
     159       REAL(wp), DIMENSION(1:surf_def_v(1)%ns) ::  s_flux_def_v_south !< flux at south-facing vertical default-type surfaces
     160       REAL(wp), DIMENSION(1:surf_def_v(2)%ns) ::  s_flux_def_v_east  !< flux at east-facing vertical default-type surfaces
     161       REAL(wp), DIMENSION(1:surf_def_v(3)%ns) ::  s_flux_def_v_west  !< flux at west-facing vertical default-type surfaces
     162       REAL(wp), DIMENSION(1:surf_def_h(0)%ns) ::  s_flux_def_h_up    !< flux at horizontal upward-facing default-type surfaces
     163       REAL(wp), DIMENSION(1:surf_def_h(1)%ns) ::  s_flux_def_h_down  !< flux at horizontal donwward-facing default-type surfaces
     164       REAL(wp), DIMENSION(1:surf_lsm_h%ns)    ::  s_flux_lsm_h_up    !< flux at horizontal upward-facing natural-type surfaces
     165       REAL(wp), DIMENSION(1:surf_lsm_v(0)%ns) ::  s_flux_lsm_v_north !< flux at north-facing vertical natural-type surfaces
     166       REAL(wp), DIMENSION(1:surf_lsm_v(1)%ns) ::  s_flux_lsm_v_south !< flux at south-facing vertical natural-type surfaces
     167       REAL(wp), DIMENSION(1:surf_lsm_v(2)%ns) ::  s_flux_lsm_v_east  !< flux at east-facing vertical natural-type surfaces
     168       REAL(wp), DIMENSION(1:surf_lsm_v(3)%ns) ::  s_flux_lsm_v_west  !< flux at west-facing vertical natural-type surfaces
     169       REAL(wp), DIMENSION(1:surf_usm_h%ns)    ::  s_flux_usm_h_up    !< flux at horizontal upward-facing urban-type surfaces
     170       REAL(wp), DIMENSION(1:surf_usm_v(0)%ns) ::  s_flux_usm_v_north !< flux at north-facing vertical urban-type surfaces
     171       REAL(wp), DIMENSION(1:surf_usm_v(1)%ns) ::  s_flux_usm_v_south !< flux at south-facing vertical urban-type surfaces
     172       REAL(wp), DIMENSION(1:surf_usm_v(2)%ns) ::  s_flux_usm_v_east  !< flux at east-facing vertical urban-type surfaces
     173       REAL(wp), DIMENSION(1:surf_usm_v(3)%ns) ::  s_flux_usm_v_west  !< flux at west-facing vertical urban-type surfaces
     174       REAL(wp), DIMENSION(1:surf_def_h(2)%ns) ::  s_flux_t           !< flux at model top
    136175#if defined( __nopointer )
    137176       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !<
    … …  
    144183!
    145184!--          Compute horizontal diffusion
    146              DO  k = nzb_s_outer(j,i)+1, nzt
     185             DO  k = nzb+1, nzt
     186!
     187!--             Predetermine flag to mask topography and wall-bounded grid points
     188                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     189!
     190!--             Predetermine flag to mask wall-bounded grid points, equivalent to
     191!--             former s_outer array
     192                mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i-1), 0 ) )
     193                mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i+1), 0 ) )
     194                mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 0 ) )
     195                mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 0 ) )
    147196
    148197                tend(k,j,i) = tend(k,j,i)                                      &
    149198                                          + 0.5_wp * (                         &
    150                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
    151                       - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
    152                                                      ) * ddx2                  &
     199                        mask_east  * ( kh(k,j,i) + kh(k,j,i+1) )               &
     200                                   * ( s(k,j,i+1) - s(k,j,i)   )               &
     201                      - mask_west  * ( kh(k,j,i) + kh(k,j,i-1) )               &
     202                                   * ( s(k,j,i)   - s(k,j,i-1) )               &
     203                                                     ) * ddx2 * flag           &
    153204                                          + 0.5_wp * (                         &
    154                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
    155                       - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    156                                                      ) * ddy2
    157              ENDDO
    158 
    159 !
    160 !--          Apply prescribed horizontal wall heatflux where necessary
    161              IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) &
    162                 )  THEN
    163                 DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
    164 
     205                        mask_north * ( kh(k,j,i) + kh(k,j+1,i) )               &
     206                                   * ( s(k,j+1,i) - s(k,j,i)   )               &
     207                      - mask_south * ( kh(k,j,i) + kh(k,j-1,i) )               &
     208                                   * ( s(k,j,i)   - s(k,j-1,i) )               &
     209                                                     ) * ddy2 * flag
     210             ENDDO
     211
     212!
     213!--          Apply prescribed horizontal wall heatflux where necessary. First,
     214!--          determine start and end index for respective (j,i)-index. Please
     215!--          note, in the flat case following loop will not be entered, as
     216!--          surf_s=1 and surf_e=0. Furtermore, note, no vertical natural surfaces
     217!--          so far.
     218!--          First, for default-type surfaces
     219!--          North-facing vertical default-type surfaces
     220             surf_s = surf_def_v(0)%start_index(j,i)
     221             surf_e = surf_def_v(0)%end_index(j,i)
     222             DO  m = surf_s, surf_e
     223                k           = surf_def_v(0)%k(m)
     224                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_north(m) * ddy2
     225             ENDDO
     226!
     227!--          South-facing vertical default-type surfaces
     228             surf_s = surf_def_v(1)%start_index(j,i)
     229             surf_e = surf_def_v(1)%end_index(j,i)
     230             DO  m = surf_s, surf_e
     231                k           = surf_def_v(1)%k(m)
     232                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_south(m) * ddy2
     233             ENDDO
     234!
     235!--          East-facing vertical default-type surfaces
     236             surf_s = surf_def_v(2)%start_index(j,i)
     237             surf_e = surf_def_v(2)%end_index(j,i)
     238             DO  m = surf_s, surf_e
     239                k           = surf_def_v(2)%k(m)
     240                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_east(m) * ddx2
     241             ENDDO
     242!
     243!--          West-facing vertical default-type surfaces
     244             surf_s = surf_def_v(3)%start_index(j,i)
     245             surf_e = surf_def_v(3)%end_index(j,i)
     246             DO  m = surf_s, surf_e
     247                k           = surf_def_v(3)%k(m)
     248                tend(k,j,i) = tend(k,j,i) + s_flux_def_v_west(m) * ddx2
     249             ENDDO
     250!
     251!--          Now, for natural-type surfaces.
     252!--          North-facing
     253             surf_s = surf_lsm_v(0)%start_index(j,i)
     254             surf_e = surf_lsm_v(0)%end_index(j,i)
     255             DO  m = surf_s, surf_e
     256                k           = surf_lsm_v(0)%k(m)
     257                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_north(m) * ddy2
     258             ENDDO
     259!
     260!--          South-facing
     261             surf_s = surf_lsm_v(1)%start_index(j,i)
     262             surf_e = surf_lsm_v(1)%end_index(j,i)
     263             DO  m = surf_s, surf_e
     264                k           = surf_lsm_v(1)%k(m)
     265                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_south(m) * ddy2
     266             ENDDO
     267!
     268!--          East-facing
     269             surf_s = surf_lsm_v(2)%start_index(j,i)
     270             surf_e = surf_lsm_v(2)%end_index(j,i)
     271             DO  m = surf_s, surf_e
     272                k           = surf_lsm_v(2)%k(m)
     273                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_east(m) * ddx2
     274             ENDDO
     275!
     276!--          West-facing
     277             surf_s = surf_lsm_v(3)%start_index(j,i)
     278             surf_e = surf_lsm_v(3)%end_index(j,i)
     279             DO  m = surf_s, surf_e
     280                k           = surf_lsm_v(3)%k(m)
     281                tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_west(m) * ddx2
     282             ENDDO
     283!
     284!--          Now, for urban-type surfaces.
     285!--          North-facing
     286             surf_s = surf_usm_v(0)%start_index(j,i)
     287             surf_e = surf_usm_v(0)%end_index(j,i)
     288             DO  m = surf_s, surf_e
     289                k           = surf_usm_v(0)%k(m)
     290                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_north(m) * ddy2
     291             ENDDO
     292!
     293!--          South-facing
     294             surf_s = surf_usm_v(1)%start_index(j,i)
     295             surf_e = surf_usm_v(1)%end_index(j,i)
     296             DO  m = surf_s, surf_e
     297                k           = surf_usm_v(1)%k(m)
     298                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_south(m) * ddy2
     299             ENDDO
     300!
     301!--          East-facing
     302             surf_s = surf_usm_v(2)%start_index(j,i)
     303             surf_e = surf_usm_v(2)%end_index(j,i)
     304             DO  m = surf_s, surf_e
     305                k           = surf_usm_v(2)%k(m)
     306                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_east(m) * ddx2
     307             ENDDO
     308!
     309!--          West-facing
     310             surf_s = surf_usm_v(3)%start_index(j,i)
     311             surf_e = surf_usm_v(3)%end_index(j,i)
     312             DO  m = surf_s, surf_e
     313                k           = surf_usm_v(3)%k(m)
     314                tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_west(m) * ddx2
     315             ENDDO
     316
     317!
     318!--          Compute vertical diffusion. In case that surface fluxes have been
     319!--          prescribed or computed at bottom and/or top, index k starts/ends at
     320!--          nzb+2 or nzt-1, respectively. Model top is also mask if top flux
     321!--          is given.
     322             DO  k = nzb+1, nzt
     323!
     324!--             Determine flags to mask topography below and above. Flag 0 is
     325!--             used to mask topography in general, and flag 8 implies
     326!--             information about use_surface_fluxes. Flag 9 is used to control
     327!--             flux at model top.
     328                mask_bottom = MERGE( 1.0_wp, 0.0_wp,                           &
     329                                     BTEST( wall_flags_0(k-1,j,i), 8 ) )
     330                mask_top    = MERGE( 1.0_wp, 0.0_wp,                           &
     331                                     BTEST( wall_flags_0(k+1,j,i), 8 ) ) *     &
     332                              MERGE( 1.0_wp, 0.0_wp,                           &
     333                                     BTEST( wall_flags_0(k+1,j,i), 9 ) )
     334                flag        = MERGE( 1.0_wp, 0.0_wp,                           &
     335                                     BTEST( wall_flags_0(k,j,i), 0 ) )
     336
     337                tend(k,j,i) = tend(k,j,i)                                      &
     338                                       + 0.5_wp * (                            &
     339                                      ( kh(k,j,i) + kh(k+1,j,i) ) *            &
     340                                          ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
     341                                                            * rho_air_zw(k)    &
     342                                                            * mask_top         &
     343                                    - ( kh(k,j,i) + kh(k-1,j,i) ) *            &
     344                                          ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
     345                                                            * rho_air_zw(k-1)  &
     346                                                            * mask_bottom      &
     347                                                  ) * ddzw(k) * drho_air(k)    &
     348                                                              * flag
     349             ENDDO
     350
     351!
     352!--          Vertical diffusion at horizontal walls.
     353             IF ( use_surface_fluxes )  THEN
     354!
     355!--             Default-type surfaces, upward-facing               
     356                surf_s = surf_def_h(0)%start_index(j,i)
     357                surf_e = surf_def_h(0)%end_index(j,i)
     358                DO  m = surf_s, surf_e
     359
     360                   k   = surf_def_h(0)%k(m)
     361                   tend(k,j,i) = tend(k,j,i) + s_flux_def_h_up(m)              &
     362                                       * ddzw(k) * drho_air(k)
     363
     364                ENDDO
     365!
     366!--             Default-type surfaces, downward-facing               
     367                surf_s = surf_def_h(1)%start_index(j,i)
     368                surf_e = surf_def_h(1)%end_index(j,i)
     369                DO  m = surf_s, surf_e
     370
     371                   k   = surf_def_h(1)%k(m)
     372                   tend(k,j,i) = tend(k,j,i) + s_flux_def_h_down(m)            &
     373                                       * ddzw(k) * drho_air(k)
     374
     375                ENDDO
     376!
     377!--             Natural-type surfaces, upward-facing 
     378                surf_s = surf_lsm_h%start_index(j,i)
     379                surf_e = surf_lsm_h%end_index(j,i)
     380                DO  m = surf_s, surf_e
     381
     382                   k   = surf_lsm_h%k(m)
     383                   tend(k,j,i) = tend(k,j,i) + s_flux_lsm_h_up(m)              &
     384                                       * ddzw(k) * drho_air(k)
     385
     386                ENDDO
     387!
     388!--             Urban-type surfaces, upward-facing     
     389                surf_s = surf_usm_h%start_index(j,i)
     390                surf_e = surf_usm_h%end_index(j,i)
     391                DO  m = surf_s, surf_e
     392
     393                   k   = surf_usm_h%k(m)
     394                   tend(k,j,i) = tend(k,j,i) + s_flux_usm_h_up(m)              &
     395                                       * ddzw(k) * drho_air(k)
     396
     397                ENDDO
     398
     399             ENDIF
     400!
     401!--          Vertical diffusion at the last computational gridpoint along z-direction
     402             IF ( use_top_fluxes )  THEN
     403                surf_s = surf_def_h(2)%start_index(j,i)
     404                surf_e = surf_def_h(2)%end_index(j,i)
     405                DO  m = surf_s, surf_e
     406
     407                   k   = surf_def_h(2)%k(m)
    165408                   tend(k,j,i) = tend(k,j,i)                                   &
    166                                                 + ( fwxp(j,i) * 0.5_wp *       &
    167                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
    168                         + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
    169                                                    -fwxm(j,i) * 0.5_wp *       &
    170                         ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
    171                         + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
    172                                                   ) * ddx2                     &
    173                                                 + ( fwyp(j,i) * 0.5_wp *       &
    174                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
    175                         + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
    176                                                    -fwym(j,i) * 0.5_wp *       &
    177                         ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    178                         + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
    179                                                   ) * ddy2
     409                           + ( - s_flux_t(m) ) * ddzw(k) * drho_air(k)
    180410                ENDDO
    181411             ENDIF
    182412
    183 !
    184 !--          Compute vertical diffusion. In case that surface fluxes have been
    185 !--          prescribed or computed at bottom and/or top, index k starts/ends at
    186 !--          nzb+2 or nzt-1, respectively.
    187              DO  k = nzb_diff_s_inner(j,i), nzt_diff
    188 
    189                 tend(k,j,i) = tend(k,j,i)                                      &
    190                                        + 0.5_wp * (                            &
    191             ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
    192                                                             * rho_air_zw(k)    &
    193           - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
    194                                                             * rho_air_zw(k-1)  &
    195                                                   ) * ddzw(k) * drho_air(k)
    196              ENDDO
    197 
    198 !
    199 !--          Vertical diffusion at the first computational gridpoint along
    200 !--          z-direction
    201              IF ( use_surface_fluxes )  THEN
    202 
    203                 k = nzb_s_inner(j,i)+1
    204 
    205                 tend(k,j,i) = tend(k,j,i)                                      &
    206                                        + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )  &
    207                                                   * ( s(k+1,j,i)-s(k,j,i) )    &
    208                                                   * ddzu(k+1)                  &
    209                                                   * rho_air_zw(k)              &
    210                                            + s_flux_b(j,i)                     &
    211                                          ) * ddzw(k) * drho_air(k)
    212 
    213              ENDIF
    214 
    215 !
    216 !--          Vertical diffusion at the last computational gridpoint along
    217 !--          z-direction
    218              IF ( use_top_fluxes )  THEN
    219 
    220                 k = nzt
    221 
    222                 tend(k,j,i) = tend(k,j,i)                                      &
    223                                        + ( - s_flux_t(j,i)                     &
    224                                            - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
    225                                                     * ( s(k,j,i)-s(k-1,j,i) )  &
    226                                                     * ddzu(k)                  &
    227                                                     * rho_air_zw(k-1)          &
    228                                          ) * ddzw(k) * drho_air(k)
    229 
    230              ENDIF
    231 
    232413          ENDDO
    233414       ENDDO
    234415
    235416    END SUBROUTINE diffusion_s
    236 
    237417
    238418!------------------------------------------------------------------------------!
    … …  
    241421!> Call for grid point i,j
    242422!------------------------------------------------------------------------------!
    243     SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
     423    SUBROUTINE diffusion_s_ij( i, j, s,                                        &
     424                               s_flux_def_h_up,    s_flux_def_h_down,          &
     425                               s_flux_t,                                       &
     426                               s_flux_lsm_h_up,    s_flux_usm_h_up,            &
     427                               s_flux_def_v_north, s_flux_def_v_south,         &
     428                               s_flux_def_v_east,  s_flux_def_v_west,          &
     429                               s_flux_lsm_v_north, s_flux_lsm_v_south,         &
     430                               s_flux_lsm_v_east,  s_flux_lsm_v_west,          &
     431                               s_flux_usm_v_north, s_flux_usm_v_south,         &
     432                               s_flux_usm_v_east,  s_flux_usm_v_west )       
    244433
    245434       USE arrays_3d,                                                          &
    … …  
    250439       
    251440       USE grid_variables,                                                     &
    252            ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     441           ONLY:  ddx2, ddy2
    253442       
    254443       USE indices,                                                            &
    255            ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_diff_s_inner, nzb_s_inner,  &
    256                   nzb_s_outer, nzt, nzt_diff
     444           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
    257445       
    258446       USE kinds
    259447
     448       USE surface_mod,                                                        &
     449           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     450                   surf_usm_v
     451
    260452       IMPLICIT NONE
    261453
    262        INTEGER(iwp) ::  i                 !<
    263        INTEGER(iwp) ::  j                 !<
    264        INTEGER(iwp) ::  k                 !<
    265        REAL(wp)     ::  wall_s_flux(0:4)  !<
    266        REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b  !<
    267        REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t  !<
     454       INTEGER(iwp) ::  i             !< running index x direction
     455       INTEGER(iwp) ::  j             !< running index y direction
     456       INTEGER(iwp) ::  k             !< running index z direction
     457       INTEGER(iwp) ::  m             !< running index surface elements
     458       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     459       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
     460
     461       REAL(wp) ::  flag              !< flag to mask topography grid points
     462       REAL(wp) ::  mask_bottom       !< flag to mask vertical upward-facing surface     
     463       REAL(wp) ::  mask_east         !< flag to mask vertical surface east of the grid point
     464       REAL(wp) ::  mask_north        !< flag to mask vertical surface north of the grid point
     465       REAL(wp) ::  mask_south        !< flag to mask vertical surface south of the grid point
     466       REAL(wp) ::  mask_west         !< flag to mask vertical surface west of the grid point
     467       REAL(wp) ::  mask_top          !< flag to mask vertical downward-facing surface 
     468
     469       REAL(wp), DIMENSION(1:surf_def_v(0)%ns) ::  s_flux_def_v_north !< flux at north-facing vertical default-type surfaces
     470       REAL(wp), DIMENSION(1:surf_def_v(1)%ns) ::  s_flux_def_v_south !< flux at south-facing vertical default-type surfaces
     471       REAL(wp), DIMENSION(1:surf_def_v(2)%ns) ::  s_flux_def_v_east  !< flux at east-facing vertical default-type surfaces
     472       REAL(wp), DIMENSION(1:surf_def_v(3)%ns) ::  s_flux_def_v_west  !< flux at west-facing vertical default-type surfaces
     473       REAL(wp), DIMENSION(1:surf_def_h(0)%ns) ::  s_flux_def_h_up    !< flux at horizontal upward-facing default-type surfaces
     474       REAL(wp), DIMENSION(1:surf_def_h(1)%ns) ::  s_flux_def_h_down  !< flux at horizontal donwward-facing default-type surfaces
     475       REAL(wp), DIMENSION(1:surf_lsm_h%ns)    ::  s_flux_lsm_h_up    !< flux at horizontal upward-facing natural-type surfaces
     476       REAL(wp), DIMENSION(1:surf_lsm_v(0)%ns) ::  s_flux_lsm_v_north !< flux at north-facing vertical urban-type surfaces
     477       REAL(wp), DIMENSION(1:surf_lsm_v(1)%ns) ::  s_flux_lsm_v_south !< flux at south-facing vertical urban-type surfaces
     478       REAL(wp), DIMENSION(1:surf_lsm_v(2)%ns) ::  s_flux_lsm_v_east  !< flux at east-facing vertical urban-type surfaces
     479       REAL(wp), DIMENSION(1:surf_lsm_v(3)%ns) ::  s_flux_lsm_v_west  !< flux at west-facing vertical urban-type surfaces
     480       REAL(wp), DIMENSION(1:surf_usm_h%ns)    ::  s_flux_usm_h_up    !< flux at horizontal upward-facing urban-type surfaces
     481       REAL(wp), DIMENSION(1:surf_usm_v(0)%ns) ::  s_flux_usm_v_north !< flux at north-facing vertical urban-type surfaces
     482       REAL(wp), DIMENSION(1:surf_usm_v(1)%ns) ::  s_flux_usm_v_south !< flux at south-facing vertical urban-type surfaces
     483       REAL(wp), DIMENSION(1:surf_usm_v(2)%ns) ::  s_flux_usm_v_east  !< flux at east-facing vertical urban-type surfaces
     484       REAL(wp), DIMENSION(1:surf_usm_v(3)%ns) ::  s_flux_usm_v_west  !< flux at west-facing vertical urban-type surfaces
     485       REAL(wp), DIMENSION(1:surf_def_h(2)%ns) ::  s_flux_t           !< flux at model top
    268486#if defined( __nopointer )
    269487       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s !<
    … …  
    274492!
    275493!--    Compute horizontal diffusion
    276        DO  k = nzb_s_outer(j,i)+1, nzt
     494       DO  k = nzb+1, nzt
     495!
     496!--       Predetermine flag to mask topography and wall-bounded grid points
     497          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     498!
     499!--       Predetermine flag to mask wall-bounded grid points, equivalent to
     500!--       former s_outer array
     501          mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i-1), 0 ) )
     502          mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i+1), 0 ) )
     503          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 0 ) )
     504          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 0 ) )
     505!
     506!--       Finally, determine flag to mask both topography itself as well
     507!--       as wall-bounded grid points, which will be treated further below
    277508
    278509          tend(k,j,i) = tend(k,j,i)                                            &
    279510                                          + 0.5_wp * (                         &
    280                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
    281                       - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
    282                                                      ) * ddx2                  &
     511                            mask_east  * ( kh(k,j,i) + kh(k,j,i+1) )           &
     512                                       * ( s(k,j,i+1) - s(k,j,i)   )           &
     513                          - mask_west  * ( kh(k,j,i) + kh(k,j,i-1) )           &
     514                                       * ( s(k,j,i)   - s(k,j,i-1) )           &
     515                                                     ) * ddx2 * flag           &
    283516                                          + 0.5_wp * (                         &
    284                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
    285                       - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    286                                                      ) * ddy2
    287        ENDDO
    288 
    289 !
    290 !--    Apply prescribed horizontal wall heatflux where necessary
    291        IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) )     &
    292        THEN
    293           DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
    294 
    295              tend(k,j,i) = tend(k,j,i)                                         &
    296                                                 + ( fwxp(j,i) * 0.5_wp *       &
    297                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
    298                         + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
    299                                                    -fwxm(j,i) * 0.5_wp *       &
    300                         ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
    301                         + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
    302                                                   ) * ddx2                     &
    303                                                 + ( fwyp(j,i) * 0.5_wp *       &
    304                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
    305                         + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
    306                                                    -fwym(j,i) * 0.5_wp *       &
    307                         ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    308                         + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
    309                                                   ) * ddy2
     517                            mask_north * ( kh(k,j,i) + kh(k,j+1,i) )           &
     518                                       * ( s(k,j+1,i) - s(k,j,i)   )           &
     519                          - mask_south * ( kh(k,j,i) + kh(k,j-1,i) )           &
     520                                       * ( s(k,j,i)  - s(k,j-1,i)  )           &
     521                                                     ) * ddy2 * flag
     522       ENDDO
     523
     524!
     525!--    Apply prescribed horizontal wall heatflux where necessary. First,
     526!--    determine start and end index for respective (j,i)-index. Please
     527!--    note, in the flat case following loops will not be entered, as
     528!--    surf_s=1 and surf_e=0. Furtermore, note, no vertical natural surfaces
     529!--    so far.
     530!--    First, for default-type surfaces
     531!--    North-facing vertical default-type surfaces
     532       surf_s = surf_def_v(0)%start_index(j,i)
     533       surf_e = surf_def_v(0)%end_index(j,i)
     534       DO  m = surf_s, surf_e
     535          k           = surf_def_v(0)%k(m)
     536          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_north(m) * ddy2
     537       ENDDO
     538!
     539!--    South-facing vertical default-type surfaces
     540       surf_s = surf_def_v(1)%start_index(j,i)
     541       surf_e = surf_def_v(1)%end_index(j,i)
     542       DO  m = surf_s, surf_e
     543          k           = surf_def_v(1)%k(m)
     544          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_south(m) * ddy2
     545       ENDDO
     546!
     547!--    East-facing vertical default-type surfaces
     548       surf_s = surf_def_v(2)%start_index(j,i)
     549       surf_e = surf_def_v(2)%end_index(j,i)
     550       DO  m = surf_s, surf_e
     551          k           = surf_def_v(2)%k(m)
     552          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_east(m) * ddx2
     553       ENDDO
     554!
     555!--    West-facing vertical default-type surfaces
     556       surf_s = surf_def_v(3)%start_index(j,i)
     557       surf_e = surf_def_v(3)%end_index(j,i)
     558       DO  m = surf_s, surf_e
     559          k           = surf_def_v(3)%k(m)
     560          tend(k,j,i) = tend(k,j,i) + s_flux_def_v_west(m) * ddx2
     561       ENDDO
     562!
     563!--    Now, for natural-type surfaces
     564!--    North-facing
     565       surf_s = surf_lsm_v(0)%start_index(j,i)
     566       surf_e = surf_lsm_v(0)%end_index(j,i)
     567       DO  m = surf_s, surf_e
     568          k           = surf_lsm_v(0)%k(m)
     569          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_north(m) * ddy2
     570       ENDDO
     571!
     572!--    South-facing
     573       surf_s = surf_lsm_v(1)%start_index(j,i)
     574       surf_e = surf_lsm_v(1)%end_index(j,i)
     575       DO  m = surf_s, surf_e
     576          k           = surf_lsm_v(1)%k(m)
     577          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_south(m) * ddy2
     578       ENDDO
     579!
     580!--    East-facing
     581       surf_s = surf_lsm_v(2)%start_index(j,i)
     582       surf_e = surf_lsm_v(2)%end_index(j,i)
     583       DO  m = surf_s, surf_e
     584          k           = surf_lsm_v(2)%k(m)
     585          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_east(m) * ddx2
     586       ENDDO
     587!
     588!--    West-facing
     589       surf_s = surf_lsm_v(3)%start_index(j,i)
     590       surf_e = surf_lsm_v(3)%end_index(j,i)
     591       DO  m = surf_s, surf_e
     592          k           = surf_lsm_v(3)%k(m)
     593          tend(k,j,i) = tend(k,j,i) + s_flux_lsm_v_west(m) * ddx2
     594       ENDDO
     595!
     596!--    Now, for urban-type surfaces
     597!--    North-facing
     598       surf_s = surf_usm_v(0)%start_index(j,i)
     599       surf_e = surf_usm_v(0)%end_index(j,i)
     600       DO  m = surf_s, surf_e
     601          k           = surf_usm_v(0)%k(m)
     602          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_north(m) * ddy2
     603       ENDDO
     604!
     605!--    South-facing
     606       surf_s = surf_usm_v(1)%start_index(j,i)
     607       surf_e = surf_usm_v(1)%end_index(j,i)
     608       DO  m = surf_s, surf_e
     609          k           = surf_usm_v(1)%k(m)
     610          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_south(m) * ddy2
     611       ENDDO
     612!
     613!--    East-facing
     614       surf_s = surf_usm_v(2)%start_index(j,i)
     615       surf_e = surf_usm_v(2)%end_index(j,i)
     616       DO  m = surf_s, surf_e
     617          k           = surf_usm_v(2)%k(m)
     618          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_east(m) * ddx2
     619       ENDDO
     620!
     621!--    West-facing
     622       surf_s = surf_usm_v(3)%start_index(j,i)
     623       surf_e = surf_usm_v(3)%end_index(j,i)
     624       DO  m = surf_s, surf_e
     625          k           = surf_usm_v(3)%k(m)
     626          tend(k,j,i) = tend(k,j,i) + s_flux_usm_v_west(m) * ddx2
     627       ENDDO
     628
     629
     630!
     631!--    Compute vertical diffusion. In case that surface fluxes have been
     632!--    prescribed or computed at bottom and/or top, index k starts/ends at
     633!--    nzb+2 or nzt-1, respectively. Model top is also mask if top flux
     634!--    is given.
     635       DO  k = nzb+1, nzt
     636!
     637!--       Determine flags to mask topography below and above. Flag 0 is
     638!--       used to mask topography in general, and flag 8 implies
     639!--       information about use_surface_fluxes. Flag 9 is used to control
     640!--       flux at model top.   
     641          mask_bottom = MERGE( 1.0_wp, 0.0_wp,                                 &
     642                               BTEST( wall_flags_0(k-1,j,i), 8 ) )
     643          mask_top    = MERGE( 1.0_wp, 0.0_wp,                                 &
     644                               BTEST( wall_flags_0(k+1,j,i), 8 ) )  *          &
     645                        MERGE( 1.0_wp, 0.0_wp,                                 &
     646                               BTEST( wall_flags_0(k+1,j,i), 9 ) )
     647          flag        = MERGE( 1.0_wp, 0.0_wp,                                 &
     648                               BTEST( wall_flags_0(k,j,i), 0 ) )
     649
     650          tend(k,j,i) = tend(k,j,i)                                            &
     651                                       + 0.5_wp * (                            &
     652                                      ( kh(k,j,i) + kh(k+1,j,i) ) *            &
     653                                          ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
     654                                                            * rho_air_zw(k)    &
     655                                                            * mask_top         &
     656                                    - ( kh(k,j,i) + kh(k-1,j,i) ) *            &
     657                                          ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
     658                                                            * rho_air_zw(k-1)  &
     659                                                            * mask_bottom      &
     660                                                  ) * ddzw(k) * drho_air(k)    &
     661                                                              * flag
     662       ENDDO
     663
     664!
     665!--    Vertical diffusion at horizontal walls.
     666!--    TO DO: Adjust for downward facing walls and mask already in main loop
     667       IF ( use_surface_fluxes )  THEN
     668!
     669!--       Default-type surfaces, upward-facing
     670          surf_s = surf_def_h(0)%start_index(j,i)
     671          surf_e = surf_def_h(0)%end_index(j,i)
     672          DO  m = surf_s, surf_e
     673
     674             k   = surf_def_h(0)%k(m)
     675
     676             tend(k,j,i) = tend(k,j,i) + s_flux_def_h_up(m)                    &
     677                                       * ddzw(k) * drho_air(k)
     678          ENDDO
     679!
     680!--       Default-type surfaces, downward-facing
     681          surf_s = surf_def_h(1)%start_index(j,i)
     682          surf_e = surf_def_h(1)%end_index(j,i)
     683          DO  m = surf_s, surf_e
     684
     685             k   = surf_def_h(1)%k(m)
     686
     687             tend(k,j,i) = tend(k,j,i) + s_flux_def_h_down(m)                  &
     688                                       * ddzw(k) * drho_air(k)
     689          ENDDO
     690!
     691!--       Natural-type surfaces, upward-facing
     692          surf_s = surf_lsm_h%start_index(j,i)
     693          surf_e = surf_lsm_h%end_index(j,i)
     694          DO  m = surf_s, surf_e
     695             k   = surf_lsm_h%k(m)
     696
     697             tend(k,j,i) = tend(k,j,i) + s_flux_lsm_h_up(m)                    &
     698                                       * ddzw(k) * drho_air(k)
     699          ENDDO
     700!
     701!--       Urban-type surfaces, upward-facing
     702          surf_s = surf_usm_h%start_index(j,i)
     703          surf_e = surf_usm_h%end_index(j,i)
     704          DO  m = surf_s, surf_e
     705             k   = surf_usm_h%k(m)
     706
     707             tend(k,j,i) = tend(k,j,i) + s_flux_usm_h_up(m)                    &
     708                                       * ddzw(k) * drho_air(k)
    310709          ENDDO
    311710       ENDIF
    312 
    313 !
    314 !--    Compute vertical diffusion. In case that surface fluxes have been
    315 !--    prescribed or computed at bottom and/or top, index k starts/ends at
    316 !--    nzb+2 or nzt-1, respectively.
    317        DO  k = nzb_diff_s_inner(j,i), nzt_diff
    318 
    319           tend(k,j,i) = tend(k,j,i)                                            &
    320                                        + 0.5_wp * (                            &
    321             ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
    322                                                             * rho_air_zw(k)    &
    323           - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
    324                                                             * rho_air_zw(k-1)  &
    325                                                   ) * ddzw(k) * drho_air(k)
    326        ENDDO
    327 
    328 !
    329 !--    Vertical diffusion at the first computational gridpoint along z-direction
    330        IF ( use_surface_fluxes )  THEN
    331 
    332           k = nzb_s_inner(j,i)+1
    333 
    334           tend(k,j,i) = tend(k,j,i) + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )     &
    335                                                * ( s(k+1,j,i)-s(k,j,i) )       &
    336                                                * ddzu(k+1)                     &
    337                                                * rho_air_zw(k)                 &
    338                                         + s_flux_b(j,i)                        &
    339                                       ) * ddzw(k) * drho_air(k)
    340 
    341        ENDIF
    342 
    343711!
    344712!--    Vertical diffusion at the last computational gridpoint along z-direction
    345713       IF ( use_top_fluxes )  THEN
    346 
    347           k = nzt
    348 
    349           tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                        &
    350                                       - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )     &
    351                                                * ( s(k,j,i)-s(k-1,j,i) )       &
    352                                                * ddzu(k)                       &
    353                                                * rho_air_zw(k-1)               &
    354                                       ) * ddzw(k) * drho_air(k)
    355 
     714          surf_s = surf_def_h(2)%start_index(j,i)
     715          surf_e = surf_def_h(2)%end_index(j,i)
     716          DO  m = surf_s, surf_e
     717
     718             k   = surf_def_h(2)%k(m)
     719             tend(k,j,i) = tend(k,j,i)                                         &
     720                           + ( - s_flux_t(m) ) * ddzw(k) * drho_air(k)
     721          ENDDO
    356722       ENDIF
    357723

  • palm/trunk/SOURCE/diffusion_u.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    9595 
    9696
    97     USE wall_fluxes_mod
    98 
    9997    PRIVATE
    10098    PUBLIC diffusion_u
    … …  
    116114
    117115       USE arrays_3d,                                                          &
    118            ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w,                  &
    119                   drho_air, rho_air_zw
     116           ONLY:  ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
    120117       
    121118       USE control_parameters,                                                 &
    122            ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
     119           ONLY:  constant_top_momentumflux, use_surface_fluxes,               &
    123120                  use_top_fluxes
    124121       
    125122       USE grid_variables,                                                     &
    126            ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
     123           ONLY:  ddx, ddx2, ddy
    127124       
    128125       USE indices,                                                            &
    129            ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_diff_u, nzb_u_inner,      &
    130                   nzb_u_outer, nzt, nzt_diff
    131        
     126           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
     127     
    132128       USE kinds
    133129
     130       USE surface_mod,                                                        &
     131           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     132                   surf_usm_v
     133
    134134       IMPLICIT NONE
    135135
    136        INTEGER(iwp) ::  i     !<
    137        INTEGER(iwp) ::  j     !<
    138        INTEGER(iwp) ::  k     !<
    139        REAL(wp)     ::  kmym  !<
    140        REAL(wp)     ::  kmyp  !<
    141        REAL(wp)     ::  kmzm  !<
    142        REAL(wp)     ::  kmzp  !<
    143 
    144        REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !<
    145 
    146 !
    147 !--    First calculate horizontal momentum flux u'v' at vertical walls,
    148 !--    if neccessary
    149        IF ( topography /= 'flat' )  THEN
    150           CALL wall_fluxes( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, nzb_u_inner, &
    151                             nzb_u_outer, wall_u )
    152        ENDIF
     136       INTEGER(iwp) ::  i             !< running index x direction
     137       INTEGER(iwp) ::  j             !< running index y direction
     138       INTEGER(iwp) ::  k             !< running index z direction
     139       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
     140       INTEGER(iwp) ::  m             !< running index surface elements
     141       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     142       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
     143
     144       REAL(wp)     ::  flag          !< flag to mask topography grid points
     145       REAL(wp)     ::  kmym          !<
     146       REAL(wp)     ::  kmyp          !<
     147       REAL(wp)     ::  kmzm          !<
     148       REAL(wp)     ::  kmzp          !<
     149       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface       
     150       REAL(wp)     ::  mask_north    !< flag to mask vertical surface north of the grid point
     151       REAL(wp)     ::  mask_south    !< flag to mask vertical surface south of the grid point
     152       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
     153
     154
    153155
    154156       DO  i = nxlu, nxr
    … …  
    156158!
    157159!--          Compute horizontal diffusion
    158              DO  k = nzb_u_outer(j,i)+1, nzt
     160             DO  k = nzb+1, nzt
     161!
     162!--             Predetermine flag to mask topography and wall-bounded grid points.
     163!--             It is sufficient to masked only north- and south-facing surfaces, which
     164!--             need special treatment for the u-component.
     165                flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   1 ) )
     166                mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
     167                mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
    159168!
    160169!--             Interpolate eddy diffusivities on staggered gridpoints
    … …  
    165174
    166175                tend(k,j,i) = tend(k,j,i)                                      &
    167                       & + 2.0_wp * (                                           &
    168                       &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
    169                       &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
    170                       &            ) * ddx2                                    &
    171                       & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
    172                       &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
    173                       &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
    174                       &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
    175                       &   ) * ddy
     176                        + 2.0_wp * (                                           &
     177                                  km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
     178                                - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
     179                                   ) * ddx2 * flag                             &
     180                        +          ( mask_north * (                            &
     181                            kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
     182                          + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
     183                                                  )                            &
     184                                   - mask_south * (                            &
     185                            kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     186                          + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
     187                                                  )                            &
     188                                   ) * ddy  * flag                             
    176189             ENDDO
    177 
    178 !
    179 !--          Wall functions at the north and south walls, respectively
    180              IF ( wall_u(j,i) /= 0.0_wp )  THEN
    181 
    182                 DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
    183                    kmyp = 0.25_wp *                                            &
    184                           ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
    185                    kmym = 0.25_wp *                                            &
    186                           ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    187 
    188                    tend(k,j,i) = tend(k,j,i)                                   &
    189                                  + 2.0_wp * (                                  &
    190                                        km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
    191                                      - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
    192                                             ) * ddx2                           &
    193                                  + (   fyp(j,i) * (                            &
    194                                   kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
    195                                 + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
    196                                                   )                            &
    197                                      - fym(j,i) * (                            &
    198                                   kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
    199                                 + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
    200                                                   )                            &
    201                                      + wall_u(j,i) * usvs(k,j,i)               &
    202                                    ) * ddy
    203                 ENDDO
    204              ENDIF
    205 
    206 !
    207 !--          Compute vertical diffusion. In case of simulating a Prandtl layer,
    208 !--          index k starts at nzb_u_inner+2.
    209              DO  k = nzb_diff_u(j,i), nzt_diff
     190!
     191!--          Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
     192!--          surfaces. Note, in the the flat case, loops won't be entered as
     193!--          start_index > end_index. Furtermore, note, no vertical natural surfaces
     194!--          so far.           
     195!--          Default-type surfaces
     196             DO  l = 0, 1
     197                surf_s = surf_def_v(l)%start_index(j,i)
     198                surf_e = surf_def_v(l)%end_index(j,i)
     199                DO  m = surf_s, surf_e
     200                   k           = surf_def_v(l)%k(m)
     201                   tend(k,j,i) = tend(k,j,i) +                                 &                   
     202                                    surf_def_v(l)%mom_flux_uv(m) * ddy
     203                ENDDO   
     204             ENDDO
     205!
     206!--          Natural-type surfaces
     207             DO  l = 0, 1
     208                surf_s = surf_lsm_v(l)%start_index(j,i)
     209                surf_e = surf_lsm_v(l)%end_index(j,i)
     210                DO  m = surf_s, surf_e
     211                   k           = surf_lsm_v(l)%k(m)
     212                   tend(k,j,i) = tend(k,j,i) +                                 &                   
     213                                    surf_lsm_v(l)%mom_flux_uv(m) * ddy
     214                ENDDO   
     215             ENDDO
     216!
     217!--          Urban-type surfaces
     218             DO  l = 0, 1
     219                surf_s = surf_usm_v(l)%start_index(j,i)
     220                surf_e = surf_usm_v(l)%end_index(j,i)
     221                DO  m = surf_s, surf_e
     222                   k           = surf_usm_v(l)%k(m)
     223                   tend(k,j,i) = tend(k,j,i) +                                 &                   
     224                                    surf_usm_v(l)%mom_flux_uv(m) * ddy
     225                ENDDO   
     226             ENDDO
     227
     228!
     229!--          Compute vertical diffusion. In case of simulating a surface layer,
     230!--          respective grid diffusive fluxes are masked (flag 8) within this
     231!--          loop, and added further below, else, simple gradient approach is
     232!--          applied. Model top is also mask if top-momentum flux is given.
     233             DO  k = nzb+1, nzt
     234!
     235!--             Determine flags to mask topography below and above. Flag 1 is
     236!--             used to mask topography in general, and flag 8 implies
     237!--             information about use_surface_fluxes. Flag 9 is used to control
     238!--             momentum flux at model top. 
     239                mask_bottom = MERGE( 1.0_wp, 0.0_wp,                           &
     240                                     BTEST( wall_flags_0(k-1,j,i), 8 ) )
     241                mask_top    = MERGE( 1.0_wp, 0.0_wp,                           &
     242                                     BTEST( wall_flags_0(k+1,j,i), 8 ) ) *     &
     243                              MERGE( 1.0_wp, 0.0_wp,                           &
     244                                     BTEST( wall_flags_0(k+1,j,i), 9 ) )
     245                flag        = MERGE( 1.0_wp, 0.0_wp,                           &
     246                                     BTEST( wall_flags_0(k,j,i), 1 ) )
    210247!
    211248!--             Interpolate eddy diffusivities on staggered gridpoints
    … …  
    216253
    217254                tend(k,j,i) = tend(k,j,i)                                      &
    218                       & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
    219                       &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
    220                       &            ) * rho_air_zw(k)                           &
    221                       &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
    222                       &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    223                       &            ) * rho_air_zw(k-1)                         &
    224                       &   ) * ddzw(k) * drho_air(k)
     255                        + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
     256                                   + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
     257                                   ) * rho_air_zw(k)   * mask_top              &
     258                          - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     259                                   + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
     260                                   ) * rho_air_zw(k-1) * mask_bottom           &
     261                          ) * ddzw(k) * drho_air(k) * flag
    225262             ENDDO
    226263
    … …  
    236273!--          because the vertical velocity is assumed to be zero at the surface.
    237274             IF ( use_surface_fluxes )  THEN
    238                 k = nzb_u_inner(j,i)+1
    239 !
    240 !--             Interpolate eddy diffusivities on staggered gridpoints
    241                 kmzp = 0.25_wp *                                               &
    242                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    243 
    244                 tend(k,j,i) = tend(k,j,i)                                      &
    245                       & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
    246                       &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
    247                       &            ) * rho_air_zw(k)                           &
    248                       &   - ( -usws(j,i) )                                     &
    249                       &   ) * ddzw(k) * drho_air(k)
     275!
     276!--             Default-type surfaces, upward-facing
     277                surf_s = surf_def_h(0)%start_index(j,i)
     278                surf_e = surf_def_h(0)%end_index(j,i)
     279                DO  m = surf_s, surf_e
     280
     281                   k   = surf_def_h(0)%k(m)
     282
     283                   tend(k,j,i) = tend(k,j,i)                                   &
     284                        + ( - ( - surf_def_h(0)%usws(m) )                      &
     285                          ) * ddzw(k) * drho_air(k)
     286                ENDDO
     287!
     288!--             Default-type surfaces, dowward-facing
     289                surf_s = surf_def_h(1)%start_index(j,i)
     290                surf_e = surf_def_h(1)%end_index(j,i)
     291                DO  m = surf_s, surf_e
     292
     293                   k   = surf_def_h(1)%k(m)
     294
     295                   tend(k,j,i) = tend(k,j,i)                                   &
     296                        + ( - surf_def_h(1)%usws(m)                            &
     297                          ) * ddzw(k) * drho_air(k)
     298                ENDDO
     299!
     300!--             Natural-type surfaces, upward-facing
     301                surf_s = surf_lsm_h%start_index(j,i)
     302                surf_e = surf_lsm_h%end_index(j,i)
     303                DO  m = surf_s, surf_e
     304
     305                   k   = surf_lsm_h%k(m)
     306
     307                   tend(k,j,i) = tend(k,j,i)                                   &
     308                        + ( - ( - surf_lsm_h%usws(m) )                         &
     309                          ) * ddzw(k) * drho_air(k)
     310                ENDDO
     311!
     312!--             Urban-type surfaces, upward-facing
     313                surf_s = surf_usm_h%start_index(j,i)
     314                surf_e = surf_usm_h%end_index(j,i)
     315                DO  m = surf_s, surf_e
     316
     317                   k   = surf_usm_h%k(m)
     318
     319                   tend(k,j,i) = tend(k,j,i)                                   &
     320                       + ( - ( - surf_usm_h%usws(m) )                          &
     321                         ) * ddzw(k) * drho_air(k)
     322                ENDDO
     323
    250324             ENDIF
    251 
    252 !
    253 !--          Vertical diffusion at the first gridpoint below the top boundary,
    254 !--          if the momentum flux at the top is prescribed by the user
    255              IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
    256                 k = nzt
    257 !
    258 !--             Interpolate eddy diffusivities on staggered gridpoints
    259                 kmzm = 0.25_wp *                                               &
    260                        ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    261 
    262                 tend(k,j,i) = tend(k,j,i)                                      &
    263                       & + ( ( -uswst(j,i) )                                    &
    264                       &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
    265                       &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    266                       &            ) * rho_air_zw(k-1)                         &
    267                       &   ) * ddzw(k) * drho_air(k)
     325!
     326!--          Add momentum flux at model top
     327             IF ( use_top_fluxes )  THEN
     328                surf_s = surf_def_h(2)%start_index(j,i)
     329                surf_e = surf_def_h(2)%end_index(j,i)
     330                DO  m = surf_s, surf_e
     331
     332                   k   = surf_def_h(2)%k(m)
     333
     334                   tend(k,j,i) = tend(k,j,i)                                   &
     335                        + ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
     336                ENDDO
    268337             ENDIF
    269338
    … …  
    282351
    283352       USE arrays_3d,                                                          &
    284            ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w,                  &
    285                   drho_air, rho_air_zw
     353           ONLY:  ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
    286354       
    287355       USE control_parameters,                                                 &
    288            ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
     356           ONLY:  constant_top_momentumflux, use_surface_fluxes,               &
     357                  use_top_fluxes
    289358       
    290359       USE grid_variables,                                                     &
    291            ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
     360           ONLY:  ddx, ddx2, ddy
    292361       
    293362       USE indices,                                                            &
    294            ONLY:  nzb, nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
    295        
     363           ONLY:  nzb, nzt, wall_flags_0
     364     
    296365       USE kinds
    297366
     367       USE surface_mod,                                                        &
     368           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     369                   surf_usm_v
     370
    298371       IMPLICIT NONE
    299372
    300        INTEGER(iwp) ::  i     !<
    301        INTEGER(iwp) ::  j     !<
    302        INTEGER(iwp) ::  k     !<
    303        REAL(wp)     ::  kmym  !<
    304        REAL(wp)     ::  kmyp  !<
    305        REAL(wp)     ::  kmzm  !<
    306        REAL(wp)     ::  kmzp  !<
    307 
    308        REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !<
    309 
    310 !
     373       INTEGER(iwp) ::  i             !< running index x direction
     374       INTEGER(iwp) ::  j             !< running index y direction
     375       INTEGER(iwp) ::  k             !< running index z direction
     376       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
     377       INTEGER(iwp) ::  m             !< running index surface elements
     378       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     379       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
     380
     381       REAL(wp)     ::  flag          !< flag to mask topography grid points
     382       REAL(wp)     ::  kmym          !<
     383       REAL(wp)     ::  kmyp          !<
     384       REAL(wp)     ::  kmzm          !<
     385       REAL(wp)     ::  kmzp          !<
     386       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface       
     387       REAL(wp)     ::  mask_north    !< flag to mask vertical surface north of the grid point
     388       REAL(wp)     ::  mask_south    !< flag to mask vertical surface south of the grid point
     389       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
     390!
    311391!--    Compute horizontal diffusion
    312        DO  k = nzb_u_outer(j,i)+1, nzt
     392       DO  k = nzb+1, nzt
     393!
     394!--       Predetermine flag to mask topography and wall-bounded grid points.
     395!--       It is sufficient to masked only north- and south-facing surfaces, which
     396!--       need special treatment for the u-component.
     397          flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   1 ) )
     398          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
     399          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
    313400!
    314401!--       Interpolate eddy diffusivities on staggered gridpoints
    … …  
    317404
    318405          tend(k,j,i) = tend(k,j,i)                                            &
    319                       & + 2.0_wp * (                                           &
    320                       &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
    321                       &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
    322                       &            ) * ddx2                                    &
    323                       & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
    324                       &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
    325                       &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
    326                       &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
    327                       &   ) * ddy
     406                       + 2.0_wp * (                                            &
     407                                 km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )     &
     408                               - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )     &
     409                                   ) * ddx2 * flag                             &
     410                                 + (                                           &
     411                  mask_north * kmyp * ( ( u(k,j+1,i) - u(k,j,i)     ) * ddy    &
     412                                      + ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx    &
     413                                      )                                        &
     414                - mask_south * kmym * ( ( u(k,j,i)   - u(k,j-1,i)   ) * ddy    &
     415                                      + ( v(k,j,i)   - v(k,j,i-1)   ) * ddx    &
     416                                      )                                        &
     417                                   ) * ddy  * flag
    328418       ENDDO
    329419
    330420!
    331 !--    Wall functions at the north and south walls, respectively
    332        IF ( wall_u(j,i) /= 0.0_wp )  THEN
    333 
    334 !
    335 !--       Calculate the horizontal momentum flux u'v'
    336           CALL wall_fluxes( i, j, nzb_u_inner(j,i)+1, nzb_u_outer(j,i),        &
    337                             usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
    338 
    339           DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
    340              kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
    341              kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    342 
    343              tend(k,j,i) = tend(k,j,i)                                         &
    344                                  + 2.0_wp * (                                  &
    345                                        km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
    346                                      - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
    347                                             ) * ddx2                           &
    348                                  + (   fyp(j,i) * (                            &
    349                                   kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
    350                                 + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
    351                                                   )                            &
    352                                      - fym(j,i) * (                            &
    353                                   kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
    354                                 + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
    355                                                   )                            &
    356                                      + wall_u(j,i) * usvs(k)                   &
    357                                    ) * ddy
    358           ENDDO
    359        ENDIF
    360 
    361 !
    362 !--    Compute vertical diffusion. In case of simulating a Prandtl layer,
    363 !--    index k starts at nzb_u_inner+2.
    364        DO  k = nzb_diff_u(j,i), nzt_diff
     421!--    Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
     422!--    surfaces. Note, in the the flat case, loops won't be entered as
     423!--    start_index > end_index. Furtermore, note, no vertical natural surfaces
     424!--    so far.           
     425!--    Default-type surfaces
     426       DO  l = 0, 1
     427          surf_s = surf_def_v(l)%start_index(j,i)
     428          surf_e = surf_def_v(l)%end_index(j,i)
     429          DO  m = surf_s, surf_e
     430             k           = surf_def_v(l)%k(m)
     431             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddy
     432          ENDDO   
     433       ENDDO
     434!
     435!--    Natural-type surfaces
     436       DO  l = 0, 1
     437          surf_s = surf_lsm_v(l)%start_index(j,i)
     438          surf_e = surf_lsm_v(l)%end_index(j,i)
     439          DO  m = surf_s, surf_e
     440             k           = surf_lsm_v(l)%k(m)
     441             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddy
     442          ENDDO   
     443       ENDDO
     444!
     445!--    Urban-type surfaces
     446       DO  l = 0, 1
     447          surf_s = surf_usm_v(l)%start_index(j,i)
     448          surf_e = surf_usm_v(l)%end_index(j,i)
     449          DO  m = surf_s, surf_e
     450             k           = surf_usm_v(l)%k(m)
     451             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddy
     452          ENDDO   
     453       ENDDO
     454!
     455!--    Compute vertical diffusion. In case of simulating a surface layer,
     456!--    respective grid diffusive fluxes are masked (flag 8) within this
     457!--    loop, and added further below, else, simple gradient approach is
     458!--    applied. Model top is also mask if top-momentum flux is given.
     459       DO  k = nzb+1, nzt
     460!
     461!--       Determine flags to mask topography below and above. Flag 1 is
     462!--       used to mask topography in general, and flag 8 implies
     463!--       information about use_surface_fluxes. Flag 9 is used to control
     464!--       momentum flux at model top.
     465          mask_bottom = MERGE( 1.0_wp, 0.0_wp,                                 &
     466                               BTEST( wall_flags_0(k-1,j,i), 8 ) )
     467          mask_top    = MERGE( 1.0_wp, 0.0_wp,                                 &
     468                               BTEST( wall_flags_0(k+1,j,i), 8 ) ) *           &
     469                        MERGE( 1.0_wp, 0.0_wp,                                 &
     470                               BTEST( wall_flags_0(k+1,j,i), 9 ) )
     471          flag        = MERGE( 1.0_wp, 0.0_wp,                                 &
     472                               BTEST( wall_flags_0(k,j,i), 1 ) )
    365473!
    366474!--       Interpolate eddy diffusivities on staggered gridpoints
    … …  
    369477
    370478          tend(k,j,i) = tend(k,j,i)                                            &
    371                       & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
    372                       &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
    373                       &            ) * rho_air_zw(k)                           &
    374                       &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
    375                       &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    376                       &            ) * rho_air_zw(k-1)                         &
    377                       &   ) * ddzw(k) * drho_air(k)
     479                        + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
     480                                   + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
     481                                   ) * rho_air_zw(k)   * mask_top              &
     482                          - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     483                                   + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
     484                                   ) * rho_air_zw(k-1) * mask_bottom           &
     485                          ) * ddzw(k) * drho_air(k) * flag
    378486       ENDDO
    379487
    380488!
    381 !--    Vertical diffusion at the first grid point above the surface, if the
     489!--    Vertical diffusion at the first surface grid points, if the
    382490!--    momentum flux at the bottom is given by the Prandtl law or if it is
    383491!--    prescribed by the user.
    … …  
    386494!--    other (LES) models showed that the values of the momentum flux becomes
    387495!--    too large in this case.
    388 !--    The term containing w(k-1,..) (see above equation) is removed here
    389 !--    because the vertical velocity is assumed to be zero at the surface.
    390496       IF ( use_surface_fluxes )  THEN
    391           k = nzb_u_inner(j,i)+1
    392 !
    393 !--       Interpolate eddy diffusivities on staggered gridpoints
    394           kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    395 
    396           tend(k,j,i) = tend(k,j,i)                                            &
    397                       & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
    398                       &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
    399                       &            ) * rho_air_zw(k)                           &
    400                       &   - ( -usws(j,i) )                                     &
    401                       &   ) * ddzw(k) * drho_air(k)
     497!
     498!--       Default-type surfaces, upward-facing
     499          surf_s = surf_def_h(0)%start_index(j,i)
     500          surf_e = surf_def_h(0)%end_index(j,i)
     501          DO  m = surf_s, surf_e
     502
     503             k   = surf_def_h(0)%k(m)
     504
     505             tend(k,j,i) = tend(k,j,i)                                         &
     506                        + ( - ( - surf_def_h(0)%usws(m) )                      &
     507                          ) * ddzw(k) * drho_air(k)
     508          ENDDO
     509!
     510!--       Default-type surfaces, dowward-facing (except for model-top fluxes)
     511          surf_s = surf_def_h(1)%start_index(j,i)
     512          surf_e = surf_def_h(1)%end_index(j,i)
     513          DO  m = surf_s, surf_e
     514
     515             k   = surf_def_h(1)%k(m)
     516
     517             tend(k,j,i) = tend(k,j,i)                                         &
     518                        + ( - surf_def_h(1)%usws(m)                            &
     519                          ) * ddzw(k) * drho_air(k)
     520          ENDDO
     521!
     522!--       Natural-type surfaces, upward-facing
     523          surf_s = surf_lsm_h%start_index(j,i)
     524          surf_e = surf_lsm_h%end_index(j,i)
     525          DO  m = surf_s, surf_e
     526
     527             k   = surf_lsm_h%k(m)
     528
     529             tend(k,j,i) = tend(k,j,i)                                         &
     530                        + ( - ( - surf_lsm_h%usws(m) )                         &
     531                          ) * ddzw(k) * drho_air(k)
     532          ENDDO
     533!
     534!--       Urban-type surfaces, upward-facing
     535          surf_s = surf_usm_h%start_index(j,i)
     536          surf_e = surf_usm_h%end_index(j,i)
     537          DO  m = surf_s, surf_e
     538
     539             k   = surf_usm_h%k(m)
     540
     541             tend(k,j,i) = tend(k,j,i)                                         &
     542                       + ( - ( - surf_usm_h%usws(m) )                          &
     543                         ) * ddzw(k) * drho_air(k)
     544          ENDDO
     545
    402546       ENDIF
    403 
    404 !
    405 !--    Vertical diffusion at the first gridpoint below the top boundary,
    406 !--    if the momentum flux at the top is prescribed by the user
    407        IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
    408           k = nzt
    409 !
    410 !--       Interpolate eddy diffusivities on staggered gridpoints
    411           kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    412 
    413           tend(k,j,i) = tend(k,j,i)                                            &
    414                       & + ( ( -uswst(j,i) )                                    &
    415                       &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
    416                       &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    417                       &            ) * rho_air_zw(k-1)                         &
    418                       &   ) * ddzw(k) * drho_air(k)
     547!
     548!--    Add momentum flux at model top
     549       IF ( use_top_fluxes )  THEN
     550          surf_s = surf_def_h(2)%start_index(j,i)
     551          surf_e = surf_def_h(2)%end_index(j,i)
     552          DO  m = surf_s, surf_e
     553
     554             k   = surf_def_h(2)%k(m)
     555
     556             tend(k,j,i) = tend(k,j,i)                                         &
     557                           + ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
     558          ENDDO
    419559       ENDIF
    420560
     561
    421562    END SUBROUTINE diffusion_u_ij
    422563

  • palm/trunk/SOURCE/diffusion_v.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    9090 
    9191
    92     USE wall_fluxes_mod
    93 
    9492    PRIVATE
    9593    PUBLIC diffusion_v
    … …  
    111109
    112110       USE arrays_3d,                                                          &
    113            ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w,                  &
    114                   drho_air, rho_air_zw
     111           ONLY:  ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
    115112       
    116113       USE control_parameters,                                                 &
    117            ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
     114           ONLY:  constant_top_momentumflux, use_surface_fluxes,               &
    118115                  use_top_fluxes
    119116       
    120117       USE grid_variables,                                                     &
    121            ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
     118           ONLY:  ddx, ddy, ddy2
    122119       
    123120       USE indices,                                                            &
    124            ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_diff_v, nzb_v_inner,      &
    125                   nzb_v_outer, nzt, nzt_diff
     121           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_0
    126122       
    127123       USE kinds
    128124
     125       USE surface_mod,                                                        &
     126           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     127                   surf_usm_v
     128
    129129       IMPLICIT NONE
    130130
    131        INTEGER(iwp) ::  i     !<
    132        INTEGER(iwp) ::  j     !<
    133        INTEGER(iwp) ::  k     !<
    134        REAL(wp)     ::  kmxm  !<
    135        REAL(wp)     ::  kmxp  !<
    136        REAL(wp)     ::  kmzm  !<
    137        REAL(wp)     ::  kmzp  !<
    138 
    139        REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !<
    140 
    141 !
    142 !--    First calculate horizontal momentum flux v'u' at vertical walls,
    143 !--    if neccessary
    144        IF ( topography /= 'flat' )  THEN
    145           CALL wall_fluxes( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, nzb_v_inner, &
    146                             nzb_v_outer, wall_v )
    147        ENDIF
     131       INTEGER(iwp) ::  i             !< running index x direction
     132       INTEGER(iwp) ::  j             !< running index y direction
     133       INTEGER(iwp) ::  k             !< running index z direction
     134       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
     135       INTEGER(iwp) ::  m             !< running index surface elements
     136       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     137       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
     138
     139       REAL(wp)     ::  flag          !< flag to mask topography grid points
     140       REAL(wp)     ::  kmxm          !<
     141       REAL(wp)     ::  kmxp          !<
     142       REAL(wp)     ::  kmzm          !<
     143       REAL(wp)     ::  kmzp          !<
     144       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface 
     145       REAL(wp)     ::  mask_east     !< flag to mask vertical surface south of the grid point
     146       REAL(wp)     ::  mask_west     !< flag to mask vertical surface north of the grid point
     147       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface     
    148148
    149149       DO  i = nxl, nxr
    … …  
    151151!
    152152!--          Compute horizontal diffusion
    153              DO  k = nzb_v_outer(j,i)+1, nzt
     153             DO  k = nzb+1, nzt
     154
     155!
     156!--             Predetermine flag to mask topography and wall-bounded grid points.
     157!--             It is sufficient to masked only east- and west-facing surfaces, which
     158!--             need special treatment for the v-component.
     159                flag      = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   2 ) )
     160                mask_east = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i+1), 2 ) )
     161                mask_west = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i-1), 2 ) )
    154162!
    155163!--             Interpolate eddy diffusivities on staggered gridpoints
    156                 kmxp = 0.25_wp * &
    157                        ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    158                 kmxm = 0.25_wp * &
    159                        ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    160 
    161                 tend(k,j,i) = tend(k,j,i)                                      &
    162                       & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
    163                       &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
    164                       &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
    165                       &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
    166                       &   ) * ddx                                              &
    167                       & + 2.0_wp * (                                           &
    168                       &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
    169                       &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
    170                       &            ) * ddy2
     164                kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
     165                kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
     166
     167                tend(k,j,i) = tend(k,j,i) +    (                             &
     168                          mask_east * kmxp * (                               &
     169                                 ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
     170                               + ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
     171                                             )                               &
     172                        - mask_west * kmxm * (                               &
     173                                 ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
     174                               + ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     175                                             )                               &
     176                                               ) * ddx  * flag               &
     177                                    + 2.0_wp * (                             &
     178                                  km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i)   )  &
     179                                - km(k,j-1,i) * ( v(k,j,i)   - v(k,j-1,i) )  &
     180                                               ) * ddy2 * flag
     181
    171182             ENDDO
    172183
    173184!
    174 !--          Wall functions at the left and right walls, respectively
    175              IF ( wall_v(j,i) /= 0.0_wp )  THEN
    176 
    177                 DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
    178                    kmxp = 0.25_wp *                                            &
    179                           ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    180                    kmxm = 0.25_wp *                                            &
    181                           ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    182                    
    183                    tend(k,j,i) = tend(k,j,i)                                   &
    184                                  + 2.0_wp * (                                  &
    185                                        km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
    186                                      - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
    187                                             ) * ddy2                           &
    188                                  + (   fxp(j,i) * (                            &
    189                                   kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
    190                                 + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
    191                                                   )                            &
    192                                      - fxm(j,i) * (                            &
    193                                   kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
    194                                 + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
    195                                                   )                            &
    196                                      + wall_v(j,i) * vsus(k,j,i)               &
    197                                    ) * ddx
    198                 ENDDO
    199              ENDIF
    200 
    201 !
    202 !--          Compute vertical diffusion. In case of simulating a Prandtl
    203 !--          layer, index k starts at nzb_v_inner+2.
    204              DO  k = nzb_diff_v(j,i), nzt_diff
     185!--          Add horizontal momentum flux v'u' at east- (l=2) and west-facing (l=3)
     186!--          surfaces. Note, in the the flat case, loops won't be entered as
     187!--          start_index > end_index. Furtermore, note, no vertical natural surfaces
     188!--          so far.           
     189!--          Default-type surfaces
     190             DO  l = 2, 3
     191                surf_s = surf_def_v(l)%start_index(j,i)
     192                surf_e = surf_def_v(l)%end_index(j,i)
     193                DO  m = surf_s, surf_e
     194                   k           = surf_def_v(l)%k(m)
     195                   tend(k,j,i) = tend(k,j,i) +                                 &
     196                                    surf_def_v(l)%mom_flux_uv(m) * ddx
     197                ENDDO   
     198             ENDDO
     199!
     200!--          Natural-type surfaces
     201             DO  l = 2, 3
     202                surf_s = surf_lsm_v(l)%start_index(j,i)
     203                surf_e = surf_lsm_v(l)%end_index(j,i)
     204                DO  m = surf_s, surf_e
     205                   k           = surf_lsm_v(l)%k(m)
     206                   tend(k,j,i) = tend(k,j,i) +                                 &
     207                                    surf_lsm_v(l)%mom_flux_uv(m) * ddx
     208                ENDDO   
     209             ENDDO
     210!
     211!--          Urban-type surfaces
     212             DO  l = 2, 3
     213                surf_s = surf_usm_v(l)%start_index(j,i)
     214                surf_e = surf_usm_v(l)%end_index(j,i)
     215                DO  m = surf_s, surf_e
     216                   k           = surf_usm_v(l)%k(m)
     217                   tend(k,j,i) = tend(k,j,i) +                                 &
     218                                    surf_usm_v(l)%mom_flux_uv(m) * ddx
     219                ENDDO   
     220             ENDDO
     221!
     222!--          Compute vertical diffusion. In case of simulating a surface layer,
     223!--          respective grid diffusive fluxes are masked (flag 10) within this
     224!--          loop, and added further below, else, simple gradient approach is
     225!--          applied. Model top is also mask if top-momentum flux is given.
     226             DO  k = nzb+1, nzt
     227!
     228!--             Determine flags to mask topography below and above. Flag 2 is
     229!--             used to mask topography in general, while flag 8 implies also
     230!--             information about use_surface_fluxes. Flag 9 is used to control
     231!--             momentum flux at model top. 
     232                mask_bottom = MERGE( 1.0_wp, 0.0_wp,                           &
     233                                     BTEST( wall_flags_0(k-1,j,i), 8 ) )
     234                mask_top    = MERGE( 1.0_wp, 0.0_wp,                           &
     235                                     BTEST( wall_flags_0(k+1,j,i), 8 ) ) *     &
     236                              MERGE( 1.0_wp, 0.0_wp,                           &
     237                                     BTEST( wall_flags_0(k+1,j,i), 9 ) )
     238                flag        = MERGE( 1.0_wp, 0.0_wp,                           &
     239                                     BTEST( wall_flags_0(k,j,i), 2 ) )
    205240!
    206241!--             Interpolate eddy diffusivities on staggered gridpoints
    … …  
    213248                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
    214249                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
    215                       &            ) * rho_air_zw(k)                           &
     250                      &            ) * rho_air_zw(k)   * mask_top              &
    216251                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
    217252                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
    218                       &            ) * rho_air_zw(k-1)                         &
    219                       &   ) * ddzw(k) * drho_air(k)
     253                      &            ) * rho_air_zw(k-1) * mask_bottom           &
     254                      &   ) * ddzw(k) * drho_air(k) * flag
    220255             ENDDO
    221256
    … …  
    228263!--          comparison with other (LES) models showed that the values of
    229264!--          the momentum flux becomes too large in this case.
    230 !--          The term containing w(k-1,..) (see above equation) is removed here
    231 !--          because the vertical velocity is assumed to be zero at the surface.
    232265             IF ( use_surface_fluxes )  THEN
    233                 k = nzb_v_inner(j,i)+1
    234 !
    235 !--             Interpolate eddy diffusivities on staggered gridpoints
    236                 kmzp = 0.25_wp *                                               &
    237                        ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    238 
    239                 tend(k,j,i) = tend(k,j,i)                                      &
    240                       & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)   &
    241                       &            + ( w(k,j,i)   - w(k,j-1,i) ) * ddy         &
    242                       &            ) * rho_air_zw(k)                           &
    243                       &   - ( -vsws(j,i) )                                     &
    244                       &   ) * ddzw(k) * drho_air(k)
     266!
     267!--             Default-type surfaces, upward-facing
     268                surf_s = surf_def_h(0)%start_index(j,i)
     269                surf_e = surf_def_h(0)%end_index(j,i)
     270                DO  m = surf_s, surf_e
     271                   k   = surf_def_h(0)%k(m)
     272
     273                   tend(k,j,i) = tend(k,j,i)                                   &
     274                        + ( - ( - surf_def_h(0)%vsws(m) )                      &
     275                          ) * ddzw(k) * drho_air(k)
     276                ENDDO
     277!
     278!--             Default-type surfaces, dowward-facing
     279                surf_s = surf_def_h(1)%start_index(j,i)
     280                surf_e = surf_def_h(1)%end_index(j,i)
     281                DO  m = surf_s, surf_e
     282                   k   = surf_def_h(1)%k(m)
     283
     284                   tend(k,j,i) = tend(k,j,i)                                   &
     285                        + ( - surf_def_h(1)%vsws(m)                            &
     286                          ) * ddzw(k) * drho_air(k)
     287                ENDDO
     288!
     289!--             Natural-type surfaces, upward-facing
     290                surf_s = surf_lsm_h%start_index(j,i)
     291                surf_e = surf_lsm_h%end_index(j,i)
     292                DO  m = surf_s, surf_e
     293                   k   = surf_lsm_h%k(m)
     294
     295                   tend(k,j,i) = tend(k,j,i)                                   &
     296                        + ( - ( - surf_lsm_h%vsws(m) )                         &
     297                          ) * ddzw(k) * drho_air(k)
     298
     299                ENDDO
     300!
     301!--             Urban-type surfaces, upward-facing
     302                surf_s = surf_usm_h%start_index(j,i)
     303                surf_e = surf_usm_h%end_index(j,i)
     304                DO  m = surf_s, surf_e
     305                   k   = surf_usm_h%k(m)
     306
     307                   tend(k,j,i) = tend(k,j,i)                                   &
     308                        + ( - ( - surf_usm_h%vsws(m) )                         &
     309                          ) * ddzw(k) * drho_air(k)
     310
     311                ENDDO
    245312             ENDIF
    246 
    247 !
    248 !--          Vertical diffusion at the first gridpoint below the top boundary,
    249 !--          if the momentum flux at the top is prescribed by the user
    250              IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
    251                 k = nzt
    252 !
    253 !--             Interpolate eddy diffusivities on staggered gridpoints
    254                 kmzm = 0.25_wp *                                               &
    255                        ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    256 
    257                 tend(k,j,i) = tend(k,j,i)                                      &
    258                       & + ( ( -vswst(j,i) )                                    &
    259                       &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
    260                       &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
    261                       &            ) * rho_air_zw(k-1)                         &
    262                       &   ) * ddzw(k) * drho_air(k)
     313!
     314!--          Add momentum flux at model top
     315             IF ( use_top_fluxes )  THEN
     316                surf_s = surf_def_h(2)%start_index(j,i)
     317                surf_e = surf_def_h(2)%end_index(j,i)
     318                DO  m = surf_s, surf_e
     319
     320                   k   = surf_def_h(2)%k(m)
     321
     322                   tend(k,j,i) = tend(k,j,i)                                   &
     323                           + ( - surf_def_h(2)%vsws(m) ) * ddzw(k) * drho_air(k)
     324                ENDDO
    263325             ENDIF
    264326
    … …  
    277339
    278340       USE arrays_3d,                                                          &
    279            ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w,                  &
    280                   drho_air, rho_air_zw
     341           ONLY:  ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
    281342       
    282343       USE control_parameters,                                                 &
    283            ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
     344           ONLY:  constant_top_momentumflux, use_surface_fluxes,               &
     345                  use_top_fluxes
    284346       
    285347       USE grid_variables,                                                     &
    286            ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
     348           ONLY:  ddx, ddy, ddy2
    287349       
    288350       USE indices,                                                            &
    289            ONLY:  nzb, nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
     351           ONLY:  nzb, nzt, wall_flags_0
    290352       
    291353       USE kinds
    292354
     355       USE surface_mod,                                                        &
     356           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     357                   surf_usm_v
     358
    293359       IMPLICIT NONE
    294360
    295        INTEGER(iwp) ::  i     !<
    296        INTEGER(iwp) ::  j     !<
    297        INTEGER(iwp) ::  k     !<
    298        REAL(wp)     ::  kmxm  !<
    299        REAL(wp)     ::  kmxp  !<
    300        REAL(wp)     ::  kmzm  !<
    301        REAL(wp)     ::  kmzp  !<
    302 
    303        REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !<
     361
     362       INTEGER(iwp) ::  i             !< running index x direction
     363       INTEGER(iwp) ::  j             !< running index y direction
     364       INTEGER(iwp) ::  k             !< running index z direction
     365       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
     366       INTEGER(iwp) ::  m             !< running index surface elements
     367       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     368       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
     369
     370       REAL(wp)     ::  flag          !< flag to mask topography grid points
     371       REAL(wp)     ::  kmxm          !<
     372       REAL(wp)     ::  kmxp          !<
     373       REAL(wp)     ::  kmzm          !<
     374       REAL(wp)     ::  kmzp          !<
     375       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface 
     376       REAL(wp)     ::  mask_east     !< flag to mask vertical surface south of the grid point
     377       REAL(wp)     ::  mask_west     !< flag to mask vertical surface north of the grid point
     378       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
    304379
    305380!
    306381!--    Compute horizontal diffusion
    307        DO  k = nzb_v_outer(j,i)+1, nzt
     382       DO  k = nzb+1, nzt
     383!
     384!--       Predetermine flag to mask topography and wall-bounded grid points.
     385!--       It is sufficient to masked only east- and west-facing surfaces, which
     386!--       need special treatment for the v-component.
     387          flag      = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   2 ) )
     388          mask_east = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i+1), 2 ) )
     389          mask_west = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i-1), 2 ) )
    308390!
    309391!--       Interpolate eddy diffusivities on staggered gridpoints
    … …  
    311393          kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    312394
    313           tend(k,j,i) = tend(k,j,i)                                            &
    314                       & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
    315                       &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
    316                       &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
    317                       &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
    318                       &   ) * ddx                                              &
    319                       & + 2.0_wp * (                                           &
    320                       &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
    321                       &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
    322                       &            ) * ddy2
     395          tend(k,j,i) = tend(k,j,i) +          (                             &
     396                          mask_east * kmxp * (                               &
     397                                 ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
     398                               + ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
     399                                             )                               &
     400                        - mask_west * kmxm * (                               &
     401                                 ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
     402                               + ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     403                                             )                               &
     404                                               ) * ddx  * flag               &
     405                                    + 2.0_wp * (                             &
     406                                  km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i)   )  &
     407                                - km(k,j-1,i) * ( v(k,j,i)   - v(k,j-1,i) )  &
     408                                               ) * ddy2 * flag
    323409       ENDDO
    324410
    325411!
    326 !--    Wall functions at the left and right walls, respectively
    327        IF ( wall_v(j,i) /= 0.0_wp )  THEN
    328 
    329 !
    330 !--       Calculate the horizontal momentum flux v'u'
    331           CALL wall_fluxes( i, j, nzb_v_inner(j,i)+1, nzb_v_outer(j,i),        &
    332                             vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
    333 
    334           DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
    335              kmxp = 0.25_wp *                                                  &
    336                     ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    337              kmxm = 0.25_wp *                                                  &
    338                     ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    339 
    340              tend(k,j,i) = tend(k,j,i)                                         &
    341                                  + 2.0_wp * (                                  &
    342                                        km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
    343                                      - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
    344                                             ) * ddy2                           &
    345                                  + (   fxp(j,i) * (                            &
    346                                   kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
    347                                 + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
    348                                                   )                            &
    349                                      - fxm(j,i) * (                            &
    350                                   kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
    351                                 + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
    352                                                   )                            &
    353                                      + wall_v(j,i) * vsus(k)                   &
    354                                    ) * ddx
    355           ENDDO
    356        ENDIF
    357 
    358 !
    359 !--    Compute vertical diffusion. In case of simulating a Prandtl layer,
    360 !--    index k starts at nzb_v_inner+2.
    361        DO  k = nzb_diff_v(j,i), nzt_diff
     412!--    Add horizontal momentum flux v'u' at east- (l=2) and west-facing (l=3)
     413!--    surfaces. Note, in the the flat case, loops won't be entered as
     414!--    start_index > end_index. Furtermore, note, no vertical natural surfaces
     415!--    so far.           
     416!--    Default-type surfaces
     417       DO  l = 2, 3
     418          surf_s = surf_def_v(l)%start_index(j,i)
     419          surf_e = surf_def_v(l)%end_index(j,i)
     420          DO  m = surf_s, surf_e
     421             k           = surf_def_v(l)%k(m)
     422             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddx
     423          ENDDO   
     424       ENDDO
     425!
     426!--    Natural-type surfaces
     427       DO  l = 2, 3
     428          surf_s = surf_lsm_v(l)%start_index(j,i)
     429          surf_e = surf_lsm_v(l)%end_index(j,i)
     430          DO  m = surf_s, surf_e
     431             k           = surf_lsm_v(l)%k(m)
     432             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddx
     433          ENDDO   
     434       ENDDO
     435!
     436!--    Urban-type surfaces
     437       DO  l = 2, 3
     438          surf_s = surf_usm_v(l)%start_index(j,i)
     439          surf_e = surf_usm_v(l)%end_index(j,i)
     440          DO  m = surf_s, surf_e
     441             k           = surf_usm_v(l)%k(m)
     442             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddx
     443          ENDDO   
     444       ENDDO
     445!
     446!--    Compute vertical diffusion. In case of simulating a surface layer,
     447!--    respective grid diffusive fluxes are masked (flag 8) within this
     448!--    loop, and added further below, else, simple gradient approach is
     449!--    applied. Model top is also mask if top-momentum flux is given.
     450       DO  k = nzb+1, nzt
     451!
     452!--       Determine flags to mask topography below and above. Flag 2 is
     453!--       used to mask topography in general, while flag 10 implies also
     454!--       information about use_surface_fluxes. Flag 9 is used to control
     455!--       momentum flux at model top. 
     456          mask_bottom = MERGE( 1.0_wp, 0.0_wp,                                 &
     457                               BTEST( wall_flags_0(k-1,j,i), 8 ) )
     458          mask_top    = MERGE( 1.0_wp, 0.0_wp,                                 &
     459                               BTEST( wall_flags_0(k+1,j,i), 8 ) ) *           &
     460                        MERGE( 1.0_wp, 0.0_wp,                                 &
     461                               BTEST( wall_flags_0(k+1,j,i), 9 ) )
     462          flag        = MERGE( 1.0_wp, 0.0_wp,                                 &
     463                               BTEST( wall_flags_0(k,j,i), 2 ) )
    362464!
    363465!--       Interpolate eddy diffusivities on staggered gridpoints
    … …  
    368470                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
    369471                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
    370                       &            ) * rho_air_zw(k)                           &
     472                      &            ) * rho_air_zw(k)   * mask_top              &
    371473                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
    372474                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
    373                       &            ) * rho_air_zw(k-1)                         &
    374                       &   ) * ddzw(k) * drho_air(k)
     475                      &            ) * rho_air_zw(k-1) * mask_bottom           &
     476                      &   ) * ddzw(k) * drho_air(k) * flag
    375477       ENDDO
    376478
    … …  
    383485!--    other (LES) models showed that the values of the momentum flux becomes
    384486!--    too large in this case.
    385 !--    The term containing w(k-1,..) (see above equation) is removed here
    386 !--    because the vertical velocity is assumed to be zero at the surface.
    387487       IF ( use_surface_fluxes )  THEN
    388           k = nzb_v_inner(j,i)+1
    389 !
    390 !--       Interpolate eddy diffusivities on staggered gridpoints
    391           kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    392 
    393           tend(k,j,i) = tend(k,j,i)                                            &
    394                       & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)   &
    395                       &            + ( w(k,j,i)   - w(k,j-1,i) ) * ddy         &
    396                       &            ) * rho_air_zw(k)                           &
    397                       &   - ( -vsws(j,i) )                                     &
    398                       &   ) * ddzw(k) * drho_air(k)
     488!
     489!--       Default-type surfaces, upward-facing
     490          surf_s = surf_def_h(0)%start_index(j,i)
     491          surf_e = surf_def_h(0)%end_index(j,i)
     492          DO  m = surf_s, surf_e
     493             k   = surf_def_h(0)%k(m)
     494
     495             tend(k,j,i) = tend(k,j,i)                                         &
     496                        + ( - ( - surf_def_h(0)%vsws(m) )                      &
     497                          ) * ddzw(k) * drho_air(k)
     498          ENDDO
     499!
     500!--       Default-type surfaces, dowward-facing
     501          surf_s = surf_def_h(1)%start_index(j,i)
     502          surf_e = surf_def_h(1)%end_index(j,i)
     503          DO  m = surf_s, surf_e
     504             k   = surf_def_h(1)%k(m)
     505
     506             tend(k,j,i) = tend(k,j,i)                                         &
     507                        + ( - surf_def_h(1)%vsws(m)                            &
     508                          ) * ddzw(k) * drho_air(k)
     509          ENDDO
     510!
     511!--       Natural-type surfaces, upward-facing
     512          surf_s = surf_lsm_h%start_index(j,i)
     513          surf_e = surf_lsm_h%end_index(j,i)
     514          DO  m = surf_s, surf_e
     515             k   = surf_lsm_h%k(m)
     516
     517             tend(k,j,i) = tend(k,j,i)                                         &
     518                        + ( - ( - surf_lsm_h%vsws(m) )                         &
     519                          ) * ddzw(k) * drho_air(k)
     520
     521          ENDDO
     522!
     523!--       Urban-type surfaces, upward-facing
     524          surf_s = surf_usm_h%start_index(j,i)
     525          surf_e = surf_usm_h%end_index(j,i)
     526          DO  m = surf_s, surf_e
     527             k   = surf_usm_h%k(m)
     528
     529             tend(k,j,i) = tend(k,j,i)                                         &
     530                        + ( - ( - surf_usm_h%vsws(m) )                         &
     531                          ) * ddzw(k) * drho_air(k)
     532
     533          ENDDO
    399534       ENDIF
    400 
    401 !
    402 !--    Vertical diffusion at the first gridpoint below the top boundary,
    403 !--    if the momentum flux at the top is prescribed by the user
    404        IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
    405           k = nzt
    406 !
    407 !--       Interpolate eddy diffusivities on staggered gridpoints
    408           kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    409 
    410           tend(k,j,i) = tend(k,j,i)                                            &
    411                       & + ( ( -vswst(j,i) )                                    &
    412                       &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
    413                       &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
    414                       &            ) * rho_air_zw(k-1)                         &
    415                       &   ) * ddzw(k) * drho_air(k)
     535!
     536!--    Add momentum flux at model top
     537       IF ( use_top_fluxes )  THEN
     538          surf_s = surf_def_h(2)%start_index(j,i)
     539          surf_e = surf_def_h(2)%end_index(j,i)
     540          DO  m = surf_s, surf_e
     541
     542             k   = surf_def_h(2)%k(m)
     543
     544             tend(k,j,i) = tend(k,j,i)                                         &
     545                           + ( - surf_def_h(2)%vsws(m) ) * ddzw(k) * drho_air(k)
     546          ENDDO
    416547       ENDIF
    417548

  • palm/trunk/SOURCE/diffusion_w.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    9797 
    9898
    99     USE wall_fluxes_mod,                                                       &
    100         ONLY :  wall_fluxes
    101 
    10299    PRIVATE
    103100    PUBLIC diffusion_w
    … …  
    125122           
    126123       USE grid_variables,                                                     &     
    127            ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     124           ONLY :  ddx, ddy
    128125           
    129126       USE indices,                                                            &           
    130            ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
     127           ONLY :  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    131128           
    132129       USE kinds
    133130
     131       USE surface_mod,                                                        &
     132           ONLY :  surf_def_v, surf_lsm_v, surf_usm_v
     133
    134134       IMPLICIT NONE
    135135
    136        INTEGER(iwp) ::  i     !<
    137        INTEGER(iwp) ::  j     !<
    138        INTEGER(iwp) ::  k     !<
     136       INTEGER(iwp) ::  i             !< running index x direction
     137       INTEGER(iwp) ::  j             !< running index y direction
     138       INTEGER(iwp) ::  k             !< running index z direction
     139       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
     140       INTEGER(iwp) ::  m             !< running index surface elements
     141       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     142       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
    139143       
    140        REAL(wp) ::  kmxm  !<
    141        REAL(wp) ::  kmxp  !<
    142        REAL(wp) ::  kmym  !<
    143        REAL(wp) ::  kmyp  !<
    144 
    145        REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
    146        REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
    147 
    148 
    149 !
    150 !--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
    151 !--    walls, if neccessary
    152        IF ( topography /= 'flat' )  THEN
    153           CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner,             &
    154                             nzb_w_outer, wall_w_x )
    155           CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner,             &
    156                             nzb_w_outer, wall_w_y )
    157        ENDIF
     144       REAL(wp) ::  flag              !< flag to mask topography grid points
     145       REAL(wp) ::  kmxm              !<
     146       REAL(wp) ::  kmxp              !<
     147       REAL(wp) ::  kmym              !<
     148       REAL(wp) ::  kmyp              !<
     149       REAL(wp) ::  mask_west         !< flag to mask vertical wall west of the grid point
     150       REAL(wp) ::  mask_east         !< flag to mask vertical wall east of the grid point
     151       REAL(wp) ::  mask_south        !< flag to mask vertical wall south of the grid point
     152       REAL(wp) ::  mask_north        !< flag to mask vertical wall north of the grid point
     153
     154
    158155
    159156       DO  i = nxl, nxr
    160157          DO  j = nys, nyn
    161              DO  k = nzb_w_outer(j,i)+1, nzt-1
     158             DO  k = nzb+1, nzt-1
     159!
     160!--             Predetermine flag to mask topography and wall-bounded grid points.
     161                flag       = MERGE( 1.0_wp, 0.0_wp,                            &
     162                                    BTEST( wall_flags_0(k,j,i),   3 ) )
     163                mask_east  = MERGE( 1.0_wp, 0.0_wp,                            &
     164                                    BTEST( wall_flags_0(k,j,i+1), 3 ) )
     165                mask_west  = MERGE( 1.0_wp, 0.0_wp,                            &
     166                                    BTEST( wall_flags_0(k,j,i-1), 3 ) )
     167                mask_south = MERGE( 1.0_wp, 0.0_wp,                            &
     168                                    BTEST( wall_flags_0(k,j-1,i), 3 ) )
     169                mask_north = MERGE( 1.0_wp, 0.0_wp,                            &
     170                                    BTEST( wall_flags_0(k,j+1,i), 3 ) )
    162171!
    163172!--             Interpolate eddy diffusivities on staggered gridpoints
    164                 kmxp = 0.25_wp *                                               &
    165                        ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
    166                 kmxm = 0.25_wp *                                               &
    167                        ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
    168                 kmyp = 0.25_wp *                                               &
    169                        ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
    170                 kmym = 0.25_wp *                                               &
    171                        ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
     173                kmxp = 0.25_wp * ( km(k,j,i)   +   km(k,j,i+1) +               &
     174                                   km(k+1,j,i) + km(k+1,j,i+1) )
     175                kmxm = 0.25_wp * ( km(k,j,i)   + km(k,j,i-1)   +               &
     176                                   km(k+1,j,i) + km(k+1,j,i-1) )
     177                kmyp = 0.25_wp * ( km(k,j,i)   + km(k+1,j,i)   +               &
     178                                   km(k,j+1,i) + km(k+1,j+1,i) )
     179                kmym = 0.25_wp * ( km(k,j,i)   + km(k+1,j,i)   +               &
     180                                   km(k,j-1,i) + km(k+1,j-1,i) )
    172181
    173182                tend(k,j,i) = tend(k,j,i)                                      &
    174                       & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
    175                       &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
    176                       &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
    177                       &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
    178                       &   ) * ddx                                              &
    179                       & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
    180                       &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
    181                       &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
    182                       &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
    183                       &   ) * ddy                                              &
    184                       & + 2.0_wp * (                                           &
    185                       &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
    186                       &               * rho_air(k+1)                           &
    187                       & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
    188                       &               * rho_air(k)                             &
    189                       &            ) * ddzu(k+1) * drho_air_zw(k)
    190              ENDDO
    191 
    192 !
    193 !--          Wall functions at all vertical walls, where necessary
    194              IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
    195 
    196                 DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
    197 !
    198 !--                Interpolate eddy diffusivities on staggered gridpoints
    199                    kmxp = 0.25_wp *                                            &
    200                           ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
    201                    kmxm = 0.25_wp *                                            &
    202                           ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
    203                    kmyp = 0.25_wp *                                            &
    204                           ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
    205                    kmym = 0.25_wp *                                            &
    206                           ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    207 
    208                    tend(k,j,i) = tend(k,j,i)                                   &
    209                                  + (   fwxp(j,i) * (                           &
    210                             kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
    211                           + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
    212                                                    )                           &
    213                                      - fwxm(j,i) * (                           &
    214                             kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
    215                           + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
    216                                                    )                           &
    217                                      + wall_w_x(j,i) * wsus(k,j,i)             &
    218                                    ) * ddx                                     &
    219                                  + (   fwyp(j,i) * (                           &
    220                             kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
    221                           + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
    222                                                    )                           &
    223                                      - fwym(j,i) * (                           &
    224                             kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
    225                           + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
    226                                                    )                           &
    227                                      + wall_w_y(j,i) * wsvs(k,j,i)             &
    228                                    ) * ddy                                     &
    229                                  + 2.0_wp * (                                  &
    230                            km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
    231                                        * rho_air(k+1)                          &
    232                          - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
    233                                        * rho_air(k)                            &
    234                                             ) * ddzu(k+1) * drho_air_zw(k)
    235                 ENDDO
    236              ENDIF
     183                       + ( mask_east *  kmxp * (                               &
     184                                   ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
     185                                 + ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
     186                                               )                               &
     187                         - mask_west * kmxm *  (                               &
     188                                   ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
     189                                 + ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
     190                                               )                               &
     191                         ) * ddx                                 * flag        &
     192                       + ( mask_north * kmyp * (                               &
     193                                   ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
     194                                 + ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
     195                                               )                               &
     196                         - mask_south * kmym * (                               &
     197                                   ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
     198                                 + ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
     199                                               )                               &
     200                         ) * ddy                                 * flag        &
     201                       + 2.0_wp * (                                            &
     202                         km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) )   * ddzw(k+1) &
     203                                     * rho_air(k+1)                            &
     204                       - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)   &
     205                                     * rho_air(k)                              &
     206                                  ) * ddzu(k+1) * drho_air_zw(k) * flag
     207             ENDDO
     208
     209!
     210!--          Add horizontal momentum flux v'w' at north- (l=0) and south-facing (l=1)
     211!--          surfaces. Note, in the the flat case, loops won't be entered as
     212!--          start_index > end_index. Furtermore, note, no vertical natural surfaces
     213!--          so far.           
     214!--          Default-type surfaces
     215             DO  l = 0, 1
     216                surf_s = surf_def_v(l)%start_index(j,i)
     217                surf_e = surf_def_v(l)%end_index(j,i)
     218                DO  m = surf_s, surf_e
     219                   k           = surf_def_v(l)%k(m)
     220                   tend(k,j,i) = tend(k,j,i) +                                 &
     221                                     surf_def_v(l)%mom_flux_w(m) * ddy
     222                ENDDO   
     223             ENDDO
     224!
     225!--          Natural-type surfaces
     226             DO  l = 0, 1
     227                surf_s = surf_lsm_v(l)%start_index(j,i)
     228                surf_e = surf_lsm_v(l)%end_index(j,i)
     229                DO  m = surf_s, surf_e
     230                   k           = surf_lsm_v(l)%k(m)
     231                   tend(k,j,i) = tend(k,j,i) +                                 &
     232                                     surf_lsm_v(l)%mom_flux_w(m) * ddy
     233                ENDDO   
     234             ENDDO
     235!
     236!--          Urban-type surfaces
     237             DO  l = 0, 1
     238                surf_s = surf_usm_v(l)%start_index(j,i)
     239                surf_e = surf_usm_v(l)%end_index(j,i)
     240                DO  m = surf_s, surf_e
     241                   k           = surf_usm_v(l)%k(m)
     242                   tend(k,j,i) = tend(k,j,i) +                                 &
     243                                     surf_usm_v(l)%mom_flux_w(m) * ddy
     244                ENDDO   
     245             ENDDO
     246!
     247!--          Add horizontal momentum flux u'w' at east- (l=2) and west-facing (l=3)
     248!--          surface.
     249!--          Default-type surfaces
     250             DO  l = 2, 3
     251                surf_s = surf_def_v(l)%start_index(j,i)
     252                surf_e = surf_def_v(l)%end_index(j,i)
     253                DO  m = surf_s, surf_e
     254                   k           = surf_def_v(l)%k(m)
     255                   tend(k,j,i) = tend(k,j,i) +                                 &
     256                                     surf_def_v(l)%mom_flux_w(m) * ddx
     257                ENDDO   
     258             ENDDO
     259!
     260!--          Natural-type surfaces
     261             DO  l = 2, 3
     262                surf_s = surf_lsm_v(l)%start_index(j,i)
     263                surf_e = surf_lsm_v(l)%end_index(j,i)
     264                DO  m = surf_s, surf_e
     265                   k           = surf_lsm_v(l)%k(m)
     266                   tend(k,j,i) = tend(k,j,i) +                                 &
     267                                     surf_lsm_v(l)%mom_flux_w(m) * ddx
     268                ENDDO   
     269             ENDDO
     270!
     271!--          Urban-type surfaces
     272             DO  l = 2, 3
     273                surf_s = surf_usm_v(l)%start_index(j,i)
     274                surf_e = surf_usm_v(l)%end_index(j,i)
     275                DO  m = surf_s, surf_e
     276                   k           = surf_usm_v(l)%k(m)
     277                   tend(k,j,i) = tend(k,j,i) +                                 &
     278                                     surf_usm_v(l)%mom_flux_w(m) * ddx
     279                ENDDO   
     280             ENDDO
    237281
    238282          ENDDO
    … …  
    256300           
    257301       USE grid_variables,                                                     &     
    258            ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     302           ONLY :  ddx, ddy
    259303           
    260304       USE indices,                                                            &           
    261            ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
     305           ONLY :  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    262306           
    263307       USE kinds
    264308
     309       USE surface_mod,                                                        &
     310           ONLY :  surf_def_v, surf_lsm_v, surf_usm_v
     311
    265312       IMPLICIT NONE
    266313
    267        INTEGER(iwp) ::  i     !<
    268        INTEGER(iwp) ::  j     !<
    269        INTEGER(iwp) ::  k     !<
     314
     315       INTEGER(iwp) ::  i             !< running index x direction
     316       INTEGER(iwp) ::  j             !< running index y direction
     317       INTEGER(iwp) ::  k             !< running index z direction
     318       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
     319       INTEGER(iwp) ::  m             !< running index surface elements
     320       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     321       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
    270322       
    271        REAL(wp) ::  kmxm  !<
    272        REAL(wp) ::  kmxp  !<
    273        REAL(wp) ::  kmym  !<
    274        REAL(wp) ::  kmyp  !<
    275 
    276        REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus
    277        REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs
    278 
    279 
    280        DO  k = nzb_w_outer(j,i)+1, nzt-1
     323       REAL(wp) ::  flag              !< flag to mask topography grid points
     324       REAL(wp) ::  kmxm              !<
     325       REAL(wp) ::  kmxp              !<
     326       REAL(wp) ::  kmym              !<
     327       REAL(wp) ::  kmyp              !<
     328       REAL(wp) ::  mask_west         !< flag to mask vertical wall west of the grid point
     329       REAL(wp) ::  mask_east         !< flag to mask vertical wall east of the grid point
     330       REAL(wp) ::  mask_south        !< flag to mask vertical wall south of the grid point
     331       REAL(wp) ::  mask_north        !< flag to mask vertical wall north of the grid point
     332
     333
     334       DO  k = nzb+1, nzt-1
     335!
     336!--       Predetermine flag to mask topography and wall-bounded grid points.
     337          flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   3 ) )
     338          mask_east  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i+1), 3 ) )
     339          mask_west  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i-1), 3 ) )
     340          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 3 ) )
     341          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 3 ) )
    281342!
    282343!--       Interpolate eddy diffusivities on staggered gridpoints
    … …  
    287348
    288349          tend(k,j,i) = tend(k,j,i)                                            &
    289                       & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
    290                       &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
    291                       &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
    292                       &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
    293                       &   ) * ddx                                              &
    294                       & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
    295                       &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
    296                       &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
    297                       &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
    298                       &   ) * ddy                                              &
    299                       & + 2.0_wp * (                                           &
    300                       &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
    301                       &               * rho_air(k+1)                           &
    302                       & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
    303                       &               * rho_air(k)                             &
    304                       &            ) * ddzu(k+1) * drho_air_zw(k)
    305        ENDDO
    306 
    307 !
    308 !--    Wall functions at all vertical walls, where necessary
    309        IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
    310 
    311 !
    312 !--       Calculate the horizontal momentum fluxes w'u' and/or w'v'
    313           IF ( wall_w_x(j,i) /= 0.0_wp )  THEN
    314              CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
    315                                wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
    316           ELSE
    317              wsus = 0.0_wp
    318           ENDIF
    319 
    320           IF ( wall_w_y(j,i) /= 0.0_wp )  THEN
    321              CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
    322                                wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
    323           ELSE
    324              wsvs = 0.0_wp
    325           ENDIF
    326 
    327           DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
    328 !
    329 !--          Interpolate eddy diffusivities on staggered gridpoints
    330              kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
    331              kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
    332              kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
    333              kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    334 
    335              tend(k,j,i) = tend(k,j,i)                                         &
    336                                  + (   fwxp(j,i) * (                           &
    337                             kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
    338                           + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
    339                                                    )                           &
    340                                      - fwxm(j,i) * (                           &
    341                             kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
    342                           + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
    343                                                    )                           &
    344                                      + wall_w_x(j,i) * wsus(k)                 &
    345                                    ) * ddx                                     &
    346                                  + (   fwyp(j,i) * (                           &
    347                             kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
    348                           + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
    349                                                    )                           &
    350                                      - fwym(j,i) * (                           &
    351                             kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
    352                           + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
    353                                                    )                           &
    354                                      + wall_w_y(j,i) * wsvs(k)                 &
    355                                    ) * ddy                                     &
    356                                  + 2.0_wp * (                                  &
    357                            km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
    358                                        * rho_air(k+1)                          &
    359                          - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
    360                                        * rho_air(k)                            &
    361                                             ) * ddzu(k+1) * drho_air_zw(k)
    362           ENDDO
    363        ENDIF
     350                       + ( mask_east *  kmxp * (                               &
     351                                   ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
     352                                 + ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
     353                                               )                               &
     354                         - mask_west * kmxm *  (                               &
     355                                   ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
     356                                 + ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
     357                                               )                               &
     358                         ) * ddx                                 * flag        &
     359                       + ( mask_north * kmyp * (                               &
     360                                   ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
     361                                 + ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
     362                                               )                               &
     363                         - mask_south * kmym * (                               &
     364                                   ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
     365                                 + ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
     366                                               )                               &
     367                         ) * ddy                                 * flag        &
     368                       + 2.0_wp * (                                            &
     369                         km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)   &
     370                                     * rho_air(k+1)                            &
     371                       - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)   &
     372                                     * rho_air(k)                              &
     373                                  ) * ddzu(k+1) * drho_air_zw(k) * flag
     374       ENDDO
     375!
     376!--    Add horizontal momentum flux v'w' at north- (l=0) and south-facing (l=1)
     377!--    surfaces. Note, in the the flat case, loops won't be entered as
     378!--    start_index > end_index. Furtermore, note, no vertical natural surfaces
     379!--    so far.           
     380!--    Default-type surfaces
     381       DO  l = 0, 1
     382          surf_s = surf_def_v(l)%start_index(j,i)
     383          surf_e = surf_def_v(l)%end_index(j,i)
     384          DO  m = surf_s, surf_e
     385             k           = surf_def_v(l)%k(m)
     386             tend(k,j,i) = tend(k,j,i) +                                       &
     387                                     surf_def_v(l)%mom_flux_w(m) * ddy
     388          ENDDO   
     389       ENDDO
     390!
     391!--    Natural-type surfaces
     392       DO  l = 0, 1
     393          surf_s = surf_lsm_v(l)%start_index(j,i)
     394          surf_e = surf_lsm_v(l)%end_index(j,i)
     395          DO  m = surf_s, surf_e
     396             k           = surf_lsm_v(l)%k(m)
     397             tend(k,j,i) = tend(k,j,i) +                                       &
     398                                     surf_lsm_v(l)%mom_flux_w(m) * ddy
     399          ENDDO   
     400       ENDDO
     401!
     402!--    Urban-type surfaces
     403       DO  l = 0, 1
     404          surf_s = surf_usm_v(l)%start_index(j,i)
     405          surf_e = surf_usm_v(l)%end_index(j,i)
     406          DO  m = surf_s, surf_e
     407             k           = surf_usm_v(l)%k(m)
     408             tend(k,j,i) = tend(k,j,i) +                                       &
     409                                     surf_usm_v(l)%mom_flux_w(m) * ddy
     410          ENDDO   
     411       ENDDO
     412!
     413!--    Add horizontal momentum flux u'w' at east- (l=2) and west-facing (l=3)
     414!--    surfaces.
     415!--    Default-type surfaces
     416       DO  l = 2, 3
     417          surf_s = surf_def_v(l)%start_index(j,i)
     418          surf_e = surf_def_v(l)%end_index(j,i)
     419          DO  m = surf_s, surf_e
     420             k           = surf_def_v(l)%k(m)
     421             tend(k,j,i) = tend(k,j,i) +                                       &
     422                                     surf_def_v(l)%mom_flux_w(m) * ddx
     423          ENDDO   
     424       ENDDO
     425!
     426!--    Natural-type surfaces
     427       DO  l = 2, 3
     428          surf_s = surf_lsm_v(l)%start_index(j,i)
     429          surf_e = surf_lsm_v(l)%end_index(j,i)
     430          DO  m = surf_s, surf_e
     431             k           = surf_lsm_v(l)%k(m)
     432             tend(k,j,i) = tend(k,j,i) +                                       &
     433                                     surf_lsm_v(l)%mom_flux_w(m) * ddx
     434          ENDDO   
     435       ENDDO
     436!
     437!--    Urban-type surfaces
     438       DO  l = 2, 3
     439          surf_s = surf_usm_v(l)%start_index(j,i)
     440          surf_e = surf_usm_v(l)%end_index(j,i)
     441          DO  m = surf_s, surf_e
     442             k           = surf_usm_v(l)%k(m)
     443             tend(k,j,i) = tend(k,j,i) +                                       &
     444                                     surf_usm_v(l)%mom_flux_w(m) * ddx
     445          ENDDO   
     446       ENDDO
     447
    364448
    365449    END SUBROUTINE diffusion_w_ij

  • palm/trunk/SOURCE/diffusivities.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    8989    USE control_parameters,                                                    &
    9090        ONLY:  atmos_ocean_sign, e_min, g, outflow_l, outflow_n, outflow_r,    &
    91                 outflow_s, use_single_reference_value, wall_adjustment
     91               outflow_s, use_single_reference_value, wall_adjustment,         &
     92               wall_adjustment_factor
    9293               
    9394    USE indices,                                                               &
    94         ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb_s_inner, nzb, nzt
     95        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt,           &
     96               wall_flags_0
    9597    USE kinds
    9698   
    … …  
    100102        ONLY :  rmask, statistic_regions, sums_l_l
    101103
     104    USE surface_mod,                                                           &
     105        ONLY :  bc_h
     106
    102107    IMPLICIT NONE
    103108
    … …  
    105110    INTEGER(iwp) ::  j                   !<
    106111    INTEGER(iwp) ::  k                   !<
     112    INTEGER(iwp) ::  m                   !<
    107113    INTEGER(iwp) ::  omp_get_thread_num  !<
    108114    INTEGER(iwp) ::  sr                  !<
    … …  
    110116
    111117    REAL(wp)     ::  dvar_dz             !<
     118    REAL(wp)     ::  flag                !<
    112119    REAL(wp)     ::  l                   !<
    113120    REAL(wp)     ::  ll                  !<
    … …  
    129136!
    130137!-- Compute the turbulent diffusion coefficient for momentum
    131     !$OMP PARALLEL PRIVATE (dvar_dz,i,j,k,l,ll,l_stable,sqrt_e,sr,tn)
     138    !$OMP PARALLEL PRIVATE (dvar_dz,i,j,k,l,ll,l_stable,sqrt_e,sr,tn,flag)
    132139!$  tn = omp_get_thread_num()
    133140
    … …  
    138145       DO  i = nxlg, nxrg
    139146          DO  j = nysg, nyng
    140              DO  k = 1, nzt
    141                 IF ( k > nzb_s_inner(j,i) )  THEN
    142                    e(k,j,i) = MAX( e(k,j,i), e_min )
    143                 ENDIF
     147             DO  k = nzb+1, nzt
     148                e(k,j,i) = MAX( e(k,j,i), e_min ) *                            &
     149                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    144150             ENDDO
    145151          ENDDO
    … …  
    150156    DO  i = nxlg, nxrg
    151157       DO  j = nysg, nyng
    152           DO  k = 1, nzt
    153 
    154              IF ( k > nzb_s_inner(j,i) )  THEN
    155 
    156                 sqrt_e = SQRT( e(k,j,i) )
    157 !
    158 !--             Determine the mixing length
    159                 dvar_dz = atmos_ocean_sign * &  ! inverse effect of pt/rho_ocean gradient
    160                           ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    161                 IF ( dvar_dz > 0.0_wp ) THEN
    162                    IF ( use_single_reference_value )  THEN
    163                       l_stable = 0.76_wp * sqrt_e /                            &
    164                                     SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    165                    ELSE
    166                       l_stable = 0.76_wp * sqrt_e /                            &
    167                                     SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    168                    ENDIF
     158          DO  k = nzb+1, nzt
     159
     160             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     161
     162             sqrt_e = SQRT( e(k,j,i) )
     163!
     164!--          Determine the mixing length
     165             dvar_dz = atmos_ocean_sign * &  ! inverse effect of pt/rho_ocean gradient
     166                       ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
     167             IF ( dvar_dz > 0.0_wp ) THEN
     168                IF ( use_single_reference_value )  THEN
     169                   l_stable = 0.76_wp * sqrt_e /                               &
     170                                 SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    169171                ELSE
    170                    l_stable = l_grid(k)
     172                   l_stable = 0.76_wp * sqrt_e /                               &
     173                                 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    171174                ENDIF
    172 !
    173 !--             Adjustment of the mixing length
    174                 IF ( wall_adjustment )  THEN
    175                    l  = MIN( l_wall(k,j,i), l_grid(k), l_stable )
    176                    ll = MIN( l_wall(k,j,i), l_grid(k) )
    177                 ELSE
    178                    l  = MIN( l_grid(k), l_stable )
    179                    ll = l_grid(k)
    180                 ENDIF
    181 
    182       !
    183       !--       Compute diffusion coefficients for momentum and heat
    184                 km(k,j,i) = 0.1_wp * l * sqrt_e
    185                 kh(k,j,i) = ( 1.0_wp + 2.0_wp * l / ll ) * km(k,j,i)
    186 
    187 !
    188 !--             Summation for averaged profile (cf. flow_statistics)
    189                 DO  sr = 0, statistic_regions
    190                    sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l * rmask(j,i,sr)
    191                 ENDDO
    192 
     175             ELSE
     176                l_stable = l_grid(k)
    193177             ENDIF
     178!
     179!--          Adjustment of the mixing length
     180             IF ( wall_adjustment )  THEN
     181                l  = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k),   &
     182                          l_stable )
     183                ll = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) )
     184             ELSE
     185                l  = MIN( l_grid(k), l_stable )
     186                ll = l_grid(k)
     187             ENDIF
     188!
     189!--          Compute diffusion coefficients for momentum and heat
     190             km(k,j,i) = 0.1_wp * l * sqrt_e                      * flag
     191             kh(k,j,i) = ( 1.0_wp + 2.0_wp * l / ll ) * km(k,j,i) * flag
     192     
     193
     194!
     195!--          Summation for averaged profile (cf. flow_statistics)
     196             DO  sr = 0, statistic_regions
     197                sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l * rmask(j,i,sr)      &
     198                                                          * flag
     199             ENDDO
    194200
    195201          ENDDO
    … …  
    202208
    203209!
    204 !-- Set vertical boundary values (Neumann conditions both at bottom and top).
     210!-- Set vertical boundary values (Neumann conditions both at upward- and
     211!-- downward facing walls. To set wall-boundary values, the surface data type
     212!-- is applied.
    205213!-- Horizontal boundary conditions at vertical walls are not set because
    206 !-- so far vertical walls require usage of a Prandtl-layer where the boundary
    207 !-- values of the diffusivities are not needed
     214!-- so far vertical surfaces require usage of a Prandtl-layer where the boundary
     215!-- values of the diffusivities are not needed.
     216!-- Upward-facing
     217    !$OMP PARALLEL DO PRIVATE( i, j, k )
     218    DO  m = 1, bc_h(0)%ns
     219       i = bc_h(0)%i(m)           
     220       j = bc_h(0)%j(m)
     221       k = bc_h(0)%k(m)
     222       km(k-1,j,i) = km(k,j,i)
     223       kh(k-1,j,i) = kh(k,j,i)
     224    ENDDO
     225!
     226!-- Downward facing surfaces
     227    !$OMP PARALLEL DO PRIVATE( i, j, k )
     228    DO  m = 1, bc_h(1)%ns
     229       i = bc_h(1)%i(m)           
     230       j = bc_h(1)%j(m)
     231       k = bc_h(1)%k(m)
     232       km(k+1,j,i) = km(k,j,i)
     233       kh(k+1,j,i) = kh(k,j,i)
     234    ENDDO
     235!
     236!-- Model top
    208237    !$OMP PARALLEL DO
    209238    DO  i = nxlg, nxrg
    210239       DO  j = nysg, nyng
    211           km(nzb_s_inner(j,i),j,i) = km(nzb_s_inner(j,i)+1,j,i)
    212           km(nzt+1,j,i)            = km(nzt,j,i)
    213           kh(nzb_s_inner(j,i),j,i) = kh(nzb_s_inner(j,i)+1,j,i)
    214           kh(nzt+1,j,i)            = kh(nzt,j,i)
     240          km(nzt+1,j,i) = km(nzt,j,i)
     241          kh(nzt+1,j,i) = kh(nzt,j,i)
    215242       ENDDO
    216243    ENDDO
     244
    217245
    218246!

  • palm/trunk/SOURCE/disturb_field.f90

    r2173 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Modify referenced parameter for disturb_field, instead of nzb_uv_inner, pass
     23! character to identify the respective grid (u- or v-grid).
     24! Set perturbations within topography to zero using flags.
    2325!
    2426! Former revisions:
    … …  
    7072!> order in every case. The perturbation range is steered by dist_range.
    7173!------------------------------------------------------------------------------!
    72  SUBROUTINE disturb_field( nzb_uv_inner, dist1, field )
     74 SUBROUTINE disturb_field( var_char, dist1, field )
    7375 
    7476
    75     USE control_parameters,   &
     77    USE control_parameters,                                                    &
    7678        ONLY:  dist_nxl, dist_nxr, dist_nyn, dist_nys, dist_range,             &
    7779               disturbance_amplitude, disturbance_created,                     &
    … …  
    8385       
    8486    USE indices,                                                               &
    85         ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     87        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, &
     88               nzt, wall_flags_0
    8689       
    8790    USE kinds
    … …  
    9699    IMPLICIT NONE
    97100
    98     INTEGER(iwp) ::  i  !<
    99     INTEGER(iwp) ::  j  !<
    100     INTEGER(iwp) ::  k  !<
    101    
    102     INTEGER(iwp) ::  nzb_uv_inner(nysg:nyng,nxlg:nxrg) !<
     101    CHARACTER (LEN = *) ::  var_char !< flag to distinguish betwenn u- and v-component
     102
     103    INTEGER(iwp) ::  flag_nr !< number of respective flag for u- or v-grid
     104    INTEGER(iwp) ::  i       !< index variable
     105    INTEGER(iwp) ::  j       !< index variable
     106    INTEGER(iwp) ::  k       !< index variable
    103107
    104108    REAL(wp) ::  randomnumber  !<
    … …  
    111115
    112116    CALL cpu_log( log_point(20), 'disturb_field', 'start' )
    113 
     117!
     118!-- Set flag number, 20 for u-grid, 21 for v-grid, required to mask topography
     119    flag_nr = MERGE( 20, 21, TRIM(var_char) == 'u' )
    114120!
    115121!-- Create an additional temporary array and initialize the arrays needed
    … …  
    224230       DO  i = nxlg, nxrg
    225231          DO  j = nysg, nyng
    226              dist1(nzb:nzb_uv_inner(j,i)+1,j,i) = 0.0_wp
     232             DO  k = nzb, nzb_max
     233                dist1(k,j,i) = MERGE( dist1(k,j,i), 0.0_wp,                    &
     234                                      BTEST( wall_flags_0(k,j,i), flag_nr )    &
     235                                    )
     236             ENDDO
    227237          ENDDO
    228238       ENDDO

  • palm/trunk/SOURCE/disturb_heatflux.f90

    r2101 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustment according new surface data type.
     23! Implemented parallel random number generator to obtain always the same
     24! random number distribution regardless of the processor distribution.
    2325!
    2426! Former revisions:
    … …  
    6062!> Generate random, normally distributed heatflux values and store them as the
    6163!> near-surface heatflux.
    62 !> On parallel computers, too, this random generator is called at all grid points
    63 !> of the total array in order to guarantee the same random distribution of the
    64 !> total array regardless of the number of processors used during the model run.
    6564!------------------------------------------------------------------------------!
    66  SUBROUTINE disturb_heatflux
     65 SUBROUTINE disturb_heatflux( surf )
    6766 
    6867
    6968    USE arrays_3d,                                                             &
    70         ONLY:  shf, heatflux_input_conversion
     69        ONLY:  heatflux_input_conversion
    7170       
    7271    USE control_parameters,                                                    &
    73         ONLY:  iran, surface_heatflux, wall_heatflux
     72        ONLY:  iran, surface_heatflux, random_generator, wall_heatflux
    7473       
    7574    USE cpulog,                                                                &
    … …  
    7978   
    8079    USE indices,                                                               &
    81         ONLY:  nx, nxl, nxr, ny, nyn, nys, nzb, nzb_s_inner
     80        ONLY:  nzb
     81
     82    USE random_generator_parallel,                                             &
     83        ONLY:  random_number_parallel, random_seed_parallel, random_dummy,     &
     84               id_random_array, seq_random_array
     85
     86    USE surface_mod,                                                           &
     87        ONLY:  surf_type
    8288
    8389    IMPLICIT NONE
    8490
    85     INTEGER(iwp) ::  j  !<
    86     INTEGER(iwp) ::  i  !<
     91    INTEGER(iwp) ::  i  !< grid index, x direction
     92    INTEGER(iwp) ::  j  !< grid index, y direction
     93    INTEGER(iwp) ::  k  !< grid index, z direction
     94    INTEGER(iwp) ::  m  !< loop variables over surface elements
    8795   
    8896    REAL(wp) ::  random_gauss  !<
    8997    REAL(wp) ::  randomnumber  !<
     98
     99    TYPE(surf_type) ::  surf   !< surface-type variable
    90100
    91101
    … …  
    93103
    94104!
    95 !-- Generate random disturbances and store them
    96     DO  i = 0, nx
    97        DO  j = 0, ny
    98           randomnumber = random_gauss( iran, 5.0_wp )
    99           IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j )   &
    100           THEN
    101              IF ( nzb_s_inner(j,i) == 0 )  THEN
    102                 shf(j,i) = randomnumber * surface_heatflux                     &
    103                            * heatflux_input_conversion(nzb)
    104              ELSE
     105!-- Generate random disturbances and store them. Note, if
     106!-- random_generator /= 'random-parallel' it is not guaranteed to obtain 
     107!-- the same random distribution if the number of processors is changed.
     108    IF ( random_generator /= 'random-parallel' )  THEN
     109
     110       DO  m = 1, surf%ns
     111
     112          k = surf%k(m)
     113
     114          randomnumber = random_gauss( iran, 5.0_wp )     
    105115!
    106 !--             Over topography surface_heatflux is replaced by wall_heatflux(0)
    107                 shf(j,i) = randomnumber * wall_heatflux(0)                     &
    108                            * heatflux_input_conversion(nzb_s_inner(j,i))
    109              ENDIF
     116!--       k-1 is topography top index. If this is 0, set surface heatflux. Over
     117!--       topography surface_heatflux is replaced by wall_heatflux(0).
     118          IF ( k-1 == 0 )  THEN
     119             surf%shf(m) = randomnumber * surface_heatflux                     &
     120                              * heatflux_input_conversion(nzb)
     121          ELSE
     122             surf%shf(m) = randomnumber * wall_heatflux(0)                     &
     123                              * heatflux_input_conversion(k-1)
    110124          ENDIF
    111125       ENDDO
    112     ENDDO
     126    ELSE
    113127
     128       DO  m = 1, surf%ns
     129
     130          i = surf%i(m)
     131          j = surf%j(m)
     132          k = surf%k(m)
     133
     134          CALL random_seed_parallel( put=seq_random_array(:, j, i) )
     135          CALL random_number_parallel( random_dummy )   
    114136!
    115 !-- Exchange lateral boundary conditions for the heatflux array
    116     CALL exchange_horiz_2d( shf )
     137!--       k-1 is topography top index. If this is 0, set surface heatflux. Over
     138!--       topography surface_heatflux is replaced by wall_heatflux(0).
     139          IF ( k-1 == 0 )  THEN
     140             surf%shf(m) = ( random_dummy - 0.5_wp ) * surface_heatflux        &
     141                              * heatflux_input_conversion(nzb)
     142          ELSE
     143             surf%shf(m) = ( random_dummy - 0.5_wp ) * wall_heatflux(0)        &
     144                              * heatflux_input_conversion(k-1)
     145          ENDIF
     146
     147          CALL random_seed_parallel( get=seq_random_array(:, j, i) )
     148
     149       ENDDO
     150
     151    ENDIF
    117152
    118153    CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )

  • palm/trunk/SOURCE/eqn_state_seawater.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    120120           ONLY:  hyp, prho, pt_p, rho_ocean, sa_p
    121121       USE indices,                                                            &
    122            ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
     122           ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
     123
     124       USE surface_mod,                                                        &
     125          ONLY :  bc_h
    123126
    124127       IMPLICIT NONE
    125128
    126        INTEGER(iwp) ::  i  !<
    127        INTEGER(iwp) ::  j  !<
    128        INTEGER(iwp) ::  k  !<
    129 
    130        REAL(wp) ::  pden  !<
    131        REAL(wp) ::  pnom  !<
    132        REAL(wp) ::  p1    !<
    133        REAL(wp) ::  p2    !<
    134        REAL(wp) ::  p3    !<
    135        REAL(wp) ::  pt1   !<
    136        REAL(wp) ::  pt2   !<
    137        REAL(wp) ::  pt3   !<
    138        REAL(wp) ::  pt4   !<
    139        REAL(wp) ::  sa1   !<
    140        REAL(wp) ::  sa15  !<
    141        REAL(wp) ::  sa2   !<
     129       INTEGER(iwp) ::  i       !< running index x direction
     130       INTEGER(iwp) ::  j       !< running index y direction
     131       INTEGER(iwp) ::  k       !< running index z direction
     132       INTEGER(iwp) ::  l       !< running index of surface type, south- or north-facing wall
     133       INTEGER(iwp) ::  m       !< running index surface elements
     134       INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
     135       INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
     136
     137       REAL(wp) ::  flag   !< flag to mask topography grid points
     138       REAL(wp) ::  pden   !<
     139       REAL(wp) ::  pnom   !<
     140       REAL(wp) ::  p1     !<
     141       REAL(wp) ::  p2     !<
     142       REAL(wp) ::  p3     !<
     143       REAL(wp) ::  pt1    !<
     144       REAL(wp) ::  pt2    !<
     145       REAL(wp) ::  pt3    !<
     146       REAL(wp) ::  pt4    !<
     147       REAL(wp) ::  sa1    !<
     148       REAL(wp) ::  sa15   !<
     149       REAL(wp) ::  sa2    !<
    142150       
    143151                       
    … …  
    145153       DO  i = nxl, nxr
    146154          DO  j = nys, nyn
    147              DO  k = nzb_s_inner(j,i)+1, nzt
     155             DO  k = nzb+1, nzt
    148156!
    149157!--             Pressure is needed in dbar
    … …  
    171179                       den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +    &
    172180                       den(10)*sa15*pt2
    173 
     181!
     182!--             Predetermine flag to mask topography
     183                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    174184!
    175185!--             Potential density (without pressure terms)
    176                 prho(k,j,i) = pnom / pden
     186                prho(k,j,i) = pnom / pden * flag
    177187
    178188                pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +    &
    … …  
    184194!
    185195!--             In-situ density
    186                 rho_ocean(k,j,i) = pnom / pden
     196                rho_ocean(k,j,i) = pnom / pden * flag
    187197
    188198             ENDDO
    189199!
    190 !--          Neumann conditions are assumed at bottom and top boundary
    191              prho(nzt+1,j,i)            = prho(nzt,j,i)
    192              prho(nzb_s_inner(j,i),j,i) = prho(nzb_s_inner(j,i)+1,j,i)
    193              rho_ocean(nzt+1,j,i)             = rho_ocean(nzt,j,i)
    194              rho_ocean(nzb_s_inner(j,i),j,i)  = rho_ocean(nzb_s_inner(j,i)+1,j,i)
     200!--          Neumann conditions are assumed at top boundary
     201             prho(nzt+1,j,i)      = prho(nzt,j,i)
     202             rho_ocean(nzt+1,j,i) = rho_ocean(nzt,j,i)
    195203
    196204          ENDDO
     205       ENDDO
     206!
     207!--    Neumann conditions at up/downward-facing surfaces
     208       !$OMP PARALLEL DO PRIVATE( i, j, k )
     209       DO  m = 1, bc_h(0)%ns
     210          i = bc_h(0)%i(m)           
     211          j = bc_h(0)%j(m)
     212          k = bc_h(0)%k(m)
     213          prho(k-1,j,i)      = prho(k,j,i)
     214          rho_ocean(k-1,j,i) = rho_ocean(k,j,i)
     215       ENDDO
     216!
     217!--    Downward facing surfaces
     218       !$OMP PARALLEL DO PRIVATE( i, j, k )
     219       DO  m = 1, bc_h(1)%ns
     220          i = bc_h(1)%i(m)           
     221          j = bc_h(1)%j(m)
     222          k = bc_h(1)%k(m)
     223          prho(k+1,j,i)      = prho(k,j,i)
     224          rho_ocean(k+1,j,i) = rho_ocean(k,j,i)
    197225       ENDDO
    198226
    … …  
    211239           
    212240       USE indices,                                                            &
    213            ONLY:  nzb_s_inner, nzt
     241           ONLY:  nzb, nzt, wall_flags_0
     242
     243       USE surface_mod,                                                        &
     244          ONLY :  bc_h
    214245
    215246       IMPLICIT NONE
    216247
    217        INTEGER(iwp) ::  i, j, k
    218 
    219        REAL(wp)     ::  pden, pnom, p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, &
    220                         sa2
    221 
    222        DO  k = nzb_s_inner(j,i)+1, nzt
     248       INTEGER(iwp) ::  i       !< running index x direction
     249       INTEGER(iwp) ::  j       !< running index y direction
     250       INTEGER(iwp) ::  k       !< running index z direction
     251       INTEGER(iwp) ::  l       !< running index of surface type, south- or north-facing wall
     252       INTEGER(iwp) ::  m       !< running index surface elements
     253       INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
     254       INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
     255
     256       REAL(wp) ::  flag   !< flag to mask topography grid points
     257       REAL(wp) ::  pden   !<
     258       REAL(wp) ::  pnom   !<
     259       REAL(wp) ::  p1     !<
     260       REAL(wp) ::  p2     !<
     261       REAL(wp) ::  p3     !<
     262       REAL(wp) ::  pt1    !<
     263       REAL(wp) ::  pt2    !<
     264       REAL(wp) ::  pt3    !<
     265       REAL(wp) ::  pt4    !<
     266       REAL(wp) ::  sa1    !<
     267       REAL(wp) ::  sa15   !<
     268       REAL(wp) ::  sa2    !<
     269
     270       DO  k = nzb+1, nzt
    223271!
    224272!--       Pressure is needed in dbar
    … …  
    246294                 den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +          &
    247295                 den(10)*sa15*pt2
    248 
     296!
     297!--       Predetermine flag to mask topography
     298          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    249299!
    250300!--       Potential density (without pressure terms)
    251           prho(k,j,i) = pnom / pden
     301          prho(k,j,i) = pnom / pden * flag
    252302
    253303          pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +          &
    … …  
    258308!
    259309!--       In-situ density
    260           rho_ocean(k,j,i) = pnom / pden
    261 
    262 
    263        ENDDO
    264 
    265 !
    266 !--    Neumann conditions are assumed at bottom and top boundary
    267        prho(nzt+1,j,i)            = prho(nzt,j,i)
    268        prho(nzb_s_inner(j,i),j,i) = prho(nzb_s_inner(j,i)+1,j,i)
    269        rho_ocean(nzt+1,j,i)             = rho_ocean(nzt,j,i)
    270        rho_ocean(nzb_s_inner(j,i),j,i)  = rho_ocean(nzb_s_inner(j,i)+1,j,i)
     310          rho_ocean(k,j,i) = pnom / pden * flag
     311
     312
     313       ENDDO
     314!
     315!--    Neumann conditions at up/downward-facing walls
     316       surf_s = bc_h(0)%start_index(j,i)   
     317       surf_e = bc_h(0)%end_index(j,i)   
     318       DO  m = surf_s, surf_e
     319          k                  = bc_h(0)%k(m)
     320          prho(k-1,j,i)      = prho(k,j,i)
     321          rho_ocean(k-1,j,i) = rho_ocean(k,j,i)
     322       ENDDO
     323!
     324!--    Downward facing surfaces
     325       surf_s = bc_h(1)%start_index(j,i)   
     326       surf_e = bc_h(1)%end_index(j,i)   
     327       DO  m = surf_s, surf_e
     328          k                  = bc_h(1)%k(m)
     329          prho(k+1,j,i)      = prho(k,j,i)
     330          rho_ocean(k+1,j,i) = rho_ocean(k,j,i)
     331       ENDDO
     332!
     333!--    Neumann condition are assumed at top boundary
     334       prho(nzt+1,j,i)      = prho(nzt,j,i)
     335       rho_ocean(nzt+1,j,i) = rho_ocean(nzt,j,i)
    271336
    272337    END SUBROUTINE eqn_state_seawater_ij

  • palm/trunk/SOURCE/flow_statistics.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    224224    USE arrays_3d,                                                             &
    225225        ONLY:  ddzu, ddzw, e, heatflux_output_conversion, hyp, km, kh,         &
    226                momentumflux_output_conversion, nr, ol, p, prho, prr, pt, q,    &
    227                qc, ql, qr, qs, qsws, qswst, rho_air, rho_air_zw, rho_ocean, s, &
    228                sa, ss, ssws, sswst, saswsb, saswst, shf, td_lsa_lpt, td_lsa_q, &
    229                td_sub_lpt, td_sub_q, time_vert, ts, tswst, u, ug, us, usws,    &
    230                uswst, vsws, v, vg, vpt, vswst, w, w_subs,                      &
    231                waterflux_output_conversion, zw
     226               momentumflux_output_conversion, nr, p, prho, prr, pt, q,        &
     227               qc, ql, qr, rho_air, rho_air_zw, rho_ocean, s,                  &
     228               sa, td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, time_vert, u,   &
     229               ug, v, vg, vpt, w, w_subs, waterflux_output_conversion, zw
    232230       
    233231    USE cloud_parameters,                                                      &
    … …  
    236234    USE control_parameters,                                                    &
    237235        ONLY:   average_count_pr, cloud_droplets, cloud_physics, do_sum,       &
    238                 dt_3d, g, humidity, kappa, large_scale_forcing,                &
     236                dt_3d, g, humidity, kappa, land_surface, large_scale_forcing,  &
    239237                large_scale_subsidence, max_pr_user, message_string, neutral,  &
    240238                microphysics_seifert, ocean, passive_scalar, simulated_time,   &
    … …  
    250248    USE indices,                                                               &
    251249        ONLY:   ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, ngp_sums,      &
    252                 ngp_sums_ls, nxl, nxr, nyn, nys, nzb, nzb_diff_s_inner,        &
    253                 nzb_s_inner, nzt, nzt_diff
     250                ngp_sums_ls, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    254251       
    255252    USE kinds
    256253   
    257254    USE land_surface_model_mod,                                                &
    258         ONLY:   ghf_eb, land_surface, m_soil, nzb_soil, nzt_soil,              &
    259                 qsws_eb, qsws_liq_eb, qsws_soil_eb, qsws_veg_eb, r_a, r_s,     &
    260                 shf_eb, t_soil
     255        ONLY:   m_soil_h, nzb_soil, nzt_soil, t_soil_h
    261256
    262257    USE netcdf_interface,                                                      &
    … …  
    277272    USE statistics
    278273
     274       USE surface_mod,                                                        &
     275          ONLY :  surf_def_h, surf_lsm_h, surf_usm_h
     276
    279277
    280278    IMPLICIT NONE
    … …  
    283281    INTEGER(iwp) ::  j                   !<
    284282    INTEGER(iwp) ::  k                   !<
     283    INTEGER(iwp) ::  ki                  !<
    285284    INTEGER(iwp) ::  k_surface_level     !<
     285    INTEGER(iwp) ::  m                   !< loop variable over all horizontal wall elements
     286    INTEGER(iwp) ::  l                   !< loop variable over surface facing -- up- or downward-facing
    286287    INTEGER(iwp) ::  nt                  !<
    287288    INTEGER(iwp) ::  omp_get_thread_num  !<
    288289    INTEGER(iwp) ::  sr                  !<
    289290    INTEGER(iwp) ::  tn                  !<
    290    
     291
    291292    LOGICAL ::  first  !<
    292293   
    293294    REAL(wp) ::  dptdz_threshold  !<
    294295    REAL(wp) ::  fac              !<
     296    REAL(wp) ::  flag             !<
    295297    REAL(wp) ::  height           !<
    296298    REAL(wp) ::  pts              !<
    … …  
    400402!--    for other horizontal averages.
    401403       tn = 0
    402 
    403        !$OMP PARALLEL PRIVATE( i, j, k, tn )
    404 !$     tn = omp_get_thread_num()
    405 
     404       !$OMP PARALLEL PRIVATE( i, j, k, tn, flag )
     405       !$ tn = omp_get_thread_num()
    406406       !$OMP DO
    407407       DO  i = nxl, nxr
    408408          DO  j =  nys, nyn
    409              DO  k = nzb_s_inner(j,i), nzt+1
    410                 sums_l(k,1,tn)  = sums_l(k,1,tn)  + u(k,j,i)  * rmask(j,i,sr)
    411                 sums_l(k,2,tn)  = sums_l(k,2,tn)  + v(k,j,i)  * rmask(j,i,sr)
    412                 sums_l(k,4,tn)  = sums_l(k,4,tn)  + pt(k,j,i) * rmask(j,i,sr)
     409             DO  k = nzb, nzt+1
     410                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
     411                sums_l(k,1,tn)  = sums_l(k,1,tn)  + u(k,j,i)  * rmask(j,i,sr)  &
     412                                                              * flag
     413                sums_l(k,2,tn)  = sums_l(k,2,tn)  + v(k,j,i)  * rmask(j,i,sr)  &
     414                                                              * flag
     415                sums_l(k,4,tn)  = sums_l(k,4,tn)  + pt(k,j,i) * rmask(j,i,sr)  &
     416                                                              * flag
    413417             ENDDO
    414418          ENDDO
    … …  
    421425          DO  i = nxl, nxr
    422426             DO  j =  nys, nyn
    423                 DO  k = nzb_s_inner(j,i), nzt+1
    424                    sums_l(k,23,tn)  = sums_l(k,23,tn) + &
    425                                       sa(k,j,i) * rmask(j,i,sr)
     427                DO  k = nzb, nzt+1
     428                   sums_l(k,23,tn)  = sums_l(k,23,tn) + sa(k,j,i)              &
     429                                    * rmask(j,i,sr)                            &
     430                                    * MERGE( 1.0_wp, 0.0_wp,                   &
     431                                             BTEST( wall_flags_0(k,j,i), 22 ) )
    426432                ENDDO
    427433             ENDDO
    … …  
    437443          DO  i = nxl, nxr
    438444             DO  j =  nys, nyn
    439                 DO  k = nzb_s_inner(j,i), nzt+1
    440                    sums_l(k,44,tn)  = sums_l(k,44,tn) + &
    441                                       vpt(k,j,i) * rmask(j,i,sr)
    442                    sums_l(k,41,tn)  = sums_l(k,41,tn) + &
    443                                       q(k,j,i) * rmask(j,i,sr)
     445                DO  k = nzb, nzt+1
     446                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
     447                   sums_l(k,44,tn)  = sums_l(k,44,tn) +                        &
     448                                      vpt(k,j,i) * rmask(j,i,sr) * flag
     449                   sums_l(k,41,tn)  = sums_l(k,41,tn) +                        &
     450                                      q(k,j,i) * rmask(j,i,sr)   * flag
    444451                ENDDO
    445452             ENDDO
    … …  
    449456             DO  i = nxl, nxr
    450457                DO  j =  nys, nyn
    451                    DO  k = nzb_s_inner(j,i), nzt+1
    452                       sums_l(k,42,tn) = sums_l(k,42,tn) + &
    453                                       ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr)
    454                       sums_l(k,43,tn) = sums_l(k,43,tn) + ( &
     458                   DO  k = nzb, nzt+1
     459                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
     460                      sums_l(k,42,tn) = sums_l(k,42,tn) +                      &
     461                                      ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr) &
     462                                                               * flag
     463                      sums_l(k,43,tn) = sums_l(k,43,tn) + (                    &
    455464                                      pt(k,j,i) + l_d_cp*pt_d_t(k) * ql(k,j,i) &
    456                                                           ) * rmask(j,i,sr)
     465                                                          ) * rmask(j,i,sr)    &
     466                                                            * flag
    457467                   ENDDO
    458468                ENDDO
    … …  
    467477          DO  i = nxl, nxr
    468478             DO  j =  nys, nyn
    469                 DO  k = nzb_s_inner(j,i), nzt+1
    470                    sums_l(k,117,tn)  = sums_l(k,117,tn) + s(k,j,i) * rmask(j,i,sr)
     479                DO  k = nzb, nzt+1
     480                   sums_l(k,117,tn)  = sums_l(k,117,tn) + s(k,j,i)             &
     481                                    * rmask(j,i,sr)                            &
     482                                    * MERGE( 1.0_wp, 0.0_wp,                   &
     483                                             BTEST( wall_flags_0(k,j,i), 22 ) )
    471484                ENDDO
    472485             ENDDO
    … …  
    603616       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper,             &
    604617       !$OMP                   sums_l_etot, tn, ust, ust2, u2, vst, vst2, v2,  &
    605        !$OMP                   w2 )
    606 !$     tn = omp_get_thread_num()
    607 
     618       !$OMP                   w2, flag, m, ki, l )
     619       !$ tn = omp_get_thread_num()
    608620       !$OMP DO
    609621       DO  i = nxl, nxr
    610622          DO  j =  nys, nyn
    611623             sums_l_etot = 0.0_wp
    612              DO  k = nzb_s_inner(j,i), nzt+1
     624             DO  k = nzb, nzt+1
     625                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
    613626!
    614627!--             Prognostic and diagnostic variables
    615                 sums_l(k,3,tn)  = sums_l(k,3,tn)  + w(k,j,i)  * rmask(j,i,sr)
    616                 sums_l(k,8,tn)  = sums_l(k,8,tn)  + e(k,j,i)  * rmask(j,i,sr)
    617                 sums_l(k,9,tn)  = sums_l(k,9,tn)  + km(k,j,i) * rmask(j,i,sr)
    618                 sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr)
    619                 sums_l(k,40,tn) = sums_l(k,40,tn) + p(k,j,i)
     628                sums_l(k,3,tn)  = sums_l(k,3,tn)  + w(k,j,i)  * rmask(j,i,sr)  &
     629                                                              * flag
     630                sums_l(k,8,tn)  = sums_l(k,8,tn)  + e(k,j,i)  * rmask(j,i,sr)  &
     631                                                              * flag
     632                sums_l(k,9,tn)  = sums_l(k,9,tn)  + km(k,j,i) * rmask(j,i,sr)  &
     633                                                              * flag
     634                sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr)  &
     635                                                              * flag
     636                sums_l(k,40,tn) = sums_l(k,40,tn) + p(k,j,i)  * flag
    620637
    621638                sums_l(k,33,tn) = sums_l(k,33,tn) + &
    622                                   ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)
     639                                  ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)&
     640                                                                 * flag
    623641
    624642                IF ( humidity )  THEN
    625643                   sums_l(k,70,tn) = sums_l(k,70,tn) + &
    626                                   ( q(k,j,i)-hom(k,1,41,sr) )**2 * rmask(j,i,sr)
     644                                  ( q(k,j,i)-hom(k,1,41,sr) )**2 * rmask(j,i,sr)&
     645                                                                 * flag
    627646                ENDIF
    628647                IF ( passive_scalar )  THEN
    629648                   sums_l(k,118,tn) = sums_l(k,118,tn) + &
    630                                   ( s(k,j,i)-hom(k,1,117,sr) )**2 * rmask(j,i,sr)
     649                                  ( s(k,j,i)-hom(k,1,117,sr) )**2 * rmask(j,i,sr)&
     650                                                                  * flag
    631651                ENDIF
    632652!
    633653!--             Higher moments
    634654!--             (Computation of the skewness of w further below)
    635                 sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i)**3 * rmask(j,i,sr)
     655                sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i)**3 * rmask(j,i,sr) &
     656                                                                * flag
    636657
    637658                sums_l_etot  = sums_l_etot + &
    638                                         0.5_wp * ( u(k,j,i)**2 + v(k,j,i)**2 + &
    639                                         w(k,j,i)**2 ) * rmask(j,i,sr)
     659                                        0.5_wp * ( u(k,j,i)**2 + v(k,j,i)**2 +  &
     660                                        w(k,j,i)**2 )            * rmask(j,i,sr)&
     661                                                                 * flag
    640662             ENDDO
    641663!
    … …  
    647669!
    648670!--          2D-arrays (being collected in the last column of sums_l)
    649              sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
    650                                         us(j,i)   * rmask(j,i,sr)
    651              sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +             &
    652                                         usws(j,i) * rmask(j,i,sr)
    653              sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +             &
    654                                         vsws(j,i) * rmask(j,i,sr)
    655              sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +             &
    656                                         ts(j,i)   * rmask(j,i,sr)
    657              IF ( humidity )  THEN
    658                 sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +        &
    659                                             qs(j,i)   * rmask(j,i,sr)
     671             IF ( surf_def_h(0)%ns >= 1 )  THEN
     672                m = surf_def_h(0)%start_index(j,i)
     673                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
     674                                        surf_def_h(0)%us(m)   * rmask(j,i,sr)
     675                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +             &
     676                                        surf_def_h(0)%usws(m) * rmask(j,i,sr)
     677                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +             &
     678                                        surf_def_h(0)%vsws(m) * rmask(j,i,sr)
     679                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +             &
     680                                        surf_def_h(0)%ts(m)   * rmask(j,i,sr)
     681                IF ( humidity )  THEN
     682                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +        &
     683                                            surf_def_h(0)%qs(m)   * rmask(j,i,sr)
     684                ENDIF
     685                IF ( passive_scalar )  THEN
     686                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +        &
     687                                            surf_def_h(0)%ss(m)   * rmask(j,i,sr)
     688                ENDIF
    660689             ENDIF
    661              IF ( passive_scalar )  THEN
    662                 sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +        &
    663                                             ss(j,i)   * rmask(j,i,sr)
     690             IF ( surf_lsm_h%ns >= 1 )  THEN
     691                m = surf_lsm_h%start_index(j,i)
     692                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
     693                                        surf_lsm_h%us(m)   * rmask(j,i,sr)
     694                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +             &
     695                                        surf_lsm_h%usws(m) * rmask(j,i,sr)
     696                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +             &
     697                                        surf_lsm_h%vsws(m) * rmask(j,i,sr)
     698                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +             &
     699                                        surf_lsm_h%ts(m)   * rmask(j,i,sr)
     700                IF ( humidity )  THEN
     701                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +        &
     702                                            surf_lsm_h%qs(m)   * rmask(j,i,sr)
     703                ENDIF
     704                IF ( passive_scalar )  THEN
     705                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +        &
     706                                            surf_lsm_h%ss(m)   * rmask(j,i,sr)
     707                ENDIF
     708             ENDIF
     709             IF ( surf_usm_h%ns >= 1 )  THEN
     710                m = surf_lsm_h%start_index(j,i)
     711                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
     712                                        surf_usm_h%us(m)   * rmask(j,i,sr)
     713                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +             &
     714                                        surf_usm_h%usws(m) * rmask(j,i,sr)
     715                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +             &
     716                                        surf_usm_h%vsws(m) * rmask(j,i,sr)
     717                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +             &
     718                                        surf_usm_h%ts(m)   * rmask(j,i,sr)
     719                IF ( humidity )  THEN
     720                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +        &
     721                                            surf_usm_h%qs(m)   * rmask(j,i,sr)
     722                ENDIF
     723                IF ( passive_scalar )  THEN
     724                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +        &
     725                                            surf_usm_h%ss(m)   * rmask(j,i,sr)
     726                ENDIF
    664727             ENDIF
    665728          ENDDO
    … …  
    674737          DO  i = nxl, nxr
    675738             DO  j =  nys, nyn
    676                 DO  k = nzb_s_inner(j,i), nzt+1
     739                DO  k = nzb, nzt+1
     740                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
     741
    677742                   u2   = u(k,j,i)**2
    678743                   v2   = v(k,j,i)**2
    … …  
    681746                   vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
    682747
    683                    sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)
    684                    sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)
    685                    sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)
     748                   sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)    &
     749                                                            * flag
     750                   sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)    &
     751                                                            * flag
     752                   sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)    &
     753                                                            * flag
    686754!
    687755!--                Perturbation energy
    688756
    689757                   sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5_wp *                &
    690                                   ( ust2 + vst2 + w2 ) * rmask(j,i,sr)
     758                                  ( ust2 + vst2 + w2 )      * rmask(j,i,sr)    &
     759                                                            * flag
    691760                ENDDO
    692761             ENDDO
    … …  
    702771       DO  i = nxl, nxr
    703772          DO  j =  nys, nyn
    704              DO  k = nzb_s_inner(j,i), nzt+1
     773             DO  k = nzb, nzt+1
     774                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
     775
    705776                w2   = w(k,j,i)**2
    706777                ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
    … …  
    709780
    710781                sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn)            &
    711                                  + 0.5_wp * ( ust2 + vst2 + w2 ) * rmask(j,i,sr)
     782                                 + 0.5_wp * ( ust2 + vst2 + w2 )               &
     783                                 * rmask(j,i,sr)                               &
     784                                 * flag
    712785             ENDDO
    713786          ENDDO
    … …  
    728801!--                However, this implies no error since staggered velocity
    729802!--                components are zero at the walls and inside buildings.
    730 
    731              DO  k = nzb_diff_s_inner(j,i)-1, nzt_diff
     803!--          Flag 23 is used to mask surface fluxes as well as model-top fluxes,
     804!--          which are added further below.
     805             DO  k = nzb, nzt
     806                flag = MERGE( 1.0_wp, 0.0_wp,                                  &
     807                              BTEST( wall_flags_0(k,j,i), 23 ) ) *             &
     808                       MERGE( 1.0_wp, 0.0_wp,                                  &
     809                              BTEST( wall_flags_0(k,j,i), 9  ) )
    732810!
    733811!--             Momentum flux w"u"
    … …  
    739817                                                           ) * rmask(j,i,sr)   &
    740818                                         * rho_air_zw(k)                       &
    741                                          * momentumflux_output_conversion(k)
     819                                         * momentumflux_output_conversion(k)   &
     820                                         * flag
    742821!
    743822!--             Momentum flux w"v"
    … …  
    749828                                                           ) * rmask(j,i,sr)   &
    750829                                         * rho_air_zw(k)                       &
    751                                          * momentumflux_output_conversion(k)
     830                                         * momentumflux_output_conversion(k)   &
     831                                         * flag
    752832!
    753833!--             Heat flux w"pt"
    … …  
    757837                                               * rho_air_zw(k)                 &
    758838                                               * heatflux_output_conversion(k) &
    759                                                * ddzu(k+1) * rmask(j,i,sr)
     839                                               * ddzu(k+1) * rmask(j,i,sr)     &
     840                                               * flag
    760841
    761842
    … …  
    766847                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
    767848                                               * ( sa(k+1,j,i) - sa(k,j,i) )   &
    768                                                * ddzu(k+1) * rmask(j,i,sr)
     849                                               * ddzu(k+1) * rmask(j,i,sr)     &
     850                                               * flag
    769851                ENDIF
    770852
    … …  
    777859                                               * rho_air_zw(k)                 &
    778860                                               * heatflux_output_conversion(k) &
    779                                                * ddzu(k+1) * rmask(j,i,sr)
     861                                               * ddzu(k+1) * rmask(j,i,sr) * flag
    780862                   sums_l(k,48,tn) = sums_l(k,48,tn)                           &
    781863                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
    … …  
    783865                                               * rho_air_zw(k)                 &
    784866                                               * waterflux_output_conversion(k)&
    785                                                * ddzu(k+1) * rmask(j,i,sr)
     867                                               * ddzu(k+1) * rmask(j,i,sr) * flag
    786868
    787869                   IF ( cloud_physics ) THEN
    … …  
    792874                                               * rho_air_zw(k)                 &
    793875                                               * waterflux_output_conversion(k)&
    794                                                * ddzu(k+1) * rmask(j,i,sr)
     876                                               * ddzu(k+1) * rmask(j,i,sr) * flag
    795877                   ENDIF
    796878                ENDIF
    … …  
    802884                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
    803885                                                  * ( s(k+1,j,i) - s(k,j,i) )  &
    804                                                   * ddzu(k+1) * rmask(j,i,sr)
     886                                                  * ddzu(k+1) * rmask(j,i,sr)  &
     887                                                              * flag
    805888                ENDIF
    806889
    … …  
    810893!--          Subgridscale fluxes in the Prandtl layer
    811894             IF ( use_surface_fluxes )  THEN
    812                 sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
     895                DO  l = 0, 1
     896                   ki = MERGE( -1, 0, l == 0 )
     897                   IF ( surf_def_h(l)%ns >= 1 )  THEN
     898                      DO  m = surf_def_h(l)%start_index(j,i), surf_def_h(l)%end_index(j,i)
     899                         k = surf_def_h(l)%k(m)
     900
     901                         sums_l(k+ki,12,tn) = sums_l(k+ki,12,tn) + &
     902                                    momentumflux_output_conversion(k+ki) * &
     903                                    surf_def_h(l)%usws(m) * rmask(j,i,sr)     ! w"u"
     904                         sums_l(k+ki,14,tn) = sums_l(k+ki,14,tn) + &
     905                                    momentumflux_output_conversion(k+ki) * &
     906                                    surf_def_h(l)%vsws(m) * rmask(j,i,sr)     ! w"v"
     907                         sums_l(k+ki,16,tn) = sums_l(k+ki,16,tn) + &
     908                                    heatflux_output_conversion(k+ki) * &
     909                                    surf_def_h(l)%shf(m)  * rmask(j,i,sr)     ! w"pt"
     910                         sums_l(k+ki,58,tn) = sums_l(k+ki,58,tn) + &
     911                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
     912                         sums_l(k+ki,61,tn) = sums_l(k+ki,61,tn) + &
     913                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
     914                         IF ( ocean )  THEN
     915                            sums_l(k+ki,65,tn) = sums_l(k+ki,65,tn) + &
     916                                       surf_def_h(l)%sasws(m) * rmask(j,i,sr)  ! w"sa"
     917                         ENDIF
     918                         IF ( humidity )  THEN
     919                            sums_l(k+ki,48,tn) = sums_l(k+ki,48,tn) +                     &
     920                                       waterflux_output_conversion(k+ki) *      &
     921                                       surf_def_h(l)%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
     922                            sums_l(k+ki,45,tn) = sums_l(k+ki,45,tn) + (                   &
     923                                       ( 1.0_wp + 0.61_wp * q(k+ki,j,i) ) *     &
     924                                       surf_def_h(l)%shf(m) + 0.61_wp * pt(k+ki,j,i) *      &
     925                                                  surf_def_h(l)%qsws(m) )                  &
     926                                       * heatflux_output_conversion(k+ki)
     927                            IF ( cloud_droplets )  THEN
     928                               sums_l(k+ki,45,tn) = sums_l(k+ki,45,tn) + (                &
     929                                         ( 1.0_wp + 0.61_wp * q(k+ki,j,i) -     &
     930                                           ql(k+ki,j,i) ) * surf_def_h(l)%shf(m) +          &
     931                                           0.61_wp * pt(k+ki,j,i) * surf_def_h(l)%qsws(m) ) &
     932                                          * heatflux_output_conversion(k+ki)
     933                            ENDIF
     934                            IF ( cloud_physics )  THEN
     935!
     936!--                            Formula does not work if ql(k+ki) /= 0.0
     937                               sums_l(k+ki,51,tn) = sums_l(k+ki,51,tn) +                  &
     938                                          waterflux_output_conversion(k+ki) *   &
     939                                          surf_def_h(l)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
     940                            ENDIF
     941                         ENDIF
     942                         IF ( passive_scalar )  THEN
     943                            sums_l(k+ki,119,tn) = sums_l(k+ki,119,tn) +                     &
     944                                        surf_def_h(l)%ssws(m) * rmask(j,i,sr) ! w"s"
     945                         ENDIF
     946
     947                      ENDDO
     948
     949                   ENDIF
     950                ENDDO
     951                IF ( surf_lsm_h%ns >= 1 )  THEN
     952                   m = surf_lsm_h%start_index(j,i)
     953                   sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
    813954                                    momentumflux_output_conversion(nzb) * &
    814                                     usws(j,i) * rmask(j,i,sr)     ! w"u"
    815                 sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
     955                                    surf_lsm_h%usws(m) * rmask(j,i,sr)     ! w"u"
     956                   sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
    816957                                    momentumflux_output_conversion(nzb) * &
    817                                     vsws(j,i) * rmask(j,i,sr)     ! w"v"
    818                 sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
     958                                    surf_lsm_h%vsws(m) * rmask(j,i,sr)     ! w"v"
     959                   sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
    819960                                    heatflux_output_conversion(nzb) * &
    820                                     shf(j,i)  * rmask(j,i,sr)     ! w"pt"
    821                 sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
     961                                    surf_lsm_h%shf(m)  * rmask(j,i,sr)     ! w"pt"
     962                   sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
    822963                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
    823                 sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
     964                   sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
    824965                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
    825                 IF ( ocean )  THEN
    826                    sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
    827                                        saswsb(j,i) * rmask(j,i,sr)  ! w"sa"
    828                 ENDIF
    829                 IF ( humidity )  THEN
    830                    sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                     &
     966                   IF ( ocean )  THEN
     967                      sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
     968                                       surf_lsm_h%sasws(m) * rmask(j,i,sr)  ! w"sa"
     969                   ENDIF
     970                   IF ( humidity )  THEN
     971                      sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                     &
    831972                                       waterflux_output_conversion(nzb) *      &
    832                                        qsws(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
    833                    sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                   &
     973                                       surf_lsm_h%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
     974                      sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                   &
    834975                                       ( 1.0_wp + 0.61_wp * q(nzb,j,i) ) *     &
    835                                        shf(j,i) + 0.61_wp * pt(nzb,j,i) *      &
    836                                                   qsws(j,i) )                  &
     976                                       surf_lsm_h%shf(m) + 0.61_wp * pt(nzb,j,i) *      &
     977                                                  surf_lsm_h%qsws(m) )                  &
    837978                                       * heatflux_output_conversion(nzb)
    838                    IF ( cloud_droplets )  THEN
    839                       sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                &
     979                      IF ( cloud_droplets )  THEN
     980                         sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                &
    840981                                         ( 1.0_wp + 0.61_wp * q(nzb,j,i) -     &
    841                                            ql(nzb,j,i) ) * shf(j,i) +          &
    842                                            0.61_wp * pt(nzb,j,i) * qsws(j,i) ) &
     982                                           ql(nzb,j,i) ) * surf_lsm_h%shf(m) +          &
     983                                           0.61_wp * pt(nzb,j,i) * surf_lsm_h%qsws(m) ) &
    843984                                          * heatflux_output_conversion(nzb)
     985                      ENDIF
     986                      IF ( cloud_physics )  THEN
     987!
     988!--                      Formula does not work if ql(nzb) /= 0.0
     989                         sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                  &
     990                                          waterflux_output_conversion(nzb) *   &
     991                                          surf_lsm_h%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
     992                      ENDIF
    844993                   ENDIF
    845                    IF ( cloud_physics )  THEN
    846 !
    847 !--                   Formula does not work if ql(nzb) /= 0.0
    848                       sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                  &
     994                   IF ( passive_scalar )  THEN
     995                      sums_l(nzb,119,tn) = sums_l(nzb,119,tn) +                     &
     996                                        surf_lsm_h%ssws(m) * rmask(j,i,sr) ! w"s"
     997                   ENDIF
     998
     999
     1000                ENDIF
     1001                IF ( surf_usm_h%ns >= 1 )  THEN
     1002                   m = surf_usm_h%start_index(j,i)
     1003                   sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
     1004                                    momentumflux_output_conversion(nzb) * &
     1005                                    surf_usm_h%usws(m) * rmask(j,i,sr)     ! w"u"
     1006                   sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
     1007                                    momentumflux_output_conversion(nzb) * &
     1008                                    surf_usm_h%vsws(m) * rmask(j,i,sr)     ! w"v"
     1009                   sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
     1010                                    heatflux_output_conversion(nzb) * &
     1011                                    surf_usm_h%shf(m)  * rmask(j,i,sr)     ! w"pt"
     1012                   sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
     1013                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
     1014                   sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
     1015                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
     1016                   IF ( ocean )  THEN
     1017                      sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
     1018                                       surf_usm_h%sasws(m) * rmask(j,i,sr)  ! w"sa"
     1019                   ENDIF
     1020                   IF ( humidity )  THEN
     1021                      sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                     &
     1022                                       waterflux_output_conversion(nzb) *      &
     1023                                       surf_usm_h%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
     1024                      sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                   &
     1025                                       ( 1.0_wp + 0.61_wp * q(nzb,j,i) ) *     &
     1026                                       surf_usm_h%shf(m) + 0.61_wp * pt(nzb,j,i) *      &
     1027                                                  surf_usm_h%qsws(m) )                  &
     1028                                       * heatflux_output_conversion(nzb)
     1029                      IF ( cloud_droplets )  THEN
     1030                         sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                &
     1031                                         ( 1.0_wp + 0.61_wp * q(nzb,j,i) -     &
     1032                                           ql(nzb,j,i) ) * surf_usm_h%shf(m) +          &
     1033                                           0.61_wp * pt(nzb,j,i) * surf_usm_h%qsws(m) ) &
     1034                                          * heatflux_output_conversion(nzb)
     1035                      ENDIF
     1036                      IF ( cloud_physics )  THEN
     1037!
     1038!--                      Formula does not work if ql(nzb) /= 0.0
     1039                         sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                  &
    8491040                                          waterflux_output_conversion(nzb) *   &
    850                                           qsws(j,i) * rmask(j,i,sr) ! w"q" (w"qv")
     1041                                          surf_usm_h%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
     1042                      ENDIF
    8511043                   ENDIF
    852                 ENDIF
    853                 IF ( passive_scalar )  THEN
    854                    sums_l(nzb,119,tn) = sums_l(nzb,119,tn) +                     &
    855                                         ssws(j,i) * rmask(j,i,sr) ! w"s"
    856                 ENDIF
     1044                   IF ( passive_scalar )  THEN
     1045                      sums_l(nzb,119,tn) = sums_l(nzb,119,tn) +                     &
     1046                                        surf_usm_h%ssws(m) * rmask(j,i,sr) ! w"s"
     1047                   ENDIF
     1048
     1049
     1050                ENDIF
     1051
    8571052             ENDIF
    8581053
    8591054             IF ( .NOT. neutral )  THEN
    860                 sums_l(nzb,114,tn) = sums_l(nzb,114,tn) +                      &
    861                                     ol(j,i)  * rmask(j,i,sr) ! L
    862              ENDIF
    863 
    864 
    865              IF ( land_surface )  THEN
    866                 sums_l(nzb,93,tn)  = sums_l(nzb,93,tn) + ghf_eb(j,i)
    867                 sums_l(nzb,94,tn)  = sums_l(nzb,94,tn) + shf_eb(j,i)
    868                 sums_l(nzb,95,tn)  = sums_l(nzb,95,tn) + qsws_eb(j,i)
    869                 sums_l(nzb,96,tn)  = sums_l(nzb,96,tn) + qsws_liq_eb(j,i)
    870                 sums_l(nzb,97,tn)  = sums_l(nzb,97,tn) + qsws_soil_eb(j,i)
    871                 sums_l(nzb,98,tn)  = sums_l(nzb,98,tn) + qsws_veg_eb(j,i)
    872                 sums_l(nzb,99,tn)  = sums_l(nzb,99,tn) + r_a(j,i)
    873                 sums_l(nzb,100,tn) = sums_l(nzb,100,tn)+ r_s(j,i)
     1055                IF ( surf_def_h(0)%ns >= 1 )  THEN
     1056                   m = surf_def_h(0)%start_index(j,i)
     1057                   sums_l(nzb,114,tn) = sums_l(nzb,114,tn) +                      &
     1058                                        surf_def_h(0)%ol(m)  * rmask(j,i,sr) ! L
     1059                ENDIF
     1060                IF ( surf_lsm_h%ns >= 1 )  THEN
     1061                   m = surf_lsm_h%start_index(j,i)
     1062                   sums_l(nzb,114,tn) = sums_l(nzb,114,tn) +                      &
     1063                                        surf_lsm_h%ol(m)  * rmask(j,i,sr) ! L
     1064                ENDIF
     1065                IF ( surf_usm_h%ns >= 1 )  THEN
     1066                   m = surf_usm_h%start_index(j,i)
     1067                   sums_l(nzb,114,tn) = sums_l(nzb,114,tn) +                      &
     1068                                        surf_usm_h%ol(m)  * rmask(j,i,sr) ! L
     1069                ENDIF
    8741070             ENDIF
    8751071
    … …  
    8931089!--          Subgridscale fluxes at the top surface
    8941090             IF ( use_top_fluxes )  THEN
     1091                m = surf_def_h(2)%start_index(j,i)
    8951092                sums_l(nzt:nzt+1,12,tn) = sums_l(nzt:nzt+1,12,tn) + &
    8961093                                    momentumflux_output_conversion(nzt:nzt+1) * &
    897                                     uswst(j,i) * rmask(j,i,sr)    ! w"u"
     1094                                    surf_def_h(2)%usws(m) * rmask(j,i,sr)    ! w"u"
    8981095                sums_l(nzt:nzt+1,14,tn) = sums_l(nzt:nzt+1,14,tn) + &
    8991096                                    momentumflux_output_conversion(nzt:nzt+1) * &
    900                                     vswst(j,i) * rmask(j,i,sr)    ! w"v"
     1097                                    surf_def_h(2)%vsws(m) * rmask(j,i,sr)    ! w"v"
    9011098                sums_l(nzt:nzt+1,16,tn) = sums_l(nzt:nzt+1,16,tn) + &
    9021099                                    heatflux_output_conversion(nzt:nzt+1) * &
    903                                     tswst(j,i)  * rmask(j,i,sr)   ! w"pt"
     1100                                    surf_def_h(2)%shf(m)  * rmask(j,i,sr)   ! w"pt"
    9041101                sums_l(nzt:nzt+1,58,tn) = sums_l(nzt:nzt+1,58,tn) + &
    9051102                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
    … …  
    9091106                IF ( ocean )  THEN
    9101107                   sums_l(nzt,65,tn) = sums_l(nzt,65,tn) + &
    911                                        saswst(j,i) * rmask(j,i,sr)  ! w"sa"
     1108                                       surf_def_h(2)%sasws(m) * rmask(j,i,sr)  ! w"sa"
    9121109                ENDIF
    9131110                IF ( humidity )  THEN
    9141111                   sums_l(nzt,48,tn) = sums_l(nzt,48,tn) +                     &
    9151112                                       waterflux_output_conversion(nzt) *      &
    916                                        qswst(j,i) * rmask(j,i,sr) ! w"q" (w"qv")
     1113                                       surf_def_h(2)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
    9171114                   sums_l(nzt,45,tn) = sums_l(nzt,45,tn) + (                   &
    9181115                                       ( 1.0_wp + 0.61_wp * q(nzt,j,i) ) *     &
    919                                        tswst(j,i) + 0.61_wp * pt(nzt,j,i) *    &
    920                                                              qswst(j,i) )      &
     1116                                       surf_def_h(2)%shf(m) +                  &
     1117                                       0.61_wp * pt(nzt,j,i) *    &
     1118                                       surf_def_h(2)%qsws(m) )      &
    9211119                                       * heatflux_output_conversion(nzt)
    9221120                   IF ( cloud_droplets )  THEN
    9231121                      sums_l(nzt,45,tn) = sums_l(nzt,45,tn) + (                &
    9241122                                          ( 1.0_wp + 0.61_wp * q(nzt,j,i) -    &
    925                                             ql(nzt,j,i) ) * tswst(j,i) +       &
    926                                            0.61_wp * pt(nzt,j,i) * qswst(j,i) )&
     1123                                            ql(nzt,j,i) ) *                    &
     1124                                            surf_def_h(2)%shf(m) +             &
     1125                                           0.61_wp * pt(nzt,j,i) *             &
     1126                                           surf_def_h(2)%qsws(m) )&
    9271127                                           * heatflux_output_conversion(nzt)
    9281128                   ENDIF
    … …  
    9321132                      sums_l(nzt,51,tn) = sums_l(nzt,51,tn) + &   ! w"q" (w"qv")
    9331133                                          waterflux_output_conversion(nzt) *   &
    934                                           qswst(j,i) * rmask(j,i,sr)
     1134                                          surf_def_h(2)%qsws(m) * rmask(j,i,sr)
    9351135                   ENDIF
    9361136                ENDIF
    9371137                IF ( passive_scalar )  THEN
    9381138                   sums_l(nzt,119,tn) = sums_l(nzt,119,tn) + &
    939                                         sswst(j,i) * rmask(j,i,sr) ! w"s"
     1139                                        surf_def_h(2)%ssws(m) * rmask(j,i,sr) ! w"s"
    9401140                ENDIF
    9411141             ENDIF
    … …  
    9461146!--          ----  speaking the following k-loop would have to be split up and
    9471147!--                rearranged according to the staggered grid.
    948              DO  k = nzb_s_inner(j,i), nzt
     1148             DO  k = nzb, nzt
     1149                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
    9491150                ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +                  &
    9501151                                 u(k+1,j,i) - hom(k+1,1,1,sr) )
    … …  
    9561157!--             Higher moments
    9571158                sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 *        &
    958                                                     rmask(j,i,sr)
     1159                                                    rmask(j,i,sr) * flag
    9591160                sums_l(k,36,tn) = sums_l(k,36,tn) + pts**2 * w(k,j,i) *        &
    960                                                     rmask(j,i,sr)
     1161                                                    rmask(j,i,sr) * flag
    9611162
    9621163!
    … …  
    9681169                                       sa(k+1,j,i) - hom(k+1,1,23,sr) )
    9691170                      sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) *     &
    970                                         rmask(j,i,sr)
     1171                                        rmask(j,i,sr) * flag
    9711172                   ENDIF
    972                    sums_l(k,64,tn) = sums_l(k,64,tn) + rho_ocean(k,j,i) *            &
    973                                                        rmask(j,i,sr)
     1173                   sums_l(k,64,tn) = sums_l(k,64,tn) + rho_ocean(k,j,i) *      &
     1174                                                       rmask(j,i,sr) * flag
    9741175                   sums_l(k,71,tn) = sums_l(k,71,tn) + prho(k,j,i) *           &
    975                                                        rmask(j,i,sr)
     1176                                                       rmask(j,i,sr) * flag
    9761177                ENDIF
    9771178
    … …  
    9851186                      sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) *     &
    9861187                                               heatflux_output_conversion(k) * &
    987                                                           rmask(j,i,sr)
    988                       sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * rmask(j,i,sr)
     1188                                                          rmask(j,i,sr) * flag
     1189                      sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * rmask(j,i,sr) &
     1190                                                                    * flag
    9891191
    9901192                      IF ( .NOT. cloud_droplets )  THEN
    … …  
    9961198                         sums_l(k,52,tn) = sums_l(k,52,tn) + pts * w(k,j,i) *  &
    9971199                                             waterflux_output_conversion(k) *  &
    998                                                              rmask(j,i,sr)
     1200                                                             rmask(j,i,sr)  *  &
     1201                                                             flag
    9991202                         sums_l(k,75,tn) = sums_l(k,75,tn) + qc(k,j,i) *       &
    1000                                                              rmask(j,i,sr)
     1203                                                             rmask(j,i,sr) *   &
     1204                                                             flag
    10011205                         sums_l(k,76,tn) = sums_l(k,76,tn) + prr(k,j,i) *      &
    1002                                                              rmask(j,i,sr)
     1206                                                             rmask(j,i,sr) *   &
     1207                                                             flag
    10031208                         IF ( microphysics_seifert )  THEN
    10041209                            sums_l(k,73,tn) = sums_l(k,73,tn) + nr(k,j,i) *    &
    1005                                                                 rmask(j,i,sr)
     1210                                                                rmask(j,i,sr) *&
     1211                                                                flag
    10061212                            sums_l(k,74,tn) = sums_l(k,74,tn) + qr(k,j,i) *    &
    1007                                                                 rmask(j,i,sr)
     1213                                                                rmask(j,i,sr) *&
     1214                                                                flag
    10081215                         ENDIF
    10091216                      ENDIF
    … …  
    10151222                         sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) *  &
    10161223                                              heatflux_output_conversion(k) *  &
    1017                                                              rmask(j,i,sr)
     1224                                                             rmask(j,i,sr)  *  &
     1225                                                             flag
    10181226                      ELSE IF ( ws_scheme_sca .AND. sr == 0 )  THEN
    10191227                         sums_l(k,46,tn) = ( ( 1.0_wp + 0.61_wp *              &
    … …  
    10221230                                             0.61_wp * hom(k,1,4,sr) *         &
    10231231                                             sums_l(k,49,tn)                   &
    1024                                            ) * heatflux_output_conversion(k)
     1232                                           ) * heatflux_output_conversion(k) * &
     1233                                               flag
    10251234                      END IF
    10261235                   END IF
    … …  
    10331242                                    s(k+1,j,i) - hom(k+1,1,117,sr) )
    10341243                   sums_l(k,116,tn) = sums_l(k,116,tn) + pts * w(k,j,i) *      &
    1035                                                        rmask(j,i,sr)
     1244                                                       rmask(j,i,sr) * flag
    10361245                ENDIF
    10371246
    … …  
    10421251                                             ( ust**2 + vst**2 + w(k,j,i)**2 ) &
    10431252                                           * momentumflux_output_conversion(k) &
    1044                                              * rmask(j,i,sr)
     1253                                           * rmask(j,i,sr) * flag
    10451254             ENDDO
    10461255          ENDDO
    10471256       ENDDO
     1257       !$OMP END PARALLEL
     1258!
     1259!--    Treat land-surface quantities according to new wall model structure.
     1260       IF ( land_surface )  THEN
     1261          tn = 0
     1262          !$OMP PARALLEL PRIVATE( i, j, m, tn )
     1263          !$ tn = omp_get_thread_num()
     1264          !$OMP DO
     1265          DO  m = 1, surf_lsm_h%ns
     1266             i = surf_lsm_h%i(m)
     1267             j = surf_lsm_h%j(m)
     1268       
     1269             IF ( i >= nxl  .AND.  i <= nxr  .AND.                             &
     1270                  j >= nys  .AND.  j <= nyn )  THEN
     1271                sums_l(nzb,93,tn)  = sums_l(nzb,93,tn) + surf_lsm_h%ghf_eb(m)
     1272                sums_l(nzb,94,tn)  = sums_l(nzb,94,tn) + surf_lsm_h%shf_eb(m)
     1273                sums_l(nzb,95,tn)  = sums_l(nzb,95,tn) + surf_lsm_h%qsws_eb(m)
     1274                sums_l(nzb,96,tn)  = sums_l(nzb,96,tn) + surf_lsm_h%qsws_liq_eb(m)
     1275                sums_l(nzb,97,tn)  = sums_l(nzb,97,tn) + surf_lsm_h%qsws_soil_eb(m)
     1276                sums_l(nzb,98,tn)  = sums_l(nzb,98,tn) + surf_lsm_h%qsws_veg_eb(m)
     1277                sums_l(nzb,99,tn)  = sums_l(nzb,99,tn) + surf_lsm_h%r_a(m)
     1278                sums_l(nzb,100,tn) = sums_l(nzb,100,tn)+ surf_lsm_h%r_s(m)
     1279             ENDIF
     1280          ENDDO
     1281          !$OMP END PARALLEL
     1282
     1283          tn = 0
     1284          !$OMP PARALLEL PRIVATE( i, j, k, m, tn )
     1285          !$ tn = omp_get_thread_num()
     1286          !$OMP DO
     1287          DO  m = 1, surf_lsm_h%ns
     1288
     1289             i = surf_lsm_h%i(m)           
     1290             j = surf_lsm_h%j(m)
     1291
     1292             IF ( i >= nxl  .AND.  i <= nxr  .AND.                             &
     1293                  j >= nys  .AND.  j <= nyn )  THEN
     1294
     1295                DO  k = nzb_soil, nzt_soil
     1296                   sums_l(k,89,tn)  = sums_l(k,89,tn)  + t_soil_h%var_2d(k,m)  &
     1297                                      * rmask(j,i,sr)
     1298                   sums_l(k,91,tn)  = sums_l(k,91,tn)  + m_soil_h%var_2d(k,m)  &
     1299                                      * rmask(j,i,sr)
     1300                ENDDO
     1301             ENDIF
     1302          ENDDO
     1303          !$OMP END PARALLEL
     1304       ENDIF
    10481305!
    10491306!--    For speed optimization fluxes which have been computed in part directly
    10501307!--    inside the WS advection routines are treated seperatly
    10511308!--    Momentum fluxes first:
     1309
     1310       tn = 0
     1311       !$OMP PARALLEL PRIVATE( i, j, k, tn, flag )
     1312       !$ tn = omp_get_thread_num()
    10521313       IF ( .NOT. ws_scheme_mom .OR. sr /= 0  )  THEN
    1053          !$OMP DO
    1054          DO  i = nxl, nxr
    1055             DO  j = nys, nyn
    1056                DO  k = nzb_diff_s_inner(j,i)-1, nzt_diff
    1057                   ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +                &
    1058                                    u(k+1,j,i) - hom(k+1,1,1,sr) )
    1059                   vst = 0.5_wp * ( v(k,j,i)   - hom(k,1,2,sr) +                &
    1060                                    v(k+1,j,i) - hom(k+1,1,2,sr) )
    1061 !
    1062 !--               Momentum flux w*u*
    1063                   sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5_wp *                 &
    1064                                                     ( w(k,j,i-1) + w(k,j,i) )  &
    1065                                           * momentumflux_output_conversion(k)  &
    1066                                                     * ust * rmask(j,i,sr)
    1067 !
    1068 !--               Momentum flux w*v*
    1069                   sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5_wp *                 &
    1070                                                     ( w(k,j-1,i) + w(k,j,i) )  &
    1071                                           * momentumflux_output_conversion(k)  &
    1072                                                     * vst * rmask(j,i,sr)
    1073                ENDDO
    1074             ENDDO
    1075          ENDDO
     1314          !$OMP DO
     1315          DO  i = nxl, nxr
     1316             DO  j = nys, nyn
     1317                DO  k = nzb, nzt
     1318!
     1319!--                Flag 23 is used to mask surface fluxes as well as model-top
     1320!--                fluxes, which are added further below.
     1321                   flag = MERGE( 1.0_wp, 0.0_wp,                               &
     1322                                 BTEST( wall_flags_0(k,j,i), 23 ) ) *          &
     1323                          MERGE( 1.0_wp, 0.0_wp,                               &
     1324                                 BTEST( wall_flags_0(k,j,i), 9  ) )
     1325
     1326                   ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +               &
     1327                                    u(k+1,j,i) - hom(k+1,1,1,sr) )
     1328                   vst = 0.5_wp * ( v(k,j,i)   - hom(k,1,2,sr) +               &
     1329                                    v(k+1,j,i) - hom(k+1,1,2,sr) )
     1330!
     1331!--                Momentum flux w*u*
     1332                   sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5_wp *                &
     1333                                                     ( w(k,j,i-1) + w(k,j,i) ) &
     1334                                           * momentumflux_output_conversion(k) &
     1335                                                     * ust * rmask(j,i,sr)     &
     1336                                                           * flag
     1337!
     1338!--                Momentum flux w*v*
     1339                   sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5_wp *                &
     1340                                                     ( w(k,j-1,i) + w(k,j,i) ) &
     1341                                           * momentumflux_output_conversion(k) &
     1342                                                     * vst * rmask(j,i,sr)     &
     1343                                                           * flag
     1344                ENDDO
     1345             ENDDO
     1346          ENDDO
    10761347
    10771348       ENDIF
    10781349       IF ( .NOT. ws_scheme_sca .OR. sr /= 0 )  THEN
    1079          !$OMP DO
    1080          DO  i = nxl, nxr
    1081             DO  j = nys, nyn
    1082                DO  k = nzb_diff_s_inner(j,i)-1, nzt_diff
    1083 !
    1084 !--               Vertical heat flux
    1085                   sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5_wp *                 &
     1350          !$OMP DO
     1351          DO  i = nxl, nxr
     1352             DO  j = nys, nyn
     1353                DO  k = nzb, nzt
     1354                   flag = MERGE( 1.0_wp, 0.0_wp,                               &
     1355                                 BTEST( wall_flags_0(k,j,i), 23 ) ) *          &
     1356                          MERGE( 1.0_wp, 0.0_wp,                               &
     1357                                 BTEST( wall_flags_0(k,j,i), 9  ) )
     1358!
     1359!--                Vertical heat flux
     1360                   sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5_wp *                &
    10861361                           ( pt(k,j,i)   - hom(k,1,4,sr) +                     &
    10871362                             pt(k+1,j,i) - hom(k+1,1,4,sr) )                   &
    10881363                           * heatflux_output_conversion(k)                     &
    1089                            * w(k,j,i) * rmask(j,i,sr)
    1090                   IF ( humidity )  THEN
    1091                      pts = 0.5_wp * ( q(k,j,i)   - hom(k,1,41,sr) +            &
     1364                           * w(k,j,i) * rmask(j,i,sr) * flag
     1365                   IF ( humidity )  THEN
     1366                      pts = 0.5_wp * ( q(k,j,i)   - hom(k,1,41,sr) +           &
    10921367                                      q(k+1,j,i) - hom(k+1,1,41,sr) )
    1093                      sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) *      &
     1368                      sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) *     &
    10941369                                       waterflux_output_conversion(k) *        &
    1095                                        rmask(j,i,sr)
    1096                   ENDIF
    1097                   IF ( passive_scalar )  THEN
    1098                      pts = 0.5_wp * ( s(k,j,i)   - hom(k,1,117,sr) +            &
     1370                                       rmask(j,i,sr) * flag
     1371                   ENDIF
     1372                   IF ( passive_scalar )  THEN
     1373                      pts = 0.5_wp * ( s(k,j,i)   - hom(k,1,117,sr) +           &
    10991374                                      s(k+1,j,i) - hom(k+1,1,117,sr) )
    1100                      sums_l(k,116,tn) = sums_l(k,116,tn) + pts * w(k,j,i) *     &
    1101                                         rmask(j,i,sr)
    1102                   ENDIF
    1103                ENDDO
    1104             ENDDO
    1105          ENDDO
     1375                      sums_l(k,116,tn) = sums_l(k,116,tn) + pts * w(k,j,i) *    &
     1376                                        rmask(j,i,sr) * flag
     1377                   ENDIF
     1378                ENDDO
     1379             ENDDO
     1380          ENDDO
    11061381
    11071382       ENDIF
    … …  
    11261401          DO  i = nxl, nxr
    11271402             DO  j = nys, nyn
    1128                 DO  k = nzb_s_inner(j,i)+1, nzt
     1403                DO  k = nzb+1, nzt
     1404                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    11291405
    11301406                   sums_ll(k,1) = sums_ll(k,1) + 0.5_wp * w(k,j,i) * (         &
    … …  
    11331409                + ( 0.25_wp * ( v(k,j,i)+v(k+1,j,i)+v(k,j+1,i)+v(k+1,j+1,i) )  &
    11341410                            - 0.5_wp * ( hom(k,1,2,sr) + hom(k+1,1,2,sr) ) )**2&
    1135                 + w(k,j,i)**2                                        )
     1411                + w(k,j,i)**2                                        ) * flag
    11361412
    11371413                   sums_ll(k,2) = sums_ll(k,2) + 0.5_wp * w(k,j,i)             &
    1138                                                * ( p(k,j,i) + p(k+1,j,i) )
     1414                                               * ( p(k,j,i) + p(k+1,j,i) ) * flag
    11391415
    11401416                ENDDO
    … …  
    11641440          DO  i = nxl, nxr
    11651441             DO  j = nys, nyn
    1166                 DO  k = nzb_s_inner(j,i)+1, nzt
     1442                DO  k = nzb+1, nzt
     1443
     1444                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    11671445
    11681446                   sums_l(k,57,tn) = sums_l(k,57,tn) - 0.5_wp * (              &
    11691447                   (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
    11701448                 - (km(k-1,j,i)+km(k,j,i)) * (e(k,j,i)-e(k-1,j,i)) * ddzu(k)   &
    1171                                                                 ) * ddzw(k)
     1449                                                                ) * ddzw(k)    &
     1450                                                                  * flag
    11721451
    11731452                   sums_l(k,69,tn) = sums_l(k,69,tn) - 0.5_wp * (              &
    11741453                   (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
    1175                                                                 )
     1454                                                                )  * flag
    11761455
    11771456                ENDDO
    … …  
    11911470          DO  i = nxl, nxr
    11921471             DO  j = nys, nyn
    1193                 DO  k = nzb_s_inner(j,i)+1, nzt
     1472                DO  k = nzb+1, nzt
     1473                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    11941474!
    11951475!--                Subgrid horizontal heat fluxes u"pt", v"pt"
    … …  
    11991479                                               * rho_air_zw(k)                 &
    12001480                                               * heatflux_output_conversion(k) &
    1201                                                  * ddx * rmask(j,i,sr)
     1481                                                 * ddx * rmask(j,i,sr) * flag
    12021482                   sums_l(k,61,tn) = sums_l(k,61,tn) - 0.5_wp *                &
    12031483                                                   ( kh(k,j,i) + kh(k,j-1,i) ) &
    … …  
    12051485                                               * rho_air_zw(k)                 &
    12061486                                               * heatflux_output_conversion(k) &
    1207                                                  * ddy * rmask(j,i,sr)
     1487                                                 * ddy * rmask(j,i,sr) * flag
    12081488!
    12091489!--                Resolved horizontal heat fluxes u*pt*, v*pt*
    … …  
    12121492                                    * 0.5_wp * ( pt(k,j,i-1) - hom(k,1,4,sr) + &
    12131493                                                 pt(k,j,i)   - hom(k,1,4,sr) ) &
    1214                                                * heatflux_output_conversion(k)
     1494                                               * heatflux_output_conversion(k) &
     1495                                               * flag
    12151496                   pts = 0.5_wp * ( pt(k,j-1,i) - hom(k,1,4,sr) +              &
    12161497                                    pt(k,j,i)   - hom(k,1,4,sr) )
    … …  
    12191500                                    * 0.5_wp * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
    12201501                                                 pt(k,j,i)   - hom(k,1,4,sr) ) &
    1221                                                * heatflux_output_conversion(k)
     1502                                               * heatflux_output_conversion(k) &
     1503                                               * flag
    12221504                ENDDO
    12231505             ENDDO
    … …  
    12791561       ENDIF
    12801562
     1563       tn = 0
    12811564       !$OMP PARALLEL PRIVATE( i, j, k, tn )
    1282 !$     tn = omp_get_thread_num()
    1283        IF ( land_surface )  THEN
    1284           !$OMP DO
    1285           DO  i = nxl, nxr
    1286              DO  j =  nys, nyn
    1287                 DO  k = nzb_soil, nzt_soil
    1288                    sums_l(k,89,tn)  = sums_l(k,89,tn)  + t_soil(k,j,i)         &
    1289                                       * rmask(j,i,sr)
    1290                    sums_l(k,91,tn)  = sums_l(k,91,tn)  + m_soil(k,j,i)         &
    1291                                       * rmask(j,i,sr)
    1292                 ENDDO
    1293              ENDDO
    1294           ENDDO
    1295        ENDIF
    1296        
     1565       !$ tn = omp_get_thread_num()       
    12971566       IF ( radiation .AND. radiation_scheme == 'rrtmg' )  THEN
    12981567          !$OMP DO
    12991568          DO  i = nxl, nxr
    13001569             DO  j =  nys, nyn
    1301                 DO  k = nzb_s_inner(j,i)+1, nzt+1
     1570                DO  k = nzb+1, nzt+1
     1571                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1572
    13021573                   sums_l(k,102,tn)  = sums_l(k,102,tn)  + rad_lw_in(k,j,i)    &
    1303                                        * rmask(j,i,sr)
     1574                                       * rmask(j,i,sr) * flag
    13041575                   sums_l(k,103,tn)  = sums_l(k,103,tn)  + rad_lw_out(k,j,i)   &
    1305                                        * rmask(j,i,sr)
     1576                                       * rmask(j,i,sr) * flag
    13061577                   sums_l(k,104,tn)  = sums_l(k,104,tn)  + rad_sw_in(k,j,i)    &
    1307                                        * rmask(j,i,sr)
     1578                                       * rmask(j,i,sr) * flag
    13081579                   sums_l(k,105,tn)  = sums_l(k,105,tn)  + rad_sw_out(k,j,i)   &
    1309                                        * rmask(j,i,sr)
     1580                                       * rmask(j,i,sr) * flag
    13101581                   sums_l(k,106,tn)  = sums_l(k,106,tn)  + rad_lw_cs_hr(k,j,i) &
    1311                                        * rmask(j,i,sr)
     1582                                       * rmask(j,i,sr) * flag
    13121583                   sums_l(k,107,tn)  = sums_l(k,107,tn)  + rad_lw_hr(k,j,i)    &
    1313                                        * rmask(j,i,sr)
     1584                                       * rmask(j,i,sr) * flag
    13141585                   sums_l(k,108,tn)  = sums_l(k,108,tn)  + rad_sw_cs_hr(k,j,i) &
    1315                                        * rmask(j,i,sr)
     1586                                       * rmask(j,i,sr) * flag
    13161587                   sums_l(k,109,tn)  = sums_l(k,109,tn)  + rad_sw_hr(k,j,i)    &
    1317                                        * rmask(j,i,sr)
     1588                                       * rmask(j,i,sr) * flag
    13181589                ENDDO
    13191590             ENDDO

  • palm/trunk/SOURCE/header.f90

    r2201 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
     23! Generic tunnel setup added
    2324!
    2425! Former revisions:
    … …  
    293294
    294295    USE arrays_3d,                                                             &
    295         ONLY:  pt_init, qsws, q_init, s_init, sa_init, shf, ug, vg, w_subs, zu,&
    296                zw
     296        ONLY:  pt_init, q_init, s_init, sa_init, ug, vg, w_subs, zu, zw
    297297       
    298298    USE control_parameters
    … …  
    320320 
    321321    USE land_surface_model_mod,                                                &
    322         ONLY: land_surface, lsm_header
     322        ONLY: lsm_header
    323323
    324324    USE microphysics_mod,                                                      &
    … …  
    362362    USE spectra_mod,                                                           &
    363363        ONLY:  calculate_spectra, spectra_header
     364
     365    USE surface_mod,                                                           &
     366        ONLY:  surf_def_h
    364367
    365368    IMPLICIT NONE
    … …  
    933936          ENDIF
    934937
     938       CASE ( 'tunnel' )
     939          IF ( tunnel_width_x /= 9999999.9_wp )  THEN
     940!
     941!--          Tunnel axis in y direction
     942             IF ( tunnel_length == 9999999.9_wp  .OR.                          &
     943                  tunnel_length >= ( nx + 1 ) * dx )  THEN
     944                WRITE ( io, 273 )  'y', tunnel_height, tunnel_wall_depth,      &
     945                                        tunnel_width_x
     946             ELSE
     947                WRITE ( io, 274 )  'y', tunnel_height, tunnel_wall_depth,      &
     948                                        tunnel_width_x, tunnel_length
     949             ENDIF
     950
     951          ELSEIF ( tunnel_width_y /= 9999999.9_wp )  THEN
     952!
     953!--          Tunnel axis in x direction
     954             IF ( tunnel_length == 9999999.9_wp  .OR.                          &
     955                  tunnel_length >= ( ny + 1 ) * dy )  THEN
     956                WRITE ( io, 273 )  'x', tunnel_height, tunnel_wall_depth,      &
     957                                        tunnel_width_y
     958             ELSE
     959                WRITE ( io, 274 )  'x', tunnel_height, tunnel_wall_depth,      &
     960                                        tunnel_width_y, tunnel_length
     961             ENDIF
     962          ENDIF
     963
    935964    END SELECT
    936965
    … …  
    10651094       IF ( constant_heatflux )  THEN
    10661095          IF ( large_scale_forcing .AND. lsf_surf )  THEN
    1067              WRITE ( io, 306 )  shf(0,0)
     1096             IF ( surf_def_h(0)%ns >= 1 )  WRITE ( io, 306 )  surf_def_h(0)%shf(1)
    10681097          ELSE
    10691098             WRITE ( io, 306 )  surface_heatflux
    … …  
    10731102       IF ( humidity  .AND.  constant_waterflux )  THEN
    10741103          IF ( large_scale_forcing .AND. lsf_surf )  THEN
    1075              WRITE ( io, 311 ) qsws(0,0)
     1104             WRITE ( io, 311 ) surf_def_h(0)%qsws(1)
    10761105          ELSE
    10771106             WRITE ( io, 311 ) surface_waterflux
    … …  
    20242053              ' Canyon height: ', F6.2, 'm, ch = ', I4, '.'      / &
    20252054              ' Canyon position (',A,'-walls): cxl = ', I4,', cxr = ', I4, '.')
     2055273 FORMAT (  ' Tunnel of infinite length in ',A, &
     2056              ' direction' / &
     2057              ' Tunnel height: ', F6.2, / &
     2058              ' Tunnel-wall depth: ', F6.2      / &
     2059              ' Tunnel width: ', F6.2 )
     2060274 FORMAT (  ' Tunnel in ', A, ' direction.' / &
     2061              ' Tunnel height: ', F6.2, / &   
     2062              ' Tunnel-wall depth: ', F6.2      / &
     2063              ' Tunnel width: ', F6.2, / &
     2064              ' Tunnel length: ', F6.2 )
    20262065278 FORMAT (' Topography grid definition convention:'/ &
    20272066            ' cell edge (staggered grid points'/  &

  • palm/trunk/SOURCE/init_3d_model.f90

    r2173 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography and surface concept:
     23!   - Modify passed parameters for disturb_field
     24!   - Topography representation via flags
     25!   - Remove unused arrays.
     26!   - Move initialization of surface-related quantities to surface_mod
    2327!
    2428! Former revisions:
    … …  
    346350
    347351    USE land_surface_model_mod,                                                &
    348         ONLY:  lsm_init, lsm_init_arrays, land_surface
     352        ONLY:  lsm_init, lsm_init_arrays
    349353 
    350354    USE ls_forcing_mod
    … …  
    383387    USE surface_layer_fluxes_mod,                                              &
    384388        ONLY:  init_surface_layer_fluxes
     389
     390    USE surface_mod,                                                           &
     391        ONLY :  init_surface_arrays, init_surfaces, surf_def_h, surf_lsm_h,    &
     392                surf_usm_h
    385393   
    386394    USE transpose_indices
    … …  
    398406    INTEGER(iwp) ::  j             !<
    399407    INTEGER(iwp) ::  k             !<
    400     INTEGER(iwp) ::  sr            !<
     408    INTEGER(iwp) ::  k_surf        !< surface level index
     409    INTEGER(iwp) ::  m             !< index of surface element in surface data type
     410    INTEGER(iwp) ::  sr            !< index of statistic region
    401411
    402412    INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::  ngp_2dh_l  !<
    … …  
    447457              ts_value(dots_max,0:statistic_regions) )
    448458    ALLOCATE( ptdf_x(nxlg:nxrg), ptdf_y(nysg:nyng) )
    449 
    450     ALLOCATE( ol(nysg:nyng,nxlg:nxrg), shf(nysg:nyng,nxlg:nxrg),               &
    451               ts(nysg:nyng,nxlg:nxrg), tswst(nysg:nyng,nxlg:nxrg),             &
    452               us(nysg:nyng,nxlg:nxrg), usws(nysg:nyng,nxlg:nxrg),              &
    453               uswst(nysg:nyng,nxlg:nxrg), vsws(nysg:nyng,nxlg:nxrg),           &
    454               vswst(nysg:nyng,nxlg:nxrg), z0(nysg:nyng,nxlg:nxrg),             &
    455               z0h(nysg:nyng,nxlg:nxrg), z0q(nysg:nyng,nxlg:nxrg) )
    456459
    457460    ALLOCATE( d(nzb+1:nzt,nys:nyn,nxl:nxr),                                    &
    … …  
    519522    IF ( humidity )  THEN
    520523!
    521 !--    2D-humidity
    522        ALLOCATE ( qs(nysg:nyng,nxlg:nxrg),                                     &
    523                   qsws(nysg:nyng,nxlg:nxrg),                                   &
    524                   qswst(nysg:nyng,nxlg:nxrg) )
    525 
    526 !
    527524!--    3D-humidity
    528525#if defined( __nopointer )
    … …  
    571568
    572569             IF ( microphysics_seifert )  THEN
    573 !
    574 !--             2D-rain water content and rain drop concentration arrays
    575                 ALLOCATE ( qrs(nysg:nyng,nxlg:nxrg),                        &
    576                            qrsws(nysg:nyng,nxlg:nxrg),                      &
    577                            qrswst(nysg:nyng,nxlg:nxrg),                     &
    578                            nrs(nysg:nyng,nxlg:nxrg),                        &
    579                            nrsws(nysg:nyng,nxlg:nxrg),                      &
    580                            nrswst(nysg:nyng,nxlg:nxrg) )
    581570!
    582571!--             3D-rain water content, rain drop concentration arrays
    … …  
    622611   
    623612    IF ( passive_scalar )  THEN
    624 !
    625 !--    2D-scalar arrays
    626        ALLOCATE ( ss(nysg:nyng,nxlg:nxrg),                                     &
    627                   ssws(nysg:nyng,nxlg:nxrg),                                   &
    628                   sswst(nysg:nyng,nxlg:nxrg) )
    629613
    630614!
    … …  
    642626
    643627    IF ( ocean )  THEN
    644        ALLOCATE( saswsb(nysg:nyng,nxlg:nxrg),                                  &
    645                  saswst(nysg:nyng,nxlg:nxrg) )
    646628#if defined( __nopointer )
    647629       ALLOCATE( prho(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                          &
    … …  
    660642                      ! density to be apointer
    661643#endif
    662        IF ( humidity_remote )  THEN
    663           ALLOCATE( qswst_remote(nysg:nyng,nxlg:nxrg))
    664           qswst_remote = 0.0_wp
    665        ENDIF
    666644    ENDIF
    667645
    … …  
    818796
    819797!
    820 !-- 4D-array for storing the Rif-values at vertical walls
    821     IF ( topography /= 'flat' )  THEN
    822        ALLOCATE( rif_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:4) )
    823        rif_wall = 0.0_wp
    824     ENDIF
    825 
    826 !
    827798!-- Arrays to store velocity data from t-dt and the phase speeds which
    828799!-- are needed for radiation boundary conditions
    … …  
    901872    ENDIF
    902873#endif
    903 
     874!
     875!-- Initialize wall arrays
     876    CALL init_surface_arrays
    904877!
    905878!-- Allocate land surface model arrays
    … …  
    944917    sums_up_fraction_l = 0.0_wp
    945918    sums_wsts_bc_l     = 0.0_wp
    946 
    947919
    948920!
    … …  
    1007979             hom(:,1,25,:) = SPREAD( l1d, 2, statistic_regions+1 )
    1008980
    1009              IF ( constant_flux_layer )  THEN
    1010                 ol   = ( zu(nzb+1) - zw(nzb) ) / ( rif1d(nzb+1) + 1.0E-20_wp )
    1011                 ts   = 0.0_wp  ! could actually be computed more accurately in the
    1012                                ! 1D model. Update when opportunity arises.
    1013                 us   = us1d
    1014                 usws = usws1d
    1015                 vsws = vsws1d
    1016              ELSE
    1017                 ts   = 0.0_wp  ! must be set, because used in
    1018                 ol   = ( zu(nzb+1) - zw(nzb) ) / zeta_min  ! flowste
    1019                 us   = 0.0_wp
    1020                 usws = 0.0_wp
    1021                 vsws = 0.0_wp
    1022              ENDIF
    1023 
    1024981          ELSE
    1025982             e    = 0.0_wp  ! must be set, because used in
    1026              ol   = ( zu(nzb+1) - zw(nzb) ) / zeta_min  ! flowste
    1027              ts   = 0.0_wp
    1028              us   = 0.0_wp
    1029              usws = 0.0_wp
    1030              vsws = 0.0_wp
    1031           ENDIF
    1032           uswst = top_momentumflux_u * momentumflux_input_conversion(nzt+1)
    1033           vswst = top_momentumflux_v * momentumflux_input_conversion(nzt+1)
    1034 
    1035 !
    1036 !--       In every case qs = 0.0 (see also pt)
    1037 !--       This could actually be computed more accurately in the 1D model.
    1038 !--       Update when opportunity arises!
    1039           IF ( humidity )  THEN
    1040              qs = 0.0_wp
    1041              IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    1042                 qrs = 0.0_wp
    1043                 nrs = 0.0_wp
    1044              ENDIF
    1045           ENDIF
    1046 !
    1047 !--       Initialize scaling parameter for passive scalar
    1048           IF ( passive_scalar ) ss = 0.0_wp         
    1049 
     983          ENDIF
    1050984!
    1051985!--       Inside buildings set velocities back to zero
    … …  
    1053987             DO  i = nxlg, nxrg
    1054988                DO  j = nysg, nyng
    1055                    u(nzb:nzb_u_inner(j,i),j,i) = 0.0_wp
    1056                    v(nzb:nzb_v_inner(j,i),j,i) = 0.0_wp
     989                   DO  k = nzb, nzt
     990                      u(k,j,i) = MERGE( u(k,j,i), 0.0_wp,                      &
     991                                        BTEST( wall_flags_0(k,j,i), 1 ) )
     992                      v(k,j,i) = MERGE( v(k,j,i), 0.0_wp,                      &
     993                                        BTEST( wall_flags_0(k,j,i), 2 ) )
     994                   ENDDO
    1057995                ENDDO
    1058996             ENDDO
    … …  
    10701008                DO  i = nxl-1, nxr+1
    10711009                   DO  j = nys-1, nyn+1
    1072                       IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = u(1,j,i)
    1073                       IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = v(1,j,i)
     1010                      u(nzb,j,i) = u(nzb+1,j,i)
     1011                      v(nzb,j,i) = v(nzb+1,j,i)
    10741012                   ENDDO
    10751013                ENDDO
    … …  
    11191057             DO  i = nxlg, nxrg
    11201058                DO  j = nysg, nyng
    1121                    u(nzb:nzb_u_inner(j,i)+1,j,i) = 0.0_wp
    1122                    v(nzb:nzb_v_inner(j,i)+1,j,i) = 0.0_wp
     1059                   DO  k = nzb, nzt
     1060                      u(k,j,i) = MERGE( u(k,j,i), 0.0_wp,                      &
     1061                                        BTEST( wall_flags_0(k,j,i), 20 ) )
     1062                      v(k,j,i) = MERGE( v(k,j,i), 0.0_wp,                      &
     1063                                        BTEST( wall_flags_0(k,j,i), 21 ) )
     1064                   ENDDO
    11231065                ENDDO
    11241066             ENDDO
    … …  
    11831125             e    = 0.0_wp
    11841126          ENDIF
    1185           ol    = ( zu(nzb+1) - zw(nzb) ) / zeta_min
    1186           ts    = 0.0_wp
    1187 !
    1188 !--       Very small number is required for calculation of Obukhov length
    1189 !--       at first timestep     
    1190           us    = 1E-30_wp
    1191           usws  = 0.0_wp
    1192           uswst = top_momentumflux_u * momentumflux_input_conversion(nzt+1)
    1193           vsws  = 0.0_wp
    1194           vswst = top_momentumflux_v * momentumflux_input_conversion(nzt+1)
    1195           IF ( humidity )       qs = 0.0_wp
    1196           IF ( passive_scalar ) ss = 0.0_wp
    1197 
    11981127!
    11991128!--       Compute initial temperature field and other constants used in case
    … …  
    12821211          CALL init_parallel_random_generator(nx, ny, nys, nyn, nxl, nxr)
    12831212       ENDIF
    1284 
    1285 !
    1286 !--    Initialize fluxes at bottom surface
    1287        IF ( use_surface_fluxes )  THEN
    1288 
    1289           IF ( constant_heatflux )  THEN
    1290 !
    1291 !--          Heat flux is prescribed
    1292              IF ( random_heatflux )  THEN
    1293                 CALL disturb_heatflux
    1294              ELSE
    1295                 shf = surface_heatflux * heatflux_input_conversion(nzb)
    1296 !
    1297 !--             Initialize shf with data from external file LSF_DATA
    1298                 IF ( large_scale_forcing .AND. lsf_surf )  THEN
    1299                    CALL ls_forcing_surf ( simulated_time )
    1300                 ENDIF
    1301 
    1302 !
    1303 !--             Over topography surface_heatflux is replaced by wall_heatflux(0)
    1304                 IF ( TRIM( topography ) /= 'flat' )  THEN
    1305                    DO  i = nxlg, nxrg
    1306                       DO  j = nysg, nyng
    1307                          IF ( nzb_s_inner(j,i) /= 0 )  THEN
    1308                             shf(j,i) = wall_heatflux(0)                        &
    1309                                   * heatflux_input_conversion(nzb_s_inner(j,i))
    1310                          ENDIF
    1311                       ENDDO
    1312                    ENDDO
    1313                 ENDIF
    1314              ENDIF
    1315           ENDIF
    1316 
    1317 !
    1318 !--       Determine the near-surface water flux
    1319           IF ( humidity )  THEN
    1320              IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    1321                 qrsws = 0.0_wp
    1322                 nrsws = 0.0_wp
    1323              ENDIF
    1324              IF ( constant_waterflux )  THEN
    1325                 qsws   = surface_waterflux * waterflux_input_conversion(nzb)
    1326 !
    1327 !--             Over topography surface_waterflux is replaced by
    1328 !--             wall_humidityflux(0)
    1329                 IF ( TRIM( topography ) /= 'flat' )  THEN
    1330                    wall_qflux = wall_humidityflux
    1331                    DO  i = nxlg, nxrg
    1332                       DO  j = nysg, nyng
    1333                          IF ( nzb_s_inner(j,i) /= 0 )  THEN
    1334                             qsws(j,i) = wall_qflux(0)                          &
    1335                                  * waterflux_input_conversion(nzb_s_inner(j,i))
    1336                          ENDIF
    1337                       ENDDO
    1338                    ENDDO
    1339                 ENDIF
    1340              ENDIF
    1341           ENDIF
    1342 !
    1343 !--       Initialize the near-surface scalar flux
    1344           IF ( passive_scalar )  THEN
    1345              IF ( constant_scalarflux )  THEN
    1346                 ssws   = surface_scalarflux
    1347 !
    1348 !--             Over topography surface_scalarflux is replaced by
    1349 !--             wall_scalarflux(0)
    1350                 IF ( TRIM( topography ) /= 'flat' )  THEN
    1351                    wall_sflux = wall_scalarflux
    1352                    DO  i = nxlg, nxrg
    1353                       DO  j = nysg, nyng
    1354                          IF ( nzb_s_inner(j,i) /= 0 )  ssws(j,i) = wall_sflux(0)
    1355                       ENDDO
    1356                    ENDDO
    1357                 ENDIF
    1358              ENDIF
    1359           ENDIF   
    1360 !
    1361 !--       Initialize near-surface salinity flux
    1362           IF ( ocean )  saswsb = bottom_salinityflux
    1363 
    1364        ENDIF
    1365 
    1366 !
    1367 !--    Initialize fluxes at top surface
    1368 !--    Currently, only the heatflux and salinity flux can be prescribed.
    1369 !--    The latent flux is zero in this case!
    1370        IF ( use_top_fluxes )  THEN
    1371 !
    1372 !--       Prescribe to heat flux
    1373           IF ( constant_top_heatflux )  tswst = top_heatflux                   &
    1374                                              * heatflux_input_conversion(nzt+1)
    1375 !
    1376 !--       Prescribe zero latent flux at the top     
    1377           IF ( humidity )  THEN
    1378              qswst = 0.0_wp
    1379              IF ( cloud_physics  .AND.  microphysics_seifert ) THEN
    1380                 nrswst = 0.0_wp
    1381                 qrswst = 0.0_wp
    1382              ENDIF
    1383           ENDIF
    1384 !
    1385 !--       Prescribe top scalar flux
    1386           IF ( passive_scalar .AND. constant_top_scalarflux )                  &
    1387              sswst = top_scalarflux
    1388 !
    1389 !--       Prescribe top salinity flux
    1390           IF ( ocean .AND. constant_top_salinityflux)                          &
    1391              saswst = top_salinityflux
    1392 !
    1393 !--       Initialization in case of a coupled model run
    1394           IF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
    1395              tswst = 0.0_wp
    1396           ENDIF
    1397 
    1398        ENDIF
    1399 
    1400 !
    1401 !--    Initialize Prandtl layer quantities
    1402        IF ( constant_flux_layer )  THEN
    1403 
    1404           z0 = roughness_length
    1405           z0h = z0h_factor * z0
    1406           z0q = z0h_factor * z0
    1407 
    1408           IF ( .NOT. constant_heatflux )  THEN
    1409 !
    1410 !--          Surface temperature is prescribed. Here the heat flux cannot be
    1411 !--          simply estimated, because therefore ol, u* and theta* would have
    1412 !--          to be computed by iteration. This is why the heat flux is assumed
    1413 !--          to be zero before the first time step. It approaches its correct
    1414 !--          value in the course of the first few time steps.
    1415              shf   = 0.0_wp
    1416           ENDIF
    1417 
    1418           IF ( humidity  )  THEN
    1419              IF (  .NOT.  constant_waterflux )  qsws   = 0.0_wp
    1420              IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    1421                 qrsws = 0.0_wp
    1422                 nrsws = 0.0_wp
    1423              ENDIF
    1424           ENDIF
    1425           IF ( passive_scalar  .AND.  .NOT.  constant_scalarflux )  ssws = 0.0_wp
    1426 
    1427        ENDIF
    1428 
    14291213!
    14301214!--    Set the reference state to be used in the buoyancy terms (for ocean runs
    … …  
    15221306
    15231307    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.         &
    1524          TRIM( initializing_actions ) == 'cyclic_fill' )                       &
     1308             TRIM( initializing_actions ) == 'cyclic_fill' )                   &
    15251309    THEN
    15261310
    15271311       CALL location_message( 'initializing in case of restart / cyclic_fill', &
    15281312                              .FALSE. )
     1313!
     1314!--    Initialize surface elements and its attributes, e.g. heat- and
     1315!--    momentumfluxes, roughness, scaling parameters. As number of surface
     1316!--    elements might be different between runs, e.g. in case of cyclic fill,
     1317!--    and not all surface elements are read, surface elements need to be
     1318!--    initialized before.     
     1319       CALL init_surfaces
    15291320!
    15301321!--    When reading data for cyclic fill of 3D prerun data files, read
    … …  
    16711462          DO  i = nxlg, nxrg
    16721463             DO  j = nysg, nyng
    1673                 u  (nzb:nzb_u_inner(j,i),j,i)   = 0.0_wp
    1674                 v  (nzb:nzb_v_inner(j,i),j,i)   = 0.0_wp
    1675                 w  (nzb:nzb_w_inner(j,i),j,i)   = 0.0_wp
    1676                 e  (nzb:nzb_w_inner(j,i),j,i)   = 0.0_wp
    1677                 tu_m(nzb:nzb_u_inner(j,i),j,i)  = 0.0_wp
    1678                 tv_m(nzb:nzb_v_inner(j,i),j,i)  = 0.0_wp
    1679                 tw_m(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
    1680                 te_m(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
    1681                 tpt_m(nzb:nzb_w_inner(j,i),j,i) = 0.0_wp
     1464                DO  k = nzb, nzt
     1465                   u(k,j,i)     = MERGE( u(k,j,i), 0.0_wp,                     &
     1466                                         BTEST( wall_flags_0(k,j,i), 1 ) )
     1467                   v(k,j,i)     = MERGE( v(k,j,i), 0.0_wp,                     &
     1468                                         BTEST( wall_flags_0(k,j,i), 2 ) )
     1469                   w(k,j,i)     = MERGE( w(k,j,i), 0.0_wp,                     &
     1470                                         BTEST( wall_flags_0(k,j,i), 3 ) )
     1471                   e(k,j,i)     = MERGE( e(k,j,i), 0.0_wp,                     &
     1472                                         BTEST( wall_flags_0(k,j,i), 0 ) )
     1473                   tu_m(k,j,i)  = MERGE( tu_m(k,j,i), 0.0_wp,                  &
     1474                                         BTEST( wall_flags_0(k,j,i), 1 ) )
     1475                   tv_m(k,j,i)  = MERGE( tv_m(k,j,i), 0.0_wp,                  &
     1476                                         BTEST( wall_flags_0(k,j,i), 2 ) )
     1477                   tw_m(k,j,i)  = MERGE( tw_m(k,j,i), 0.0_wp,                  &
     1478                                         BTEST( wall_flags_0(k,j,i), 3 ) )
     1479                   te_m(k,j,i)  = MERGE( te_m(k,j,i), 0.0_wp,                  &
     1480                                         BTEST( wall_flags_0(k,j,i), 0 ) )
     1481                   tpt_m(k,j,i) = MERGE( tpt_m(k,j,i), 0.0_wp,                 &
     1482                                         BTEST( wall_flags_0(k,j,i), 0 ) )
     1483                ENDDO
    16821484             ENDDO
    16831485          ENDDO
    … …  
    17661568          IF ( nxr == nx )  THEN
    17671569             DO  j = nys, nyn
    1768                 DO  k = nzb_u_inner(j,nx)+1, nzt
     1570                DO  k = nzb+1, nzt
    17691571                   volume_flow_initial_l(1) = volume_flow_initial_l(1) +       &
    1770                                               u_init(k) * dzw(k)
    1771                    volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)
     1572                                              u_init(k) * dzw(k)               &
     1573                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1574                                              BTEST( wall_flags_0(k,j,nxr), 1 )&
     1575                                            )
     1576
     1577                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)   &
     1578                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1579                                              BTEST( wall_flags_0(k,j,nxr), 1 )&
     1580                                            )
    17721581                ENDDO
    17731582             ENDDO
    … …  
    17761585          IF ( nyn == ny )  THEN
    17771586             DO  i = nxl, nxr
    1778                 DO  k = nzb_v_inner(ny,i)+1, nzt
    1779                    volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
    1780                                               v_init(k) * dzw(k)
    1781                    volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)
     1587                DO  k = nzb+1, nzt
     1588                   volume_flow_initial_l(2) = volume_flow_initial_l(2) +       &
     1589                                              v_init(k) * dzw(k)               &       
     1590                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1591                                              BTEST( wall_flags_0(k,nyn,i), 2 )&
     1592                                            )
     1593                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)   &       
     1594                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1595                                              BTEST( wall_flags_0(k,nyn,i), 2 )&
     1596                                            )
    17821597                ENDDO
    17831598             ENDDO
    … …  
    18021617          IF ( nxr == nx )  THEN
    18031618             DO  j = nys, nyn
    1804                 DO  k = nzb_u_inner(j,nx)+1, nzt
     1619                DO  k = nzb+1, nzt
    18051620                   volume_flow_initial_l(1) = volume_flow_initial_l(1) +       &
    1806                                               hom_sum(k,1,0) * dzw(k)
    1807                    volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)
     1621                                              hom_sum(k,1,0) * dzw(k)          &
     1622                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1623                                              BTEST( wall_flags_0(k,j,nx), 1 ) &
     1624                                            )
     1625                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)   &
     1626                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1627                                              BTEST( wall_flags_0(k,j,nx), 1 ) &
     1628                                            )
    18081629                ENDDO
    18091630             ENDDO
    … …  
    18121633          IF ( nyn == ny )  THEN
    18131634             DO  i = nxl, nxr
    1814                 DO  k = nzb_v_inner(ny,i)+1, nzt
     1635                DO  k = nzb+1, nzt
    18151636                   volume_flow_initial_l(2) = volume_flow_initial_l(2) +       &
    1816                                               hom_sum(k,2,0) * dzw(k)
    1817                    volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)
     1637                                              hom_sum(k,2,0) * dzw(k)          &       
     1638                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1639                                              BTEST( wall_flags_0(k,ny,i), 2 ) &
     1640                                            )
     1641                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)   &       
     1642                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1643                                              BTEST( wall_flags_0(k,ny,i), 2 ) &
     1644                                            )
    18181645                ENDDO
    18191646             ENDDO
    … …  
    18381665          IF ( nxr == nx )  THEN
    18391666             DO  j = nys, nyn
    1840                 DO  k = nzb_u_inner(j,nx)+1, nzt
    1841                    volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
    1842                                               u(k,j,nx) * dzw(k)
    1843                    volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)
     1667                DO  k = nzb+1, nzt
     1668                   volume_flow_initial_l(1) = volume_flow_initial_l(1) +       &
     1669                                              u(k,j,nx) * dzw(k)               &
     1670                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1671                                              BTEST( wall_flags_0(k,j,nx), 1 ) &
     1672                                            )
     1673                   volume_flow_area_l(1)    = volume_flow_area_l(1) + dzw(k)   &
     1674                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1675                                              BTEST( wall_flags_0(k,j,nx), 1 ) &
     1676                                            )
    18441677                ENDDO
    18451678             ENDDO
    … …  
    18481681          IF ( nyn == ny )  THEN
    18491682             DO  i = nxl, nxr
    1850                 DO  k = nzb_v_inner(ny,i)+1, nzt
     1683                DO  k = nzb+1, nzt
    18511684                   volume_flow_initial_l(2) = volume_flow_initial_l(2) +       &
    1852                                               v(k,ny,i) * dzw(k)
    1853                    volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)
     1685                                              v(k,ny,i) * dzw(k)               &       
     1686                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1687                                              BTEST( wall_flags_0(k,ny,i), 2 ) &
     1688                                            )
     1689                   volume_flow_area_l(2)    = volume_flow_area_l(2) + dzw(k)   &       
     1690                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     1691                                              BTEST( wall_flags_0(k,ny,i), 2 ) &
     1692                                            )
    18541693                ENDDO
    18551694             ENDDO
    … …  
    18781717
    18791718    ENDIF
    1880 
     1719!
     1720!-- Initialize surface elements and its attributes, e.g. heat- and
     1721!-- momentumfluxes, roughness, scaling parameters.
     1722!-- This is already done in case of restart data. 
     1723    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.            &
     1724         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
     1725       CALL init_surfaces
     1726!
     1727!--    Finally, if random_heatflux is set, disturb shf at horizontal
     1728!--    surfaces. Actually, this should be done in surface_mod, where all other
     1729!--    initializations of surface quantities are done. However, this
     1730!--    would create a ring dependency, hence, it is done here. Maybe delete
     1731!--    disturb_heatflux and tranfer the respective code directly into the
     1732!--    initialization in surface_mod.         
     1733       IF ( use_surface_fluxes  .AND.  constant_heatflux  .AND.                &
     1734            random_heatflux )  THEN
     1735          IF ( surf_def_h(0)%ns >= 1 )  CALL disturb_heatflux( surf_def_h(0) )
     1736          IF ( surf_lsm_h%ns    >= 1 )  CALL disturb_heatflux( surf_lsm_h    )
     1737          IF ( surf_usm_h%ns    >= 1 )  CALL disturb_heatflux( surf_usm_h    )
     1738       ENDIF
     1739    ENDIF
     1740
     1741!
     1742!-- Initialize surface forcing corresponding to large-scale forcing. Therein,
     1743!-- initialize heat-fluxes, etc. via datatype. Revise it later!
     1744    IF ( large_scale_forcing .AND. lsf_surf )  THEN
     1745       IF ( use_surface_fluxes  .AND.  constant_heatflux )  THEN
     1746          CALL ls_forcing_surf ( simulated_time )
     1747       ENDIF
     1748    ENDIF
    18811749!
    18821750!-- Initialize quantities for special advections schemes
    … …  
    18911759
    18921760       CALL location_message( 'creating initial disturbances', .FALSE. )
    1893        CALL disturb_field( nzb_u_inner, tend, u )
    1894        CALL disturb_field( nzb_v_inner, tend, v )
     1761       CALL disturb_field( 'u', tend, u )
     1762       CALL disturb_field( 'v', tend, v )
    18951763       CALL location_message( 'finished', .TRUE. )
    18961764
    … …  
    21482016    mean_surface_level_height_l = 0.0_wp
    21492017
     2018!
     2019!-- To do: New concept for these non-topography grid points!
    21502020    DO  sr = 0, statistic_regions
    21512021       DO  i = nxl, nxr
    … …  
    21552025!--             All xy-grid points
    21562026                ngp_2dh_l(sr) = ngp_2dh_l(sr) + 1
    2157                 mean_surface_level_height_l(sr) = mean_surface_level_height_l(sr) &
    2158                                                   + zw(nzb_s_inner(j,i))
    2159 !
    2160 !--             xy-grid points above topography
    2161                 DO  k = nzb_s_outer(j,i), nz + 1
    2162                    ngp_2dh_outer_l(k,sr) = ngp_2dh_outer_l(k,sr) + 1
     2027!
     2028!--             Determine mean surface-level height. In case of downward-
     2029!--             facing walls are present, more than one surface level exist.
     2030!--             In this case, use the lowest surface-level height.
     2031                IF ( surf_def_h(0)%start_index(j,i) <=                         &
     2032                     surf_def_h(0)%end_index(j,i) )  THEN
     2033                   m = surf_def_h(0)%start_index(j,i)
     2034                   k = surf_def_h(0)%k(m)
     2035                   mean_surface_level_height_l(sr) =                           &
     2036                                       mean_surface_level_height_l(sr) + zw(k-1)
     2037                ENDIF
     2038                IF ( surf_lsm_h%start_index(j,i) <=                            &
     2039                     surf_lsm_h%end_index(j,i) )  THEN
     2040                   m = surf_lsm_h%start_index(j,i)
     2041                   k = surf_lsm_h%k(m)
     2042                   mean_surface_level_height_l(sr) =                           &
     2043                                       mean_surface_level_height_l(sr) + zw(k-1)
     2044                ENDIF
     2045                IF ( surf_usm_h%start_index(j,i) <=                            &
     2046                     surf_usm_h%end_index(j,i) )  THEN
     2047                   m = surf_usm_h%start_index(j,i)
     2048                   k = surf_usm_h%k(m)
     2049                   mean_surface_level_height_l(sr) =                           &
     2050                                       mean_surface_level_height_l(sr) + zw(k-1)
     2051                ENDIF
     2052
     2053                k_surf = k - 1
     2054
     2055                DO  k = nzb, nzt+1
     2056!
     2057!--                xy-grid points above topography
     2058                   ngp_2dh_outer_l(k,sr) = ngp_2dh_outer_l(k,sr)     +         &
     2059                                  MERGE( 1, 0, BTEST( wall_flags_0(k,j,i), 24 ) )
     2060
     2061                   ngp_2dh_s_inner_l(k,sr) = ngp_2dh_s_inner_l(k,sr) +         &
     2062                                  MERGE( 1, 0, BTEST( wall_flags_0(k,j,i), 22 ) )
     2063
    21632064                ENDDO
    2164                 DO  k = nzb_s_inner(j,i), nz + 1
    2165                    ngp_2dh_s_inner_l(k,sr) = ngp_2dh_s_inner_l(k,sr) + 1
    2166                 ENDDO
    21672065!
    21682066!--             All grid points of the total domain above topography
    2169                 ngp_3d_inner_l(sr) = ngp_3d_inner_l(sr)                        &
    2170                                      + ( nz - nzb_s_inner(j,i) + 2 )
     2067                ngp_3d_inner_l(sr) = ngp_3d_inner_l(sr) + ( nz - k_surf + 2 )
     2068
     2069
     2070
    21712071             ENDIF
    21722072          ENDDO

  • palm/trunk/SOURCE/init_grid.f90

    r2201 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! - Adjustments according to new topography representation
     23! - Bugfix: Move determination of nzb_max behind topography modification in
     24!   cell-edge case
     25! - Get rid off global arrays required for topography output
     26! - Enable topography input via netcdf
     27! - Generic tunnel set-up added
    2328!
    2429! Former revisions:
    … …  
    212217! ------------
    213218!> Creating grid depending constants
     219!> To Do: Setting topo flags only based on topo_3d array - flags for former
     220!> nzb_outer arrays are still not set properly.
     221!> To Do: Rearrange topo flag list
    214222!------------------------------------------------------------------------------!
    215223 SUBROUTINE init_grid
    … …  
    230238               dz_stretch_level, dz_stretch_level_index, grid_level, ibc_uv_b, &
    231239               io_blocks, io_group, inflow_l, inflow_n, inflow_r, inflow_s,    &
    232                masking_method, maximum_grid_level, message_string,             &
     240               lod, masking_method, maximum_grid_level, message_string,        &
    233241               momentum_advec, nest_domain, nest_bound_l, nest_bound_n,        &
    234242               nest_bound_r, nest_bound_s, ocean, outflow_l, outflow_n,        &
    235243               outflow_r, outflow_s, psolver, scalar_advec, topography,        &
    236                topography_grid_convention, use_surface_fluxes, use_top_fluxes, &
    237                wall_adjustment_factor
     244               topography_grid_convention, tunnel_height, tunnel_length,       &
     245               tunnel_width_x, tunnel_width_y, tunnel_wall_depth,              &
     246               use_surface_fluxes, use_top_fluxes, wall_adjustment_factor
    238247         
    239248    USE grid_variables,                                                        &
    240         ONLY:  ddx, ddx2, ddy, ddy2, dx, dx2, dy, dy2, fwxm,                   &
    241                fwxp, fwym, fwyp, fxm, fxp, fym, fyp, wall_e_x, wall_e_y,       &
    242                wall_u, wall_v, wall_w_x, wall_w_y, zu_s_inner, zw_w_inner
     249        ONLY:  ddx, ddx2, ddy, ddy2, dx, dx2, dy, dy2, zu_s_inner, zw_w_inner
    243250       
    244251    USE indices,                                                               &
    245         ONLY:  flags, nbgp, nx, nxl, nxlg, nxl_mg, nxr, nxrg, nxr_mg,          &
    246                ny, nyn, nyng, nyn_mg, nys, nys_mg, nysg, nz, nzb,              &
    247                nzb_diff, nzb_diff_s_inner, nzb_diff_s_outer, nzb_diff_u,       &
    248                nzb_diff_v, nzb_max, nzb_s_inner, nzb_s_outer, nzb_u_inner,     &
     252        ONLY:  advc_flags_1, advc_flags_2, flags, nbgp, nx, nxl, nxlg, nxl_mg, &
     253               nxr, nxrg, nxr_mg, ny, nyn, nyng, nyn_mg, nys, nys_mg, nysg, nz,&
     254               nzb, nzb_diff, nzb_diff_s_inner, nzb_diff_s_outer,              &
     255               nzb_max, nzb_s_inner, nzb_s_outer, nzb_u_inner,                 &
    249256               nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner,             &
    250                nzb_w_outer, nzt, nzt_diff, nzt_mg, rflags_invers,              &
    251                rflags_s_inner, wall_flags_0, wall_flags_00, wall_flags_1,      &
     257               nzb_w_outer, nzt, nzt_mg, wall_flags_0, wall_flags_1,           &
    252258               wall_flags_10, wall_flags_2, wall_flags_3,  wall_flags_4,       &
    253259               wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,         &
    … …  
    255261   
    256262    USE kinds
    257    
     263#if defined ( __netcdf )
     264    USE netcdf_interface,                                                      &
     265        ONLY:  netcdf_close_file, netcdf_open_read_file, netcdf_get_attribute, &
     266               netcdf_get_variable
     267#endif
    258268    USE pegrid
     269
     270    USE surface_mod,                                                           &
     271        ONLY:  init_bc
    259272
    260273    IMPLICIT NONE
    … …  
    275288    INTEGER(iwp) ::  cys           !< index for south canyon wall
    276289    INTEGER(iwp) ::  i             !< index variable along x
     290    INTEGER(iwp) ::  id_topo       !< NetCDF id of topograhy input file
    277291    INTEGER(iwp) ::  ii            !< loop variable for reading topography file
    278292    INTEGER(iwp) ::  inc           !< incremental parameter for coarsening grid level
    279293    INTEGER(iwp) ::  j             !< index variable along y
    280294    INTEGER(iwp) ::  k             !< index variable along z
     295    INTEGER(iwp) ::  k_top         !< topography top index on local PE
    281296    INTEGER(iwp) ::  l             !< loop variable
    282297    INTEGER(iwp) ::  nxl_l         !< index of left PE boundary for multigrid level
    … …  
    286301    INTEGER(iwp) ::  nzb_local_max !< vertical grid index of maximum topography height
    287302    INTEGER(iwp) ::  nzb_local_min !< vertical grid index of minimum topography height
    288     INTEGER(iwp) ::  nzb_si        !< dummy index for local nzb_s_inner
    289303    INTEGER(iwp) ::  nzt_l         !< index of top PE boundary for multigrid level
    290304    INTEGER(iwp) ::  num_hole      !< number of holes (in topography) resolved by only one grid point
    … …  
    292306    INTEGER(iwp) ::  num_wall      !< number of surrounding vertical walls for a single grid point
    293307    INTEGER(iwp) ::  skip_n_rows   !< counting variable to skip rows while reading topography file   
    294     INTEGER(iwp) ::  vi            !< dummy for vertical influence
    295 
    296     INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::                               &
    297                      vertical_influence  !< number of vertical grid points above obstacle where adjustment of near-wall mixing length is required
    298                                          
    299     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_nl      !< index of north-left corner location to limit near-wall mixing length
    300     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_nr      !< north-right
    301     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_sl      !< south-left
    302     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_sr      !< south-right
     308    INTEGER(iwp) ::  hv_in         !< heavyside function to model inner tunnel surface
     309    INTEGER(iwp) ::  hv_out        !< heavyside function to model outer tunnel surface
     310    INTEGER(iwp) ::  txe_out       !< end position of outer tunnel wall in x
     311    INTEGER(iwp) ::  txs_out       !< start position of outer tunnel wall in x
     312    INTEGER(iwp) ::  tye_out       !< end position of outer tunnel wall in y
     313    INTEGER(iwp) ::  tys_out       !< start position of outer tunnel wall in y
     314    INTEGER(iwp) ::  txe_in        !< end position of inner tunnel wall in x
     315    INTEGER(iwp) ::  txs_in        !< start position of inner tunnel wall in x
     316    INTEGER(iwp) ::  tye_in        !< end position of inner tunnel wall in y
     317    INTEGER(iwp) ::  tys_in        !< start position of inner tunnel wall in y
     318    INTEGER(iwp) ::  td            !< tunnel wall depth
     319    INTEGER(iwp) ::  th            !< height of outer tunnel wall
     320                                     
    303321    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_local      !< index for topography top at cell-center
    304322    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_tmp        !< dummy to calculate topography indices on u- and v-grid
    305     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_l         !< distance to adjacent left-facing wall
    306     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_n         !< north-facing
    307     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_r         !< right-facing
    308     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_s         !< right-facing
     323
     324    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  topo_3d !< input array for 3D topography and dummy array for setting "outer"-flags
     325
     326    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag indicating wether netcdf topography input file or not
    309327
    310328    REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file   
    311329    REAL(wp) ::  dz_stretched  !< stretched vertical grid spacing
    312330
     331    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  oro_height    !< input variable for terrain height
    313332    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  topo_height   !< input variable for topography height
    314     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zu_s_inner_l  !< dummy array on global scale to write topography output array
    315     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw_w_inner_l  !< dummy array on global scale to write topography output array
    316 
    317    
     333
    318334!
    319335!-- Calculation of horizontal array bounds including ghost layers
    … …  
    464480!
    465481!-- Allocate outer and inner index arrays for topography and set
    466 !-- defaults.
    467 
    468     ALLOCATE( corner_nl(nys:nyn,nxl:nxr), corner_nr(nys:nyn,nxl:nxr),       &
    469               corner_sl(nys:nyn,nxl:nxr), corner_sr(nys:nyn,nxl:nxr),       &
    470               wall_l(nys:nyn,nxl:nxr), wall_n(nys:nyn,nxl:nxr),             &
    471               wall_r(nys:nyn,nxl:nxr), wall_s(nys:nyn,nxl:nxr) )                     
    472      
    473     ALLOCATE( fwxm(nysg:nyng,nxlg:nxrg), fwxp(nysg:nyng,nxlg:nxrg),         &
    474               fwym(nysg:nyng,nxlg:nxrg), fwyp(nysg:nyng,nxlg:nxrg),         &
    475               fxm(nysg:nyng,nxlg:nxrg), fxp(nysg:nyng,nxlg:nxrg),           &
    476               fym(nysg:nyng,nxlg:nxrg), fyp(nysg:nyng,nxlg:nxrg),           &
    477               nzb_s_inner(nysg:nyng,nxlg:nxrg),                             &
     482!-- defaults.                   
     483    ALLOCATE( nzb_s_inner(nysg:nyng,nxlg:nxrg),                             &
    478484              nzb_s_outer(nysg:nyng,nxlg:nxrg),                             &
    479485              nzb_u_inner(nysg:nyng,nxlg:nxrg),                             &
    … …  
    485491              nzb_diff_s_inner(nysg:nyng,nxlg:nxrg),                        &
    486492              nzb_diff_s_outer(nysg:nyng,nxlg:nxrg),                        &
    487               nzb_diff_u(nysg:nyng,nxlg:nxrg),                              &
    488               nzb_diff_v(nysg:nyng,nxlg:nxrg),                              &
    489493              nzb_local(nysg:nyng,nxlg:nxrg),                               &
    490494              nzb_tmp(nysg:nyng,nxlg:nxrg),                                 &
    491               rflags_s_inner(nzb:nzt+2,nysg:nyng,nxlg:nxrg),                &
    492               rflags_invers(nysg:nyng,nxlg:nxrg,nzb:nzt+2),                 &
    493               wall_e_x(nysg:nyng,nxlg:nxrg),                                &
    494               wall_e_y(nysg:nyng,nxlg:nxrg),                                &
    495               wall_u(nysg:nyng,nxlg:nxrg),                                  &
    496               wall_v(nysg:nyng,nxlg:nxrg),                                  &
    497               wall_w_x(nysg:nyng,nxlg:nxrg),                                &
    498               wall_w_y(nysg:nyng,nxlg:nxrg) )
    499 
    500 
     495              wall_flags_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     496
     497    ALLOCATE( topo_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     498    topo_3d    = 0
    501499
    502500    ALLOCATE( l_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    503 
    504501
    505502    nzb_s_inner = nzb;  nzb_s_outer = nzb
    … …  
    507504    nzb_v_inner = nzb;  nzb_v_outer = nzb
    508505    nzb_w_inner = nzb;  nzb_w_outer = nzb
    509 
    510     rflags_s_inner = 1.0_wp
    511     rflags_invers  = 1.0_wp
    512506
    513507!
    … …  
    519513       nzb_diff = nzb + 1
    520514    ENDIF
    521     IF ( use_top_fluxes )  THEN
    522        nzt_diff = nzt - 1
    523     ELSE
    524        nzt_diff = nzt
    525     ENDIF
    526515
    527516    nzb_diff_s_inner = nzb_diff;  nzb_diff_s_outer = nzb_diff
    528     nzb_diff_u = nzb_diff;  nzb_diff_v = nzb_diff
    529 
    530     wall_e_x = 0.0_wp;  wall_e_y = 0.0_wp;  wall_u = 0.0_wp;  wall_v = 0.0_wp
    531     wall_w_x = 0.0_wp;  wall_w_y = 0.0_wp
    532     fwxp = 1.0_wp;  fwxm = 1.0_wp;  fwyp = 1.0_wp;  fwym = 1.0_wp
    533     fxp  = 1.0_wp;  fxm  = 1.0_wp;  fyp  = 1.0_wp;  fym  = 1.0_wp
    534517
    535518!
    … …  
    542525    ENDDO
    543526    l_wall(nzt+1,:,:) = l_grid(nzt)
    544 
    545     ALLOCATE ( vertical_influence(nzb:nzt) )
    546     DO  k = 1, nzt
    547        vertical_influence(k) = MIN ( INT( l_grid(k) / &
    548                      ( wall_adjustment_factor * dzw(k) ) + 0.5_wp ), nzt - k )
    549     ENDDO
    550527
    551528    DO  k = 1, nzt
    … …  
    561538       ENDIF
    562539    ENDDO
    563     vertical_influence(0) = vertical_influence(1)
    564 
    565     DO  k = nzb + 1, nzb + vertical_influence(nzb)
    566        l_wall(k,:,:) = zu(k) - zw(nzb)
    567     ENDDO
    568 
    569540!
    570541!-- Set outer and inner index arrays for non-flat topography.
    … …  
    580551!--       nzb_local is required for the multigrid solver
    581552          nzb_local = 0
     553!
     554!--       Initialilize 3D topography array, used later for initializing flags
     555          topo_3d(nzb+1:nzt+1,:,:) = IBSET( topo_3d(nzb+1:nzt+1,:,:), 0 )
     556!
     557!--       level of detail is required for output routines
     558          lod       = 1
    582559
    583560       CASE ( 'single_building' )
    … …  
    587564          blx = NINT( building_length_x / dx )
    588565          bly = NINT( building_length_y / dy )
    589           IF ( .NOT. ocean )  THEN
    590              bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
    591           ELSE
    592              bh  = MINLOC( ABS( zw - zw(0) - building_height ), 1 ) - 1
    593           ENDIF
    594 
    595           IF ( ABS( zw(bh  ) - building_height ) == &
     566          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
     567          IF ( ABS( zw(bh)   - building_height ) == &
    596568               ABS( zw(bh+1) - building_height )    )  bh = bh + 1
    597569
    … …  
    626598
    627599          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
     600!
     601!--       Set bit array to mask topography
     602          DO  i = nxlg, nxrg
     603             DO  j = nysg, nyng
     604
     605                topo_3d(nzb_local(j,i)+1:nzt+1,j,i) =                          &
     606                                 IBSET( topo_3d(nzb_local(j,i)+1:nzt+1,j,i), 0 )
     607             ENDDO
     608          ENDDO
     609!
     610!--       level of detail is required for output routines. Here, 2D topography.
     611          lod = 1
     612
     613          CALL exchange_horiz_int( topo_3d, nbgp )
    628614
    629615       CASE ( 'single_street_canyon' )
    … …  
    658644          ENDIF
    659645
    660           IF ( .NOT. ocean )  THEN
    661              ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
    662           ELSE
    663              ch  = MINLOC( ABS( zw - zw(0) - canyon_height ), 1 ) - 1
    664           ENDIF
    665 
    666           IF ( ABS( zw(ch  ) - canyon_height ) == &
     646          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
     647          IF ( ABS( zw(ch)   - canyon_height ) == &
    667648               ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
    668649
    … …  
    707688
    708689          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
     690!
     691!--       Set bit array to mask topography
     692          DO  i = nxlg, nxrg
     693             DO  j = nysg, nyng
     694                topo_3d(nzb_local(j,i)+1:nzt+1,j,i) =                          &
     695                                 IBSET( topo_3d(nzb_local(j,i)+1:nzt+1,j,i), 0 )
     696             ENDDO
     697          ENDDO
     698!
     699!--       level of detail is required for output routines. Here, 2D topography.
     700          lod = 1
     701
     702          CALL exchange_horiz_int( topo_3d, nbgp )
     703
     704       CASE ( 'tunnel' )
     705
     706!
     707!--       Tunnel height
     708          IF ( tunnel_height == 9999999.9_wp )  THEN
     709             th = zw( INT( 0.2 * nz) )
     710          ELSE
     711             th = tunnel_height
     712          ENDIF
     713!
     714!--       Tunnel-wall depth
     715          IF ( tunnel_wall_depth == 9999999.9_wp )  THEN
     716             td = MAX ( dx, dy, dz )
     717          ELSE
     718             td = tunnel_wall_depth
     719          ENDIF
     720!
     721!--       Check for tunnel width
     722          IF ( tunnel_width_x == 9999999.9_wp  .AND.                           &
     723               tunnel_width_y == 9999999.9_wp  )  THEN
     724             message_string = 'No tunnel width is given. '
     725             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     726          ENDIF
     727          IF ( tunnel_width_x /= 9999999.9_wp  .AND.                           &
     728               tunnel_width_y /= 9999999.9_wp  )  THEN
     729             message_string = 'Inconsistent tunnel parameters:' //             &   
     730                              'tunnel can only be oriented' //                 &
     731                              'either in x- or in y-direction.'
     732             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     733          ENDIF
     734!
     735!--       Tunnel axis along y
     736          IF ( tunnel_width_x /= 9999999.9_wp )  THEN
     737             IF ( tunnel_width_x > ( nx + 1 ) * dx )  THEN
     738                message_string = 'Tunnel width too large'
     739                CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     740             ENDIF
     741
     742             txs_out = INT( ( nx + 1 ) * 0.5_wp * dx - tunnel_width_x * 0.5_wp )
     743             txe_out = INT( ( nx + 1 ) * 0.5_wp * dx + tunnel_width_x * 0.5_wp )
     744             txs_in  = INT( ( nx + 1 ) * 0.5_wp * dx -                         &
     745                                      ( tunnel_width_x * 0.5_wp - td ) )
     746             txe_in  = INT( ( nx + 1 ) * 0.5_wp * dx +                         &
     747                                      ( tunnel_width_x * 0.5_wp - td ) )
     748
     749             tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_length * 0.5_wp )
     750             tye_out = INT( ( ny + 1 ) * 0.5_wp * dy + tunnel_length * 0.5_wp )
     751             tys_in  = tys_out
     752             tye_in  = tye_out
     753          ENDIF
     754          IF ( tunnel_width_x /= 9999999.9_wp  .AND.                           &
     755               tunnel_width_x - 2.0_wp * tunnel_wall_depth <= 2.0_wp * dx )  THEN
     756             message_string = 'Tunnel width too small'
     757             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     758          ENDIF
     759          IF ( tunnel_width_y /= 9999999.9_wp  .AND.                           &
     760               tunnel_width_y - 2.0_wp * tunnel_wall_depth <= 2.0_wp * dy )  THEN
     761             message_string = 'Tunnel width too small'
     762             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     763          ENDIF
     764!
     765!--       Tunnel axis along x
     766          IF ( tunnel_width_y /= 9999999.9_wp )  THEN
     767             IF ( tunnel_width_y > ( ny + 1 ) * dy )  THEN
     768                message_string = 'Tunnel width too large'
     769                CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     770             ENDIF
     771
     772             txs_out = INT( ( nx + 1 ) * 0.5_wp * dx - tunnel_length * 0.5_wp )
     773             txe_out = INT( ( nx + 1 ) * 0.5_wp * dx + tunnel_length * 0.5_wp )
     774             txs_in  = txs_out
     775             txe_in  = txe_out
     776
     777             tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_width_y * 0.5_wp )
     778             tye_out = INT( ( ny + 1 ) * 0.5_wp * dy + tunnel_width_y * 0.5_wp )
     779             tys_in  = INT( ( ny + 1 ) * 0.5_wp * dy -                         &
     780                                     ( tunnel_width_y * 0.5_wp - td ) )
     781             tye_in  = INT( ( ny + 1 ) * 0.5_wp * dy +                         &
     782                                     ( tunnel_width_y * 0.5_wp - td ) )
     783          ENDIF
     784
     785          topo_3d = 0
     786          DO  i = nxl, nxr
     787             DO  j = nys, nyn
     788!
     789!--             Use heaviside function to model outer tunnel surface
     790                hv_out = th * 0.5_wp *                                         &
     791                              ( ( SIGN( 1.0_wp, i * dx - txs_out ) + 1.0_wp )  &
     792                              - ( SIGN( 1.0_wp, i * dx - txe_out ) + 1.0_wp ) )
     793
     794                hv_out = hv_out * 0.5_wp *                                     &
     795                            ( ( SIGN( 1.0_wp, j * dy - tys_out ) + 1.0_wp )    &
     796                            - ( SIGN( 1.0_wp, j * dy - tye_out ) + 1.0_wp ) )
     797!
     798!--             Use heaviside function to model inner tunnel surface
     799                hv_in  = ( th - td ) * 0.5_wp *                                &
     800                                ( ( SIGN( 1.0_wp, i * dx - txs_in ) + 1.0_wp ) &
     801                                - ( SIGN( 1.0_wp, i * dx - txe_in ) + 1.0_wp ) )
     802
     803                hv_in = hv_in * 0.5_wp *                                       &
     804                                ( ( SIGN( 1.0_wp, j * dy - tys_in ) + 1.0_wp ) &
     805                                - ( SIGN( 1.0_wp, j * dy - tye_in ) + 1.0_wp ) )
     806!
     807!--             Set flags at x-y-positions without any tunnel surface
     808                IF ( hv_out - hv_in == 0.0_wp )  THEN
     809                   topo_3d(nzb+1:nzt+1,j,i) = IBSET( topo_3d(nzb+1:nzt+1,j,i), 0 )
     810!
     811!--             Set flags at x-y-positions with tunnel surfaces
     812                ELSE
     813                   DO  k = nzb + 1, nzt + 1
     814!
     815!--                   Inner tunnel
     816                      IF ( hv_out - hv_in == th )  THEN
     817                         IF ( zw(k) <= hv_out )  THEN
     818                            topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
     819                         ELSE
     820                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
     821                         ENDIF
     822                      ENDIF
     823!
     824!--                   Lateral tunnel walls
     825                      IF ( hv_out - hv_in == td )  THEN
     826                         IF ( zw(k) <= hv_in )  THEN
     827                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
     828                         ELSEIF ( zw(k) > hv_in  .AND.  zw(k) <= hv_out )  THEN
     829                            topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
     830                         ELSEIF ( zw(k) > hv_out )  THEN
     831                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
     832                         ENDIF
     833                      ENDIF
     834                   ENDDO
     835                ENDIF
     836             ENDDO
     837          ENDDO
     838
     839          nzb_local = 0
     840!
     841!--       level of detail is required for output routines. Here, 3D topography.
     842          lod = 2
     843
     844          CALL exchange_horiz_int( topo_3d, nbgp )
    709845
    710846       CASE ( 'read_from_file' )
    711847
     848          ALLOCATE ( oro_height(nys:nyn,nxl:nxr)  )
    712849          ALLOCATE ( topo_height(nys:nyn,nxl:nxr) )
     850          oro_height  = 0.0_wp
     851          topo_height = 0.0_wp
    713852
    714853          DO  ii = 0, io_blocks-1
    … …  
    717856!
    718857!--             Arbitrary irregular topography data in PALM format (exactly
    719 !--             matching the grid size and total domain size)
    720                 OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ),       &
    721                           STATUS='OLD', FORM='FORMATTED', ERR=10 )
    722 !
    723 !--             Read topography PE-wise. Rows are read from nyn to nys, columns
    724 !--             are read from nxl to nxr. At first, ny-nyn rows need to be skipped.
    725                 skip_n_rows = 0
    726                 DO WHILE ( skip_n_rows < ny - nyn )
    727                    READ( 90, * ) 
    728                    skip_n_rows = skip_n_rows + 1
    729                 ENDDO
    730 !
    731 !--             Read data from nyn to nys and nxl to nxr. Therefore, skip
    732 !--             column until nxl-1 is reached
    733                 DO  j = nyn, nys, -1
    734                    READ( 90, *, ERR=11, END=11 )                               &
     858!--             matching the grid size and total domain size).
     859!--             First, check if NetCDF file for topography exist or not.
     860!--             This case, read topography from NetCDF, else read it from
     861!--             ASCII file.
     862#if defined ( __netcdf )
     863                INQUIRE( FILE='TOPOGRAPHY_DATA_NC'//TRIM( coupling_char ),     &
     864                         EXIST=netcdf_extend )
     865!
     866!--             NetCDF branch   
     867                IF ( netcdf_extend )  THEN
     868!
     869!--                Open file in read-only mode
     870                   CALL netcdf_open_read_file( 'TOPOGRAPHY_DATA_NC',           &
     871                                               id_topo, 20 )  !Error number still need to be set properly
     872
     873!
     874!--                Read terrain height. Reading is done PE-wise, i.e. each
     875!--                processor reads its own domain. Reading is realized
     876!--                via looping over x-dimension, i.e. calling
     877!--                netcdf_get_variable reads topography along y for given x.
     878!--                Orography is 2D.
     879                   DO  i = nxl, nxr
     880                      CALL netcdf_get_variable( id_topo, 'orography_0',        &
     881                                                i, oro_height(:,i), 20 )  !Error number still need to be set properly
     882                   ENDDO
     883!
     884!--                Read attribute lod (level of detail), required for variable
     885!--                buildings_0
     886                   CALL netcdf_get_attribute( id_topo, "lod", lod, .FALSE.,    &
     887                                              20, 'buildings_0' ) !Error number still need to be set properly
     888!
     889!--                Read building height
     890!--                2D for lod = 1, 3D for lod = 2
     891                   IF ( lod == 1 )  THEN
     892                      DO  i = nxl, nxr
     893                         CALL netcdf_get_variable( id_topo, 'buildings_0',     &
     894                                                   i, topo_height(:,i), 20 )  !Error number still need to be set properly
     895                      ENDDO
     896
     897                   ELSEIF ( lod == 2 )  THEN
     898!
     899!--                   Read data PE-wise. Read yz-slices.
     900                      DO  i = nxl, nxr
     901                         DO  j = nys, nyn
     902                            CALL netcdf_get_variable( id_topo, 'buildings_0',  &
     903                                                      i, j, topo_3d(:,j,i), 20 )  !Error number still need to be set properly
     904                         ENDDO
     905                      ENDDO
     906                   ELSE
     907                      message_string = 'NetCDF attribute lod ' //              &
     908                                       '(level of detail) is not set properly.'
     909                      CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 ) !Error number still need to be set properly
     910                   ENDIF
     911!
     912!--                Close topography input file
     913                   CALL netcdf_close_file( id_topo, 20 )
     914#endif
     915
     916!
     917!--             ASCII branch. Please note, reading of 3D topography is not
     918!--             supported in ASCII format. Further, no distinction is made
     919!--             between orography and buildings
     920                ELSE
     921
     922                   OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ),    &
     923                         STATUS='OLD', FORM='FORMATTED', ERR=10 )
     924!
     925!--                Read topography PE-wise. Rows are read from nyn to nys, columns
     926!--                are read from nxl to nxr. At first, ny-nyn rows need to be skipped.
     927                   skip_n_rows = 0
     928                   DO WHILE ( skip_n_rows < ny - nyn )
     929                      READ( 90, * ) 
     930                      skip_n_rows = skip_n_rows + 1
     931                   ENDDO
     932!
     933!--                Read data from nyn to nys and nxl to nxr. Therefore, skip
     934!--                column until nxl-1 is reached
     935                   DO  j = nyn, nys, -1
     936                      READ( 90, *, ERR=11, END=11 )                            &
    735937                                              ( dum, i = 0, nxl-1 ),           &
    736938                                              ( topo_height(j,i), i = nxl, nxr )
    737                 ENDDO
    738 
    739                 GOTO 12
     939                   ENDDO
     940
     941                   GOTO 12
    740942         
    741  10             message_string = 'file TOPOGRAPHY'//TRIM( coupling_char )//    &
    742                                  ' does not exist'
    743                 CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 )
    744 
    745  11             message_string = 'errors in file TOPOGRAPHY_DATA'//            &
    746                                  TRIM( coupling_char )
    747                 CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 )
    748 
    749  12             CLOSE( 90 )
     943 10                message_string = 'file TOPOGRAPHY'//TRIM( coupling_char )// &
     944                                    ' does not exist'
     945                   CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 )
     946
     947 11                message_string = 'errors in file TOPOGRAPHY_DATA'//         &
     948                                    TRIM( coupling_char )
     949                   CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 )
     950
     951 12                CLOSE( 90 )
     952
     953                ENDIF
    750954
    751955             ENDIF
    … …  
    761965             DO  j = nys, nyn
    762966                IF ( .NOT. ocean )  THEN
    763                    nzb_local(j,i) = MINLOC( ABS( zw - topo_height(j,i) ), 1 ) - 1
    764                    IF ( ABS( zw(nzb_local(j,i)  ) - topo_height(j,i) ) ==      &
    765                         ABS( zw(nzb_local(j,i)+1) - topo_height(j,i) )    )    &
     967                   nzb_local(j,i) = MINLOC( ABS( zw - topo_height(j,i)         &
     968                                                    - oro_height(j,i) ), 1 ) - 1
     969                   IF ( ABS( zw(nzb_local(j,i)  ) - topo_height(j,i)           &
     970                                                  - oro_height(j,i)  ) ==      &
     971                        ABS( zw(nzb_local(j,i)+1) - topo_height(j,i)           &
     972                                                  - oro_height(j,i)  )    )    &
    766973                      nzb_local(j,i) = nzb_local(j,i) + 1
    767974                ELSE
    768975                   nzb_local(j,i) = MINLOC( ABS( zw - zw(0)                    &
    769                                                     - topo_height(j,i) ), 1 ) - 1
     976                                                    - topo_height(j,i)         &
     977                                                    - oro_height(j,i) ), 1 ) - 1
    770978                   IF ( ABS( zw(nzb_local(j,i)  ) - zw(0)                      &
    771                                                   - topo_height(j,i) )  ==     &
     979                                                  - topo_height(j,i)           &
     980                                                  - oro_height(j,i)  )  ==     &
    772981                        ABS( zw(nzb_local(j,i)+1) - zw(0)                      &
    773                                                   - topo_height(j,i) )    )    &
     982                                                  - topo_height(j,i)           &
     983                                                  - oro_height(j,i)  )    )    &
    774984                      nzb_local(j,i) = nzb_local(j,i) + 1
    775985                ENDIF
    … …  
    778988          ENDDO
    779989
     990          DEALLOCATE ( oro_height  )
    780991          DEALLOCATE ( topo_height )
    781992!
    … …  
    8361047             CALL message( 'init_grid', 'PA0430', 0, 0, 0, 6, 0 )
    8371048          ENDIF
     1049
     1050!
     1051!--       Set bit array to mask topography. Only required for lod = 1
     1052          IF ( lod == 1 )  THEN
     1053             DO  i = nxlg, nxrg
     1054                DO  j = nysg, nyng
     1055                   topo_3d(nzb_local(j,i)+1:nzt+1,j,i) =                          &
     1056                                 IBSET( topo_3d(nzb_local(j,i)+1:nzt+1,j,i), 0 )
     1057                ENDDO
     1058             ENDDO
     1059          ENDIF
    8381060!
    8391061!--       Exchange ghost-points, as well as add cyclic or Neumann boundary
    8401062!--       conditions.
     1063          CALL exchange_horiz_int( topo_3d, nbgp )
    8411064          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
    8421065         
    8431066          IF ( .NOT. bc_ns_cyc )  THEN
     1067             IF ( nys == 0  )  topo_3d(:,-1,:)   = topo_3d(:,0,:)
     1068             IF ( nyn == ny )  topo_3d(:,ny+1,:) = topo_3d(:,ny,:)
     1069
    8441070             IF ( nys == 0  )  nzb_local(-1,:)   = nzb_local(0,:)
    8451071             IF ( nyn == ny )  nzb_local(ny+1,:) = nzb_local(ny,:)
    … …  
    8471073
    8481074          IF ( .NOT. bc_lr_cyc )  THEN
     1075             IF ( nxl == 0  )  topo_3d(:,:,-1)   = topo_3d(:,:,0)
     1076             IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)     
     1077
    8491078             IF ( nxl == 0  )  nzb_local(:,-1)   = nzb_local(:,0)
    8501079             IF ( nxr == nx )  nzb_local(:,nx+1) = nzb_local(:,nx)         
    8511080          ENDIF
     1081
    8521082
    8531083       CASE DEFAULT
    … …  
    8571087!--       case in the user interface. There, the subroutine user_init_grid
    8581088!--       checks which of these two conditions applies.
    859           CALL user_init_grid( nzb_local )
     1089          CALL user_init_grid( topo_3d )
    8601090
    8611091    END SELECT
    862 !
    863 !-- Determine the maximum level of topography. Furthermore it is used for
    864 !-- steering the degradation of order of the applied advection scheme.
    865 !-- In case of non-cyclic lateral boundaries, the order of the advection
    866 !-- scheme has to be reduced up to nzt (required at the lateral boundaries).
    867 #if defined( __parallel )
    868     CALL MPI_ALLREDUCE( MAXVAL( nzb_local ) + 1, nzb_max, 1, MPI_INTEGER,      &
    869                         MPI_MAX, comm2d, ierr )
    870 #else
    871     nzb_max = MAXVAL( nzb_local ) + 1
    872 #endif
    873     IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR.             &
    874          inflow_n .OR. outflow_n .OR. inflow_s .OR. outflow_s .OR.             &
    875          nest_domain )                                                         &
    876     THEN
    877        nzb_max = nzt
    878     ENDIF
    879 
    8801092!
    8811093!-- Consistency checks and index array initialization are only required for
    … …  
    9011113                                '&MAXVAL( nzb_local ) = ', nzb_local_max
    9021114          CALL message( 'init_grid', 'PA0210', 1, 2, 0, 6, 0 )
     1115       ENDIF
     1116!
     1117!--    In case of non-flat topography, check whether the convention how to
     1118!--    define the topography grid has been set correctly, or whether the default
     1119!--    is applicable. If this is not possible, abort.
     1120       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
     1121          IF ( TRIM( topography ) /= 'single_building' .AND.                   &
     1122               TRIM( topography ) /= 'single_street_canyon' .AND.              &
     1123               TRIM( topography ) /= 'tunnel'  .AND.                           &
     1124               TRIM( topography ) /= 'read_from_file')  THEN
     1125!--          The default value is not applicable here, because it is only valid
     1126!--          for the two standard cases 'single_building' and 'read_from_file'
     1127!--          defined in init_grid.
     1128             WRITE( message_string, * )                                        &
     1129                  'The value for "topography_grid_convention" ',               &
     1130                  'is not set. Its default value is & only valid for ',        &
     1131                  '"topography" = ''single_building'', ',                      &
     1132                  '''single_street_canyon'' & or ''read_from_file''.',         &
     1133                  ' & Choose ''cell_edge'' or ''cell_center''.'
     1134             CALL message( 'init_grid', 'PA0239', 1, 2, 0, 6, 0 )
     1135          ELSE
     1136!--          The default value is applicable here.
     1137!--          Set convention according to topography.
     1138             IF ( TRIM( topography ) == 'single_building' .OR.                 &
     1139                  TRIM( topography ) == 'single_street_canyon' )  THEN
     1140                topography_grid_convention = 'cell_edge'
     1141             ELSEIF ( TRIM( topography ) == 'read_from_file'  .OR.             &
     1142                      TRIM( topography ) == 'tunnel')  THEN
     1143                topography_grid_convention = 'cell_center'
     1144             ENDIF
     1145          ENDIF
     1146       ELSEIF ( TRIM( topography_grid_convention ) /= 'cell_edge' .AND.        &
     1147                TRIM( topography_grid_convention ) /= 'cell_center' )  THEN
     1148          WRITE( message_string, * )                                           &
     1149               'The value for "topography_grid_convention" is ',               &
     1150               'not recognized. & Choose ''cell_edge'' or ''cell_center''.'
     1151          CALL message( 'init_grid', 'PA0240', 1, 2, 0, 6, 0 )
    9031152       ENDIF
    9041153
    … …  
    9641213                nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j+1,i) )
    9651214             ENDDO
    966           ENDDO
     1215          ENDDO 
    9671216!
    9681217!--       Exchange ghost points         
    9691218          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
     1219!
     1220!--       Apply cell-edge convention also for 3D topo array. The former setting
     1221!--       of nzb_local will be removed later.
     1222          DO  j = nys+1, nyn+1
     1223             DO  i = nxl-1, nxr
     1224                DO  k = nzb, nzt+1
     1225                   IF ( BTEST( topo_3d(k,j,i), 0 )  .OR.                       &
     1226                        BTEST( topo_3d(k,j,i+1), 0 ) )                         &
     1227                      topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
     1228                ENDDO
     1229             ENDDO
     1230          ENDDO     
     1231          CALL exchange_horiz_int( topo_3d, nbgp )   
     1232
     1233          DO  i = nxl, nxr+1
     1234             DO  j = nys-1, nyn
     1235                DO  k = nzb, nzt+1
     1236                   IF ( BTEST( topo_3d(k,j,i), 0 )  .OR.                       &
     1237                        BTEST( topo_3d(k,j+1,i), 0 ) )                         &
     1238                      topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
     1239                ENDDO
     1240             ENDDO
     1241          ENDDO 
     1242          CALL exchange_horiz_int( topo_3d, nbgp )
     1243   
    9701244       ENDIF
     1245     
    9711246!
    9721247!--    Initialize index arrays nzb_s_inner and nzb_w_inner
     1248
    9731249       nzb_s_inner = nzb_local
    9741250       nzb_w_inner = nzb_local
    … …  
    11031379       CALL exchange_horiz_2d_int( nzb_s_outer, nys, nyn, nxl, nxr, nbgp )
    11041380
    1105 !
    1106 !--    Allocate and set the arrays containing the topography height
    1107        ALLOCATE( zu_s_inner(0:nx+1,0:ny+1), zw_w_inner(0:nx+1,0:ny+1),         &
    1108                  zu_s_inner_l(0:nx+1,0:ny+1), zw_w_inner_l(0:nx+1,0:ny+1) )
    1109                  
    1110        zu_s_inner   = 0.0_wp
    1111        zw_w_inner   = 0.0_wp
    1112        zu_s_inner_l = 0.0_wp
    1113        zw_w_inner_l = 0.0_wp
    1114        
    1115        DO  i = nxl, nxr
    1116           DO  j = nys, nyn
    1117              zu_s_inner_l(i,j) = zu(nzb_local(j,i))
    1118              zw_w_inner_l(i,j) = zw(nzb_local(j,i))
    1119           ENDDO
    1120        ENDDO
    1121        
    1122 #if defined( __parallel )
    1123        CALL MPI_REDUCE( zu_s_inner_l, zu_s_inner, (nx+2)*(ny+2),         &
    1124                            MPI_REAL, MPI_SUM, 0, comm2d, ierr )       
    1125        CALL MPI_REDUCE( zw_w_inner_l, zw_w_inner, (nx+2)*(ny+2),         &
    1126                            MPI_REAL, MPI_SUM, 0, comm2d, ierr ) 
    1127 #else
    1128        zu_s_inner = zu_s_inner_l
    1129        zw_w_inner = zw_w_inner_l
    1130 #endif
    1131 
    1132       DEALLOCATE( zu_s_inner_l, zw_w_inner_l )
    1133       IF ( myid /= 0 )  DEALLOCATE( zu_s_inner, zw_w_inner )
    1134 !
    1135 !--   Set south and left ghost points, required for netcdf output
    1136       IF ( myid == 0 )  THEN
    1137          IF( bc_lr_cyc )  THEN
    1138             zu_s_inner(nx+1,:) = zu_s_inner(0,:)
    1139             zw_w_inner(nx+1,:) = zw_w_inner(0,:)
    1140          ELSE
    1141             zu_s_inner(nx+1,:) = zu_s_inner(nx,:)
    1142             zw_w_inner(nx+1,:) = zw_w_inner(nx,:)
    1143          ENDIF
    1144          IF( bc_ns_cyc )  THEN
    1145             zu_s_inner(:,ny+1) = zu_s_inner(:,0)
    1146             zw_w_inner(:,ny+1) = zw_w_inner(:,0)
    1147          ELSE
    1148             zu_s_inner(:,ny+1) = zu_s_inner(:,ny)
    1149             zw_w_inner(:,ny+1) = zw_w_inner(:,ny)
    1150          ENDIF
    1151       ENDIF
    1152 !
    1153 !--    Set flag arrays to be used for masking of grid points
    1154        DO  i = nxlg, nxrg
    1155           DO  j = nysg, nyng
    1156              DO  k = nzb, nzt+1
    1157                 IF ( k <= nzb_s_inner(j,i) )  rflags_s_inner(k,j,i) = 0.0_wp
    1158                 IF ( k <= nzb_s_inner(j,i) )  rflags_invers(j,i,k)  = 0.0_wp
    1159              ENDDO
    1160           ENDDO
    1161        ENDDO
    1162 
    11631381    ENDIF
    11641382!
    … …  
    11661384!-- grid-levels further below.
    11671385    DEALLOCATE( nzb_tmp )
     1386
     1387!
     1388!-- Determine the maximum level of topography. It is used for
     1389!-- steering the degradation of order of the applied advection scheme.
     1390!-- In case of non-cyclic lateral boundaries, the order of the advection
     1391!-- scheme has to be reduced up to nzt (required at the lateral boundaries).
     1392    k_top = 0
     1393    DO  i = nxl, nxr
     1394       DO  j = nys, nyn
     1395          DO  k = nzb, nzt + 1
     1396             k_top = MAX( k_top, MERGE( k, 0,                                  &
     1397                                        .NOT. BTEST( topo_3d(k,j,i), 0 ) ) )
     1398          ENDDO
     1399       ENDDO
     1400    ENDDO
     1401#if defined( __parallel )
     1402    CALL MPI_ALLREDUCE( k_top + 1, nzb_max, 1, MPI_INTEGER,                    & !is +1 really necessary here?
     1403                        MPI_MAX, comm2d, ierr )
     1404#else
     1405    nzb_max = k_top + 1
     1406#endif
     1407    IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR.             &
     1408         inflow_n .OR. outflow_n .OR. inflow_s .OR. outflow_s .OR.             &
     1409         nest_domain )                                                         &
     1410    THEN
     1411       nzb_max = nzt
     1412    ENDIF
     1413!
     1414!-- Finally, if topography extents up to the model top, limit nzb_max to nzt.
     1415    nzb_max = MIN( nzb_max, nzt )
    11681416
    11691417!
    … …  
    11721420!-- applied
    11731421    IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
    1174        nzb_diff_u         = nzb_u_inner + 2
    1175        nzb_diff_v         = nzb_v_inner + 2
    11761422       nzb_diff_s_inner   = nzb_s_inner + 2
    11771423       nzb_diff_s_outer   = nzb_s_outer + 2
    11781424    ELSE
    1179        nzb_diff_u         = nzb_u_inner + 1
    1180        nzb_diff_v         = nzb_v_inner + 1
    11811425       nzb_diff_s_inner   = nzb_s_inner + 1
    11821426       nzb_diff_s_outer   = nzb_s_outer + 1
    … …  
    11841428
    11851429!
    1186 !-- Calculation of wall switches and factors required by diffusion_u/v.f90 and
    1187 !-- for limitation of near-wall mixing length l_wall further below
    1188     corner_nl = 0
    1189     corner_nr = 0
    1190     corner_sl = 0
    1191     corner_sr = 0
    1192     wall_l    = 0
    1193     wall_n    = 0
    1194     wall_r    = 0
    1195     wall_s    = 0
    1196 
    1197     DO  i = nxl, nxr
    1198        DO  j = nys, nyn
    1199 !
    1200 !--       u-component
    1201           IF ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  THEN
    1202              wall_u(j,i) = 1.0_wp   ! north wall (location of adjacent fluid)
    1203              fym(j,i)    = 0.0_wp
    1204              fyp(j,i)    = 1.0_wp
    1205           ELSEIF ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  THEN
    1206              wall_u(j,i) = 1.0_wp   ! south wall (location of adjacent fluid)
    1207              fym(j,i)    = 1.0_wp
    1208              fyp(j,i)    = 0.0_wp
    1209           ENDIF
    1210 !
    1211 !--       v-component
    1212           IF ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  THEN
    1213              wall_v(j,i) = 1.0_wp   ! rigth wall (location of adjacent fluid)
    1214              fxm(j,i)    = 0.0_wp
    1215              fxp(j,i)    = 1.0_wp
    1216           ELSEIF ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  THEN
    1217              wall_v(j,i) = 1.0_wp   ! left wall (location of adjacent fluid)
    1218              fxm(j,i)    = 1.0_wp
    1219              fxp(j,i)    = 0.0_wp
    1220           ENDIF
    1221 !
    1222 !--       w-component, also used for scalars, separate arrays for shear
    1223 !--       production of tke
    1224           IF ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  THEN
    1225              wall_e_y(j,i) =  1.0_wp   ! north wall (location of adjacent fluid)
    1226              wall_w_y(j,i) =  1.0_wp
    1227              fwym(j,i)     =  0.0_wp
    1228              fwyp(j,i)     =  1.0_wp
    1229           ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  THEN
    1230              wall_e_y(j,i) = -1.0_wp   ! south wall (location of adjacent fluid)
    1231              wall_w_y(j,i) =  1.0_wp
    1232              fwym(j,i)     =  1.0_wp
    1233              fwyp(j,i)     =  0.0_wp
    1234           ENDIF
    1235           IF ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  THEN
    1236              wall_e_x(j,i) =  1.0_wp   ! right wall (location of adjacent fluid)
    1237              wall_w_x(j,i) =  1.0_wp
    1238              fwxm(j,i)     =  0.0_wp
    1239              fwxp(j,i)     =  1.0_wp
    1240           ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  THEN
    1241              wall_e_x(j,i) = -1.0_wp   ! left wall (location of adjacent fluid)
    1242              wall_w_x(j,i) =  1.0_wp
    1243              fwxm(j,i)     =  1.0_wp
    1244              fwxp(j,i)     =  0.0_wp
    1245           ENDIF
    1246 !
    1247 !--       Wall and corner locations inside buildings for limitation of
    1248 !--       near-wall mixing length l_wall
    1249           IF ( nzb_s_inner(j,i) > nzb_s_inner(j+1,i) )  THEN
    1250 
    1251              wall_n(j,i) = nzb_s_inner(j+1,i) + 1            ! North wall
    1252 
    1253              IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) )  THEN
    1254                 corner_nl(j,i) = MAX( nzb_s_inner(j+1,i),  & ! Northleft corner
    1255                                       nzb_s_inner(j,i-1) ) + 1
    1256              ENDIF
    1257 
    1258              IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) )  THEN
    1259                 corner_nr(j,i) = MAX( nzb_s_inner(j+1,i),  & ! Northright corner
    1260                                       nzb_s_inner(j,i+1) ) + 1
    1261              ENDIF
    1262 
    1263           ENDIF
    1264 
    1265           IF ( nzb_s_inner(j,i) > nzb_s_inner(j-1,i) )  THEN
    1266 
    1267              wall_s(j,i) = nzb_s_inner(j-1,i) + 1            ! South wall
    1268              IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) )  THEN
    1269                 corner_sl(j,i) = MAX( nzb_s_inner(j-1,i),  & ! Southleft corner
    1270                                       nzb_s_inner(j,i-1) ) + 1
    1271              ENDIF
    1272 
    1273              IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) )  THEN
    1274                 corner_sr(j,i) = MAX( nzb_s_inner(j-1,i),  & ! Southright corner
    1275                                       nzb_s_inner(j,i+1) ) + 1
    1276              ENDIF
    1277 
    1278           ENDIF
    1279 
    1280           IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) )  THEN
    1281              wall_l(j,i) = nzb_s_inner(j,i-1) + 1            ! Left wall
    1282           ENDIF
    1283 
    1284           IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) )  THEN
    1285              wall_r(j,i) = nzb_s_inner(j,i+1) + 1            ! Right wall
    1286           ENDIF
     1430!-- Set-up topography flags. First, set flags only for s, u, v and w-grid.
     1431!-- Further special flags will be set in following loops.
     1432    wall_flags_0 = 0
     1433    DO  j = nys, nyn
     1434       DO  i = nxl, nxr
     1435          DO  k = nzb, nzt+1
     1436!
     1437!--          scalar grid
     1438             IF ( BTEST( topo_3d(k,j,i), 0 ) )                                 &
     1439                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 )
     1440!
     1441!--          v grid
     1442             IF ( BTEST( topo_3d(k,j,i),   0 )  .AND.                          &
     1443                  BTEST( topo_3d(k,j-1,i), 0 ) )                               &
     1444                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )
     1445!
     1446!--     To do: set outer arrays on basis of topo_3d array, adjust for downward-facing walls
     1447!--          s grid outer array
     1448             IF ( k >= nzb_s_outer(j,i) )                                      &
     1449                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 )
     1450!
     1451!--          s grid outer array
     1452             IF ( k >= nzb_u_outer(j,i) )                                      &
     1453                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 26 )
     1454!
     1455!--          s grid outer array
     1456             IF ( k >= nzb_v_outer(j,i) )                                      &
     1457                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )
     1458!
     1459!--          w grid outer array
     1460             IF ( k >= nzb_w_outer(j,i) )                                      &
     1461                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 28 )
     1462          ENDDO
     1463
     1464          DO k = nzb, nzt
     1465!
     1466!--          w grid
     1467             IF ( BTEST( topo_3d(k,j,i),   0 )  .AND.                          &
     1468                  BTEST( topo_3d(k+1,j,i), 0 ) )                               &
     1469                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )
     1470          ENDDO
     1471          wall_flags_0(nzt+1,j,i) = IBSET( wall_flags_0(nzt+1,j,i), 3 )
    12871472
    12881473       ENDDO
    12891474    ENDDO
     1475!
     1476!-- u grid. Note, reverse
     1477!-- memory access is required for setting flag on u-grid
     1478    DO  j = nys, nyn
     1479       DO  i = nxl, nxr
     1480          DO k = nzb, nzt+1
     1481             IF ( BTEST( topo_3d(k,j,i),   0 )  .AND.                          &
     1482                  BTEST( topo_3d(k,j,i-1), 0 ) )                               &
     1483                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 )
     1484          ENDDO
     1485       ENDDO
     1486    ENDDO
     1487!
     1488!-- Set further special flags
     1489    DO i = nxl, nxr
     1490       DO j = nys, nyn
     1491          DO k = nzb, nzt+1
     1492!
     1493!--          scalar grid, former nzb_diff_s_inner.
     1494!--          Note, use this flag also to mask topography in diffusion_u and
     1495!--          diffusion_v along the vertical direction. In case of
     1496!--          use_surface_fluxes, fluxes are calculated via MOST, else, simple
     1497!--          gradient approach is applied. Please note, in case of u- and v-
     1498!--          diffuison, a small error is made at edges (on the east side for u,
     1499!--          at the north side for v), since topography on scalar grid point
     1500!--          is used instead of topography on u/v-grid. As number of topography grid
     1501!--          points on uv-grid is different than s-grid, different number of
     1502!--          surface elements would be required. In order to avoid this,
     1503!--          treat edges (u(k,j,i+1)) simply by a gradient approach, i.e. these
     1504!--          points are not masked within diffusion_u. Tests had shown that the
     1505!--          effect on the flow is negligible.
     1506             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
     1507                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )                         &
     1508                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 )
     1509             ELSE
     1510                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 )
     1511             ENDIF
     1512
     1513          ENDDO
     1514!
     1515!--       Special flag to control vertical diffusion at model top - former
     1516!--       nzt_diff
     1517          wall_flags_0(:,j,i) = IBSET( wall_flags_0(:,j,i), 9 )
     1518          IF ( use_top_fluxes )                                                &
     1519             wall_flags_0(nzt:nzt+1,j,i) = IBCLR( wall_flags_0(nzt:nzt+1,j,i), 9 )
     1520
     1521          DO k = nzb+1, nzt
     1522!
     1523!--          Special flag on u grid, former nzb_u_inner + 1, required   
     1524!--          for disturb_field and initialization. Do not disturb directly at
     1525!--          topography, as well as initialize u with zero one grid point outside
     1526!--          of topography.
     1527             IF ( BTEST( wall_flags_0(k-1,j,i), 1 )  .AND.                     &
     1528                  BTEST( wall_flags_0(k,j,i),   1 )  .AND.                     &
     1529                  BTEST( wall_flags_0(k+1,j,i), 1 ) )                          &
     1530                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 20 )
     1531!
     1532!--          Special flag on v grid, former nzb_v_inner + 1, required   
     1533!--          for disturb_field and initialization. Do not disturb directly at
     1534!--          topography, as well as initialize v with zero one grid point outside
     1535!--          of topography.
     1536             IF ( BTEST( wall_flags_0(k-1,j,i), 2 )  .AND.                     &
     1537                  BTEST( wall_flags_0(k,j,i),   2 )  .AND.                     &
     1538                  BTEST( wall_flags_0(k+1,j,i), 2 ) )                          &
     1539                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )
     1540!
     1541!--          Special flag on scalar grid, former nzb_s_inner+1. Used for
     1542!--          lpm_sgs_tke
     1543             IF ( BTEST( wall_flags_0(k,j,i),   0 )  .AND.                     &
     1544                  BTEST( wall_flags_0(k-1,j,i), 0 )  .AND.                     &
     1545                  BTEST( wall_flags_0(k+1,j,i), 0 ) )                          &
     1546                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 25 )
     1547!
     1548!--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in
     1549!--          in production_e
     1550             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
     1551                IF ( BTEST( wall_flags_0(k,j,i),   24 )  .AND.                 &
     1552                     BTEST( wall_flags_0(k-1,j,i), 24 )  .AND.                 &
     1553                     BTEST( wall_flags_0(k+1,j,i), 0 ) )                       &
     1554                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 29 )
     1555             ELSE
     1556                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )                         &
     1557                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 29 )
     1558             ENDIF
     1559!
     1560!--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in
     1561!--          in production_e
     1562             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
     1563                IF ( BTEST( wall_flags_0(k,j,i),   0 )  .AND.                  &
     1564                     BTEST( wall_flags_0(k-1,j,i), 0 )  .AND.                  &
     1565                     BTEST( wall_flags_0(k+1,j,i), 0 ) )                       &
     1566                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )
     1567             ELSE
     1568                IF ( BTEST( wall_flags_0(k,j,i), 0 ) )                         &
     1569                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )
     1570             ENDIF
     1571          ENDDO
     1572!
     1573!--       Flags indicating downward facing walls
     1574          DO k = nzb+1, nzt
     1575!
     1576!--          Scalar grid
     1577             IF ( BTEST( wall_flags_0(k-1,j,i), 0 )  .AND.                     &
     1578            .NOT. BTEST( wall_flags_0(k,j,i), 0   ) )                          &
     1579                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 )
     1580!
     1581!--          Downward facing wall on u grid
     1582             IF ( BTEST( wall_flags_0(k-1,j,i), 1 )  .AND.                     &
     1583            .NOT. BTEST( wall_flags_0(k,j,i), 1   ) )                          &
     1584                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 15 )
     1585!
     1586!--          Downward facing wall on v grid
     1587             IF ( BTEST( wall_flags_0(k-1,j,i), 2 )  .AND.                     &
     1588            .NOT. BTEST( wall_flags_0(k,j,i), 2   ) )                          &
     1589                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 17 )
     1590!
     1591!--          Downward facing wall on w grid
     1592             IF ( BTEST( wall_flags_0(k-1,j,i), 3 )  .AND.                     &
     1593            .NOT. BTEST( wall_flags_0(k,j,i), 3 ) )                            &
     1594                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 19 )
     1595          ENDDO
     1596!
     1597!--       Flags indicating upward facing walls
     1598          DO k = nzb, nzt
     1599!
     1600!--          Upward facing wall on scalar grid
     1601             IF ( .NOT. BTEST( wall_flags_0(k,j,i),   0 )  .AND.               &
     1602                        BTEST( wall_flags_0(k+1,j,i), 0 ) )                    &
     1603                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )
     1604!
     1605!--          Upward facing wall on u grid
     1606             IF ( .NOT. BTEST( wall_flags_0(k,j,i),   1 )  .AND.               &
     1607                        BTEST( wall_flags_0(k+1,j,i), 1 ) )                    &
     1608                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 )
     1609
     1610!
     1611!--          Upward facing wall on v grid
     1612             IF ( .NOT. BTEST( wall_flags_0(k,j,i),   2 )  .AND.               &
     1613                        BTEST( wall_flags_0(k+1,j,i), 2 ) )                    &
     1614                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 16 )
     1615
     1616!
     1617!--          Upward facing wall on w grid
     1618             IF ( .NOT. BTEST( wall_flags_0(k,j,i),   3 )  .AND.               &
     1619                        BTEST( wall_flags_0(k+1,j,i), 3 ) )                    &
     1620                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )
     1621!
     1622!--          Special flag on scalar grid, former nzb_s_inner
     1623             IF ( BTEST( wall_flags_0(k,j,i), 0 )  .OR.                        &
     1624                  BTEST( wall_flags_0(k,j,i), 12 ) .OR.                        &
     1625                  BTEST( wall_flags_0(k,j,i), 13 ) )                           &
     1626                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )
     1627!
     1628!--          Special flag on scalar grid, nzb_diff_s_inner - 1, required for
     1629!--          flow_statistics
     1630             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
     1631                IF ( BTEST( wall_flags_0(k,j,i),   0 )  .AND.                  &
     1632                     BTEST( wall_flags_0(k+1,j,i), 0 ) )                       &
     1633                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )
     1634             ELSE
     1635                IF ( BTEST( wall_flags_0(k,j,i), 22 ) )                        &
     1636                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )
     1637             ENDIF
     1638
     1639
     1640          ENDDO
     1641          wall_flags_0(nzt+1,j,i) = IBSET( wall_flags_0(nzt+1,j,i), 22 )
     1642          wall_flags_0(nzt+1,j,i) = IBSET( wall_flags_0(nzt+1,j,i), 23 )
     1643       ENDDO
     1644    ENDDO
     1645!
     1646!-- Exchange ghost points for wall flags
     1647    CALL exchange_horiz_int( wall_flags_0, nbgp )
     1648!
     1649!-- Set boundary conditions also for flags. Can be interpreted as Neumann
     1650!-- boundary conditions for topography.
     1651    IF ( .NOT. bc_ns_cyc )  THEN
     1652       IF ( nys == 0  )  wall_flags_0(:,-1,:)   = wall_flags_0(:,0,:)
     1653       IF ( nyn == ny )  wall_flags_0(:,ny+1,:) = wall_flags_0(:,ny,:)
     1654    ENDIF
     1655    IF ( .NOT. bc_lr_cyc )  THEN
     1656       IF ( nxl == 0  )  wall_flags_0(:,:,-1)   = wall_flags_0(:,:,0)
     1657       IF ( nxr == nx )  wall_flags_0(:,:,nx+1) = wall_flags_0(:,:,nx)           
     1658    ENDIF
     1659
     1660!
     1661!-- Initialize boundary conditions via surface type
     1662    CALL init_bc
     1663!
     1664!-- Allocate and set topography height arrays required for data output
     1665    IF ( TRIM( topography ) /= 'flat' )  THEN
     1666!
     1667!--    Allocate and set the arrays containing the topography height
     1668
     1669       IF ( nxr == nx  .AND.  nyn /= ny )  THEN
     1670          ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn),                             &
     1671                    zw_w_inner(nxl:nxr+1,nys:nyn) )
     1672       ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
     1673          ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn+1),                             &
     1674                    zw_w_inner(nxl:nxr,nys:nyn+1) )
     1675       ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
     1676          ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn+1),                           &
     1677                    zw_w_inner(nxl:nxr+1,nys:nyn+1) )
     1678       ELSE
     1679          ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn),                               &
     1680                    zw_w_inner(nxl:nxr,nys:nyn) )
     1681       ENDIF
     1682
     1683       zu_s_inner   = 0.0_wp
     1684       zw_w_inner   = 0.0_wp
     1685!
     1686!--    Determine local topography height on scalar and w-grid. Note, setting
     1687!--    lateral boundary values is not necessary, realized via wall_flags_0
     1688!--    array. Further, please note that loop bounds are different from
     1689!--    nxl to nxr and nys to nyn on south and right model boundary, hence,
     1690!--    use intrinsic lbound and ubound functions to infer array bounds.
     1691       DO  i = lbound(zu_s_inner, 1), ubound(zu_s_inner, 1)
     1692          DO  j = lbound(zu_s_inner, 2), ubound(zu_s_inner, 2)
     1693!
     1694!--          Topography height on scalar grid. Therefore, determine index of
     1695!--          upward-facing surface element on scalar grid (bit 12).
     1696             zu_s_inner(i,j) = zu( MAXLOC( MERGE(                              &
     1697                                         1, 0, BTEST( wall_flags_0(:,j,i), 12 )&
     1698                                                ), DIM = 1                     &
     1699                                         ) - 1                                 &
     1700                                 )
     1701!
     1702!--          Topography height on w grid. Therefore, determine index of
     1703!--          upward-facing surface element on w grid (bit 18).
     1704             zw_w_inner(i,j) = zw( MAXLOC( MERGE(                              &
     1705                                         1, 0, BTEST( wall_flags_0(:,j,i), 18 )&
     1706                                                ), DIM = 1                     &
     1707                                         ) - 1                                 &
     1708                                 )
     1709          ENDDO
     1710       ENDDO
     1711
     1712
     1713    ENDIF
     1714
    12901715!
    12911716!-- Calculate wall flag arrays for the multigrid method.
    … …  
    14501875!-- required in the ws-scheme, the arrays need to be allocated here as they are
    14511876!-- used in OpenACC directives.
    1452     ALLOCATE( wall_flags_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                     &
    1453               wall_flags_00(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    1454     wall_flags_0 = 0
    1455     wall_flags_00 = 0
     1877    ALLOCATE( advc_flags_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                     &
     1878              advc_flags_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     1879    advc_flags_1 = 0
     1880    advc_flags_2 = 0
    14561881!
    14571882!-- Init flags for ws-scheme to degrade order of the numerics near walls, i.e.
    … …  
    14661891!-- Go through all points of the subdomain one by one and look for the closest
    14671892!-- surface
    1468     IF ( TRIM(topography) /= 'flat' )  THEN
    1469        DO  i = nxl, nxr
    1470           DO  j = nys, nyn
    1471 
    1472              nzb_si = nzb_s_inner(j,i)
    1473              vi     = vertical_influence(nzb_si)
    1474 
    1475              IF ( wall_n(j,i) > 0 )  THEN
    1476 !
    1477 !--             North wall (y distance)
    1478                 DO  k = wall_n(j,i), nzb_si
    1479                    l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), 0.5_wp * dy )
    1480                 ENDDO
    1481 !
    1482 !--             Above North wall (yz distance)
    1483                 DO  k = nzb_si + 1, nzb_si + vi
    1484                    l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i),                     &
    1485                                           SQRT( 0.25_wp * dy**2 +              &
    1486                                           ( zu(k) - zw(nzb_si) )**2 ) )
    1487                 ENDDO
    1488 !
    1489 !--             Northleft corner (xy distance)
    1490                 IF ( corner_nl(j,i) > 0 )  THEN
    1491                    DO  k = corner_nl(j,i), nzb_si
    1492                       l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
    1493                                                0.5_wp * SQRT( dx**2 + dy**2 ) )
    1494                    ENDDO
    1495 !
    1496 !--                Above Northleft corner (xyz distance)
    1497                    DO  k = nzb_si + 1, nzb_si + vi
    1498                       l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1),              &
    1499                                             SQRT( 0.25_wp * (dx**2 + dy**2) +  &
    1500                                             ( zu(k) - zw(nzb_si) )**2 ) )
    1501                    ENDDO
    1502                 ENDIF
    1503 !
    1504 !--             Northright corner (xy distance)
    1505                 IF ( corner_nr(j,i) > 0 )  THEN
    1506                    DO  k = corner_nr(j,i), nzb_si
    1507                        l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1),             &
    1508                                                 0.5_wp * SQRT( dx**2 + dy**2 ) )
    1509                    ENDDO
    1510 !
    1511 !--                Above northright corner (xyz distance)
    1512                    DO  k = nzb_si + 1, nzb_si + vi
    1513                       l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1),              &
    1514                                             SQRT( 0.25_wp * (dx**2 + dy**2) +  &
    1515                                             ( zu(k) - zw(nzb_si) )**2 ) )
    1516                    ENDDO
    1517                 ENDIF
     1893    DO  i = nxl, nxr
     1894       DO  j = nys, nyn
     1895          DO  k = nzb+1, nzt
     1896!
     1897!--          Check if current gridpoint belongs to the atmosphere
     1898             IF ( BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
     1899!
     1900!--             Check for neighbouring grid-points.
     1901!--             Vertical distance, down
     1902                IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )                 &
     1903                   l_wall(k,j,i) = MIN( l_grid(k), zu(k) - zw(k-1) )
     1904!
     1905!--             Vertical distance, up
     1906                IF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )                 &
     1907                   l_wall(k,j,i) = MIN( l_grid(k), zw(k) - zu(k) )
     1908!
     1909!--             y-distance
     1910                IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 )  .OR.             &
     1911                     .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )                 &
     1912                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dy )
     1913!
     1914!--             x-distance
     1915                IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 )  .OR.             &
     1916                     .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )                 &
     1917                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dx )
     1918!
     1919!--              yz-distance (vertical edges, down)
     1920                 IF ( .NOT. BTEST( wall_flags_0(k-1,j-1,i), 0 )  .OR.          &
     1921                      .NOT. BTEST( wall_flags_0(k-1,j+1,i), 0 )  )             &
     1922                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1923                                        SQRT( 0.25_wp * dy**2 +                &
     1924                                       ( zu(k) - zw(k-1) )**2 ) )
     1925!
     1926!--              yz-distance (vertical edges, up)
     1927                 IF ( .NOT. BTEST( wall_flags_0(k+1,j-1,i), 0 )  .OR.          &
     1928                      .NOT. BTEST( wall_flags_0(k+1,j+1,i), 0 )  )             &
     1929                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1930                                        SQRT( 0.25_wp * dy**2 +                &
     1931                                       ( zw(k) - zu(k) )**2 ) )
     1932!
     1933!--              xz-distance (vertical edges, down)
     1934                 IF ( .NOT. BTEST( wall_flags_0(k-1,j,i-1), 0 )  .OR.          &
     1935                      .NOT. BTEST( wall_flags_0(k-1,j,i+1), 0 )  )             &
     1936                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1937                                        SQRT( 0.25_wp * dx**2 +                &
     1938                                       ( zu(k) - zw(k-1) )**2 ) )
     1939!
     1940!--              xz-distance (vertical edges, up)
     1941                 IF ( .NOT. BTEST( wall_flags_0(k+1,j,i-1), 0 )  .OR.          &
     1942                      .NOT. BTEST( wall_flags_0(k+1,j,i+1), 0 )  )             &
     1943                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1944                                        SQRT( 0.25_wp * dx**2 +                &
     1945                                       ( zw(k) - zu(k) )**2 ) )
     1946!
     1947!--             xy-distance (horizontal edges)
     1948                IF ( .NOT. BTEST( wall_flags_0(k,j-1,i-1), 0 )  .OR.           &
     1949                     .NOT. BTEST( wall_flags_0(k,j+1,i-1), 0 )  .OR.           &
     1950                     .NOT. BTEST( wall_flags_0(k,j-1,i+1), 0 )  .OR.           &
     1951                     .NOT. BTEST( wall_flags_0(k,j+1,i+1), 0 ) )               &
     1952                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1953                                        SQRT( 0.25_wp * ( dx**2 + dy**2 ) ) )
     1954!
     1955!--             xyz distance (vertical and horizontal edges, down)
     1956                IF ( .NOT. BTEST( wall_flags_0(k-1,j-1,i-1), 0 )  .OR.         &
     1957                     .NOT. BTEST( wall_flags_0(k-1,j+1,i-1), 0 )  .OR.         &
     1958                     .NOT. BTEST( wall_flags_0(k-1,j-1,i+1), 0 )  .OR.         &
     1959                     .NOT. BTEST( wall_flags_0(k-1,j+1,i+1), 0 ) )             &
     1960                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1961                                        SQRT( 0.25_wp * ( dx**2 + dy**2 )      &
     1962                                              +  ( zu(k) - zw(k-1) )**2  ) )
     1963!
     1964!--             xyz distance (vertical and horizontal edges, up)
     1965                IF ( .NOT. BTEST( wall_flags_0(k+1,j-1,i-1), 0 )  .OR.         &
     1966                     .NOT. BTEST( wall_flags_0(k+1,j+1,i-1), 0 )  .OR.         &
     1967                     .NOT. BTEST( wall_flags_0(k+1,j-1,i+1), 0 )  .OR.         &
     1968                     .NOT. BTEST( wall_flags_0(k+1,j+1,i+1), 0 ) )             &
     1969                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
     1970                                        SQRT( 0.25_wp * ( dx**2 + dy**2 )      &
     1971                                              +  ( zw(k) - zu(k) )**2  ) )
     1972                 
    15181973             ENDIF
    1519 
    1520              IF ( wall_s(j,i) > 0 )  THEN
    1521 !
    1522 !--             South wall (y distance)
    1523                 DO  k = wall_s(j,i), nzb_si
    1524                    l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), 0.5_wp * dy )
    1525                 ENDDO
    1526 !
    1527 !--             Above south wall (yz distance)
    1528                 DO  k = nzb_si + 1, nzb_si + vi
    1529                    l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i),                     &
    1530                                           SQRT( 0.25_wp * dy**2 +              &
    1531                                           ( zu(k) - zw(nzb_si) )**2 ) )
    1532                 ENDDO
    1533 !
    1534 !--             Southleft corner (xy distance)
    1535                 IF ( corner_sl(j,i) > 0 )  THEN
    1536                    DO  k = corner_sl(j,i), nzb_si
    1537                       l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1),              &
    1538                                                0.5_wp * SQRT( dx**2 + dy**2 ) )
    1539                    ENDDO
    1540 !
    1541 !--                Above southleft corner (xyz distance)
    1542                    DO  k = nzb_si + 1, nzb_si + vi
    1543                       l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1),              &
    1544                                             SQRT( 0.25_wp * (dx**2 + dy**2) +  &
    1545                                             ( zu(k) - zw(nzb_si) )**2 ) )
    1546                    ENDDO
    1547                 ENDIF
    1548 !
    1549 !--             Southright corner (xy distance)
    1550                 IF ( corner_sr(j,i) > 0 )  THEN
    1551                    DO  k = corner_sr(j,i), nzb_si
    1552                       l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1),              &
    1553                                                0.5_wp * SQRT( dx**2 + dy**2 ) )
    1554                    ENDDO
    1555 !
    1556 !--                Above southright corner (xyz distance)
    1557                    DO  k = nzb_si + 1, nzb_si + vi
    1558                       l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1),              &
    1559                                             SQRT( 0.25_wp * (dx**2 + dy**2) +  &
    1560                                             ( zu(k) - zw(nzb_si) )**2 ) )
    1561                    ENDDO
    1562                 ENDIF
    1563 
    1564              ENDIF
    1565 
    1566              IF ( wall_l(j,i) > 0 )  THEN
    1567 !
    1568 !--             Left wall (x distance)
    1569                 DO  k = wall_l(j,i), nzb_si
    1570                    l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), 0.5_wp * dx )
    1571                 ENDDO
    1572 !
    1573 !--             Above left wall (xz distance)
    1574                 DO  k = nzb_si + 1, nzb_si + vi
    1575                    l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1),                     &
    1576                                        SQRT( 0.25_wp * dx**2 +                 &
    1577                                        ( zu(k) - zw(nzb_si) )**2 ) )
    1578                 ENDDO
    1579              ENDIF
    1580 
    1581              IF ( wall_r(j,i) > 0 )  THEN
    1582 !
    1583 !--             Right wall (x distance)
    1584                 DO  k = wall_r(j,i), nzb_si
    1585                    l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), 0.5_wp * dx )
    1586                 ENDDO
    1587 !
    1588 !--             Above right wall (xz distance)
    1589                 DO  k = nzb_si + 1, nzb_si + vi
    1590                    l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1),                     &
    1591                                           SQRT( 0.25_wp * dx**2 +              &
    1592                                           ( zu(k) - zw(nzb_si) )**2 ) )
    1593                 ENDDO
    1594 
    1595              ENDIF
    1596 
    15971974          ENDDO
    15981975       ENDDO
    1599 
    1600     ENDIF
    1601 
    1602 !
    1603 !-- Multiplication with wall_adjustment_factor
    1604     l_wall = wall_adjustment_factor * l_wall
    1605 
     1976    ENDDO
    16061977!
    16071978!-- Set lateral boundary conditions for l_wall
    1608     CALL exchange_horiz( l_wall, nbgp )
    1609 
    1610     DEALLOCATE( corner_nl, corner_nr, corner_sl, corner_sr, nzb_local, &
    1611                 vertical_influence, wall_l, wall_n, wall_r, wall_s )
     1979    CALL exchange_horiz( l_wall, nbgp )     
    16121980
    16131981

  • palm/trunk/SOURCE/interaction_droplets_ptq.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    106106           
    107107       USE indices,                                                            &
    108            ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
     108           ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    109109           
    110110       USE kinds
    … …  
    114114       IMPLICIT NONE
    115115
    116        INTEGER(iwp) ::  i !<
    117        INTEGER(iwp) ::  j !<
    118        INTEGER(iwp) ::  k !<
     116       INTEGER(iwp) ::  i    !< running index x direction
     117       INTEGER(iwp) ::  j    !< running index y direction
     118       INTEGER(iwp) ::  k    !< running index z direction
    119119
     120       REAL(wp) ::  flag     !< flag to mask topography grid points
    120121 
    121122       DO  i = nxl, nxr
    122123          DO  j = nys, nyn
    123              DO  k = nzb_s_inner(j,i)+1, nzt
    124                 q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i)
    125                 pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)
     124             DO  k = nzb+1, nzt
     125!
     126!--             Predetermine flag to mask topography
     127                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     128
     129                q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i) * flag
     130                pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)   &
     131                                                        * flag
    126132             ENDDO
    127133          ENDDO
    … …  
    145151
    146152       USE indices,                                                            &
    147            ONLY:  nzb_s_inner, nzt
     153           ONLY:  nzb, nzt, wall_flags_0
    148154
    149155       USE kinds,                                                              &
    … …  
    154160       IMPLICIT NONE
    155161
    156        INTEGER(iwp) ::  i !<
    157        INTEGER(iwp) ::  j !<
    158        INTEGER(iwp) ::  k !<
     162       INTEGER(iwp) ::  i    !< running index x direction
     163       INTEGER(iwp) ::  j    !< running index y direction
     164       INTEGER(iwp) ::  k    !< running index z direction
     165
     166       REAL(wp) ::  flag     !< flag to mask topography grid points
    159167
    160168
    161        DO  k = nzb_s_inner(j,i)+1, nzt
    162           q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i)
    163           pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)
     169       DO  k = nzb+1, nzt
     170!
     171!--       Predetermine flag to mask topography
     172          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     173
     174          q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i) * flag
     175          pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k) * flag
    164176       ENDDO
    165177

  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r2150 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
     23!   - now, also vertical walls are possible
     24!   - for vertical walls, parametrization of r_a (aerodynamic resisistance) is
     25!     implemented.
     26!
     27! Add check for soil moisture, it must not exceed its saturation value.
    2328!
    2429! Former revisions:
    … …  
    159164!> DALES and UCLA-LES models.
    160165!>
     166!> @todo Extensive verification energy-balance solver for vertical surfaces,
     167!>       e.g. parametrization of r_a
     168!> @todo Revise single land-surface processes for vertical surfaces, e.g.
     169!>       treatment of humidity, etc.
    161170!> @todo Consider partial absorption of the net shortwave radiation by the
    162171!>       skin layer.
    … …  
    174183 
    175184    USE arrays_3d,                                                             &
    176         ONLY:  hyp, ol, pt, pt_p, prr, q, q_p, ql, qsws, shf, ts, us, vpt, z0, &
    177                z0h, z0q
     185        ONLY:  hyp, pt, pt_p, prr, q, q_p, ql, vpt, u, v, w
    178186
    179187    USE cloud_parameters,                                                      &
    … …  
    183191        ONLY:  cloud_physics, dt_3d, humidity, intermediate_timestep_count,    &
    184192               initializing_actions, intermediate_timestep_count_max,          &
    185                max_masks, precipitation, pt_surface,                           &
     193               land_surface, max_masks, precipitation, pt_surface,             &
    186194               rho_surface, roughness_length, surface_pressure,                &
    187195               timestep_scheme, tsc, z0h_factor, time_since_reference_point
    188196
    189197    USE indices,                                                               &
    190         ONLY:  nbgp, nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner
     198        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb
    191199
    192200    USE kinds
    … …  
    196204    USE radiation_model_mod,                                                   &
    197205        ONLY:  force_radiation_call, rad_net, rad_sw_in, rad_lw_out,           &
    198                rad_lw_out_change_0, unscheduled_radiation_calls
     206               rad_lw_out_change_0, radiation_scheme, unscheduled_radiation_calls
    199207       
    200208    USE statistics,                                                            &
    201209        ONLY:  hom, statistic_regions
    202210
     211    USE surface_mod,                                                        &
     212        ONLY :  surf_lsm_h, surf_lsm_v, surf_type
     213
    203214    IMPLICIT NONE
    204215
     216    TYPE surf_type_lsm
     217       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  var_1D !< 1D prognostic variable
     218       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_2D !< 2D prognostic variable
     219    END TYPE surf_type_lsm
    205220!
    206221!-- LSM model constants
    … …  
    225240                    soil_type = 3    !< NAMELIST soil_type_2d
    226241
    227     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  soil_type_2d, &  !< soil type, 0: user-defined, 1-7: generic (see list)
    228                                                   veg_type_2d      !< vegetation type, 0: user-defined, 1-19: generic (see list)
    229 
    230     LOGICAL, DIMENSION(:,:), ALLOCATABLE :: water_surface,     & !< flag parameter for water surfaces (classes 14+15)
    231                                             pave_surface,      & !< flag parameter for pavements (asphalt etc.) (class 20)
    232                                             building_surface     !< flag parameter indicating that the surface element is covered by buildings (no LSM actions, not implemented yet)
    233 
    234242    LOGICAL :: conserve_water_content = .TRUE.,  & !< open or closed bottom surface for the soil model
    235                force_radiation_call_l = .FALSE., & !< flag parameter for unscheduled radiation model calls
    236                land_surface = .FALSE.              !< flag parameter indicating wheather the lsm is used
     243               force_radiation_call_l = .FALSE., & !< flag to force calling of radiation routine
     244               aero_resist_kray = .TRUE.           !< flag to control parametrization of aerodynamic resistance at vertical surface elements
    237245
    238246!   value 9999999.9_wp -> generic available or user-defined value must be set
    … …  
    288296              dz_soil                                                            !< soil grid spacing (edge-edge)
    289297
     298
    290299#if defined( __nopointer )
    291     REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_surface,   & !< surface temperature (K)
    292                                                      t_surface_p, & !< progn. surface temperature (K)
    293                                                      m_liq_eb,    & !< liquid water reservoir (m)
    294                                                      m_liq_eb_av, & !< liquid water reservoir (m)
    295                                                      m_liq_eb_p     !< progn. liquid water reservoir (m)
     300    TYPE(surf_type_lsm), TARGET  ::  t_soil_h,    & !< Soil temperature (K), horizontal surface elements
     301                                     t_soil_h_p,  & !< Prog. soil temperature (K), horizontal surface elements
     302                                     m_soil_h,    & !< Soil moisture (m3/m3), horizontal surface elements
     303                                     m_soil_h_p     !< Prog. soil moisture (m3/m3), horizontal surface elements
     304
     305    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET  ::  &
     306                                     t_soil_v,    & !< Soil temperature (K), vertical surface elements
     307                                     t_soil_v_p,  & !< Prog. soil temperature (K), vertical surface elements
     308                                     m_soil_v,    & !< Soil moisture (m3/m3), vertical surface elements
     309                                     m_soil_v_p     !< Prog. soil moisture (m3/m3), vertical surface elements
    296310#else
    297     REAL(wp), DIMENSION(:,:), POINTER :: t_surface,      &
    298                                          t_surface_p,    &
    299                                          m_liq_eb,       &
    300                                          m_liq_eb_p
    301 
    302     REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_surface_1, t_surface_2, &
    303                                                      m_liq_eb_av,              &
    304                                                      m_liq_eb_1, m_liq_eb_2
     311    TYPE(surf_type_lsm), POINTER ::  t_soil_h,    & !< Soil temperature (K), horizontal surface elements
     312                                     t_soil_h_p,  & !< Prog. soil temperature (K), horizontal surface elements
     313                                     m_soil_h,    & !< Soil moisture (m3/m3), horizontal surface elements
     314                                     m_soil_h_p     !< Prog. soil moisture (m3/m3), horizontal surface elements
     315
     316    TYPE(surf_type_lsm), TARGET  ::  t_soil_h_1,  & !<
     317                                     t_soil_h_2,  & !<
     318                                     m_soil_h_1,  & !<
     319                                     m_soil_h_2     !<
     320
     321    TYPE(surf_type_lsm), DIMENSION(:), POINTER :: &
     322                                     t_soil_v,    & !< Soil temperature (K), vertical surface elements
     323                                     t_soil_v_p,  & !< Prog. soil temperature (K), vertical surface elements
     324                                     m_soil_v,    & !< Soil moisture (m3/m3), vertical surface elements
     325                                     m_soil_v_p     !< Prog. soil moisture (m3/m3), vertical surface elements   
     326
     327    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::&
     328                                     t_soil_v_1,  & !<
     329                                     t_soil_v_2,  & !<
     330                                     m_soil_v_1,  & !<
     331                                     m_soil_v_2     !<
     332#endif   
     333
     334#if defined( __nopointer )
     335    TYPE(surf_type_lsm), TARGET   ::  t_surface_h,    & !< surface temperature (K), horizontal surface elements
     336                                      t_surface_h_p,  & !< progn. surface temperature (K), horizontal surface elements
     337                                      m_liq_eb_h,     & !< liquid water reservoir (m), horizontal surface elements
     338                                      m_liq_eb_h_p      !< progn. liquid water reservoir (m), horizontal surface elements
     339
     340    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET   ::  &
     341                                      t_surface_v,    & !< surface temperature (K), vertical surface elements
     342                                      t_surface_v_p,  & !< progn. surface temperature (K), vertical surface elements
     343                                      m_liq_eb_v,     & !< liquid water reservoir (m), vertical surface elements
     344                                      m_liq_eb_v_p      !< progn. liquid water reservoir (m), vertical surface elements
     345#else
     346    TYPE(surf_type_lsm), POINTER  ::  t_surface_h,    & !< surface temperature (K), horizontal surface elements
     347                                      t_surface_h_p,  & !< progn. surface temperature (K), horizontal surface elements
     348                                      m_liq_eb_h,     & !< liquid water reservoir (m), horizontal surface elements
     349                                      m_liq_eb_h_p      !< progn. liquid water reservoir (m), horizontal surface elements
     350
     351    TYPE(surf_type_lsm), TARGET   ::  t_surface_h_1,  & !<
     352                                      t_surface_h_2,  & !<
     353                                      m_liq_eb_h_1,   & !<
     354                                      m_liq_eb_h_2      !<
     355
     356    TYPE(surf_type_lsm), DIMENSION(:), POINTER  ::    &
     357                                      t_surface_v,    & !< surface temperature (K), vertical surface elements
     358                                      t_surface_v_p,  & !< progn. surface temperature (K), vertical surface elements
     359                                      m_liq_eb_v,     & !< liquid water reservoir (m), vertical surface elements
     360                                      m_liq_eb_v_p      !< progn. liquid water reservoir (m), vertical surface elements
     361
     362    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET   ::  &
     363                                      t_surface_v_1,  & !<
     364                                      t_surface_v_2,  & !<
     365                                      m_liq_eb_v_1,   & !<
     366                                      m_liq_eb_v_2      !<
    305367#endif
    306368
    307 !
    308 !-- Temporal tendencies for time stepping           
    309     REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_surface_m,  & !< surface temperature tendency (K)
    310                                              tm_liq_eb_m      !< liquid water reservoir tendency (m)
     369#if defined( __nopointer )
     370    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: m_liq_eb_av
     371#else
     372    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: m_liq_eb_av
     373#endif
     374
     375#if defined( __nopointer )
     376    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  t_soil_av, & !< Average of t_soil
     377                                                        m_soil_av    !< Average of m_soil
     378#else
     379    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  t_soil_av, & !< Average of t_soil
     380                                                        m_soil_av    !< Average of m_soil
     381#endif
     382
     383    TYPE(surf_type_lsm), TARGET ::  tm_liq_eb_h_m   !< liquid water reservoir tendency (m), horizontal surface elements
     384    TYPE(surf_type_lsm), TARGET ::  tt_surface_h_m  !< surface temperature tendency (K), horizontal surface elements
     385    TYPE(surf_type_lsm), TARGET ::  tt_soil_h_m     !< t_soil storage array, horizontal surface elements
     386    TYPE(surf_type_lsm), TARGET ::  tm_soil_h_m     !< m_soil storage array, horizontal surface elements
     387
     388    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tm_liq_eb_v_m   !< liquid water reservoir tendency (m), vertical surface elements
     389    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tt_surface_v_m  !< surface temperature tendency (K), vertical surface elements
     390    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tt_soil_v_m     !< t_soil storage array, vertical surface elements
     391    TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::  tm_soil_v_m     !< m_soil storage array, vertical surface elements
    311392
    312393!
    313394!-- Energy balance variables               
    314395    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
    315               alpha_vg,         & !< coef. of Van Genuchten
    316               c_liq,            & !< liquid water coverage (of vegetated area)
    317396              c_liq_av,         & !< average of c_liq
    318397              c_soil_av,        & !< average of c_soil
    319               c_veg,            & !< vegetation coverage
    320398              c_veg_av,         & !< average of c_veg
    321               f_sw_in,          & !< fraction of absorbed shortwave radiation by the surface layer (not implemented yet)
    322               ghf_eb,           & !< ground heat flux
    323399              ghf_eb_av,        & !< average of ghf_eb
    324               gamma_w_sat,      & !< hydraulic conductivity at saturation
    325               g_d,              & !< coefficient for dependence of r_canopy on water vapour pressure deficit
    326               lai,              & !< leaf area index
    327400              lai_av,           & !< average of lai
    328               lambda_surface_s, & !< coupling between surface and soil (depends on vegetation type)
    329               lambda_surface_u, & !< coupling between surface and soil (depends on vegetation type)
    330               l_vg,             & !< coef. of Van Genuchten
    331               m_fc,             & !< soil moisture at field capacity (m3/m3)
    332               m_res,            & !< residual soil moisture
    333               m_sat,            & !< saturation soil moisture (m3/m3)
    334               m_wilt,           & !< soil moisture at permanent wilting point (m3/m3)
    335               n_vg,             & !< coef. Van Genuchten 
    336               qsws_eb,          & !< surface flux of latent heat (total)
    337401              qsws_eb_av,       & !< average of qsws_eb
    338               qsws_liq_eb,      & !< surface flux of latent heat (liquid water portion)
    339402              qsws_liq_eb_av,   & !< average of qsws_liq_eb
    340               qsws_soil_eb,     & !< surface flux of latent heat (soil portion)
    341403              qsws_soil_eb_av,  & !< average of qsws_soil_eb
    342               qsws_veg_eb,      & !< surface flux of latent heat (vegetation portion)
    343404              qsws_veg_eb_av,   & !< average of qsws_veg_eb
    344               rad_net_l,        & !< local copy of rad_net (net radiation at surface)
    345               r_a,              & !< aerodynamic resistance
    346405              r_a_av,           & !< average of r_a
    347               r_canopy,         & !< canopy resistance
    348               r_soil,           & !< soil resistance
    349               r_soil_min,       & !< minimum soil resistance
    350               r_s,              & !< total surface resistance (combination of r_soil and r_canopy)
    351406              r_s_av,           & !< average of r_s
    352               r_canopy_min,     & !< minimum canopy (stomatal) resistance
    353               shf_eb,           & !< surface flux of sensible heat
    354407              shf_eb_av           !< average of shf_eb
    355 
    356 
    357     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::                                 &
    358               lambda_h, &   !< heat conductivity of soil (W/m/K)                           
    359               lambda_w, &   !< hydraulic diffusivity of soil (?)
    360               gamma_w,  &   !< hydraulic conductivity of soil (W/m/K)
    361               rho_c_total   !< volumetric heat capacity of the actual soil matrix (?)
    362 
    363 #if defined( __nopointer )
    364     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                         &
    365               t_soil,    & !< Soil temperature (K)
    366               t_soil_av, & !< Average of t_soil
    367               t_soil_p,  & !< Prog. soil temperature (K)
    368               m_soil,    & !< Soil moisture (m3/m3)
    369               m_soil_av, & !< Average of m_soil
    370               m_soil_p     !< Prog. soil moisture (m3/m3)
    371 #else
    372     REAL(wp), DIMENSION(:,:,:), POINTER ::                                     &
    373               t_soil, t_soil_p, &
    374               m_soil, m_soil_p   
    375 
    376     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                         &
    377               t_soil_av, t_soil_1, t_soil_2,                                   &
    378               m_soil_av, m_soil_1, m_soil_2
    379 #endif
    380 
    381 
    382     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::                                 &
    383               tt_soil_m, & !< t_soil storage array
    384               tm_soil_m, & !< m_soil storage array
    385               root_fr      !< root fraction (sum=1)
    386408
    387409
    … …  
    571593!
    572594!-- Public parameters, constants and initial values
    573     PUBLIC land_surface, skip_time_do_lsm
     595    PUBLIC aero_resist_kray, skip_time_do_lsm
    574596
    575597!
    … …  
    578600
    579601!
    580 !-- Public 2D output variables
    581     PUBLIC ghf_eb, qsws_eb, qsws_liq_eb, qsws_soil_eb,qsws_veg_eb, r_a, r_s,   &
    582            shf_eb
    583 
    584 !
    585602!-- Public prognostic variables
    586     PUBLIC m_soil, t_soil
     603    PUBLIC m_soil_h, t_soil_h
    587604
    588605
    … …  
    871888    USE control_parameters,                                                    &
    872889        ONLY:  bc_pt_b, bc_q_b, constant_flux_layer, message_string,           &
    873                most_method, topography
     890               most_method
    874891                 
    875892    USE radiation_model_mod,                                                   &
    … …  
    879896    IMPLICIT NONE
    880897
    881  
     898    INTEGER(iwp) ::  k        !< running index, z-dimension
    882899!
    883900!-- Dirichlet boundary conditions are required as the surface fluxes are
    … …  
    897914    ENDIF
    898915
    899     IF ( topography /= 'flat' )  THEN
    900        message_string = 'lsm cannot be used ' //                            &
    901                         'in combination with  topography /= "flat"'
    902        CALL message( 'check_parameters', 'PA0415', 1, 2, 0, 6, 0 )
    903     ENDIF
    904 
    905916    IF ( ( veg_type == 14  .OR.  veg_type == 15 ) .AND.                     &
    906917           most_method == 'lookup' )  THEN
    … …  
    10441055
    10451056    ENDIF
     1057!
     1058!-- Check for proper setting of soil moisture, must not be larger than its
     1059!-- saturation value.
     1060    DO  k = nzb_soil, nzt_soil
     1061       IF ( soil_moisture(k) > m_soil_pars(0,soil_type) )  THEN
     1062          message_string = 'soil_moisture must not exceed its saturation' // &
     1063                           ' value'
     1064          CALL message( 'check_parameters', 'PA0403', 1, 2, 0, 6, 0 )
     1065       ENDIF
     1066    ENDDO
    10461067
    10471068    IF (  .NOT.  radiation )  THEN
    … …  
    10591080!> Solver for the energy balance at the surface.
    10601081!------------------------------------------------------------------------------!
    1061  SUBROUTINE lsm_energy_balance
     1082 SUBROUTINE lsm_energy_balance( horizontal, l )
    10621083
    10631084
    … …  
    10651086
    10661087    INTEGER(iwp) ::  i         !< running index
     1088    INTEGER(iwp) ::  i_off     !< offset to determine index of surface element, seen from atmospheric grid point, for x
    10671089    INTEGER(iwp) ::  j         !< running index
    1068     INTEGER(iwp) ::  k, ks     !< running index
     1090    INTEGER(iwp) ::  j_off     !< offset to determine index of surface element, seen from atmospheric grid point, for y
     1091    INTEGER(iwp) ::  k         !< running index
     1092    INTEGER(iwp) ::  k_off     !< offset to determine index of surface element, seen from atmospheric grid point, for z
     1093    INTEGER(iwp) ::  k_rad     !< index to access radiation array
     1094    INTEGER(iwp) ::  ks        !< running index
     1095    INTEGER(iwp) ::  l         !< surface-facing index
     1096    INTEGER(iwp) ::  m         !< running index concerning wall elements
     1097
     1098    LOGICAL      ::  horizontal !< Flag indicating horizontal or vertical surfaces
    10691099
    10701100    REAL(wp) :: c_surface_tmp,& !< temporary variable for storing the volumetric heat capacity of the surface
    … …  
    10901120                qv1            !< specific humidity at first grid level
    10911121
     1122    TYPE(surf_type_lsm), POINTER ::  surf_t_surface
     1123    TYPE(surf_type_lsm), POINTER ::  surf_t_surface_p
     1124    TYPE(surf_type_lsm), POINTER ::  surf_tt_surface_m
     1125    TYPE(surf_type_lsm), POINTER ::  surf_m_liq_eb
     1126    TYPE(surf_type_lsm), POINTER ::  surf_m_liq_eb_p
     1127    TYPE(surf_type_lsm), POINTER ::  surf_tm_liq_eb_m
     1128
     1129    TYPE(surf_type_lsm), POINTER ::  surf_m_soil
     1130    TYPE(surf_type_lsm), POINTER ::  surf_t_soil
     1131
     1132    TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
     1133
     1134    IF ( horizontal )  THEN
     1135       surf              => surf_lsm_h
     1136
     1137       surf_t_surface    => t_surface_h
     1138       surf_t_surface_p  => t_surface_h_p
     1139       surf_tt_surface_m => tt_surface_h_m
     1140       surf_m_liq_eb     => m_liq_eb_h
     1141       surf_m_liq_eb_p   => m_liq_eb_h_p
     1142       surf_tm_liq_eb_m  => tm_liq_eb_h_m
     1143       surf_m_soil       => m_soil_h
     1144       surf_t_soil       => t_soil_h
     1145
     1146       k_off     = -1
     1147       j_off     = 0
     1148       i_off     = 0
     1149    ELSE
     1150       surf              => surf_lsm_v(l)
     1151
     1152       surf_t_surface    => t_surface_v(l)
     1153       surf_t_surface_p  => t_surface_v_p(l)
     1154       surf_tt_surface_m => tt_surface_v_m(l)
     1155       surf_m_liq_eb     => m_liq_eb_v(l)
     1156       surf_m_liq_eb_p   => m_liq_eb_v_p(l)
     1157       surf_tm_liq_eb_m  => tm_liq_eb_v_m(l)
     1158       surf_m_soil       => m_soil_v(l)
     1159       surf_t_soil       => t_soil_v(l)
     1160
     1161       k_off = 0
     1162       IF ( l == 0 )  THEN
     1163          j_off = -1
     1164          i_off = 0
     1165       ELSEIF ( l == 1 )  THEN
     1166          j_off = 1
     1167          i_off = 0
     1168       ELSEIF ( l == 2 )  THEN
     1169          j_off = 0
     1170          i_off = -1
     1171       ELSEIF ( l == 3 )  THEN
     1172          j_off = 0
     1173          i_off = 1
     1174       ENDIF
     1175    ENDIF
     1176
    10921177!
    10931178!-- Calculate the exner function for the current time step
    10941179    exn = ( surface_pressure / 1000.0_wp )**0.286_wp
    10951180
    1096     DO  i = nxlg, nxrg
    1097        DO  j = nysg, nyng
    1098           k = nzb_s_inner(j,i)
    1099 
    1100 !
    1101 !--       Set lambda_surface according to stratification between skin layer and soil
    1102           IF (  .NOT.  pave_surface(j,i) )  THEN
    1103 
    1104              c_surface_tmp = c_surface
    1105 
    1106              IF ( t_surface(j,i) >= t_soil(nzb_soil,j,i))  THEN
    1107                 lambda_surface = lambda_surface_s(j,i)
    1108              ELSE
    1109                 lambda_surface = lambda_surface_u(j,i)
    1110              ENDIF
     1181    DO  m = 1, surf%ns
     1182
     1183       i   = surf%i(m)           
     1184       j   = surf%j(m)
     1185       k   = surf%k(m)
     1186!
     1187!--    Determine height index for radiation. Note, in clear-sky case radiation
     1188!--    arrays have rank 0 in first dimensions, so index must be zero. In case
     1189!--    of RRTMG radiation arrays have non-zero rank in first dimension, so that
     1190!--    radiation can be obtained at respective height level
     1191       k_rad = MERGE( 0, k + k_off, radiation_scheme /= 'rrtmg' )
     1192!
     1193!--    Set lambda_surface according to stratification between skin layer and soil
     1194       IF (  .NOT.  surf%pave_surface(m) )  THEN
     1195
     1196          c_surface_tmp = c_surface
     1197
     1198          IF ( surf_t_surface%var_1d(m) >= surf_t_soil%var_2d(nzb_soil,m))  THEN
     1199             lambda_surface = surf%lambda_surface_s(m)
    11111200          ELSE
    1112 
    1113              c_surface_tmp = pave_heat_capacity * dz_soil(nzb_soil) * 0.5_wp
    1114              lambda_surface = pave_heat_conductivity * ddz_soil(nzb_soil)
    1115 
    1116           ENDIF
    1117 
    1118 !
    1119 !--       First step: calculate aerodyamic resistance. As pt, us, ts
    1120 !--       are not available for the prognostic time step, data from the last
    1121 !--       time step is used here. Note that this formulation is the
    1122 !--       equivalent to the ECMWF formulation using drag coefficients
    1123           IF ( cloud_physics )  THEN
    1124              pt1 = pt(k+1,j,i) + l_d_cp * pt_d_t(k+1) * ql(k+1,j,i)
    1125              qv1 = q(k+1,j,i) - ql(k+1,j,i)
    1126           ELSE
    1127              pt1 = pt(k+1,j,i)
    1128              qv1 = q(k+1,j,i)
    1129           ENDIF
    1130 
    1131           r_a(j,i) = (pt1 - pt(k,j,i)) / (ts(j,i) * us(j,i) + 1.0E-20_wp)
    1132 
    1133 !
    1134 !--       Make sure that the resistance does not drop to zero for neutral
    1135 !--       stratification
    1136           IF ( ABS(r_a(j,i)) < 1.0_wp )  r_a(j,i) = 1.0_wp
    1137 
    1138 !
    1139 !--       Second step: calculate canopy resistance r_canopy
    1140 !--       f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
     1201             lambda_surface = surf%lambda_surface_u(m)
     1202          ENDIF
     1203       ELSE
     1204
     1205          c_surface_tmp = pave_heat_capacity * dz_soil(nzb_soil) * 0.5_wp
     1206          lambda_surface = pave_heat_conductivity * ddz_soil(nzb_soil)
     1207
     1208       ENDIF
     1209
     1210!
     1211!--    First step: calculate aerodyamic resistance. As pt, us, ts
     1212!--    are not available for the prognostic time step, data from the last
     1213!--    time step is used here. Note that this formulation is the
     1214!--    equivalent to the ECMWF formulation using drag coefficients
     1215       IF ( cloud_physics )  THEN
     1216          pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
     1217          qv1 = q(k,j,i) - ql(k,j,i)
     1218       ELSE
     1219          pt1 = pt(k,j,i)
     1220          qv1 = q(k,j,i)
     1221       ENDIF
     1222!
     1223!--    Calculate aerodynamical resistance. For horizontal and vertical
     1224!--    surfaces MOST is applied. Moreover, for vertical surfaces, resistance
     1225!--    can be obtain via parameterization of Mason (2000) /
     1226!--    Krayenhoff and Voogt (2006).
     1227!--    To do: detailed investigation which approach is better!
     1228       IF ( horizontal  .OR.  .NOT. aero_resist_kray )  THEN
     1229          surf%r_a(m) = ( pt1 - surf_lsm_h%pt_surface(m) ) /                   &
     1230                        ( surf%ts(m) * surf%us(m) + 1.0E-20_wp )
     1231       ELSE
     1232          surf%r_a(m) = 1.0_wp / ( 11.8_wp + 4.2_wp *                          &
     1233                        SQRT( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 +      &
     1234                              ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 +      &
     1235                              ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2 )      &
     1236                                 )
     1237       ENDIF
     1238!
     1239!--    Make sure that the resistance does not drop to zero for neutral
     1240!--    stratification
     1241       IF ( ABS( surf%r_a(m) ) < 1.0_wp )  surf%r_a(m) = 1.0_wp
     1242!
     1243!--    Second step: calculate canopy resistance r_canopy
     1244!--    f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation
    11411245 
    1142 !--       f1: correction for incoming shortwave radiation (stomata close at
    1143 !--       night)
    1144           f1 = MIN( 1.0_wp, ( 0.004_wp * rad_sw_in(k,j,i) + 0.05_wp ) /        &
    1145                            (0.81_wp * (0.004_wp * rad_sw_in(k,j,i)             &
    1146                             + 1.0_wp)) )
    1147 
    1148 
    1149 
    1150 !
    1151 !--       f2: correction for soil moisture availability to plants (the
    1152 !--       integrated soil moisture must thus be considered here)
    1153 !--       f2 = 0 for very dry soils
    1154           m_total = 0.0_wp
    1155           DO  ks = nzb_soil, nzt_soil
    1156               m_total = m_total + root_fr(ks,j,i)                              &
    1157                         * MAX(m_soil(ks,j,i),m_wilt(j,i))
    1158           ENDDO
    1159 
    1160           IF ( m_total > m_wilt(j,i)  .AND.  m_total < m_fc(j,i) )  THEN
    1161              f2 = ( m_total - m_wilt(j,i) ) / (m_fc(j,i) - m_wilt(j,i) )
    1162           ELSEIF ( m_total >= m_fc(j,i) )  THEN
    1163              f2 = 1.0_wp
    1164           ELSE
    1165              f2 = 1.0E-20_wp
    1166           ENDIF
    1167 
    1168 !
    1169 !--       Calculate water vapour pressure at saturation
    1170           e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surface(j,i)        &
    1171                         - 273.16_wp ) / ( t_surface(j,i) - 35.86_wp ) )
    1172 
    1173 !
    1174 !--       f3: correction for vapour pressure deficit
    1175           IF ( g_d(j,i) /= 0.0_wp )  THEN
    1176 !
    1177 !--          Calculate vapour pressure
    1178              e  = qv1 * surface_pressure / 0.622_wp
    1179              f3 = EXP ( -g_d(j,i) * (e_s - e) )
    1180           ELSE
    1181              f3 = 1.0_wp
    1182           ENDIF
    1183 
    1184 !
    1185 !--       Calculate canopy resistance. In case that c_veg is 0 (bare soils),
    1186 !--       this calculation is obsolete, as r_canopy is not used below.
    1187 !--       To do: check for very dry soil -> r_canopy goes to infinity
    1188           r_canopy(j,i) = r_canopy_min(j,i) / (lai(j,i) * f1 * f2 * f3         &
    1189                                           + 1.0E-20_wp)
    1190 
    1191 !
    1192 !--       Third step: calculate bare soil resistance r_soil. The Clapp &
    1193 !--       Hornberger parametrization does not consider c_veg.
    1194           IF ( soil_type_2d(j,i) /= 7 )  THEN
    1195              m_min = c_veg(j,i) * m_wilt(j,i) + (1.0_wp - c_veg(j,i)) *        &
    1196                      m_res(j,i)
    1197           ELSE
    1198              m_min = m_wilt(j,i)
    1199           ENDIF
    1200 
    1201           f2 = ( m_soil(nzb_soil,j,i) - m_min ) / ( m_fc(j,i) - m_min )
    1202           f2 = MAX(f2,1.0E-20_wp)
    1203           f2 = MIN(f2,1.0_wp)
    1204 
    1205           r_soil(j,i) = r_soil_min(j,i) / f2
    1206 
    1207 !
    1208 !--       Calculate the maximum possible liquid water amount on plants and
    1209 !--       bare surface. For vegetated surfaces, a maximum depth of 0.2 mm is
    1210 !--       assumed, while paved surfaces might hold up 1 mm of water. The
    1211 !--       liquid water fraction for paved surfaces is calculated after
    1212 !--       Noilhan & Planton (1989), while the ECMWF formulation is used for
    1213 !--       vegetated surfaces and bare soils.
    1214           IF ( pave_surface(j,i) )  THEN
    1215              m_liq_eb_max = m_max_depth * 5.0_wp
    1216              c_liq(j,i) = MIN( 1.0_wp, (m_liq_eb(j,i) / m_liq_eb_max)**0.67 )
    1217           ELSE
    1218              m_liq_eb_max = m_max_depth * ( c_veg(j,i) * lai(j,i)              &
    1219                             + (1.0_wp - c_veg(j,i)) )
    1220              c_liq(j,i) = MIN( 1.0_wp, m_liq_eb(j,i) / m_liq_eb_max )
    1221           ENDIF
    1222 
    1223 !
    1224 !--       Calculate saturation specific humidity
    1225           q_s = 0.622_wp * e_s / surface_pressure
    1226 
    1227 !
    1228 !--       In case of dewfall, set evapotranspiration to zero
    1229 !--       All super-saturated water is then removed from the air
    1230           IF ( humidity  .AND.  q_s <= qv1 )  THEN
    1231              r_canopy(j,i) = 0.0_wp
    1232              r_soil(j,i)   = 0.0_wp
    1233           ENDIF
    1234 
    1235 !
    1236 !--       Calculate coefficients for the total evapotranspiration
    1237 !--       In case of water surface, set vegetation and soil fluxes to zero.
    1238 !--       For pavements, only evaporation of liquid water is possible.
    1239           IF ( water_surface(j,i) )  THEN
    1240              f_qsws_veg  = 0.0_wp
    1241              f_qsws_soil = 0.0_wp
    1242              f_qsws_liq  = rho_lv / r_a(j,i)
    1243           ELSEIF ( pave_surface (j,i) )  THEN
    1244              f_qsws_veg  = 0.0_wp
    1245              f_qsws_soil = 0.0_wp
    1246              f_qsws_liq  = rho_lv * c_liq(j,i) / r_a(j,i)
    1247           ELSE
    1248              f_qsws_veg  = rho_lv * c_veg(j,i) * (1.0_wp - c_liq(j,i))/        &
    1249                            (r_a(j,i) + r_canopy(j,i))
    1250              f_qsws_soil = rho_lv * (1.0_wp - c_veg(j,i)) / (r_a(j,i) +        &
    1251                                                              r_soil(j,i))
    1252              f_qsws_liq  = rho_lv * c_veg(j,i) * c_liq(j,i) / r_a(j,i)
    1253           ENDIF
     1246!--    f1: correction for incoming shortwave radiation (stomata close at
     1247!--    night)
     1248       f1 = MIN( 1.0_wp, ( 0.004_wp * rad_sw_in(k_rad,j+j_off,i+i_off) + 0.05_wp ) /&
     1249                        (0.81_wp * (0.004_wp * rad_sw_in(k_rad,j+j_off,i+i_off)&
     1250                         + 1.0_wp)) )
     1251!
     1252!--    f2: correction for soil moisture availability to plants (the
     1253!--    integrated soil moisture must thus be considered here)
     1254!--    f2 = 0 for very dry soils
     1255       m_total = 0.0_wp
     1256       DO  ks = nzb_soil, nzt_soil
     1257           m_total = m_total + surf%root_fr(ks,m)                              &
     1258                     * MAX( surf_m_soil%var_2d(ks,m), surf%m_wilt(m) )
     1259       ENDDO
     1260
     1261       IF ( m_total > surf%m_wilt(m)  .AND.                                    &
     1262            m_total < surf%m_fc(m) )  THEN
     1263          f2 = ( m_total - surf%m_wilt(m) ) /                                  &
     1264               ( surf%m_fc(m) - surf%m_wilt(m) )
     1265       ELSEIF ( m_total >= surf%m_fc(m) )  THEN
     1266          f2 = 1.0_wp
     1267       ELSE
     1268          f2 = 1.0E-20_wp
     1269       ENDIF
     1270!
     1271!--    Calculate water vapour pressure at saturation
     1272       e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( surf_t_surface%var_1d(m) &
     1273                     - 273.16_wp ) / ( surf_t_surface%var_1d(m) - 35.86_wp ) )
     1274!
     1275!--    f3: correction for vapour pressure deficit
     1276       IF ( surf%g_d(m) /= 0.0_wp )  THEN
     1277!
     1278!--       Calculate vapour pressure
     1279          e  = qv1 * surface_pressure / 0.622_wp
     1280          f3 = EXP ( - surf%g_d(m) * (e_s - e) )
     1281       ELSE
     1282          f3 = 1.0_wp
     1283       ENDIF
     1284!
     1285!--    Calculate canopy resistance. In case that c_veg is 0 (bare soils),
     1286!--    this calculation is obsolete, as r_canopy is not used below.
     1287!--    To do: check for very dry soil -> r_canopy goes to infinity
     1288       surf%r_canopy(m) = surf%r_canopy_min(m) /                               &
     1289                              ( surf%lai(m) * f1 * f2 * f3 + 1.0E-20_wp )
     1290!
     1291!--    Third step: calculate bare soil resistance r_soil. The Clapp &
     1292!--    Hornberger parametrization does not consider c_veg.
     1293       IF ( surf%soil_type_2d(m) /= 7 )  THEN
     1294          m_min = surf%c_veg(m) * surf%m_wilt(m) +                             &
     1295                         ( 1.0_wp - surf%c_veg(m) ) * surf%m_res(m)
     1296       ELSE
     1297          m_min = surf%m_wilt(m)
     1298       ENDIF
     1299
     1300       f2 = ( surf_m_soil%var_2d(nzb_soil,m) - m_min ) / ( surf%m_fc(m) - m_min )
     1301       f2 = MAX( f2, 1.0E-20_wp )
     1302       f2 = MIN( f2, 1.0_wp     )
     1303
     1304       surf%r_soil(m) = surf%r_soil_min(m) / f2
     1305
     1306!
     1307!--    Calculate the maximum possible liquid water amount on plants and
     1308!--    bare surface. For vegetated surfaces, a maximum depth of 0.2 mm is
     1309!--    assumed, while paved surfaces might hold up 1 mm of water. The
     1310!--    liquid water fraction for paved surfaces is calculated after
     1311!--    Noilhan & Planton (1989), while the ECMWF formulation is used for
     1312!--    vegetated surfaces and bare soils.
     1313       IF ( surf%pave_surface(m) )  THEN
     1314          m_liq_eb_max = m_max_depth * 5.0_wp
     1315          surf%c_liq(m) = MIN( 1.0_wp, ( surf_m_liq_eb%var_1d(m) / m_liq_eb_max)**0.67 )
     1316       ELSE
     1317          m_liq_eb_max = m_max_depth * ( surf%c_veg(m) * surf%lai(m)&
     1318                            + ( 1.0_wp - surf%c_veg(m) ) )
     1319          surf%c_liq(m) = MIN( 1.0_wp, surf_m_liq_eb%var_1d(m) / m_liq_eb_max )
     1320       ENDIF
     1321!
     1322!--    Calculate saturation specific humidity
     1323       q_s = 0.622_wp * e_s / surface_pressure
     1324!
     1325!--    In case of dewfall, set evapotranspiration to zero
     1326!--    All super-saturated water is then removed from the air
     1327       IF ( humidity  .AND.  q_s <= qv1 )  THEN
     1328          surf%r_canopy(m) = 0.0_wp
     1329          surf%r_soil(m)   = 0.0_wp
     1330       ENDIF
     1331
     1332!
     1333!--    Calculate coefficients for the total evapotranspiration
     1334!--    In case of water surface, set vegetation and soil fluxes to zero.
     1335!--    For pavements, only evaporation of liquid water is possible.
     1336       IF ( surf%water_surface(m) )  THEN
     1337          f_qsws_veg  = 0.0_wp
     1338          f_qsws_soil = 0.0_wp
     1339          f_qsws_liq  = rho_lv / surf%r_a(m)
     1340       ELSEIF ( surf%pave_surface (m) )  THEN
     1341          f_qsws_veg  = 0.0_wp
     1342          f_qsws_soil = 0.0_wp
     1343          f_qsws_liq  = rho_lv * surf%c_liq(m) / surf%r_a(m)
     1344       ELSE
     1345          f_qsws_veg  = rho_lv * surf%c_veg(m) *                               &
     1346                            ( 1.0_wp        - surf%c_liq(m)    ) /             &
     1347                            ( surf%r_a(m) + surf%r_canopy(m) )
     1348          f_qsws_soil = rho_lv * (1.0_wp    - surf%c_veg(m)    ) /             &
     1349                            ( surf%r_a(m) + surf%r_soil(m)   )
     1350          f_qsws_liq  = rho_lv * surf%c_veg(m) * surf%c_liq(m)   /             &
     1351                              surf%r_a(m)
     1352       ENDIF
    12541353!
    12551354!--       If soil moisture is below wilting point, plants do no longer
    … …  
    12591358!           ENDIF
    12601359
    1261           f_shf  = rho_cp / r_a(j,i)
    1262           f_qsws = f_qsws_veg + f_qsws_soil + f_qsws_liq
    1263 
    1264 !
    1265 !--       Calculate derivative of q_s for Taylor series expansion
    1266           e_s_dt = e_s * ( 17.269_wp / (t_surface(j,i) - 35.86_wp) -           &
    1267                            17.269_wp*(t_surface(j,i) - 273.16_wp)              &
    1268                            / (t_surface(j,i) - 35.86_wp)**2 )
    1269 
    1270           dq_s_dt = 0.622_wp * e_s_dt / surface_pressure
    1271 
    1272 !
    1273 !--       Add LW up so that it can be removed in prognostic equation
    1274           rad_net_l(j,i) = rad_net(j,i) + rad_lw_out(nzb,j,i)
    1275 
    1276 !
    1277 !--       Calculate new skin temperature
    1278           IF ( humidity )  THEN
    1279 
    1280 !
    1281 !--          Numerator of the prognostic equation
    1282              coef_1 = rad_net_l(j,i) + rad_lw_out_change_0(j,i)                &
    1283                       * t_surface(j,i) - rad_lw_out(nzb,j,i)                   &
    1284                       + f_shf * pt1 + f_qsws * ( qv1 - q_s                     &
    1285                       + dq_s_dt * t_surface(j,i) ) + lambda_surface            &
    1286                       * t_soil(nzb_soil,j,i)
    1287 
    1288 !
    1289 !--          Denominator of the prognostic equation
    1290              coef_2 = rad_lw_out_change_0(j,i) + f_qsws * dq_s_dt              &
    1291                       + lambda_surface + f_shf / exn
    1292           ELSE
    1293 
    1294 !
    1295 !--          Numerator of the prognostic equation
    1296              coef_1 = rad_net_l(j,i) + rad_lw_out_change_0(j,i)                &
    1297                       * t_surface(j,i) - rad_lw_out(nzb,j,i)                   &
    1298                       + f_shf * pt1  + lambda_surface                          &
    1299                       * t_soil(nzb_soil,j,i)
    1300 
    1301 !
    1302 !--          Denominator of the prognostic equation
    1303              coef_2 = rad_lw_out_change_0(j,i) + lambda_surface + f_shf / exn
    1304 
    1305           ENDIF
    1306 
    1307           tend = 0.0_wp
    1308 
    1309 !
    1310 !--       Implicit solution when the surface layer has no heat capacity,
    1311 !--       otherwise use RK3 scheme.
    1312           t_surface_p(j,i) = ( coef_1 * dt_3d * tsc(2) + c_surface_tmp *       &
    1313                              t_surface(j,i) ) / ( c_surface_tmp + coef_2       &
    1314                                 * dt_3d * tsc(2) )
    1315 
    1316 !
    1317 !--       Add RK3 term
    1318           IF ( c_surface_tmp /= 0.0_wp )  THEN
    1319 
    1320              t_surface_p(j,i) = t_surface_p(j,i) + dt_3d * tsc(3)              &
    1321                                 * tt_surface_m(j,i)
    1322 
    1323 !
    1324 !--          Calculate true tendency
    1325              tend = (t_surface_p(j,i) - t_surface(j,i) - dt_3d * tsc(3)        &
    1326                     * tt_surface_m(j,i)) / (dt_3d  * tsc(2))
    1327 !
    1328 !--          Calculate t_surface tendencies for the next Runge-Kutta step
    1329              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1330                 IF ( intermediate_timestep_count == 1 )  THEN
    1331                    tt_surface_m(j,i) = tend
    1332                 ELSEIF ( intermediate_timestep_count <                         &
    1333                          intermediate_timestep_count_max )  THEN
    1334                    tt_surface_m(j,i) = -9.5625_wp * tend + 5.3125_wp           &
    1335                                        * tt_surface_m(j,i)
    1336                 ENDIF
     1360       f_shf  = rho_cp / surf%r_a(m)
     1361       f_qsws = f_qsws_veg + f_qsws_soil + f_qsws_liq
     1362!
     1363!--    Calculate derivative of q_s for Taylor series expansion
     1364       e_s_dt = e_s * ( 17.269_wp / ( surf_t_surface%var_1d(m) - 35.86_wp) -   &
     1365                        17.269_wp*( surf_t_surface%var_1d(m) - 273.16_wp)      &
     1366                       / ( surf_t_surface%var_1d(m) - 35.86_wp)**2 )
     1367
     1368       dq_s_dt = 0.622_wp * e_s_dt / surface_pressure
     1369!
     1370!--    Add LW up so that it can be removed in prognostic equation
     1371       surf%rad_net_l(m) = rad_net(j,i) + rad_lw_out(nzb,j,i)
     1372!
     1373!--    Calculate new skin temperature
     1374       IF ( humidity )  THEN
     1375!
     1376!--       Numerator of the prognostic equation
     1377          coef_1 = surf%rad_net_l(m) + rad_lw_out_change_0(j,i)                &
     1378                   * surf_t_surface%var_1d(m) - rad_lw_out(nzb,j,i)            &
     1379                   + f_shf * pt1 + f_qsws * ( qv1 - q_s                        &
     1380                   + dq_s_dt * surf_t_surface%var_1d(m) ) + lambda_surface     &
     1381                   * surf_t_soil%var_2d(nzb_soil,m)
     1382!
     1383!--       Denominator of the prognostic equation
     1384          coef_2 = rad_lw_out_change_0(j,i) + f_qsws * dq_s_dt                 &
     1385                   + lambda_surface + f_shf / exn
     1386       ELSE
     1387!
     1388!--       Numerator of the prognostic equation
     1389          coef_1 = surf%rad_net_l(m) + rad_lw_out_change_0(j,i)                &
     1390                   * surf_t_surface%var_1d(m) - rad_lw_out(nzb,j,i)            &
     1391                   + f_shf * pt1  + lambda_surface                             &
     1392                   * surf_t_soil%var_2d(nzb_soil,m)
     1393!
     1394!--       Denominator of the prognostic equation
     1395          coef_2 = rad_lw_out_change_0(j,i) + lambda_surface + f_shf / exn
     1396
     1397       ENDIF
     1398
     1399       tend = 0.0_wp
     1400
     1401!
     1402!--    Implicit solution when the surface layer has no heat capacity,
     1403!--    otherwise use RK3 scheme.
     1404       surf_t_surface_p%var_1d(m) = ( coef_1 * dt_3d * tsc(2) + c_surface_tmp *&
     1405                          surf_t_surface%var_1d(m) ) / ( c_surface_tmp + coef_2&
     1406                                             * dt_3d * tsc(2) )
     1407
     1408!
     1409!--    Add RK3 term
     1410       IF ( c_surface_tmp /= 0.0_wp )  THEN
     1411
     1412          surf_t_surface_p%var_1d(m) = surf_t_surface_p%var_1d(m) + dt_3d *    &
     1413                                       tsc(3) * surf_tt_surface_m%var_1d(m)
     1414
     1415!
     1416!--       Calculate true tendency
     1417          tend = ( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) -     &
     1418                   dt_3d * tsc(3) * surf_tt_surface_m%var_1d(m)) / (dt_3d  * tsc(2))
     1419!
     1420!--       Calculate t_surface tendencies for the next Runge-Kutta step
     1421          IF ( timestep_scheme(1:5) == 'runge' )  THEN
     1422             IF ( intermediate_timestep_count == 1 )  THEN
     1423                surf_tt_surface_m%var_1d(m) = tend
     1424             ELSEIF ( intermediate_timestep_count <                            &
     1425                      intermediate_timestep_count_max )  THEN
     1426                surf_tt_surface_m%var_1d(m) = -9.5625_wp * tend +              &
     1427                                               5.3125_wp * surf_tt_surface_m%var_1d(m)
    13371428             ENDIF
    13381429          ENDIF
    1339 
    1340 !
    1341 !--       In case of fast changes in the skin temperature, it is possible to
    1342 !--       update the radiative fluxes independently from the prescribed
    1343 !--       radiation call frequency. This effectively prevents oscillations,
    1344 !--       especially when setting skip_time_do_radiation /= 0. The threshold
    1345 !--       value of 0.2 used here is just a first guess. This method should be
    1346 !--       revised in the future as tests have shown that the threshold is
    1347 !--       often reached, when no oscillations would occur (causes immense
    1348 !--       computing time for the radiation code).
    1349           IF ( ABS( t_surface_p(j,i) - t_surface(j,i) ) > 0.2_wp  .AND.        &
    1350                unscheduled_radiation_calls )  THEN
    1351              force_radiation_call_l = .TRUE.
    1352           ENDIF
    1353 
    1354           pt(k,j,i) = t_surface_p(j,i) / exn
    1355 
    1356 !
    1357 !--       Calculate fluxes
    1358           rad_net_l(j,i)   = rad_net_l(j,i) + rad_lw_out_change_0(j,i)         &
    1359                              * t_surface(j,i) - rad_lw_out(nzb,j,i)            &
    1360                              - rad_lw_out_change_0(j,i) * t_surface_p(j,i)
    1361 
    1362           rad_net(j,i) = rad_net_l(j,i)
    1363           rad_lw_out(nzb,j,i) = rad_lw_out(nzb,j,i) + rad_lw_out_change_0(j,i) &
    1364                                 * ( t_surface_p(j,i) - t_surface(j,i) )
    1365 
    1366           ghf_eb(j,i)    = lambda_surface * (t_surface_p(j,i)                  &
    1367                            - t_soil(nzb_soil,j,i))
    1368 
    1369           shf_eb(j,i)    = - f_shf * ( pt1 - pt(k,j,i) )
    1370 
    1371           shf(j,i) = shf_eb(j,i) / rho_cp
    1372 
    1373           IF ( humidity )  THEN
    1374              qsws_eb(j,i)  = - f_qsws    * ( qv1 - q_s + dq_s_dt               &
    1375                              * t_surface(j,i) - dq_s_dt * t_surface_p(j,i) )
    1376 
    1377              qsws(j,i) = qsws_eb(j,i) / rho_lv
    1378 
    1379              qsws_veg_eb(j,i)  = - f_qsws_veg  * ( qv1 - q_s                   &
    1380                                  + dq_s_dt * t_surface(j,i) - dq_s_dt          &
    1381                                  * t_surface_p(j,i) )
    1382 
    1383              qsws_soil_eb(j,i) = - f_qsws_soil * ( qv1 - q_s                   &
    1384                                  + dq_s_dt * t_surface(j,i) - dq_s_dt          &
    1385                                  * t_surface_p(j,i) )
    1386 
    1387              qsws_liq_eb(j,i)  = - f_qsws_liq * ( qv1 - q_s                   &
    1388                                  + dq_s_dt * t_surface(j,i) - dq_s_dt          &
    1389                                  * t_surface_p(j,i) )
    1390           ENDIF
    1391 
    1392 !
    1393 !--       Calculate the true surface resistance
    1394           IF ( qsws_eb(j,i) == 0.0_wp )  THEN
    1395              r_s(j,i) = 1.0E10_wp
    1396           ELSE
    1397              r_s(j,i) = - rho_lv * ( qv1 - q_s + dq_s_dt                       &
    1398                         * t_surface(j,i) - dq_s_dt * t_surface_p(j,i) )        &
    1399                         / qsws_eb(j,i) - r_a(j,i)
    1400           ENDIF
    1401 
    1402 !
    1403 !--       Calculate change in liquid water reservoir due to dew fall or
    1404 !--       evaporation of liquid water
    1405           IF ( humidity )  THEN
    1406 !
    1407 !--          If precipitation is activated, add rain water to qsws_liq_eb
    1408 !--          and qsws_soil_eb according the the vegetation coverage.
    1409 !--          precipitation_rate is given in mm.
    1410              IF ( precipitation )  THEN
    1411 
    1412 !
    1413 !--             Add precipitation to liquid water reservoir, if possible.
    1414 !--             Otherwise, add the water to soil. In case of
    1415 !--             pavements, the exceeding water amount is implicitely removed
    1416 !--             as runoff as qsws_soil_eb is then not used in the soil model
    1417                 IF ( m_liq_eb(j,i) /= m_liq_eb_max )  THEN
    1418                    qsws_liq_eb(j,i) = qsws_liq_eb(j,i)                         &
    1419                                     + c_veg(j,i) * prr(k,j,i) * hyrho(k)       &
    1420                                     * 0.001_wp * rho_l * l_v
    1421                 ELSE
    1422                    qsws_soil_eb(j,i) = qsws_soil_eb(j,i)                       &
    1423                                      + c_veg(j,i) * prr(k,j,i) * hyrho(k)      &
    1424                                      * 0.001_wp * rho_l * l_v
    1425                 ENDIF
    1426 
    1427 !--             Add precipitation to bare soil according to the bare soil
    1428 !--             coverage.
    1429                 qsws_soil_eb(j,i) = qsws_soil_eb(j,i) + (1.0_wp                &
    1430                                     - c_veg(j,i)) * prr(k,j,i) * hyrho(k)      &
    1431                                     * 0.001_wp * rho_l * l_v
     1430       ENDIF
     1431
     1432!
     1433!--    In case of fast changes in the skin temperature, it is possible to
     1434!--    update the radiative fluxes independently from the prescribed
     1435!--    radiation call frequency. This effectively prevents oscillations,
     1436!--    especially when setting skip_time_do_radiation /= 0. The threshold
     1437!--    value of 0.2 used here is just a first guess. This method should be
     1438!--    revised in the future as tests have shown that the threshold is
     1439!--    often reached, when no oscillations would occur (causes immense
     1440!--    computing time for the radiation code).
     1441       IF ( ABS( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) ) > 0.2_wp  .AND. &
     1442            unscheduled_radiation_calls )  THEN
     1443          force_radiation_call_l = .TRUE.
     1444       ENDIF
     1445
     1446       pt(k+k_off,j+j_off,i+i_off) = surf_t_surface_p%var_1d(m) / exn  !is actually no air temperature
     1447       surf%pt_surface(m)          = surf_t_surface_p%var_1d(m) / exn
     1448
     1449!
     1450!--    Calculate fluxes
     1451       surf%rad_net_l(m) = surf%rad_net_l(m) +                                 &
     1452                            rad_lw_out_change_0(j,i)                           &
     1453                          * surf_t_surface%var_1d(m) - rad_lw_out(nzb,j,i)     &
     1454                          - rad_lw_out_change_0(j,i) * surf_t_surface_p%var_1d(m)
     1455
     1456       rad_net(j,i) = surf%rad_net_l(m)
     1457       rad_lw_out(nzb,j,i) = rad_lw_out(nzb,j,i) + rad_lw_out_change_0(j,i) *  &
     1458                     ( surf_t_surface_p%var_1d(m) - surf_t_surface%var_1d(m) )
     1459
     1460       surf%ghf_eb(m) = lambda_surface * ( surf_t_surface_p%var_1d(m)          &
     1461                                             - surf_t_soil%var_2d(nzb_soil,m) )
     1462
     1463       surf%shf_eb(m) = - f_shf * ( pt1 - surf%pt_surface(m) )
     1464
     1465       surf%shf(m) = surf%shf_eb(m) / rho_cp
     1466
     1467       IF ( humidity )  THEN
     1468          surf%qsws_eb(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt                  &
     1469                          * surf_t_surface%var_1d(m) - dq_s_dt *               &
     1470                            surf_t_surface_p%var_1d(m) )
     1471
     1472          surf%qsws(m) = surf%qsws_eb(m) / rho_lv
     1473
     1474          surf%qsws_veg_eb(m)  = - f_qsws_veg * ( qv1 - q_s                   &
     1475                              + dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt   &
     1476                              * surf_t_surface_p%var_1d(m) )
     1477
     1478          surf%qsws_soil_eb(m) = - f_qsws_soil * ( qv1 - q_s                   &
     1479                              + dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt   &
     1480                              * surf_t_surface_p%var_1d(m) )
     1481
     1482          surf%qsws_liq_eb(m)  = - f_qsws_liq  * ( qv1 - q_s                   &
     1483                              + dq_s_dt * surf_t_surface%var_1d(m) - dq_s_dt   &
     1484                              * surf_t_surface_p%var_1d(m) )
     1485       ENDIF
     1486
     1487!
     1488!--    Calculate the true surface resistance
     1489       IF ( surf%qsws_eb(m) == 0.0_wp )  THEN
     1490          surf%r_s(m) = 1.0E10_wp
     1491       ELSE
     1492          surf%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt                       &
     1493                          * surf_t_surface%var_1d(m) - dq_s_dt *               &
     1494                            surf_t_surface_p%var_1d(m) ) /                     &
     1495                            surf%qsws_eb(m) - surf%r_a(m)
     1496       ENDIF
     1497
     1498!
     1499!--    Calculate change in liquid water reservoir due to dew fall or
     1500!--    evaporation of liquid water
     1501       IF ( humidity )  THEN
     1502!
     1503!--       If precipitation is activated, add rain water to qsws_liq_eb
     1504!--       and qsws_soil_eb according the the vegetation coverage.
     1505!--       precipitation_rate is given in mm.
     1506          IF ( precipitation )  THEN
     1507
     1508!
     1509!--          Add precipitation to liquid water reservoir, if possible.
     1510!--          Otherwise, add the water to soil. In case of
     1511!--          pavements, the exceeding water amount is implicitely removed
     1512!--          as runoff as qsws_soil_eb is then not used in the soil model
     1513             IF ( surf_m_liq_eb%var_1d(m) /= m_liq_eb_max )  THEN
     1514                surf%qsws_liq_eb(m) = surf%qsws_liq_eb(m)                      &
     1515                                 + surf%c_veg(m) * prr(k+k_off,j+j_off,i+i_off)&
     1516                                 * hyrho(k+k_off)                              &
     1517                                 * 0.001_wp * rho_l * l_v
     1518             ELSE
     1519                surf%qsws_soil_eb(m) = surf%qsws_soil_eb(m)                    &
     1520                                 + surf%c_veg(m) * prr(k+k_off,j+j_off,i+i_off)&
     1521                                 * hyrho(k+k_off)                              &
     1522                                 * 0.001_wp * rho_l * l_v
    14321523             ENDIF
    14331524
    1434 !
    1435 !--          If the air is saturated, check the reservoir water level
    1436              IF ( qsws_eb(j,i) < 0.0_wp )  THEN
    1437 
    1438 !
    1439 !--             Check if reservoir is full (avoid values > m_liq_eb_max)
    1440 !--             In that case, qsws_liq_eb goes to qsws_soil_eb. In this
    1441 !--             case qsws_veg_eb is zero anyway (because c_liq = 1),       
    1442 !--             so that tend is zero and no further check is needed
    1443                 IF ( m_liq_eb(j,i) == m_liq_eb_max )  THEN
    1444                    qsws_soil_eb(j,i) = qsws_soil_eb(j,i)                       &
    1445                                         + qsws_liq_eb(j,i)
    1446 
    1447                    qsws_liq_eb(j,i)  = 0.0_wp
    1448                 ENDIF
    1449 
    1450 !
    1451 !--             In case qsws_veg_eb becomes negative (unphysical behavior),
    1452 !--             let the water enter the liquid water reservoir as dew on the
    1453 !--             plant
    1454                 IF ( qsws_veg_eb(j,i) < 0.0_wp )  THEN
    1455                    qsws_liq_eb(j,i) = qsws_liq_eb(j,i) + qsws_veg_eb(j,i)
    1456                    qsws_veg_eb(j,i) = 0.0_wp
    1457                 ENDIF
    1458              ENDIF                   
    1459  
    1460              tend = - qsws_liq_eb(j,i) * drho_l_lv
    1461              m_liq_eb_p(j,i) = m_liq_eb(j,i) + dt_3d * ( tsc(2) * tend         &
    1462                                                 + tsc(3) * tm_liq_eb_m(j,i) )
    1463 
    1464 !
    1465 !--          Check if reservoir is overfull -> reduce to maximum
    1466 !--          (conservation of water is violated here)
    1467              m_liq_eb_p(j,i) = MIN(m_liq_eb_p(j,i),m_liq_eb_max)
    1468 
    1469 !
    1470 !--          Check if reservoir is empty (avoid values < 0.0)
    1471 !--          (conservation of water is violated here)
    1472              m_liq_eb_p(j,i) = MAX(m_liq_eb_p(j,i),0.0_wp)
    1473 
    1474 
    1475 !
    1476 !--          Calculate m_liq_eb tendencies for the next Runge-Kutta step
    1477              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1478                 IF ( intermediate_timestep_count == 1 )  THEN
    1479                    tm_liq_eb_m(j,i) = tend
    1480                 ELSEIF ( intermediate_timestep_count <                         &
    1481                          intermediate_timestep_count_max )  THEN
    1482                    tm_liq_eb_m(j,i) = -9.5625_wp * tend + 5.3125_wp            &
    1483                                     * tm_liq_eb_m(j,i)
    1484                 ENDIF
     1525!--          Add precipitation to bare soil according to the bare soil
     1526!--          coverage.
     1527             surf%qsws_soil_eb(m) = surf%qsws_soil_eb(m) + ( 1.0_wp            &
     1528                               - surf%c_veg(m) ) * prr(k+k_off,j+j_off,i+i_off)&
     1529                               * hyrho(k+k_off)                                &
     1530                               * 0.001_wp * rho_l * l_v
     1531          ENDIF
     1532
     1533!
     1534!--       If the air is saturated, check the reservoir water level
     1535          IF ( surf%qsws_eb(m) < 0.0_wp )  THEN
     1536!
     1537!--          Check if reservoir is full (avoid values > m_liq_eb_max)
     1538!--          In that case, qsws_liq_eb goes to qsws_soil_eb. In this
     1539!--          case qsws_veg_eb is zero anyway (because c_liq = 1),       
     1540!--          so that tend is zero and no further check is needed
     1541             IF ( surf_m_liq_eb%var_1d(m) == m_liq_eb_max )  THEN
     1542                surf%qsws_soil_eb(m) = surf%qsws_soil_eb(m) + surf%qsws_liq_eb(m)
     1543
     1544                surf%qsws_liq_eb(m)  = 0.0_wp
    14851545             ENDIF
    14861546
    1487           ENDIF
    1488 
    1489        ENDDO
     1547!
     1548!--          In case qsws_veg_eb becomes negative (unphysical behavior),
     1549!--          let the water enter the liquid water reservoir as dew on the
     1550!--          plant
     1551             IF ( surf%qsws_veg_eb(m) < 0.0_wp )  THEN
     1552                surf%qsws_liq_eb(m) = surf%qsws_liq_eb(m) + surf%qsws_veg_eb(m)
     1553                surf%qsws_veg_eb(m) = 0.0_wp
     1554             ENDIF
     1555          ENDIF                   
     1556 
     1557          tend = - surf%qsws_liq_eb(m) * drho_l_lv
     1558          surf_m_liq_eb_p%var_1d(m) = surf_m_liq_eb%var_1d(m) + dt_3d *        &
     1559                                        ( tsc(2) * tend +                      &
     1560                                          tsc(3) * surf_tm_liq_eb_m%var_1d(m) )
     1561!
     1562!--       Check if reservoir is overfull -> reduce to maximum
     1563!--       (conservation of water is violated here)
     1564          surf_m_liq_eb_p%var_1d(m) = MIN( surf_m_liq_eb_p%var_1d(m),m_liq_eb_max )
     1565
     1566!
     1567!--       Check if reservoir is empty (avoid values < 0.0)
     1568!--       (conservation of water is violated here)
     1569          surf_m_liq_eb_p%var_1d(m) = MAX( surf_m_liq_eb_p%var_1d(m), 0.0_wp )
     1570!
     1571!--       Calculate m_liq_eb tendencies for the next Runge-Kutta step
     1572          IF ( timestep_scheme(1:5) == 'runge' )  THEN
     1573             IF ( intermediate_timestep_count == 1 )  THEN
     1574                surf_tm_liq_eb_m%var_1d(m) = tend
     1575             ELSEIF ( intermediate_timestep_count <                            &
     1576                      intermediate_timestep_count_max )  THEN
     1577                surf_tm_liq_eb_m%var_1d(m) = -9.5625_wp * tend +               &
     1578                                              5.3125_wp * surf_tm_liq_eb_m%var_1d(m)
     1579             ENDIF
     1580          ENDIF
     1581
     1582       ENDIF
     1583
    14901584    ENDDO
    14911585
    … …  
    14971591#if defined( __parallel )
    14981592       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    1499        CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call,    &
     1593       CALL MPI_ALLREDUCE( force_radiation_call_l, force_radiation_call,       &
    15001594                           1, MPI_LOGICAL, MPI_LOR, comm2d, ierr )
    15011595#else
    … …  
    15131607!
    15141608!-- Calculate new roughness lengths (for water surfaces only)
    1515     CALL calc_z0_water_surface
     1609    IF ( horizontal )  CALL calc_z0_water_surface
     1610
     1611    CONTAINS
     1612!------------------------------------------------------------------------------!
     1613! Description:
     1614! ------------
     1615!> Calculation of specific humidity of the skin layer (surface). It is assumend
     1616!> that the skin is always saturated.
     1617!------------------------------------------------------------------------------!
     1618    SUBROUTINE calc_q_surface
     1619
     1620       IMPLICIT NONE
     1621
     1622       REAL(wp) :: resistance    !< aerodynamic and soil resistance term
     1623
     1624       DO  m = 1, surf%ns
     1625
     1626          i   = surf%i(m)           
     1627          j   = surf%j(m)
     1628          k   = surf%k(m)
     1629
     1630!
     1631!--       Calculate water vapour pressure at saturation
     1632          e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp *                         &
     1633                                 ( surf_t_surface_p%var_1d(m) - 273.16_wp ) /  &
     1634                                 ( surf_t_surface_p%var_1d(m) - 35.86_wp  )    &
     1635                                         )
     1636
     1637!
     1638!--       Calculate specific humidity at saturation
     1639          q_s = 0.622_wp * e_s / surface_pressure
     1640
     1641          resistance = surf%r_a(m) / ( surf%r_a(m) + surf%r_s(m) )
     1642
     1643!
     1644!--       Calculate specific humidity at surface
     1645          IF ( cloud_physics )  THEN
     1646             q(k+k_off,j+j_off,i+i_off) = resistance * q_s +                   &
     1647                                        ( 1.0_wp - resistance ) *              &
     1648                                        ( q(k,j,i) - ql(k,j,i) )
     1649          ELSE
     1650             q(k+k_off,j+j_off,i+i_off) = resistance * q_s +                   &
     1651                                        ( 1.0_wp - resistance ) *              &
     1652                                          q(k,j,i)
     1653          ENDIF
     1654
     1655!
     1656!--       Update virtual potential temperature
     1657          vpt(k+k_off,j+j_off,i+i_off) = pt(k+k_off,j+j_off,i+i_off) *         &
     1658                     ( 1.0_wp + 0.61_wp * q(k+k_off,j+j_off,i+i_off) )
     1659
     1660       ENDDO
     1661
     1662    END SUBROUTINE calc_q_surface
     1663
    15161664
    15171665
    … …  
    16071755       IMPLICIT NONE
    16081756
    1609        INTEGER(iwp) ::  i !< running index
    1610        INTEGER(iwp) ::  j !< running index
    1611        INTEGER(iwp) ::  k !< running index
     1757       INTEGER(iwp) ::  i     !< running index
     1758       INTEGER(iwp) ::  i_off !< index offset of surface element, seen from atmospheric grid point
     1759       INTEGER(iwp) ::  j     !< running index
     1760       INTEGER(iwp) ::  j_off !< index offset of surface element, seen from atmospheric grid point
     1761       INTEGER(iwp) ::  k     !< running index
     1762       INTEGER(iwp) ::  l     !< running index surface facing
     1763       INTEGER(iwp) ::  m     !< running index
    16121764
    16131765       REAL(wp) :: pt1   !< potential temperature at first grid level
    1614 
    16151766
    16161767!
    16171768!--    Calculate Exner function
    16181769       exn = ( surface_pressure / 1000.0_wp )**0.286_wp
    1619 
    1620 
    16211770!
    16221771!--    If no cloud physics is used, rho_surface has not been calculated before
    … …  
    16341783!
    16351784!--    Set inital values for prognostic quantities
    1636        tt_surface_m = 0.0_wp
    1637        tt_soil_m    = 0.0_wp
    1638        tm_soil_m    = 0.0_wp
    1639        tm_liq_eb_m  = 0.0_wp
    1640        c_liq        = 0.0_wp
    1641 
    1642        ghf_eb = 0.0_wp
    1643        shf_eb = rho_cp * shf
     1785!--    Horizontal surfaces
     1786       tt_surface_h_m%var_1d = 0.0_wp
     1787       tt_soil_h_m%var_2d    = 0.0_wp
     1788       tm_soil_h_m%var_2d    = 0.0_wp
     1789       tm_liq_eb_h_m%var_1d  = 0.0_wp
     1790       surf_lsm_h%c_liq = 0.0_wp
     1791
     1792       surf_lsm_h%ghf_eb = 0.0_wp
     1793       surf_lsm_h%shf_eb = rho_cp * surf_lsm_h%shf
    16441794
    16451795       IF ( humidity )  THEN
    1646           qsws_eb = rho_lv * qsws
     1796          surf_lsm_h%qsws_eb = rho_lv * surf_lsm_h%qsws
    16471797       ELSE
    1648           qsws_eb = 0.0_wp
    1649        ENDIF
    1650 
    1651        qsws_liq_eb  = 0.0_wp
    1652        qsws_soil_eb = 0.0_wp
    1653        qsws_veg_eb  = 0.0_wp
    1654 
    1655        r_a        = 50.0_wp
    1656        r_s        = 50.0_wp
    1657        r_canopy   = 0.0_wp
    1658        r_soil     = 0.0_wp
     1798          surf_lsm_h%qsws_eb = 0.0_wp
     1799       ENDIF
     1800
     1801       surf_lsm_h%qsws_liq_eb  = 0.0_wp
     1802       surf_lsm_h%qsws_soil_eb = 0.0_wp
     1803       surf_lsm_h%qsws_veg_eb  = 0.0_wp
     1804
     1805       surf_lsm_h%r_a        = 50.0_wp
     1806       surf_lsm_h%r_s        = 50.0_wp
     1807       surf_lsm_h%r_canopy   = 0.0_wp
     1808       surf_lsm_h%r_soil     = 0.0_wp
     1809!
     1810!--    Do the same for vertical surfaces
     1811       DO  l = 0, 3
     1812          tt_surface_v_m(l)%var_1d = 0.0_wp
     1813          tt_soil_v_m(l)%var_2d    = 0.0_wp
     1814          tm_soil_v_m(l)%var_2d    = 0.0_wp
     1815          tm_liq_eb_v_m(l)%var_1d  = 0.0_wp
     1816          surf_lsm_v(l)%c_liq = 0.0_wp
     1817
     1818          surf_lsm_v(l)%ghf_eb = 0.0_wp
     1819          surf_lsm_v(l)%shf_eb = rho_cp * surf_lsm_v(l)%shf
     1820
     1821          IF ( humidity )  THEN
     1822             surf_lsm_v(l)%qsws_eb = rho_lv * surf_lsm_v(l)%qsws
     1823          ELSE
     1824             surf_lsm_v(l)%qsws_eb = 0.0_wp
     1825          ENDIF
     1826
     1827          surf_lsm_v(l)%qsws_liq_eb  = 0.0_wp
     1828          surf_lsm_v(l)%qsws_soil_eb = 0.0_wp
     1829          surf_lsm_v(l)%qsws_veg_eb  = 0.0_wp
     1830
     1831          surf_lsm_v(l)%r_a        = 50.0_wp
     1832          surf_lsm_v(l)%r_s        = 50.0_wp
     1833          surf_lsm_v(l)%r_canopy   = 0.0_wp
     1834          surf_lsm_v(l)%r_soil     = 0.0_wp
     1835       ENDDO
    16591836
    16601837!
    16611838!--    Allocate 3D soil model arrays
    1662        ALLOCATE ( root_fr(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1663        ALLOCATE ( lambda_h(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1664        ALLOCATE ( rho_c_total(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1665 
    1666        lambda_h = 0.0_wp
     1839!--    First, for horizontal surfaces
     1840       ALLOCATE ( surf_lsm_h%root_fr(nzb_soil:nzt_soil,1:surf_lsm_h%ns)     )
     1841       ALLOCATE ( surf_lsm_h%lambda_h(nzb_soil:nzt_soil,1:surf_lsm_h%ns)    )
     1842       ALLOCATE ( surf_lsm_h%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
     1843
     1844       surf_lsm_h%lambda_h = 0.0_wp
    16671845!
    16681846!--    If required, allocate humidity-related variables for the soil model
    16691847       IF ( humidity )  THEN
    1670           ALLOCATE ( lambda_w(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1671           ALLOCATE ( gamma_w(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )   
    1672 
    1673           lambda_w = 0.0_wp
    1674        ENDIF
     1848          ALLOCATE ( surf_lsm_h%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
     1849          ALLOCATE ( surf_lsm_h%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns)  ) 
     1850
     1851          surf_lsm_h%lambda_w = 0.0_wp
     1852       ENDIF
     1853!
     1854!--    For vertical surfaces
     1855       DO  l = 0, 3
     1856          ALLOCATE ( surf_lsm_v(l)%root_fr(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)     )
     1857          ALLOCATE ( surf_lsm_v(l)%lambda_h(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)    )
     1858          ALLOCATE ( surf_lsm_v(l)%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
     1859
     1860          surf_lsm_v(l)%lambda_h = 0.0_wp
     1861!
     1862!--       If required, allocate humidity-related variables for the soil model
     1863          IF ( humidity )  THEN
     1864             ALLOCATE ( surf_lsm_v(l)%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
     1865             ALLOCATE ( surf_lsm_v(l)%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  ) 
     1866
     1867             surf_lsm_v(l)%lambda_w = 0.0_wp
     1868          ENDIF     
     1869       ENDDO
    16751870
    16761871!
    … …  
    17351930!
    17361931!--    Map values to the respective 2D arrays
    1737        alpha_vg      = alpha_vangenuchten
    1738        l_vg          = l_vangenuchten
    1739        n_vg          = n_vangenuchten
    1740        gamma_w_sat   = hydraulic_conductivity
    1741        m_sat         = saturation_moisture
    1742        m_fc          = field_capacity
    1743        m_wilt        = wilting_point
    1744        m_res         = residual_moisture
    1745        r_soil_min    = min_soil_resistance
     1932!--    Horizontal surfaces
     1933       surf_lsm_h%alpha_vg      = alpha_vangenuchten
     1934       surf_lsm_h%l_vg          = l_vangenuchten
     1935       surf_lsm_h%n_vg          = n_vangenuchten
     1936       surf_lsm_h%gamma_w_sat   = hydraulic_conductivity
     1937       surf_lsm_h%m_sat         = saturation_moisture
     1938       surf_lsm_h%m_fc          = field_capacity
     1939       surf_lsm_h%m_wilt        = wilting_point
     1940       surf_lsm_h%m_res         = residual_moisture
     1941       surf_lsm_h%r_soil_min    = min_soil_resistance
     1942!
     1943!--    Vertical surfaces
     1944       DO  l = 0, 3
     1945          surf_lsm_v(l)%alpha_vg      = alpha_vangenuchten
     1946          surf_lsm_v(l)%l_vg          = l_vangenuchten
     1947          surf_lsm_v(l)%n_vg          = n_vangenuchten
     1948          surf_lsm_v(l)%gamma_w_sat   = hydraulic_conductivity
     1949          surf_lsm_v(l)%m_sat         = saturation_moisture
     1950          surf_lsm_v(l)%m_fc          = field_capacity
     1951          surf_lsm_v(l)%m_wilt        = wilting_point
     1952          surf_lsm_v(l)%m_res         = residual_moisture
     1953          surf_lsm_v(l)%r_soil_min    = min_soil_resistance
     1954       ENDDO
     1955
     1956
    17461957
    17471958!
    17481959!--    Initial run actions
    17491960       IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
    1750 
    1751           t_soil    = 0.0_wp
    1752           m_liq_eb  = 0.0_wp
    1753           m_soil    = 0.0_wp
     1961!
     1962!--       First, for horizontal surfaces
     1963          t_soil_h%var_2d    = 0.0_wp
     1964          m_soil_h%var_2d    = 0.0_wp
     1965          m_liq_eb_h%var_1d  = 0.0_wp
    17541966
    17551967!
    … …  
    17581970!--       wilting point) -> problems with devision by zero)
    17591971          DO  k = nzb_soil, nzt_soil
    1760              t_soil(k,:,:)    = soil_temperature(k)
    1761              m_soil(k,:,:)    = MAX(soil_moisture(k),m_wilt(:,:))
     1972             t_soil_h%var_2d(k,:)      = soil_temperature(k)
     1973             m_soil_h%var_2d(k,:)      = MAX(soil_moisture(k),surf_lsm_h%m_wilt(:))
    17621974             soil_moisture(k) = MAX(soil_moisture(k),wilting_point)
    17631975          ENDDO
    1764           t_soil(nzt_soil+1,:,:) = soil_temperature(nzt_soil+1)
     1976          t_soil_h%var_2d(nzt_soil+1,:) = soil_temperature(nzt_soil+1)
    17651977
    17661978!
    17671979!--       Calculate surface temperature
    1768           t_surface   = pt_surface * exn
     1980          t_surface_h%var_1d(:)    = pt_surface * exn
     1981          surf_lsm_h%pt_surface(:) = pt_surface
    17691982
    17701983!
    17711984!--       Set artifical values for ts and us so that r_a has its initial value
    1772 !--       for the first time step
    1773           DO  i = nxlg, nxrg
    1774              DO  j = nysg, nyng
    1775                 k = nzb_s_inner(j,i)
     1985!--       for the first time step. Only for interior core domain, not for ghost points
     1986          DO  m = 1, surf_lsm_h%ns
     1987             i   = surf_lsm_h%i(m)           
     1988             j   = surf_lsm_h%j(m)
     1989             k   = surf_lsm_h%k(m)
     1990
     1991             IF ( cloud_physics )  THEN
     1992                pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
     1993             ELSE
     1994                pt1 = pt(k,j,i)
     1995             ENDIF
     1996
     1997!
     1998!--          Assure that r_a cannot be zero at model start
     1999             IF ( pt1 == surf_lsm_h%pt_surface(m) )  pt1 = pt1 + 1.0E-10_wp
     2000
     2001             surf_lsm_h%us(m)   = 0.1_wp
     2002             surf_lsm_h%ts(m)   = ( pt1 - surf_lsm_h%pt_surface(m) ) / surf_lsm_h%r_a(m)
     2003             surf_lsm_h%shf(m)  = - surf_lsm_h%us(m) * surf_lsm_h%ts(m)
     2004          ENDDO
     2005!
     2006!--       Vertical surfaces
     2007          DO  l = 0, 3
     2008
     2009             t_soil_v(l)%var_2d    = 0.0_wp
     2010             m_soil_v(l)%var_2d    = 0.0_wp
     2011             m_liq_eb_v(l)%var_1d  = 0.0_wp
     2012
     2013!
     2014!--          Map user settings of T and q for each soil layer
     2015!--          (make sure that the soil moisture does not drop below the permanent
     2016!--          wilting point) -> problems with devision by zero)
     2017             DO  k = nzb_soil, nzt_soil
     2018                t_soil_v(l)%var_2d(k,:)      = soil_temperature(k)
     2019                m_soil_v(l)%var_2d(k,:)      = MAX(soil_moisture(k),surf_lsm_v(l)%m_wilt(:))
     2020                soil_moisture(k) = MAX(soil_moisture(k),wilting_point)
     2021             ENDDO
     2022             t_soil_v(l)%var_2d(nzt_soil+1,:) = soil_temperature(nzt_soil+1)
     2023
     2024!
     2025!--          Calculate surface temperature
     2026             t_surface_v(l)%var_1d(:)   = pt_surface * exn
     2027             surf_lsm_h%pt_surface(:)   = pt_surface
     2028
     2029!
     2030!--          Set artifical values for ts and us so that r_a has its initial value
     2031!--          for the first time step. Only for interior core domain, not for ghost points
     2032             DO  m = 1, surf_lsm_v(l)%ns
     2033                i   = surf_lsm_v(l)%i(m)           
     2034                j   = surf_lsm_v(l)%j(m)
     2035                k   = surf_lsm_v(l)%k(m)
    17762036
    17772037                IF ( cloud_physics )  THEN
    1778                    pt1 = pt(k+1,j,i) + l_d_cp * pt_d_t(k+1) * ql(k+1,j,i)
     2038                   pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
    17792039                ELSE
    1780                    pt1 = pt(k+1,j,i)
     2040                   pt1 = pt(k,j,i)
    17812041                ENDIF
    17822042
    17832043!
    17842044!--             Assure that r_a cannot be zero at model start
    1785                 IF ( pt1 == pt(k,j,i) )  pt1 = pt1 + 1.0E-10_wp
    1786 
    1787                 us(j,i)  = 0.1_wp
    1788                 ts(j,i)  = (pt1 - pt(k,j,i)) / r_a(j,i)
    1789                 shf(j,i) = - us(j,i) * ts(j,i)
     2045                IF ( pt1 == surf_lsm_h%pt_surface(m) )  pt1 = pt1 + 1.0E-10_wp
     2046
     2047                surf_lsm_v(l)%us(m)   = 0.1_wp
     2048                surf_lsm_v(l)%ts(m)   = ( pt1 - surf_lsm_h%pt_surface(m) ) / surf_lsm_v(l)%r_a(m)
     2049                surf_lsm_v(l)%shf(m)  = - surf_lsm_v(l)%us(m) * surf_lsm_v(l)%ts(m)
    17902050             ENDDO
    17912051          ENDDO
    … …  
    17942054!--    Actions for restart runs
    17952055       ELSE
    1796 
    1797           DO  i = nxlg, nxrg
    1798              DO  j = nysg, nyng
    1799                 k = nzb_s_inner(j,i)               
    1800                 t_surface(j,i) = pt(k,j,i) * exn
    1801              ENDDO
     2056!
     2057!--       Horizontal surfaces
     2058          DO  m = 1, surf_lsm_h%ns
     2059             i   = surf_lsm_h%i(m)           
     2060             j   = surf_lsm_h%j(m)
     2061             k   = surf_lsm_h%k(m)         
     2062             t_surface_h%var_1d(m) = pt(k-1,j,i) * exn
    18022063          ENDDO
    1803 
    1804        ENDIF
    1805 
    1806        DO  k = nzb_soil, nzt_soil
    1807           root_fr(k,:,:) = root_fraction(k)
     2064!
     2065!--       Vertical surfaces
     2066          DO  l = 0, 3
     2067!
     2068!--          Set index offset of surface element, seen from atmospheric grid point
     2069             IF ( l == 0 )  THEN
     2070                j_off = -1
     2071                i_off = 0
     2072             ELSEIF ( l == 1 )  THEN
     2073                j_off = 1
     2074                i_off = 0
     2075             ELSEIF ( l == 2 )  THEN
     2076                j_off = 0
     2077                i_off = -1
     2078             ELSEIF ( l == 3 )  THEN
     2079                j_off = 0
     2080                i_off = 1
     2081             ENDIF
     2082             DO  m = 1, surf_lsm_v(l)%ns
     2083                i   = surf_lsm_v(l)%i(m)           
     2084                j   = surf_lsm_v(l)%j(m)
     2085                k   = surf_lsm_v(l)%k(m)         
     2086                t_surface_v(l)%var_1d(m) = pt(k,j+j_off,i+i_off) * exn
     2087             ENDDO
     2088          ENDDO
     2089
     2090       ENDIF
     2091!
     2092!--    Initialize root fraction
     2093!--    Horizontal surfaces
     2094       DO  m = 1, surf_lsm_h%ns
     2095          i   = surf_lsm_h%i(m)           
     2096          j   = surf_lsm_h%j(m)
     2097
     2098          DO  k = nzb_soil, nzt_soil
     2099             surf_lsm_h%root_fr(k,m) = root_fraction(k)
     2100          ENDDO
     2101       ENDDO
     2102!
     2103!--    Vertical surfaces
     2104       DO  l = 0, 3
     2105          DO  m = 1, surf_lsm_v(l)%ns
     2106             i   = surf_lsm_v(l)%i(m)           
     2107             j   = surf_lsm_v(l)%j(m)
     2108
     2109             DO  k = nzb_soil, nzt_soil
     2110                surf_lsm_v(l)%root_fr(k,m) = root_fraction(k)
     2111             ENDDO
     2112          ENDDO
    18082113       ENDDO
    18092114
    … …  
    18432148
    18442149          IF ( ANY( root_fraction == 9999999.9_wp ) )  THEN
    1845              DO  k = nzb_soil, nzt_soil
    1846                 root_fr(k,:,:) = root_distribution(k,veg_type)
    1847                 root_fraction(k) = root_distribution(k,veg_type)
     2150             DO  m = 1, surf_lsm_h%ns
     2151                i   = surf_lsm_h%i(m)           
     2152                j   = surf_lsm_h%j(m)
     2153
     2154                DO  k = nzb_soil, nzt_soil
     2155                   surf_lsm_h%root_fr(k,m) = root_distribution(k,veg_type)
     2156                   root_fraction(k)    = root_distribution(k,veg_type)
     2157                ENDDO
     2158             ENDDO
     2159             DO  l = 0, 3
     2160                DO  m = 1, surf_lsm_v(l)%ns
     2161                   i   = surf_lsm_v(l)%i(m)           
     2162                   j   = surf_lsm_v(l)%j(m)
     2163
     2164                   DO  k = nzb_soil, nzt_soil
     2165                      surf_lsm_v(l)%root_fr(k,m) = root_distribution(k,veg_type)
     2166                      root_fraction(k)    = root_distribution(k,veg_type)
     2167                   ENDDO
     2168                ENDDO
    18482169             ENDDO
    18492170          ENDIF
    … …  
    18772198!--    Map vegetation and soil types to 2D array to allow for heterogeneous
    18782199!--    surfaces via user interface see below
    1879        veg_type_2d = veg_type
    1880        soil_type_2d = soil_type
     2200!--    First for horizontal surfaces
     2201       surf_lsm_h%veg_type_2d  = veg_type
     2202       surf_lsm_h%soil_type_2d = soil_type
    18812203
    18822204!
    18832205!--    Map vegetation parameters to the respective 2D arrays
    1884        r_canopy_min         = min_canopy_resistance
    1885        lai                  = leaf_area_index
    1886        c_veg                = vegetation_coverage
    1887        g_d                  = canopy_resistance_coefficient
    1888        lambda_surface_s     = lambda_surface_stable
    1889        lambda_surface_u     = lambda_surface_unstable
    1890        f_sw_in              = f_shortwave_incoming
    1891        z0                   = z0_eb
    1892        z0h                  = z0h_eb
    1893        z0q                  = z0q_eb
     2206       surf_lsm_h%r_canopy_min      = min_canopy_resistance
     2207       surf_lsm_h%lai               = leaf_area_index
     2208       surf_lsm_h%c_veg             = vegetation_coverage
     2209       surf_lsm_h%g_d               = canopy_resistance_coefficient
     2210       surf_lsm_h%lambda_surface_s  = lambda_surface_stable
     2211       surf_lsm_h%lambda_surface_u  = lambda_surface_unstable
     2212       surf_lsm_h%f_sw_in           = f_shortwave_incoming
     2213       surf_lsm_h%z0                = z0_eb
     2214       surf_lsm_h%z0h               = z0h_eb
     2215       surf_lsm_h%z0q               = z0q_eb
     2216
     2217!--    Vertical surfaces
     2218       DO  l = 0, 3
     2219          surf_lsm_v(l)%veg_type_2d  = veg_type
     2220          surf_lsm_v(l)%soil_type_2d = soil_type
     2221
     2222!
     2223!--       Map vegetation parameters to the respective 2D arrays
     2224          surf_lsm_v(l)%r_canopy_min      = min_canopy_resistance
     2225          surf_lsm_v(l)%lai               = leaf_area_index
     2226          surf_lsm_v(l)%c_veg             = vegetation_coverage
     2227          surf_lsm_v(l)%g_d               = canopy_resistance_coefficient
     2228          surf_lsm_v(l)%lambda_surface_s  = lambda_surface_stable
     2229          surf_lsm_v(l)%lambda_surface_u  = lambda_surface_unstable
     2230          surf_lsm_v(l)%f_sw_in           = f_shortwave_incoming
     2231          surf_lsm_v(l)%z0                = z0_eb
     2232          surf_lsm_v(l)%z0h               = z0h_eb
     2233          surf_lsm_v(l)%z0q               = z0q_eb
     2234       ENDDO
    18942235
    18952236!
    … …  
    19002241!--    Set flag parameter if vegetation type was set to a water surface. Also
    19012242!--    set temperature to a constant value in all "soil" layers.
    1902        DO  i = nxlg, nxrg
    1903           DO  j = nysg, nyng
    1904              IF ( veg_type_2d(j,i) == 14  .OR.  veg_type_2d(j,i) == 15 )  THEN
    1905                 water_surface(j,i) = .TRUE.
    1906                 t_soil(:,j,i) = t_surface(j,i)
    1907              ELSEIF ( veg_type_2d(j,i) == 20 )  THEN
    1908                 pave_surface(j,i) = .TRUE.
    1909                 m_soil(:,j,i) = 0.0_wp
    1910              ENDIF
    1911 
    1912           ENDDO
     2243!--    For now, do not set water surface for vertical surfaces
     2244       DO  m = 1, surf_lsm_h%ns
     2245          i   = surf_lsm_h%i(m)           
     2246          j   = surf_lsm_h%j(m)
     2247
     2248          IF ( surf_lsm_h%veg_type_2d(m) == 14  .OR.                           &
     2249               surf_lsm_h%veg_type_2d(m) == 15 )  THEN
     2250             surf_lsm_h%water_surface(m) = .TRUE.
     2251             t_soil_h%var_2d(:,m) = t_surface_h%var_1d(m)
     2252          ELSEIF ( surf_lsm_h%veg_type_2d(m) == 20 )  THEN
     2253             surf_lsm_h%pave_surface(m) = .TRUE.
     2254             m_soil_h%var_2d(:,m)            = 0.0_wp
     2255          ENDIF
     2256
    19132257       ENDDO
    19142258
    19152259!
    1916 !--    Calculate new roughness lengths (for water surfaces only)
     2260!--    Calculate new roughness lengths (for water surfaces only, i.e. only
     2261!-     horizontal surfaces)
    19172262       CALL calc_z0_water_surface
    19182263
    1919        t_soil_p    = t_soil
    1920        m_soil_p    = m_soil
    1921        m_liq_eb_p  = m_liq_eb
    1922        t_surface_p = t_surface
     2264       t_soil_h_p    = t_soil_h
     2265       m_soil_h_p    = m_soil_h
     2266       m_liq_eb_h_p  = m_liq_eb_h
     2267       t_surface_h_p = t_surface_h
     2268
     2269       t_soil_v_p    = t_soil_v
     2270       m_soil_v_p    = m_soil_v
     2271       m_liq_eb_v_p  = m_liq_eb_v
     2272       t_surface_v_p = t_surface_v
    19232273
    19242274
    … …  
    19262276!--    Store initial profiles of t_soil and m_soil (assuming they are
    19272277!--    horizontally homogeneous on this PE)
    1928        hom(nzb_soil:nzt_soil,1,90,:)  = SPREAD( t_soil(nzb_soil:nzt_soil,      &
    1929                                                 nysg,nxlg), 2,                 &
    1930                                                 statistic_regions+1 )
    1931        hom(nzb_soil:nzt_soil,1,92,:)  = SPREAD( m_soil(nzb_soil:nzt_soil,      &
    1932                                                 nysg,nxlg), 2,                 &
    1933                                                 statistic_regions+1 )
     2278       hom(nzb_soil:nzt_soil,1,90,:)  = SPREAD( t_soil_h%var_2d(nzb_soil:nzt_soil,1),  &
     2279                                                2, statistic_regions+1 )
     2280       hom(nzb_soil:nzt_soil,1,92,:)  = SPREAD( m_soil_h%var_2d(nzb_soil:nzt_soil,1),  &
     2281                                                2, statistic_regions+1 )
    19342282
    19352283    END SUBROUTINE lsm_init
    … …  
    19462294       IMPLICIT NONE
    19472295
    1948 !
    1949 !--    Allocate surface and soil temperature / humidity
     2296       INTEGER(iwp) ::  l !< index indicating facing of surface array
     2297
     2298!
     2299!--    Allocate surface and soil temperature / humidity. Please note,
     2300!--    these arrays are allocated according to surface-data structure,
     2301!--    even if they do not belong to the data type due to the
     2302!--    pointer arithmetric (TARGET attribute is not allowed in a data-type).
    19502303#if defined( __nopointer )
    1951        ALLOCATE ( m_liq_eb(nysg:nyng,nxlg:nxrg) )
    1952        ALLOCATE ( m_liq_eb_p(nysg:nyng,nxlg:nxrg) )
    1953        ALLOCATE ( m_soil(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1954        ALLOCATE ( m_soil_p(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1955        ALLOCATE ( t_surface(nysg:nyng,nxlg:nxrg) )
    1956        ALLOCATE ( t_surface_p(nysg:nyng,nxlg:nxrg) )
    1957        ALLOCATE ( t_soil(nzb_soil:nzt_soil+1,nysg:nyng,nxlg:nxrg) )
    1958        ALLOCATE ( t_soil_p(nzb_soil:nzt_soil+1,nysg:nyng,nxlg:nxrg) )
     2304!
     2305!--    Horizontal surfaces
     2306       ALLOCATE ( m_liq_eb_h%var_1d(1:surf_lsm_h%ns)                     )
     2307       ALLOCATE ( m_liq_eb_h_p%var_1d(1:surf_lsm_h%ns)                   )
     2308       ALLOCATE ( t_surface_h%var_1d(1:surf_lsm_h%ns)                    )
     2309       ALLOCATE ( t_surface_h_p%var_1d(1:surf_lsm_h%ns)                  )
     2310       ALLOCATE ( m_soil_h%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)     )
     2311       ALLOCATE ( m_soil_h_p%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)   )
     2312       ALLOCATE ( t_soil_h%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns)   )
     2313       ALLOCATE ( t_soil_h_p%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
     2314!
     2315!--    Vertical surfaces
     2316       DO  l = 0, 3
     2317          ALLOCATE ( m_liq_eb_v(l)%var_1d(1:surf_lsm_v(l)%ns)                     )
     2318          ALLOCATE ( m_liq_eb_v(l)_p%var_1d(1:surf_lsm_v(l)%ns)                   )
     2319          ALLOCATE ( t_surface_v(l)%var_1d(1:surf_lsm_v(l)%ns)                    )
     2320          ALLOCATE ( t_surface_v(l)_p%var_1d(1:surf_lsm_v(l)%ns)                  )
     2321          ALLOCATE ( m_soil_v(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)     )
     2322          ALLOCATE ( m_soil_v(l)_p%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)   )
     2323          ALLOCATE ( t_soil_v(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns)   )
     2324          ALLOCATE ( t_soil_v(l)_p%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
     2325       ENDDO
    19592326#else
    1960        ALLOCATE ( m_liq_eb_1(nysg:nyng,nxlg:nxrg) )
    1961        ALLOCATE ( m_liq_eb_2(nysg:nyng,nxlg:nxrg) )
    1962        ALLOCATE ( m_soil_1(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1963        ALLOCATE ( m_soil_2(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1964        ALLOCATE ( t_surface_1(nysg:nyng,nxlg:nxrg) )
    1965        ALLOCATE ( t_surface_2(nysg:nyng,nxlg:nxrg) )
    1966        ALLOCATE ( t_soil_1(nzb_soil:nzt_soil+1,nysg:nyng,nxlg:nxrg) )
    1967        ALLOCATE ( t_soil_2(nzb_soil:nzt_soil+1,nysg:nyng,nxlg:nxrg) )
     2327!
     2328!--    Horizontal surfaces
     2329       ALLOCATE ( m_liq_eb_h_1%var_1d(1:surf_lsm_h%ns)                   )
     2330       ALLOCATE ( m_liq_eb_h_2%var_1d(1:surf_lsm_h%ns)                   )
     2331       ALLOCATE ( t_surface_h_1%var_1d(1:surf_lsm_h%ns)                  )
     2332       ALLOCATE ( t_surface_h_2%var_1d(1:surf_lsm_h%ns)                  )
     2333       ALLOCATE ( m_soil_h_1%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)   )
     2334       ALLOCATE ( m_soil_h_2%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)   )
     2335       ALLOCATE ( t_soil_h_1%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
     2336       ALLOCATE ( t_soil_h_2%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
     2337!
     2338!--    Vertical surfaces
     2339       DO  l = 0, 3
     2340          ALLOCATE ( m_liq_eb_v_1(l)%var_1d(1:surf_lsm_v(l)%ns)                   )
     2341          ALLOCATE ( m_liq_eb_v_2(l)%var_1d(1:surf_lsm_v(l)%ns)                   )
     2342          ALLOCATE ( t_surface_v_1(l)%var_1d(1:surf_lsm_v(l)%ns)                  )
     2343          ALLOCATE ( t_surface_v_2(l)%var_1d(1:surf_lsm_v(l)%ns)                  )
     2344          ALLOCATE ( m_soil_v_1(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)   )
     2345          ALLOCATE ( m_soil_v_2(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)   )
     2346          ALLOCATE ( t_soil_v_1(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
     2347          ALLOCATE ( t_soil_v_2(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
     2348       ENDDO
    19682349#endif
    19692350
    19702351!
    19712352!--    Allocate intermediate timestep arrays
    1972        ALLOCATE ( tm_liq_eb_m(nysg:nyng,nxlg:nxrg) )
    1973        ALLOCATE ( tm_soil_m(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
    1974        ALLOCATE ( tt_surface_m(nysg:nyng,nxlg:nxrg) )
    1975        ALLOCATE ( tt_soil_m(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
     2353!--    Horizontal surfaces
     2354       ALLOCATE ( tm_liq_eb_h_m%var_1d(1:surf_lsm_h%ns)                  )
     2355       ALLOCATE ( tt_surface_h_m%var_1d(1:surf_lsm_h%ns)                 )
     2356       ALLOCATE ( tm_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)  )
     2357       ALLOCATE ( tt_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)  )
     2358!
     2359!--    Horizontal surfaces
     2360       DO  l = 0, 3
     2361          ALLOCATE ( tm_liq_eb_v_m(l)%var_1d(1:surf_lsm_v(l)%ns)                  )
     2362          ALLOCATE ( tt_surface_v_m(l)%var_1d(1:surf_lsm_v(l)%ns)                 )
     2363          ALLOCATE ( tm_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  )
     2364          ALLOCATE ( tt_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  )
     2365       ENDDO
     2366!
     2367!--    Allocate skin-surface temperature
     2368       ALLOCATE ( surf_lsm_h%pt_surface(1:surf_lsm_h%ns) )
     2369       DO  l = 0, 3
     2370          ALLOCATE ( surf_lsm_v(l)%pt_surface(1:surf_lsm_v(l)%ns) )
     2371       ENDDO
    19762372
    19772373!
    19782374!--    Allocate 2D vegetation model arrays
    1979        ALLOCATE ( alpha_vg(nysg:nyng,nxlg:nxrg) )
    1980        ALLOCATE ( building_surface(nysg:nyng,nxlg:nxrg) )
    1981        ALLOCATE ( c_liq(nysg:nyng,nxlg:nxrg) )
    1982        ALLOCATE ( c_veg(nysg:nyng,nxlg:nxrg) )
    1983        ALLOCATE ( f_sw_in(nysg:nyng,nxlg:nxrg) )
    1984        ALLOCATE ( ghf_eb(nysg:nyng,nxlg:nxrg) )
    1985        ALLOCATE ( gamma_w_sat(nysg:nyng,nxlg:nxrg) )
    1986        ALLOCATE ( g_d(nysg:nyng,nxlg:nxrg) )
    1987        ALLOCATE ( lai(nysg:nyng,nxlg:nxrg) )
    1988        ALLOCATE ( l_vg(nysg:nyng,nxlg:nxrg) )
    1989        ALLOCATE ( lambda_surface_u(nysg:nyng,nxlg:nxrg) )
    1990        ALLOCATE ( lambda_surface_s(nysg:nyng,nxlg:nxrg) )
    1991        ALLOCATE ( m_fc(nysg:nyng,nxlg:nxrg) )
    1992        ALLOCATE ( m_res(nysg:nyng,nxlg:nxrg) )
    1993        ALLOCATE ( m_sat(nysg:nyng,nxlg:nxrg) )
    1994        ALLOCATE ( m_wilt(nysg:nyng,nxlg:nxrg) )
    1995        ALLOCATE ( n_vg(nysg:nyng,nxlg:nxrg) )
    1996        ALLOCATE ( pave_surface(nysg:nyng,nxlg:nxrg) )
    1997        ALLOCATE ( qsws_eb(nysg:nyng,nxlg:nxrg) )
    1998        ALLOCATE ( qsws_soil_eb(nysg:nyng,nxlg:nxrg) )
    1999        ALLOCATE ( qsws_liq_eb(nysg:nyng,nxlg:nxrg) )
    2000        ALLOCATE ( qsws_veg_eb(nysg:nyng,nxlg:nxrg) )
    2001        ALLOCATE ( rad_net_l(nysg:nyng,nxlg:nxrg) )
    2002        ALLOCATE ( r_a(nysg:nyng,nxlg:nxrg) )
    2003        ALLOCATE ( r_canopy(nysg:nyng,nxlg:nxrg) )
    2004        ALLOCATE ( r_soil(nysg:nyng,nxlg:nxrg) )
    2005        ALLOCATE ( r_soil_min(nysg:nyng,nxlg:nxrg) )
    2006        ALLOCATE ( r_s(nysg:nyng,nxlg:nxrg) )
    2007        ALLOCATE ( r_canopy_min(nysg:nyng,nxlg:nxrg) )
    2008        ALLOCATE ( shf_eb(nysg:nyng,nxlg:nxrg) )
    2009        ALLOCATE ( soil_type_2d(nysg:nyng,nxlg:nxrg) )
    2010        ALLOCATE ( veg_type_2d(nysg:nyng,nxlg:nxrg) )
    2011        ALLOCATE ( water_surface(nysg:nyng,nxlg:nxrg) )
    2012 
    2013        water_surface = .FALSE.
    2014        pave_surface  = .FALSE.
    2015 
     2375!--    Horizontal surfaces
     2376       ALLOCATE ( surf_lsm_h%alpha_vg(1:surf_lsm_h%ns)         )
     2377       ALLOCATE ( surf_lsm_h%building_surface(1:surf_lsm_h%ns) )
     2378       ALLOCATE ( surf_lsm_h%c_liq(1:surf_lsm_h%ns)            )
     2379       ALLOCATE ( surf_lsm_h%c_veg(1:surf_lsm_h%ns)            )
     2380       ALLOCATE ( surf_lsm_h%f_sw_in(1:surf_lsm_h%ns)          )
     2381       ALLOCATE ( surf_lsm_h%ghf_eb(1:surf_lsm_h%ns)           )
     2382       ALLOCATE ( surf_lsm_h%gamma_w_sat(1:surf_lsm_h%ns)      )
     2383       ALLOCATE ( surf_lsm_h%g_d(1:surf_lsm_h%ns)              )
     2384       ALLOCATE ( surf_lsm_h%lai(1:surf_lsm_h%ns)              )
     2385       ALLOCATE ( surf_lsm_h%l_vg(1:surf_lsm_h%ns)             )
     2386       ALLOCATE ( surf_lsm_h%lambda_surface_u(1:surf_lsm_h%ns) )
     2387       ALLOCATE ( surf_lsm_h%lambda_surface_s(1:surf_lsm_h%ns) )
     2388       ALLOCATE ( surf_lsm_h%m_fc(1:surf_lsm_h%ns)             )
     2389       ALLOCATE ( surf_lsm_h%m_res(1:surf_lsm_h%ns)            )
     2390       ALLOCATE ( surf_lsm_h%m_sat(1:surf_lsm_h%ns)            )
     2391       ALLOCATE ( surf_lsm_h%m_wilt(1:surf_lsm_h%ns)           )
     2392       ALLOCATE ( surf_lsm_h%n_vg(1:surf_lsm_h%ns)             )
     2393       ALLOCATE ( surf_lsm_h%pave_surface(1:surf_lsm_h%ns)     )
     2394       ALLOCATE ( surf_lsm_h%qsws_eb(1:surf_lsm_h%ns)          )
     2395       ALLOCATE ( surf_lsm_h%qsws_soil_eb(1:surf_lsm_h%ns)     )
     2396       ALLOCATE ( surf_lsm_h%qsws_liq_eb(1:surf_lsm_h%ns)      )
     2397       ALLOCATE ( surf_lsm_h%qsws_veg_eb(1:surf_lsm_h%ns)      )
     2398       ALLOCATE ( surf_lsm_h%rad_net_l(1:surf_lsm_h%ns)        )
     2399       ALLOCATE ( surf_lsm_h%r_a(1:surf_lsm_h%ns)              )
     2400       ALLOCATE ( surf_lsm_h%r_canopy(1:surf_lsm_h%ns)         )
     2401       ALLOCATE ( surf_lsm_h%r_soil(1:surf_lsm_h%ns)           )
     2402       ALLOCATE ( surf_lsm_h%r_soil_min(1:surf_lsm_h%ns)       )
     2403       ALLOCATE ( surf_lsm_h%r_s(1:surf_lsm_h%ns)              )
     2404       ALLOCATE ( surf_lsm_h%r_canopy_min(1:surf_lsm_h%ns)     )
     2405       ALLOCATE ( surf_lsm_h%shf_eb(1:surf_lsm_h%ns)           )
     2406       ALLOCATE ( surf_lsm_h%soil_type_2d(1:surf_lsm_h%ns)     )
     2407       ALLOCATE ( surf_lsm_h%veg_type_2d(1:surf_lsm_h%ns)      )
     2408       ALLOCATE ( surf_lsm_h%water_surface(1:surf_lsm_h%ns)    )
     2409
     2410       surf_lsm_h%water_surface = .FALSE.
     2411       surf_lsm_h%pave_surface  = .FALSE.
     2412!
     2413!--    Vertical surfaces
     2414       DO  l = 0, 3
     2415          ALLOCATE ( surf_lsm_v(l)%alpha_vg(1:surf_lsm_v(l)%ns)         )
     2416          ALLOCATE ( surf_lsm_v(l)%building_surface(1:surf_lsm_v(l)%ns) )
     2417          ALLOCATE ( surf_lsm_v(l)%c_liq(1:surf_lsm_v(l)%ns)            )
     2418          ALLOCATE ( surf_lsm_v(l)%c_veg(1:surf_lsm_v(l)%ns)            )
     2419          ALLOCATE ( surf_lsm_v(l)%f_sw_in(1:surf_lsm_v(l)%ns)          )
     2420          ALLOCATE ( surf_lsm_v(l)%ghf_eb(1:surf_lsm_v(l)%ns)           )
     2421          ALLOCATE ( surf_lsm_v(l)%gamma_w_sat(1:surf_lsm_v(l)%ns)      )
     2422          ALLOCATE ( surf_lsm_v(l)%g_d(1:surf_lsm_v(l)%ns)              )
     2423          ALLOCATE ( surf_lsm_v(l)%lai(1:surf_lsm_v(l)%ns)              )
     2424          ALLOCATE ( surf_lsm_v(l)%l_vg(1:surf_lsm_v(l)%ns)             )
     2425          ALLOCATE ( surf_lsm_v(l)%lambda_surface_u(1:surf_lsm_v(l)%ns) )
     2426          ALLOCATE ( surf_lsm_v(l)%lambda_surface_s(1:surf_lsm_v(l)%ns) )
     2427          ALLOCATE ( surf_lsm_v(l)%m_fc(1:surf_lsm_v(l)%ns)             )
     2428          ALLOCATE ( surf_lsm_v(l)%m_res(1:surf_lsm_v(l)%ns)            )
     2429          ALLOCATE ( surf_lsm_v(l)%m_sat(1:surf_lsm_v(l)%ns)            )
     2430          ALLOCATE ( surf_lsm_v(l)%m_wilt(1:surf_lsm_v(l)%ns)           )
     2431          ALLOCATE ( surf_lsm_v(l)%n_vg(1:surf_lsm_v(l)%ns)             )
     2432          ALLOCATE ( surf_lsm_v(l)%pave_surface(1:surf_lsm_v(l)%ns)     )
     2433          ALLOCATE ( surf_lsm_v(l)%qsws_eb(1:surf_lsm_v(l)%ns)          )
     2434          ALLOCATE ( surf_lsm_v(l)%qsws_soil_eb(1:surf_lsm_v(l)%ns)     )
     2435          ALLOCATE ( surf_lsm_v(l)%qsws_liq_eb(1:surf_lsm_v(l)%ns)      )
     2436          ALLOCATE ( surf_lsm_v(l)%qsws_veg_eb(1:surf_lsm_v(l)%ns)      )
     2437          ALLOCATE ( surf_lsm_v(l)%rad_net_l(1:surf_lsm_v(l)%ns)        )
     2438          ALLOCATE ( surf_lsm_v(l)%r_a(1:surf_lsm_v(l)%ns)              )
     2439          ALLOCATE ( surf_lsm_v(l)%r_canopy(1:surf_lsm_v(l)%ns)         )
     2440          ALLOCATE ( surf_lsm_v(l)%r_soil(1:surf_lsm_v(l)%ns)           )
     2441          ALLOCATE ( surf_lsm_v(l)%r_soil_min(1:surf_lsm_v(l)%ns)       )
     2442          ALLOCATE ( surf_lsm_v(l)%r_s(1:surf_lsm_v(l)%ns)              )
     2443          ALLOCATE ( surf_lsm_v(l)%r_canopy_min(1:surf_lsm_v(l)%ns)     )
     2444          ALLOCATE ( surf_lsm_v(l)%shf_eb(1:surf_lsm_v(l)%ns)           )
     2445          ALLOCATE ( surf_lsm_v(l)%soil_type_2d(1:surf_lsm_v(l)%ns)     )
     2446          ALLOCATE ( surf_lsm_v(l)%veg_type_2d(1:surf_lsm_v(l)%ns)      )
     2447          ALLOCATE ( surf_lsm_v(l)%water_surface(1:surf_lsm_v(l)%ns)    )
     2448
     2449          surf_lsm_v(l)%water_surface = .FALSE.
     2450          surf_lsm_v(l)%pave_surface  = .FALSE.
     2451       ENDDO
     2452   
    20162453#if ! defined( __nopointer )
    20172454!
    20182455!--    Initial assignment of the pointers
    2019        t_soil    => t_soil_1;    t_soil_p    => t_soil_2
    2020        t_surface => t_surface_1; t_surface_p => t_surface_2
    2021        m_soil    => m_soil_1;    m_soil_p    => m_soil_2
    2022        m_liq_eb  => m_liq_eb_1;  m_liq_eb_p  => m_liq_eb_2
     2456!--    Horizontal surfaces
     2457       t_soil_h    => t_soil_h_1;    t_soil_h_p    => t_soil_h_2
     2458       t_surface_h => t_surface_h_1; t_surface_h_p => t_surface_h_2
     2459       m_soil_h    => m_soil_h_1;    m_soil_h_p    => m_soil_h_2
     2460       m_liq_eb_h  => m_liq_eb_h_1;  m_liq_eb_h_p  => m_liq_eb_h_2
     2461!
     2462!--    Vertical surfaces
     2463       t_soil_v    => t_soil_v_1;    t_soil_v_p    => t_soil_v_2
     2464       t_surface_v => t_surface_v_1; t_surface_v_p => t_surface_v_2
     2465       m_soil_v    => m_soil_v_1;    m_soil_v_p    => m_soil_v_2
     2466       m_liq_eb_v  => m_liq_eb_v_1;  m_liq_eb_v_p  => m_liq_eb_v_2
    20232467#endif
    20242468
    … …  
    20432487                                  conserve_water_content,                      &
    20442488                                  f_shortwave_incoming, field_capacity,        &
    2045                                   hydraulic_conductivity,                      &
     2489                                  aero_resist_kray, hydraulic_conductivity,                      &
    20462490                                  lambda_surface_stable,                       &
    20472491                                  lambda_surface_unstable, leaf_area_index,    &
    … …  
    20872531!> temperature and water content.
    20882532!------------------------------------------------------------------------------!
    2089     SUBROUTINE lsm_soil_model
     2533    SUBROUTINE lsm_soil_model( horizontal, l )
    20902534
    20912535
    20922536       IMPLICIT NONE
    20932537
    2094        INTEGER(iwp) ::  i   !< running index
    2095        INTEGER(iwp) ::  j   !< running index
    2096        INTEGER(iwp) ::  k   !< running index
    2097 
    2098        REAL(wp)     :: h_vg !< Van Genuchten coef. h
     2538       INTEGER(iwp) ::  k       !< running index
     2539       INTEGER(iwp) ::  l       !< surface-data type index indication facing
     2540       INTEGER(iwp) ::  m       !< running index
     2541
     2542       LOGICAL      ::  horizontal !< flag indication horizontal wall, required to set pointer accordingly
     2543
     2544       REAL(wp)     ::  h_vg !< Van Genuchten coef. h
    20992545
    21002546       REAL(wp), DIMENSION(nzb_soil:nzt_soil) :: gamma_temp,  & !< temp. gamma
    … …  
    21022548                                                 tend           !< tendency
    21032549
    2104        DO  i = nxlg, nxrg
    2105           DO  j = nysg, nyng
    2106 
    2107              IF ( pave_surface(j,i) )  THEN
    2108                 rho_c_total(nzb_soil,j,i) = pave_heat_capacity
    2109                 lambda_temp(nzb_soil)     = pave_heat_conductivity
     2550       TYPE(surf_type_lsm), POINTER ::  surf_m_soil
     2551       TYPE(surf_type_lsm), POINTER ::  surf_m_soil_p
     2552       TYPE(surf_type_lsm), POINTER ::  surf_t_soil
     2553       TYPE(surf_type_lsm), POINTER ::  surf_t_soil_p
     2554       TYPE(surf_type_lsm), POINTER ::  surf_tm_soil_m
     2555       TYPE(surf_type_lsm), POINTER ::  surf_tt_soil_m
     2556
     2557       TYPE(surf_type), POINTER  ::  surf  !< surface-date type variable
     2558
     2559       IF ( horizontal )  THEN
     2560          surf           => surf_lsm_h
     2561
     2562          surf_m_soil    => m_soil_h
     2563          surf_m_soil_p  => m_soil_h_p
     2564          surf_t_soil    => t_soil_h
     2565          surf_t_soil_p  => t_soil_h_p
     2566          surf_tm_soil_m => tm_soil_h_m
     2567          surf_tt_soil_m => tt_soil_h_m
     2568       ELSE
     2569          surf           => surf_lsm_v(l)
     2570
     2571          surf_m_soil    => m_soil_v(l)
     2572          surf_m_soil_p  => m_soil_v_p(l)
     2573          surf_t_soil    => t_soil_v(l)
     2574          surf_t_soil_p  => t_soil_v_p(l)
     2575          surf_tm_soil_m => tm_soil_v_m(l)
     2576          surf_tt_soil_m => tt_soil_v_m(l)
     2577       ENDIF
     2578
     2579       DO  m = 1, surf%ns
     2580
     2581          IF ( surf%pave_surface(m) )  THEN
     2582             surf%rho_c_total(nzb_soil,m) = pave_heat_capacity
     2583             lambda_temp(nzb_soil)          = pave_heat_conductivity
     2584          ENDIF
     2585
     2586          IF (  .NOT.  surf%water_surface(m) )  THEN
     2587             DO  k = nzb_soil, nzt_soil
     2588
     2589                IF ( surf%pave_surface(m)  .AND.  zs(k) <= pave_depth )  THEN
     2590                   
     2591                   surf%rho_c_total(k,m) = pave_heat_capacity
     2592                   lambda_temp(k)        = pave_heat_conductivity   
     2593
     2594                ELSE           
     2595!
     2596!--                Calculate volumetric heat capacity of the soil, taking
     2597!--                into account water content
     2598                   surf%rho_c_total(k,m) = (rho_c_soil *                 &
     2599                                               ( 1.0_wp - surf%m_sat(m) )&
     2600                                               + rho_c_water * surf_m_soil%var_2d(k,m) )
     2601
     2602!
     2603!--                Calculate soil heat conductivity at the center of the soil
     2604!--                layers
     2605                   lambda_h_sat = lambda_h_sm**(1.0_wp - surf%m_sat(m)) *&
     2606                                  lambda_h_water ** surf_m_soil%var_2d(k,m)
     2607
     2608                   ke = 1.0_wp + LOG10( MAX( 0.1_wp, surf_m_soil%var_2d(k,m) /             &
     2609                                                     surf%m_sat(m) ) )
     2610
     2611                   lambda_temp(k) = ke * (lambda_h_sat - lambda_h_dry) +       &
     2612                                    lambda_h_dry
     2613                ENDIF
     2614             ENDDO
     2615
     2616!
     2617!--          Calculate soil heat conductivity (lambda_h) at the _stag level
     2618!--          using linear interpolation. For pavement surface, the
     2619!--          true pavement depth is considered
     2620             DO  k = nzb_soil, nzt_soil-1
     2621                IF ( surf%pave_surface(m)  .AND.  zs(k)   < pave_depth   &
     2622                                                 .AND.  zs(k+1) > pave_depth )  THEN
     2623                   surf%lambda_h(k,m) = ( pave_depth - zs(k) ) / dz_soil(k+1)&
     2624                                     * lambda_temp(k)                          &
     2625                                     + ( 1.0_wp - ( pave_depth - zs(k) )       &
     2626                                     / dz_soil(k+1) ) * lambda_temp(k+1)
     2627                ELSE
     2628                   surf%lambda_h(k,m) = ( lambda_temp(k+1) + lambda_temp(k) )&
     2629                                     * 0.5_wp
     2630                ENDIF
     2631             ENDDO
     2632             surf%lambda_h(nzt_soil,m) = lambda_temp(nzt_soil)
     2633
     2634!
     2635!--          Prognostic equation for soil temperature t_soil
     2636             tend(:) = 0.0_wp
     2637
     2638             tend(nzb_soil) = ( 1.0_wp / surf%rho_c_total(nzb_soil,m) ) *&
     2639                    ( surf%lambda_h(nzb_soil,m) * ( surf_t_soil%var_2d(nzb_soil+1,m) &
     2640                      - surf_t_soil%var_2d(nzb_soil,m) ) * ddz_soil(nzb_soil+1)            &
     2641                      + surf%ghf_eb(m) ) * ddz_soil_stag(nzb_soil)
     2642
     2643             DO  k = nzb_soil+1, nzt_soil
     2644                tend(k) = ( 1.0_wp / surf%rho_c_total(k,m) )             &
     2645                          * (   surf%lambda_h(k,m)                       &
     2646                              * ( surf_t_soil%var_2d(k+1,m) - surf_t_soil%var_2d(k,m) )                &
     2647                              * ddz_soil(k+1)                                  &
     2648                              - surf%lambda_h(k-1,m)                     &
     2649                              * ( surf_t_soil%var_2d(k,m) - surf_t_soil%var_2d(k-1,m) )                &
     2650                              * ddz_soil(k)                                    &
     2651                            ) * ddz_soil_stag(k)
     2652
     2653             ENDDO
     2654
     2655             surf_t_soil_p%var_2d(nzb_soil:nzt_soil,m) = surf_t_soil%var_2d(nzb_soil:nzt_soil,m)       &
     2656                                               + dt_3d * ( tsc(2)              &
     2657                                               * tend(nzb_soil:nzt_soil)       &
     2658                                               + tsc(3)                        &
     2659                                               * surf_tt_soil_m%var_2d(nzb_soil:nzt_soil,m) )
     2660
     2661!
     2662!--          Calculate t_soil tendencies for the next Runge-Kutta step
     2663             IF ( timestep_scheme(1:5) == 'runge' )  THEN
     2664                IF ( intermediate_timestep_count == 1 )  THEN
     2665                   DO  k = nzb_soil, nzt_soil
     2666                      surf_tt_soil_m%var_2d(k,m) = tend(k)
     2667                   ENDDO
     2668                ELSEIF ( intermediate_timestep_count <                         &
     2669                         intermediate_timestep_count_max )  THEN
     2670                   DO  k = nzb_soil, nzt_soil
     2671                      surf_tt_soil_m%var_2d(k,m) = -9.5625_wp * tend(k) + 5.3125_wp        &
     2672                                         * surf_tt_soil_m%var_2d(k,m)
     2673                   ENDDO
     2674                ENDIF
    21102675             ENDIF
    21112676
    2112              IF (  .NOT.  water_surface(j,i) )  THEN
     2677
     2678             DO  k = nzb_soil, nzt_soil
     2679
     2680!
     2681!--             Calculate soil diffusivity at the center of the soil layers
     2682                lambda_temp(k) = (- b_ch * surf%gamma_w_sat(m) * psi_sat     &
     2683                                  / surf%m_sat(m) ) * ( MAX( surf_m_soil%var_2d(k,m),    &
     2684                                  surf%m_wilt(m) ) / surf%m_sat(m) )**(&
     2685                                                            b_ch + 2.0_wp )
     2686
     2687!
     2688!--             Parametrization of Van Genuchten
     2689                IF ( soil_type /= 7 )  THEN
     2690!
     2691!--                Calculate the hydraulic conductivity after Van Genuchten
     2692!--                (1980)
     2693                   h_vg = ( ( ( surf%m_res(m) - surf%m_sat(m) ) /  &
     2694                              ( surf%m_res(m) -                          &
     2695                                MAX( surf_m_soil%var_2d(k,m), surf%m_wilt(m) )       &
     2696                              )                                                &
     2697                            )**(                                               &
     2698                          surf%n_vg(m) / ( surf%n_vg(m) - 1.0_wp ) &
     2699                               ) - 1.0_wp                                      &
     2700                          )**( 1.0_wp / surf%n_vg(m) ) / surf%alpha_vg(m)
     2701
     2702                   gamma_temp(k) = surf%gamma_w_sat(m) * ( ( ( 1.0_wp +  &
     2703                          ( surf%alpha_vg(m) * h_vg )**surf%n_vg(m)&
     2704                                                               )**(            &
     2705                              1.0_wp - 1.0_wp / surf%n_vg(m)) - (        &
     2706                          surf%alpha_vg(m) * h_vg )**( surf%n_vg(m)&
     2707                              - 1.0_wp) )**2 )                                 &
     2708                              / ( ( 1.0_wp + ( surf%alpha_vg(m) * h_vg   &
     2709                              )**surf%n_vg(m) )**( ( 1.0_wp  - 1.0_wp    &
     2710                              / surf%n_vg(m) ) *                         &
     2711                              ( surf%l_vg(m) + 2.0_wp) ) )
     2712!
     2713!--             Parametrization of Clapp & Hornberger
     2714                ELSE
     2715                   gamma_temp(k) = surf%gamma_w_sat(m) * ( surf_m_soil%var_2d(k,m)   &
     2716                                   / surf%m_sat(m) )**(2.0_wp * b_ch + 3.0_wp)
     2717                ENDIF
     2718
     2719             ENDDO
     2720
     2721!
     2722!--          Prognostic equation for soil moisture content. Only performed,
     2723!--          when humidity is enabled in the atmosphere and the surface type
     2724!--          is not pavement (implies dry soil below).
     2725             IF ( humidity  .AND.  .NOT.  surf%pave_surface(m) )  THEN
     2726!
     2727!--             Calculate soil diffusivity (lambda_w) at the _stag level
     2728!--             using linear interpolation. To do: replace this with
     2729!--             ECMWF-IFS Eq. 8.81
     2730                DO  k = nzb_soil, nzt_soil-1
     2731                   
     2732                   surf%lambda_w(k,m) = ( lambda_temp(k+1) +             &
     2733                                                lambda_temp(k) ) * 0.5_wp
     2734                   surf%gamma_w(k,m)  = ( gamma_temp(k+1)  +             &
     2735                                                gamma_temp(k) )  * 0.5_wp
     2736
     2737                ENDDO
     2738
     2739!
     2740!
     2741!--             In case of a closed bottom (= water content is conserved),
     2742!--             set hydraulic conductivity to zero to that no water will be
     2743!--             lost in the bottom layer.
     2744                IF ( conserve_water_content )  THEN
     2745                   surf%gamma_w(nzt_soil,m) = 0.0_wp
     2746                ELSE
     2747                   surf%gamma_w(nzt_soil,m) = gamma_temp(nzt_soil)
     2748                ENDIF     
     2749
     2750!--             The root extraction (= root_extr * qsws_veg_eb / (rho_l     
     2751!--             * l_v)) ensures the mass conservation for water. The         
     2752!--             transpiration of plants equals the cumulative withdrawals by
     2753!--             the roots in the soil. The scheme takes into account the
     2754!--             availability of water in the soil layers as well as the root
     2755!--             fraction in the respective layer. Layer with moisture below
     2756!--             wilting point will not contribute, which reflects the
     2757!--             preference of plants to take water from moister layers.
     2758!
     2759!--             Calculate the root extraction (ECMWF 7.69, the sum of
     2760!--             root_extr = 1). The energy balance solver guarantees a
     2761!--             positive transpiration, so that there is no need for an
     2762!--             additional check.
     2763                m_total = 0.0_wp
    21132764                DO  k = nzb_soil, nzt_soil
    2114 
    2115 
    2116                    IF ( pave_surface(j,i)  .AND.  zs(k) <= pave_depth )  THEN
    2117                    
    2118                       rho_c_total(k,j,i) = pave_heat_capacity
    2119                       lambda_temp(k)     = pave_heat_conductivity   
    2120 
    2121                    ELSE           
    2122 !
    2123 !--                   Calculate volumetric heat capacity of the soil, taking
    2124 !--                   into account water content
    2125                       rho_c_total(k,j,i) = (rho_c_soil * (1.0_wp - m_sat(j,i)) &
    2126                                            + rho_c_water * m_soil(k,j,i))
    2127 
    2128 !
    2129 !--                   Calculate soil heat conductivity at the center of the soil
    2130 !--                   layers
    2131                       lambda_h_sat = lambda_h_sm ** (1.0_wp - m_sat(j,i)) *    &
    2132                                      lambda_h_water ** m_soil(k,j,i)
    2133 
    2134                       ke = 1.0_wp + LOG10(MAX(0.1_wp,m_soil(k,j,i)             &
    2135                                                      / m_sat(j,i)))
    2136 
    2137                       lambda_temp(k) = ke * (lambda_h_sat - lambda_h_dry) +    &
    2138                                        lambda_h_dry
    2139                    ENDIF
    2140 
     2765                    IF ( surf_m_soil%var_2d(k,m) > surf%m_wilt(m) )  THEN
     2766                       m_total = m_total + surf%root_fr(k,m) * surf_m_soil%var_2d(k,m)
     2767                    ENDIF
     2768                ENDDO 
     2769                 IF ( m_total > 0.0_wp )  THEN
     2770                   DO  k = nzb_soil, nzt_soil
     2771                      IF ( surf_m_soil%var_2d(k,m) > surf%m_wilt(m) )  THEN
     2772                         root_extr(k) = surf%root_fr(k,m) * surf_m_soil%var_2d(k,m)  &
     2773                                                            / m_total
     2774                      ELSE
     2775                         root_extr(k) = 0.0_wp
     2776                      ENDIF
     2777                   ENDDO
     2778                ENDIF
     2779!
     2780!--             Prognostic equation for soil water content m_soil_h.
     2781                tend(:) = 0.0_wp
     2782
     2783                tend(nzb_soil) = ( surf%lambda_w(nzb_soil,m) *   (       &
     2784                         surf_m_soil%var_2d(nzb_soil+1,m) - surf_m_soil%var_2d(nzb_soil,m) )           &
     2785                         * ddz_soil(nzb_soil+1) - surf%gamma_w(nzb_soil,m) - &
     2786                                                     (                         &
     2787                            root_extr(nzb_soil) * surf%qsws_veg_eb(m)    &
     2788                            + surf%qsws_soil_eb(m) ) * drho_l_lv )       &
     2789                            * ddz_soil_stag(nzb_soil)
     2790
     2791                DO  k = nzb_soil+1, nzt_soil-1
     2792                   tend(k) = ( surf%lambda_w(k,m) * ( surf_m_soil%var_2d(k+1,m)      &
     2793                             - surf_m_soil%var_2d(k,m) ) * ddz_soil(k+1)                   &
     2794                             - surf%gamma_w(k,m)                         &
     2795                             - surf%lambda_w(k-1,m) * ( surf_m_soil%var_2d(k,m) -    &
     2796                             surf_m_soil%var_2d(k-1,m)) * ddz_soil(k)                      &
     2797                             + surf%gamma_w(k-1,m) - (root_extr(k)       &
     2798                             * surf%qsws_veg_eb(m) * drho_l_lv)          &
     2799                             ) * ddz_soil_stag(k)
    21412800                ENDDO
    2142 
    2143 !
    2144 !--             Calculate soil heat conductivity (lambda_h) at the _stag level
    2145 !--             using linear interpolation. For pavement surface, the
    2146 !--             true pavement depth is considered
    2147                 DO  k = nzb_soil, nzt_soil-1
    2148                    IF ( pave_surface(j,i)  .AND.  zs(k)   < pave_depth         &
    2149                                            .AND.  zs(k+1) > pave_depth )  THEN
    2150                       lambda_h(k,j,i) = ( pave_depth - zs(k) ) / dz_soil(k+1)  &
    2151                                         * lambda_temp(k)                       &
    2152                                         + ( 1.0_wp - ( pave_depth - zs(k) )    &
    2153                                         / dz_soil(k+1) ) * lambda_temp(k+1)
    2154                    ELSE
    2155                       lambda_h(k,j,i) = ( lambda_temp(k+1) + lambda_temp(k) )  &
    2156                                         * 0.5_wp
    2157                    ENDIF
     2801                tend(nzt_soil) = ( - surf%gamma_w(nzt_soil,m)            &
     2802                                     - surf%lambda_w(nzt_soil-1,m)       &
     2803                                     * ( surf_m_soil%var_2d(nzt_soil,m)                    &
     2804                                     - surf_m_soil%var_2d(nzt_soil-1,m))                   &
     2805                                     * ddz_soil(nzt_soil)                      &
     2806                                     + surf%gamma_w(nzt_soil-1,m) - (    &
     2807                                       root_extr(nzt_soil)                     &
     2808                                     * surf%qsws_veg_eb(m) * drho_l_lv ) &
     2809                                  ) * ddz_soil_stag(nzt_soil)             
     2810
     2811                surf_m_soil_p%var_2d(nzb_soil:nzt_soil,m) = surf_m_soil%var_2d(nzb_soil:nzt_soil,m)    &
     2812                                                + dt_3d * ( tsc(2) * tend(:)   &
     2813                                                + tsc(3) * surf_tm_soil_m%var_2d(:,m) )   
     2814   
     2815!
     2816!--             Account for dry soils (find a better solution here!)
     2817                DO  k = nzb_soil, nzt_soil
     2818                   IF ( surf_m_soil_p%var_2d(k,m) < 0.0_wp )  surf_m_soil_p%var_2d(k,m) = 0.0_wp
    21582819                ENDDO
    2159                 lambda_h(nzt_soil,j,i) = lambda_temp(nzt_soil)
    2160 
    2161 
    2162 
    2163 
    2164 !
    2165 !--             Prognostic equation for soil temperature t_soil
    2166                 tend(:) = 0.0_wp
    2167 
    2168                 tend(nzb_soil) = (1.0_wp/rho_c_total(nzb_soil,j,i)) *          &
    2169                           ( lambda_h(nzb_soil,j,i) * ( t_soil(nzb_soil+1,j,i)  &
    2170                             - t_soil(nzb_soil,j,i) ) * ddz_soil(nzb_soil+1)    &
    2171                             + ghf_eb(j,i) ) * ddz_soil_stag(nzb_soil)
    2172 
    2173                 DO  k = nzb_soil+1, nzt_soil
    2174                    tend(k) = (1.0_wp/rho_c_total(k,j,i))                       &
    2175                              * (   lambda_h(k,j,i)                             &
    2176                                  * ( t_soil(k+1,j,i) - t_soil(k,j,i) )         &
    2177                                  * ddz_soil(k+1)                               &
    2178                                  - lambda_h(k-1,j,i)                           &
    2179                                  * ( t_soil(k,j,i) - t_soil(k-1,j,i) )         &
    2180                                  * ddz_soil(k)                                 &
    2181                                ) * ddz_soil_stag(k)
    2182 
    2183                 ENDDO
    2184 
    2185                 t_soil_p(nzb_soil:nzt_soil,j,i) = t_soil(nzb_soil:nzt_soil,j,i)&
    2186                                                   + dt_3d * ( tsc(2)           &
    2187                                                   * tend(nzb_soil:nzt_soil)    &
    2188                                                   + tsc(3)                     &
    2189                                                   * tt_soil_m(:,j,i) )   
    2190 
    2191 !
    2192 !--             Calculate t_soil tendencies for the next Runge-Kutta step
     2820
     2821!
     2822!--             Calculate m_soil tendencies for the next Runge-Kutta step
    21932823                IF ( timestep_scheme(1:5) == 'runge' )  THEN
    21942824                   IF ( intermediate_timestep_count == 1 )  THEN
    21952825                      DO  k = nzb_soil, nzt_soil
    2196                          tt_soil_m(k,j,i) = tend(k)
     2826                         surf_tm_soil_m%var_2d(k,m) = tend(k)
    21972827                      ENDDO
    21982828                   ELSEIF ( intermediate_timestep_count <                      &
    21992829                            intermediate_timestep_count_max )  THEN
    22002830                      DO  k = nzb_soil, nzt_soil
    2201                          tt_soil_m(k,j,i) = -9.5625_wp * tend(k) + 5.3125_wp   &
    2202                                          * tt_soil_m(k,j,i)
     2831                         surf_tm_soil_m%var_2d(k,m) = -9.5625_wp * tend(k) + 5.3125_wp     &
     2832                                  * surf_tm_soil_m%var_2d(k,m)
    22032833                      ENDDO
    22042834                   ENDIF
    22052835                ENDIF
    2206 
    2207 
    2208                 DO  k = nzb_soil, nzt_soil
    2209 
    2210 !
    2211 !--                Calculate soil diffusivity at the center of the soil layers
    2212                    lambda_temp(k) = (- b_ch * gamma_w_sat(j,i) * psi_sat       &
    2213                                      / m_sat(j,i) ) * ( MAX( m_soil(k,j,i),    &
    2214                                      m_wilt(j,i) ) / m_sat(j,i) )**(           &
    2215                                      b_ch + 2.0_wp )
    2216 
    2217 !
    2218 !--                Parametrization of Van Genuchten
    2219                    IF ( soil_type /= 7 )  THEN
    2220 !
    2221 !--                   Calculate the hydraulic conductivity after Van Genuchten
    2222 !--                   (1980)
    2223                       h_vg = ( ( (m_res(j,i) - m_sat(j,i)) / ( m_res(j,i) -    &
    2224                                  MAX( m_soil(k,j,i), m_wilt(j,i) ) ) )**(      &
    2225                                  n_vg(j,i) / (n_vg(j,i) - 1.0_wp ) ) - 1.0_wp  &
    2226                              )**( 1.0_wp / n_vg(j,i) ) / alpha_vg(j,i)
    2227 
    2228 
    2229                       gamma_temp(k) = gamma_w_sat(j,i) * ( ( (1.0_wp +         &
    2230                                       ( alpha_vg(j,i) * h_vg )**n_vg(j,i))**(  &
    2231                                       1.0_wp - 1.0_wp / n_vg(j,i) ) - (        &
    2232                                       alpha_vg(j,i) * h_vg )**( n_vg(j,i)      &
    2233                                       - 1.0_wp) )**2 )                         &
    2234                                       / ( ( 1.0_wp + ( alpha_vg(j,i) * h_vg    &
    2235                                       )**n_vg(j,i) )**( ( 1.0_wp  - 1.0_wp     &
    2236                                       / n_vg(j,i) ) *( l_vg(j,i) + 2.0_wp) ) )
    2237 
    2238 !
    2239 !--                Parametrization of Clapp & Hornberger
    2240                    ELSE
    2241                       gamma_temp(k) = gamma_w_sat(j,i) * ( m_soil(k,j,i)       &
    2242                                       / m_sat(j,i) )**(2.0_wp * b_ch + 3.0_wp)
    2243                    ENDIF
    2244 
    2245                 ENDDO
    2246 
    2247 !
    2248 !--             Prognostic equation for soil moisture content. Only performed,
    2249 !--             when humidity is enabled in the atmosphere and the surface type
    2250 !--             is not pavement (implies dry soil below).
    2251                 IF ( humidity  .AND.  .NOT.  pave_surface(j,i) )  THEN
    2252 !
    2253 !--                Calculate soil diffusivity (lambda_w) at the _stag level
    2254 !--                using linear interpolation. To do: replace this with
    2255 !--                ECMWF-IFS Eq. 8.81
    2256                    DO  k = nzb_soil, nzt_soil-1
    2257                      
    2258                       lambda_w(k,j,i) = ( lambda_temp(k+1) + lambda_temp(k) )  &
    2259                                         * 0.5_wp
    2260                       gamma_w(k,j,i)  = ( gamma_temp(k+1) + gamma_temp(k) )    &
    2261                                         * 0.5_wp
    2262 
    2263                    ENDDO
    2264 
    2265 !
    2266 !
    2267 !--                In case of a closed bottom (= water content is conserved),
    2268 !--                set hydraulic conductivity to zero to that no water will be
    2269 !--                lost in the bottom layer.
    2270                    IF ( conserve_water_content )  THEN
    2271                       gamma_w(nzt_soil,j,i) = 0.0_wp
    2272                    ELSE
    2273                       gamma_w(nzt_soil,j,i) = gamma_temp(nzt_soil)
    2274                    ENDIF     
    2275 
    2276 !--                The root extraction (= root_extr * qsws_veg_eb / (rho_l     
    2277 !--                * l_v)) ensures the mass conservation for water. The         
    2278 !--                transpiration of plants equals the cumulative withdrawals by
    2279 !--                the roots in the soil. The scheme takes into account the
    2280 !--                availability of water in the soil layers as well as the root
    2281 !--                fraction in the respective layer. Layer with moisture below
    2282 !--                wilting point will not contribute, which reflects the
    2283 !--                preference of plants to take water from moister layers.
    2284 
    2285 !
    2286 !--                Calculate the root extraction (ECMWF 7.69, the sum of
    2287 !--                root_extr = 1). The energy balance solver guarantees a
    2288 !--                positive transpiration, so that there is no need for an
    2289 !--                additional check.
    2290                    m_total = 0.0_wp
    2291                    DO  k = nzb_soil, nzt_soil
    2292                        IF ( m_soil(k,j,i) > m_wilt(j,i) )  THEN
    2293                           m_total = m_total + root_fr(k,j,i) * m_soil(k,j,i)
    2294                        ENDIF
    2295                    ENDDO 
    2296 
    2297                    IF ( m_total > 0.0_wp )  THEN
    2298                       DO  k = nzb_soil, nzt_soil
    2299                          IF ( m_soil(k,j,i) > m_wilt(j,i) )  THEN
    2300                             root_extr(k) = root_fr(k,j,i) * m_soil(k,j,i)      &
    2301                                                             / m_total
    2302                          ELSE
    2303                             root_extr(k) = 0.0_wp
    2304                          ENDIF
    2305                       ENDDO
    2306                    ENDIF
    2307 
    2308 !
    2309 !--                Prognostic equation for soil water content m_soil.
    2310                    tend(:) = 0.0_wp
    2311 
    2312                    tend(nzb_soil) = ( lambda_w(nzb_soil,j,i) * (               &
    2313                             m_soil(nzb_soil+1,j,i) - m_soil(nzb_soil,j,i) )    &
    2314                             * ddz_soil(nzb_soil+1) - gamma_w(nzb_soil,j,i) - ( &
    2315                                root_extr(nzb_soil) * qsws_veg_eb(j,i)          &
    2316                                + qsws_soil_eb(j,i) ) * drho_l_lv )             &
    2317                                * ddz_soil_stag(nzb_soil)
    2318 
    2319                    DO  k = nzb_soil+1, nzt_soil-1
    2320                       tend(k) = ( lambda_w(k,j,i) * ( m_soil(k+1,j,i)          &
    2321                                 - m_soil(k,j,i) ) * ddz_soil(k+1)              &
    2322                                 - gamma_w(k,j,i)                               &
    2323                                 - lambda_w(k-1,j,i) * (m_soil(k,j,i) -         &
    2324                                 m_soil(k-1,j,i)) * ddz_soil(k)                 &
    2325                                 + gamma_w(k-1,j,i) - (root_extr(k)             &
    2326                                 * qsws_veg_eb(j,i) * drho_l_lv)                &
    2327                                 ) * ddz_soil_stag(k)
    2328 
    2329                    ENDDO
    2330                    tend(nzt_soil) = ( - gamma_w(nzt_soil,j,i)                  &
    2331                                            - lambda_w(nzt_soil-1,j,i)          &
    2332                                            * (m_soil(nzt_soil,j,i)             &
    2333                                            - m_soil(nzt_soil-1,j,i))           &
    2334                                            * ddz_soil(nzt_soil)                &
    2335                                            + gamma_w(nzt_soil-1,j,i) - (       &
    2336                                              root_extr(nzt_soil)               &
    2337                                            * qsws_veg_eb(j,i) * drho_l_lv  )   &
    2338                                      ) * ddz_soil_stag(nzt_soil)             
    2339 
    2340                    m_soil_p(nzb_soil:nzt_soil,j,i) = m_soil(nzb_soil:nzt_soil,j,i)&
    2341                                                    + dt_3d * ( tsc(2) * tend(:)   &
    2342                                                    + tsc(3) * tm_soil_m(:,j,i) )   
    2343    
    2344 !
    2345 !--                Account for dry soils (find a better solution here!)
    2346                    DO  k = nzb_soil, nzt_soil
    2347                       IF ( m_soil_p(k,j,i) < 0.0_wp )  m_soil_p(k,j,i) = 0.0_wp
    2348                    ENDDO
    2349 
    2350 !
    2351 !--                Calculate m_soil tendencies for the next Runge-Kutta step
    2352                    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2353                       IF ( intermediate_timestep_count == 1 )  THEN
    2354                          DO  k = nzb_soil, nzt_soil
    2355                             tm_soil_m(k,j,i) = tend(k)
    2356                          ENDDO
    2357                       ELSEIF ( intermediate_timestep_count <                   &
    2358                                intermediate_timestep_count_max )  THEN
    2359                          DO  k = nzb_soil, nzt_soil
    2360                             tm_soil_m(k,j,i) = -9.5625_wp * tend(k) + 5.3125_wp&
    2361                                      * tm_soil_m(k,j,i)
    2362                          ENDDO
    2363                       ENDIF
    2364                    ENDIF
    2365 
    2366                 ENDIF
    2367 
    23682836             ENDIF
    23692837
    2370           ENDDO
     2838          ENDIF
     2839
    23712840       ENDDO
    23722841
    … …  
    23862855
    23872856#if defined( __nopointer )
    2388 
    2389        t_surface    = t_surface_p
    2390        t_soil       = t_soil_p
     2857!
     2858!--    Horizontal surfaces
     2859       t_surface_h  = t_surface_h_p
     2860       t_soil_h     = t_soil_h_p
    23912861       IF ( humidity )  THEN
    2392           m_soil    = m_soil_p
    2393           m_liq_eb  = m_liq_eb_p
     2862          m_soil_h    = m_soil_h_p
     2863          m_liq_eb_h  = m_liq_eb_h_p
     2864       ENDIF
     2865!
     2866!--    Vertical surfaces
     2867       t_surface_v  = t_surface_v_p
     2868       t_soil_v     = t_soil_v_p
     2869       IF ( humidity )  THEN
     2870          m_soil_v    = m_soil_v_p
     2871          m_liq_eb_v  = m_liq_eb_v_p
    23942872       ENDIF
    23952873
    … …  
    23992877
    24002878          CASE ( 0 )
    2401 
    2402              t_surface  => t_surface_1; t_surface_p  => t_surface_2
    2403              t_soil     => t_soil_1;    t_soil_p     => t_soil_2
     2879!
     2880!--          Horizontal surfaces
     2881             t_surface_h  => t_surface_h_1; t_surface_h_p  => t_surface_h_2
     2882             t_soil_h     => t_soil_h_1;    t_soil_h_p     => t_soil_h_2
    24042883             IF ( humidity )  THEN
    2405                 m_soil    => m_soil_1;   m_soil_p    => m_soil_2
    2406                 m_liq_eb  => m_liq_eb_1; m_liq_eb_p  => m_liq_eb_2
     2884                m_soil_h    => m_soil_h_1;   m_soil_h_p    => m_soil_h_2
     2885                m_liq_eb_h  => m_liq_eb_h_1; m_liq_eb_h_p  => m_liq_eb_h_2
    24072886             ENDIF
     2887!
     2888!--          Vertical surfaces
     2889             t_surface_v  => t_surface_v_1; t_surface_v_p  => t_surface_v_2
     2890             t_soil_v     => t_soil_v_1;    t_soil_v_p     => t_soil_v_2
     2891             IF ( humidity )  THEN
     2892                m_soil_v    => m_soil_v_1;   m_soil_v_p    => m_soil_v_2
     2893                m_liq_eb_v  => m_liq_eb_v_1; m_liq_eb_v_p  => m_liq_eb_v_2
     2894             ENDIF
     2895
    24082896
    24092897
    24102898          CASE ( 1 )
    2411 
    2412              t_surface  => t_surface_2; t_surface_p  => t_surface_1
    2413              t_soil     => t_soil_2;    t_soil_p     => t_soil_1
     2899!
     2900!--          Horizontal surfaces
     2901             t_surface_h  => t_surface_h_2; t_surface_h_p  => t_surface_h_1
     2902             t_soil_h     => t_soil_h_2;    t_soil_h_p     => t_soil_h_1
    24142903             IF ( humidity )  THEN
    2415                 m_soil    => m_soil_2;   m_soil_p    => m_soil_1
    2416                 m_liq_eb  => m_liq_eb_2; m_liq_eb_p  => m_liq_eb_1
     2904                m_soil_h    => m_soil_h_2;   m_soil_h_p    => m_soil_h_1
     2905                m_liq_eb_h  => m_liq_eb_h_2; m_liq_eb_h_p  => m_liq_eb_h_1
     2906             ENDIF
     2907!
     2908!--          Vertical surfaces
     2909             t_surface_v  => t_surface_v_2; t_surface_v_p  => t_surface_v_1
     2910             t_soil_v     => t_soil_v_2;    t_soil_v_p     => t_soil_v_1
     2911             IF ( humidity )  THEN
     2912                m_soil_v    => m_soil_v_2;   m_soil_v_p    => m_soil_v_1
     2913                m_liq_eb_v  => m_liq_eb_v_2; m_liq_eb_v_p  => m_liq_eb_v_1
    24172914             ENDIF
    24182915
    … …  
    24452942    CHARACTER (LEN=*) :: variable !<
    24462943
    2447     INTEGER(iwp) ::  i !<
    2448     INTEGER(iwp) ::  j !<
    2449     INTEGER(iwp) ::  k !<
     2944    INTEGER(iwp) ::  i       !<
     2945    INTEGER(iwp) ::  j       !<
     2946    INTEGER(iwp) ::  k       !<
     2947    INTEGER(iwp) ::  m       !< running index
    24502948
    24512949    IF ( mode == 'allocate' )  THEN
    … …  
    25533051
    25543052          CASE ( 'c_liq*' )
    2555              DO  i = nxlg, nxrg
    2556                 DO  j = nysg, nyng
    2557                    c_liq_av(j,i) = c_liq_av(j,i) + c_liq(j,i)
     3053             DO  m = 1, surf_lsm_h%ns
     3054                i   = surf_lsm_h%i(m)           
     3055                j   = surf_lsm_h%j(m)
     3056                c_liq_av(j,i) = c_liq_av(j,i) + surf_lsm_h%c_liq(m)
     3057             ENDDO
     3058
     3059          CASE ( 'c_soil*' )
     3060             DO  m = 1, surf_lsm_h%ns
     3061                i   = surf_lsm_h%i(m)           
     3062                j   = surf_lsm_h%j(m)
     3063                c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - surf_lsm_h%c_veg(m))
     3064             ENDDO
     3065
     3066          CASE ( 'c_veg*' )
     3067             DO  m = 1, surf_lsm_h%ns
     3068                i   = surf_lsm_h%i(m)           
     3069                j   = surf_lsm_h%j(m)
     3070                c_veg_av(j,i) = c_veg_av(j,i) + surf_lsm_h%c_veg(m)
     3071             ENDDO
     3072
     3073          CASE ( 'ghf_eb*' )
     3074             DO  m = 1, surf_lsm_h%ns
     3075                i   = surf_lsm_h%i(m)           
     3076                j   = surf_lsm_h%j(m)
     3077                ghf_eb_av(j,i) = ghf_eb_av(j,i) + surf_lsm_h%ghf_eb(m)
     3078             ENDDO
     3079
     3080          CASE ( 'lai*' )
     3081             DO  m = 1, surf_lsm_h%ns
     3082                i   = surf_lsm_h%i(m)           
     3083                j   = surf_lsm_h%j(m)
     3084                lai_av(j,i) = lai_av(j,i) + surf_lsm_h%lai(m)
     3085             ENDDO
     3086
     3087          CASE ( 'm_liq_eb*' )
     3088             DO  m = 1, surf_lsm_h%ns
     3089                i   = surf_lsm_h%i(m)           
     3090                j   = surf_lsm_h%j(m)
     3091                m_liq_eb_av(j,i) = m_liq_eb_av(j,i) + m_liq_eb_h%var_1d(m)
     3092             ENDDO
     3093
     3094          CASE ( 'm_soil' )
     3095             DO  m = 1, surf_lsm_h%ns
     3096                i   = surf_lsm_h%i(m)           
     3097                j   = surf_lsm_h%j(m)
     3098                DO  k = nzb_soil, nzt_soil
     3099                   m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil_h%var_2d(k,m)
    25583100                ENDDO
    25593101             ENDDO
    25603102
    2561           CASE ( 'c_soil*' )
    2562              DO  i = nxlg, nxrg
    2563                 DO  j = nysg, nyng
    2564                    c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - c_veg(j,i))
    2565                 ENDDO
    2566              ENDDO
    2567 
    2568           CASE ( 'c_veg*' )
    2569              DO  i = nxlg, nxrg
    2570                 DO  j = nysg, nyng
    2571                    c_veg_av(j,i) = c_veg_av(j,i) + c_veg(j,i)
    2572                 ENDDO
    2573              ENDDO
    2574 
    2575           CASE ( 'ghf_eb*' )
    2576              DO  i = nxlg, nxrg
    2577                 DO  j = nysg, nyng
    2578                    ghf_eb_av(j,i) = ghf_eb_av(j,i) + ghf_eb(j,i)
    2579                 ENDDO
    2580              ENDDO
    2581 
    2582           CASE ( 'lai*' )
    2583              DO  i = nxlg, nxrg
    2584                 DO  j = nysg, nyng
    2585                    lai_av(j,i) = lai_av(j,i) + lai(j,i)
    2586                 ENDDO
    2587              ENDDO
    2588 
    2589           CASE ( 'm_liq_eb*' )
    2590              DO  i = nxlg, nxrg
    2591                 DO  j = nysg, nyng
    2592                    m_liq_eb_av(j,i) = m_liq_eb_av(j,i) + m_liq_eb(j,i)
    2593                 ENDDO
    2594              ENDDO
    2595 
    2596           CASE ( 'm_soil' )
    2597              DO  i = nxlg, nxrg
    2598                 DO  j = nysg, nyng
    2599                    DO  k = nzb_soil, nzt_soil
    2600                       m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil(k,j,i)
    2601                    ENDDO
    2602                 ENDDO
    2603              ENDDO
    2604 
    26053103          CASE ( 'qsws_eb*' )
    2606              DO  i = nxlg, nxrg
    2607                 DO  j = nysg, nyng
    2608                    qsws_eb_av(j,i) = qsws_eb_av(j,i) + qsws_eb(j,i)
    2609                 ENDDO
     3104             DO  m = 1, surf_lsm_h%ns
     3105                i   = surf_lsm_h%i(m)           
     3106                j   = surf_lsm_h%j(m)
     3107                qsws_eb_av(j,i) = qsws_eb_av(j,i) + surf_lsm_h%qsws_eb(m)
    26103108             ENDDO
    26113109
    26123110          CASE ( 'qsws_liq_eb*' )
    2613              DO  i = nxlg, nxrg
    2614                 DO  j = nysg, nyng
    2615                    qsws_liq_eb_av(j,i) = qsws_liq_eb_av(j,i) + qsws_liq_eb(j,i)
    2616                 ENDDO
     3111             DO  m = 1, surf_lsm_h%ns
     3112                i   = surf_lsm_h%i(m)           
     3113                j   = surf_lsm_h%j(m)
     3114                qsws_liq_eb_av(j,i) = qsws_liq_eb_av(j,i) +                    &
     3115                                      surf_lsm_h%qsws_liq_eb(m)
    26173116             ENDDO
    26183117
    26193118          CASE ( 'qsws_soil_eb*' )
    2620              DO  i = nxlg, nxrg
    2621                 DO  j = nysg, nyng
    2622                    qsws_soil_eb_av(j,i) = qsws_soil_eb_av(j,i) + qsws_soil_eb(j,i)
    2623                 ENDDO
     3119             DO  m = 1, surf_lsm_h%ns
     3120                i   = surf_lsm_h%i(m)           
     3121                j   = surf_lsm_h%j(m)
     3122                qsws_soil_eb_av(j,i) = qsws_soil_eb_av(j,i) +                  &
     3123                                       surf_lsm_h%qsws_soil_eb(m)
    26243124             ENDDO
    26253125
    26263126          CASE ( 'qsws_veg_eb*' )
    2627              DO  i = nxlg, nxrg
    2628                 DO  j = nysg, nyng
    2629                    qsws_veg_eb_av(j,i) = qsws_veg_eb_av(j,i) + qsws_veg_eb(j,i)
    2630                 ENDDO
     3127             DO  m = 1, surf_lsm_h%ns
     3128                i   = surf_lsm_h%i(m)           
     3129                j   = surf_lsm_h%j(m)
     3130                qsws_veg_eb_av(j,i) = qsws_veg_eb_av(j,i) +                    &
     3131                                      surf_lsm_h%qsws_veg_eb(m)
    26313132             ENDDO
    26323133
    26333134          CASE ( 'r_a*' )
    2634              DO  i = nxlg, nxrg
    2635                 DO  j = nysg, nyng
    2636                    r_a_av(j,i) = r_a_av(j,i) + r_a(j,i)
    2637                 ENDDO
     3135             DO  m = 1, surf_lsm_h%ns
     3136                i   = surf_lsm_h%i(m)           
     3137                j   = surf_lsm_h%j(m)
     3138                r_a_av(j,i) = r_a_av(j,i) + surf_lsm_h%r_a(m)
    26383139             ENDDO
    26393140
    26403141          CASE ( 'r_s*' )
    2641              DO  i = nxlg, nxrg
    2642                 DO  j = nysg, nyng
    2643                    r_s_av(j,i) = r_s_av(j,i) + r_s(j,i)
    2644                 ENDDO
     3142             DO  m = 1, surf_lsm_h%ns
     3143                i   = surf_lsm_h%i(m)           
     3144                j   = surf_lsm_h%j(m)
     3145                r_s_av(j,i) = r_s_av(j,i) + surf_lsm_h%r_s(m)
    26453146             ENDDO
    26463147
    26473148          CASE ( 'shf_eb*' )
    2648              DO  i = nxlg, nxrg
    2649                 DO  j = nysg, nyng
    2650                    shf_eb_av(j,i) = shf_eb_av(j,i) + shf_eb(j,i)
    2651                 ENDDO
     3149             DO  m = 1, surf_lsm_h%ns
     3150                i   = surf_lsm_h%i(m)           
     3151                j   = surf_lsm_h%j(m)
     3152                shf_eb_av(j,i) = shf_eb_av(j,i) + surf_lsm_h%shf_eb(m)
    26523153             ENDDO
    26533154
    26543155          CASE ( 't_soil' )
    2655              DO  i = nxlg, nxrg
    2656                 DO  j = nysg, nyng
    2657                    DO  k = nzb_soil, nzt_soil
    2658                       t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil(k,j,i)
    2659                    ENDDO
     3156             DO  m = 1, surf_lsm_h%ns
     3157                i   = surf_lsm_h%i(m)           
     3158                j   = surf_lsm_h%j(m)
     3159                DO  k = nzb_soil, nzt_soil
     3160                   t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil_h%var_2d(k,m)
    26603161                ENDDO
    26613162             ENDDO
    … …  
    26713172
    26723173          CASE ( 'c_liq*' )
    2673              DO  i = nxlg, nxrg
    2674                 DO  j = nysg, nyng
     3174             DO  i = nxl, nxr
     3175                DO  j = nys, nyn
    26753176                   c_liq_av(j,i) = c_liq_av(j,i) / REAL( average_count_3d, KIND=wp )
    26763177                ENDDO
    … …  
    26783179
    26793180          CASE ( 'c_soil*' )
    2680              DO  i = nxlg, nxrg
    2681                 DO  j = nysg, nyng
     3181             DO  i = nxl, nxr
     3182                DO  j = nys, nyn
    26823183                   c_soil_av(j,i) = c_soil_av(j,i) / REAL( average_count_3d, KIND=wp )
    26833184                ENDDO
    … …  
    26853186
    26863187          CASE ( 'c_veg*' )
    2687              DO  i = nxlg, nxrg
    2688                 DO  j = nysg, nyng
     3188             DO  i = nxl, nxr
     3189                DO  j = nys, nyn
    26893190                   c_veg_av(j,i) = c_veg_av(j,i) / REAL( average_count_3d, KIND=wp )
    26903191                ENDDO
    … …  
    26923193
    26933194          CASE ( 'ghf_eb*' )
    2694              DO  i = nxlg, nxrg
    2695                 DO  j = nysg, nyng
     3195             DO  i = nxl, nxr
     3196                DO  j = nys, nyn
    26963197                   ghf_eb_av(j,i) = ghf_eb_av(j,i) / REAL( average_count_3d, KIND=wp )
    26973198                ENDDO
    … …  
    26993200
    27003201         CASE ( 'lai*' )
    2701              DO  i = nxlg, nxrg
    2702                 DO  j = nysg, nyng
     3202             DO  i = nxl, nxr
     3203                DO  j = nys, nyn
    27033204                   lai_av(j,i) = lai_av(j,i) / REAL( average_count_3d, KIND=wp )
    27043205                ENDDO
    … …  
    27063207
    27073208          CASE ( 'm_liq_eb*' )
    2708              DO  i = nxlg, nxrg
    2709                 DO  j = nysg, nyng
     3209             DO  i = nxl, nxr
     3210                DO  j = nys, nyn
    27103211                   m_liq_eb_av(j,i) = m_liq_eb_av(j,i) / REAL( average_count_3d, KIND=wp )
    27113212                ENDDO
    … …  
    27133214
    27143215          CASE ( 'm_soil' )
    2715              DO  i = nxlg, nxrg
    2716                 DO  j = nysg, nyng
     3216             DO  i = nxl, nxr
     3217                DO  j = nys, nyn
    27173218                   DO  k = nzb_soil, nzt_soil
    27183219                      m_soil_av(k,j,i) = m_soil_av(k,j,i) / REAL( average_count_3d, KIND=wp )
    … …  
    27223223
    27233224          CASE ( 'qsws_eb*' )
    2724              DO  i = nxlg, nxrg
    2725                 DO  j = nysg, nyng
     3225             DO  i = nxl, nxr
     3226                DO  j = nys, nyn
    27263227                   qsws_eb_av(j,i) = qsws_eb_av(j,i) / REAL( average_count_3d, KIND=wp )
    27273228                ENDDO
    … …  
    27293230
    27303231          CASE ( 'qsws_liq_eb*' )
    2731              DO  i = nxlg, nxrg
    2732                 DO  j = nysg, nyng
     3232             DO  i = nxl, nxr
     3233                DO  j = nys, nyn
    27333234                   qsws_liq_eb_av(j,i) = qsws_liq_eb_av(j,i) / REAL( average_count_3d, KIND=wp )
    27343235                ENDDO
    … …  
    27363237
    27373238          CASE ( 'qsws_soil_eb*' )
    2738              DO  i = nxlg, nxrg
    2739                 DO  j = nysg, nyng
     3239             DO  i = nxl, nxr
     3240                DO  j = nys, nyn
    27403241                   qsws_soil_eb_av(j,i) = qsws_soil_eb_av(j,i) / REAL( average_count_3d, KIND=wp )
    27413242                ENDDO
    … …  
    27433244
    27443245          CASE ( 'qsws_veg_eb*' )
    2745              DO  i = nxlg, nxrg
    2746                 DO  j = nysg, nyng
     3246             DO  i = nxl, nxr
     3247                DO  j = nys, nyn
    27473248                   qsws_veg_eb_av(j,i) = qsws_veg_eb_av(j,i) / REAL( average_count_3d, KIND=wp )
    27483249                ENDDO
    … …  
    27503251
    27513252          CASE ( 'r_a*' )
    2752              DO  i = nxlg, nxrg
    2753                 DO  j = nysg, nyng
     3253             DO  i = nxl, nxr
     3254                DO  j = nys, nyn
    27543255                   r_a_av(j,i) = r_a_av(j,i) / REAL( average_count_3d, KIND=wp )
    27553256                ENDDO
    … …  
    27573258
    27583259          CASE ( 'r_s*' )
    2759              DO  i = nxlg, nxrg
    2760                 DO  j = nysg, nyng
     3260             DO  i = nxl, nxr
     3261                DO  j = nys, nyn
    27613262                   r_s_av(j,i) = r_s_av(j,i) / REAL( average_count_3d, KIND=wp )
    27623263                ENDDO
    … …  
    27643265
    27653266          CASE ( 't_soil' )
    2766              DO  i = nxlg, nxrg
    2767                 DO  j = nysg, nyng
     3267             DO  i = nxl, nxr
     3268                DO  j = nys, nyn
    27683269                   DO  k = nzb_soil, nzt_soil
    27693270                      t_soil_av(k,j,i) = t_soil_av(k,j,i) / REAL( average_count_3d, KIND=wp )
    … …  
    27713272                ENDDO
    27723273             ENDDO
     3274!
     3275!--
    27733276
    27743277       END SELECT
    … …  
    28373340    CHARACTER (LEN=*) ::  variable !<
    28383341
    2839     INTEGER(iwp) ::  av !<
    2840     INTEGER(iwp) ::  i  !<
    2841     INTEGER(iwp) ::  j  !<
    2842     INTEGER(iwp) ::  k  !<
     3342    INTEGER(iwp) ::  av      !<
     3343    INTEGER(iwp) ::  i       !< running index
     3344    INTEGER(iwp) ::  j       !< running index
     3345    INTEGER(iwp) ::  k       !< running index
     3346    INTEGER(iwp) ::  m       !< running index
    28433347    INTEGER(iwp) ::  nzb_do  !<
    28443348    INTEGER(iwp) ::  nzt_do  !<
    … …  
    28493353    REAL(wp), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nzt+1) ::  local_pf !<
    28503354
     3355
    28513356    found = .TRUE.
    28523357
    28533358    SELECT CASE ( TRIM( variable ) )
    2854 
    2855 
     3359!
     3360!--    Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein.
     3361!--    However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged.
    28563362       CASE ( 'c_liq*_xy' )        ! 2d-array
    28573363          IF ( av == 0 )  THEN
    2858              DO  i = nxlg, nxrg
    2859                 DO  j = nysg, nyng
    2860                    local_pf(i,j,nzb+1) = c_liq(j,i) * c_veg(j,i)
    2861                 ENDDO
     3364             DO  m = 1, surf_lsm_h%ns
     3365                i                   = surf_lsm_h%i(m)           
     3366                j                   = surf_lsm_h%j(m)
     3367                local_pf(i,j,nzb+1) = surf_lsm_h%c_liq(m) * surf_lsm_h%c_veg(m)
    28623368             ENDDO
    28633369          ELSE
    … …  
    28743380       CASE ( 'c_soil*_xy' )        ! 2d-array
    28753381          IF ( av == 0 )  THEN
    2876              DO  i = nxlg, nxrg
    2877                 DO  j = nysg, nyng
    2878                    local_pf(i,j,nzb+1) = 1.0_wp - c_veg(j,i)
    2879                 ENDDO
     3382             DO  m = 1, surf_lsm_h%ns
     3383                i                   = surf_lsm_h%i(m)           
     3384                j                   = surf_lsm_h%j(m)
     3385                local_pf(i,j,nzb+1) = 1.0_wp - surf_lsm_h%c_veg(m)
    28803386             ENDDO
    28813387          ELSE
    … …  
    28923398       CASE ( 'c_veg*_xy' )        ! 2d-array
    28933399          IF ( av == 0 )  THEN
    2894              DO  i = nxlg, nxrg
    2895                 DO  j = nysg, nyng
    2896                    local_pf(i,j,nzb+1) = c_veg(j,i)
    2897                 ENDDO
     3400             DO  m = 1, surf_lsm_h%ns
     3401                i                   = surf_lsm_h%i(m)           
     3402                j                   = surf_lsm_h%j(m)
     3403                local_pf(i,j,nzb+1) = surf_lsm_h%c_veg(m)
    28983404             ENDDO
    28993405          ELSE
    … …  
    29103416       CASE ( 'ghf_eb*_xy' )        ! 2d-array
    29113417          IF ( av == 0 )  THEN
    2912              DO  i = nxlg, nxrg
    2913                 DO  j = nysg, nyng
    2914                    local_pf(i,j,nzb+1) = ghf_eb(j,i)
    2915                 ENDDO
     3418             DO  m = 1, surf_lsm_h%ns
     3419                i                   = surf_lsm_h%i(m)           
     3420                j                   = surf_lsm_h%j(m)
     3421                local_pf(i,j,nzb+1) = surf_lsm_h%ghf_eb(m)
    29163422             ENDDO
    29173423          ELSE
    … …  
    29283434       CASE ( 'lai*_xy' )        ! 2d-array
    29293435          IF ( av == 0 )  THEN
    2930              DO  i = nxlg, nxrg
    2931                 DO  j = nysg, nyng
    2932                    local_pf(i,j,nzb+1) = lai(j,i)
    2933                 ENDDO
     3436             DO  m = 1, surf_lsm_h%ns
     3437                i                   = surf_lsm_h%i(m)           
     3438                j                   = surf_lsm_h%j(m)
     3439                local_pf(i,j,nzb+1) = surf_lsm_h%lai(m)
    29343440             ENDDO
    29353441          ELSE
    … …  
    29463452       CASE ( 'm_liq_eb*_xy' )        ! 2d-array
    29473453          IF ( av == 0 )  THEN
    2948              DO  i = nxlg, nxrg
    2949                 DO  j = nysg, nyng
    2950                    local_pf(i,j,nzb+1) = m_liq_eb(j,i)
    2951                 ENDDO
     3454             DO  m = 1, surf_lsm_h%ns
     3455                i                   = surf_lsm_h%i(m)           
     3456                j                   = surf_lsm_h%j(m)
     3457                local_pf(i,j,nzb+1) = m_liq_eb_h%var_1d(m)
    29523458             ENDDO
    29533459          ELSE
    … …  
    29643470       CASE ( 'm_soil_xy', 'm_soil_xz', 'm_soil_yz' )
    29653471          IF ( av == 0 )  THEN
    2966              DO  i = nxlg, nxrg
    2967                 DO  j = nysg, nyng
    2968                    DO k = nzb_soil, nzt_soil
    2969                       local_pf(i,j,k) = m_soil(k,j,i)
    2970                    ENDDO
     3472             DO  m = 1, surf_lsm_h%ns
     3473                i   = surf_lsm_h%i(m)           
     3474                j   = surf_lsm_h%j(m)
     3475                DO k = nzb_soil, nzt_soil
     3476                   local_pf(i,j,k) = m_soil_h%var_2d(k,m)
    29713477                ENDDO
    29723478             ENDDO
    … …  
    29883494       CASE ( 'qsws_eb*_xy' )        ! 2d-array
    29893495          IF ( av == 0 ) THEN
    2990              DO  i = nxlg, nxrg
    2991                 DO  j = nysg, nyng
    2992                    local_pf(i,j,nzb+1) =  qsws_eb(j,i)
    2993                 ENDDO
     3496             DO  m = 1, surf_lsm_h%ns
     3497                i                   = surf_lsm_h%i(m)           
     3498                j                   = surf_lsm_h%j(m)
     3499                local_pf(i,j,nzb+1) =  surf_lsm_h%qsws_eb(m)
    29943500             ENDDO
    29953501          ELSE
    … …  
    30063512       CASE ( 'qsws_liq_eb*_xy' )        ! 2d-array
    30073513          IF ( av == 0 ) THEN
    3008              DO  i = nxlg, nxrg
    3009                 DO  j = nysg, nyng
    3010                    local_pf(i,j,nzb+1) =  qsws_liq_eb(j,i)
    3011                 ENDDO
     3514             DO  m = 1, surf_lsm_h%ns
     3515                i                   = surf_lsm_h%i(m)           
     3516                j                   = surf_lsm_h%j(m)
     3517                local_pf(i,j,nzb+1) = surf_lsm_h%qsws_liq_eb(m)
    30123518             ENDDO
    30133519          ELSE
    … …  
    30243530       CASE ( 'qsws_soil_eb*_xy' )        ! 2d-array
    30253531          IF ( av == 0 ) THEN
    3026              DO  i = nxlg, nxrg
    3027                 DO  j = nysg, nyng
    3028                    local_pf(i,j,nzb+1) =  qsws_soil_eb(j,i)
    3029                 ENDDO
     3532             DO  m = 1, surf_lsm_h%ns
     3533                i                   = surf_lsm_h%i(m)           
     3534                j                   = surf_lsm_h%j(m)
     3535                local_pf(i,j,nzb+1) =  surf_lsm_h%qsws_soil_eb(m)
    30303536             ENDDO
    30313537          ELSE
    … …  
    30423548       CASE ( 'qsws_veg_eb*_xy' )        ! 2d-array
    30433549          IF ( av == 0 ) THEN
    3044              DO  i = nxlg, nxrg
    3045                 DO  j = nysg, nyng
    3046                    local_pf(i,j,nzb+1) =  qsws_veg_eb(j,i)
    3047                 ENDDO
     3550             DO  m = 1, surf_lsm_h%ns
     3551                i                   = surf_lsm_h%i(m)           
     3552                j                   = surf_lsm_h%j(m)
     3553                local_pf(i,j,nzb+1) =  surf_lsm_h%qsws_veg_eb(m)
    30483554             ENDDO
    30493555          ELSE
    … …  
    30613567       CASE ( 'r_a*_xy' )        ! 2d-array
    30623568          IF ( av == 0 )  THEN
    3063              DO  i = nxlg, nxrg
    3064                 DO  j = nysg, nyng
    3065                    local_pf(i,j,nzb+1) = r_a(j,i)
    3066                 ENDDO
     3569             DO  m = 1, surf_lsm_h%ns
     3570                i                   = surf_lsm_h%i(m)           
     3571                j                   = surf_lsm_h%j(m)
     3572                local_pf(i,j,nzb+1) = surf_lsm_h%r_a(m)
    30673573             ENDDO
    30683574          ELSE
    … …  
    30793585       CASE ( 'r_s*_xy' )        ! 2d-array
    30803586          IF ( av == 0 )  THEN
    3081              DO  i = nxlg, nxrg
    3082                 DO  j = nysg, nyng
    3083                    local_pf(i,j,nzb+1) = r_s(j,i)
    3084                 ENDDO
     3587             DO  m = 1, surf_lsm_h%ns
     3588                i                   = surf_lsm_h%i(m)           
     3589                j                   = surf_lsm_h%j(m)
     3590                local_pf(i,j,nzb+1) = surf_lsm_h%r_s(m)
    30853591             ENDDO
    30863592          ELSE
    … …  
    30973603       CASE ( 'shf_eb*_xy' )        ! 2d-array
    30983604          IF ( av == 0 ) THEN
    3099              DO  i = nxlg, nxrg
    3100                 DO  j = nysg, nyng
    3101                    local_pf(i,j,nzb+1) =  shf_eb(j,i)
    3102                 ENDDO
     3605             DO  m = 1, surf_lsm_h%ns
     3606                i                   = surf_lsm_h%i(m)           
     3607                j                   = surf_lsm_h%j(m)
     3608                local_pf(i,j,nzb+1) =  surf_lsm_h%shf_eb(m)
    31033609             ENDDO
    31043610          ELSE
    … …  
    31153621       CASE ( 't_soil_xy', 't_soil_xz', 't_soil_yz' )
    31163622          IF ( av == 0 )  THEN
    3117              DO  i = nxlg, nxrg
    3118                 DO  j = nysg, nyng
    3119                    DO k = nzb_soil, nzt_soil
    3120                       local_pf(i,j,k) = t_soil(k,j,i)
    3121                    ENDDO
     3623             DO  m = 1, surf_lsm_h%ns
     3624                i   = surf_lsm_h%i(m)           
     3625                j   = surf_lsm_h%j(m)
     3626                DO k = nzb_soil, nzt_soil
     3627                   local_pf(i,j,k) = t_soil_h%var_2d(k,m)
    31223628                ENDDO
    31233629             ENDDO
    … …  
    31683674    INTEGER(iwp) ::  j     !<
    31693675    INTEGER(iwp) ::  k     !<
     3676    INTEGER(iwp) ::  m     !< running index
    31703677
    31713678    LOGICAL      ::  found !<
    … …  
    31783685
    31793686    SELECT CASE ( TRIM( variable ) )
    3180 
     3687!
     3688!--   Requires 3D exchange
    31813689
    31823690      CASE ( 'm_soil' )
    31833691
    31843692         IF ( av == 0 )  THEN
    3185             DO  i = nxlg, nxrg
    3186                DO  j = nysg, nyng
    3187                   DO  k = nzb_soil, nzt_soil
    3188                      local_pf(i,j,k) = m_soil(k,j,i)
    3189                   ENDDO
    3190                ENDDO
     3693            DO  m = 1, surf_lsm_h%ns
     3694                i   = surf_lsm_h%i(m)           
     3695                j   = surf_lsm_h%j(m)
     3696                DO  k = nzb_soil, nzt_soil
     3697                   local_pf(i,j,k) = m_soil_h%var_2d(k,m)
     3698                ENDDO
    31913699            ENDDO
    31923700         ELSE
    … …  
    32033711
    32043712         IF ( av == 0 )  THEN
    3205             DO  i = nxlg, nxrg
    3206                DO  j = nysg, nyng
    3207                   DO  k = nzb_soil, nzt_soil
    3208                      local_pf(i,j,k) = t_soil(k,j,i)
    3209                   ENDDO
     3713            DO  m = 1, surf_lsm_h%ns
     3714               i   = surf_lsm_h%i(m)           
     3715               j   = surf_lsm_h%j(m)
     3716               DO  k = nzb_soil, nzt_soil
     3717                  local_pf(i,j,k) = t_soil_h%var_2d(k,m)
    32103718               ENDDO
    32113719            ENDDO
    … …  
    32613769          WRITE ( 14 )  'lai_av              ';  WRITE ( 14 )  lai_av
    32623770       ENDIF
    3263        WRITE ( 14 )  'm_liq_eb            ';  WRITE ( 14 )  m_liq_eb
     3771       WRITE ( 14 )     'm_liq_eb            ';  WRITE ( 14 )  m_liq_eb_h
    32643772       IF ( ALLOCATED( m_liq_eb_av ) )  THEN
    32653773          WRITE ( 14 )  'm_liq_eb_av         ';  WRITE ( 14 )  m_liq_eb_av
    32663774       ENDIF
    3267        WRITE ( 14 )  'm_soil              ';  WRITE ( 14 )  m_soil
     3775       WRITE ( 14 )     'm_soil              ';  WRITE ( 14 )  m_soil_h
    32683776       IF ( ALLOCATED( m_soil_av ) )  THEN
    32693777          WRITE ( 14 )  'm_soil_av           ';  WRITE ( 14 )  m_soil_av
    … …  
    32843792          WRITE ( 14 )  'shf_eb_av           ';  WRITE ( 14 )  shf_eb_av
    32853793       ENDIF
    3286        WRITE ( 14 )  't_soil              ';  WRITE ( 14 )  t_soil
     3794       WRITE ( 14 )     't_soil              ';  WRITE ( 14 )  t_soil_h
    32873795       IF ( ALLOCATED( t_soil_av ) )  THEN
    32883796          WRITE ( 14 )  't_soil_av           ';  WRITE ( 14 )  t_soil_av
    … …  
    33493857          tmp_3d2   !<
    33503858
     3859    REAL(wp),                                                                  &
     3860       DIMENSION(1:surf_lsm_h%ns) ::                                  &
     3861          tmp_walltype_1d   !<
     3862
     3863    REAL(wp),                                                                  &
     3864       DIMENSION(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) ::              &
     3865          tmp_walltype_2d   !<
     3866
     3867    REAL(wp),                                                                  &
     3868       DIMENSION(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ::                &
     3869          tmp_walltype_2d2  !<
     3870
    33513871
    33523872   IF ( initializing_actions == 'read_restart_data' )  THEN
    … …  
    33663886            nync = nynfa(i,k) + offset_ya(i,k)
    33673887
    3368 
    33693888            SELECT CASE ( TRIM( field_char ) )
     3889
    33703890
    33713891                CASE ( 'c_liq_av' )
    … …  
    33743894                   ENDIF
    33753895                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3376                    c_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     3896                   c_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
    33773897                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    33783898
    … …  
    33823902                   ENDIF
    33833903                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3384                    c_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     3904                   c_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
    33853905                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    33863906
    … …  
    33903910                   ENDIF
    33913911                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3392                    c_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     3912                   c_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
    33933913                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    33943914
    … …  
    33983918                   ENDIF
    33993919                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3400                    ghf_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     3920                   ghf_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
    34013921                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    34023922
    34033923                CASE ( 'm_liq_eb' )
    3404                    IF ( k == 1 )  READ ( 13 )  tmp_2d
    3405                    m_liq_eb(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =        &
    3406                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
     3924                   IF ( k == 1 )  READ ( 13 )  tmp_walltype_1d !tmp_2d
     3925                   m_liq_eb_h%var_1d(1:surf_lsm_h%ns)  =                       &
     3926                                 tmp_walltype_1d(1:surf_lsm_h%ns)
    34073927
    34083928                CASE ( 'lai_av' )
    … …  
    34113931                   ENDIF
    34123932                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3413                    lai_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     3933                   lai_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =           &
    34143934                                  tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    34153935
    … …  
    34233943
    34243944                CASE ( 'm_soil' )
    3425                    IF ( k == 1 )  READ ( 13 )  tmp_3d2(:,:,:)
    3426                    m_soil(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
    3427                           tmp_3d2(nzb_soil:nzt_soil,nysf-nbgp:nynf             &
    3428                           +nbgp,nxlf-nbgp:nxrf+nbgp)
     3945                   IF ( k == 1 )  READ ( 13 )  tmp_walltype_2d2(:,:)
     3946                   m_soil_h%var_2d(:,1:surf_lsm_h%ns) =                        &
     3947                          tmp_walltype_2d2(:,1:surf_lsm_h%ns)   
    34293948
    34303949                CASE ( 'm_soil_av' )
    … …  
    34423961                   ENDIF 
    34433962                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3444                    qsws_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  = &
     3963                   qsws_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =      &
    34453964                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    34463965
    … …  
    34503969                   ENDIF 
    34513970                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3452                    qsws_liq_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  = &
     3971                   qsws_liq_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =  &
    34533972                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    34543973                CASE ( 'qsws_soil_eb_av' )
    … …  
    34733992                   ENDIF
    34743993                   IF ( k == 1 )  READ ( 13 )  tmp_2d
    3475                    shf_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  = &
     3994                   shf_eb_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =       &
    34763995                         tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    34773996
    34783997                CASE ( 't_soil' )
    3479                    IF ( k == 1 )  READ ( 13 )  tmp_3d
    3480                    t_soil(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
    3481                                    tmp_3d(:,nysf-nbgp:nynf+nbgp,               &
    3482                                                 nxlf-nbgp:nxrf+nbgp)
     3998                   IF ( k == 1 )  READ ( 13 )  tmp_walltype_2d(:,:)
     3999                   t_soil_h%var_2d(:,1:surf_lsm_h%ns) =                        &
     4000                         tmp_walltype_2d(:,1:surf_lsm_h%ns)     
    34834001
    34844002                CASE ( 't_soil_av' )
    … …  
    34884006                   IF ( k == 1 )  READ ( 13 )  tmp_3d2(:,:,:)
    34894007                   t_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =      &
    3490                                     tmp_3d(:,nysf-nbgp:nynf+nbgp,             &
     4008                                    tmp_3d2(:,nysf-nbgp:nynf+nbgp,             &
    34914009                                    nxlf-nbgp:nxrf+nbgp)
    34924010
    … …  
    35254043       IMPLICIT NONE
    35264044
    3527        INTEGER :: i  !< running index
    3528        INTEGER :: j  !< running index
     4045       INTEGER(iwp) ::  i       !< running index
     4046       INTEGER(iwp) ::  j       !< running index
     4047       INTEGER(iwp) ::  m       !< running index
    35294048
    35304049       REAL(wp), PARAMETER :: alpha_ch  = 0.018_wp !< Charnock constant (0.01-0.11). Use 0.01 for FLake and 0.018 for ECMWF
    … …  
    35334052!       REAL(wp) :: re_0 !< near-surface roughness Reynolds number
    35344053
    3535 
    3536        DO  i = nxlg, nxrg   
    3537           DO  j = nysg, nyng
    3538              IF ( water_surface(j,i) )  THEN
    3539 
    3540 !
    3541 !--             Disabled: FLake parameterization. Ideally, the Charnock
    3542 !--             coefficient should depend on the water depth and the fetch
    3543 !--             length
    3544 !                re_0 = z0(j,i) * us(j,i) / molecular_viscosity
     4054       DO  m = 1, surf_lsm_h%ns
     4055
     4056          i   = surf_lsm_h%i(m)           
     4057          j   = surf_lsm_h%j(m)
     4058         
     4059          IF ( surf_lsm_h%water_surface(m) )  THEN
     4060
     4061!
     4062!--          Disabled: FLake parameterization. Ideally, the Charnock
     4063!--          coefficient should depend on the water depth and the fetch
     4064!--          length
     4065!             re_0 = z0(j,i) * us(j,i) / molecular_viscosity
    35454066!       
    3546 !                z0(j,i) = MAX( 0.1_wp * molecular_viscosity / us(j,i),            &
    3547 !                              alpha_ch * us(j,i) / g )
    3548 !
    3549 !                z0h(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 3.2_wp ) )
    3550 !                z0q(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 4.2_wp ) )
    3551 
    3552 !
    3553 !--              Set minimum roughness length for u* > 0.2
    3554 !                IF ( us(j,i) > 0.2_wp )  THEN
    3555 !                   z0h(j,i) = MAX( 1.0E-5_wp, z0h(j,i) )
    3556 !                   z0q(j,i) = MAX( 1.0E-5_wp, z0q(j,i) )
    3557 !                ENDIF
    3558 
    3559 !
    3560 !--             ECMWF IFS model parameterization after Beljaars (1994). At low
    3561 !--             wind speed, the sea surface becomes aerodynamically smooth and
    3562 !--             the roughness scales with the viscosity. At high wind speed, the
    3563 !--             Charnock relation is used.
    3564                 z0(j,i) =   ( 0.11_wp * molecular_viscosity / us(j,i) )        &
    3565                           + ( alpha_ch * us(j,i)**2 / g )
    3566 
    3567                 z0h(j,i) = 0.40_wp * molecular_viscosity / us(j,i)
    3568                 z0q(j,i) = 0.62_wp * molecular_viscosity / us(j,i)
    3569 
    3570              ENDIF
    3571           ENDDO
     4067!             z0(j,i) = MAX( 0.1_wp * molecular_viscosity / us(j,i),            &
     4068!                           alpha_ch * us(j,i) / g )
     4069!
     4070!             z0h(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 3.2_wp ) )
     4071!             z0q(j,i) = z0(j,i) * EXP( - kappa / pr_number * ( 4.0_wp * SQRT( re_0 ) - 4.2_wp ) )
     4072
     4073!
     4074!--           Set minimum roughness length for u* > 0.2
     4075!             IF ( us(j,i) > 0.2_wp )  THEN
     4076!                z0h(j,i) = MAX( 1.0E-5_wp, z0h(j,i) )
     4077!                z0q(j,i) = MAX( 1.0E-5_wp, z0q(j,i) )
     4078!             ENDIF
     4079
     4080!
     4081!--          ECMWF IFS model parameterization after Beljaars (1994). At low
     4082!--          wind speed, the sea surface becomes aerodynamically smooth and
     4083!--          the roughness scales with the viscosity. At high wind speed, the
     4084!--          Charnock relation is used.
     4085             surf_lsm_h%z0(m)  = ( 0.11_wp * molecular_viscosity /             &
     4086                                 surf_lsm_h%us(m) )  &
     4087                               + ( alpha_ch * surf_lsm_h%us(m)**2 / g )
     4088
     4089             surf_lsm_h%z0h(m) = 0.40_wp * molecular_viscosity /               &
     4090                                 surf_lsm_h%us(m)
     4091             surf_lsm_h%z0q(m) = 0.62_wp * molecular_viscosity /               &
     4092                                 surf_lsm_h%us(m)
     4093
     4094          ENDIF
    35724095       ENDDO
    35734096
    … …  
    35754098
    35764099
    3577 !------------------------------------------------------------------------------!
    3578 ! Description:
    3579 ! ------------
    3580 !> Calculation of specific humidity of the skin layer (surface). It is assumend
    3581 !> that the skin is always saturated.
    3582 !------------------------------------------------------------------------------!
    3583     SUBROUTINE calc_q_surface
    3584 
    3585        IMPLICIT NONE
    3586 
    3587        INTEGER :: i              !< running index
    3588        INTEGER :: j              !< running index
    3589        INTEGER :: k              !< running index
    3590 
    3591        REAL(wp) :: resistance    !< aerodynamic and soil resistance term
    3592 
    3593        DO  i = nxlg, nxrg   
    3594           DO  j = nysg, nyng
    3595              k = nzb_s_inner(j,i)
    3596 
    3597 !
    3598 !--          Calculate water vapour pressure at saturation
    3599              e_s = 0.01_wp * 610.78_wp * EXP( 17.269_wp * ( t_surface_p(j,i)   &
    3600                    - 273.16_wp ) / ( t_surface_p(j,i) - 35.86_wp ) )
    3601 
    3602 !
    3603 !--          Calculate specific humidity at saturation
    3604              q_s = 0.622_wp * e_s / surface_pressure
    3605 
    3606              resistance = r_a(j,i) / (r_a(j,i) + r_s(j,i))
    3607 
    3608 !
    3609 !--          Calculate specific humidity at surface
    3610              IF ( cloud_physics )  THEN
    3611                 q(k,j,i) = resistance * q_s + (1.0_wp - resistance)            &
    3612                              * ( q(k+1,j,i) - ql(k+1,j,i) )
    3613              ELSE
    3614                 q(k,j,i) = resistance * q_s + (1.0_wp - resistance)            &
    3615                              * q(k+1,j,i)
    3616              ENDIF
    3617 
    3618 !
    3619 !--          Update virtual potential temperature
    3620              vpt(k,j,i) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) )
    3621 
    3622           ENDDO
    3623        ENDDO
    3624 
    3625     END SUBROUTINE calc_q_surface
    3626 
    36274100
    36284101 END MODULE land_surface_model_mod

  • palm/trunk/SOURCE/lpm.f90

    r2101 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    123123
    124124    USE indices,                                                               &
    125         ONLY: nxl, nxr, nys, nyn, nzb, nzb_max, nzt, nzb_w_inner
     125        ONLY: nxl, nxr, nys, nyn, nzb, nzb_max, nzt
    126126
    127127    USE kinds
    … …  
    365365!--    Increment time since last release
    366366       IF ( dt_3d_reached )  time_prel = time_prel + dt_3d
    367 
    368367!
    369368!--    Move Particles local to PE to a different grid cell

  • palm/trunk/SOURCE/lpm_advec.f90

    r2101 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    109109
    110110    USE arrays_3d,                                                             &
    111         ONLY:  de_dx, de_dy, de_dz, diss, e, km, u, us, usws, v, vsws, w, zu, zw
     111        ONLY:  de_dx, de_dy, de_dz, diss, e, km, u, v, w, zu, zw
    112112
    113113    USE cpulog
    … …  
    123123       
    124124    USE indices,                                                               &
    125         ONLY:  nzb, nzb_s_inner, nzt
     125        ONLY:  nzb, nzb_max, nzt, wall_flags_0
    126126       
    127127    USE kinds
    … …  
    136136        ONLY:  hom
    137137
     138    USE surface_mod,                                                           &
     139        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
     140
    138141    IMPLICIT NONE
    139142
    … …  
    147150    INTEGER(iwp) ::  jlog                        !< index variable along y
    148151    INTEGER(iwp) ::  k                           !< index variable along z
     152    INTEGER(iwp) ::  k_wall                      !< vertical index of topography top
    149153    INTEGER(iwp) ::  kp                          !< index variable along z
    150154    INTEGER(iwp) ::  kw                          !< index variable along z
    … …  
    152156    INTEGER(iwp) ::  nb                          !< block number particles are sorted in
    153157    INTEGER(iwp) ::  num_gp                      !< number of adjacent grid points inside topography
     158    INTEGER(iwp) ::  surf_start                  !< Index on surface data-type for current grid box
    154159
    155160    INTEGER(iwp), DIMENSION(0:7) ::  start_index !< start particle index for current block
    … …  
    194199    REAL(wp) ::  u_int_u            !< x/y-interpolated u-component at particle position at upper vertical level
    195200    REAL(wp) ::  us_int             !< friction velocity at particle grid box
     201    REAL(wp) ::  usws_int           !< surface momentum flux (u component) at particle grid box
    196202    REAL(wp) ::  v_int_l            !< x/y-interpolated v-component at particle position at lower vertical level
    197203    REAL(wp) ::  v_int_u            !< x/y-interpolated v-component at particle position at upper vertical level
     204    REAL(wp) ::  vsws_int           !< surface momentum flux (u component) at particle grid box
    198205    REAL(wp) ::  vv_int             !<
    199206    REAL(wp) ::  w_int_l            !< x/y-interpolated w-component at particle position at lower vertical level
    … …  
    258265       j = jp + block_offset(nb)%j_off
    259266       k = kp + block_offset(nb)%k_off
    260 
    261 
    262267!
    263268!--    Interpolate u velocity-component
    … …  
    271276!--       Monin-Obukhov relations (if branch).
    272277!--       First, check if particle is located below first vertical grid level
    273 !--       (Prandtl-layer height)
     278!--       above topography (Prandtl-layer height)
    274279          ilog = ( particles(n)%x + 0.5_wp * dx ) * ddx
    275280          jlog = ( particles(n)%y + 0.5_wp * dy ) * ddy
    276 
    277           IF ( constant_flux_layer  .AND.                                      &
    278                zv(n) - zw(nzb_s_inner(jlog,ilog)) < z_p )  THEN
     281!
     282!--       Determine vertical index of topography top
     283          k_wall = MAXLOC(                                                     &
     284                       MERGE( 1, 0,                                            &
     285                              BTEST( wall_flags_0(nzb:nzb_max,jlog,ilog), 12 ) &
     286                            ), DIM = 1                                         &
     287                         ) - 1
     288
     289          IF ( constant_flux_layer  .AND.  zv(n) - zw(k_wall) < z_p )  THEN
    279290!
    280291!--          Resolved-scale horizontal particle velocity is zero below z0.
    281              IF ( zv(n) - zw(nzb_s_inner(jlog,ilog)) < z0_av_global )  THEN
     292             IF ( zv(n) - zw(k_wall) < z0_av_global )  THEN
    282293                u_int(n) = 0.0_wp
    283294             ELSE
    284295!
    285296!--             Determine the sublayer. Further used as index.
    286                 height_p = ( zv(n) - zw(nzb_s_inner(jlog,ilog)) - z0_av_global ) &
     297                height_p = ( zv(n) - zw(k_wall) - z0_av_global ) &
    287298                                     * REAL( number_of_sublayers, KIND=wp )    &
    288299                                     * d_z_p_z0
    … …  
    296307                                   )
    297308!
    298 !--             Limit friction velocity. In narrow canyons or holes the
    299 !--             friction velocity can become very small, resulting in a too
    300 !--             large particle speed.
    301                 us_int   = MAX( 0.5_wp * ( us(jlog,ilog) + us(jlog,ilog-1) ),  &
    302                                 0.01_wp ) 
     309!--             Get friction velocity and momentum flux from new surface data
     310!--             types.
     311                IF ( surf_def_h(0)%start_index(jlog,ilog) <=                   &
     312                     surf_def_h(0)%end_index(jlog,ilog) )  THEN
     313                   surf_start = surf_def_h(0)%start_index(jlog,ilog)
     314!--                Limit friction velocity. In narrow canyons or holes the
     315!--                friction velocity can become very small, resulting in a too
     316!--                large particle speed.
     317                   us_int    = MAX( surf_def_h(0)%us(surf_start), 0.01_wp ) 
     318                   usws_int  = surf_def_h(0)%usws(surf_start)
     319                ELSEIF ( surf_lsm_h%start_index(jlog,ilog) <=                  &
     320                         surf_lsm_h%end_index(jlog,ilog) )  THEN
     321                   surf_start = surf_lsm_h%start_index(jlog,ilog)
     322                   us_int    = MAX( surf_lsm_h%us(surf_start), 0.01_wp ) 
     323                   usws_int  = surf_lsm_h%usws(surf_start)
     324                ELSEIF ( surf_usm_h%start_index(jlog,ilog) <=                  &
     325                         surf_usm_h%end_index(jlog,ilog) )  THEN
     326                   surf_start = surf_usm_h%start_index(jlog,ilog)
     327                   us_int    = MAX( surf_usm_h%us(surf_start), 0.01_wp ) 
     328                   usws_int  = surf_usm_h%usws(surf_start)
     329                ENDIF
     330
    303331!
    304332!--             Neutral solution is applied for all situations, e.g. also for
    … …  
    308336!--             as sensitivity studies revealed no significant effect of
    309337!--             using the neutral solution also for un/stable situations.
    310                 u_int(n) = -usws(jlog,ilog) / ( us_int * kappa + 1E-10_wp )          &
     338                u_int(n) = -usws_int / ( us_int * kappa + 1E-10_wp )           &
    311339                            * log_z_z0_int - u_gtrans
    312340               
    … …  
    352380          ilog = ( particles(n)%x + 0.5_wp * dx ) * ddx
    353381          jlog = ( particles(n)%y + 0.5_wp * dy ) * ddy
    354           IF ( constant_flux_layer  .AND.                                      &
    355                zv(n) - zw(nzb_s_inner(jlog,ilog)) < z_p )  THEN
    356 
    357              IF ( zv(n) - zw(nzb_s_inner(jlog,ilog)) < z0_av_global )  THEN
     382!
     383!--       Determine vertical index of topography top
     384          k_wall = MAXLOC(                                                     &
     385                       MERGE( 1, 0,                                            &
     386                              BTEST( wall_flags_0(nzb:nzb_max,jlog,ilog), 12 ) &
     387                            ), DIM = 1                                         &
     388                         ) - 1
     389
     390          IF ( constant_flux_layer  .AND.  zv(n) - zw(k_wall) < z_p )  THEN
     391             IF ( zv(n) - zw(k_wall) < z0_av_global )  THEN
    358392!
    359393!--             Resolved-scale horizontal particle velocity is zero below z0.
    … …  
    365399!--             topography particle on u-grid can be above surface-layer height,
    366400!--             whereas it can be below on v-grid.
    367                 height_p = ( zv(n) - zw(nzb_s_inner(jlog,ilog)) - z0_av_global ) &
     401                height_p = ( zv(n) - zw(k_wall) - z0_av_global ) &
    368402                                  * REAL( number_of_sublayers, KIND=wp )       &
    369403                                  * d_z_p_z0
    … …  
    377411                                   )
    378412!
    379 !--             Limit friction velocity. In narrow canyons or holes the
    380 !--             friction velocity can become very small, resulting in a too
    381 !--             large particle speed.
    382                 us_int   = MAX( 0.5_wp * ( us(jlog,ilog) + us(jlog-1,ilog) ),  &
    383                                 0.01_wp )   
     413!--             Get friction velocity and momentum flux from new surface data
     414!--             types.
     415                IF ( surf_def_h(0)%start_index(jlog,ilog) <=                   &
     416                     surf_def_h(0)%end_index(jlog,ilog) )  THEN
     417                   surf_start = surf_def_h(0)%start_index(jlog,ilog)
     418!--                Limit friction velocity. In narrow canyons or holes the
     419!--                friction velocity can become very small, resulting in a too
     420!--                large particle speed.
     421                   us_int    = MAX( surf_def_h(0)%us(surf_start), 0.01_wp ) 
     422                   vsws_int  = surf_def_h(0)%usws(surf_start)
     423                ELSEIF ( surf_lsm_h%start_index(jlog,ilog) <=                  &
     424                         surf_lsm_h%end_index(jlog,ilog) )  THEN
     425                   surf_start = surf_lsm_h%start_index(jlog,ilog)
     426                   us_int    = MAX( surf_lsm_h%us(surf_start), 0.01_wp ) 
     427                   vsws_int  = surf_lsm_h%usws(surf_start)
     428                ELSEIF ( surf_usm_h%start_index(jlog,ilog) <=                  &
     429                         surf_usm_h%end_index(jlog,ilog) )  THEN
     430                   surf_start = surf_usm_h%start_index(jlog,ilog)
     431                   us_int    = MAX( surf_usm_h%us(surf_start), 0.01_wp ) 
     432                   vsws_int  = surf_usm_h%usws(surf_start)
     433                ENDIF
    384434!
    385435!--             Neutral solution is applied for all situations, e.g. also for
    … …  
    389439!--             as sensitivity studies revealed no significant effect of
    390440!--             using the neutral solution also for un/stable situations.
    391                 v_int(n) = -vsws(jlog,ilog) / ( us_int * kappa + 1E-10_wp )    &
     441                v_int(n) = -vsws_int / ( us_int * kappa + 1E-10_wp )           &
    392442                         * log_z_z0_int - v_gtrans
    393443
    … …  
    622672             num_gp = 0
    623673
    624              IF ( k > nzb_s_inner(j,i)  .OR.  nzb_s_inner(j,i) == 0 )  THEN
     674!
     675!--          Determine vertical index of topography top at (j,i)
     676             k_wall = MAXLOC(                                                  &
     677                          MERGE( 1, 0,                                         &
     678                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     679                               ), DIM = 1                                      &
     680                            ) - 1
     681!
     682!--          To do: Reconsider order of computations in order to avoid
     683!--          unnecessary index calculations.
     684             IF ( k > k_wall  .OR.  k_wall == 0 )  THEN
    625685                num_gp = num_gp + 1
    626686                gp_outside_of_building(1) = 1
    … …  
    634694                de_dzi(num_gp) = de_dz(k,j,i)
    635695             ENDIF
    636              IF ( k > nzb_s_inner(j+1,i)  .OR.  nzb_s_inner(j+1,i) == 0 )  THEN
     696
     697!
     698!--          Determine vertical index of topography top at (j+1,i)
     699             k_wall = MAXLOC(                                                  &
     700                          MERGE( 1, 0,                                         &
     701                                 BTEST( wall_flags_0(nzb:nzb_max,j+1,i), 12 )  &
     702                               ), DIM = 1                                      &
     703                            ) - 1
     704             IF ( k > k_wall  .OR.  k_wall == 0 )  THEN
    637705                num_gp = num_gp + 1
    638706                gp_outside_of_building(2) = 1
    … …  
    647715             ENDIF
    648716
    649              IF ( k+1 > nzb_s_inner(j,i)  .OR.  nzb_s_inner(j,i) == 0 )  THEN
     717!
     718!--          Determine vertical index of topography top at (j,i)
     719             k_wall = MAXLOC(                                                  &
     720                          MERGE( 1, 0,                                         &
     721                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     722                               ), DIM = 1                                      &
     723                            ) - 1
     724             IF ( k+1 > k_wall  .OR.  k_wall == 0 )  THEN
    650725                num_gp = num_gp + 1
    651726                gp_outside_of_building(3) = 1
    … …  
    660735             ENDIF
    661736
    662              IF ( k+1 > nzb_s_inner(j+1,i)  .OR.  nzb_s_inner(j+1,i) == 0 )  THEN
     737!
     738!--          Determine vertical index of topography top at (j+1,i)
     739             k_wall = MAXLOC(                                                  &
     740                          MERGE( 1, 0,                                         &
     741                                 BTEST( wall_flags_0(nzb:nzb_max,j+1,i), 12 )  &
     742                               ), DIM = 1                                      &
     743                            ) - 1
     744             IF ( k+1 > k_wall  .OR.  k_wall == 0 )  THEN
    663745                num_gp = num_gp + 1
    664746                gp_outside_of_building(4) = 1
    … …  
    673755             ENDIF
    674756
    675              IF ( k > nzb_s_inner(j,i+1)  .OR.  nzb_s_inner(j,i+1) == 0 )  THEN
     757!
     758!--          Determine vertical index of topography top at (j,i+1)
     759             k_wall = MAXLOC(                                                  &
     760                          MERGE( 1, 0,                                         &
     761                                 BTEST( wall_flags_0(nzb:nzb_max,j,i+1), 12 )  &
     762                               ), DIM = 1                                      &
     763                            ) - 1
     764             IF ( k > k_wall  .OR.  k_wall == 0 )  THEN
    676765                num_gp = num_gp + 1
    677766                gp_outside_of_building(5) = 1
    … …  
    686775             ENDIF
    687776
    688              IF ( k > nzb_s_inner(j+1,i+1)  .OR.  nzb_s_inner(j+1,i+1) == 0 )  THEN
     777!
     778!--          Determine vertical index of topography top at (j+1,i+1)
     779             k_wall = MAXLOC(                                                  &
     780                          MERGE( 1, 0,                                         &
     781                                 BTEST( wall_flags_0(nzb:nzb_max,j+1,i+1), 12 )&
     782                               ), DIM = 1                                      &
     783                            ) - 1
     784             IF ( k > k_wall  .OR.  k_wall == 0 )  THEN
    689785                num_gp = num_gp + 1
    690786                gp_outside_of_building(6) = 1
    … …  
    699795             ENDIF
    700796
    701              IF ( k+1 > nzb_s_inner(j,i+1)  .OR.  nzb_s_inner(j,i+1) == 0 )  THEN
     797!
     798!--          Determine vertical index of topography top at (j,i+1)
     799             k_wall = MAXLOC(                                                  &
     800                          MERGE( 1, 0,                                         &
     801                                 BTEST( wall_flags_0(nzb:nzb_max,j,i+1), 12 )  &
     802                               ), DIM = 1                                      &
     803                            ) - 1
     804             IF ( k+1 > k_wall  .OR.  k_wall == 0 )  THEN
    702805                num_gp = num_gp + 1
    703806                gp_outside_of_building(7) = 1
    … …  
    712815             ENDIF
    713816
    714              IF ( k+1 > nzb_s_inner(j+1,i+1)  .OR.  nzb_s_inner(j+1,i+1) == 0)  THEN
     817!
     818!--          Determine vertical index of topography top at (j+1,i+1)
     819             k_wall = MAXLOC(                                                  &
     820                          MERGE( 1, 0,                                         &
     821                                 BTEST( wall_flags_0(nzb:nzb_max,j+1,i+1), 12 )&
     822                               ), DIM = 1                                      &
     823                            ) - 1
     824             IF ( k+1 > k_wall  .OR.  k_wall == 0)  THEN
    715825                num_gp = num_gp + 1
    716826                gp_outside_of_building(8) = 1

  • palm/trunk/SOURCE/lpm_boundary_conds.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography and surface concept
     23! Rename character range into location, as range is an intrinsic.
    2324!
    2425! Former revisions:
    … …  
    7879!> (see offset_ocean_*)
    7980!------------------------------------------------------------------------------!
    80  SUBROUTINE lpm_boundary_conds( range )
     81 SUBROUTINE lpm_boundary_conds( location )
    8182 
    8283
    … …  
    9495
    9596    USE indices,                                                               &
    96         ONLY:  nxl, nxr, nyn, nys, nz, nzb_s_inner
     97        ONLY:  nxl, nxr, nyn, nys, nz, nzb, nzb_max, wall_flags_0
    9798
    9899    USE kinds
    … …  
    107108    IMPLICIT NONE
    108109
    109     CHARACTER (LEN=*) ::  range     !<
     110    CHARACTER (LEN=*) ::  location     !<
    110111   
    111112    INTEGER(iwp) ::  inc            !< dummy for sorting algorithmus
    … …  
    118119    INTEGER(iwp) ::  j2             !< grid index (x) of current particle position
    119120    INTEGER(iwp) ::  j3             !< grid index (x) of intermediate particle position
     121    INTEGER(iwp) ::  k_wall         !< vertical index of topography top
    120122    INTEGER(iwp) ::  n              !< particle number
    121123    INTEGER(iwp) ::  t_index        !< running index for intermediate particle timesteps in reflection algorithmus
    … …  
    167169
    168170
    169     IF ( range == 'bottom/top' )  THEN
     171    IF ( location == 'bottom/top' )  THEN
    170172
    171173!
    … …  
    232234       ENDDO
    233235
    234     ELSEIF ( range == 'walls' )  THEN
     236    ELSEIF ( location == 'walls' )  THEN
    235237
    236238
    … …  
    281283          ENDIF
    282284!
    283 !--       Walls aligned in xy layer at which particle can be possiblly reflected
    284           zwall1 = zw(nzb_s_inner(j2,i2))
    285           zwall2 = zw(nzb_s_inner(j1,i1))
    286           zwall3 = zw(nzb_s_inner(j1,i2))
    287           zwall4 = zw(nzb_s_inner(j2,i1))
     285!--       Walls aligned in xy layer at which particle can be possiblly reflected.
     286!--       The construct of MERGE and BTEST is used to determine the topography-
     287!--       top index (former nzb_s_inner).
     288          zwall1 = zw( MAXLOC(                                                 &
     289                          MERGE( 1, 0,                                         &
     290                                 BTEST( wall_flags_0(nzb:nzb_max,j2,i2), 12 )  &
     291                               ), DIM = 1                                      &
     292                             ) - 1 )                                             
     293          zwall2 = zw( MAXLOC(                                                 &
     294                          MERGE( 1, 0,                                         &
     295                                 BTEST( wall_flags_0(nzb:nzb_max,j1,i1), 12 )  &
     296                               ), DIM = 1                                      &
     297                             ) - 1 ) 
     298          zwall3 = zw( MAXLOC(                                                 &
     299                          MERGE( 1, 0,                                         &
     300                                 BTEST( wall_flags_0(nzb:nzb_max,j1,i2), 12 )  &
     301                               ), DIM = 1                                      &
     302                             ) - 1 ) 
     303          zwall4 = zw( MAXLOC(                                                 &
     304                          MERGE( 1, 0,                                         &
     305                                 BTEST( wall_flags_0(nzb:nzb_max,j2,i1), 12 )  &
     306                               ), DIM = 1                                      &
     307                             ) - 1 ) 
    288308!
    289309!--       Initialize flags to check if particle reflection is necessary
    … …  
    469489!--             constant is required, as the particle position do not
    470490!--             necessarily exactly match the wall location due to rounding
    471 !--             errors.   
     491!--             errors. At first, determine index of topography top at (j3,i3) 
     492                k_wall = MAXLOC(                                               &
     493                            MERGE( 1, 0,                                       &
     494                                 BTEST( wall_flags_0(nzb:nzb_max,j3,i3), 12 )  &
     495                                 ), DIM = 1                                    &
     496                               ) - 1 
    472497                IF ( ABS( pos_x - xwall ) < eps      .AND.                     &
    473                      pos_z <= zw(nzb_s_inner(j3,i3)) .AND.                     &
     498                     pos_z <= zw(k_wall)            .AND.                     &
    474499                     reach_x(t_index)                .AND.                     &
    475500                     .NOT. reflect_x )  THEN
    … …  
    504529!
    505530!--             Check if a particle needs to be reflected at any xz-wall. If
    506 !--             necessary, carry out reflection.
     531!--             necessary, carry out reflection. At first, determine index of
     532!--             topography top at (j3,i3) 
     533                k_wall = MAXLOC(                                               &
     534                            MERGE( 1, 0,                                       &
     535                                 BTEST( wall_flags_0(nzb:nzb_max,j3,i3), 12 )  &
     536                                 ), DIM = 1                                    &
     537                               ) - 1 
    507538                IF ( ABS( pos_y - ywall ) < eps      .AND.                     &
    508                      pos_z <= zw(nzb_s_inner(j3,i3)) .AND.                     &
     539                     pos_z <= zw(k_wall)            .AND.                     &
    509540                     reach_y(t_index)                .AND.                     &
    510541                     .NOT. reflect_y ) THEN
    … …  
    525556!
    526557!--             Check if a particle needs to be reflected at any xy-wall. If
    527 !--             necessary, carry out reflection.
     558!--             necessary, carry out reflection. 
    528559                IF ( downwards .AND. reach_z(t_index) .AND.                    &
    529560                     .NOT. reflect_z )  THEN
    530                    IF ( pos_z - zw(nzb_s_inner(j3,i3)) < eps ) THEN
     561!
     562!--                Determine index of topography top at (j3,i3) and chick if
     563!--                particle is below. 
     564                   k_wall = MAXLOC(                                            &
     565                          MERGE( 1, 0,                                         &
     566                                   BTEST( wall_flags_0(nzb:nzb_max,j3,i3), 12 )&
     567                               ), DIM = 1                                      &
     568                                  ) - 1 
     569                   IF ( pos_z - zw(k_wall) < eps ) THEN
    531570 
    532                       pos_z = MAX( 2.0_wp * zw(nzb_s_inner(j3,i3)) - pos_z,    &
    533                                    zw(nzb_s_inner(j3,i3)) )
     571                      pos_z = MAX( 2.0_wp * zw(k_wall) - pos_z,    &
     572                                   zw(k_wall) )
    534573
    535574                      particles(n)%speed_z = - particles(n)%speed_z

  • palm/trunk/SOURCE/lpm_init.f90

    r2224 r2232  
    2020! Current revisions:
    2121! -----------------
     22! Adjustments according to new topography realization
    2223!
    2324!
    … …  
    146147
    147148    USE arrays_3d,                                                             &
    148         ONLY:  de_dx, de_dy, de_dz, zu, zw, z0
     149        ONLY:  de_dx, de_dy, de_dz, zu, zw
    149150
    150151    USE control_parameters,                                                    &
    … …  
    157158    USE indices,                                                               &
    158159        ONLY:  nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb,    &
    159                nzb_w_inner, nzt
     160               nzb_max, nzt, wall_flags_0
    160161
    161162    USE kinds
    … …  
    196197        ONLY:  random_function
    197198
     199    USE surface_mod,                                                           &
     200        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
     201
    198202    IMPLICIT NONE
    199203
    … …  
    287291       number_of_particle_groups = max_number_of_particle_groups
    288292    ENDIF
     293!
     294!-- Check if downward-facing walls exist. This case, reflection boundary
     295!-- conditions (as well as subgrid-scale velocities) may do not work
     296!-- propably (not realized so far).
     297    IF ( surf_def_h(1)%ns >= 1 )  THEN
     298       WRITE( message_string, * ) 'Overhanging topograpyh do not work '// &   
     299                                  'with particles'
     300       CALL message( 'lpm_init', 'PA0212', 0, 1, 0, 6, 0 )
     301
     302    ENDIF
    289303
    290304!
    … …  
    355369       
    356370       ALLOCATE ( log_z_z0(0:number_of_sublayers) )
    357        z_p         = zu(nzb+1) - zw(nzb)
     371       z_p = zu(nzb+1) - zw(nzb)
    358372
    359373!
    … …  
    362376!--    However, sensitivity studies showed that the effect is
    363377!--    negligible.
    364        z0_av_local  = SUM( z0(nys:nyn,nxl:nxr) )
     378       z0_av_local  = SUM( surf_def_h(0)%z0 ) + SUM( surf_lsm_h%z0 ) +         &
     379                      SUM( surf_usm_h%z0 )
    365380       z0_av_global = 0.0_wp
    366381
    … …  
    577592    INTEGER(iwp)               ::  j           !< loop variable ( particles per point )
    578593    INTEGER(iwp)               ::  jp          !< index variable along y
     594    INTEGER(iwp)               ::  k           !< index variable along z
     595    INTEGER(iwp)               ::  k_surf      !< index of surface grid point
    579596    INTEGER(iwp)               ::  kp          !< index variable along z
    580597    INTEGER(iwp)               ::  loop_stride !< loop variable for initialization
    … …  
    679696!
    680697!--                            Determine the grid indices of the particle position
    681                               ip = ( tmp_particle%x + 0.5_wp * dx ) * ddx
     698                               ip = ( tmp_particle%x + 0.5_wp * dx ) * ddx
    682699                               jp = ( tmp_particle%y + 0.5_wp * dy ) * ddy
    683700                               kp = tmp_particle%z / dz + 1 + offset_ocean_nzt
     701!
     702!--                            Determine surface level. Therefore, check for
     703!--                            upward-facing wall on w-grid. MAXLOC will return
     704!--                            the index of the lowest upward-facing wall.
     705                               k_surf = MAXLOC(                                &
     706                                             MERGE( 1, 0,                      &
     707                                   BTEST( wall_flags_0(nzb:nzb_max,jp,ip), 18 )&
     708                                                  ), DIM = 1                   &
     709                                              ) - 1
    684710
    685711                               IF ( seed_follows_topography )  THEN
    686712!
    687713!--                               Particle height is given relative to topography
    688                                   kp = kp + nzb_w_inner(jp,ip)
    689                                   tmp_particle%z = tmp_particle%z +            &
    690                                                          zw(nzb_w_inner(jp,ip))
    691                                   IF ( kp > nzt )  THEN
     714                                  kp = kp + k_surf
     715                                  tmp_particle%z = tmp_particle%z + zw(k_surf)
     716!--                               Skip particle release if particle position is
     717!--                               above model top, or within topography in case
     718!--                               of overhanging structures.
     719                                  IF ( kp > nzt  .OR.                          &
     720                                 .NOT. BTEST( wall_flags_0(kp,jp,ip), 0 ) )  THEN
    692721                                     pos_x = pos_x + pdx(i)
    693722                                     CYCLE xloop
    694723                                  ENDIF
     724!
     725!--                            Skip particle release if particle position is
     726!--                            below surface, or within topography in case
     727!--                            of overhanging structures.
    695728                               ELSEIF ( .NOT. seed_follows_topography .AND.    &
    696                                         tmp_particle%z <= zw(nzb_w_inner(jp,ip)) )  THEN
     729                                         tmp_particle%z <= zw(k_surf)  .OR.    &
     730                                        .NOT. BTEST( wall_flags_0(kp,jp,ip), 0 ) )&
     731                               THEN
    697732                                  pos_x = pos_x + pdx(i)
    698733                                  CYCLE xloop                               
    … …  
    820855                                     pdx(particles(n)%group)
    821856                      particles(n)%x = particles(n)%x +                        &
    822                               MERGE( rand_contr, SIGN( dx, rand_contr ), &
     857                              MERGE( rand_contr, SIGN( dx, rand_contr ),       &
    823858                                     ABS( rand_contr ) < dx                    &
    824859                                   )
    … …  
    828863                                     pdy(particles(n)%group)
    829864                      particles(n)%y = particles(n)%y +                        &
    830                               MERGE( rand_contr, SIGN( dy, rand_contr ), &
     865                              MERGE( rand_contr, SIGN( dy, rand_contr ),       &
    831866                                     ABS( rand_contr ) < dy                    &
    832867                                   )
    … …  
    836871                                     pdz(particles(n)%group)
    837872                      particles(n)%z = particles(n)%z +                        &
    838                               MERGE( rand_contr, SIGN( dz, rand_contr ), &
     873                              MERGE( rand_contr, SIGN( dz, rand_contr ),       &
    839874                                     ABS( rand_contr ) < dz                    &
    840875                                   )
    … …  
    854889                   i = ( particles(n)%x + 0.5_wp * dx ) * ddx
    855890                   j = ( particles(n)%y + 0.5_wp * dy ) * ddy
    856                    IF ( particles(n)%z <= zw(nzb_w_inner(j,i)) )  THEN
     891                   k =   particles(n)%z / dz + 1 + offset_ocean_nzt
     892!
     893!--                Check if particle is within topography
     894                   IF ( .NOT. BTEST( wall_flags_0(k,j,i), 0 ) )  THEN
    857895                      particles(n)%particle_mask = .FALSE.
    858896                      deleted_particles = deleted_particles + 1
    859897                   ENDIF
     898
    860899                ENDDO
    861900             ENDDO

  • palm/trunk/SOURCE/lpm_init_sgs_tke.f90

    r2101 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments according to new topography realization
    2323!
    2424! Former revisions:
    … …  
    7373
    7474    USE indices,                                                               &
    75         ONLY:  nbgp, ngp_2dh_outer, nxl, nxr, nyn, nys, nzb, nzb_s_inner,      &
    76                nzb_s_outer, nzt
     75        ONLY:  nbgp, ngp_2dh_outer, nxl, nxr, nyn, nys, nzb,                   &
     76               nzb_s_outer, nzt, wall_flags_0
    7777
    7878    USE kinds
    … …  
    8686        ONLY:  flow_statistics_called, hom, sums, sums_l
    8787
     88    USE surface_mod,                                                           &
     89        ONLY:  bc_h
     90
    8891    IMPLICIT NONE
    8992
    90     INTEGER(iwp) ::  i      !<
    91     INTEGER(iwp) ::  j      !<
    92     INTEGER(iwp) ::  k      !<
    93 
     93    INTEGER(iwp) ::  i      !< index variable along x
     94    INTEGER(iwp) ::  j      !< index variable along y
     95    INTEGER(iwp) ::  k      !< index variable along z
     96    INTEGER(iwp) ::  m      !< running index for the surface elements
     97
     98    REAL(wp) ::  flag1      !< flag to mask topography
    9499
    95100!
    … …  
    99104          DO  k = nzb, nzt+1
    100105
    101              IF ( k <= nzb_s_inner(j,i-1)  .AND.  k > nzb_s_inner(j,i)  .AND.  &
    102                   k  > nzb_s_inner(j,i+1) )                                    &
     106             IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 )  .AND.               &
     107                        BTEST( wall_flags_0(k,j,i), 0   )  .AND.               &
     108                        BTEST( wall_flags_0(k,j,i+1), 0 ) )                    &
    103109             THEN
    104110                de_dx(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    105111                               ( e(k,j,i+1) - e(k,j,i) ) * ddx
    106              ELSEIF ( k  > nzb_s_inner(j,i-1)  .AND.  k > nzb_s_inner(j,i)     &
    107                       .AND.  k <= nzb_s_inner(j,i+1) )                         &
     112             ELSEIF ( BTEST( wall_flags_0(k,j,i-1), 0 )  .AND.                 &
     113                      BTEST( wall_flags_0(k,j,i), 0   )  .AND.                 &
     114                .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )                      &
    108115             THEN
    109116                de_dx(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    110117                               ( e(k,j,i) - e(k,j,i-1) ) * ddx
    111              ELSEIF ( k < nzb_s_inner(j,i)  .AND.  k < nzb_s_inner(j,i+1) )    &
     118             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j,i), 22   )  .AND.          &
     119                      .NOT. BTEST( wall_flags_0(k,j,i+1), 22 ) )               &   
    112120             THEN
    113121                de_dx(k,j,i) = 0.0_wp
    114              ELSEIF ( k < nzb_s_inner(j,i-1)  .AND.  k < nzb_s_inner(j,i) )    &
     122             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 22 )  .AND.          &
     123                      .NOT. BTEST( wall_flags_0(k,j,i), 22   ) )               &
    115124             THEN
    116125                de_dx(k,j,i) = 0.0_wp
    … …  
    119128             ENDIF
    120129
    121              IF ( k <= nzb_s_inner(j-1,i)  .AND.  k > nzb_s_inner(j,i)  .AND.  &
    122                   k  > nzb_s_inner(j+1,i) )                                    &
     130             IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 )  .AND.               &
     131                        BTEST( wall_flags_0(k,j,i), 0   )  .AND.               &
     132                        BTEST( wall_flags_0(k,j+1,i), 0 ) )                    &
    123133             THEN
    124134                de_dy(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    125135                               ( e(k,j+1,i) - e(k,j,i) ) * ddy
    126              ELSEIF ( k  > nzb_s_inner(j-1,i)  .AND.  k  > nzb_s_inner(j,i)    &
    127                       .AND.  k <= nzb_s_inner(j+1,i) )                         &
     136             ELSEIF ( BTEST( wall_flags_0(k,j-1,i), 0 )  .AND.                 &
     137                      BTEST( wall_flags_0(k,j,i), 0   )  .AND.                 &
     138                .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )                      &
    128139             THEN
    129140                de_dy(k,j,i) = 2.0_wp * sgs_wf_part *                          &
    130141                               ( e(k,j,i) - e(k,j-1,i) ) * ddy
    131              ELSEIF ( k < nzb_s_inner(j,i)  .AND.  k < nzb_s_inner(j+1,i) )    &
     142             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j,i), 22   )  .AND.          &
     143                      .NOT. BTEST( wall_flags_0(k,j+1,i), 22 ) )               &   
    132144             THEN
    133145                de_dy(k,j,i) = 0.0_wp
    134              ELSEIF ( k < nzb_s_inner(j-1,i)  .AND.  k < nzb_s_inner(j,i) )    &
     146             ELSEIF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 22 )  .AND.          &
     147                      .NOT. BTEST( wall_flags_0(k,j,i), 22   ) )               &
    135148             THEN
    136149                de_dy(k,j,i) = 0.0_wp
    … …  
    144157
    145158!
    146 !-- TKE gradient along z, including bottom and top boundary conditions
     159!-- TKE gradient along z at topograhy and including bottom and top boundary conditions
    147160    DO  i = nxl, nxr
    148161       DO  j = nys, nyn
    149 
    150           DO  k = nzb_s_inner(j,i)+2, nzt-1
    151              de_dz(k,j,i)  = 2.0_wp * sgs_wf_part *                            &
    152                              ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1)-zu(k-1) )
    153           ENDDO
    154 
    155           k = nzb_s_inner(j,i)
    156           de_dz(nzb:k,j,i) = 0.0_wp
    157           de_dz(k+1,j,i)   = 2.0_wp * sgs_wf_part *                            &
    158                              ( e(k+2,j,i) - e(k+1,j,i) ) / ( zu(k+2) - zu(k+1) )
     162          DO  k = nzb+1, nzt-1
     163!
     164!--          Flag to mask topography
     165             flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0  ) )
     166
     167             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                             &
     168                           ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1) - zu(k-1) ) &
     169                                                 * flag1
     170          ENDDO
     171!
     172!--       upward-facing surfaces
     173          DO  m = bc_h(0)%start_index(j,i), bc_h(0)%end_index(j,i)
     174             k            = bc_h(0)%k(m)
     175             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                             &
     176                           ( e(k+1,j,i) - e(k,j,i)   ) / ( zu(k+1) - zu(k) )
     177          ENDDO
     178!
     179!--       downward-facing surfaces
     180          DO  m = bc_h(1)%start_index(j,i), bc_h(1)%end_index(j,i)
     181             k            = bc_h(1)%k(m)
     182             de_dz(k,j,i) = 2.0_wp * sgs_wf_part *                             &
     183                           ( e(k,j,i) - e(k-1,j,i)   ) / ( zu(k) - zu(k-1) )
     184          ENDDO
     185
     186          de_dz(nzb,j,i)   = 0.0_wp
    159187          de_dz(nzt,j,i)   = 0.0_wp
    160188          de_dz(nzt+1,j,i) = 0.0_wp
    161189       ENDDO
    162190    ENDDO
    163 
    164 
    165 !
    166 !-- Lateral boundary conditions
     191!
     192!-- Ghost point exchange
    167193    CALL exchange_horiz( de_dx, nbgp )
    168194    CALL exchange_horiz( de_dy, nbgp )
    … …  
    185211       DO  i = nxl, nxr
    186212          DO  j =  nys, nyn
    187              DO  k = nzb_s_outer(j,i), nzt+1
    188                 sums_l(k,1,0)  = sums_l(k,1,0)  + u(k,j,i)
    189                 sums_l(k,2,0)  = sums_l(k,2,0)  + v(k,j,i)
     213             DO  k = nzb, nzt+1
     214!
     215!--             Flag indicate nzb_s_outer
     216                flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 24 ) )
     217
     218                sums_l(k,1,0)  = sums_l(k,1,0)  + u(k,j,i) * flag1
     219                sums_l(k,2,0)  = sums_l(k,2,0)  + v(k,j,i) * flag1
    190220             ENDDO
    191221          ENDDO
    … …  
    221251       DO  i = nxl, nxr
    222252          DO  j = nys, nyn
    223              DO  k = nzb_s_outer(j,i), nzt+1
    224                 sums_l(k,8,0)  = sums_l(k,8,0)  + e(k,j,i)
    225                 sums_l(k,30,0) = sums_l(k,30,0) + ( u(k,j,i) - hom(k,1,1,0) )**2
    226                 sums_l(k,31,0) = sums_l(k,31,0) + ( v(k,j,i) - hom(k,1,2,0) )**2
    227                 sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2
     253             DO  k = nzb, nzt+1
     254!
     255!--             Flag indicate nzb_s_outer
     256                flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 24 ) )
     257
     258                sums_l(k,8,0)  = sums_l(k,8,0)  + e(k,j,i)                       * flag1
     259                sums_l(k,30,0) = sums_l(k,30,0) + ( u(k,j,i) - hom(k,1,1,0) )**2 * flag1
     260                sums_l(k,31,0) = sums_l(k,31,0) + ( v(k,j,i) - hom(k,1,2,0) )**2 * flag1
     261                sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2                    * flag1
    228262             ENDDO
    229263          ENDDO

  • palm/trunk/SOURCE/ls_forcing_mod.f90

    r2105 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adopt to new topography structure, even though no well-conceived topography
     23! concept concerning nudging and large-scale for exist so far.
     24!
     25! Also adopt to new surface-structure, i.e. fluxes are obtained from data-types
    2326!
    2427! Former revisions:
    … …  
    356359
    357360       USE arrays_3d,                                                          &
    358            ONLY:  p_surf, pt_surf, q_surf, qsws, qsws_surf, shf, shf_surf,     &
     361           ONLY:  p_surf, pt_surf, q_surf, qsws_surf, shf_surf,                &
    359362                  heatflux_input_conversion, waterflux_input_conversion,       &
    360363                  time_surf, time_vert, ug, ug_vert, vg, vg_vert
    … …  
    369372       USE kinds
    370373
     374       USE surface_mod,                                                        &
     375           ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
     376
    371377       IMPLICIT NONE
    372378
    373379       INTEGER(iwp) ::  nt                     !<
    374380
     381       REAL(wp)             :: dum_surf_flux  !<
    375382       REAL(wp)             :: fac            !<
    376383       REAL(wp), INTENT(in) :: time           !<
    … …  
    398405!--       In case of Neumann boundary condition pt_surface is needed for
    399406!--       calculation of reference density
    400           shf        = ( shf_surf(nt) + fac * ( shf_surf(nt+1) - shf_surf(nt) )&
    401                        ) * heatflux_input_conversion(nzb)
    402           pt_surface = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
     407          dum_surf_flux = ( shf_surf(nt) + fac *                               &
     408                            ( shf_surf(nt+1) - shf_surf(nt) )                  &
     409                          ) * heatflux_input_conversion(nzb)
     410!
     411!--       Save surface sensible heat flux on default, natural and urban surface
     412!--       type, if required
     413          IF ( surf_def_h(0)%ns >= 1 )  surf_def_h(0)%shf(:) = dum_surf_flux
     414          IF ( surf_lsm_h%ns    >= 1 )  surf_lsm_h%shf(:)    = dum_surf_flux
     415          IF ( surf_usm_h%ns    >= 1 )  surf_usm_h%shf(:)    = dum_surf_flux
     416
     417          pt_surface    = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
    403418
    404419       ENDIF
    … …  
    411426
    412427       ELSEIF ( ibc_q_b == 1 )  THEN
    413 
    414           qsws = ( qsws_surf(nt) + fac * ( qsws_surf(nt+1) - qsws_surf(nt) )   &
    415                  ) * waterflux_input_conversion(nzb)
     428          dum_surf_flux = ( qsws_surf(nt) + fac *                              &
     429                             ( qsws_surf(nt+1) - qsws_surf(nt) )               &
     430                             ) * waterflux_input_conversion(nzb)
     431!
     432!--       Save surface sensible heat flux on default, natural and urban surface
     433!--       type, if required
     434          IF ( surf_def_h(0)%ns >= 1 )  surf_def_h(0)%qsws(:) = dum_surf_flux
     435          IF ( surf_lsm_h%ns    >= 1 )  surf_lsm_h%qsws(:)    = dum_surf_flux
     436          IF ( surf_usm_h%ns    >= 1 )  surf_usm_h%qsws(:)    = dum_surf_flux
    416437
    417438       ENDIF
    … …  
    516537             DO  i = nxl, nxr
    517538                DO  j = nys, nyn
    518                    DO  k = nzb_u_inner(j,i)+1, nzt
     539                   DO  k = nzb+1, nzt
    519540                      tend(k,j,i) = tend(k,j,i) + td_lsa_lpt(k,nt) + fac *     &
    520                                     ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )
     541                                    ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) ) *&
     542                                        MERGE( 1.0_wp, 0.0_wp,                 &
     543                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    521544                   ENDDO
    522545                ENDDO
    … …  
    527550             DO  i = nxl, nxr
    528551                DO  j = nys, nyn
    529                    DO  k = nzb_u_inner(j,i)+1, nzt
     552                   DO  k = nzb+1, nzt
    530553                      tend(k,j,i) = tend(k,j,i) + td_lsa_q(k,nt) + fac *       &
    531                                     ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) )
     554                                    ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) ) *    &
     555                                        MERGE( 1.0_wp, 0.0_wp,                 &
     556                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    532557                   ENDDO
    533558                ENDDO
    … …  
    546571                DO  i = nxl, nxr
    547572                   DO  j = nys, nyn
    548                       DO  k = nzb_u_inner(j,i)+1, nzt
     573                      DO  k = nzb+1, nzt
    549574                         tend(k,j,i) = tend(k,j,i) + td_sub_lpt(k,nt) + fac *  &
    550                                        ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )
     575                                     ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )*&
     576                                        MERGE( 1.0_wp, 0.0_wp,                 &
     577                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    551578                      ENDDO
    552579                   ENDDO
    … …  
    557584                DO  i = nxl, nxr
    558585                   DO  j = nys, nyn
    559                       DO  k = nzb_u_inner(j,i)+1, nzt
     586                      DO  k = nzb+1, nzt
    560587                         tend(k,j,i) = tend(k,j,i) + td_sub_q(k,nt) + fac *    &
    561                                        ( td_sub_q(k,nt+1) - td_sub_q(k,nt) )
     588                                       ( td_sub_q(k,nt+1) - td_sub_q(k,nt) ) * &
     589                                        MERGE( 1.0_wp, 0.0_wp,                 &
     590                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    562591                      ENDDO
    563592                   ENDDO
    … …  
    618647          CASE ( 'pt' )
    619648
    620              DO  k = nzb_u_inner(j,i)+1, nzt
     649             DO  k = nzb+1, nzt
    621650                tend(k,j,i) = tend(k,j,i) + td_lsa_lpt(k,nt)                   &
    622                               + fac * ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )
     651                             + fac * ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )*&
     652                                        MERGE( 1.0_wp, 0.0_wp,                 &
     653                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    623654             ENDDO
    624655
    625656          CASE ( 'q' )
    626657
    627              DO  k = nzb_u_inner(j,i)+1, nzt
     658             DO  k = nzb+1, nzt
    628659                tend(k,j,i) = tend(k,j,i) + td_lsa_q(k,nt)                     &
    629                               + fac * ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) )
     660                              + fac * ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) ) *  &
     661                                        MERGE( 1.0_wp, 0.0_wp,                 &
     662                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    630663             ENDDO
    631664
    … …  
    640673             CASE ( 'pt' )
    641674
    642                 DO  k = nzb_u_inner(j,i)+1, nzt
     675                DO  k = nzb+1, nzt
    643676                   tend(k,j,i) = tend(k,j,i) + td_sub_lpt(k,nt) + fac *        &
    644                                  ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )
     677                                 ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) ) *   &
     678                                        MERGE( 1.0_wp, 0.0_wp,                 &
     679                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    645680                ENDDO
    646681 
    647682             CASE ( 'q' )
    648683
    649                 DO  k = nzb_u_inner(j,i)+1, nzt
     684                DO  k = nzb+1, nzt
    650685                   tend(k,j,i) = tend(k,j,i) + td_sub_q(k,nt) + fac *          &
    651                                  ( td_sub_q(k,nt+1) - td_sub_q(k,nt) )
     686                                 ( td_sub_q(k,nt+1) - td_sub_q(k,nt) ) *       &
     687                                        MERGE( 1.0_wp, 0.0_wp,                 &
     688                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    652689                ENDDO
    653690

  • palm/trunk/SOURCE/microphysics_mod.f90

    r2156 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    402402
    403403       USE indices,                                                            &
    404            ONLY:  nxlg, nxrg, nysg, nyng, nzb_s_inner, nzt
     404           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    405405
    406406       USE kinds
    … …  
    416416       DO  i = nxlg, nxrg
    417417          DO  j = nysg, nyng
    418              DO  k = nzb_s_inner(j,i)+1, nzt
     418             DO  k = nzb+1, nzt
    419419                IF ( qr(k,j,i) <= eps_sb )  THEN
    420420                   qr(k,j,i) = 0.0_wp
    … …  
    422422                ELSE
    423423                   IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) )  THEN
    424                       nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin
     424                      nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin *               &
     425                                       MERGE( 1.0_wp, 0.0_wp,                  &           
     426                                              BTEST( wall_flags_0(k,j,i), 0 ) )
    425427                   ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) )  THEN
    426                       nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax
     428                      nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax *               &
     429                                       MERGE( 1.0_wp, 0.0_wp,                  &           
     430                                              BTEST( wall_flags_0(k,j,i), 0 ) )
    427431                   ENDIF
    428432                ENDIF
    … …  
    459463
    460464       USE indices,                                                            &
    461            ONLY:  nxlg, nxrg, nysg, nyng, nzb_s_inner, nzt
     465           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    462466
    463467       USE kinds
    … …  
    472476       REAL(wp)     ::  autocon           !<
    473477       REAL(wp)     ::  dissipation       !<
     478       REAL(wp)     ::  flag              !< flag to mask topography grid points
    474479       REAL(wp)     ::  k_au              !<
    475480       REAL(wp)     ::  l_mix             !<
    … …  
    487492       DO  i = nxlg, nxrg
    488493          DO  j = nysg, nyng
    489              DO  k = nzb_s_inner(j,i)+1, nzt
     494             DO  k = nzb+1, nzt
     495!
     496!--             Predetermine flag to mask topography
     497                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    490498
    491499                IF ( qc(k,j,i) > eps_sb )  THEN
    … …  
    554562                   autocon = MIN( autocon, qc(k,j,i) / dt_micro )
    555563
    556                    qr(k,j,i) = qr(k,j,i) + autocon * dt_micro
    557                    qc(k,j,i) = qc(k,j,i) - autocon * dt_micro
    558                    nr(k,j,i) = nr(k,j,i) + autocon / x0 * hyrho(k) * dt_micro
     564                   qr(k,j,i) = qr(k,j,i) + autocon * dt_micro * flag
     565                   qc(k,j,i) = qc(k,j,i) - autocon * dt_micro * flag
     566                   nr(k,j,i) = nr(k,j,i) + autocon / x0 * hyrho(k) * dt_micro  &
     567                                                              * flag
    559568
    560569                ENDIF
    … …  
    583592
    584593       USE indices,                                                            &
    585            ONLY:  nxlg, nxrg, nyng, nysg, nzb_s_inner, nzt
     594           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    586595
    587596       USE kinds
    … …  
    590599       IMPLICIT NONE
    591600
    592        INTEGER(iwp) ::  i !<
    593        INTEGER(iwp) ::  j !<
    594        INTEGER(iwp) ::  k !<
     601       INTEGER(iwp) ::  i      !<
     602       INTEGER(iwp) ::  j      !<
     603       INTEGER(iwp) ::  k      !<
     604       INTEGER(iwp) ::  k_wall !< topgraphy top index
    595605
    596606       REAL(wp)    ::  dqdt_precip !<
     607       REAL(wp)    ::  flag        !< flag to mask topography grid points
    597608
    598609       DO  i = nxlg, nxrg
    599610          DO  j = nysg, nyng
    600              DO  k = nzb_s_inner(j,i)+1, nzt
     611!
     612!--          Determine vertical index of topography top
     613             k_wall = MAXLOC(                                                  &
     614                          MERGE( 1, 0,                                         &
     615                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     616                               ), DIM = 1                                      &
     617                            ) - 1
     618             DO  k = nzb+1, nzt
     619!
     620!--             Predetermine flag to mask topography
     621                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    601622
    602623                IF ( qc(k,j,i) > ql_crit )  THEN
    … …  
    606627                ENDIF
    607628
    608                 qc(k,j,i) = qc(k,j,i) - dqdt_precip * dt_micro
    609                 q(k,j,i)  = q(k,j,i)  - dqdt_precip * dt_micro
     629                qc(k,j,i) = qc(k,j,i) - dqdt_precip * dt_micro * flag
     630                q(k,j,i)  = q(k,j,i)  - dqdt_precip * dt_micro * flag
    610631                pt(k,j,i) = pt(k,j,i) + dqdt_precip * dt_micro * l_d_cp *      &
    611                                         pt_d_t(k)
     632                                        pt_d_t(k)              * flag
    612633
    613634!
    614635!--             Compute the rain rate (stored on surface grid point)
    615                 prr(nzb_s_inner(j,i),j,i) = prr(nzb_s_inner(j,i),j,i) +        &
    616                                             dqdt_precip * dzw(k)
     636                prr(k_wall,j,i) = prr(k_wall,j,i) + dqdt_precip * dzw(k) * flag
    617637
    618638             ENDDO
    … …  
    643663
    644664       USE indices,                                                            &
    645            ONLY:  nxlg, nxrg, nysg, nyng, nzb_s_inner, nzt
     665           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    646666
    647667       USE kinds
    … …  
    654674
    655675       REAL(wp)     ::  accr              !<
     676       REAL(wp)     ::  flag              !< flag to mask topography grid points
    656677       REAL(wp)     ::  k_cr              !<
    657678       REAL(wp)     ::  phi_ac            !<
    … …  
    662683       DO  i = nxlg, nxrg
    663684          DO  j = nysg, nyng
    664              DO  k = nzb_s_inner(j,i)+1, nzt
     685             DO  k = nzb+1, nzt
     686!
     687!--             Predetermine flag to mask topography
     688                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    665689
    666690                IF ( ( qc(k,j,i) > eps_sb )  .AND.  ( qr(k,j,i) > eps_sb ) )  THEN
    … …  
    690714                   accr = MIN( accr, qc(k,j,i) / dt_micro )
    691715
    692                    qr(k,j,i) = qr(k,j,i) + accr * dt_micro
    693                    qc(k,j,i) = qc(k,j,i) - accr * dt_micro
     716                   qr(k,j,i) = qr(k,j,i) + accr * dt_micro * flag
     717                   qc(k,j,i) = qc(k,j,i) - accr * dt_micro * flag
    694718
    695719                ENDIF
    … …  
    724748
    725749       USE indices,                                                            &
    726            ONLY:  nxlg, nxrg, nysg, nyng, nzb_s_inner, nzt
     750           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    727751
    728752       USE kinds
    … …  
    736760       REAL(wp)     ::  breakup           !<
    737761       REAL(wp)     ::  dr                !<
     762       REAL(wp)     ::  flag              !< flag to mask topography grid points
    738763       REAL(wp)     ::  phi_br            !<
    739764       REAL(wp)     ::  selfcoll          !<
    … …  
    743768       DO  i = nxlg, nxrg
    744769          DO  j = nysg, nyng
    745              DO  k = nzb_s_inner(j,i)+1, nzt
     770             DO  k = nzb+1, nzt
     771!
     772!--             Predetermine flag to mask topography
     773                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     774
    746775                IF ( qr(k,j,i) > eps_sb )  THEN
    747776!
    … …  
    763792
    764793                   selfcoll = MAX( breakup - selfcoll, -nr(k,j,i) / dt_micro )
    765                    nr(k,j,i) = nr(k,j,i) + selfcoll * dt_micro
     794                   nr(k,j,i) = nr(k,j,i) + selfcoll * dt_micro * flag
    766795
    767796                ENDIF
    … …  
    796825
    797826       USE indices,                                                            &
    798            ONLY:  nxlg, nxrg, nysg, nyng, nzb_s_inner, nzt
     827           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    799828
    800829       USE kinds
    … …  
    812841       REAL(wp)     ::  evap_nr           !<
    813842       REAL(wp)     ::  f_vent            !<
     843       REAL(wp)     ::  flag              !< flag to mask topography grid points
    814844       REAL(wp)     ::  g_evap            !<
    815845       REAL(wp)     ::  lambda_r          !<
    … …  
    828858       DO  i = nxlg, nxrg
    829859          DO  j = nysg, nyng
    830              DO  k = nzb_s_inner(j,i)+1, nzt
     860             DO  k = nzb+1, nzt
     861!
     862!--             Predetermine flag to mask topography
     863                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     864
    831865                IF ( qr(k,j,i) > eps_sb )  THEN
    832866!
    … …  
    916950                                     -nr(k,j,i) / dt_micro )
    917951
    918                       qr(k,j,i) = qr(k,j,i) + evap    * dt_micro
    919                       nr(k,j,i) = nr(k,j,i) + evap_nr * dt_micro
     952                      qr(k,j,i) = qr(k,j,i) + evap    * dt_micro * flag
     953                      nr(k,j,i) = nr(k,j,i) + evap_nr * dt_micro * flag
    920954
    921955                   ENDIF
    … …  
    951985
    952986       USE indices,                                                            &
    953            ONLY:  nxlg, nxrg, nysg, nyng, nzb, nzb_s_inner, nzt
     987           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    954988
    955989       USE kinds
    … …  
    965999       INTEGER(iwp) ::  k             !<
    9661000
    967        REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc !<
     1001       REAL(wp)                       ::  flag   !< flag to mask topography grid points
     1002       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qc !<
    9681003
    9691004       CALL cpu_log( log_point_s(59), 'sed_cloud', 'start' )
    … …  
    9731008       DO  i = nxlg, nxrg
    9741009          DO  j = nysg, nyng
    975              DO  k = nzt, nzb_s_inner(j,i)+1, -1
     1010             DO  k = nzt, nzb+1, -1
     1011!
     1012!--             Predetermine flag to mask topography
     1013                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    9761014
    9771015                IF ( qc(k,j,i) > eps_sb )  THEN
    9781016                   sed_qc(k) = sed_qc_const * nc_const**( -2.0_wp / 3.0_wp ) * &
    979                                ( qc(k,j,i) * hyrho(k) )**( 5.0_wp / 3.0_wp )
     1017                               ( qc(k,j,i) * hyrho(k) )**( 5.0_wp / 3.0_wp ) * &
     1018                                                                           flag
    9801019                ELSE
    9811020                   sed_qc(k) = 0.0_wp
    … …  
    9841023                sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q(k,j,i) /   &
    9851024                                            dt_micro + sed_qc(k+1)             &
    986                                )
     1025                               ) * flag
    9871026
    9881027                q(k,j,i)  = q(k,j,i)  + ( sed_qc(k+1) - sed_qc(k) ) *          &
    989                                         ddzu(k+1) / hyrho(k) * dt_micro
     1028                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
    9901029                qc(k,j,i) = qc(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) *          &
    991                                         ddzu(k+1) / hyrho(k) * dt_micro
     1030                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
    9921031                pt(k,j,i) = pt(k,j,i) - ( sed_qc(k+1) - sed_qc(k) ) *          &
    9931032                                        ddzu(k+1) / hyrho(k) * l_d_cp *        &
    994                                         pt_d_t(k) * dt_micro
     1033                                        pt_d_t(k) * dt_micro            * flag
    9951034
    9961035!
    … …  
    9981037                IF ( call_microphysics_at_all_substeps )  THEN
    9991038                   prr(k,j,i) = prr(k,j,i) +  sed_qc(k) / hyrho(k)             &
    1000                                 * weight_substep(intermediate_timestep_count)
     1039                                * weight_substep(intermediate_timestep_count)  &
     1040                                * flag
    10011041                ELSE
    1002                    prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k)
     1042                   prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * flag
    10031043                ENDIF
    10041044
    … …  
    10321072
    10331073       USE indices,                                                            &
    1034            ONLY:  nxlg, nxrg, nysg, nyng, nzb, nzb_s_inner, nzt
     1074           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
    10351075
    10361076       USE kinds
    … …  
    10391079           ONLY:  weight_substep
    10401080
     1081       USE surface_mod,                                                        &
     1082           ONLY :  bc_h
     1083       
    10411084       IMPLICIT NONE
    10421085
    1043        INTEGER(iwp) ::  i                          !<
    1044        INTEGER(iwp) ::  j                          !<
    1045        INTEGER(iwp) ::  k                          !<
    1046        INTEGER(iwp) ::  k_run                      !<
     1086       INTEGER(iwp) ::  i             !< running index x direction
     1087       INTEGER(iwp) ::  j             !< running index y direction
     1088       INTEGER(iwp) ::  k             !< running index z direction
     1089       INTEGER(iwp) ::  k_run         !<
     1090       INTEGER(iwp) ::  l             !< running index of surface type
     1091       INTEGER(iwp) ::  m             !< running index surface elements
     1092       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     1093       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
    10471094
    10481095       REAL(wp)     ::  c_run                      !<
    … …  
    10521099       REAL(wp)     ::  dr                         !<
    10531100       REAL(wp)     ::  flux                       !<
     1101       REAL(wp)     ::  flag                       !< flag to mask topography grid points
    10541102       REAL(wp)     ::  lambda_r                   !<
    10551103       REAL(wp)     ::  mu_r                       !<
    … …  
    10711119       DO  i = nxlg, nxrg
    10721120          DO  j = nysg, nyng
    1073              DO  k = nzb_s_inner(j,i)+1, nzt
     1121             DO  k = nzb+1, nzt
     1122!
     1123!--             Predetermine flag to mask topography
     1124                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1125
    10741126                IF ( qr(k,j,i) > eps_sb )  THEN
    10751127!
    … …  
    10931145                                                  ( mu_r + 1.0_wp ) )          &
    10941146                                              )                                &
    1095                                 )
     1147                                ) * flag
    10961148
    10971149                   w_qr(k) = MAX( 0.1_wp, MIN( 20.0_wp,                        &
    … …  
    11011153                                                  ( mu_r + 4.0_wp ) )          &
    11021154                                             )                                 &
    1103                                 )
     1155                                ) * flag
    11041156                ELSE
    11051157                   w_nr(k) = 0.0_wp
    … …  
    11081160             ENDDO
    11091161!
    1110 !--          Adjust boundary values
    1111              w_nr(nzb_s_inner(j,i)) = w_nr(nzb_s_inner(j,i)+1)
    1112              w_qr(nzb_s_inner(j,i)) = w_qr(nzb_s_inner(j,i)+1)
     1162!--          Adjust boundary values using surface data type.
     1163!--          Upward-facing
     1164             surf_s = bc_h(0)%start_index(j,i)   
     1165             surf_e = bc_h(0)%end_index(j,i)
     1166             DO  m = surf_s, surf_e
     1167                k         = bc_h(0)%k(m)
     1168                w_nr(k-1) = w_nr(k)
     1169                w_qr(k-1) = w_qr(k)
     1170             ENDDO
     1171!
     1172!--          Downward-facing
     1173             surf_s = bc_h(1)%start_index(j,i)   
     1174             surf_e = bc_h(1)%end_index(j,i)
     1175             DO  m = surf_s, surf_e
     1176                k         = bc_h(1)%k(m)
     1177                w_nr(k+1) = w_nr(k)
     1178                w_qr(k+1) = w_qr(k)
     1179             ENDDO
     1180!
     1181!--          Model top boundary value
    11131182             w_nr(nzt+1) = 0.0_wp
    11141183             w_qr(nzt+1) = 0.0_wp
    11151184!
    11161185!--          Compute Courant number
    1117              DO  k = nzb_s_inner(j,i)+1, nzt
     1186             DO  k = nzb+1, nzt
     1187!
     1188!--             Predetermine flag to mask topography
     1189                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1190
    11181191                c_nr(k) = 0.25_wp * ( w_nr(k-1) +                              &
    11191192                                      2.0_wp * w_nr(k) + w_nr(k+1) ) *         &
    1120                           dt_micro * ddzu(k)
     1193                          dt_micro * ddzu(k) * flag
    11211194                c_qr(k) = 0.25_wp * ( w_qr(k-1) +                              &
    11221195                                      2.0_wp * w_qr(k) + w_qr(k+1) ) *         &
    1123                           dt_micro * ddzu(k)
     1196                          dt_micro * ddzu(k) * flag
    11241197             ENDDO
    11251198!
    … …  
    11271200             IF ( limiter_sedimentation )  THEN
    11281201
    1129                 DO k = nzb_s_inner(j,i)+1, nzt
     1202                DO k = nzb+1, nzt
     1203!
     1204!--                Predetermine flag to mask topography
     1205                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1206
    11301207                   d_mean = 0.5_wp * ( qr(k+1,j,i) - qr(k-1,j,i) )
    11311208                   d_min  = qr(k,j,i) - MIN( qr(k+1,j,i), qr(k,j,i), qr(k-1,j,i) )
    … …  
    11341211                   qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min,  &
    11351212                                                              2.0_wp * d_max,  &
    1136                                                               ABS( d_mean ) )
     1213                                                              ABS( d_mean ) )  &
     1214                                                      * flag
    11371215
    11381216                   d_mean = 0.5_wp * ( nr(k+1,j,i) - nr(k-1,j,i) )
    … …  
    11561234!
    11571235!--          Compute sedimentation flux
    1158              DO  k = nzt, nzb_s_inner(j,i)+1, -1
    1159 !
    1160 !--             Sum up all rain drop number densities which contribute to the flux
     1236             DO  k = nzt, nzb+1, -1
     1237!
     1238!--             Predetermine flag to mask topography
     1239                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1240!
     1241!--             Sum up all rain drop number densities which contribute to the flux
    11611242!--             through k-1/2
    11621243                flux  = 0.0_wp
    … …  
    11671248                   flux  = flux + hyrho(k_run) *                               &
    11681249                           ( nr(k_run,j,i) + nr_slope(k_run) *                 &
    1169                            ( 1.0_wp - c_run ) * 0.5_wp ) * c_run * dzu(k_run)
    1170                    z_run = z_run + dzu(k_run)
    1171                    k_run = k_run + 1
    1172                    c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) )
     1250                           ( 1.0_wp - c_run ) * 0.5_wp ) * c_run * dzu(k_run)  &
     1251                                              * flag
     1252                   z_run = z_run + dzu(k_run) * flag
     1253                   k_run = k_run + 1          * flag
     1254                   c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) )    &
     1255                                              * flag
    11731256                ENDDO
    11741257!
    … …  
    11801263                          )
    11811264
    1182                 sed_nr(k) = flux / dt_micro
     1265                sed_nr(k) = flux / dt_micro * flag
    11831266                nr(k,j,i) = nr(k,j,i) + ( sed_nr(k+1) - sed_nr(k) ) *          &
    1184                                         ddzu(k+1) / hyrho(k) * dt_micro
     1267                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
    11851268!
    11861269!--             Sum up all rain water content which contributes to the flux
    … …  
    11951278                   flux  = flux + hyrho(k_run) * ( qr(k_run,j,i) +             &
    11961279                                  qr_slope(k_run) * ( 1.0_wp - c_run ) *       &
    1197                                   0.5_wp ) * c_run * dzu(k_run)
    1198                    z_run = z_run + dzu(k_run)
    1199                    k_run = k_run + 1
    1200                    c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) )
     1280                                  0.5_wp ) * c_run * dzu(k_run) * flag
     1281                   z_run = z_run + dzu(k_run)                   * flag
     1282                   k_run = k_run + 1                            * flag
     1283                   c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) )    &
     1284                                                                * flag
    12011285
    12021286                ENDDO
    … …  
    12091293                          )
    12101294
    1211                 sed_qr(k) = flux / dt_micro
     1295                sed_qr(k) = flux / dt_micro * flag
    12121296
    12131297                qr(k,j,i) = qr(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) *          &
    1214                                         ddzu(k+1) / hyrho(k) * dt_micro
     1298                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
    12151299                q(k,j,i)  = q(k,j,i)  + ( sed_qr(k+1) - sed_qr(k) ) *          &
    1216                                         ddzu(k+1) / hyrho(k) * dt_micro
     1300                                        ddzu(k+1) / hyrho(k) * dt_micro * flag
    12171301                pt(k,j,i) = pt(k,j,i) - ( sed_qr(k+1) - sed_qr(k) ) *          &
    12181302                                        ddzu(k+1) / hyrho(k) * l_d_cp *        &
    1219                                         pt_d_t(k) * dt_micro
     1303                                        pt_d_t(k) * dt_micro            * flag
    12201304!
    12211305!--             Compute the rain rate
    12221306                IF ( call_microphysics_at_all_substeps )  THEN
    12231307                   prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k)             &
    1224                                 * weight_substep(intermediate_timestep_count)
     1308                                * weight_substep(intermediate_timestep_count) &
     1309                                * flag
    12251310                ELSE
    1226                    prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k)
     1311                   prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) * flag
    12271312                ENDIF
    12281313
    … …  
    12561341
    12571342       USE indices,                                                            &
    1258            ONLY:  nxl, nxr, nys, nyn, nzb_s_inner
     1343           ONLY:  nxl, nxr, nys, nyn, nzb, nzt, wall_flags_0
    12591344
    12601345       USE kinds
    12611346
     1347       USE surface_mod,                                                        &
     1348           ONLY :  bc_h
     1349
    12621350       IMPLICIT NONE
    12631351
    1264        INTEGER(iwp) ::  i                          !:
    1265        INTEGER(iwp) ::  j                          !:
    1266 
     1352       INTEGER(iwp) ::  i             !< running index x direction
     1353       INTEGER(iwp) ::  j             !< running index y direction
     1354       INTEGER(iwp) ::  k             !< running index y direction
     1355       INTEGER(iwp) ::  m             !< running index surface elements
     1356       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     1357       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
    12671358
    12681359       IF ( ( dt_do2d_xy - time_do2d_xy ) < precipitation_amount_interval .AND.&
    … …  
    12701361            intermediate_timestep_count == intermediate_timestep_count_max ) ) &
    12711362       THEN
    1272 
    1273           DO  i = nxl, nxr
    1274              DO  j = nys, nyn
    1275 
    1276                 precipitation_amount(j,i) = precipitation_amount(j,i) +        &
    1277                                             prr(nzb_s_inner(j,i)+1,j,i) *      &
    1278                                             hyrho(nzb_s_inner(j,i)+1) * dt_3d
    1279 
    1280              ENDDO
     1363!
     1364!--       Run over all upward-facing surface elements, i.e. non-natural,
     1365!--       natural and urban
     1366          DO  m = 1, bc_h(0)%ns
     1367             i = bc_h(0)%i(m)           
     1368             j = bc_h(0)%j(m)
     1369             k = bc_h(0)%k(m)
     1370             precipitation_amount(j,i) = precipitation_amount(j,i) +           &
     1371                                               prr(k,j,i) * hyrho(k) * dt_3d
    12811372          ENDDO
     1373
    12821374       ENDIF
    12831375
    … …  
    14101502
    14111503       USE indices,                                                            &
    1412            ONLY:  nzb_s_inner, nzt
     1504           ONLY:  nzb, nzt, wall_flags_0
    14131505
    14141506       USE kinds
    … …  
    14201512       INTEGER(iwp) ::  k                 !<
    14211513
    1422        DO  k = nzb_s_inner(j,i)+1, nzt
     1514       REAL(wp) ::  flag                  !< flag to indicate first grid level above surface
     1515
     1516       DO  k = nzb+1, nzt
     1517!
     1518!--       Predetermine flag to mask topography
     1519          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    14231520
    14241521          IF ( qr_1d(k) <= eps_sb )  THEN
    … …  
    14311528!--          too big weights of rain drops (Stevens and Seifert, 2008).
    14321529             IF ( nr_1d(k) * xrmin > qr_1d(k) * hyrho(k) )  THEN
    1433                 nr_1d(k) = qr_1d(k) * hyrho(k) / xrmin
     1530                nr_1d(k) = qr_1d(k) * hyrho(k) / xrmin * flag
    14341531             ELSEIF ( nr_1d(k) * xrmax < qr_1d(k) * hyrho(k) )  THEN
    1435                 nr_1d(k) = qr_1d(k) * hyrho(k) / xrmax
     1532                nr_1d(k) = qr_1d(k) * hyrho(k) / xrmax * flag
    14361533             ENDIF
    14371534
    … …  
    14631560
    14641561       USE indices,                                                            &
    1465            ONLY:  nzb_s_inner, nzt
     1562           ONLY:  nzb, nzt, wall_flags_0
    14661563
    14671564       USE kinds
    … …  
    14761573       REAL(wp)     ::  autocon           !<
    14771574       REAL(wp)     ::  dissipation       !<
     1575       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
    14781576       REAL(wp)     ::  k_au              !<
    14791577       REAL(wp)     ::  l_mix             !<
    … …  
    14871585       REAL(wp)     ::  xc                !<
    14881586
    1489        DO  k = nzb_s_inner(j,i)+1, nzt
     1587       DO  k = nzb+1, nzt
     1588!
     1589!--       Predetermine flag to mask topography
     1590          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    14901591
    14911592          IF ( qc_1d(k) > eps_sb )  THEN
    … …  
    15511652             autocon = MIN( autocon, qc_1d(k) / dt_micro )
    15521653
    1553              qr_1d(k) = qr_1d(k) + autocon * dt_micro
    1554              qc_1d(k) = qc_1d(k) - autocon * dt_micro
    1555              nr_1d(k) = nr_1d(k) + autocon / x0 * hyrho(k) * dt_micro
     1654             qr_1d(k) = qr_1d(k) + autocon * dt_micro                 * flag
     1655             qc_1d(k) = qc_1d(k) - autocon * dt_micro                 * flag
     1656             nr_1d(k) = nr_1d(k) + autocon / x0 * hyrho(k) * dt_micro * flag
    15561657
    15571658          ENDIF
    … …  
    15751676
    15761677       USE indices,                                                            &
    1577            ONLY:  nzb_s_inner, nzt
     1678           ONLY:  nzb, nzb_max, nzt, wall_flags_0
    15781679
    15791680       USE kinds
    … …  
    15821683       IMPLICIT NONE
    15831684
    1584        INTEGER(iwp) ::  i !<
    1585        INTEGER(iwp) ::  j !<
    1586        INTEGER(iwp) ::  k !<
     1685       INTEGER(iwp) ::  i      !<
     1686       INTEGER(iwp) ::  j      !<
     1687       INTEGER(iwp) ::  k      !<
     1688       INTEGER(iwp) ::  k_wall !< topography top index
    15871689
    15881690       REAL(wp)    ::  dqdt_precip !<
    1589 
    1590        DO  k = nzb_s_inner(j,i)+1, nzt
     1691       REAL(wp)    ::  flag              !< flag to indicate first grid level above surface
     1692
     1693!
     1694!--    Determine vertical index of topography top
     1695       k_wall = MAXLOC(                                                        &
     1696                        MERGE( 1, 0,                                           &
     1697                               BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )      &
     1698                             ), DIM = 1                                        &
     1699                      ) - 1
     1700       DO  k = nzb+1, nzt
     1701!
     1702!--       Predetermine flag to mask topography
     1703          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    15911704
    15921705          IF ( qc_1d(k) > ql_crit )  THEN
    … …  
    15961709          ENDIF
    15971710
    1598           qc_1d(k) = qc_1d(k) - dqdt_precip * dt_micro
    1599           q_1d(k)  = q_1d(k)  - dqdt_precip * dt_micro
    1600           pt_1d(k) = pt_1d(k) + dqdt_precip * dt_micro * l_d_cp * pt_d_t(k)
     1711          qc_1d(k) = qc_1d(k) - dqdt_precip * dt_micro * flag
     1712          q_1d(k)  = q_1d(k)  - dqdt_precip * dt_micro * flag
     1713          pt_1d(k) = pt_1d(k) + dqdt_precip * dt_micro * l_d_cp * pt_d_t(k) * flag
    16011714
    16021715!
    16031716!--       Compute the rain rate (stored on surface grid point)
    1604           prr(nzb_s_inner(j,i),j,i) = prr(nzb_s_inner(j,i),j,i) +              &
    1605                                       dqdt_precip * dzw(k)
     1717          prr(k_wall,j,i) = prr(k_wall,j,i) + dqdt_precip * dzw(k) * flag
    16061718
    16071719       ENDDO
    … …  
    16261738
    16271739       USE indices,                                                            &
    1628            ONLY:  nzb_s_inner, nzt
     1740           ONLY:  nzb, nzt, wall_flags_0
    16291741
    16301742       USE kinds
    … …  
    16371749
    16381750       REAL(wp)     ::  accr              !<
     1751       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
    16391752       REAL(wp)     ::  k_cr              !<
    16401753       REAL(wp)     ::  phi_ac            !<
    16411754       REAL(wp)     ::  tau_cloud         !<
    16421755
    1643        DO  k = nzb_s_inner(j,i)+1, nzt
     1756       DO  k = nzb+1, nzt
     1757!
     1758!--       Predetermine flag to mask topography
     1759          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1760
    16441761          IF ( ( qc_1d(k) > eps_sb )  .AND.  ( qr_1d(k) > eps_sb ) )  THEN
    16451762!
    … …  
    16671784             accr = MIN( accr, qc_1d(k) / dt_micro )
    16681785
    1669              qr_1d(k) = qr_1d(k) + accr * dt_micro
    1670              qc_1d(k) = qc_1d(k) - accr * dt_micro
     1786             qr_1d(k) = qr_1d(k) + accr * dt_micro * flag
     1787             qc_1d(k) = qc_1d(k) - accr * dt_micro * flag
    16711788
    16721789          ENDIF
    … …  
    16911808
    16921809       USE indices,                                                            &
    1693            ONLY:  nzb_s_inner, nzt
     1810           ONLY:  nzb, nzt, wall_flags_0
    16941811
    16951812       USE kinds
    … …  
    17031820       REAL(wp)     ::  breakup           !<
    17041821       REAL(wp)     ::  dr                !<
     1822       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
    17051823       REAL(wp)     ::  phi_br            !<
    17061824       REAL(wp)     ::  selfcoll          !<
    17071825
    1708        DO  k = nzb_s_inner(j,i)+1, nzt
     1826       DO  k = nzb+1, nzt
     1827!
     1828!--       Predetermine flag to mask topography
     1829          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1830
    17091831          IF ( qr_1d(k) > eps_sb )  THEN
    17101832!
    … …  
    17241846
    17251847             selfcoll = MAX( breakup - selfcoll, -nr_1d(k) / dt_micro )
    1726              nr_1d(k) = nr_1d(k) + selfcoll * dt_micro
     1848             nr_1d(k) = nr_1d(k) + selfcoll * dt_micro * flag
    17271849
    17281850          ENDIF
    … …  
    17501872
    17511873       USE indices,                                                            &
    1752            ONLY:  nzb_s_inner, nzt
     1874           ONLY:  nzb, nzt, wall_flags_0
    17531875
    17541876       USE kinds
    … …  
    17661888       REAL(wp)     ::  evap_nr           !<
    17671889       REAL(wp)     ::  f_vent            !<
     1890       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
    17681891       REAL(wp)     ::  g_evap            !<
    17691892       REAL(wp)     ::  lambda_r          !<
    … …  
    17781901       REAL(wp)     ::  xr                !<
    17791902
    1780        DO  k = nzb_s_inner(j,i)+1, nzt
     1903       DO  k = nzb+1, nzt
     1904!
     1905!--       Predetermine flag to mask topography
     1906          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1907
    17811908          IF ( qr_1d(k) > eps_sb )  THEN
    17821909!
    … …  
    18621989                               -nr_1d(k) / dt_micro )
    18631990
    1864                 qr_1d(k) = qr_1d(k) + evap    * dt_micro
    1865                 nr_1d(k) = nr_1d(k) + evap_nr * dt_micro
     1991                qr_1d(k) = qr_1d(k) + evap    * dt_micro * flag
     1992                nr_1d(k) = nr_1d(k) + evap_nr * dt_micro * flag
    18661993
    18671994             ENDIF
    … …  
    18912018
    18922019       USE indices,                                                            &
    1893            ONLY:  nzb, nzb_s_inner, nzt
     2020           ONLY:  nzb, nzb, nzt, wall_flags_0
    18942021
    18952022       USE kinds
    … …  
    19042031       INTEGER(iwp) ::  k             !<
    19052032
    1906        REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc  !<
     2033       REAL(wp)                       ::  flag    !< flag to indicate first grid level above surface
     2034       REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qc  !<
    19072035
    19082036       sed_qc(nzt+1) = 0.0_wp
    19092037
    1910        DO  k = nzt, nzb_s_inner(j,i)+1, -1
     2038       DO  k = nzt, nzb+1, -1
     2039!
     2040!--       Predetermine flag to mask topography
     2041          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     2042
    19112043          IF ( qc_1d(k) > eps_sb )  THEN
    19122044             sed_qc(k) = sed_qc_const * nc_1d(k)**( -2.0_wp / 3.0_wp ) *       &
    1913                          ( qc_1d(k) * hyrho(k) )**( 5.0_wp / 3.0_wp )
     2045                         ( qc_1d(k) * hyrho(k) )**( 5.0_wp / 3.0_wp )  * flag
    19142046          ELSE
    19152047             sed_qc(k) = 0.0_wp
    … …  
    19182050          sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q_1d(k) /          &
    19192051                                      dt_micro + sed_qc(k+1)                   &
    1920                          )
     2052                         ) * flag
    19212053
    19222054          q_1d(k)  = q_1d(k)  + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) /      &
    1923                                 hyrho(k) * dt_micro
     2055                                hyrho(k) * dt_micro * flag
    19242056          qc_1d(k) = qc_1d(k) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) /      &
    1925                                 hyrho(k) * dt_micro
     2057                                hyrho(k) * dt_micro * flag
    19262058          pt_1d(k) = pt_1d(k) - ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) /      &
    1927                                 hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro
     2059                                hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro * flag
    19282060
    19292061!
    19302062!--       Compute the precipitation rate of cloud (fog) droplets
    19312063          IF ( call_microphysics_at_all_substeps )  THEN
    1932              prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) *               &
    1933                              weight_substep(intermediate_timestep_count)
     2064             prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) *                  &
     2065                              weight_substep(intermediate_timestep_count) * flag
    19342066          ELSE
    1935              prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k)
     2067             prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * flag
    19362068          ENDIF
    19372069
    … …  
    19592091
    19602092       USE indices,                                                            &
    1961            ONLY:  nzb, nzb_s_inner, nzt
     2093           ONLY:  nzb, nzb, nzt, wall_flags_0
    19622094
    19632095       USE kinds
    … …  
    19662098           ONLY:  weight_substep
    19672099
     2100       USE surface_mod,                                                        &
     2101           ONLY :  bc_h
     2102       
    19682103       IMPLICIT NONE
    19692104
    1970        INTEGER(iwp) ::  i                          !<
    1971        INTEGER(iwp) ::  j                          !<
    1972        INTEGER(iwp) ::  k                          !<
    1973        INTEGER(iwp) ::  k_run                      !<
     2105       INTEGER(iwp) ::  i             !< running index x direction
     2106       INTEGER(iwp) ::  j             !< running index y direction
     2107       INTEGER(iwp) ::  k             !< running index z direction
     2108       INTEGER(iwp) ::  k_run         !<
     2109       INTEGER(iwp) ::  m             !< running index surface elements
     2110       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     2111       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
    19742112
    19752113       REAL(wp)     ::  c_run                      !<
    … …  
    19792117       REAL(wp)     ::  dr                         !<
    19802118       REAL(wp)     ::  flux                       !<
     2119       REAL(wp)     ::  flag                       !< flag to indicate first grid level above surface
    19812120       REAL(wp)     ::  lambda_r                   !<
    19822121       REAL(wp)     ::  mu_r                       !<
    … …  
    19942133!
    19952134!--    Compute velocities
    1996        DO  k = nzb_s_inner(j,i)+1, nzt
     2135       DO  k = nzb+1, nzt
     2136!
     2137!--       Predetermine flag to mask topography
     2138          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     2139
    19972140          IF ( qr_1d(k) > eps_sb )  THEN
    19982141!
    … …  
    20132156                                            ( mu_r + 1.0_wp ) )                &
    20142157                                        )                                      &
    2015                           )
     2158                          ) * flag
    20162159             w_qr(k) = MAX( 0.1_wp, MIN( 20.0_wp,                              &
    20172160                                         a_term - b_term * ( 1.0_wp +          &
    … …  
    20192162                                            ( mu_r + 4.0_wp ) )                &
    20202163                                       )                                       &
    2021                           )
     2164                          ) * flag
    20222165          ELSE
    20232166             w_nr(k) = 0.0_wp
    … …  
    20262169       ENDDO
    20272170!
    2028 !--    Adjust boundary values
    2029        w_nr(nzb_s_inner(j,i)) = w_nr(nzb_s_inner(j,i)+1)
    2030        w_qr(nzb_s_inner(j,i)) = w_qr(nzb_s_inner(j,i)+1)
     2171!--    Adjust boundary values using surface data type.
     2172!--    Upward facing non-natural
     2173       surf_s = bc_h(0)%start_index(j,i)   
     2174       surf_e = bc_h(0)%end_index(j,i)
     2175       DO  m = surf_s, surf_e
     2176          k         = bc_h(0)%k(m)
     2177          w_nr(k-1) = w_nr(k)
     2178          w_qr(k-1) = w_qr(k)
     2179       ENDDO
     2180!
     2181!--    Downward facing non-natural
     2182       surf_s = bc_h(1)%start_index(j,i)   
     2183       surf_e = bc_h(1)%end_index(j,i)
     2184       DO  m = surf_s, surf_e
     2185          k         = bc_h(1)%k(m)
     2186          w_nr(k+1) = w_nr(k)
     2187          w_qr(k+1) = w_qr(k)
     2188       ENDDO
     2189!
     2190!--    Neumann boundary condition at model top
    20312191       w_nr(nzt+1) = 0.0_wp
    20322192       w_qr(nzt+1) = 0.0_wp
    20332193!
    20342194!--    Compute Courant number
    2035        DO  k = nzb_s_inner(j,i)+1, nzt
     2195       DO  k = nzb+1, nzt
     2196!
     2197!--       Predetermine flag to mask topography
     2198          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     2199
    20362200          c_nr(k) = 0.25_wp * ( w_nr(k-1) + 2.0_wp * w_nr(k) + w_nr(k+1) ) *   &
    2037                     dt_micro * ddzu(k)
     2201                    dt_micro * ddzu(k) * flag
    20382202          c_qr(k) = 0.25_wp * ( w_qr(k-1) + 2.0_wp * w_qr(k) + w_qr(k+1) ) *   &
    2039                     dt_micro * ddzu(k)
     2203                    dt_micro * ddzu(k) * flag
    20402204       ENDDO
    20412205!
    … …  
    20432207       IF ( limiter_sedimentation )  THEN
    20442208
    2045           DO k = nzb_s_inner(j,i)+1, nzt
     2209          DO k = nzb+1, nzt
     2210!
     2211!--          Predetermine flag to mask topography
     2212             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     2213
    20462214             d_mean = 0.5_wp * ( qr_1d(k+1) - qr_1d(k-1) )
    20472215             d_min  = qr_1d(k) - MIN( qr_1d(k+1), qr_1d(k), qr_1d(k-1) )
    … …  
    20502218             qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min,        &
    20512219                                                        2.0_wp * d_max,        &
    2052                                                         ABS( d_mean ) )
     2220                                                        ABS( d_mean ) ) * flag
    20532221
    20542222             d_mean = 0.5_wp * ( nr_1d(k+1) - nr_1d(k-1) )
    … …  
    20582226             nr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min,        &
    20592227                                                        2.0_wp * d_max,        &
    2060                                                         ABS( d_mean ) )
     2228                                                        ABS( d_mean ) ) * flag
    20612229          ENDDO
    20622230
    … …  
    20722240!
    20732241!--    Compute sedimentation flux
    2074        DO  k = nzt, nzb_s_inner(j,i)+1, -1
    2075 !
    2076 !--       Sum up all rain drop number densities which contribute to the flux
     2242       DO  k = nzt, nzb+1, -1
     2243!
     2244!--       Predetermine flag to mask topography
     2245          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     2246!
     2247!--       Sum up all rain drop number densities which contribute to the flux
    20772248!--       through k-1/2
    20782249          flux  = 0.0_wp
    … …  
    20832254             flux  = flux + hyrho(k_run) *                                     &
    20842255                     ( nr_1d(k_run) + nr_slope(k_run) * ( 1.0_wp - c_run ) *   &
    2085                      0.5_wp ) * c_run * dzu(k_run)
    2086              z_run = z_run + dzu(k_run)
    2087              k_run = k_run + 1
    2088              c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) )
     2256                     0.5_wp ) * c_run * dzu(k_run) * flag
     2257             z_run = z_run + dzu(k_run)            * flag
     2258             k_run = k_run + 1                     * flag
     2259             c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) * flag
    20892260          ENDDO
    20902261!
    … …  
    20942265                      hyrho(k) * dzu(k+1) * nr_1d(k) + sed_nr(k+1) * dt_micro )
    20952266
    2096           sed_nr(k) = flux / dt_micro
     2267          sed_nr(k) = flux / dt_micro * flag
    20972268          nr_1d(k)  = nr_1d(k) + ( sed_nr(k+1) - sed_nr(k) ) * ddzu(k+1) /     &
    2098                                     hyrho(k) * dt_micro
     2269                                    hyrho(k) * dt_micro * flag
    20992270!
    21002271!--       Sum up all rain water content which contributes to the flux
    … …  
    21092280             flux  = flux + hyrho(k_run) *                                     &
    21102281                     ( qr_1d(k_run) + qr_slope(k_run) * ( 1.0_wp - c_run ) *   &
    2111                      0.5_wp ) * c_run * dzu(k_run)
    2112              z_run = z_run + dzu(k_run)
    2113              k_run = k_run + 1
    2114              c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) )
     2282                     0.5_wp ) * c_run * dzu(k_run) * flag
     2283             z_run = z_run + dzu(k_run)            * flag
     2284             k_run = k_run + 1                     * flag
     2285             c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) * flag
    21152286
    21162287          ENDDO
    … …  
    21202291                      hyrho(k) * dzu(k) * qr_1d(k) + sed_qr(k+1) * dt_micro )
    21212292
    2122           sed_qr(k) = flux / dt_micro
     2293          sed_qr(k) = flux / dt_micro * flag
    21232294
    21242295          qr_1d(k) = qr_1d(k) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) /      &
    2125                                 hyrho(k) * dt_micro
     2296                                hyrho(k) * dt_micro * flag
    21262297          q_1d(k)  = q_1d(k)  + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) /      &
    2127                                 hyrho(k) * dt_micro
     2298                                hyrho(k) * dt_micro * flag
    21282299          pt_1d(k) = pt_1d(k) - ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) /      &
    2129                                 hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro
     2300                                hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro * flag
    21302301!
    21312302!--       Compute the rain rate
    21322303          IF ( call_microphysics_at_all_substeps )  THEN
    21332304             prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k)                    &
    2134                           * weight_substep(intermediate_timestep_count)
     2305                          * weight_substep(intermediate_timestep_count) * flag
    21352306          ELSE
    2136              prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k)
     2307             prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) * flag
    21372308          ENDIF
    21382309
    … …  
    21622333
    21632334       USE indices,                                                            &
    2164            ONLY:  nzb_s_inner
     2335           ONLY:  nzb, nzt, wall_flags_0
    21652336
    21662337       USE kinds
    21672338
     2339       USE surface_mod,                                                        &
     2340           ONLY :  bc_h
     2341
    21682342       IMPLICIT NONE
    21692343
    2170        INTEGER(iwp) ::  i                          !:
    2171        INTEGER(iwp) ::  j                          !:
    2172 
     2344       INTEGER(iwp) ::  i             !< running index x direction
     2345       INTEGER(iwp) ::  j             !< running index y direction
     2346       INTEGER(iwp) ::  k             !< running index z direction
     2347       INTEGER(iwp) ::  m             !< running index surface elements
     2348       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
     2349       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
    21732350
    21742351       IF ( ( dt_do2d_xy - time_do2d_xy ) < precipitation_amount_interval .AND.&
    … …  
    21772354       THEN
    21782355
    2179           precipitation_amount(j,i) = precipitation_amount(j,i) +              &
    2180                                       prr(nzb_s_inner(j,i)+1,j,i) *            &
    2181                                       hyrho(nzb_s_inner(j,i)+1) * dt_3d
     2356          surf_s = bc_h(0)%start_index(j,i)   
     2357          surf_e = bc_h(0)%end_index(j,i)
     2358          DO  m = surf_s, surf_e
     2359             k                         = bc_h(0)%k(m)
     2360             precipitation_amount(j,i) = precipitation_amount(j,i) +           &
     2361                                               prr(k,j,i) * hyrho(k) * dt_3d
     2362          ENDDO
     2363
    21822364       ENDIF
    21832365

  • palm/trunk/SOURCE/modules.f90

    r2201 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Renamed wall_flags_0 and wall_flags_00 into advc_flags_1 and advc_flags_2,
     23! respectively. Moreover, introduced further flag array wall_flags_0.
     24!
     25! Adjustments for new topography concept:
     26!   -fwxm, fwxp, fwym, fwyp, fxm, fxp, fym, fyp, rif_wall, wall_e_x, wall_e_y,
     27!   -wall_v, wall_u, wall_w_x, wall_w_y, wall_qflux, wall_sflux, wall_nrflux,
     28!   -wall_qrflux
     29!
     30! Adjustments for new surface concept:
     31!   +land_surface
     32!   -z0, z0h, z0q, us, ts, qs, qsws, nrs, nrsws, qrs, qrsws, ssws, ss, saswsb
     33!   -nzb_diff_u, nzb_diff_v, nzt_diff
     34!   -uswst, vswst, tswst, sswst, saswst, qswst, qrswst, nrswst, qswst_remote
     35!
     36! Generic tunnel setup:
     37!   +tunnel_height, tunnel_length, tunnel_width_x, tunnel_width_y,
     38!   +tunnel_wall_depth
     39!
     40! Topography input via netcdf
     41!   +lod
    2342!
    2443! Former revisions:
    … …  
    534553    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  f3_mg                 !<
    535554    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  mean_inflow_profiles  !<
    536     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  nrs                   !<
    537     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  nrsws                 !<
    538     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  nrswst                !<
    539     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ol                    !< Obukhov length
    540555    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  precipitation_amount  !<
    541556    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  precipitation_rate    !<
    … …  
    543558    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pt_slope_ref          !<
    544559    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qnudge                !<
    545     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qs                    !<
    546     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qsws                  !<
    547     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qswst                 !<
    548     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qswst_remote          !<
    549     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qrs                   !<
    550     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qrsws                 !<
    551     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  qrswst                !<
    552     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  saswsb                !<
    553     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  saswst                !<
    554     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  shf                   !<
    555     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ss                    !<
    556     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ssws                  !<
    557     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sswst                 !<
    558560    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tnudge                !<
    559561    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  td_lsa_lpt            !<
    … …  
    563565    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  total_2d_a            !<
    564566    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  total_2d_o            !<
    565     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ts                    !<
    566     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tswst                 !<
    567567    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ug_vert               !<
    568568    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  unudge                !<
    569     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  us                    !<
    570     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  usws                  !<
    571     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  uswst                 !<
    572569    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vnudge                !<
    573570    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vg_vert               !<
    574     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vsws                  !<
    575     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vswst                 !<
    576571    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wnudge                !<
    577572    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wsubs_vert            !<
    578     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z0                    !< roughness length for momentum
    579     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z0h                   !< roughness length for heat
    580     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  z0q                   !< roughness length for moisture
    581573   
    582574    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  d          !<
    … …  
    744736#endif
    745737
    746     REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  rif_wall !<
    747738    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  tri      !<
    748739
    … …  
    10141005    INTEGER(iwp) ::  io_blocks = 1                     !<
    10151006    INTEGER(iwp) ::  iran = -1234567                   !<
     1007    INTEGER(iwp) ::  lod = 1                           !< level of detail, topography input parameter
    10161008    INTEGER(iwp) ::  masks = 0                         !<
    10171009    INTEGER(iwp) ::  maximum_grid_level                !<
    … …  
    11301122    LOGICAL ::  large_scale_forcing = .FALSE.                !<
    11311123    LOGICAL ::  large_scale_subsidence = .FALSE.             !<
     1124    LOGICAL ::  land_surface = .FALSE.                       !< flag parameter indicating wheather the lsm is used
    11321125    LOGICAL ::  lsf_exception = .FALSE.                      !< temporary flag for use of lsf with buildings on flat terrain
    11331126    LOGICAL ::  lsf_surf = .TRUE.                            !<
    … …  
    11831176    LOGICAL ::  ws_scheme_sca = .FALSE.                      !<
    11841177    LOGICAL ::  ws_scheme_mom = .FALSE.                      !<
    1185 
    11861178    LOGICAL ::  data_output_xy(0:1) = .FALSE.                !<
    11871179    LOGICAL ::  data_output_xz(0:1) = .FALSE.                !<
    … …  
    13221314    REAL(wp) ::  top_salinityflux = 9999999.9_wp               !<
    13231315    REAL(wp) ::  top_scalarflux = 9999999.9_wp                 !<
     1316    REAL(wp) ::  tunnel_height = 9999999.9_wp                  !< height of tunnel outer wall
     1317    REAL(wp) ::  tunnel_length = 9999999.9_wp                  !< tunnel length
     1318    REAL(wp) ::  tunnel_width_x = 9999999.9_wp                 !< tunnel width in x, with respect to outer wall
     1319    REAL(wp) ::  tunnel_width_y = 9999999.9_wp                 !< tunnel width in y, with respect to outer wall
     1320    REAL(wp) ::  tunnel_wall_depth = 9999999.9_wp              !< tunnel wall depth
    13241321    REAL(wp) ::  ug_surface = 0.0_wp                           !<
    13251322    REAL(wp) ::  u_bulk = 0.0_wp                               !<
    … …  
    13661363    REAL(wp) ::  wall_heatflux(0:4) = 0.0_wp                       !<
    13671364    REAL(wp) ::  wall_humidityflux(0:4) = 0.0_wp                   !<
    1368     REAL(wp) ::  wall_nrflux(0:4) = 0.0_wp                         !<
    1369     REAL(wp) ::  wall_qflux(0:4) = 0.0_wp                          !<
    1370     REAL(wp) ::  wall_qrflux(0:4) = 0.0_wp                         !<
    13711365    REAL(wp) ::  wall_salinityflux(0:4) = 0.0_wp                   !<
    1372     REAL(wp) ::  wall_sflux(0:4) = 0.0_wp                          !<
    13731366    REAL(wp) ::  wall_scalarflux(0:4) = 0.0_wp                     !<
    13741367    REAL(wp) ::  subs_vertical_gradient(10) = 0.0_wp               !<
    … …  
    15341527    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddy2_mg  !<
    15351528
    1536     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwxm        !<
    1537     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwxp        !<
    1538     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwym        !<
    1539     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwyp        !<
    1540     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fxm         !<
    1541     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fxp         !<
    1542     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fym         !<
    1543     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fyp         !<
    1544     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wall_e_x    !<
    1545     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wall_e_y    !<
    1546     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wall_u      !<
    1547     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wall_v      !<
    1548     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wall_w_x    !<
    1549     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  wall_w_y    !<
    15501529    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zu_s_inner  !< 
    15511530    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  zw_w_inner  !<
    … …  
    15941573    INTEGER(iwp) ::  nzb_max      !<
    15951574    INTEGER(iwp) ::  nzt          !<
    1596     INTEGER(iwp) ::  nzt_diff     !<
    15971575
    15981576    INTEGER(idp), DIMENSION(:), ALLOCATABLE ::  ngp_3d        !<
    … …  
    16121590    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_diff_s_inner  !<
    16131591    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_diff_s_outer  !<
    1614     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_diff_u        !<
    1615     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_diff_v        !<
    16161592    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_inner         !<
    16171593    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_outer         !<
    … …  
    16271603    INTEGER(iwp), DIMENSION(:,:,:), POINTER ::  flags  !<
    16281604
    1629     INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_0   !<
    1630     INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_00  !<
    1631 
    16321605    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_1   !<
    16331606    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_2   !<
    … …  
    16411614    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::  wall_flags_10  !<
    16421615
    1643     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rflags_s_inner  !<
    1644     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rflags_invers   !<
     1616    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  advc_flags_1            !< flags used to degrade order of advection scheme
     1617    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  advc_flags_2            !< flags used to degrade order of advection scheme
     1618    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_0            !< flags to mask topography
    16451619
    16461620    SAVE

  • palm/trunk/SOURCE/netcdf_interface_mod.f90

    r2210 r2232  
    2020! Current revisions:
    2121! ------------------
     22! Adjustments to new topography and surface concept
    2223!
    23 !
     24! Topograpyh height arrays (zu_s_inner, zw_w_inner) are defined locally, output
     25! only if parallel netcdf.
     26!
     27! Build interface for topography input:
     28! - open file in read-only mode
     29! - read global attributes
     30! - read variables
     31!
     32! Bugfix in xy output (land-surface case)
     33!
    2434! Former revisions:
    2535! -----------------
    … …  
    198208 MODULE netcdf_interface
    199209
    200     USE control_parameters, ONLY: max_masks, fl_max, var_fl_max, varnamelength
     210    USE control_parameters,                                                    &
     211        ONLY:  max_masks, fl_max, var_fl_max, varnamelength
    201212    USE kinds
    202213#if defined( __netcdf )
    … …  
    397408    END INTERFACE netcdf_create_dim
    398409
     410    INTERFACE netcdf_close_file
     411       MODULE PROCEDURE netcdf_close_file
     412    END INTERFACE netcdf_close_file
     413
    399414    INTERFACE netcdf_create_file
    400415       MODULE PROCEDURE netcdf_create_file
    … …  
    409424    END INTERFACE netcdf_define_header
    410425
     426    INTERFACE netcdf_get_attribute
     427       MODULE PROCEDURE netcdf_get_attribute
     428    END INTERFACE netcdf_get_attribute
     429
     430    INTERFACE netcdf_get_variable
     431       MODULE PROCEDURE netcdf_get_variable_2d
     432       MODULE PROCEDURE netcdf_get_variable_3d
     433    END INTERFACE netcdf_get_variable
     434
    411435    INTERFACE netcdf_handle_error
    412436       MODULE PROCEDURE netcdf_handle_error
    413437    END INTERFACE netcdf_handle_error
    414438
     439    INTERFACE netcdf_open_read_file
     440       MODULE PROCEDURE netcdf_open_read_file
     441    END INTERFACE netcdf_open_read_file
     442
    415443    INTERFACE netcdf_open_write_file
    416444       MODULE PROCEDURE netcdf_open_write_file
    417445    END INTERFACE netcdf_open_write_file
    418446
    419     PUBLIC netcdf_create_file, netcdf_define_header, netcdf_handle_error,      &
    420            netcdf_open_write_file
     447    PUBLIC netcdf_create_file, netcdf_close_file, netcdf_define_header,        &
     448           netcdf_handle_error, netcdf_get_attribute, netcdf_get_variable,     &
     449           netcdf_open_read_file, netcdf_open_write_file
    421450
    422451 CONTAINS
    … …  
    434463    USE control_parameters,                                                    &
    435464        ONLY:  averaging_interval, averaging_interval_pr,                      &
    436                data_output_pr,  domask,  dopr_n,        &
     465               data_output_pr, domask, dopr_n,                                 &
    437466               dopr_time_count, dopts_time_count, dots_time_count,             &
    438                do2d, do2d_xz_time_count, do3d,                &
     467               do2d, do2d_xz_time_count, do3d,                                 &
    439468               do2d_yz_time_count, dt_data_output_av, dt_do2d_xy, dt_do2d_xz,  &
    440469               dt_do2d_yz, dt_do3d, mask_size, do2d_xy_time_count,             &
    441                do3d_time_count, domask_time_count, end_time, mask_i_global,    &
    442                mask_j_global, mask_k_global, message_string, mid, ntdim_2d_xy, &
     470               do3d_time_count, domask_time_count, end_time, land_surface,     &
     471               lod, mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global, &
     472               mask_k_global, message_string, mid, ntdim_2d_xy,                &
    443473               ntdim_2d_xz, ntdim_2d_yz, ntdim_3d, nz_do3d, prt_time_count,    &
    444474               run_description_header, section, simulated_time,                &
    … …  
    452482
    453483    USE indices,                                                               &
    454         ONLY:  nx, ny, nz ,nzb, nzt
     484        ONLY:  nx, nxl, nxr, ny, nys, nyn, nz ,nzb, nzt
    455485
    456486    USE kinds
    457487
    458488    USE land_surface_model_mod,                                                &
    459         ONLY: land_surface, lsm_define_netcdf_grid, nzb_soil, nzt_soil, nzs, zs
     489        ONLY: lsm_define_netcdf_grid, nzb_soil, nzt_soil, nzs, zs
    460490
    461491    USE pegrid
    … …  
    750780!
    751781!--       In case of non-flat topography define 2d-arrays containing the height
    752 !--       information
    753           IF ( TRIM( topography ) /= 'flat' )  THEN
     782!--       information. Only for parallel netcdf output.
     783          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
     784               netcdf_data_format > 4 )  THEN
    754785!
    755786!--          Define zusi = zu(nzb_s_inner)
    … …  
    9921023!
    9931024!--       In case of non-flat topography write height information
    994           IF ( TRIM( topography ) /= 'flat' )  THEN
    995 
    996              ALLOCATE( netcdf_data_2d(mask_size(mid,1),mask_size(mid,2)) )
    997              netcdf_data_2d = zu_s_inner( mask_i_global(mid,:mask_size(mid,1)),&
    998                                           mask_j_global(mid,:mask_size(mid,2)) )
    999 
    1000              nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),         &
    1001                                      id_var_zusi_mask(mid,av),    &
    1002                                      netcdf_data_2d,              &
    1003                                      start = (/ 1, 1 /),          &
    1004                                      count = (/ mask_size(mid,1), &
    1005                                                 mask_size(mid,2) /) )
     1025          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
     1026               netcdf_data_format > 4 )  THEN
     1027
     1028             ALLOCATE( netcdf_data_2d(mask_size_l(mid,1),mask_size_l(mid,2)) )
     1029             netcdf_data_2d = zu_s_inner( mask_i(mid,:mask_size_l(mid,1)),     &
     1030                                          mask_j(mid,:mask_size_l(mid,2)) )
     1031
     1032             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
     1033                                     id_var_zusi_mask(mid,av),                 &
     1034                                     netcdf_data_2d,                           &
     1035                                     start = (/ 1, 1 /),                       &
     1036                                     count = (/ mask_size_l(mid,1),            &
     1037                                                mask_size_l(mid,2) /) )
    10061038             CALL netcdf_handle_error( 'netcdf_define_header', 505 )
    10071039
    1008              netcdf_data_2d = zw_w_inner( mask_i_global(mid,:mask_size(mid,1)),&
    1009                                           mask_j_global(mid,:mask_size(mid,2)) )
    1010 
    1011              nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),         &
    1012                                      id_var_zwwi_mask(mid,av),    &
    1013                                      netcdf_data_2d,              &
    1014                                      start = (/ 1, 1 /),          &
    1015                                      count = (/ mask_size(mid,1), &
    1016                                                 mask_size(mid,2) /) )
     1040             netcdf_data_2d = zw_w_inner( mask_i(mid,:mask_size_l(mid,1)),     &
     1041                                          mask_j(mid,:mask_size_l(mid,2)) )
     1042
     1043             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
     1044                                     id_var_zwwi_mask(mid,av),                 &
     1045                                     netcdf_data_2d,                           &
     1046                                     start = (/ 1, 1 /),                       &
     1047                                     count = (/ mask_size_l(mid,1),            &
     1048                                                mask_size_l(mid,2) /) )
    10171049             CALL netcdf_handle_error( 'netcdf_define_header', 506 )
    10181050
    … …  
    12831315!
    12841316!--       In case of non-flat topography define 2d-arrays containing the height
    1285 !--       information
    1286           IF ( TRIM( topography ) /= 'flat' )  THEN
     1317!--       information. Only output 2d topography information in case of parallel
     1318!--       output.
     1319          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
     1320               netcdf_data_format > 4 )  THEN
    12871321!
    12881322!--          Define zusi = zu(nzb_s_inner)
    … …  
    15421576             CALL netcdf_handle_error( 'netcdf_define_header', 86 )
    15431577
    1544 !
    1545 !--          In case of non-flat topography write height information
    1546              IF ( TRIM( topography ) /= 'flat' )  THEN
    1547 
    1548                 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), &
    1549                                         zu_s_inner(0:nx+1,0:ny+1), &
    1550                                         start = (/ 1, 1 /), &
    1551                                         count = (/ nx+2, ny+2 /) )
    1552                 CALL netcdf_handle_error( 'netcdf_define_header', 419 )
    1553 
    1554                 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), &
    1555                                         zw_w_inner(0:nx+1,0:ny+1), &
    1556                                         start = (/ 1, 1 /), &
    1557                                         count = (/ nx+2, ny+2 /) )
    1558                 CALL netcdf_handle_error( 'netcdf_define_header', 420 )
    1559 
    1560              ENDIF
    1561 
    15621578             IF ( land_surface )  THEN
    15631579!
    … …  
    15681584                CALL netcdf_handle_error( 'netcdf_define_header', 86 )
    15691585             ENDIF
     1586
     1587          ENDIF
     1588!
     1589!--       In case of non-flat topography write height information. Only for
     1590!--       parallel netcdf output.
     1591          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
     1592               netcdf_data_format > 4 )  THEN
     1593
     1594             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
     1595                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
     1596                                        zu_s_inner(nxl:nxr+1,nys:nyn),         &
     1597                                        start = (/ nxl+1, nys+1 /),            &
     1598                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
     1599             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
     1600                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
     1601                                        zu_s_inner(nxl:nxr,nys:nyn+1),         &
     1602                                        start = (/ nxl+1, nys+1 /),            &
     1603                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
     1604             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
     1605                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
     1606                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),       &
     1607                                        start = (/ nxl+1, nys+1 /),            &
     1608                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
     1609             ELSE
     1610                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av),     &
     1611                                        zu_s_inner(nxl:nxr,nys:nyn),           &
     1612                                        start = (/ nxl+1, nys+1 /),            &
     1613                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
     1614             ENDIF
     1615             CALL netcdf_handle_error( 'netcdf_define_header', 419 )
     1616
     1617             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
     1618                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
     1619                                        zw_w_inner(nxl:nxr+1,nys:nyn),         &
     1620                                        start = (/ nxl+1, nys+1 /),            &
     1621                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
     1622             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
     1623                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
     1624                                        zw_w_inner(nxl:nxr,nys:nyn+1),         &
     1625                                        start = (/ nxl+1, nys+1 /),            &
     1626                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
     1627             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
     1628                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
     1629                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),       &
     1630                                        start = (/ nxl+1, nys+1 /),            &
     1631                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
     1632             ELSE
     1633                nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av),     &
     1634                                        zw_w_inner(nxl:nxr,nys:nyn),           &
     1635                                        start = (/ nxl+1, nys+1 /),            &
     1636                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
     1637             ENDIF
     1638             CALL netcdf_handle_error( 'netcdf_define_header', 420 )
    15701639
    15711640          ENDIF
    … …  
    18411910          IF ( land_surface )  THEN
    18421911
    1843              ns_do = 0
    1844              DO WHILE ( section(ns_do+1,1) < nzs )
     1912             ns_do = 1
     1913             DO WHILE ( section(ns_do,1) /= -9999  .AND.  ns <= nzs )
    18451914                ns_do = ns_do + 1
    18461915             ENDDO
    … …  
    19001969!
    19011970!--       In case of non-flat topography define 2d-arrays containing the height
    1902 !--       information
    1903           IF ( TRIM( topography ) /= 'flat' )  THEN
     1971!--       information. Only for parallel netcdf output.
     1972          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
     1973               netcdf_data_format > 4  )  THEN
    19041974!
    19051975!--          Define zusi = zu(nzb_s_inner)
    … …  
    22112281             DEALLOCATE( netcdf_data )
    22122282
    2213 !
    2214 !--          In case of non-flat topography write height information
    2215              IF ( TRIM( topography ) /= 'flat' )  THEN
    2216 
    2217                 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), &
    2218                                         zu_s_inner(0:nx+1,0:ny+1), &
    2219                                         start = (/ 1, 1 /), &
    2220                                         count = (/ nx+2, ny+2 /) )
    2221                 CALL netcdf_handle_error( 'netcdf_define_header', 427 )
    2222 
    2223                 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), &
    2224                                         zw_w_inner(0:nx+1,0:ny+1), &
    2225                                         start = (/ 1, 1 /), &
    2226                                         count = (/ nx+2, ny+2 /) )
    2227                 CALL netcdf_handle_error( 'netcdf_define_header', 428 )
    2228 
     2283          ENDIF
     2284
     2285!
     2286!--       In case of non-flat topography write height information. Only for
     2287!--       parallel netcdf output.
     2288          IF ( TRIM( topography ) /= 'flat'  .AND.                             &
     2289               netcdf_data_format > 4  )  THEN
     2290
     2291             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
     2292                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
     2293                                        zu_s_inner(nxl:nxr+1,nys:nyn),         &
     2294                                        start = (/ nxl+1, nys+1 /),            &
     2295                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
     2296             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
     2297                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
     2298                                        zu_s_inner(nxl:nxr,nys:nyn+1),         &
     2299                                        start = (/ nxl+1, nys+1 /),            &
     2300                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
     2301             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
     2302                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
     2303                                        zu_s_inner(nxl:nxr+1,nys:nyn+1),       &
     2304                                        start = (/ nxl+1, nys+1 /),            &
     2305                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
     2306             ELSE
     2307                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av),     &
     2308                                        zu_s_inner(nxl:nxr,nys:nyn),           &
     2309                                        start = (/ nxl+1, nys+1 /),            &
     2310                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
    22292311             ENDIF
    2230 
    2231 
     2312             CALL netcdf_handle_error( 'netcdf_define_header', 427 )
     2313
     2314             IF ( nxr == nx  .AND.  nyn /= ny )  THEN
     2315                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
     2316                                        zw_w_inner(nxl:nxr+1,nys:nyn),         &
     2317                                        start = (/ nxl+1, nys+1 /),            &
     2318                                        count = (/ nxr-nxl+2, nyn-nys+1 /) )
     2319             ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
     2320                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
     2321                                        zw_w_inner(nxl:nxr,nys:nyn+1),         &
     2322                                        start = (/ nxl+1, nys+1 /),            &
     2323                                        count = (/ nxr-nxl+1, nyn-nys+2 /) )
     2324             ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
     2325                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
     2326                                        zw_w_inner(nxl:nxr+1,nys:nyn+1),       &
     2327                                        start = (/ nxl+1, nys+1 /),            &
     2328                                        count = (/ nxr-nxl+2, nyn-nys+2 /) )
     2329             ELSE
     2330                nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av),     &
     2331                                        zw_w_inner(nxl:nxr,nys:nyn),           &
     2332                                        start = (/ nxl+1, nys+1 /),            &
     2333                                        count = (/ nxr-nxl+1, nyn-nys+1 /) )
     2334             ENDIF
     2335             CALL netcdf_handle_error( 'netcdf_define_header', 428 )
    22322336
    22332337          ENDIF
    … …  
    53375441! Description:
    53385442! ------------
     5443!> Closes an existing netCDF file.
     5444!------------------------------------------------------------------------------!
     5445 
     5446 SUBROUTINE netcdf_close_file( id, errno )
     5447#if defined( __netcdf )
     5448
     5449    USE pegrid
     5450
     5451    IMPLICIT NONE
     5452
     5453    INTEGER(iwp), INTENT(IN)           ::  errno     !< error number
     5454    INTEGER(iwp), INTENT(INOUT)        ::  id        !< file id
     5455
     5456    nc_stat = NF90_CLOSE( id )
     5457    CALL netcdf_handle_error( 'netcdf_close', errno )
     5458#endif
     5459 END SUBROUTINE netcdf_close_file
     5460
     5461!------------------------------------------------------------------------------!
     5462! Description:
     5463! ------------
     5464!> Opens an existing netCDF file for reading only and gives back the id.
     5465!------------------------------------------------------------------------------!
     5466 
     5467 SUBROUTINE netcdf_open_read_file( filename, id, errno )
     5468#if defined( __netcdf )
     5469
     5470    USE pegrid
     5471
     5472    IMPLICIT NONE
     5473
     5474    CHARACTER (LEN=*), INTENT(IN) ::  filename  !< filename
     5475    INTEGER(iwp), INTENT(IN)      ::  errno     !< error number
     5476    INTEGER(iwp), INTENT(INOUT)   ::  id        !< file id
     5477    LOGICAL                       ::  file_open = .FALSE.
     5478
     5479    nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
     5480
     5481    CALL netcdf_handle_error( 'netcdf_open_read_file', errno )
     5482
     5483#endif
     5484 END SUBROUTINE netcdf_open_read_file
     5485
     5486!------------------------------------------------------------------------------!
     5487! Description:
     5488! ------------
     5489!> Reads the global attributes of a file
     5490!------------------------------------------------------------------------------!
     5491 
     5492 SUBROUTINE netcdf_get_attribute( id, attribute_name, value, global, errno, variable_name )
     5493#if defined( __netcdf )
     5494
     5495    USE pegrid
     5496
     5497    IMPLICIT NONE
     5498
     5499    CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
     5500    CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
     5501
     5502    INTEGER(iwp), INTENT(IN)    ::  errno            !< error number
     5503    INTEGER(iwp), INTENT(INOUT) ::  id               !< file id
     5504    INTEGER(iwp), INTENT(INOUT) ::  value            !< read value
     5505
     5506    INTEGER(iwp)                ::  id_var           !< variable id
     5507
     5508    LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attributes
     5509
     5510!
     5511!-- Read global attribute
     5512    IF ( global )  THEN
     5513       nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
     5514       CALL netcdf_handle_error( 'netcdf_get_attribute global', errno )
     5515!
     5516!-- Read attributes referring to a single variable. Therefore, first inquire
     5517!-- variable id
     5518    ELSE
     5519       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
     5520       CALL netcdf_handle_error( 'netcdf_get_attribute', errno )
     5521       nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
     5522       CALL netcdf_handle_error( 'netcdf_get_attribute', errno )       
     5523    ENDIF
     5524#endif
     5525 END SUBROUTINE netcdf_get_attribute
     5526
     5527!------------------------------------------------------------------------------!
     5528! Description:
     5529! ------------
     5530!> Reads a 2D REAL variable of a file. Reading is done processor-wise,
     5531!> i.e. each core reads its own domain, as well as in slices along x.
     5532!------------------------------------------------------------------------------!
     5533 
     5534 SUBROUTINE netcdf_get_variable_2d( id, variable_name, i, var, errno )
     5535#if defined( __netcdf )
     5536
     5537    USE indices
     5538    USE pegrid
     5539
     5540    IMPLICIT NONE
     5541
     5542    CHARACTER(LEN=*)              ::  variable_name   !< attribute name
     5543    INTEGER(iwp), INTENT(IN)      ::  errno           !< error number
     5544    INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
     5545
     5546    INTEGER(iwp), INTENT(INOUT)   ::  id              !< file id
     5547
     5548    INTEGER(iwp)                  ::  id_var          !< variable id
     5549
     5550    REAL(wp), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
     5551    REAL(wp) :: var_dum
     5552!
     5553!-- Inquire variable id
     5554    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
     5555!
     5556!-- Get variable
     5557    nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                        &
     5558                            start = (/ i+1, nys+1 /),                          &
     5559                            count = (/ 1, nyn - nys + 1 /) )
     5560
     5561    CALL netcdf_handle_error( 'netcdf_get_variable', errno )
     5562#endif
     5563 END SUBROUTINE netcdf_get_variable_2d
     5564
     5565!------------------------------------------------------------------------------!
     5566! Description:
     5567! ------------
     5568!> Reads a 3D INTEGER variable of a file. Reading is done processor-wise,
     5569!> i.e. each core reads its own domain, as well as in slices along x.
     5570!------------------------------------------------------------------------------!
     5571 
     5572 SUBROUTINE netcdf_get_variable_3d( id, variable_name, i, j, var, errno )
     5573#if defined( __netcdf )
     5574
     5575    USE indices
     5576    USE pegrid
     5577
     5578    IMPLICIT NONE
     5579
     5580    CHARACTER(LEN=*)              ::  variable_name   !< attribute name
     5581    INTEGER(iwp), INTENT(IN)      ::  errno           !< error number
     5582    INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
     5583    INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
     5584
     5585    INTEGER(iwp), INTENT(INOUT)   ::  id              !< file id
     5586
     5587    INTEGER(iwp)                  ::  id_var          !< variable id
     5588    INTEGER(iwp)                  ::  id_z            !< id of z-dimension
     5589    INTEGER(iwp)                  ::  nz_file         !< number of grid-points in file
     5590
     5591    INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(INOUT) ::  var  !< variable to be read
     5592!
     5593!-- Get dimension of z-axis
     5594    nc_stat = NF90_INQ_DIMID( id, "z", id_z )
     5595    nc_stat = NF90_INQUIRE_DIMENSION( id, id_z, len = nz_file )
     5596!
     5597!-- Inquire variable id
     5598    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
     5599!
     5600!-- Get variable
     5601    nc_stat = NF90_GET_VAR( id, id_var, var(0:nz_file-1),                  &
     5602                            start = (/ i+1, j+1, 1 /),                         &
     5603                            count = (/ 1, 1, nz_file /) )
     5604
     5605    CALL netcdf_handle_error( 'netcdf_get_variable', errno )
     5606#endif
     5607 END SUBROUTINE netcdf_get_variable_3d
     5608
     5609!------------------------------------------------------------------------------!
     5610! Description:
     5611! ------------
    53395612!> Opens an existing netCDF file for writing and gives back the id.
    53405613!> The parallel flag has to be TRUE for parallel netCDF output support.

  • palm/trunk/SOURCE/nudging_mod.f90

    r2101 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    332332
    333333       USE indices,                                                            &
    334            ONLY:  nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
     334           ONLY:  nxl, nxr, nys, nyn, nzb, nzt, wall_flags_0
    335335
    336336       USE kinds
    … …  
    372372                DO  j = nys, nyn
    373373
    374                    DO  k = nzb_u_inner(j,i)+1, nzt
     374                   DO  k = nzb+1, nzt
    375375
    376376                      tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp +     &
    377377                                     unudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    378378
    379                       tend(k,j,i) = tend(k,j,i) + tmp_tend
     379                      tend(k,j,i) = tend(k,j,i) + tmp_tend *                   &
     380                                        MERGE( 1.0_wp, 0.0_wp,                 &
     381                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    380382
    381383                      sums_ls_l(k,6) = sums_ls_l(k,6) + tmp_tend *             &
    … …  
    393395                DO  j = nys, nyn
    394396
    395                    DO  k = nzb_u_inner(j,i)+1, nzt
     397                   DO  k = nzb+1, nzt
    396398
    397399                      tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp +     &
    398400                                     vnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    399401
    400                       tend(k,j,i) = tend(k,j,i) + tmp_tend
     402                      tend(k,j,i) = tend(k,j,i) + tmp_tend *                   &
     403                                        MERGE( 1.0_wp, 0.0_wp,                 &
     404                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    401405
    402406                      sums_ls_l(k,7) = sums_ls_l(k,7) + tmp_tend *             &
    … …  
    414418                DO  j = nys, nyn
    415419
    416                    DO  k = nzb_u_inner(j,i)+1, nzt
     420                   DO  k = nzb+1, nzt
    417421
    418422                      tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp +    &
    419423                                     ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    420424
    421                       tend(k,j,i) = tend(k,j,i) + tmp_tend
     425                      tend(k,j,i) = tend(k,j,i) + tmp_tend *                   &
     426                                        MERGE( 1.0_wp, 0.0_wp,                 &
     427                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    422428
    423429                      sums_ls_l(k,4) = sums_ls_l(k,4) + tmp_tend *             &
    … …  
    435441                DO  j = nys, nyn
    436442
    437                    DO  k = nzb_u_inner(j,i)+1, nzt
     443                   DO  k = nzb+1, nzt
    438444
    439445                      tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp +    &
    440446                                     qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    441447
    442                       tend(k,j,i) = tend(k,j,i) + tmp_tend
     448                      tend(k,j,i) = tend(k,j,i) + tmp_tend *                   &
     449                                        MERGE( 1.0_wp, 0.0_wp,                 &
     450                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    443451
    444452                      sums_ls_l(k,5) = sums_ls_l(k,5) + tmp_tend *             &
    … …  
    476484
    477485       USE indices,                                                            &
    478            ONLY:  nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
     486           ONLY:  nxl, nxr, nys, nyn, nzb, nzt, wall_flags_0
    479487
    480488       USE kinds
    … …  
    514522          CASE ( 'u' )
    515523
    516              DO  k = nzb_u_inner(j,i)+1, nzt
     524             DO  k = nzb+1, nzt
    517525
    518526                tmp_tend = - ( hom(k,1,1,0) - ( unudge(k,nt) * dtp +           &
    519527                               unudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    520528
    521                 tend(k,j,i) = tend(k,j,i) + tmp_tend
     529                tend(k,j,i) = tend(k,j,i) + tmp_tend *                         &
     530                                        MERGE( 1.0_wp, 0.0_wp,                 &
     531                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    522532
    523533                sums_ls_l(k,6) = sums_ls_l(k,6) + tmp_tend                     &
    … …  
    529539          CASE ( 'v' )
    530540
    531              DO  k = nzb_u_inner(j,i)+1, nzt
     541             DO  k = nzb+1, nzt
    532542
    533543                tmp_tend = - ( hom(k,1,2,0) - ( vnudge(k,nt) * dtp +           &
    534544                               vnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    535545
    536                 tend(k,j,i) = tend(k,j,i) + tmp_tend
     546                tend(k,j,i) = tend(k,j,i) + tmp_tend *                         &
     547                                        MERGE( 1.0_wp, 0.0_wp,                 &
     548                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    537549
    538550                sums_ls_l(k,7) = sums_ls_l(k,7) + tmp_tend                     &
    … …  
    544556          CASE ( 'pt' )
    545557
    546              DO  k = nzb_u_inner(j,i)+1, nzt
     558             DO  k = nzb+1, nzt
    547559
    548560                tmp_tend = - ( hom(k,1,4,0) - ( ptnudge(k,nt) * dtp +          &
    549561                               ptnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    550562
    551                 tend(k,j,i) = tend(k,j,i) + tmp_tend
     563                tend(k,j,i) = tend(k,j,i) + tmp_tend *                         &
     564                                        MERGE( 1.0_wp, 0.0_wp,                 &
     565                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    552566
    553567                sums_ls_l(k,4) = sums_ls_l(k,4) + tmp_tend                     &
    … …  
    560574          CASE ( 'q' )
    561575
    562              DO  k = nzb_u_inner(j,i)+1, nzt
     576             DO  k = nzb+1, nzt
    563577
    564578                tmp_tend = - ( hom(k,1,41,0) - ( qnudge(k,nt) * dtp +          &
    565579                               qnudge(k,nt+1) * dtm ) ) / tmp_tnudge(k)
    566580
    567                 tend(k,j,i) = tend(k,j,i) + tmp_tend
     581                tend(k,j,i) = tend(k,j,i) + tmp_tend *                         &
     582                                        MERGE( 1.0_wp, 0.0_wp,                 &
     583                                               BTEST( wall_flags_0(k,j,i), 0 ) )
    568584
    569585                sums_ls_l(k,5) = sums_ls_l(k,5) + tmp_tend                     &

  • palm/trunk/SOURCE/palm.f90

    r2179 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Renamed wall_flags_0 and wall_flags_00 into advc_flags_1 and advc_flags_2,
     23! respectively, within copyin statement. Moreover, introduced further flag
     24! array wall_flags_0.
     25! Remove unused variables from ONLY list.
    2326!
    2427! Former revisions:
    … …  
    165168
    166169    USE control_parameters,                                                    &
     170
    167171        ONLY:  cloud_physics, constant_diffusion, coupling_char, coupling_mode,&
    168172               do2d_at_begin, do3d_at_begin, humidity, initializing_actions,   &
    169                io_blocks, io_group,                                            &
     173               land_surface, io_blocks, io_group,                              &
    170174               large_scale_forcing, message_string, microphysics_seifert,      &
    171175               nest_domain, neutral,                                           &
    … …  
    179183        ONLY:  cpu_log, log_point, cpu_statistics
    180184
    181     USE grid_variables,                                                        &
    182         ONLY:  fxm, fxp, fym, fyp, fwxm, fwxp, fwym, fwyp, wall_e_x, wall_e_y, &
    183                wall_u, wall_v, wall_w_x, wall_w_y
    184 
    185185    USE indices,                                                               &
    186         ONLY:  nbgp, ngp_2dh, ngp_2dh_s_inner, nzb_diff_s_inner, nzb_diff_s_outer,   &
    187                nzb_diff_u, nzb_diff_v, nzb_s_inner, nzb_s_outer, nzb_u_inner,  &
    188                nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner,             &
    189                nzb_w_outer, rflags_invers, rflags_s_inner, wall_flags_0,       &
    190                wall_flags_00
     186        ONLY:  nbgp
    191187
    192188    USE kinds
    193189
    194190    USE land_surface_model_mod,                                                &
    195         ONLY:  land_surface, lsm_last_actions
     191        ONLY:  lsm_last_actions
    196192
    197193    USE ls_forcing_mod,                                                        &
    … …  
    213209    USE radiation_model_mod,                                                   &
    214210        ONLY:  radiation, radiation_last_actions
    215 
    216     USE statistics,                                                            &
    217         ONLY:  hom, rmask, weight_pres, weight_substep
    218 
    219     USE surface_layer_fluxes_mod,                                              &
    220         ONLY:  pt1, qv1, uv_total
    221        
     211       
    222212    USE urban_surface_mod,                                                     &
    223213        ONLY:  usm_write_restart_data       

  • palm/trunk/SOURCE/parin.f90

    r2119 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! typo corrected
     23! +wall_salinityflux
     24! +tunnel_height, tunnel_lenght, tunnel_width_x, tunnel_width_y,
     25!  tunnel_wall_depth
    2326!
    2427! Former revisions:
    … …  
    373376             topography, topography_grid_convention, top_heatflux,             &
    374377             top_momentumflux_u, top_momentumflux_v, top_salinityflux,         &
    375              top_scalarflux, transpose_compute_overlap, turbulent_inflow,      &
    376              turbulent_outflow,                                                &
     378             top_scalarflux, transpose_compute_overlap,                        &
     379             tunnel_height, tunnel_length, tunnel_width_x, tunnel_width_y,     &
     380             tunnel_wall_depth,                                                &
     381             turbulent_inflow, turbulent_outflow,                              &
    377382             use_subsidence_tendencies, ug_surface, ug_vertical_gradient,      &
    378383             ug_vertical_gradient_level, use_surface_fluxes, use_cmax,         &
    … …  
    381386             vg_vertical_gradient_level, v_bulk, v_profile, ventilation_effect,&
    382387             wall_adjustment, wall_heatflux, wall_humidityflux,                &
    383              wall_scalarflux, zeta_max, zeta_min, z0h_factor
     388             wall_salinityflux, wall_scalarflux, zeta_max, zeta_min, z0h_factor
    384389     
    385390    NAMELIST /d3par/  averaging_interval, averaging_interval_pr,               &
    … …  
    594599          CALL wtm_parin
    595600!
    596 !--       Check if virtual flights should be carried out and read &flight_part
     601!--       Check if virtual flights should be carried out and read &flight_par
    597602!--       if required
    598603          CALL flight_parin

  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r2214 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new topography concept
    2323!
    2424! Former revisions:
    … …  
    118118 
    119119    USE arrays_3d,                                                             &
    120         ONLY:  dzu, dzw, e, q, s, shf, tend, u, v, w, zu, zw
     120        ONLY:  dzu, dzw, e, q, s, tend, u, v, w, zu, zw
    121121
    122122    USE indices,                                                               &
    123123        ONLY:  nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv,   &
    124                nz, nzb, nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
     124               nz, nzb, nzb_max, nzt, wall_flags_0
    125125
    126126    USE kinds
    … …  
    549549       USE control_parameters,                                                 &
    550550           ONLY:  coupling_char, dz, humidity, io_blocks, io_group,            &
    551                   message_string, ocean, passive_scalar 
    552 
    553        USE control_parameters,                                                 &
    554            ONLY:  urban_surface
     551                  message_string, ocean, passive_scalar, urban_surface
     552
     553       USE surface_mod,                                                        &
     554           ONLY: surf_def_h, surf_lsm_h, surf_usm_h
    555555
    556556       IMPLICIT NONE
    … …  
    562562       INTEGER(iwp) ::  j   !< running index
    563563       INTEGER(iwp) ::  k   !< running index
     564       INTEGER(iwp) ::  m   !< running index
    564565
    565566       REAL(wp) ::  int_bpdf        !< vertical integral for lad-profile construction
    … …  
    639640          canopy_height = pch_index * dz
    640641
    641           DO k = nzb, pch_index
     642          DO k = 0, pch_index
    642643             int_bpdf = int_bpdf +                                             &
    643644                      ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) ) *  &
    … …  
    649650!
    650651!--       Preliminary lad profile (defined on w-grid)
    651           DO k = nzb, pch_index
     652          DO k = 0, pch_index
    652653             pre_lad(k) =  lai_beta *                                          &
    653654                        ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) )  &
    … …  
    662663!--       when calculating the canopy tendencies)
    663664          lad(0) = pre_lad(0)
    664           DO k = nzb+1, pch_index
     665          DO k = 1, pch_index
    665666             lad(k) = 0.5 * ( pre_lad(k-1) + pre_lad(k) )
    666667          ENDDO         
    … …  
    761762          ENDDO
    762763
     764!           
     765!--       In areas with canopy the surface value of the canopy heat
     766!--       flux distribution overrides the surface heat flux (shf)
     767!--       Start with default surface type
     768          DO  m = 1, surf_def_h(0)%ns
     769             k = surf_def_h(0)%k(m)
     770             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
     771                surf_def_h(0)%shf(m) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) )
     772          ENDDO
     773!
     774!--       Natural surfaces
     775          DO  m = 1, surf_lsm_h%ns
     776             k = surf_lsm_h%k(m)
     777             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
     778                surf_lsm_h%shf(m) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) )
     779          ENDDO
     780!
     781!--       Urban surfaces
     782          DO  m = 1, surf_usm_h%ns
     783             k = surf_usm_h%k(m)
     784             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
     785                surf_usm_h%shf(m) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) )
     786          ENDDO
     787!
    763788!
    764789!--       Calculation of the heating rate (K/s) within the different layers of
    765 !--       the plant canopy
     790!--       the plant canopy. Calculation is only necessary in areas covered with
     791!--       canopy.
     792!--       Within the different canopy layers the plant-canopy heating
     793!--       rate (pc_heating_rate) is calculated as the vertical
     794!--       divergence of the canopy heat fluxes at the top and bottom
     795!--       of the respective layer
    766796          DO  i = nxlg, nxrg
    767797             DO  j = nysg, nyng
    768 !
    769 !--             Calculation only necessary in areas covered with canopy
    770                 IF ( cum_lai_hf(0,j,i) /= 0.0_wp )  THEN
    771 !--             
    772 !--                In areas with canopy the surface value of the canopy heat
    773 !--                flux distribution overrides the surface heat flux (shf)
    774                    shf(j,i) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) )
    775 !
    776 !--                Within the different canopy layers the plant-canopy heating
    777 !--                rate (pc_heating_rate) is calculated as the vertical
    778 !--                divergence of the canopy heat fluxes at the top and bottom
    779 !--                of the respective layer
    780                    DO  k = 1, pch_index
    781                       pc_heating_rate(k,j,i) = cthf *                         &
    782                                                 ( exp(-ext_coef*cum_lai_hf(k,j,i)) -  &
    783                                                   exp(-ext_coef*cum_lai_hf(k-1,j,i)) ) / dzw(k)
    784                    ENDDO
    785                 ENDIF
     798                DO  k = 1, pch_index
     799                   IF ( cum_lai_hf(0,j,i) /= 0.0_wp )  THEN
     800                      pc_heating_rate(k,j,i) = cthf *                             &
     801                                ( exp(-ext_coef*cum_lai_hf(k,j,i)) -              &
     802                                  exp(-ext_coef*cum_lai_hf(k-1,j,i) ) ) / dzw(k)
     803                   ENDIF
     804                ENDDO
    786805             ENDDO
    787806          ENDDO
    … …  
    966985       INTEGER(iwp) ::  j         !< running index
    967986       INTEGER(iwp) ::  k         !< running index
     987       INTEGER(iwp) ::  k_wall    !< vertical index of topography top
    968988       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
    969989
    … …  
    9871007             DO  i = nxlu, nxr
    9881008                DO  j = nys, nyn
    989                    DO  k = nzb_u_inner(j,i)+1, nzb_u_inner(j,i)+pch_index
    990 
    991                       kk = k - nzb_u_inner(j,i)  !- lad arrays are defined flat
     1009!
     1010!--                Determine topography-top index on u-grid
     1011                   k_wall = MAXLOC(                                            &
     1012                          MERGE( 1, 0,                                         &
     1013                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 )    &
     1014                               ), DIM = 1                                      &
     1015                                  ) - 1
     1016                   DO  k = k_wall+1, k_wall+pch_index
     1017
     1018                      kk = k - k_wall   !- lad arrays are defined flat
    9921019!
    9931020!--                   In order to create sharp boundaries of the plant canopy,
    … …  
    10481075             DO  i = nxl, nxr
    10491076                DO  j = nysv, nyn
    1050                    DO  k = nzb_v_inner(j,i)+1, nzb_v_inner(j,i)+pch_index
    1051 
    1052                       kk = k - nzb_v_inner(j,i)  !- lad arrays are defined flat
     1077!
     1078!--                Determine topography-top index on v-grid
     1079                   k_wall = MAXLOC(                                            &
     1080                          MERGE( 1, 0,                                         &
     1081                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 )    &
     1082                               ), DIM = 1                                      &
     1083                                  ) - 1
     1084                   DO  k = k_wall+1, k_wall+pch_index
     1085
     1086                      kk = k - k_wall   !- lad arrays are defined flat
    10531087!
    10541088!--                   In order to create sharp boundaries of the plant canopy,
    … …  
    11091143             DO  i = nxl, nxr
    11101144                DO  j = nys, nyn
    1111                    DO  k = nzb_w_inner(j,i)+1, nzb_w_inner(j,i)+pch_index-1
    1112 
    1113                       kk = k - nzb_w_inner(j,i)  !- lad arrays are defined flat
     1145!
     1146!--                Determine topography-top index on w-grid
     1147                   k_wall = MAXLOC(                                            &
     1148                          MERGE( 1, 0,                                         &
     1149                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 )    &
     1150                               ), DIM = 1                                      &
     1151                                  ) - 1
     1152                   DO  k = k_wall+1, k_wall+pch_index-1
     1153
     1154                      kk = k - k_wall   !- lad arrays are defined flat
    11141155
    11151156                      pre_tend = 0.0_wp
    … …  
    11571198             DO  i = nxl, nxr
    11581199                DO  j = nys, nyn
    1159                    DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1160                       kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1200!
     1201!--                Determine topography-top index on scalar-grid
     1202                   k_wall = MAXLOC(                                            &
     1203                          MERGE( 1, 0,                                         &
     1204                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1205                               ), DIM = 1                                      &
     1206                                  ) - 1
     1207                   DO  k = k_wall+1, k_wall+pch_index
     1208
     1209                      kk = k - k_wall   !- lad arrays are defined flat
    11611210                      tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i)
    11621211                   ENDDO
    … …  
    11691218             DO  i = nxl, nxr
    11701219                DO  j = nys, nyn
    1171                    DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1172                       kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1220!
     1221!--                Determine topography-top index on scalar-grid
     1222                   k_wall = MAXLOC(                                            &
     1223                          MERGE( 1, 0,                                         &
     1224                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1225                               ), DIM = 1                                      &
     1226                                  ) - 1
     1227                   DO  k = k_wall+1, k_wall+pch_index
     1228
     1229                      kk = k - k_wall   !- lad arrays are defined flat
    11731230                      tend(k,j,i) = tend(k,j,i) -                              &
    11741231                                       lsec *                                  &
    … …  
    11941251             DO  i = nxl, nxr
    11951252                DO  j = nys, nyn
    1196                    DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1197                       kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1253!
     1254!--                Determine topography-top index on scalar-grid
     1255                   k_wall = MAXLOC(                                            &
     1256                          MERGE( 1, 0,                                         &
     1257                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1258                               ), DIM = 1                                      &
     1259                                  ) - 1
     1260                   DO  k = k_wall+1, k_wall+pch_index
     1261
     1262                      kk = k - k_wall   !- lad arrays are defined flat
    11981263                      tend(k,j,i) = tend(k,j,i) -                              &
    11991264                                       2.0_wp * cdc *                          &
    … …  
    12181283             DO  i = nxl, nxr
    12191284                DO  j = nys, nyn
    1220                    DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1221                       kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1285!
     1286!--                Determine topography-top index on scalar-grid
     1287                   k_wall = MAXLOC(                                            &
     1288                          MERGE( 1, 0,                                         &
     1289                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1290                               ), DIM = 1                                      &
     1291                                  ) - 1
     1292                   DO  k = k_wall+1, k_wall+pch_index
     1293
     1294                      kk = k - k_wall   !- lad arrays are defined flat
    12221295                      tend(k,j,i) = tend(k,j,i) -                              &
    12231296                                       lsec *                                  &
    … …  
    12881361       INTEGER(iwp) ::  j         !< running index
    12891362       INTEGER(iwp) ::  k         !< running index
     1363       INTEGER(iwp) ::  k_wall    !< vertical index of topography top
    12901364       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
    12911365
    … …  
    13071381!--       u-component
    13081382          CASE ( 1 )
    1309              DO  k = nzb_u_inner(j,i)+1, nzb_u_inner(j,i)+pch_index
    1310 
    1311                 kk = k - nzb_u_inner(j,i)  !- lad arrays are defined flat
     1383!
     1384!--          Determine topography-top index on u-grid
     1385             k_wall = MAXLOC(                                                  &
     1386                          MERGE( 1, 0,                                         &
     1387                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 )    &
     1388                               ), DIM = 1                                      &
     1389                            ) - 1
     1390             DO  k = k_wall+1, k_wall+pch_index
     1391
     1392                kk = k - k_wall  !- lad arrays are defined flat
    13121393!
    13131394!--             In order to create sharp boundaries of the plant canopy,
    … …  
    13631444!--       v-component
    13641445          CASE ( 2 )
    1365              DO  k = nzb_v_inner(j,i)+1, nzb_v_inner(j,i)+pch_index
    1366 
    1367                 kk = k - nzb_v_inner(j,i)  !- lad arrays are defined flat
     1446!
     1447!--          Determine topography-top index on v-grid
     1448             k_wall = MAXLOC(                                                  &
     1449                          MERGE( 1, 0,                                         &
     1450                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 )    &
     1451                               ), DIM = 1                                      &
     1452                            ) - 1
     1453             DO  k = k_wall+1, k_wall+pch_index
     1454
     1455                kk = k - k_wall  !- lad arrays are defined flat
    13681456!
    13691457!--             In order to create sharp boundaries of the plant canopy,
    … …  
    14191507!--       w-component
    14201508          CASE ( 3 )
    1421              DO  k = nzb_w_inner(j,i)+1, nzb_w_inner(j,i)+pch_index-1
    1422 
    1423                 kk = k - nzb_w_inner(j,i)  !- lad arrays are defined flat
     1509!
     1510!--          Determine topography-top index on w-grid
     1511             k_wall = MAXLOC(                                                  &
     1512                          MERGE( 1, 0,                                         &
     1513                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 )    &
     1514                               ), DIM = 1                                      &
     1515                            ) - 1
     1516             DO  k = k_wall+1, k_wall+pch_index-1
     1517
     1518                kk = k - k_wall  !- lad arrays are defined flat
    14241519
    14251520                pre_tend = 0.0_wp
    … …  
    14621557!--       potential temperature
    14631558          CASE ( 4 )
    1464              DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1465                 kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1559!
     1560!--          Determine topography-top index on scalar grid
     1561             k_wall = MAXLOC(                                                  &
     1562                          MERGE( 1, 0,                                         &
     1563                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1564                               ), DIM = 1                                      &
     1565                            ) - 1
     1566             DO  k = k_wall+1, k_wall+pch_index
     1567                kk = k - k_wall  !- lad arrays are defined flat
    14661568                tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i)
    14671569             ENDDO
    … …  
    14711573!--       humidity
    14721574          CASE ( 5 )
    1473              DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1474                 kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1575!
     1576!--          Determine topography-top index on scalar grid
     1577             k_wall = MAXLOC(                                                  &
     1578                          MERGE( 1, 0,                                         &
     1579                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1580                               ), DIM = 1                                      &
     1581                            ) - 1
     1582             DO  k = k_wall+1, k_wall+pch_index
     1583
     1584                kk = k - k_wall
    14751585                tend(k,j,i) = tend(k,j,i) -                                    &
    14761586                                 lsec *                                        &
    … …  
    14921602!--       sgs-tke
    14931603          CASE ( 6 )
    1494              DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1495                 kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1604!
     1605!--          Determine topography-top index on scalar grid
     1606             k_wall = MAXLOC(                                                  &
     1607                          MERGE( 1, 0,                                         &
     1608                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1609                               ), DIM = 1                                      &
     1610                            ) - 1
     1611             DO  k = k_wall+1, k_wall+pch_index
     1612
     1613                kk = k - k_wall
    14961614                tend(k,j,i) = tend(k,j,i) -                                    &
    14971615                                 2.0_wp * cdc *                                &
    … …  
    15131631!--       scalar concentration
    15141632          CASE ( 7 )
    1515              DO  k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index
    1516                 kk = k - nzb_s_inner(j,i)  !- lad arrays are defined flat
     1633!
     1634!--          Determine topography-top index on scalar grid
     1635             k_wall = MAXLOC(                                                  &
     1636                          MERGE( 1, 0,                                         &
     1637                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1638                               ), DIM = 1                                      &
     1639                            ) - 1
     1640             DO  k = k_wall+1, k_wall+pch_index
     1641
     1642                kk = k - k_wall
    15171643                tend(k,j,i) = tend(k,j,i) -                                    &
    15181644                                 lsec *                                        &

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r2230 r2232  
    2121! Current revisions:
    2222! ------------------
    23 !
     23! Adjustments to new topography concept
    2424!
    2525! Former revisions:
    … …  
    139139    USE arrays_3d,                                                             &
    140140        ONLY:  dzu, dzw, e, e_p, nr, pt, pt_p, q, q_p, qr, u, u_p, v, v_p,     &
    141                w, w_p, zu, zw, z0
     141               w, w_p, zu, zw
    142142#else
    143143   USE arrays_3d,                                                              &
    144144        ONLY:  dzu, dzw, e, e_p, e_1, e_2, nr, nr_2, nr_p, pt, pt_p, pt_1,     &
    145145               pt_2, q, q_p, q_1, q_2, qr, qr_2, s, s_2, u, u_p, u_1, u_2, v,  &
    146                v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw, z0
     146               v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw
    147147#endif
    148148
    … …  
    151151               message_string, microphysics_seifert, nest_bound_l, nest_bound_r,&
    152152               nest_bound_s, nest_bound_n, nest_domain, neutral, passive_scalar,&
    153                simulated_time, topography, volume_flow
     153               roughness_length, simulated_time, topography, volume_flow
    154154
    155155    USE cpulog,                                                                 &
    … …  
    161161    USE indices,                                                                &
    162162        ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg,  &
    163                nysv, nz, nzb, nzb_s_inner, nzb_u_inner, nzb_u_outer,            &
    164                nzb_v_inner, nzb_v_outer, nzb_w_inner, nzb_w_outer, nzt
     163               nysv, nz, nzb, nzb_max, nzt, wall_flags_0
    165164
    166165    USE kinds
    … …  
    201200
    202201#endif
     202
     203    USE surface_mod,                                                            &
     204        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
    203205
    204206    IMPLICIT NONE
    … …  
    13101312
    13111313       INTEGER(iwp) ::  direction    !:  Wall normal index: 1=k, 2=j, 3=i.
     1314       INTEGER(iwp) ::  end_index    !:  End index of present surface data type
    13121315       INTEGER(iwp) ::  i            !:
    13131316       INTEGER(iwp) ::  icorr        !:
    … …  
    13191322       INTEGER(iwp) ::  jw           !:
    13201323       INTEGER(iwp) ::  k            !:
     1324       INTEGER(iwp) ::  k_wall_u_ji    !:
     1325       INTEGER(iwp) ::  k_wall_u_ji_p  !:
     1326       INTEGER(iwp) ::  k_wall_u_ji_m  !:
     1327       INTEGER(iwp) ::  k_wall_v_ji    !:
     1328       INTEGER(iwp) ::  k_wall_v_ji_p  !:
     1329       INTEGER(iwp) ::  k_wall_v_ji_m  !:
     1330       INTEGER(iwp) ::  k_wall_w_ji    !:
     1331       INTEGER(iwp) ::  k_wall_w_ji_p  !:
     1332       INTEGER(iwp) ::  k_wall_w_ji_m  !:
    13211333       INTEGER(iwp) ::  kb           !:
    13221334       INTEGER(iwp) ::  kcorr        !:
    13231335       INTEGER(iwp) ::  lc           !:
     1336       INTEGER(iwp) ::  m            !: Running index for surface data type
    13241337       INTEGER(iwp) ::  ni           !:
    13251338       INTEGER(iwp) ::  nj           !:
    13261339       INTEGER(iwp) ::  nk           !:
    13271340       INTEGER(iwp) ::  nzt_topo_max !:
     1341       INTEGER(iwp) ::  start_index  !:  Start index of present surface data type
    13281342       INTEGER(iwp) ::  wall_index   !:  Index of the wall-node coordinate
    13291343
     1344       REAL(wp)     ::  z0_topo      !:  roughness at vertical walls
    13301345       REAL(wp), ALLOCATABLE, DIMENSION(:) ::  lcr   !:
    13311346
    … …  
    13391354          DO  i = nxl-1, nxl
    13401355             DO  j = nys, nyn
    1341                 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i),   &
    1342                                          nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1356!
     1357!--             Concept need to be reconsidered for 3D-topography
     1358!--             Determine largest topography index on scalar grid
     1359                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
     1360                  MAXLOC(                                                      &
     1361                          MERGE( 1, 0,                                         &
     1362                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     1363                               ), DIM = 1                                      &
     1364                        ) - 1          )
     1365!
     1366!--             Determine largest topography index on u grid
     1367                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
     1368                  MAXLOC(                                                      &
     1369                          MERGE( 1, 0,                                         &
     1370                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 )  &
     1371                               ), DIM = 1                                      &
     1372                        ) - 1          )
     1373!
     1374!--             Determine largest topography index on v grid
     1375                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
     1376                  MAXLOC(                                                      &
     1377                          MERGE( 1, 0,                                         &
     1378                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 )  &
     1379                               ), DIM = 1                                      &
     1380                        ) - 1          )
     1381!
     1382!--             Determine largest topography index on w grid
     1383                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
     1384                  MAXLOC(                                                      &
     1385                          MERGE( 1, 0,                                         &
     1386                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 )  &
     1387                               ), DIM = 1                                      &
     1388                        ) - 1          )
    13431389             ENDDO
    13441390          ENDDO
    … …  
    13501396          i = nxr + 1
    13511397          DO  j = nys, nyn
    1352              nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i),      &
    1353                                       nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1398!
     1399!--             Concept need to be reconsidered for 3D-topography
     1400!--             Determine largest topography index on scalar grid
     1401                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
     1402                  MAXLOC(                                                      &
     1403                          MERGE( 1, 0,                                         &
     1404                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )  &
     1405                               ), DIM = 1                                      &
     1406                        ) - 1          )
     1407!
     1408!--             Determine largest topography index on u grid
     1409                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
     1410                  MAXLOC(                                                      &
     1411                          MERGE( 1, 0,                                         &
     1412                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 )  &
     1413                               ), DIM = 1                                      &
     1414                        ) - 1          )
     1415!
     1416!--             Determine largest topography index on v grid
     1417                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
     1418                  MAXLOC(                                                      &
     1419                          MERGE( 1, 0,                                         &
     1420                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 )  &
     1421                               ), DIM = 1                                      &
     1422                        ) - 1          )
     1423!
     1424!--             Determine largest topography index on w grid
     1425                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
     1426                  MAXLOC(                                                      &
     1427                          MERGE( 1, 0,                                         &
     1428                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 )  &
     1429                               ), DIM = 1                                      &
     1430                        ) - 1          )
    13541431          ENDDO
    13551432          nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1
    … …  
    13601437          DO  j = nys-1, nys
    13611438             DO  i = nxl, nxr
    1362                 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i),   &
    1363                                          nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1439!
     1440!--             Concept need to be reconsidered for 3D-topography
     1441!--             Determine largest topography index on scalar grid
     1442                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
     1443                  MAXLOC(                                                      &
     1444                          MERGE( 1, 0,                                         &
     1445                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )  &
     1446                               ), DIM = 1                                      &
     1447                        ) - 1          )
     1448!
     1449!--             Determine largest topography index on u grid
     1450                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
     1451                  MAXLOC(                                                      &
     1452                          MERGE( 1, 0,                                         &
     1453                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 )  &
     1454                               ), DIM = 1                                      &
     1455                        ) - 1          )
     1456!
     1457!--             Determine largest topography index on v grid
     1458                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
     1459                  MAXLOC(                                                      &
     1460                          MERGE( 1, 0,                                         &
     1461                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 )  &
     1462                               ), DIM = 1                                      &
     1463                        ) - 1          )
     1464!
     1465!--             Determine largest topography index on w grid
     1466                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
     1467                  MAXLOC(                                                      &
     1468                          MERGE( 1, 0,                                         &
     1469                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 )  &
     1470                               ), DIM = 1                                      &
     1471                        ) - 1          )
    13641472             ENDDO
    13651473          ENDDO
    … …  
    13711479          j = nyn + 1
    13721480          DO  i = nxl, nxr
    1373              nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i),      &
    1374                                       nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1481!
     1482!--             Concept need to be reconsidered for 3D-topography
     1483!--             Determine largest topography index on scalar grid
     1484                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
     1485                  MAXLOC(                                                      &
     1486                          MERGE( 1, 0,                                         &
     1487                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )  &
     1488                               ), DIM = 1                                      &
     1489                        ) - 1          )
     1490!
     1491!--             Determine largest topography index on u grid
     1492                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
     1493                  MAXLOC(                                                      &
     1494                          MERGE( 1, 0,                                         &
     1495                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 )  &
     1496                               ), DIM = 1                                      &
     1497                        ) - 1          )
     1498!
     1499!--             Determine largest topography index on v grid
     1500                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
     1501                  MAXLOC(                                                      &
     1502                          MERGE( 1, 0,                                         &
     1503                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 )  &
     1504                               ), DIM = 1                                      &
     1505                        ) - 1          )
     1506!
     1507!--             Determine largest topography index on w grid
     1508                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
     1509                  MAXLOC(                                                      &
     1510                          MERGE( 1, 0,                                         &
     1511                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 )  &
     1512                               ), DIM = 1                                      &
     1513                        ) - 1          )
    13751514          ENDDO
    13761515          nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1
    … …  
    14221561!--          Left boundary for u
    14231562             i   = 0
    1424              kb  = nzb_u_inner(j,i)
    1425              k   = kb + 1
    1426              wall_index = kb
    1427              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1428                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1563!
     1564!--          For loglaw correction the roughness z0 is required. z0, however,
     1565!--          is part of the surfacetypes now, so call subroutine according
     1566!--          to the present surface tpye.
     1567!--          Default surface type
     1568             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1569                  surf_def_h(0)%end_index(j,i) )  THEN
     1570                start_index = surf_def_h(0)%start_index(j,i)
     1571                end_index   = surf_def_h(0)%end_index(j,i)
     1572                DO  m = start_index, end_index
     1573                   k          = surf_def_h(0)%k(m)
     1574                   wall_index = k - 1
     1575                   kb         = k - 1
     1576                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1577                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1578                            kb, direction, ncorr )
     1579                ENDDO
     1580!
     1581!--          Natural surface type
     1582             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1583                      surf_lsm_h%end_index(j,i) )  THEN
     1584                start_index = surf_lsm_h%start_index(j,i)
     1585                end_index   = surf_lsm_h%end_index(j,i)
     1586                DO  m = start_index, end_index
     1587                   k          = surf_lsm_h%k(m)
     1588                   wall_index = k - 1
     1589                   kb         = k - 1
     1590                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1591                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1592                            kb, direction, ncorr )
     1593                ENDDO
     1594!
     1595!--          Urban surface type
     1596             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1597                      surf_usm_h%end_index(j,i) )  THEN
     1598                start_index = surf_usm_h%start_index(j,i)
     1599                end_index = surf_usm_h%end_index(j,i)
     1600                DO  m = start_index, end_index
     1601                   k          = surf_usm_h%k(m)
     1602                   wall_index = k - 1
     1603                   kb         = k - 1
     1604                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1605                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1606                            kb, direction, ncorr )
     1607                ENDDO
     1608             ENDIF
    14291609             logc_u_l(1,k,j) = lc
    14301610             logc_ratio_u_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    … …  
    14331613!--          Left boundary for v
    14341614             i   = -1
    1435              kb  =  nzb_v_inner(j,i)
    1436              k   =  kb + 1
    1437              wall_index = kb
    1438              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1439                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1615!
     1616!--          For loglaw correction the roughness z0 is required. z0, however,
     1617!--          is part of the surfacetypes now, so call subroutine according
     1618!--          to the present surface tpye.
     1619!--          Default surface type
     1620             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1621                  surf_def_h(0)%end_index(j,i) )  THEN
     1622                start_index = surf_def_h(0)%start_index(j,i)
     1623                end_index   = surf_def_h(0)%end_index(j,i)
     1624                DO  m = start_index, end_index
     1625                   k          = surf_def_h(0)%k(m)
     1626                   wall_index = k - 1
     1627                   kb         = k - 1
     1628                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1629                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1630                            kb, direction, ncorr )
     1631                ENDDO
     1632!
     1633!--          Natural surface type
     1634             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1635                      surf_lsm_h%end_index(j,i) )  THEN
     1636                start_index = surf_lsm_h%start_index(j,i)
     1637                end_index   = surf_lsm_h%end_index(j,i)
     1638                DO  m = start_index, end_index
     1639                   k          = surf_lsm_h%k(m)
     1640                   wall_index = k - 1
     1641                   kb         = k - 1
     1642                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1643                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1644                            kb, direction, ncorr )
     1645                ENDDO
     1646!
     1647!--          Urban surface type
     1648             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1649                      surf_usm_h%end_index(j,i) )  THEN
     1650                start_index = surf_usm_h%start_index(j,i)
     1651                end_index = surf_usm_h%end_index(j,i)
     1652                DO  m = start_index, end_index
     1653                   k          = surf_usm_h%k(m)
     1654                   wall_index = k - 1
     1655                   kb         = k - 1
     1656                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1657                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1658                            kb, direction, ncorr )
     1659                ENDDO
     1660             ENDIF
    14401661             logc_v_l(1,k,j) = lc
    14411662             logc_ratio_v_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    … …  
    14691690!--          Right boundary for u
    14701691             i   = nxr + 1
    1471              kb  = nzb_u_inner(j,i)
    1472              k   = kb + 1
    1473              wall_index = kb
    1474              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1475                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1692!
     1693!--          For loglaw correction the roughness z0 is required. z0, however,
     1694!--          is part of the surfacetypes now, so call subroutine according
     1695!--          to the present surface tpye.
     1696!--          Default surface type
     1697             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1698                  surf_def_h(0)%end_index(j,i) )  THEN
     1699                start_index = surf_def_h(0)%start_index(j,i)
     1700                end_index   = surf_def_h(0)%end_index(j,i)
     1701                DO  m = start_index, end_index
     1702                   k          = surf_def_h(0)%k(m)
     1703                   wall_index = k - 1
     1704                   kb         = k - 1
     1705                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1706                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1707                            kb, direction, ncorr )
     1708                ENDDO
     1709!
     1710!--          Natural surface type
     1711             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1712                      surf_lsm_h%end_index(j,i) )  THEN
     1713                start_index = surf_lsm_h%start_index(j,i)
     1714                end_index   = surf_lsm_h%end_index(j,i)
     1715                DO  m = start_index, end_index
     1716                   k          = surf_lsm_h%k(m)
     1717                   wall_index = k - 1
     1718                   kb         = k - 1
     1719                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1720                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1721                            kb, direction, ncorr )
     1722                ENDDO
     1723!
     1724!--          Urban surface type
     1725             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1726                      surf_usm_h%end_index(j,i) )  THEN
     1727                start_index = surf_usm_h%start_index(j,i)
     1728                end_index = surf_usm_h%end_index(j,i)
     1729                DO  m = start_index, end_index
     1730                   k          = surf_usm_h%k(m)
     1731                   wall_index = k - 1
     1732                   kb         = k - 1
     1733                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1734                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1735                            kb, direction, ncorr )
     1736                ENDDO
     1737             ENDIF
     1738
    14761739             logc_u_r(1,k,j) = lc
    14771740             logc_ratio_u_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    … …  
    14801743!--          Right boundary for v
    14811744             i   = nxr + 1
    1482              kb  = nzb_v_inner(j,i)
    1483              k   = kb + 1
    1484              wall_index = kb
    1485              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1486                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1745!
     1746!--          For loglaw correction the roughness z0 is required. z0, however,
     1747!--          is part of the surfacetypes now, so call subroutine according
     1748!--          to the present surface tpye.
     1749!--          Default surface type
     1750             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1751                  surf_def_h(0)%end_index(j,i) )  THEN
     1752                start_index = surf_def_h(0)%start_index(j,i)
     1753                end_index   = surf_def_h(0)%end_index(j,i)
     1754                DO  m = start_index, end_index
     1755                   k          = surf_def_h(0)%k(m)
     1756                   wall_index = k - 1
     1757                   kb         = k - 1
     1758                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1759                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1760                            kb, direction, ncorr )
     1761                ENDDO
     1762!
     1763!--          Natural surface type
     1764             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1765                      surf_lsm_h%end_index(j,i) )  THEN
     1766                start_index = surf_lsm_h%start_index(j,i)
     1767                end_index   = surf_lsm_h%end_index(j,i)
     1768                DO  m = start_index, end_index
     1769                   k          = surf_lsm_h%k(m)
     1770                   wall_index = k - 1
     1771                   kb         = k - 1
     1772                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1773                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1774                            kb, direction, ncorr )
     1775                ENDDO
     1776!
     1777!--          Urban surface type
     1778             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1779                      surf_usm_h%end_index(j,i) )  THEN
     1780                start_index = surf_usm_h%start_index(j,i)
     1781                end_index = surf_usm_h%end_index(j,i)
     1782                DO  m = start_index, end_index
     1783                   k          = surf_usm_h%k(m)
     1784                   wall_index = k - 1
     1785                   kb         = k - 1
     1786                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1787                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1788                            kb, direction, ncorr )
     1789                ENDDO
     1790             ENDIF
    14871791             logc_v_r(1,k,j) = lc
    14881792             logc_ratio_v_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    … …  
    15161820!--          South boundary for u
    15171821             j   = -1
    1518              kb  =  nzb_u_inner(j,i)
    1519              k   =  kb + 1
    1520              wall_index = kb
    1521              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1522                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1822!
     1823!--          For loglaw correction the roughness z0 is required. z0, however,
     1824!--          is part of the surfacetypes now, so call subroutine according
     1825!--          to the present surface tpye.
     1826!--          Default surface type
     1827             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1828                  surf_def_h(0)%end_index(j,i) )  THEN
     1829                start_index = surf_def_h(0)%start_index(j,i)
     1830                end_index   = surf_def_h(0)%end_index(j,i)
     1831                DO  m = start_index, end_index
     1832                   k          = surf_def_h(0)%k(m)
     1833                   wall_index = k - 1
     1834                   kb         = k - 1
     1835                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1836                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1837                            kb, direction, ncorr )
     1838                ENDDO
     1839!
     1840!--          Natural surface type
     1841             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1842                      surf_lsm_h%end_index(j,i) )  THEN
     1843                start_index = surf_lsm_h%start_index(j,i)
     1844                end_index   = surf_lsm_h%end_index(j,i)
     1845                DO  m = start_index, end_index
     1846                   k          = surf_lsm_h%k(m)
     1847                   wall_index = k - 1
     1848                   kb         = k - 1
     1849                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1850                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1851                            kb, direction, ncorr )
     1852                ENDDO
     1853!
     1854!--          Urban surface type
     1855             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1856                      surf_usm_h%end_index(j,i) )  THEN
     1857                start_index = surf_usm_h%start_index(j,i)
     1858                end_index = surf_usm_h%end_index(j,i)
     1859                DO  m = start_index, end_index
     1860                   k          = surf_usm_h%k(m)
     1861                   wall_index = k - 1
     1862                   kb         = k - 1
     1863                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1864                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1865                            kb, direction, ncorr )
     1866                ENDDO
     1867             ENDIF
    15231868             logc_u_s(1,k,i) = lc
    15241869             logc_ratio_u_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    … …  
    15271872!--          South boundary for v
    15281873             j   = 0
    1529              kb  = nzb_v_inner(j,i)
    1530              k   = kb + 1
    1531              wall_index = kb
    1532              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1533                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1874!
     1875!--          For loglaw correction the roughness z0 is required. z0, however,
     1876!--          is part of the surfacetypes now, so call subroutine according
     1877!--          to the present surface tpye.
     1878!--          Default surface type
     1879             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1880                  surf_def_h(0)%end_index(j,i) )  THEN
     1881                start_index = surf_def_h(0)%start_index(j,i)
     1882                end_index   = surf_def_h(0)%end_index(j,i)
     1883                DO  m = start_index, end_index
     1884                   k          = surf_def_h(0)%k(m)
     1885                   wall_index = k - 1
     1886                   kb         = k - 1
     1887                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1888                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1889                            kb, direction, ncorr )
     1890                ENDDO
     1891!
     1892!--          Natural surface type
     1893             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1894                      surf_lsm_h%end_index(j,i) )  THEN
     1895                start_index = surf_lsm_h%start_index(j,i)
     1896                end_index   = surf_lsm_h%end_index(j,i)
     1897                DO  m = start_index, end_index
     1898                   k          = surf_lsm_h%k(m)
     1899                   wall_index = k - 1
     1900                   kb         = k - 1
     1901                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1902                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1903                            kb, direction, ncorr )
     1904                ENDDO
     1905!
     1906!--          Urban surface type
     1907             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1908                      surf_usm_h%end_index(j,i) )  THEN
     1909                start_index = surf_usm_h%start_index(j,i)
     1910                end_index = surf_usm_h%end_index(j,i)
     1911                DO  m = start_index, end_index
     1912                   k          = surf_usm_h%k(m)
     1913                   wall_index = k - 1
     1914                   kb         = k - 1
     1915                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1916                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1917                            kb, direction, ncorr )
     1918                ENDDO
     1919             ENDIF
    15341920             logc_v_s(1,k,i) = lc
    15351921             logc_ratio_v_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    … …  
    15631949!--          North boundary for u
    15641950             j   = nyn + 1
    1565              kb  = nzb_u_inner(j,i)
    1566              k   = kb + 1
    1567              wall_index = kb
    1568              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1569                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     1951!
     1952!--          For loglaw correction the roughness z0 is required. z0, however,
     1953!--          is part of the surfacetypes now, so call subroutine according
     1954!--          to the present surface tpye.
     1955!--          Default surface type
     1956             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     1957                  surf_def_h(0)%end_index(j,i) )  THEN
     1958                start_index = surf_def_h(0)%start_index(j,i)
     1959                end_index   = surf_def_h(0)%end_index(j,i)
     1960                DO  m = start_index, end_index
     1961                   k          = surf_def_h(0)%k(m)
     1962                   wall_index = k - 1
     1963                   kb         = k - 1
     1964                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1965                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     1966                            kb, direction, ncorr )
     1967                ENDDO
     1968!
     1969!--          Natural surface type
     1970             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     1971                      surf_lsm_h%end_index(j,i) )  THEN
     1972                start_index = surf_lsm_h%start_index(j,i)
     1973                end_index   = surf_lsm_h%end_index(j,i)
     1974                DO  m = start_index, end_index
     1975                   k          = surf_lsm_h%k(m)
     1976                   wall_index = k - 1
     1977                   kb         = k - 1
     1978                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1979                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     1980                            kb, direction, ncorr )
     1981                ENDDO
     1982!
     1983!--          Urban surface type
     1984             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     1985                      surf_usm_h%end_index(j,i) )  THEN
     1986                start_index = surf_usm_h%start_index(j,i)
     1987                end_index = surf_usm_h%end_index(j,i)
     1988                DO  m = start_index, end_index
     1989                   k          = surf_usm_h%k(m)
     1990                   wall_index = k - 1
     1991                   kb         = k - 1
     1992                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     1993                            j, inc, wall_index, surf_usm_h%z0(m),    &
     1994                            kb, direction, ncorr )
     1995                ENDDO
     1996             ENDIF
    15701997             logc_u_n(1,k,i) = lc
    15711998             logc_ratio_u_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    … …  
    15742001!--          North boundary for v
    15752002             j   = nyn + 1
    1576              kb  = nzb_v_inner(j,i)
    1577              k   = kb + 1
    1578              wall_index = kb
    1579              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    1580                                 inc, wall_index, z0(j,i), kb, direction, ncorr )
     2003!
     2004!--          For loglaw correction the roughness z0 is required. z0, however,
     2005!--          is part of the surfacetypes now, so call subroutine according
     2006!--          to the present surface tpye.
     2007!--          Default surface type
     2008             IF ( surf_def_h(0)%start_index(j,i) <=                            &
     2009                  surf_def_h(0)%end_index(j,i) )  THEN
     2010                start_index = surf_def_h(0)%start_index(j,i)
     2011                end_index   = surf_def_h(0)%end_index(j,i)
     2012                DO  m = start_index, end_index
     2013                   k          = surf_def_h(0)%k(m)
     2014                   wall_index = k - 1
     2015                   kb         = k - 1
     2016                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     2017                            j, inc, wall_index, surf_def_h(0)%z0(m), &
     2018                            kb, direction, ncorr )
     2019                ENDDO
     2020!
     2021!--          Natural surface type
     2022             ELSEIF ( surf_lsm_h%start_index(j,i) <=                           &
     2023                      surf_lsm_h%end_index(j,i) )  THEN
     2024                start_index = surf_lsm_h%start_index(j,i)
     2025                end_index   = surf_lsm_h%end_index(j,i)
     2026                DO  m = start_index, end_index
     2027                   k          = surf_lsm_h%k(m)
     2028                   wall_index = k - 1
     2029                   kb         = k - 1
     2030                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     2031                            j, inc, wall_index, surf_lsm_h%z0(m),    &
     2032                            kb, direction, ncorr )
     2033                ENDDO
     2034!
     2035!--          Urban surface type
     2036             ELSEIF ( surf_usm_h%start_index(j,i) <=                           &
     2037                      surf_usm_h%end_index(j,i) )  THEN
     2038                start_index = surf_usm_h%start_index(j,i)
     2039                end_index = surf_usm_h%end_index(j,i)
     2040                DO  m = start_index, end_index
     2041                   k          = surf_usm_h%k(m)
     2042                   wall_index = k - 1
     2043                   kb         = k - 1
     2044                   CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,  &
     2045                            j, inc, wall_index, surf_usm_h%z0(m),    &
     2046                            kb, direction, ncorr )
     2047                ENDDO
     2048             ENDIF
    15812049             logc_v_n(1,k,i) = lc
    15822050             logc_ratio_v_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    … …  
    15902058!--    Then vertical walls and corners if necessary
    15912059       IF ( topography /= 'flat' )  THEN
     2060!
     2061!--       Workaround, set z0 at vertical surfaces simply to the given roughness
     2062!--       lenth, which is required to determine the logarithmic correction
     2063!--       factors at the child boundaries, which are at the ghost-points.
     2064!--       The surface data type for vertical surfaces, however, is not defined
     2065!--       at ghost-points, so that no z0 can be retrieved at this point.
     2066!--       Maybe, revise this later and define vertical surface datattype also
     2067!--       at ghost-points.
     2068          z0_topo = roughness_length
    15922069
    15932070          kb = 0       ! kb is not used when direction > 1
    15942071!       
    15952072!--       Left boundary
     2073
     2074!
     2075!--       Are loglaw-correction parameters also calculated inside topo?
    15962076          IF ( nest_bound_l )  THEN
    15972077
    … …  
    15992079
    16002080             DO  j = nys, nyn
     2081                k_wall_u_ji   = MAXLOC(                                        &
     2082                            MERGE( 1, 0,                                       &
     2083                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,0), 26 ) &
     2084                                 ), DIM = 1                                    &
     2085                                      ) - 1
     2086                k_wall_u_ji_p = MAXLOC(                                        &
     2087                            MERGE( 1, 0,                                       &
     2088                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,0), 26 )&
     2089                                 ), DIM = 1                                    &
     2090                                      ) - 1
     2091                k_wall_u_ji_m = MAXLOC(                                        &
     2092                            MERGE( 1, 0,                                       &
     2093                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,0), 26 )&
     2094                                 ), DIM = 1                                    &
     2095                                      ) - 1
     2096
     2097                k_wall_w_ji   = MAXLOC(                                        &
     2098                            MERGE( 1, 0,                                       &
     2099                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,-1), 28 )&
     2100                                 ), DIM = 1                                    &
     2101                                      ) - 1
     2102                k_wall_w_ji_p = MAXLOC(                                        &
     2103                            MERGE( 1, 0,                                       &
     2104                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,-1), 28 )&
     2105                                 ), DIM = 1                                    &
     2106                                      ) - 1
     2107                k_wall_w_ji_m = MAXLOC(                                        &
     2108                            MERGE( 1, 0,                                       &
     2109                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,-1), 28 )&
     2110                                 ), DIM = 1                                    &
     2111                                      ) - 1
     2112
    16012113                DO  k = nzb, nzt_topo_nestbc_l
     2114
     2115                   i            = 0
    16022116!
    16032117!--                Wall for u on the south side, but not on the north side
    1604                    i  = 0
    1605                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) .AND.         &
    1606                         ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )            &
     2118                   IF ( ( k_wall_u_ji > k_wall_u_ji_p ) .AND.                  &
     2119                        ( k_wall_u_ji == k_wall_u_ji_m ) )                     &
    16072120                   THEN
    16082121                      inc        =  1
    16092122                      wall_index =  j
    1610                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1611                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2123                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2124                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    16122125!
    16132126!--                   The direction of the wall-normal index is stored as the
    … …  
    16202133!
    16212134!--                Wall for u on the north side, but not on the south side
    1622                    i  = 0
    1623                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) .AND.         &
    1624                         ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) )  THEN
     2135                   IF ( ( k_wall_u_ji > k_wall_u_ji_m ) .AND.                  &
     2136                        ( k_wall_u_ji == k_wall_u_ji_p ) )  THEN
    16252137                      inc        = -1
    16262138                      wall_index =  j + 1
    1627                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1628                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2139                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2140                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    16292141!
    16302142!--                   The direction of the wall-normal index is stored as the
    … …  
    16352147                   ENDIF
    16362148
     2149                   i  = -1
    16372150!
    16382151!--                Wall for w on the south side, but not on the north side.
    1639                    i  = -1
    1640                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.        &
    1641                         ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) )  THEN
     2152
     2153                   IF ( ( k_wall_w_ji > k_wall_w_ji_p )  .AND.                 &
     2154                        ( k_wall_w_ji == k_wall_w_ji_m ) )  THEN   
    16422155                      inc        =  1
    16432156                      wall_index =  j
    1644                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1645                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2157                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2158                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    16462159!
    16472160!--                   The direction of the wall-normal index is stored as the
    … …  
    16542167!
    16552168!--                Wall for w on the north side, but not on the south side.
    1656                    i  = -1
    1657                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  .AND.        &
    1658                         ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) )  THEN
     2169                   IF ( ( k_wall_w_ji > k_wall_w_ji_m )  .AND.                 &
     2170                        ( k_wall_w_ji == k_wall_w_ji_p ) )  THEN
    16592171                      inc        = -1
    16602172                      wall_index =  j+1
    1661                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1662                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2173                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2174                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    16632175!
    16642176!--                   The direction of the wall-normal index is stored as the
    … …  
    16822194
    16832195             DO  j = nys, nyn
     2196
     2197                k_wall_u_ji    = MAXLOC(                                       &
     2198                            MERGE( 1, 0,                                       &
     2199                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 26 ) &
     2200                                 ), DIM = 1                                    &
     2201                                     ) - 1
     2202                k_wall_u_ji_p  = MAXLOC(                                       &
     2203                            MERGE( 1, 0,                                       &
     2204                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 26 )&
     2205                                 ), DIM = 1                                    &
     2206                                     ) - 1
     2207                k_wall_u_ji_m  = MAXLOC(                                       &
     2208                            MERGE( 1, 0,                                       &
     2209                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 26 )&
     2210                                     ), DIM = 1                                &
     2211                                        ) - 1
     2212
     2213                k_wall_w_ji    = MAXLOC(                                       &
     2214                            MERGE( 1, 0,                                       &
     2215                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 28 ) &
     2216                                 ), DIM = 1                                    &
     2217                                     ) - 1
     2218                k_wall_w_ji_p  = MAXLOC(                                       &
     2219                            MERGE( 1, 0,                                       &
     2220                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 28 )&
     2221                                 ), DIM = 1                                    &
     2222                                     ) - 1
     2223                k_wall_w_ji_m  = MAXLOC(                                       &
     2224                            MERGE( 1, 0,                                       &
     2225                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 28 )&
     2226                                     ), DIM = 1                                &
     2227                                        ) - 1
    16842228                DO  k = nzb, nzt_topo_nestbc_r
    16852229!
    16862230!--                Wall for u on the south side, but not on the north side
    1687                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  .AND.        &
    1688                         ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )  THEN
     2231                   IF ( ( k_wall_u_ji > k_wall_u_ji_p )  .AND.                 &
     2232                        ( k_wall_u_ji == k_wall_u_ji_m ) )  THEN
    16892233                      inc        = 1
    16902234                      wall_index = j
    16912235                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1692                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2236                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    16932237!
    16942238!--                   The direction of the wall-normal index is stored as the
    … …  
    17012245!
    17022246!--                Wall for u on the north side, but not on the south side
    1703                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  .AND.        &
    1704                         ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) )  THEN
     2247                   IF ( ( k_wall_u_ji > k_wall_u_ji_m )  .AND.                  &
     2248                        ( k_wall_u_ji == k_wall_u_ji_p ) )  THEN
    17052249                      inc        = -1
    17062250                      wall_index =  j+1
    17072251                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1708                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2252                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    17092253!
    17102254!--                   The direction of the wall-normal index is stored as the
    … …  
    17172261!
    17182262!--                Wall for w on the south side, but not on the north side
    1719                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.        &
    1720                         ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) )  THEN
     2263                   IF ( ( k_wall_w_ji > k_wall_w_ji_p )  .AND.                 &
     2264                        ( k_wall_w_ji == k_wall_w_ji_m ) )  THEN
    17212265                      inc        =  1
    17222266                      wall_index =  j
    1723                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1724                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2267                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2268                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    17252269!
    17262270!--                   The direction of the wall-normal index is stored as the
    … …  
    17332277!
    17342278!--                Wall for w on the north side, but not on the south side
    1735                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  .AND.        &
    1736                         ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) )  THEN
     2279                   IF ( ( k_wall_w_ji > k_wall_w_ji_m )  .AND.                 &
     2280                        ( k_wall_w_ji == k_wall_w_ji_p ) )  THEN
    17372281                      inc        = -1
    17382282                      wall_index =  j+1
    1739                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1740                           k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2283                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2284                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    17412285
    17422286!
    … …  
    17602304
    17612305             DO  i = nxl, nxr
     2306
     2307                k_wall_v_ji    = MAXLOC(                                       &
     2308                            MERGE( 1, 0,                                       &
     2309                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i), 27 ) &
     2310                                 ), DIM = 1                                    &
     2311                                     ) - 1
     2312                k_wall_v_ji_p  = MAXLOC(                                       &
     2313                            MERGE( 1, 0,                                       &
     2314                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i+1), 27 )&
     2315                                 ), DIM = 1                                    &
     2316                                     ) - 1
     2317                k_wall_v_ji_m  = MAXLOC(                                       &
     2318                            MERGE( 1, 0,                                       &
     2319                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i-1), 27 )&
     2320                                     ), DIM = 1                                &
     2321                                        ) - 1
     2322
     2323                k_wall_w_ji    = MAXLOC(                                       &
     2324                            MERGE( 1, 0,                                       &
     2325                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i), 28 )&
     2326                                 ), DIM = 1                                    &
     2327                                     ) - 1
     2328                k_wall_w_ji_p  = MAXLOC(                                       &
     2329                            MERGE( 1, 0,                                       &
     2330                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i+1), 28 )&
     2331                                 ), DIM = 1                                    &
     2332                                     ) - 1
     2333                k_wall_w_ji_m  = MAXLOC(                                       &
     2334                            MERGE( 1, 0,                                       &
     2335                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i-1), 28 )&
     2336                                     ), DIM = 1                                &
     2337                                        ) - 1
    17622338                DO  k = nzb, nzt_topo_nestbc_s
    17632339!
    17642340!--                Wall for v on the left side, but not on the right side
    17652341                   j  = 0
    1766                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.        &
    1767                         ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1) ) )  THEN
     2342                   IF ( ( k_wall_v_ji > k_wall_v_ji_p )  .AND.                 &
     2343                        ( k_wall_v_ji == k_wall_v_ji_m ) )  THEN
    17682344                      inc        =  1
    17692345                      wall_index =  i
    1770                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1771                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2346                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2347                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    17722348!
    17732349!--                   The direction of the wall-normal index is stored as the
    … …  
    17812357!--                Wall for v on the right side, but not on the left side
    17822358                   j  = 0
    1783                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.        &
    1784                         ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1) ) )  THEN
     2359                   IF ( ( k_wall_v_ji > k_wall_v_ji_m )  .AND.                 &
     2360                        ( k_wall_v_ji == k_wall_v_ji_p ) )  THEN
    17852361                      inc        = -1
    17862362                      wall_index =  i+1
    1787                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1788                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2363                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2364                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    17892365!
    17902366!--                   The direction of the wall-normal index is stored as the
    … …  
    17982374!--                Wall for w on the left side, but not on the right side
    17992375                   j  = -1
    1800                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.        &
    1801                         ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1) ) )  THEN
     2376                   IF ( ( k_wall_w_ji > k_wall_w_ji_p )  .AND.                 &
     2377                        ( k_wall_w_ji == k_wall_w_ji_m ) )  THEN
    18022378                      inc        =  1
    18032379                      wall_index =  i
    1804                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1805                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2380                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2381                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    18062382!
    18072383!--                   The direction of the wall-normal index is stored as the
    … …  
    18152391!--                Wall for w on the right side, but not on the left side
    18162392                   j  = -1
    1817                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.        &
    1818                         ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1) ) )  THEN
     2393                   IF ( ( k_wall_w_ji > k_wall_w_ji_m )  .AND.                 &
     2394                        ( k_wall_w_ji == k_wall_w_ji_p ) )  THEN
    18192395                      inc        = -1
    18202396                      wall_index =  i+1
    1821                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1822                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2397                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2398                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    18232399!
    18242400!--                   The direction of the wall-normal index is stored as the
    … …  
    18422418
    18432419             DO  i = nxl, nxr
     2420                k_wall_v_ji    = MAXLOC(                                       &
     2421                            MERGE( 1, 0,                                       &
     2422                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 27 ) &
     2423                                 ), DIM = 1                                    &
     2424                                       ) - 1
     2425
     2426                k_wall_v_ji_p  = MAXLOC(                                       &
     2427                            MERGE( 1, 0,                                       &
     2428                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 27 )&
     2429                                 ), DIM = 1                                    &
     2430                                       ) - 1
     2431                k_wall_v_ji_m  = MAXLOC(                                       &
     2432                            MERGE( 1, 0,                                       &
     2433                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 27 )&
     2434                                     ), DIM = 1                                &
     2435                                       ) - 1
     2436
     2437                k_wall_w_ji    = MAXLOC(                                       &
     2438                            MERGE( 1, 0,                                       &
     2439                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 28 )  &
     2440                                 ), DIM = 1                                    &
     2441                                       ) - 1
     2442                k_wall_w_ji_p  = MAXLOC(                                       &
     2443                            MERGE( 1, 0,                                       &
     2444                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 28 )&
     2445                                 ), DIM = 1                                    &
     2446                                       ) - 1
     2447                k_wall_w_ji_m  = MAXLOC(                                       &
     2448                            MERGE( 1, 0,                                       &
     2449                          BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 28 )&
     2450                                     ), DIM = 1                                &
     2451                                       ) - 1
    18442452                DO  k = nzb, nzt_topo_nestbc_n
    18452453!
    18462454!--                Wall for v on the left side, but not on the right side
    1847                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.        &
    1848                         ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1) ) )  THEN
     2455                   IF ( ( k_wall_v_ji > k_wall_v_ji_p )  .AND.                 &
     2456                        ( k_wall_v_ji == k_wall_v_ji_m ) )  THEN
    18492457                      inc        = 1
    18502458                      wall_index = i
    1851                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1852                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2459                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2460                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    18532461!
    18542462!--                   The direction of the wall-normal index is stored as the
    … …  
    18612469!
    18622470!--                Wall for v on the right side, but not on the left side
    1863                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.        &
    1864                         ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1) ) )  THEN
     2471                   IF ( ( k_wall_v_ji > k_wall_v_ji_m )  .AND.                 &
     2472                        ( k_wall_v_ji == k_wall_v_ji_p ) )  THEN
    18652473                      inc        = -1
    18662474                      wall_index =  i + 1
    1867                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1868                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2475                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2476                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    18692477!
    18702478!--                   The direction of the wall-normal index is stored as the
    … …  
    18772485!
    18782486!--                Wall for w on the left side, but not on the right side
    1879                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.        &
    1880                         ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1) ) )  THEN
     2487                   IF ( ( k_wall_v_ji > k_wall_v_ji_p )  .AND.                 &
     2488                        ( k_wall_v_ji == k_wall_v_ji_m ) )  THEN
    18812489                      inc        = 1
    18822490                      wall_index = i
    1883                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1884                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2491                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     2492                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    18852493!
    18862494!--                   The direction of the wall-normal index is stored as the
    … …  
    18932501!
    18942502!--                Wall for w on the right side, but not on the left side
    1895                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.        &
    1896                         ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1) ) )  THEN
     2503                   IF ( ( k_wall_v_ji > k_wall_v_ji_m )  .AND.                 &
     2504                        ( k_wall_v_ji == k_wall_v_ji_p ) )  THEN
    18972505                      inc        = -1
    18982506                      wall_index =  i+1
    18992507                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    1900                           k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
     2508                          k, i, inc, wall_index, z0_topo, kb, direction, ncorr )
    19012509!
    19022510!--                   The direction of the wall-normal index is stored as the
    … …  
    24163024
    24173025
    2418     SUBROUTINE pmci_init_tkefactor
     3026SUBROUTINE pmci_init_tkefactor
    24193027
    24203028!
    … …  
    24263034
    24273035       IMPLICIT NONE
     3036
     3037       INTEGER(iwp)        ::  k                     !: index variable along z
     3038       INTEGER(iwp)        ::  k_wall                !: topography-top index along z
     3039       INTEGER(iwp)        ::  kc                    !:
     3040
    24283041       REAL(wp), PARAMETER ::  cfw = 0.2_wp          !:
    24293042       REAL(wp), PARAMETER ::  c_tkef = 0.6_wp       !:
    … …  
    24343047       REAL(wp)            ::  height                !:
    24353048       REAL(wp), PARAMETER ::  p13 = 1.0_wp/3.0_wp   !:
    2436        REAL(wp), PARAMETER ::  p23 = 2.0_wp/3.0_wp   !:
    2437        INTEGER(iwp)        ::  k                     !:
    2438        INTEGER(iwp)        ::  kc                    !:
    2439        
     3049       REAL(wp), PARAMETER ::  p23 = 2.0_wp/3.0_wp   !:       
    24403050
    24413051       IF ( nest_bound_l )  THEN
    … …  
    24443054          i = nxl - 1
    24453055          DO  j = nysg, nyng
    2446              DO  k = nzb_s_inner(j,i) + 1, nzt
     3056             k_wall = MAXLOC(                                                  &
     3057                          MERGE( 1, 0,                                         &
     3058                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     3059                               ), DIM = 1                                      &
     3060                            ) - 1
     3061
     3062             DO  k = k_wall + 1, nzt
     3063
    24473064                kc     = kco(k+1)
    24483065                glsf   = ( dx * dy * dzu(k) )**p13
    24493066                glsc   = ( cg%dx * cg%dy *cg%dzu(kc) )**p13
    2450                 height = zu(k) - zu(nzb_s_inner(j,i))
     3067                height = zu(k) - zu(k_wall)
    24513068                fw     = EXP( -cfw * height / glsf )
    24523069                tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    24533070                                              ( glsf / glsc )**p23 )
    24543071             ENDDO
    2455              tkefactor_l(nzb_s_inner(j,i),j) = c_tkef * fw0
     3072             tkefactor_l(k_wall,j) = c_tkef * fw0
    24563073          ENDDO
    24573074       ENDIF
    … …  
    24623079          i = nxr + 1
    24633080          DO  j = nysg, nyng
    2464              DO  k = nzb_s_inner(j,i) + 1, nzt
     3081             k_wall = MAXLOC(                                                  &
     3082                          MERGE( 1, 0,                                         &
     3083                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     3084                               ), DIM = 1                                      &
     3085                            ) - 1
     3086
     3087             DO  k = k_wall + 1, nzt
     3088
    24653089                kc     = kco(k+1)
    24663090                glsf   = ( dx * dy * dzu(k) )**p13
    24673091                glsc   = ( cg%dx * cg%dy * cg%dzu(kc) )**p13
    2468                 height = zu(k) - zu(nzb_s_inner(j,i))
     3092                height = zu(k) - zu(k_wall)
    24693093                fw     = EXP( -cfw * height / glsf )
    24703094                tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    24713095                                              ( glsf / glsc )**p23 )
    24723096             ENDDO
    2473              tkefactor_r(nzb_s_inner(j,i),j) = c_tkef * fw0
     3097             tkefactor_r(k_wall,j) = c_tkef * fw0
    24743098          ENDDO
    24753099       ENDIF
    … …  
    24803104          j = nys - 1
    24813105          DO  i = nxlg, nxrg
    2482              DO  k = nzb_s_inner(j,i) + 1, nzt
     3106             k_wall = MAXLOC(                                                  &
     3107                          MERGE( 1, 0,                                         &
     3108                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     3109                               ), DIM = 1                                      &
     3110                            ) - 1
     3111
     3112             DO  k = k_wall + 1, nzt
     3113
    24833114                kc     = kco(k+1)
    24843115                glsf   = ( dx * dy * dzu(k) )**p13
    24853116                glsc   = ( cg%dx * cg%dy * cg%dzu(kc) ) ** p13
    2486                 height = zu(k) - zu(nzb_s_inner(j,i))
     3117                height = zu(k) - zu(k_wall)
    24873118                fw     = EXP( -cfw*height / glsf )
    24883119                tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    24893120                                              ( glsf / glsc )**p23 )
    24903121             ENDDO
    2491              tkefactor_s(nzb_s_inner(j,i),i) = c_tkef * fw0
     3122             tkefactor_s(k_wall,i) = c_tkef * fw0
    24923123          ENDDO
    24933124       ENDIF
    … …  
    24983129          j = nyn + 1
    24993130          DO  i = nxlg, nxrg
    2500              DO  k = nzb_s_inner(j,i)+1, nzt
     3131             k_wall = MAXLOC(                                                  &
     3132                          MERGE( 1, 0,                                         &
     3133                                 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )    &
     3134                               ), DIM = 1                                      &
     3135                            ) - 1
     3136             DO  k = k_wall + 1, nzt
     3137
    25013138                kc     = kco(k+1)
    25023139                glsf   = ( dx * dy * dzu(k) )**p13
    25033140                glsc   = ( cg%dx * cg%dy * cg%dzu(kc) )**p13
    2504                 height = zu(k) - zu(nzb_s_inner(j,i))
     3141                height = zu(k) - zu(k_wall)
    25053142                fw     = EXP( -cfw * height / glsf )
    2506                 tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
     3143                tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
    25073144                                              ( glsf / glsc )**p23 )
    25083145             ENDDO
    2509              tkefactor_n(nzb_s_inner(j,i),i) = c_tkef * fw0
     3146             tkefactor_n(k_wall,i) = c_tkef * fw0
    25103147          ENDDO
    25113148       ENDIF
    … …  
    25133150       ALLOCATE( tkefactor_t(nysg:nyng,nxlg:nxrg) )
    25143151       k = nzt
     3152
    25153153       DO  i = nxlg, nxrg
    25163154          DO  j = nysg, nyng
     3155!
     3156!--          Determine vertical index for local topography top
     3157             k_wall = MAXLOC(                                                  &
     3158                        MERGE( 1, 0,                                           &
     3159                               BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 )      &
     3160                             ), DIM = 1                                        &
     3161                            ) - 1
     3162
    25173163             kc     = kco(k+1)
    25183164             glsf   = ( dx * dy * dzu(k) )**p13
    25193165             glsc   = ( cg%dx * cg%dy * cg%dzu(kc) )**p13
    2520              height = zu(k) - zu(nzb_s_inner(j,i))
     3166             height = zu(k) - zu(k_wall)
    25213167             fw     = EXP( -cfw * height / glsf )
    2522              tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *         &
     3168             tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *        &
    25233169                                           ( glsf / glsc )**p23 )
    25243170          ENDDO
    … …  
    27833429    INTEGER(iwp) ::  jcn        !:
    27843430    INTEGER(iwp) ::  jcs        !:
     3431    INTEGER(iwp) ::  k          !:
    27853432
    27863433    REAL(wp) ::  waittime       !:
    … …  
    28043451!--    The interpolation.
    28053452       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,    &
    2806                                    r2yo, r1zo, r2zo, nzb_u_inner, 'u' )
     3453                                   r2yo, r1zo, r2zo, 'u' )
    28073454       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,    &
    2808                                    r2yv, r1zo, r2zo, nzb_v_inner, 'v' )
     3455                                   r2yv, r1zo, r2zo, 'v' )
    28093456       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,    &
    2810                                    r2yo, r1zw, r2zw, nzb_w_inner, 'w' )
     3457                                   r2yo, r1zw, r2zw, 'w' )
    28113458       CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,    &
    2812                                    r2yo, r1zo, r2zo, nzb_s_inner, 'e' )
     3459                                   r2yo, r1zo, r2zo, 'e' )
    28133460
    28143461       IF ( .NOT. neutral )  THEN
    28153462          CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,       &
    2816                                       r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 's' )
     3463                                      r1yo, r2yo, r1zo, r2zo, 's' )
    28173464       ENDIF
    28183465
    … …  
    28203467
    28213468          CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo,   &
    2822                                       r2yo, r1zo, r2zo, nzb_s_inner, 's' )
     3469                                      r2yo, r1zo, r2zo, 's' )
    28233470
    28243471          IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    28253472!              CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,    &
    2826 !                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,   &
    2827 !                                          's' )
     3473!                                          r1yo, r2yo, r1zo, r2zo, 's' )
    28283474             CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,    &
    2829                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,   &
    2830                                          's' )
     3475                                         r1yo, r2yo, r1zo, r2zo, 's' )
    28313476!             CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,    &
    2832 !                                         r1yo, r2yo, r1zo, r2zo, nzb_s_inner,   &
    2833 !                                         's' )   
     3477!                                         r1yo, r2yo, r1zo, r2zo, 's' )   
    28343478             CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,    &
    2835                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,   &
    2836                                          's' )
     3479                                         r1yo, r2yo, r1zo, r2zo, 's' )
    28373480          ENDIF
    28383481
    … …  
    28413484       IF ( passive_scalar )  THEN
    28423485          CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,   &
    2843                                       r2yo, r1zo, r2zo, nzb_s_inner, 's' )
     3486                                      r2yo, r1zo, r2zo, 's' )
    28443487       ENDIF
    28453488
    … …  
    28513494          DO   i = nxlg, nxrg
    28523495             DO   j = nysg, nyng
    2853                 u(nzb:nzb_u_inner(j,i),j,i)   = 0.0_wp
    2854                 v(nzb:nzb_v_inner(j,i),j,i)   = 0.0_wp
    2855                 w(nzb:nzb_w_inner(j,i),j,i)   = 0.0_wp
    2856                 e(nzb:nzb_s_inner(j,i),j,i)   = 0.0_wp
    2857                 u_p(nzb:nzb_u_inner(j,i),j,i) = 0.0_wp
    2858                 v_p(nzb:nzb_v_inner(j,i),j,i) = 0.0_wp
    2859                 w_p(nzb:nzb_w_inner(j,i),j,i) = 0.0_wp
    2860                 e_p(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp
     3496                DO  k = nzb, nzt
     3497                   u(k,j,i)   = MERGE( u(k,j,i), 0.0_wp,                       &
     3498                                       BTEST( wall_flags_0(k,j,i), 1 ) )
     3499                   v(k,j,i)   = MERGE( v(k,j,i), 0.0_wp,                       &
     3500                                       BTEST( wall_flags_0(k,j,i), 2 ) )
     3501                   w(k,j,i)   = MERGE( w(k,j,i), 0.0_wp,                       &
     3502                                       BTEST( wall_flags_0(k,j,i), 3 ) )
     3503                   e(k,j,i)   = MERGE( e(k,j,i), 0.0_wp,                       &
     3504                                       BTEST( wall_flags_0(k,j,i), 0 ) )
     3505                   u_p(k,j,i) = MERGE( u_p(k,j,i), 0.0_wp,                     &
     3506                                       BTEST( wall_flags_0(k,j,i), 1 ) )
     3507                   v_p(k,j,i) = MERGE( v_p(k,j,i), 0.0_wp,                     &
     3508                                       BTEST( wall_flags_0(k,j,i), 2 ) )
     3509                   w_p(k,j,i) = MERGE( w_p(k,j,i), 0.0_wp,                     &
     3510                                       BTEST( wall_flags_0(k,j,i), 3 ) )
     3511                   e_p(k,j,i) = MERGE( e_p(k,j,i), 0.0_wp,                     &
     3512                                       BTEST( wall_flags_0(k,j,i), 0 ) )
     3513                ENDDO
    28613514             ENDDO
    28623515          ENDDO
    … …  
    28693522
    28703523    SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,     &
    2871                                      r1z, r2z, kb, var )
     3524                                     r1z, r2z, var )
    28723525!
    28733526!--    Interpolation of the internal values for the child-domain initialization
    … …  
    28813534       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !:
    28823535       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
    2883        INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb    !:
    2884 
    2885        INTEGER(iwp) ::  i      !:
    2886        INTEGER(iwp) ::  ib     !:
    2887        INTEGER(iwp) ::  ie     !:
    2888        INTEGER(iwp) ::  j      !:
    2889        INTEGER(iwp) ::  jb     !:
    2890        INTEGER(iwp) ::  je     !:
    2891        INTEGER(iwp) ::  k      !:
    2892        INTEGER(iwp) ::  k1     !:
    2893        INTEGER(iwp) ::  kbc    !:
    2894        INTEGER(iwp) ::  l      !:
    2895        INTEGER(iwp) ::  m      !:
    2896        INTEGER(iwp) ::  n      !:
     3536
     3537       INTEGER(iwp) ::  flag_nr  !: Number of flag array to mask topography on respective u/v/w or s grid
     3538       INTEGER(iwp) ::  flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid
     3539       INTEGER(iwp) ::  i        !:
     3540       INTEGER(iwp) ::  ib       !:
     3541       INTEGER(iwp) ::  ie       !:
     3542       INTEGER(iwp) ::  j        !:
     3543       INTEGER(iwp) ::  jb       !:
     3544       INTEGER(iwp) ::  je       !:
     3545       INTEGER(iwp) ::  k        !:
     3546       INTEGER(iwp) ::  k_wall   !:
     3547       INTEGER(iwp) ::  k1       !:
     3548       INTEGER(iwp) ::  kbc      !:
     3549       INTEGER(iwp) ::  l        !:
     3550       INTEGER(iwp) ::  m        !:
     3551       INTEGER(iwp) ::  n        !:
    28973552
    28983553       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
    … …  
    29143569       REAL(wp) ::  logzuc1    !:
    29153570       REAL(wp) ::  zuc1       !:
     3571       REAL(wp) ::  z0_topo    !:  roughness at vertical walls
    29163572
    29173573
    … …  
    29453601       ENDIF
    29463602!
     3603!--    Determine number of flag array to be used to mask topography
     3604       IF ( var == 'u' )  THEN
     3605          flag_nr  = 1
     3606          flag_nr2 = 14
     3607       ELSEIF ( var == 'v' )  THEN
     3608          flag_nr  = 2
     3609          flag_nr2 = 16
     3610       ELSEIF ( var == 'w' )  THEN
     3611          flag_nr  = 3
     3612          flag_nr2 = 18
     3613       ELSE
     3614          flag_nr  = 0
     3615          flag_nr2 = 12
     3616       ENDIF
     3617!
    29473618!--    Trilinear interpolation.
    29483619       DO  i = ib, ie
    29493620          DO  j = jb, je
    2950              DO  k = kb(j,i), nzt + 1
     3621             DO  k = nzb, nzt + 1
    29513622                l = ic(i)
    29523623                m = jc(j)
    … …  
    29703641!--    too.
    29713642       IF ( var == 'u' .OR. var == 'v' )  THEN
     3643          z0_topo = roughness_length
    29723644          DO  i = ib, nxr
    29733645             DO  j = jb, nyn
     3646!
     3647!--             Determine vertical index of topography top at grid point (j,i)
     3648                k_wall = MAXLOC(                                               &
     3649                      MERGE( 1, 0,                                             &
     3650                             BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )  &
     3651                           ), DIM = 1                                          &
     3652                               ) - 1
     3653!
     3654!--             kbc is the first coarse-grid point above the surface
    29743655                kbc = 1
    2975 !
    2976 !--             kbc is the first coarse-grid point above the surface
    2977                 DO  WHILE ( cg%zu(kbc) < zu(kb(j,i)) )
     3656                DO  WHILE ( cg%zu(kbc) < zu(k_wall) )
    29783657                   kbc = kbc + 1
    29793658                ENDDO
    29803659                zuc1 = cg%zu(kbc)
    2981                 k1   = kb(j,i) + 1
     3660                k1   = k_wall + 1
    29823661                DO  WHILE ( zu(k1) < zuc1 )
    29833662                   k1 = k1 + 1
    29843663                ENDDO
    2985                 logzuc1 = LOG( ( zu(k1) - zu(kb(j,i)) ) / z0(j,i) )
    2986 
    2987                 k = kb(j,i) + 1
     3664                logzuc1 = LOG( ( zu(k1) - zu(k_wall) ) / z0_topo )
     3665
     3666                k = k_wall + 1
    29883667                DO  WHILE ( zu(k) < zuc1 )
    2989                    logratio = ( LOG( ( zu(k) - zu(kb(j,i)) ) / z0(j,i)) ) /     &
     3668                   logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) /     &
    29903669                                logzuc1
    29913670                   f(k,j,i) = logratio * f(k1,j,i)
    29923671                   k  = k + 1
    29933672                ENDDO
    2994                 f(kb(j,i),j,i) = 0.0_wp
     3673                f(k_wall,j,i) = 0.0_wp
    29953674             ENDDO
    29963675          ENDDO
    … …  
    30003679          DO  i = ib, nxr
    30013680              DO  j = jb, nyn
    3002                 f(kb(j,i),j,i) = 0.0_wp
    3003              ENDDO
    3004           ENDDO
     3681!
     3682!--              Determine vertical index of topography top at grid point (j,i)
     3683                 k_wall = MAXLOC(                                              &
     3684                      MERGE( 1, 0,                                             &
     3685                             BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )  &
     3686                           ), DIM = 1                                          &
     3687                                ) - 1
     3688
     3689                 f(k_wall,j,i) = 0.0_wp
     3690              ENDDO
     3691           ENDDO
    30053692
    30063693       ENDIF
    … …  
    31373824       innor = dy
    31383825       DO   j = nys, nyn
    3139           DO   k = nzb_u_inner(j,i)+1, nzt
    3140              volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)
     3826          DO   k = nzb+1, nzt
     3827             volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)   &
     3828                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     3829                                              BTEST( wall_flags_0(k,j,i), 1 ) )
    31413830          ENDDO
    31423831       ENDDO
    … …  
    31473836       innor = -dy
    31483837       DO   j = nys, nyn
    3149           DO   k = nzb_u_inner(j,i)+1, nzt
    3150              volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)
     3838          DO   k = nzb+1, nzt
     3839             volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)   &
     3840                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     3841                                              BTEST( wall_flags_0(k,j,i), 1 ) )
    31513842          ENDDO
    31523843       ENDDO
    … …  
    31703861       innor = dx
    31713862       DO   i = nxl, nxr
    3172           DO   k = nzb_v_inner(j,i)+1, nzt
    3173              volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)
     3863          DO   k = nzb+1, nzt
     3864             volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)   &
     3865                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     3866                                              BTEST( wall_flags_0(k,j,i), 2 ) )
    31743867          ENDDO
    31753868       ENDDO
    … …  
    31803873       innor = -dx
    31813874       DO   i = nxl, nxr
    3182           DO   k = nzb_v_inner(j,i)+1, nzt
    3183              volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)
     3875          DO   k = nzb+1, nzt
     3876             volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)   &
     3877                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     3878                                              BTEST( wall_flags_0(k,j,i), 2 ) )
    31843879          ENDDO
    31853880       ENDDO
    … …  
    33404035    INTEGER(iwp) ::  child_id    !:
    33414036    INTEGER(iwp) ::  i           !:
     4037    INTEGER(iwp) ::  ierr        !:
    33424038    INTEGER(iwp) ::  j           !:
    3343     INTEGER(iwp) ::  ierr        !:
     4039    INTEGER(iwp) ::  k           !:
    33444040    INTEGER(iwp) ::  m           !:
    33454041
    … …  
    33744070             DO   i = nxlg, nxrg
    33754071                DO   j = nysg, nyng
    3376                    u(nzb:nzb_u_inner(j,i),j,i)  = 0.0_wp
    3377                    v(nzb:nzb_v_inner(j,i),j,i)  = 0.0_wp
    3378                    w(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
    3379                    e(nzb:nzb_s_inner(j,i),j,i)  = 0.0_wp
     4072                   DO  k = nzb, nzt+1
     4073                      u(k,j,i)  = MERGE( u(k,j,i), 0.0_wp,                     &
     4074                                         BTEST( wall_flags_0(k,j,i), 1 ) )
     4075                      v(k,j,i)  = MERGE( v(k,j,i), 0.0_wp,                     &
     4076                                         BTEST( wall_flags_0(k,j,i), 2 ) )
     4077                      w(k,j,i)  = MERGE( w(k,j,i), 0.0_wp,                     &
     4078                                         BTEST( wall_flags_0(k,j,i), 3 ) )
     4079                      e(k,j,i)  = MERGE( e(k,j,i), 0.0_wp,                     &
     4080                                         BTEST( wall_flags_0(k,j,i), 0 ) )
    33804081!
    33814082!--                TO_DO: zero setting of temperature within topography creates
    … …  
    33854086!                      q(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp
    33864087!                   ENDIF
     4088                   ENDDO
    33874089                ENDDO
    33884090             ENDDO
    … …  
    34634165          IF ( nest_bound_l )  THEN
    34644166             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    3465                                        r1yo, r2yo, r1zo, r2zo, nzb_u_inner,     &
     4167                                       r1yo, r2yo, r1zo, r2zo,                  &
    34664168                                       logc_u_l, logc_ratio_u_l,                &
    34674169                                       nzt_topo_nestbc_l, 'l', 'u' )
    34684170
    34694171             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
    3470                                        r1yv, r2yv, r1zo, r2zo, nzb_v_inner,     &
     4172                                       r1yv, r2yv, r1zo, r2zo,                  &
    34714173                                       logc_v_l, logc_ratio_v_l,                &
    34724174                                       nzt_topo_nestbc_l, 'l', 'v' )
    34734175
    34744176             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
    3475                                        r1yo, r2yo, r1zw, r2zw, nzb_w_inner,     &
     4177                                       r1yo, r2yo, r1zw, r2zw,                  &
    34764178                                       logc_w_l, logc_ratio_w_l,                &
    34774179                                       nzt_topo_nestbc_l, 'l', 'w' )
    34784180
    34794181             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
    3480                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,     &
     4182                                       r1yo, r2yo, r1zo, r2zo,                  &
    34814183                                       logc_u_l, logc_ratio_u_l,                &
    34824184                                       nzt_topo_nestbc_l, 'l', 'e' )
    … …  
    34844186             IF ( .NOT. neutral )  THEN
    34854187                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
    3486                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     4188                                          r1yo, r2yo, r1zo, r2zo,               &
    34874189                                          logc_u_l, logc_ratio_u_l,             &
    34884190                                          nzt_topo_nestbc_l, 'l', 's' )
    … …  
    34924194
    34934195                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,    &
    3494                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     4196                                          r1yo, r2yo, r1zo, r2zo,               &
    34954197                                          logc_u_l, logc_ratio_u_l,             &
    34964198                                          nzt_topo_nestbc_l, 'l', 's' )
    … …  
    35004202!                    CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, r2xo,&
    35014203!                                              r1yo, r2yo, r1zo, r2zo,            &
    3502 !                                              nzb_s_inner, logc_u_l,             &
     4204!                                              logc_u_l,                          &
    35034205!                                              logc_ratio_u_l, nzt_topo_nestbc_l, &
    35044206!                                              'l', 's' ) 
    … …  
    35064208                   CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, r2xo,&
    35074209                                             r1yo, r2yo, r1zo, r2zo,            &
    3508                                              nzb_s_inner, logc_u_l,             &
     4210                                             logc_u_l,                          &
    35094211                                             logc_ratio_u_l, nzt_topo_nestbc_l, &
    35104212                                             'l', 's' )
    … …  
    35124214!                    CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, r2xo,&
    35134215!                                              r1yo, r2yo, r1zo, r2zo,            &
    3514 !                                              nzb_s_inner, logc_u_l,             &
     4216!                                              logc_u_l,                          &
    35154217!                                              logc_ratio_u_l, nzt_topo_nestbc_l, &
    35164218!                                              'l', 's' )
    … …  
    35184220                   CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, r2xo,&
    35194221                                             r1yo, r2yo, r1zo, r2zo,            &
    3520                                              nzb_s_inner, logc_u_l,             &
     4222                                             logc_u_l,                          &
    35214223                                             logc_ratio_u_l, nzt_topo_nestbc_l, &
    35224224                                             'l', 's' )             
    … …  
    35274229             IF ( passive_scalar )  THEN
    35284230                CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo,     &
    3529                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     4231                                          r1yo, r2yo, r1zo, r2zo,               &
    35304232                                          logc_u_l, logc_ratio_u_l,             &
    35314233                                          nzt_topo_nestbc_l, 'l', 's' )
    … …  
    35334235
    35344236             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    3535 
    3536                 CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'l', 'u' )
    3537                 CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'l', 'v' )
    3538                 CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'l', 'w' )
    3539                 CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'l', 'e' )
     4237                CALL pmci_extrap_ifoutflow_lr( u, 'l', 'u' )
     4238                CALL pmci_extrap_ifoutflow_lr( v, 'l', 'v' )
     4239                CALL pmci_extrap_ifoutflow_lr( w, 'l', 'w' )
     4240                CALL pmci_extrap_ifoutflow_lr( e, 'l', 'e' )
    35404241
    35414242                IF ( .NOT. neutral )  THEN
    3542                    CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'l', 's' )
     4243                   CALL pmci_extrap_ifoutflow_lr( pt, 'l', 's' )
    35434244                ENDIF
    35444245
    35454246                IF ( humidity )  THEN
    3546 
    3547                    CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'l', 's' )
     4247                   CALL pmci_extrap_ifoutflow_lr( q, 'l', 's' )
    35484248
    35494249                   IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    35504250
    3551 !                       CALL pmci_extrap_ifoutflow_lr( qc, nzb_s_inner, 'l', 's' )
    3552                       CALL pmci_extrap_ifoutflow_lr( qr, nzb_s_inner, 'l', 's' )
    3553 !                      CALL pmci_extrap_ifoutflow_lr( nc, nzb_s_inner, 'l', 's' )
    3554                       CALL pmci_extrap_ifoutflow_lr( nr, nzb_s_inner, 'l', 's' )
     4251!                       CALL pmci_extrap_ifoutflow_lr( qc, 'l', 's' )
     4252                      CALL pmci_extrap_ifoutflow_lr( qr, 'l', 's' )
     4253!                      CALL pmci_extrap_ifoutflow_lr( nc, 'l', 's' )
     4254                      CALL pmci_extrap_ifoutflow_lr( nr, 'l', 's' )
    35554255
    35564256                   ENDIF
    … …  
    35594259
    35604260                IF ( passive_scalar )  THEN
    3561                    CALL pmci_extrap_ifoutflow_lr( s, nzb_s_inner, 'l', 's' )
     4261                   CALL pmci_extrap_ifoutflow_lr( s, 'l', 's' )
    35624262                ENDIF
    35634263
    … …  
    35694269   !--    Right border pe
    35704270          IF ( nest_bound_r )  THEN
    3571 
    3572              CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    3573                                        r1yo, r2yo, r1zo, r2zo, nzb_u_inner,    &
    3574                                        logc_u_r, logc_ratio_u_r,               &
     4271             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     4272                                       r1yo, r2yo, r1zo, r2zo,                  &
     4273                                       logc_u_r, logc_ratio_u_r,                &
    35754274                                       nzt_topo_nestbc_r, 'r', 'u' )
    35764275
    3577              CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    3578                                        r1yv, r2yv, r1zo, r2zo, nzb_v_inner,    &
    3579                                        logc_v_r, logc_ratio_v_r,               &
     4276             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     4277                                       r1yv, r2yv, r1zo, r2zo,                  &
     4278                                       logc_v_r, logc_ratio_v_r,                &
    35804279                                       nzt_topo_nestbc_r, 'r', 'v' )
    35814280
    3582              CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    3583                                        r1yo, r2yo, r1zw, r2zw, nzb_w_inner,    &
    3584                                        logc_w_r, logc_ratio_w_r,               &
     4281             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     4282                                       r1yo, r2yo, r1zw, r2zw,                  &
     4283                                       logc_w_r, logc_ratio_w_r,                &
    35854284                                       nzt_topo_nestbc_r, 'r', 'w' )
    35864285
    3587              CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
    3588                                        r1yo,r2yo, r1zo, r2zo, nzb_s_inner,     &
    3589                                        logc_u_r, logc_ratio_u_r,               &
     4286             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     4287                                       r1yo,r2yo, r1zo, r2zo,                   &
     4288                                       logc_u_r, logc_ratio_u_r,                &
    35904289                                       nzt_topo_nestbc_r, 'r', 'e' )
    35914290
     4291
    35924292             IF ( .NOT. neutral )  THEN
    3593                 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    3594                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
    3595                                           logc_u_r, logc_ratio_u_r,            &
     4293                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     4294                                          r1yo, r2yo, r1zo, r2zo,               &
     4295                                          logc_u_r, logc_ratio_u_r,             &
    35964296                                          nzt_topo_nestbc_r, 'r', 's' )
     4297
    35974298             ENDIF
    35984299
    35994300             IF ( humidity )  THEN
    3600 
    3601                 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    3602                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
    3603                                           logc_u_r, logc_ratio_u_r,            &
     4301                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,    &
     4302                                          r1yo, r2yo, r1zo, r2zo,               &
     4303                                          logc_u_r, logc_ratio_u_r,             &
    36044304                                          nzt_topo_nestbc_r, 'r', 's' )
     4305
    36054306
    36064307                IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    … …  
    36084309!                    CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo,     &
    36094310!                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3610 !                                              nzb_s_inner, logc_u_r,            &
     4311!                                              logc_u_r,                         &
    36114312!                                              logc_ratio_u_r, nzt_topo_nestbc_r,&
    36124313!                                              'r', 's' )
    … …  
    36144315                   CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo,     &
    36154316                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3616                                              nzb_s_inner, logc_u_r,            &
     4317                                             logc_u_r,                         &
    36174318                                             logc_ratio_u_r, nzt_topo_nestbc_r,&
    36184319                                             'r', 's' )
    … …  
    36204321!                    CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo,     &
    36214322!                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3622 !                                              nzb_s_inner, logc_u_r,            &
     4323!                                              logc_u_r,                         &
    36234324!                                              logc_ratio_u_r, nzt_topo_nestbc_r,&
    36244325!                                              'r', 's' )
    … …  
    36264327                   CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo,     &
    36274328                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3628                                              nzb_s_inner, logc_u_r,            &
     4329                                             logc_u_r,                         &
    36294330                                             logc_ratio_u_r, nzt_topo_nestbc_r,&
    36304331                                             'r', 's' )
    … …  
    36364337             IF ( passive_scalar )  THEN
    36374338                CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
    3638                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
     4339                                          r1yo, r2yo, r1zo, r2zo,             &
    36394340                                          logc_u_r, logc_ratio_u_r,            &
    36404341                                          nzt_topo_nestbc_r, 'r', 's' )
     4342
    36414343             ENDIF
    36424344
    36434345             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    3644 
    3645                 CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'r', 'u' )
    3646                 CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'r', 'v' )
    3647                 CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'r', 'w' )
    3648                 CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'r', 'e' )
     4346                CALL pmci_extrap_ifoutflow_lr( u, 'r', 'u' )
     4347                CALL pmci_extrap_ifoutflow_lr( v, 'r', 'v' )
     4348                CALL pmci_extrap_ifoutflow_lr( w, 'r', 'w' )
     4349                CALL pmci_extrap_ifoutflow_lr( e, 'r', 'e' )
    36494350
    36504351                IF ( .NOT. neutral )  THEN
    3651                    CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'r', 's' )
     4352                   CALL pmci_extrap_ifoutflow_lr( pt, 'r', 's' )
    36524353                ENDIF
    36534354
    36544355                IF ( humidity )  THEN
    3655 
    3656                    CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'r', 's' )
     4356                   CALL pmci_extrap_ifoutflow_lr( q, 'r', 's' )
    36574357
    36584358                   IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    3659 !                       CALL pmci_extrap_ifoutflow_lr( qc, nzb_s_inner, 'r', 's' )
    3660                       CALL pmci_extrap_ifoutflow_lr( qr, nzb_s_inner, 'r', 's' )
    3661 !                      CALL pmci_extrap_ifoutflow_lr( nc, nzb_s_inner, 'r', 's' ) 
    3662                       CALL pmci_extrap_ifoutflow_lr( nr, nzb_s_inner, 'r', 's' )
     4359!                       CALL pmci_extrap_ifoutflow_lr( qc, 'r', 's' )
     4360                      CALL pmci_extrap_ifoutflow_lr( qr, 'r', 's' )
     4361!                      CALL pmci_extrap_ifoutflow_lr( nc, 'r', 's' ) 
     4362                      CALL pmci_extrap_ifoutflow_lr( nr, 'r', 's' )
    36634363                   ENDIF
    36644364
    … …  
    36664366
    36674367                IF ( passive_scalar )  THEN
    3668                    CALL pmci_extrap_ifoutflow_lr( s, nzb_s_inner, 'r', 's' )
     4368                   CALL pmci_extrap_ifoutflow_lr( s, 'r', 's' )
    36694369                ENDIF
    36704370             ENDIF
    … …  
    36754375   !--    South border pe
    36764376          IF ( nest_bound_s )  THEN
    3677              CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    3678                                        r1yo, r2yo, r1zo, r2zo, nzb_u_inner,    &
    3679                                        logc_u_s, logc_ratio_u_s,               &
     4377             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     4378                                       r1yo, r2yo, r1zo, r2zo,                  &
     4379                                       logc_u_s, logc_ratio_u_s,                &
    36804380                                       nzt_topo_nestbc_s, 's', 'u' )
    3681 
    3682              CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    3683                                        r1yv, r2yv, r1zo, r2zo, nzb_v_inner,    &
    3684                                        logc_v_s, logc_ratio_v_s,               &
     4381             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     4382                                       r1yv, r2yv, r1zo, r2zo,                  &
     4383                                       logc_v_s, logc_ratio_v_s,                &
    36854384                                       nzt_topo_nestbc_s, 's', 'v' )
    3686 
    3687              CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    3688                                        r1yo, r2yo, r1zw, r2zw, nzb_w_inner,    &
    3689                                        logc_w_s, logc_ratio_w_s,               &
     4385             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     4386                                       r1yo, r2yo, r1zw, r2zw,                  &
     4387                                       logc_w_s, logc_ratio_w_s,                &
    36904388                                       nzt_topo_nestbc_s, 's','w' )
    3691 
    3692              CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
    3693                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,    &
    3694                                        logc_u_s, logc_ratio_u_s,               &
     4389             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     4390                                       r1yo, r2yo, r1zo, r2zo,                  &
     4391                                       logc_u_s, logc_ratio_u_s,                &
    36954392                                       nzt_topo_nestbc_s, 's', 'e' )
    36964393
    36974394             IF ( .NOT. neutral )  THEN
    3698                 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    3699                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
    3700                                           logc_u_s, logc_ratio_u_s,            &
     4395                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     4396                                          r1yo, r2yo, r1zo, r2zo,               &
     4397                                          logc_u_s, logc_ratio_u_s,             &
    37014398                                          nzt_topo_nestbc_s, 's', 's' )
    37024399             ENDIF
    37034400
    37044401             IF ( humidity )  THEN
    3705 
    3706                 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    3707                                           r1yo,r2yo, r1zo, r2zo, nzb_s_inner,  &
    3708                                           logc_u_s, logc_ratio_u_s,            &
     4402                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,    &
     4403                                          r1yo,r2yo, r1zo, r2zo,                &
     4404                                          logc_u_s, logc_ratio_u_s,             &
    37094405                                          nzt_topo_nestbc_s, 's', 's' )
    37104406
    … …  
    37134409!                    CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo,     &
    37144410!                                              r2xo, r1yo,r2yo, r1zo, r2zo,      &
    3715 !                                              nzb_s_inner, logc_u_s,            &
     4411!                                              logc_u_s,                         &
    37164412!                                              logc_ratio_u_s, nzt_topo_nestbc_s,&
    37174413!                                              's', 's' )
    … …  
    37194415                   CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo,     &
    37204416                                             r2xo, r1yo,r2yo, r1zo, r2zo,      &
    3721                                              nzb_s_inner, logc_u_s,            &
     4417                                             logc_u_s,                         &
    37224418                                             logc_ratio_u_s, nzt_topo_nestbc_s,&
    37234419                                             's', 's' )
    … …  
    37254421!                    CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo,     &
    37264422!                                              r2xo, r1yo,r2yo, r1zo, r2zo,      &
    3727 !                                              nzb_s_inner, logc_u_s,            &
     4423!                                              logc_u_s,                         &
    37284424!                                              logc_ratio_u_s, nzt_topo_nestbc_s,&
    37294425!                                              's', 's' )
    … …  
    37314427                   CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo,     &
    37324428                                             r2xo, r1yo,r2yo, r1zo, r2zo,      &
    3733                                              nzb_s_inner, logc_u_s,            &
     4429                                             logc_u_s,                         &
    37344430                                             logc_ratio_u_s, nzt_topo_nestbc_s,&
    37354431                                             's', 's' )
    … …  
    37404436
    37414437             IF ( passive_scalar )  THEN
    3742                 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
    3743                                           r1yo,r2yo, r1zo, r2zo, nzb_s_inner,  &
    3744                                           logc_u_s, logc_ratio_u_s,            &
     4438                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,     &
     4439                                          r1yo,r2yo, r1zo, r2zo,                &
     4440                                          logc_u_s, logc_ratio_u_s,             &
    37454441                                          nzt_topo_nestbc_s, 's', 's' )
    37464442             ENDIF
    37474443
    37484444             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    3749 
    3750                 CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 's', 'u' )
    3751                 CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 's', 'v' )
    3752                 CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 's', 'w' )
    3753                 CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 's', 'e' )
     4445                CALL pmci_extrap_ifoutflow_sn( u, 's', 'u' )
     4446                CALL pmci_extrap_ifoutflow_sn( v, 's', 'v' )
     4447                CALL pmci_extrap_ifoutflow_sn( w, 's', 'w' )
     4448                CALL pmci_extrap_ifoutflow_sn( e, 's', 'e' )
    37544449
    37554450                IF ( .NOT. neutral )  THEN
    3756                    CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 's', 's' )
     4451                   CALL pmci_extrap_ifoutflow_sn( pt, 's', 's' )
    37574452                ENDIF
    37584453
    37594454                IF ( humidity )  THEN
    3760 
    3761                    CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 's', 's' )
     4455                   CALL pmci_extrap_ifoutflow_sn( q,  's', 's' )
    37624456
    37634457                   IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    3764 !                       CALL pmci_extrap_ifoutflow_sn( qc, nzb_s_inner, 's', 's' )
    3765                       CALL pmci_extrap_ifoutflow_sn( qr, nzb_s_inner, 's', 's' )     
    3766 !                       CALL pmci_extrap_ifoutflow_sn( nc, nzb_s_inner, 's', 's' )
    3767                       CALL pmci_extrap_ifoutflow_sn( nr, nzb_s_inner, 's', 's' )
     4458!                       CALL pmci_extrap_ifoutflow_sn( qc, 's', 's' )
     4459                      CALL pmci_extrap_ifoutflow_sn( qr, 's', 's' )     
     4460!                       CALL pmci_extrap_ifoutflow_sn( nc, 's', 's' )
     4461                      CALL pmci_extrap_ifoutflow_sn( nr, 's', 's' )
    37684462
    37694463                   ENDIF
    … …  
    37724466
    37734467                IF ( passive_scalar )  THEN
    3774                    CALL pmci_extrap_ifoutflow_sn( s, nzb_s_inner, 's', 's' )
     4468                   CALL pmci_extrap_ifoutflow_sn( s, 's', 's' )
    37754469                ENDIF
    37764470
    … …  
    37824476   !--    North border pe
    37834477          IF ( nest_bound_n )  THEN
    3784 
    3785              CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    3786                                        r1yo, r2yo, r1zo, r2zo, nzb_u_inner,    &
    3787                                        logc_u_n, logc_ratio_u_n,               &
     4478             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     4479                                       r1yo, r2yo, r1zo, r2zo,                  &
     4480                                       logc_u_n, logc_ratio_u_n,                &
    37884481                                       nzt_topo_nestbc_n, 'n', 'u' )
    3789              CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    3790                                        r1yv, r2yv, r1zo, r2zo, nzb_v_inner,    &
    3791                                        logc_v_n, logc_ratio_v_n,               &
     4482
     4483             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     4484                                       r1yv, r2yv, r1zo, r2zo,                  &
     4485                                       logc_v_n, logc_ratio_v_n,                &
    37924486                                       nzt_topo_nestbc_n, 'n', 'v' )
    3793              CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    3794                                        r1yo, r2yo, r1zw, r2zw, nzb_w_inner,    &
    3795                                        logc_w_n, logc_ratio_w_n,               &
     4487
     4488             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     4489                                       r1yo, r2yo, r1zw, r2zw,                  &
     4490                                       logc_w_n, logc_ratio_w_n,                &
    37964491                                       nzt_topo_nestbc_n, 'n', 'w' )
    3797              CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
    3798                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,    &
    3799                                        logc_u_n, logc_ratio_u_n,               &
     4492
     4493             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     4494                                       r1yo, r2yo, r1zo, r2zo,                  &
     4495                                       logc_u_n, logc_ratio_u_n,                &
    38004496                                       nzt_topo_nestbc_n, 'n', 'e' )
    38014497
    38024498             IF ( .NOT. neutral )  THEN
    3803                 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    3804                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
    3805                                           logc_u_n, logc_ratio_u_n,            &
     4499                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     4500                                          r1yo, r2yo, r1zo, r2zo,               &
     4501                                          logc_u_n, logc_ratio_u_n,             &
    38064502                                          nzt_topo_nestbc_n, 'n', 's' )
    38074503             ENDIF
    38084504
    38094505             IF ( humidity )  THEN
    3810 
    3811                 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    3812                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
    3813                                           logc_u_n, logc_ratio_u_n,            &
     4506                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,    &
     4507                                          r1yo, r2yo, r1zo, r2zo,               &
     4508                                          logc_u_n, logc_ratio_u_n,             &
    38144509                                          nzt_topo_nestbc_n, 'n', 's' )
    38154510
    … …  
    38184513!                    CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo,     &
    38194514!                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3820 !                                              nzb_s_inner, logc_u_n,            &
     4515!                                              logc_u_n,                         &
    38214516!                                              logc_ratio_u_n, nzt_topo_nestbc_n,&
    38224517!                                              'n', 's' )
    … …  
    38244519                   CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo,     &
    38254520                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3826                                              nzb_s_inner, logc_u_n,            &
     4521                                             logc_u_n,                         &
    38274522                                             logc_ratio_u_n, nzt_topo_nestbc_n,&
    38284523                                             'n', 's' )
    … …  
    38304525!                    CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo,     &
    38314526!                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3832 !                                              nzb_s_inner, logc_u_n,            &
     4527!                                              logc_u_n,                         &
    38334528!                                              logc_ratio_u_n, nzt_topo_nestbc_n,&
    38344529!                                              'n', 's' )
    … …  
    38364531                   CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo,     &
    38374532                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
    3838                                              nzb_s_inner, logc_u_n,            &
     4533                                             logc_u_n,                         &
    38394534                                             logc_ratio_u_n, nzt_topo_nestbc_n,&
    38404535                                             'n', 's' )
    … …  
    38454540
    38464541             IF ( passive_scalar )  THEN
    3847                 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
    3848                                           r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &
    3849                                           logc_u_n, logc_ratio_u_n,            &
     4542                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,     &
     4543                                          r1yo, r2yo, r1zo, r2zo,               &
     4544                                          logc_u_n, logc_ratio_u_n,             &
    38504545                                          nzt_topo_nestbc_n, 'n', 's' )
    38514546             ENDIF
    38524547
    38534548             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    3854 
    3855                 CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 'n', 'u' )
    3856                 CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 'n', 'v' )
    3857                 CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 'n', 'w' )
    3858                 CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 'n', 'e' )
     4549                CALL pmci_extrap_ifoutflow_sn( u, 'n', 'u' )
     4550                CALL pmci_extrap_ifoutflow_sn( v, 'n', 'v' )
     4551                CALL pmci_extrap_ifoutflow_sn( w, 'n', 'w' )
     4552                CALL pmci_extrap_ifoutflow_sn( e, 'n', 'e' )
    38594553
    38604554                IF ( .NOT. neutral )  THEN
    3861                    CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 'n', 's' )
     4555                   CALL pmci_extrap_ifoutflow_sn( pt, 'n', 's' )
    38624556                ENDIF
    38634557
    38644558                IF ( humidity )  THEN
    3865 
    3866                    CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 'n', 's' )
     4559                   CALL pmci_extrap_ifoutflow_sn( q,  'n', 's' )
    38674560
    38684561                   IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    3869 !                       CALL pmci_extrap_ifoutflow_sn( qc, nzb_s_inner, 'n', 's' )
    3870                       CALL pmci_extrap_ifoutflow_sn( qr, nzb_s_inner, 'n', 's' )
    3871 !                       CALL pmci_extrap_ifoutflow_sn( nc, nzb_s_inner, 'n', 's' )
    3872                       CALL pmci_extrap_ifoutflow_sn( nr, nzb_s_inner, 'n', 's' )
     4562!                       CALL pmci_extrap_ifoutflow_sn( qc, 'n', 's' )
     4563                      CALL pmci_extrap_ifoutflow_sn( qr, 'n', 's' )
     4564!                       CALL pmci_extrap_ifoutflow_sn( nc, 'n', 's' )
     4565                      CALL pmci_extrap_ifoutflow_sn( nr, 'n', 's' )
    38734566                   ENDIF
    38744567
    … …  
    38764569
    38774570                IF ( passive_scalar )  THEN
    3878                    CALL pmci_extrap_ifoutflow_sn( s, nzb_s_inner, 'n', 's' )
     4571                   CALL pmci_extrap_ifoutflow_sn( s, 'n', 's' )
    38794572                ENDIF
    38804573
    … …  
    38834576          ENDIF
    38844577
    3885        ENDIF       !: IF ( nesting_mode /= 'vertical' )
     4578       ENDIF       ! IF ( nesting_mode /= 'vertical' )
    38864579
    38874580!
    … …  
    40164709
    40174710   SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
    4018                                    r2z, kb, logc, logc_ratio, nzt_topo_nestbc,  &
     4711                                   r2z, logc, logc_ratio, nzt_topo_nestbc,      &
    40194712                                   edge, var )
    40204713!
    … …  
    40404733      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic     !:
    40414734      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc     !:
    4042       INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb     !:
    40434735      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !:
    40444736      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                 &
    … …  
    40494741      CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    40504742
    4051       INTEGER(iwp) ::  i       !:
    4052       INTEGER(iwp) ::  ib      !:
    4053       INTEGER(iwp) ::  ibgp    !:
    4054       INTEGER(iwp) ::  iw      !:
    4055       INTEGER(iwp) ::  j       !:
    4056       INTEGER(iwp) ::  jco     !:
    4057       INTEGER(iwp) ::  jcorr   !:
    4058       INTEGER(iwp) ::  jinc    !:
    4059       INTEGER(iwp) ::  jw      !:
    4060       INTEGER(iwp) ::  j1      !:
    4061       INTEGER(iwp) ::  k       !:
    4062       INTEGER(iwp) ::  kco     !:
    4063       INTEGER(iwp) ::  kcorr   !:
    4064       INTEGER(iwp) ::  k1      !:
    4065       INTEGER(iwp) ::  l       !:
    4066       INTEGER(iwp) ::  m       !:
    4067       INTEGER(iwp) ::  n       !:
    4068       INTEGER(iwp) ::  kbc     !:
     4743      INTEGER(iwp) ::  flag_nr  !: Number of flag array to mask topography on respective u/v/w or s grid
     4744      INTEGER(iwp) ::  flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid
     4745      INTEGER(iwp) ::  i        !:
     4746      INTEGER(iwp) ::  ib       !:
     4747      INTEGER(iwp) ::  ibgp     !:
     4748      INTEGER(iwp) ::  iw       !:
     4749      INTEGER(iwp) ::  j        !:
     4750      INTEGER(iwp) ::  jco      !:
     4751      INTEGER(iwp) ::  jcorr    !:
     4752      INTEGER(iwp) ::  jinc     !:
     4753      INTEGER(iwp) ::  jw       !:
     4754      INTEGER(iwp) ::  j1       !:
     4755      INTEGER(iwp) ::  k        !:
     4756      INTEGER(iwp) ::  k_wall   !: vertical index of topography top
     4757      INTEGER(iwp) ::  kco      !:
     4758      INTEGER(iwp) ::  kcorr    !:
     4759      INTEGER(iwp) ::  k1       !:
     4760      INTEGER(iwp) ::  l        !:
     4761      INTEGER(iwp) ::  m        !:
     4762      INTEGER(iwp) ::  n        !:
     4763      INTEGER(iwp) ::  kbc      !:
    40694764     
    40704765      REAL(wp) ::  coarse_dx   !:
    … …  
    40944789         ib = nxr + 2
    40954790      ENDIF
     4791!
     4792!--    Determine number of flag array to be used to mask topography
     4793       IF ( var == 'u' )  THEN
     4794          flag_nr  = 1
     4795          flag_nr2 = 14
     4796       ELSEIF ( var == 'v' )  THEN
     4797          flag_nr  = 2
     4798          flag_nr2 = 16
     4799       ELSEIF ( var == 'w' )  THEN
     4800          flag_nr  = 3
     4801          flag_nr2 = 18
     4802       ELSE
     4803          flag_nr  = 0
     4804          flag_nr2 = 12
     4805       ENDIF
    40964806     
    40974807      DO  j = nys, nyn+1
    4098          DO  k = kb(j,i), nzt+1
     4808         DO  k = nzb, nzt+1
    40994809            l = ic(i)
    41004810            m = jc(j)
    … …  
    41194829      IF ( var == 'u' .OR. var == 'v' )  THEN           
    41204830         DO  j = nys, nyn
    4121             k = kb(j,i)+1
     4831!
     4832!--         Determine vertical index of topography top at grid point (j,i)
     4833            k_wall = MAXLOC(                                                   &
     4834                        MERGE( 1, 0,                                           &
     4835                               BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )&
     4836                             ), DIM = 1                                        &
     4837                           ) - 1
     4838
     4839            k = k_wall+1
    41224840            IF ( ( logc(1,k,j) /= 0 )  .AND.  ( logc(2,k,j) == 0 ) )  THEN
    41234841               k1 = logc(1,k,j)
    … …  
    41414859!--         Solid surface only on south/north side of the node                   
    41424860            DO  j = nys, nyn
    4143                DO  k = kb(j,i)+1, nzt_topo_nestbc
     4861!
     4862!--            Determine vertical index of topography top at grid point (j,i)
     4863               k_wall = MAXLOC(                                                &
     4864                     MERGE( 1, 0,                                              &
     4865                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     4866                          ), DIM = 1                                           &
     4867                              ) - 1
     4868               DO  k = k_wall+1, nzt_topo_nestbc
    41444869                  IF ( ( logc(2,k,j) /= 0 )  .AND.  ( logc(1,k,j) == 0 ) )  THEN
    41454870!
    … …  
    41624887         IF ( var == 'u' )  THEN
    41634888            DO  j = nys, nyn
    4164                k = kb(j,i) + 1
     4889!
     4890!--            Determine vertical index of topography top at grid point (j,i)
     4891               k_wall = MAXLOC(                                                &
     4892                     MERGE( 1, 0,                                              &
     4893                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     4894                          ), DIM = 1                                           &
     4895                              ) - 1
     4896               k = k_wall + 1
    41654897               IF ( ( logc(2,k,j) /= 0 )  .AND.  ( logc(1,k,j) /= 0 ) )  THEN
    41664898                  k1   = logc(1,k,j)                 
    … …  
    41904922         IF ( edge == 'l' )  THEN
    41914923            DO  j = nys, nyn + 1
    4192                DO  k = kb(j,i), nzt + 1
     4924!
     4925!--            Determine vertical index of topography top at grid point (j,i)
     4926               k_wall = MAXLOC(                                                &
     4927                     MERGE( 1, 0,                                              &
     4928                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     4929                          ), DIM = 1                                           &
     4930                              ) - 1
     4931               DO  k = k_wall, nzt + 1
    41934932                  f(k,j,i) = tkefactor_l(k,j) * f(k,j,i)
    41944933               ENDDO
    … …  
    41964935         ELSEIF ( edge == 'r' )  THEN           
    41974936            DO  j = nys, nyn+1
    4198                DO  k = kb(j,i), nzt+1
     4937!
     4938!--            Determine vertical index of topography top at grid point (j,i)
     4939               k_wall = MAXLOC(                                                &
     4940                     MERGE( 1, 0,                                              &
     4941                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     4942                          ), DIM = 1                                           &
     4943                              ) - 1
     4944               DO  k = k_wall, nzt+1
    41994945                  f(k,j,i) = tkefactor_r(k,j) * f(k,j,i)
    42004946               ENDDO
    … …  
    42204966
    42214967   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
    4222                                    r2z, kb, logc, logc_ratio,                   &
     4968                                   r2z, logc, logc_ratio,                   &
    42234969                                   nzt_topo_nestbc, edge, var )
    42244970
    … …  
    42454991      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !:
    42464992      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !:
    4247       INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb    !:
    42484993      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
    42494994      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                 &
    … …  
    42544999      CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    42555000     
     5001      INTEGER(iwp) ::  flag_nr  !: Number of flag array to mask topography on respective u/v/w or s grid
     5002      INTEGER(iwp) ::  flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid
    42565003      INTEGER(iwp) ::  i       !:
    42575004      INTEGER(iwp) ::  iinc    !:
    … …  
    42635010      INTEGER(iwp) ::  jbgp    !:
    42645011      INTEGER(iwp) ::  k       !:
     5012      INTEGER(iwp) ::  k_wall   !: vertical index of topography top
    42655013      INTEGER(iwp) ::  kcorr   !:
    42665014      INTEGER(iwp) ::  kco     !:
    … …  
    42975045      ENDIF
    42985046
     5047!
     5048!--    Determine number of flag array to be used to mask topography
     5049       IF ( var == 'u' )  THEN
     5050          flag_nr  = 1
     5051          flag_nr2 = 14
     5052       ELSEIF ( var == 'v' )  THEN
     5053          flag_nr  = 2
     5054          flag_nr2 = 16
     5055       ELSEIF ( var == 'w' )  THEN
     5056          flag_nr  = 3
     5057          flag_nr2 = 18
     5058       ELSE
     5059          flag_nr  = 0
     5060          flag_nr2 = 12
     5061       ENDIF
     5062
    42995063      DO  i = nxl, nxr+1
    4300          DO  k = kb(j,i), nzt+1
     5064!
     5065!--      Determine vertical index of topography top at grid point (j,i)
     5066         k_wall = MAXLOC(                                                      &
     5067                        MERGE( 1, 0,                                           &
     5068                               BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )&
     5069                             ), DIM = 1                                        &
     5070                           ) - 1
     5071         DO  k = k_wall, nzt+1
    43015072            l = ic(i)
    43025073            m = jc(j)
    … …  
    43215092      IF ( var == 'u'  .OR.  var == 'v' )  THEN           
    43225093         DO  i = nxl, nxr
    4323             k = kb(j,i) + 1
     5094!
     5095!--         Determine vertical index of topography top at grid point (j,i)
     5096            k_wall = MAXLOC(                                                   &
     5097                        MERGE( 1, 0,                                           &
     5098                               BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )&
     5099                             ), DIM = 1                                        &
     5100                           ) - 1
     5101
     5102            k = k_wall + 1
    43245103            IF ( ( logc(1,k,i) /= 0 )  .AND.  ( logc(2,k,i) == 0 ) )  THEN
    43255104               k1 = logc(1,k,i)
    … …  
    43425121         IF ( var == 'v' .OR. var == 'w' )  THEN
    43435122            DO  i = nxl, nxr
    4344                DO  k = kb(j,i), nzt_topo_nestbc
     5123!
     5124!--            Determine vertical index of topography top at grid point (j,i)
     5125               k_wall = MAXLOC(                                                &
     5126                     MERGE( 1, 0,                                              &
     5127                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     5128                          ), DIM = 1                                           &
     5129                              ) - 1
     5130               DO  k = k_wall, nzt_topo_nestbc
    43455131!
    43465132!--               Solid surface only on left/right side of the node           
    … …  
    43655151         IF ( var == 'v' )  THEN
    43665152            DO  i = nxl, nxr
    4367                k = kb(j,i) + 1
     5153!
     5154!--            Determine vertical index of topography top at grid point (j,i)
     5155               k_wall = MAXLOC(                                                &
     5156                     MERGE( 1, 0,                                              &
     5157                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     5158                          ), DIM = 1                                           &
     5159                              ) - 1
     5160               k = k_wall + 1
    43685161               IF ( ( logc(2,k,i) /= 0 )  .AND.  ( logc(1,k,i) /= 0 ) )  THEN
    43695162                  k1   = logc(1,k,i)         
    … …  
    43935186         IF ( edge == 's' )  THEN
    43945187            DO  i = nxl, nxr + 1
    4395                DO  k = kb(j,i), nzt+1
     5188!
     5189!--            Determine vertical index of topography top at grid point (j,i)
     5190               k_wall = MAXLOC(                                                &
     5191                     MERGE( 1, 0,                                              &
     5192                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     5193                          ), DIM = 1                                           &
     5194                              ) - 1
     5195               DO  k = k_wall, nzt+1
    43965196                  f(k,j,i) = tkefactor_s(k,i) * f(k,j,i)
    43975197               ENDDO
    … …  
    43995199         ELSEIF ( edge == 'n' )  THEN
    44005200            DO  i = nxl, nxr + 1
    4401                DO  k = kb(j,i), nzt+1
     5201!
     5202!--            Determine vertical index of topography top at grid point (j,i)
     5203               k_wall = MAXLOC(                                                &
     5204                     MERGE( 1, 0,                                              &
     5205                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )   &
     5206                          ), DIM = 1                                           &
     5207                              ) - 1
     5208               DO  k = k_wall, nzt+1
    44025209                  f(k,j,i) = tkefactor_n(k,i) * f(k,j,i)
    44035210               ENDDO
    … …  
    45105317
    45115318
    4512     SUBROUTINE pmci_extrap_ifoutflow_lr( f, kb, edge, var )
     5319    SUBROUTINE pmci_extrap_ifoutflow_lr( f, edge, var )
    45135320!
    45145321!--    After the interpolation of ghost-node values for the child-domain
    … …  
    45245331       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    45255332
    4526        INTEGER(iwp) ::  i     !:
    4527        INTEGER(iwp) ::  ib    !:
    4528        INTEGER(iwp) ::  ibgp  !:
    4529        INTEGER(iwp) ::  ied   !:
    4530        INTEGER(iwp) ::  j     !:
    4531        INTEGER(iwp) ::  k     !:
    4532      
    4533        INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb   !:
     5333       INTEGER(iwp) ::  flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid
     5334       INTEGER(iwp) ::  i       !:
     5335       INTEGER(iwp) ::  ib      !:
     5336       INTEGER(iwp) ::  ibgp    !:
     5337       INTEGER(iwp) ::  ied     !:
     5338       INTEGER(iwp) ::  j       !:
     5339       INTEGER(iwp) ::  k       !:
     5340       INTEGER(iwp) ::  k_wall  !:
    45345341
    45355342       REAL(wp) ::  outnor    !:
    … …  
    45575364          outnor = 1.0_wp
    45585365       ENDIF
     5366!
     5367!--    Determine number of flag array to be used to mask topography
     5368       IF ( var == 'u' )  THEN
     5369          flag_nr  = 14
     5370       ELSEIF ( var == 'v' )  THEN
     5371          flag_nr  = 16
     5372       ELSEIF ( var == 'w' )  THEN
     5373          flag_nr  = 18
     5374       ELSE
     5375          flag_nr  = 12
     5376       ENDIF
    45595377
    45605378       DO  j = nys, nyn+1
    4561           DO  k = kb(j,i), nzt+1
     5379!
     5380!--       Determine vertical index of topography top at grid point (j,i)
     5381          k_wall = MAXLOC(                                                     &
     5382                     MERGE( 1, 0,                                              &
     5383                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr )    &
     5384                          ), DIM = 1                                           &
     5385                         ) - 1
     5386          DO  k = k_wall, nzt+1
    45625387             vdotnor = outnor * u(k,j,ied)
    45635388!
    … …  
    45685393          ENDDO
    45695394          IF ( (var == 'u' )  .OR.  (var == 'v' )  .OR.  (var == 'w') )  THEN
    4570              f(kb(j,i),j,i) = 0.0_wp
     5395             f(k_wall,j,i) = 0.0_wp
    45715396          ENDIF
    45725397       ENDDO
    … …  
    45885413
    45895414
    4590     SUBROUTINE pmci_extrap_ifoutflow_sn( f, kb, edge, var )
     5415    SUBROUTINE pmci_extrap_ifoutflow_sn( f, edge, var )
    45915416!
    45925417!--    After  the interpolation of ghost-node values for the child-domain
    … …  
    46015426       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    46025427     
     5428       INTEGER(iwp) ::  flag_nr   !: Number of flag array to mask topography on respective u/v/w or s grid
    46035429       INTEGER(iwp) ::  i         !:
    46045430       INTEGER(iwp) ::  j         !:
    … …  
    46075433       INTEGER(iwp) ::  jed       !:
    46085434       INTEGER(iwp) ::  k         !:
    4609 
    4610        INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb   !:
     5435       INTEGER(iwp) ::  k_wall    !:
    46115436
    46125437       REAL(wp)     ::  outnor    !:
    … …  
    46355460       ENDIF
    46365461
     5462!
     5463!--    Determine number of flag array to be used to mask topography
     5464       IF ( var == 'u' )  THEN
     5465          flag_nr  = 14
     5466       ELSEIF ( var == 'v' )  THEN
     5467          flag_nr  = 16
     5468       ELSEIF ( var == 'w' )  THEN
     5469          flag_nr  = 18
     5470       ELSE
     5471          flag_nr  = 12
     5472       ENDIF
     5473
    46375474       DO  i = nxl, nxr+1
    4638           DO  k = kb(j,i), nzt+1
     5475!
     5476!--       Determine vertical index of topography top at grid point (j,i)
     5477          k_wall = MAXLOC(                                                     &
     5478                     MERGE( 1, 0,                                              &
     5479                            BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr )    &
     5480                          ), DIM = 1                                           &
     5481                         ) - 1
     5482          DO  k = k_wall, nzt+1
    46395483             vdotnor = outnor * v(k,jed,i)
    46405484!
    … …  
    46455489          ENDDO
    46465490          IF ( (var == 'u' )  .OR.  (var == 'v' )  .OR.  (var == 'w') )  THEN
    4647              f(kb(j,i),j,i) = 0.0_wp
     5491             f(k_wall,j,i) = 0.0_wp
    46485492          ENDIF
    46495493       ENDDO

  • palm/trunk/SOURCE/poismg_mod.f90

    r2101 r2232  
    2626! $Id$
    2727!
    28 ! 2084 2016-12-09 15:59:42Z knoop
    29 ! Bugfix: missing rho_air_mg even/odd sorting implemented
    30 !
    3128! 2073 2016-11-30 14:34:05Z raasch
    3229! change of openmp directives in restrict
    … …  
    111108    REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE ::  f1_mg_b, f2_mg_b, f3_mg_b  !< blocked version of f1_mg ...
    112109
    113     REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE ::  rho_air_mg_b               !< blocked version of rho_air_mg
    114 
    115110    INTERFACE poismg
    116111       MODULE PROCEDURE poismg
    … …  
    320315                kp1 = k-ind_even_odd
    321316                r(k,j,i) = f_mg(k,j,i)                                         &
    322                       - rho_air_mg_b(k,l) * ddx2_mg(l) *                         &
     317                      - rho_air_mg(k,l) * ddx2_mg(l) *                         &
    323318                      ( p_mg(k,j,i+1) +  p_mg(k,j,i-1)  )                      &
    324                       - rho_air_mg_b(k,l) * ddy2_mg(l) *                         &
     319                      - rho_air_mg(k,l) * ddy2_mg(l) *                         &
    325320                      ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )                       &
    326321                      - f2_mg_b(k,l) * p_mg(kp1,j,i)                           &
    … …  
    333328                kp1 = k+ind_even_odd+1
    334329                r(k,j,i) = f_mg(k,j,i)                                         &
    335                       - rho_air_mg_b(k,l) * ddx2_mg(l) *                         &
     330                      - rho_air_mg(k,l) * ddx2_mg(l) *                         &
    336331                      ( p_mg(k,j,i+1) +  p_mg(k,j,i-1)  )                      &
    337                       - rho_air_mg_b(k,l) * ddy2_mg(l) *                         &
     332                      - rho_air_mg(k,l) * ddy2_mg(l) *                         &
    338333                      ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )                       &
    339334                      - f2_mg_b(k,l) * p_mg(kp1,j,i)                           &
    … …  
    766761                         kp1 = k-ind_even_odd
    767762                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    768                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     763                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    769764                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    770                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     765                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    771766                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    772767                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    785780                         kp1 = k-ind_even_odd
    786781                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    787                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     782                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    788783                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    789                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     784                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    790785                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    791786                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    804799                         kp1 = k+ind_even_odd+1
    805800                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    806                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     801                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    807802                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    808                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     803                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    809804                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    810805                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    823818                         kp1 = k+ind_even_odd+1
    824819                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    825                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     820                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    826821                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    827                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     822                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    828823                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    829824                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    854849                         j   = jj
    855850                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    856                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     851                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    857852                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    858                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     853                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    859854                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    860855                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    863858                         j = jj+2
    864859                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    865                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     860                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    866861                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    867                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     862                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    868863                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    869864                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    880875                         j   = jj
    881876                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    882                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     877                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    883878                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    884                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     879                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    885880                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    886881                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    889884                         j = jj+2
    890885                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    891                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     886                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    892887                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    893                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     888                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    894889                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    895890                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    906901                         j   = jj
    907902                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    908                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     903                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    909904                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    910                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     905                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    911906                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    912907                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    915910                         j = jj+2
    916911                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    917                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     912                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    918913                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    919                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     914                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    920915                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    921916                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    932927                         j   = jj
    933928                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    934                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     929                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    935930                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    936                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     931                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    937932                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    938933                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    941936                         j = jj+2
    942937                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
    943                                  rho_air_mg_b(k,l) * ddx2_mg(l) *                &
     938                                 rho_air_mg(k,l) * ddx2_mg(l) *                &
    944939                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    945                                + rho_air_mg_b(k,l) * ddy2_mg(l) *                &
     940                               + rho_air_mg(k,l) * ddy2_mg(l) *                &
    946941                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    947942                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    … …  
    17581753
    17591754       USE arrays_3d,                                                          &
    1760            ONLY:  f1_mg, f2_mg, f3_mg, rho_air_mg
     1755           ONLY:  f1_mg, f2_mg, f3_mg
    17611756
    17621757       USE control_parameters,                                                 &
    … …  
    17841779       ALLOCATE( f1_mg_b(nzb:nzt+1,maximum_grid_level),                        &
    17851780                 f2_mg_b(nzb:nzt+1,maximum_grid_level),                        &
    1786                  f3_mg_b(nzb:nzt+1,maximum_grid_level),                        &
    1787                  rho_air_mg_b(nzb:nzt+1,maximum_grid_level) )
     1781                 f3_mg_b(nzb:nzt+1,maximum_grid_level) )
    17881782
    17891783!
    … …  
    18061800                                          f3_mg_b(nzb:nzt_mg(grid_level)+1,l), &
    18071801                                          l )
    1808           CALL sort_k_to_even_odd_blocks( rho_air_mg(nzb+1:nzt_mg(grid_level),l),   &
    1809                                           rho_air_mg_b(nzb:nzt_mg(grid_level)+1,l), &
    1810                                           l )
    18111802       ENDDO
    18121803

  • palm/trunk/SOURCE/poismg_noopt.f90

    r2101 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Bugfixes OpenMP
    2323!
    2424! Former revisions:
    … …  
    495495    END SELECT
    496496   
    497 !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc)
     497!$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc, rkjim,rkjip,rkjpi,rkjmi,rkjmim,rkjpim, &
     498!$OMP rkjmip, rkjpip,rkmji,rkmjim,rkmjip,rkmjpi,rkmjmi,rkmjmim,rkmjpim,rkmjmip,&
     499!$OMP rkmjpip          )
    498500!$OMP DO
    499501    DO  ic = nxl_mg(l), nxr_mg(l)   

  • palm/trunk/SOURCE/pres.f90

    r2119 r2232  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Adjustments to new topography and surface concept
    2323!
    2424! Former revisions:
    … …  
    156156    USE indices,                                                               &
    157157        ONLY:  nbgp, ngp_2dh_outer, nx, nxl, nxlg, nxl_mg, nxr, nxrg, nxr_mg,  &
    158                ny, nys, nysg, nys_mg, nyn, nyng, nyn_mg, nzb, nzb_s_inner,     &
    159                nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt, nzt_mg,             &
    160                rflags_s_inner
     158               ny, nys, nysg, nys_mg, nyn, nyng, nyn_mg, nzb, nzt, nzt_mg,     &
     159               wall_flags_0
    161160
    162161    USE kinds
    … …  
    176175               weight_substep
    177176
     177    USE surface_mod,                                                           &
     178        ONLY :  bc_h
     179
    178180    IMPLICIT NONE
    179181
    … …  
    181183    INTEGER(iwp) ::  j              !<
    182184    INTEGER(iwp) ::  k              !<
     185    INTEGER(iwp) ::  m              !<
    183186
    184187    REAL(wp)     ::  ddt_3d         !<
    … …  
    269272!
    270273!--       Sum up the volume flow through the south/north boundary
    271           DO  k = nzb_u_inner(j,i)+1, nzt
    272              volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k)
     274          DO  k = nzb+1, nzt
     275             volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k)           &
     276                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     277                                              BTEST( wall_flags_0(k,j,i), 1 )  &
     278                                            )
    273279          ENDDO
    274280       ENDDO
    … …  
    285291
    286292       DO  j = nysg, nyng
    287           DO  k = nzb_u_inner(j,i)+1, nzt
    288              u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
     293          DO  k = nzb+1, nzt
     294             u(k,j,i) = u(k,j,i) + volume_flow_offset(1)                       &
     295                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     296                                              BTEST( wall_flags_0(k,j,i), 1 )  &
     297                                            )
    289298          ENDDO
    290299       ENDDO
    … …  
    308317!
    309318!--       Sum up the volume flow through the south/north boundary
    310           DO  k = nzb_v_inner(j,i)+1, nzt
    311              volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k)
     319          DO  k = nzb+1, nzt
     320             volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k)           &
     321                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     322                                              BTEST( wall_flags_0(k,j,i), 2 )  &
     323                                            )
    312324          ENDDO
    313325       ENDDO
    … …  
    324336
    325337       DO  i = nxlg, nxrg
    326           DO  k = nzb_v_inner(j,i)+1, nzt
    327              v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
     338          DO  k = nzb+1, nzt
     339             v(k,j,i) = v(k,j,i) + volume_flow_offset(2)                       &
     340                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     341                                              BTEST( wall_flags_0(k,j,i), 2 )  &
     342                                            )
    328343          ENDDO
    329344       ENDDO
    … …  
    350365       DO  i = nxl, nxr
    351366          DO  j = nys, nyn
    352              DO  k = nzb_w_inner(j,i)+1, nzt
    353                 w_l_l(k) = w_l_l(k) + w(k,j,i)
     367             DO  k = nzb+1, nzt
     368                w_l_l(k) = w_l_l(k) + w(k,j,i)                                 &
     369                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     370                                              BTEST( wall_flags_0(k,j,i), 3 )  &
     371                                            )
    354372             ENDDO
    355373          ENDDO
    … …  
    367385       DO  i = nxlg, nxrg
    368386          DO  j = nysg, nyng
    369              DO  k = nzb_w_inner(j,i)+1, nzt
    370                 w(k,j,i) = w(k,j,i) - w_l(k)
     387             DO  k = nzb+1, nzt
     388                w(k,j,i) = w(k,j,i) - w_l(k)                                   &
     389                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     390                                              BTEST( wall_flags_0(k,j,i), 3 )  &
     391                                            )
    371392             ENDDO
    372393          ENDDO
    … …  
    379400
    380401    IF ( psolver(1:9) == 'multigrid' )  THEN
    381        !$OMP PARALLEL DO SCHEDULE( STATIC )
     402       !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)
    382403       DO  i = nxl-1, nxr+1
    383404          DO  j = nys-1, nyn+1
    … …  
    388409       ENDDO
    389410    ELSE
    390        !$OMP PARALLEL DO SCHEDULE( STATIC )
     411       !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)
    391412       DO  i = nxl, nxr
    392413          DO  j = nys, nyn
    … …  
    406427    DO  i = nxl, nxr
    407428       DO  j = nys, nyn
    408           DO  k = nzb_s_inner(j,i)+1, nzt
     429          DO  k = nzb+1, nzt
    409430             d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx +       &
    410431                          ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy +       &
    411432                          ( w(k,j,i)   * rho_air_zw(k) -                       &
    412433                            w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k)           &
    413                         ) * ddt_3d * d_weight_pres
     434                        ) * ddt_3d * d_weight_pres                             &
     435                                   * MERGE( 1.0_wp, 0.0_wp,                    &
     436                                            BTEST( wall_flags_0(k,j,i), 0 )    &
     437                                          )
    414438          ENDDO
    415439!
    416440!--       Compute possible PE-sum of divergences for flow_statistics
    417           DO  k = nzb_s_inner(j,i)+1, nzt
    418              threadsum = threadsum + ABS( d(k,j,i) )
     441          DO  k = nzb+1, nzt
     442             threadsum = threadsum + ABS( d(k,j,i) )                           &
     443                                   * MERGE( 1.0_wp, 0.0_wp,                    &
     444                                            BTEST( wall_flags_0(k,j,i), 0 )    &
     445                                          )
    419446          ENDDO
    420447
    … …  
    438465                          ( w(k,j,i)   * rho_air_zw(k) -                       &
    439466                            w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k)           &
    440                         ) * ddt_3d * d_weight_pres * rflags_s_inner(k,j,i)
     467                        ) * ddt_3d * d_weight_pres                             &
     468                                   * MERGE( 1.0_wp, 0.0_wp,                    &
     469                                            BTEST( wall_flags_0(k,j,i), 0 )    &
     470                                          )     
    441471          ENDDO
    442472       ENDDO
    … …  
    484514!--    Store computed perturbation pressure and set boundary condition in
    485515!--    z-direction
    486        !$OMP PARALLEL DO
     516       !$OMP PARALLEL DO PRIVATE (i,j,k)
    487517       DO  i = nxl, nxr
    488518          DO  j = nys, nyn
    … …  
    499529       IF ( ibc_p_b == 1 )  THEN
    500530!
    501 !--       Neumann (dp/dz = 0)
    502           !$OMP PARALLEL DO
    503           DO  i = nxlg, nxrg
    504              DO  j = nysg, nyng
    505                 tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
    506              ENDDO
     531!--       Neumann (dp/dz = 0). Using surfae data type, first for non-natural
     532!--       surfaces, then for natural and urban surfaces
     533!--       Upward facing
     534          !$OMP PARALLEL DO PRIVATE( i, j, k )
     535          DO  m = 1, bc_h(0)%ns
     536             i             = bc_h(0)%i(m)           
     537             j             = bc_h(0)%j(m)
     538             k             = bc_h(0)%k(m)
     539             tend(k-1,j,i) = tend(k,j,i)
     540          ENDDO
     541!
     542!--       Downward facing
     543          !$OMP PARALLEL DO PRIVATE( i, j, k )
     544          DO  m = 1, bc_h(1)%ns
     545             i             = bc_h(1)%i(m)           
     546             j             = bc_h(1)%j(m)
     547             k             = bc_h(1)%k(m)
     548             tend(k+1,j,i) = tend(k,j,i)
    507549          ENDDO
    508550
    509551       ELSE
    510552!
    511 !--       Dirichlet
    512           !$OMP PARALLEL DO
    513           DO  i = nxlg, nxrg
    514              DO  j = nysg, nyng
    515                 tend(nzb_s_inner(j,i),j,i) = 0.0_wp
    516              ENDDO
     553!--       Dirichlet. Using surface data type, first for non-natural
     554!--       surfaces, then for natural and urban surfaces
     555!--       Upward facing
     556          !$OMP PARALLEL DO PRIVATE( i, j, k )
     557          DO  m = 1, bc_h(0)%ns
     558             i             = bc_h(0)%i(m)           
     559             j             = bc_h(0)%j(m)
     560             k             = bc_h(0)%k(m)
     561             tend(k-1,j,i) = 0.0_wp
     562          ENDDO
     563!
     564!--       Downward facing
     565          !$OMP PARALLEL DO PRIVATE( i, j, k )
     566          DO  m = 1, bc_h(1)%ns
     567             i             = bc_h(1)%i(m)           
     568             j             = bc_h(1)%j(m)
     569             k             = bc_h(1)%k(m)
     570             tend(k+1,j,i) = 0.0_wp
    517571          ENDDO
    518572
    … …  
    524578!
    525579!--       Neumann
    526           !$OMP PARALLEL DO
     580          !$OMP PARALLEL DO PRIVATE (i,j,k)
    527581          DO  i = nxlg, nxrg
    528582             DO  j = nysg, nyng
    … …  
    534588!
    535589!--       Dirichlet
    536           !$OMP PARALLEL DO
     590          !$OMP PARALLEL DO PRIVATE (i,j,k)
    537591          DO  i = nxlg, nxrg
    538592             DO  j = nysg, nyng
    … …  
    646700       DO  j = nys, nyn
    647701
    648           DO  k = 1, nzt
    649              IF ( k > nzb_w_inner(j,i) )  THEN
    650                 w(k,j,i) = w(k,j,i) - dt_3d *                                 &
    651                            ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1) *      &
    652                            weight_pres_l
    653              ENDIF
    654           ENDDO
    655 
    656           DO  k = 1, nzt
    657              IF ( k > nzb_u_inner(j,i) )  THEN
    658                 u(k,j,i) = u(k,j,i) - dt_3d *                                 &
    659                            ( tend(k,j,i) - tend(k,j,i-1) ) * ddx *            &
    660                            weight_pres_l
    661              ENDIF
    662           ENDDO
    663 
    664           DO  k = 1, nzt
    665              IF ( k > nzb_v_inner(j,i) )  THEN
    666                 v(k,j,i) = v(k,j,i) - dt_3d *                                 &
    667                            ( tend(k,j,i) - tend(k,j-1,i) ) * ddy *            &
    668                            weight_pres_l
    669              ENDIF
     702          DO  k = nzb+1, nzt
     703             w(k,j,i) = w(k,j,i) - dt_3d *                                     &
     704                           ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1)         &
     705                                     * weight_pres_l                           &
     706                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     707                                              BTEST( wall_flags_0(k,j,i), 3 )  &
     708                                            )
     709          ENDDO
     710
     711          DO  k = nzb+1, nzt
     712             u(k,j,i) = u(k,j,i) - dt_3d *                                     &
     713                           ( tend(k,j,i) - tend(k,j,i-1) ) * ddx               &
     714                                     * weight_pres_l                           &
     715                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     716                                              BTEST( wall_flags_0(k,j,i), 1 )  &
     717                                            )
     718          ENDDO
     719
     720          DO  k = nzb+1, nzt
     721             v(k,j,i) = v(k,j,i) - dt_3d *                                     &
     722                           ( tend(k,j,i) - tend(k,j-1,i) ) * ddy               &
     723                                     * weight_pres_l                           &
     724                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     725                                              BTEST( wall_flags_0(k,j,i), 2 )  &
     726                                            )
    670727          ENDDO                                                         
    671728
    … …  
    676733!
    677734!-- Sum up the volume flow through the right and north boundary
    678     IF ( conserve_volume_flow  .AND.  bc_lr_cyc  .AND.  bc_ns_cyc  .AND.  &
     735    IF ( conserve_volume_flow  .AND.  bc_lr_cyc  .AND.  bc_ns_cyc  .AND.       &
    679736         nxr == nx )  THEN
    680737
    … …  
    683740       DO  j = nys, nyn
    684741          !$OMP CRITICAL
    685           DO  k = nzb_u_inner(j,nx) + 1, nzt
    686              volume_flow_l(1) = volume_flow_l(1) + u(k,j,nx) * dzw(k)
     742          DO  k = nzb+1, nzt
     743             volume_flow_l(1) = volume_flow_l(1) + u(k,j,nxr) * dzw(k)         &
     744                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     745                                              BTEST( wall_flags_0(k,j,nxr), 1 )&
     746                                            )
    687747          ENDDO
    688748          !$OMP END CRITICAL
    … …  
    692752    ENDIF
    693753
    694     IF ( conserve_volume_flow  .AND.  bc_ns_cyc  .AND.  bc_lr_cyc  .AND.  &
     754    IF ( conserve_volume_flow  .AND.  bc_ns_cyc  .AND.  bc_lr_cyc  .AND.       &
    695755         nyn == ny )  THEN
    696756
    … …  
    699759       DO  i = nxl, nxr
    700760          !$OMP CRITICAL
    701           DO  k = nzb_v_inner(ny,i) + 1, nzt
    702              volume_flow_l(2) = volume_flow_l(2) + v(k,ny,i) * dzw(k)
     761          DO  k = nzb+1, nzt
     762             volume_flow_l(2) = volume_flow_l(2) + v(k,nyn,i) * dzw(k)         &
     763                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     764                                              BTEST( wall_flags_0(k,nyn,i), 2 )&
     765                                            )
    703766           ENDDO
    704767          !$OMP END CRITICAL
    … …  
    727790       DO  i = nxl, nxr
    728791          DO  j = nys, nyn
    729              DO  k = nzb_u_inner(j,i) + 1, nzt
    730                 u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
    731              ENDDO
    732              DO  k = nzb_v_inner(j,i) + 1, nzt
    733                 v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
     792             DO  k = nzb+1, nzt
     793                u(k,j,i) = u(k,j,i) + volume_flow_offset(1)                    &
     794                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     795                                              BTEST( wall_flags_0(k,j,i), 1 )  &
     796                                            )
     797             ENDDO
     798             DO  k = nzb+1, nzt
     799                v(k,j,i) = v(k,j,i) + volume_flow_offset(2)                    &
     800                                     * MERGE( 1.0_wp, 0.0_wp,                  &
     801                                              BTEST( wall_flags_0(k,j,i), 2 )  &
     802                                            )
    734803             ENDDO
    735804          ENDDO
    … …  
    768837       DO  i = nxl, nxr
    769838          DO  j = nys, nyn
    770              DO  k = nzb_s_inner(j,i)+1, nzt
    771              d(k,j,i) = ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx +         &
    772                         ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy +         &
    773                         ( w(k,j,i)   * rho_air_zw(k) -                         &
    774                           w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k)
     839             DO  k = nzb+1, nzt
     840             d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx +       &
     841                          ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy +       &
     842                          ( w(k,j,i)   * rho_air_zw(k) -                       &
     843                            w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k)           &
     844                        ) * MERGE( 1.0_wp, 0.0_wp,                             &
     845                                   BTEST( wall_flags_0(k,j,i), 0 )             &
     846                                 )
    775847             ENDDO
    776848             DO  k = nzb+1, nzt
    … …  
    783855       DO  i = nxl, nxr
    784856          DO  j = nys, nyn
    785              DO  k = 1, nzt
     857             DO  k = nzb+1, nzt
    786858                d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx +    &
    787859                             ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy +    &
    788860                             ( w(k,j,i)   * rho_air_zw(k) -                    &
    789861                               w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k)        &
    790                            ) * rflags_s_inner(k,j,i)
     862                           ) * MERGE( 1.0_wp, 0.0_wp,                          &
     863                                   BTEST( wall_flags_0(k,j,i), 0 )             &
     864                                    )
    791865             ENDDO
    792866          ENDDO

  • palm/trunk/SOURCE/production_e.f90

    r2127 r2232  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Adjustments to new surface concept
    2323!
    2424! Former revisions:
    … …  
    106106!------------------------------------------------------------------------------!
    107107 MODULE production_e_mod
    108  
    109 
    110     USE wall_fluxes_mod,                                                       &
    111         ONLY:  wall_fluxes_e
    112108
    113109    USE kinds
    … …  
    115111    PRIVATE
    116112    PUBLIC production_e, production_e_init
    117 
    118     LOGICAL, SAVE ::  first_call = .TRUE.  !<
    119 
    120     REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  u_0  !<
    121     REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  v_0  !<
    122113
    123114    INTERFACE production_e
    … …  
    141132
    142133       USE arrays_3d,                                                          &
    143            ONLY:  ddzw, dd2zu, kh, km, prho, pt, q, ql, qsws, qswst, shf,      &
    144                   tend, tswst, u, v, vpt, w
     134           ONLY:  ddzw, dd2zu, kh, km, prho, pt, q, ql, tend, u, v, vpt, w
    145135
    146136       USE cloud_parameters,                                                   &
    … …  
    154144
    155145       USE grid_variables,                                                     &
    156            ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
     146           ONLY:  ddx, dx, ddy, dy
    157147
    158148       USE indices,                                                            &
    159            ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
    160                    nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
     149           ONLY:  nxl, nxr, nys, nyn, nzb, nzt, wall_flags_0
     150
     151       USE surface_mod,                                                        &
     152           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     153                   surf_usm_v
    161154
    162155       IMPLICIT NONE
    163156
    164        INTEGER(iwp) ::  i           !<
    165        INTEGER(iwp) ::  j           !<
    166        INTEGER(iwp) ::  k           !<
    167 
    168        REAL(wp)     ::  def         !<
    169        REAL(wp)     ::  dudx        !<
    170        REAL(wp)     ::  dudy        !<
    171        REAL(wp)     ::  dudz        !<
    172        REAL(wp)     ::  dvdx        !<
    173        REAL(wp)     ::  dvdy        !<
    174        REAL(wp)     ::  dvdz        !<
    175        REAL(wp)     ::  dwdx        !<
    176        REAL(wp)     ::  dwdy        !<
    177        REAL(wp)     ::  dwdz        !<
     157       INTEGER(iwp) ::  i       !< running index x-direction
     158       INTEGER(iwp) ::  j       !< running index y-direction
     159       INTEGER(iwp) ::  k       !< running index z-direction
     160       INTEGER(iwp) ::  l       !< running index for different surface type orientation
     161       INTEGER(iwp) ::  m       !< running index surface elements
     162       INTEGER(iwp) ::  surf_e  !< end index of surface elements at given i-j position
     163       INTEGER(iwp) ::  surf_s  !< start index of surface elements at given i-j position
     164
     165       REAL(wp)     ::  def         !<
     166       REAL(wp)     ::  flag        !< flag to mask topography
    178167       REAL(wp)     ::  k1          !<
    179168       REAL(wp)     ::  k2          !<
    180        REAL(wp)     ::  km_neutral  !<
     169       REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
    181170       REAL(wp)     ::  theta       !<
    182171       REAL(wp)     ::  temp        !<
    183 
    184 !       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs, vsus, wsus, wsvs
    185        REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !<
    186        REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !<
    187        REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !<
    188        REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !<
    189 
    190 !
    191 !--    First calculate horizontal momentum flux u'v', w'v', v'u', w'u' at
    192 !--    vertical walls, if neccessary
    193 !--    So far, results are slightly different from the ij-Version.
    194 !--    Therefore, ij-Version is called further below within the ij-loops.
    195 !       IF ( topography /= 'flat' )  THEN
    196 !          CALL wall_fluxes_e( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
    197 !          CALL wall_fluxes_e( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
    198 !          CALL wall_fluxes_e( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
    199 !          CALL wall_fluxes_e( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
    200 !       ENDIF
    201 
     172       REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
     173       REAL(wp)     ::  usvs        !< momentum flux u"v"
     174       REAL(wp)     ::  vsus        !< momentum flux v"u"
     175       REAL(wp)     ::  wsus        !< momentum flux w"u"
     176       REAL(wp)     ::  wsvs        !< momentum flux w"v"
     177
     178       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudx  !< Gradient of u-component in x-direction
     179       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudy  !< Gradient of u-component in y-direction
     180       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudz  !< Gradient of u-component in z-direction
     181       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdx  !< Gradient of v-component in x-direction
     182       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdy  !< Gradient of v-component in y-direction
     183       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdz  !< Gradient of v-component in z-direction
     184       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdx  !< Gradient of w-component in x-direction
     185       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdy  !< Gradient of w-component in y-direction
     186       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdz  !< Gradient of w-component in z-direction
    202187
    203188       DO  i = nxl, nxr
    204189
    205 !
    206 !--       Calculate TKE production by shear
    207           DO  j = nys, nyn
    208              DO  k = nzb_diff_s_outer(j,i), nzt
    209 
    210                 dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    211                 dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
    212                                     u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    213                 dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    214                                     u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    215 
    216                 dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    217                                     v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    218                 dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    219                 dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    220                                     v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    221 
    222                 dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    223                                     w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    224                 dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
    225                                     w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    226                 dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    227 
    228                 def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
    229                       dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
    230                       dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
    231 
    232                 IF ( def < 0.0_wp )  def = 0.0_wp
    233 
    234                 tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
    235 
     190          IF ( constant_flux_layer )  THEN
     191
     192!
     193!--          Calculate TKE production by shear. Calculate gradients at all grid
     194!--          points first, gradients at surface-bounded grid points will be
     195!--          overwritten further below.
     196             DO  j = nys, nyn
     197                DO  k = nzb+1, nzt
     198
     199                   dudx(k,j) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
     200                   dudy(k,j) = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) -         &
     201                                           u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
     202                   dudz(k,j) = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) -         &
     203                                           u(k-1,j,i) - u(k-1,j,i+1) ) *       &
     204                                                            dd2zu(k)
     205   
     206                   dvdx(k,j) = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) -         &
     207                                           v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
     208                   dvdy(k,j) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
     209                   dvdz(k,j) = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) -         &
     210                                           v(k-1,j,i) - v(k-1,j+1,i) ) *       &
     211                                                            dd2zu(k)
     212
     213                   dwdx(k,j) = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) -         &
     214                                           w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
     215                   dwdy(k,j) = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) -         &
     216                                           w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
     217                   dwdz(k,j) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
     218
     219                ENDDO
    236220             ENDDO
    237           ENDDO
    238 
    239           IF ( constant_flux_layer )  THEN
    240221
    241222!
    … …  
    244225!--          'bottom and wall: use u_0,v_0 and wall functions'
    245226             DO  j = nys, nyn
    246 
    247                 IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) ) &
    248                 THEN
    249 
    250                    k = nzb_diff_s_inner(j,i) - 1
    251                    dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
    252                    dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    253                                      u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
    254                    dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
    255                    dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    256                                      v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
    257                    dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
    258 
    259                    IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
    260 !
    261 !--                   Inconsistency removed: as the thermal stratification is
    262 !--                   not taken into account for the evaluation of the wall
    263 !--                   fluxes at vertical walls, the eddy viscosity km must not
    264 !--                   be used for the evaluation of the velocity gradients dudy
    265 !--                   and dwdy
    266 !--                   Note: The validity of the new method has not yet been
    267 !--                         shown, as so far no suitable data for a validation
    268 !--                         has been available
    269                       CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    270                                           usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
    271                       CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    272                                           wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
    273                       km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25_wp * &
    274                                    0.5_wp * dy
    275                       IF ( km_neutral > 0.0_wp )  THEN
    276                          dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
    277                          dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
    278                       ELSE
    279                          dudy = 0.0_wp
    280                          dwdy = 0.0_wp
    281                       ENDIF
    282                    ELSE
    283                       dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
    284                                          u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    285                       dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
    286                                          w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    287                    ENDIF
    288 
    289                    IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
    290 !
    291 !--                   Inconsistency removed: as the thermal stratification is
    292 !--                   not taken into account for the evaluation of the wall
    293 !--                   fluxes at vertical walls, the eddy viscosity km must not
    294 !--                   be used for the evaluation of the velocity gradients dvdx
    295 !--                   and dwdx
    296 !--                   Note: The validity of the new method has not yet been
    297 !--                         shown, as so far no suitable data for a validation
    298 !--                         has been available
    299                       CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    300                                           vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
    301                       CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    302                                           wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
    303                       km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25_wp * &
    304                                    0.5_wp * dx
    305                       IF ( km_neutral > 0.0_wp )  THEN
    306                          dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
    307                          dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
    308                       ELSE
    309                          dvdx = 0.0_wp
    310                          dwdx = 0.0_wp
    311                       ENDIF
    312                    ELSE
    313                       dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    314                                          v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    315                       dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    316                                          w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    317                    ENDIF
    318 
    319                    def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
    320                          dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
    321                          dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
     227!
     228!--             Compute gradients at north- and south-facing surfaces.
     229!--             First, for default surfaces, then for urban surfaces.
     230!--             Note, so far no natural vertical surfaces implemented
     231                DO  l = 0, 1
     232                   surf_s = surf_def_v(l)%start_index(j,i)
     233                   surf_e = surf_def_v(l)%end_index(j,i)
     234                   DO  m = surf_s, surf_e
     235                      k           = surf_def_v(l)%k(m)
     236                      usvs        = surf_def_v(l)%mom_flux_tke(0,m)
     237                      wsvs        = surf_def_v(l)%mom_flux_tke(1,m)
     238     
     239                      km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp      &
     240                                      * 0.5_wp * dy
     241!
     242!--                   -1.0 for right-facing wall, 1.0 for left-facing wall
     243                      sign_dir = MERGE( 1.0_wp, -1.0_wp,                       &
     244                                        BTEST( wall_flags_0(k,j-1,i), 0 ) )
     245                      dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
     246                      dwdy(k,j) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
     247                   ENDDO
     248!
     249!--                Natural surfaces
     250                   surf_s = surf_lsm_v(l)%start_index(j,i)
     251                   surf_e = surf_lsm_v(l)%end_index(j,i)
     252                   DO  m = surf_s, surf_e
     253                      k           = surf_lsm_v(l)%k(m)
     254                      usvs        = surf_lsm_v(l)%mom_flux_tke(0,m)
     255                      wsvs        = surf_lsm_v(l)%mom_flux_tke(1,m)
     256     
     257                      km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp      &
     258                                      * 0.5_wp * dy
     259!
     260!--                   -1.0 for right-facing wall, 1.0 for left-facing wall
     261                      sign_dir = MERGE( 1.0_wp, -1.0_wp,                       &
     262                                        BTEST( wall_flags_0(k,j-1,i), 0 ) )
     263                      dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
     264                      dwdy(k,j) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
     265                   ENDDO
     266!
     267!--                Urban surfaces
     268                   surf_s = surf_usm_v(l)%start_index(j,i)
     269                   surf_e = surf_usm_v(l)%end_index(j,i)
     270                   DO  m = surf_s, surf_e
     271                      k           = surf_usm_v(l)%k(m)
     272                      usvs        = surf_usm_v(l)%mom_flux_tke(0,m)
     273                      wsvs        = surf_usm_v(l)%mom_flux_tke(1,m)
     274     
     275                      km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp      &
     276                                      * 0.5_wp * dy
     277!
     278!--                   -1.0 for right-facing wall, 1.0 for left-facing wall
     279                      sign_dir = MERGE( 1.0_wp, -1.0_wp,                       &
     280                                        BTEST( wall_flags_0(k,j-1,i), 0 ) )
     281                      dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
     282                      dwdy(k,j) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
     283                   ENDDO 
     284                ENDDO
     285!
     286!--             Compute gradients at east- and west-facing walls
     287                DO  l = 2, 3
     288                   surf_s = surf_def_v(l)%start_index(j,i)
     289                   surf_e = surf_def_v(l)%end_index(j,i)
     290                   DO  m = surf_s, surf_e
     291                      k     = surf_def_v(l)%k(m)
     292                      vsus  = surf_def_v(l)%mom_flux_tke(0,m)
     293                      wsus  = surf_def_v(l)%mom_flux_tke(1,m)
     294
     295                      km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp      &
     296                                         * 0.5_wp * dx
     297!
     298!--                   -1.0 for right-facing wall, 1.0 for left-facing wall
     299                      sign_dir = MERGE( 1.0_wp, -1.0_wp,                       &
     300                                        BTEST( wall_flags_0(k,j,i-1), 0 ) )
     301                      dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
     302                      dwdx(k,j) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
     303                   ENDDO
     304!
     305!--                Natural surfaces                   
     306                   surf_s = surf_lsm_v(l)%start_index(j,i)
     307                   surf_e = surf_lsm_v(l)%end_index(j,i)
     308                   DO  m = surf_s, surf_e
     309                      k     = surf_lsm_v(l)%k(m)
     310                      vsus  = surf_lsm_v(l)%mom_flux_tke(0,m)
     311                      wsus  = surf_lsm_v(l)%mom_flux_tke(1,m)
     312
     313                      km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp      &
     314                                         * 0.5_wp * dx
     315!
     316!--                   -1.0 for right-facing wall, 1.0 for left-facing wall
     317                      sign_dir = MERGE( 1.0_wp, -1.0_wp,                       &
     318                                        BTEST( wall_flags_0(k,j,i-1), 0 ) )
     319                      dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
     320                      dwdx(k,j) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
     321                   ENDDO   
     322!
     323!--                Urban surfaces                   
     324                   surf_s = surf_usm_v(l)%start_index(j,i)
     325                   surf_e = surf_usm_v(l)%end_index(j,i)
     326                   DO  m = surf_s, surf_e
     327                      k     = surf_usm_v(l)%k(m)
     328                      vsus  = surf_usm_v(l)%mom_flux_tke(0,m)
     329                      wsus  = surf_usm_v(l)%mom_flux_tke(1,m)
     330
     331                      km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp      &
     332                                         * 0.5_wp * dx
     333!
     334!--                   -1.0 for right-facing wall, 1.0 for left-facing wall
     335                      sign_dir = MERGE( 1.0_wp, -1.0_wp,                       &
     336                                        BTEST( wall_flags_0(k,j,i-1), 0 ) )
     337                      dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
     338                      dwdx(k,j) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
     339                   ENDDO
     340                ENDDO
     341!
     342!--             Compute gradients at upward-facing surfaces
     343                surf_s = surf_def_h(0)%start_index(j,i)
     344                surf_e = surf_def_h(0)%end_index(j,i)
     345                DO  m = surf_s, surf_e
     346                   k = surf_def_h(0)%k(m)
     347!
     348!--                Please note, actually, an interpolation of u_0 and v_0
     349!--                onto the grid center would be required. However, this
     350!--                would require several data transfers between 2D-grid and
     351!--                wall type. The effect of this missing interpolation is
     352!--                negligible. (See also production_e_init).
     353                   dudz(k,j) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)   
     354                   dvdz(k,j) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
     355           
     356                ENDDO
     357!
     358!--             Natural surfaces
     359                surf_s = surf_lsm_h%start_index(j,i)
     360                surf_e = surf_lsm_h%end_index(j,i)
     361                DO  m = surf_s, surf_e
     362                   k = surf_lsm_h%k(m)
     363!
     364!--                Please note, actually, an interpolation of u_0 and v_0
     365!--                onto the grid center would be required. However, this
     366!--                would require several data transfers between 2D-grid and
     367!--                wall type. The effect of this missing interpolation is
     368!--                negligible. (See also production_e_init).
     369                   dudz(k,j) = ( u(k+1,j,i) - surf_lsm_h%u_0(m) ) * dd2zu(k)   
     370                   dvdz(k,j) = ( v(k+1,j,i) - surf_lsm_h%v_0(m) ) * dd2zu(k)
     371           
     372                ENDDO
     373!
     374!--             Urban surfaces
     375                surf_s = surf_usm_h%start_index(j,i)
     376                surf_e = surf_usm_h%end_index(j,i)
     377                DO  m = surf_s, surf_e
     378                   k = surf_usm_h%k(m)
     379!
     380!--                Please note, actually, an interpolation of u_0 and v_0
     381!--                onto the grid center would be required. However, this
     382!--                would require several data transfers between 2D-grid and
     383!--                wall type. The effect of this missing interpolation is
     384!--                negligible. (See also production_e_init).
     385                   dudz(k,j) = ( u(k+1,j,i) - surf_usm_h%u_0(m) ) * dd2zu(k)   
     386                   dvdz(k,j) = ( v(k+1,j,i) - surf_usm_h%v_0(m) ) * dd2zu(k)
     387           
     388                ENDDO
     389!
     390!--             Compute gradients at downward-facing walls, only for
     391!--             non-natural default surfaces
     392                surf_s = surf_def_h(1)%start_index(j,i)
     393                surf_e = surf_def_h(1)%end_index(j,i)
     394                DO  m = surf_s, surf_e
     395                   k = surf_def_h(1)%k(m)
     396!
     397!--                Please note, actually, an interpolation of u_0 and v_0
     398!--                onto the grid center would be required. However, this
     399!--                would require several data transfers between 2D-grid and
     400!--                wall type. The effect of this missing interpolation is
     401!--                negligible. (See also production_e_init).
     402                   dudz(k,j) = ( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)   
     403                   dvdz(k,j) = ( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
     404
     405                ENDDO
     406
     407             ENDDO
     408
     409             DO  j = nys, nyn
     410                DO  k = nzb+1, nzt
     411
     412                   def = 2.0_wp * ( dudx(k,j)**2 + dvdy(k,j)**2 + dwdz(k,j)**2 ) + &
     413                                    dudy(k,j)**2 + dvdx(k,j)**2 + dwdx(k,j)**2 +   &
     414                                    dwdy(k,j)**2 + dudz(k,j)**2 + dvdz(k,j)**2 +   &
     415                         2.0_wp * ( dvdx(k,j)*dudy(k,j) + dwdx(k,j)*dudz(k,j)  +   &
     416                                    dwdy(k,j)*dvdz(k,j) )
    322417
    323418                   IF ( def < 0.0_wp )  def = 0.0_wp
    324419
    325                    tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
    326 
    327 
    328 !
    329 !--                (3) - will be executed only, if there is at least one level
    330 !--                between (2) and (4), i.e. the topography must have a
    331 !--                minimum height of 2 dz. Wall fluxes for this case have
    332 !--                already been calculated for (2).
    333 !--                'wall only: use wall functions'
    334 
    335                    DO  k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
    336 
    337                       dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
    338                       dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    339                                         u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    340                       dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    341                       dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    342                                         v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    343                       dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
    344 
    345                       IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
    346 !
    347 !--                      Inconsistency removed: as the thermal stratification
    348 !--                      is not taken into account for the evaluation of the
    349 !--                      wall fluxes at vertical walls, the eddy viscosity km
    350 !--                      must not be used for the evaluation of the velocity
    351 !--                      gradients dudy and dwdy
    352 !--                      Note: The validity of the new method has not yet
    353 !--                            been shown, as so far no suitable data for a
    354 !--                            validation has been available
    355                          km_neutral = kappa * ( usvs(k)**2 + &
    356                                                 wsvs(k)**2 )**0.25_wp * 0.5_wp * dy
    357                          IF ( km_neutral > 0.0_wp )  THEN
    358                             dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
    359                             dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
    360                          ELSE
    361                             dudy = 0.0_wp
    362                             dwdy = 0.0_wp
    363                          ENDIF
    364                       ELSE
    365                          dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
     420                   flag  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     421
     422                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
     423
     424                ENDDO
     425             ENDDO
     426
     427          ELSEIF ( use_surface_fluxes )  THEN
     428
     429             DO  j = nys, nyn
     430!
     431!--             Calculate TKE production by shear. Here, no additional
     432!--             wall-bounded code is considered.
     433!--             Why?
     434                DO  k = nzb+1, nzt
     435
     436                   dudx(k,j)  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
     437                   dudy(k,j)  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) -        &
    366438                                            u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    367                          dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
     439                   dudz(k,j)  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) -        &
     440                                            u(k-1,j,i) - u(k-1,j,i+1) ) *      &
     441                                                                        dd2zu(k)
     442
     443                   dvdx(k,j)  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) -        &
     444                                            v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
     445                   dvdy(k,j)  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
     446                   dvdz(k,j)  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) -        &
     447                                            v(k-1,j,i) - v(k-1,j+1,i) ) *      &
     448                                                                        dd2zu(k)
     449
     450                   dwdx(k,j)  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) -        &
     451                                            w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
     452                   dwdy(k,j)  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) -        &
    368453                                            w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    369                       ENDIF
    370 
    371                       IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
    372 !
    373 !--                      Inconsistency removed: as the thermal stratification
    374 !--                      is not taken into account for the evaluation of the
    375 !--                      wall fluxes at vertical walls, the eddy viscosity km
    376 !--                      must not be used for the evaluation of the velocity
    377 !--                      gradients dvdx and dwdx
    378 !--                      Note: The validity of the new method has not yet
    379 !--                            been shown, as so far no suitable data for a
    380 !--                            validation has been available
    381                          km_neutral = kappa * ( vsus(k)**2 + &
    382                                                 wsus(k)**2 )**0.25_wp * 0.5_wp * dx
    383                          IF ( km_neutral > 0.0_wp )  THEN
    384                             dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
    385                             dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
    386                          ELSE
    387                             dvdx = 0.0_wp
    388                             dwdx = 0.0_wp
    389                          ENDIF
    390                       ELSE
    391                          dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    392                                             v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    393                          dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    394                                             w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    395                       ENDIF
    396 
    397                       def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
    398                            dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 +  &
    399                            dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
    400 
    401                       IF ( def < 0.0_wp )  def = 0.0_wp
    402 
    403                       tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
    404 
    405                    ENDDO
    406 
    407                 ENDIF
    408 
    409              ENDDO
    410 
    411 !
    412 !--          (4) - will allways be executed.
    413 !--          'special case: free atmosphere' (as for case (0))
    414              DO  j = nys, nyn
    415 
    416                 IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) ) &
    417                 THEN
    418 
    419                    k = nzb_diff_s_outer(j,i)-1
    420 
    421                    dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    422                    dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
    423                                        u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    424                    dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    425                                        u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    426 
    427                    dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    428                                        v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    429                    dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    430                    dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    431                                        v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    432 
    433                    dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    434                                        w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    435                    dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
    436                                        w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    437                    dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    438 
    439                    def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
    440                          dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
    441                          dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
     454                   dwdz(k,j)  =           ( w(k,j,i)   - w(k-1,j,i)   ) *      &
     455                                                                        ddzw(k)
     456     
     457                   def = 2.0_wp * (                                            &
     458                                dudx(k,j)**2 + dvdy(k,j)**2 + dwdz(k,j)**2     &
     459                                  ) +                                          &
     460                                dudy(k,j)**2 + dvdx(k,j)**2 + dwdx(k,j)**2 +   &
     461                                dwdy(k,j)**2 + dudz(k,j)**2 + dvdz(k,j)**2 +   &
     462                         2.0_wp * (                                            &
     463                                dvdx(k,j)*dudy(k,j) + dwdx(k,j)*dudz(k,j)  +   &
     464                                dwdy(k,j)*dvdz(k,j)                            &
     465                                  )
    442466
    443467                   IF ( def < 0.0_wp )  def = 0.0_wp
    444468
    445                    tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
    446 
    447                 ENDIF
    448 
    449              ENDDO
    450 
    451 !
    452 !--          Position without adjacent wall
    453 !--          (1) - will allways be executed.
    454 !--          'bottom only: use u_0,v_0'
    455              DO  j = nys, nyn
    456 
    457                 IF ( ( wall_e_x(j,i) == 0.0_wp ) .AND. ( wall_e_y(j,i) == 0.0_wp ) ) &
    458                 THEN
    459 
    460                    k = nzb_diff_s_inner(j,i)-1
    461 
    462                    dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    463                    dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
    464                                        u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    465                    dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    466                                        u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
    467 
    468                    dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    469                                        v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    470                    dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    471                    dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    472                                        v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
    473 
    474                    dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    475                                        w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    476                    dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
    477                                        w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    478                    dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    479 
    480                    def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
    481                          dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
    482                          dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
    483 
    484                    IF ( def < 0.0_wp )  def = 0.0_wp
    485 
    486                    tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
    487 
    488                 ENDIF
    489 
    490              ENDDO
    491 
    492           ELSEIF ( use_surface_fluxes )  THEN
    493 
    494              DO  j = nys, nyn
    495 
    496                 k = nzb_diff_s_outer(j,i)-1
    497 
    498                 dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    499                 dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
    500                                     u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    501                 dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    502                                    u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    503 
    504                 dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    505                                     v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    506                 dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    507                 dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    508                                     v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    509 
    510                 dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    511                                     w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    512                 dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
    513                                     w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    514                 dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    515 
    516                 def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
    517                       dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
    518                       dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
    519 
    520                 IF ( def < 0.0_wp )  def = 0.0_wp
    521 
    522                 tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
    523 
     469                   flag  = MERGE( 1.0_wp, 0.0_wp,                              &
     470                                  BTEST( wall_flags_0(k,j,i), 29 ) )
     471                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
     472     
     473                ENDDO
    524474             ENDDO
    525475
    … …  
    539489!--                   in the bottom and top surface layer
    540490                      DO  j = nys, nyn
    541                          DO  k = nzb_s_inner(j,i)+1, nzt
     491                         DO  k = nzb+1, nzt
    542492                            tend(k,j,i) = tend(k,j,i) +                        &
    543493                                          kh(k,j,i) * g / rho_reference *      &
    544494                                          ( prho(k+1,j,i) - prho(k-1,j,i) ) *  &
    545                                           dd2zu(k)
     495                                          dd2zu(k) *                           &
     496                                    MERGE( 1.0_wp, 0.0_wp,                     &
     497                                             BTEST( wall_flags_0(k,j,i), 0 )   &
     498                                          )
    546499                         ENDDO
    547500                      ENDDO
    … …  
    550503
    551504                      DO  j = nys, nyn
    552                          DO  k = nzb_diff_s_inner(j,i), nzt_diff
    553                             tend(k,j,i) = tend(k,j,i) -                   &
    554                                           kh(k,j,i) * g / pt_reference *  &
    555                                           ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
    556                                           dd2zu(k)
     505                         DO  k = nzb+1, nzt
     506!
     507!--                         Flag 9 is used to mask top fluxes, flag 30 to mask
     508!--                         surface fluxes
     509                            tend(k,j,i) = tend(k,j,i) -                        &
     510                                          kh(k,j,i) * g / pt_reference  *      &
     511                                          ( pt(k+1,j,i) - pt(k-1,j,i) ) *      &
     512                                          dd2zu(k)                      *      &
     513                                      MERGE( 1.0_wp, 0.0_wp,                   &
     514                                             BTEST( wall_flags_0(k,j,i), 30 )  &
     515                                           )                            *      &
     516                                      MERGE( 1.0_wp, 0.0_wp,                   &
     517                                             BTEST( wall_flags_0(k,j,i), 9 )   &
     518                                           ) 
    557519                         ENDDO
    558520
    559521                         IF ( use_surface_fluxes )  THEN
    560                             k = nzb_diff_s_inner(j,i)-1
    561                             tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
    562                                                         shf(j,i)
     522!
     523!--                         Default surfaces, up- and downward-facing
     524                            DO  l = 0, 1
     525                               surf_s = surf_def_h(l)%start_index(j,i)
     526                               surf_e = surf_def_h(l)%end_index(j,i)
     527                               DO  m = surf_s, surf_e
     528                                  k = surf_def_h(l)%k(m)
     529                                  tend(k,j,i) = tend(k,j,i) + g / pt_reference &
     530                                                         * surf_def_h(l)%shf(m)   
     531                               ENDDO   
     532                            ENDDO     
     533!
     534!--                         Natural surfaces
     535                            surf_s = surf_lsm_h%start_index(j,i)
     536                            surf_e = surf_lsm_h%end_index(j,i)
     537                            DO  m = surf_s, surf_e
     538                               k = surf_lsm_h%k(m)
     539                               tend(k,j,i) = tend(k,j,i) + g / pt_reference    &
     540                                                         * surf_lsm_h%shf(m)   
     541                            ENDDO
     542!
     543!--                         Urban surfaces
     544                            surf_s = surf_usm_h%start_index(j,i)
     545                            surf_e = surf_usm_h%end_index(j,i)
     546                            DO  m = surf_s, surf_e
     547                               k = surf_usm_h%k(m)
     548                               tend(k,j,i) = tend(k,j,i) + g / pt_reference    &
     549                                                         * surf_usm_h%shf(m)   
     550                            ENDDO                         
    563551                         ENDIF
    564552
    565553                         IF ( use_top_fluxes )  THEN
    566                             k = nzt
    567                             tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
    568                                                         tswst(j,i)
     554                            surf_s = surf_def_h(2)%start_index(j,i)
     555                            surf_e = surf_def_h(2)%end_index(j,i)
     556                            DO  m = surf_s, surf_e
     557                               k = surf_def_h(2)%k(m)
     558                               tend(k,j,i) = tend(k,j,i) + g / pt_reference *     &
     559                                                           surf_def_h(2)%shf(m)
     560                            ENDDO
    569561                         ENDIF
    570562                      ENDDO
    … …  
    579571!--                   in the bottom and top surface layer
    580572                      DO  j = nys, nyn
    581                          DO  k = nzb_s_inner(j,i)+1, nzt
     573                         DO  k = nzb+1, nzt
    582574                            tend(k,j,i) = tend(k,j,i) +                        &
    583575                                          kh(k,j,i) * g / prho(k,j,i) *        &
    584576                                          ( prho(k+1,j,i) - prho(k-1,j,i) ) *  &
    585                                           dd2zu(k)
     577                                          dd2zu(k)                           * &
     578                                     MERGE( 1.0_wp, 0.0_wp,                    &
     579                                             BTEST( wall_flags_0(k,j,i), 0 )   &
     580                                          )
    586581                         ENDDO
    587582                      ENDDO
    … …  
    590585
    591586                      DO  j = nys, nyn
    592                          DO  k = nzb_diff_s_inner(j,i), nzt_diff
    593                             tend(k,j,i) = tend(k,j,i) -                   &
    594                                           kh(k,j,i) * g / pt(k,j,i) *     &
    595                                           ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
    596                                           dd2zu(k)
     587                         DO  k = nzb+1, nzt
     588!
     589!--                         Flag 9 is used to mask top fluxes, flag 30 to mask
     590!--                         surface fluxes
     591                            tend(k,j,i) = tend(k,j,i) -                        &
     592                                          kh(k,j,i) * g / pt(k,j,i) *          &
     593                                          ( pt(k+1,j,i) - pt(k-1,j,i) ) *      &
     594                                          dd2zu(k)                      *      &
     595                                      MERGE( 1.0_wp, 0.0_wp,                   &
     596                                             BTEST( wall_flags_0(k,j,i), 30 )  &
     597                                           )                            *      &
     598                                      MERGE( 1.0_wp, 0.0_wp,                   &
     599                                             BTEST( wall_flags_0(k,j,i), 9 )   &
     600                                           )
    597601                         ENDDO
    598602
    599603                         IF ( use_surface_fluxes )  THEN
    600                             k = nzb_diff_s_inner(j,i)-1
    601                             tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
    602                                                         shf(j,i)
     604!
     605!--                         Default surfaces, up- and downwrd-facing
     606                            DO  l = 0, 1
     607                               surf_s = surf_def_h(l)%start_index(j,i)
     608                               surf_e = surf_def_h(l)%end_index(j,i)
     609                               DO  m = surf_s, surf_e
     610                                  k = surf_def_h(l)%k(m)
     611                                  tend(k,j,i) = tend(k,j,i) + g / pt_reference &
     612                                                         * surf_def_h(l)%shf(m)   
     613                               ENDDO 
     614                            ENDDO
     615!
     616!--                         Natural surfaces
     617                            surf_s = surf_lsm_h%start_index(j,i)
     618                            surf_e = surf_lsm_h%end_index(j,i)
     619                            DO  m = surf_s, surf_e
     620                               k = surf_lsm_h%k(m)
     621                               tend(k,j,i) = tend(k,j,i) + g / pt_reference    &
     622                                                         * surf_lsm_h%shf(m)   
     623                            ENDDO 
     624!
     625!--                         Urban surfaces
     626                            surf_s = surf_usm_h%start_index(j,i)
     627                            surf_e = surf_usm_h%end_index(j,i)
     628                            DO  m = surf_s, surf_e
     629                               k = surf_usm_h%k(m)
     630                               tend(k,j,i) = tend(k,j,i) + g / pt_reference    &
     631                                                         * surf_usm_h%shf(m)   
     632                            ENDDO 
    603633                         ENDIF
    604634
    605635                         IF ( use_top_fluxes )  THEN
    606                             k = nzt
    607                             tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
    608                                                         tswst(j,i)
     636                            surf_s = surf_def_h(2)%start_index(j,i)
     637                            surf_e = surf_def_h(2)%end_index(j,i)
     638                            DO  m = surf_s, surf_e
     639                               k = surf_def_h(2)%k(m)
     640                               tend(k,j,i) = tend(k,j,i) + g / pt_reference *     &
     641                                                           surf_def_h(2)%shf(m)
     642                            ENDDO
    609643                         ENDIF
    610644                      ENDDO
    … …  
    618652                DO  j = nys, nyn
    619653
    620                    DO  k = nzb_diff_s_inner(j,i), nzt_diff
    621 
     654                   DO  k = nzb+1, nzt
     655!
     656!--                   Flag 9 is used to mask top fluxes, flag 30 to mask
     657!--                   surface fluxes
    622658                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
    623659                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    … …  
    627663                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
    628664                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
    629                                          ) * dd2zu(k)
    630                       ELSE IF ( cloud_physics )  THEN
    631                          IF ( ql(k,j,i) == 0.0_wp )  THEN
    632                             k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    633                             k2 = 0.61_wp * pt(k,j,i)
    634                          ELSE
    635                             theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
    636                             temp  = theta * t_d_pt(k)
    637                             k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    638                                           ( q(k,j,i) - ql(k,j,i) ) *          &
    639                                  ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
    640                                  ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
    641                                  ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    642                             k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
    643                          ENDIF
    644                          tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
    645                                          g / vpt(k,j,i) *                      &
    646                                          ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
    647                                            k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
    648                                          ) * dd2zu(k)
    649                       ELSE IF ( cloud_droplets )  THEN
    650                          k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
    651                          k2 = 0.61_wp * pt(k,j,i)
    652                          tend(k,j,i) = tend(k,j,i) -                          &
    653                                        kh(k,j,i) * g / vpt(k,j,i) *           &
    654                                        ( k1 * ( pt(k+1,j,i)- pt(k-1,j,i) ) +  &
    655                                          k2 * ( q(k+1,j,i) -  q(k-1,j,i) ) -  &
    656                                          pt(k,j,i) * ( ql(k+1,j,i) -          &
    657                                          ql(k-1,j,i) ) ) * dd2zu(k)
    658                       ENDIF
    659 
    660                    ENDDO
    661 
    662                 ENDDO
    663 
    664                 IF ( use_surface_fluxes )  THEN
    665 
    666                    DO  j = nys, nyn
    667 
    668                       k = nzb_diff_s_inner(j,i)-1
    669 
    670                       IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
    671                          k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    672                          k2 = 0.61_wp * pt(k,j,i)
     665                                         ) * dd2zu(k) *                        &
     666                                      MERGE( 1.0_wp, 0.0_wp,                   &
     667                                             BTEST( wall_flags_0(k,j,i), 30 )  &
     668                                           )          *                        &
     669                                      MERGE( 1.0_wp, 0.0_wp,                   &
     670                                             BTEST( wall_flags_0(k,j,i), 9 )   &
     671                                           )
    673672                      ELSE IF ( cloud_physics )  THEN
    674673                         IF ( ql(k,j,i) == 0.0_wp )  THEN
    … …  
    685684                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
    686685                         ENDIF
     686                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
     687                                         g / vpt(k,j,i) *                      &
     688                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
     689                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
     690                                         ) * dd2zu(k) *                        &
     691                                      MERGE( 1.0_wp, 0.0_wp,                   &
     692                                             BTEST( wall_flags_0(k,j,i), 30 )  &
     693                                           )          *                        &
     694                                      MERGE( 1.0_wp, 0.0_wp,                   &
     695                                             BTEST( wall_flags_0(k,j,i), 9 )   &
     696                                           )
    687697                      ELSE IF ( cloud_droplets )  THEN
    688698                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
    689699                         k2 = 0.61_wp * pt(k,j,i)
     700                         tend(k,j,i) = tend(k,j,i) -                           &
     701                                       kh(k,j,i) * g / vpt(k,j,i) *            &
     702                                       ( k1 * ( pt(k+1,j,i)- pt(k-1,j,i) ) +   &
     703                                         k2 * ( q(k+1,j,i) -  q(k-1,j,i) ) -   &
     704                                         pt(k,j,i) * ( ql(k+1,j,i) -           &
     705                                         ql(k-1,j,i) ) ) * dd2zu(k) *          &
     706                                      MERGE( 1.0_wp, 0.0_wp,                   &
     707                                             BTEST( wall_flags_0(k,j,i), 30 )  &
     708                                           )                        *          &
     709                                      MERGE( 1.0_wp, 0.0_wp,                   &
     710                                             BTEST( wall_flags_0(k,j,i), 9 )   &
     711                                           )
    690712                      ENDIF
    691713
    692                       tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
    693                                             ( k1* shf(j,i) + k2 * qsws(j,i) )
    694714                   ENDDO
    695715
     716                ENDDO
     717
     718                IF ( use_surface_fluxes )  THEN
     719
     720                   DO  j = nys, nyn
     721!
     722!--                   Treat horizontal default surfaces, up- and downward-facing
     723                      DO  l = 0, 1
     724                         surf_s = surf_def_h(l)%start_index(j,i)
     725                         surf_e = surf_def_h(l)%end_index(j,i)
     726                         DO  m = surf_s, surf_e
     727                            k = surf_def_h(l)%k(m)
     728
     729                            IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
     730                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     731                               k2 = 0.61_wp * pt(k,j,i)
     732                            ELSE IF ( cloud_physics )  THEN
     733                               IF ( ql(k,j,i) == 0.0_wp )  THEN
     734                                  k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     735                                  k2 = 0.61_wp * pt(k,j,i)
     736                               ELSE
     737                                  theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
     738                                  temp  = theta * t_d_pt(k)
     739                                  k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *         &
     740                                             ( q(k,j,i) - ql(k,j,i) ) *        &
     741                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /   &
     742                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *     &
     743                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
     744                                  k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
     745                               ENDIF
     746                            ELSE IF ( cloud_droplets )  THEN
     747                               k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
     748                               k2 = 0.61_wp * pt(k,j,i)
     749                            ENDIF
     750
     751                            tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) *       &
     752                                               ( k1 * surf_def_h(l)%shf(m) +   &
     753                                                 k2 * surf_def_h(l)%qsws(m) )
     754                         ENDDO
     755                      ENDDO
     756!
     757!--                   Treat horizontal natural surfaces
     758                      surf_s = surf_lsm_h%start_index(j,i)
     759                      surf_e = surf_lsm_h%end_index(j,i)
     760                      DO  m = surf_s, surf_e
     761                         k = surf_lsm_h%k(m)
     762
     763                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
     764                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     765                            k2 = 0.61_wp * pt(k,j,i)
     766                         ELSE IF ( cloud_physics )  THEN
     767                            IF ( ql(k,j,i) == 0.0_wp )  THEN
     768                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     769                               k2 = 0.61_wp * pt(k,j,i)
     770                            ELSE
     771                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
     772                               temp  = theta * t_d_pt(k)
     773                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
     774                                             ( q(k,j,i) - ql(k,j,i) ) *        &
     775                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /   &
     776                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *     &
     777                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
     778                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
     779                            ENDIF
     780                         ELSE IF ( cloud_droplets )  THEN
     781                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
     782                            k2 = 0.61_wp * pt(k,j,i)
     783                         ENDIF
     784
     785                         tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) *          &
     786                                               ( k1 * surf_lsm_h%shf(m) +      &
     787                                                 k2 * surf_lsm_h%qsws(m) )
     788                      ENDDO
     789!
     790!--                   Treat horizontal urban surfaces
     791                      surf_s = surf_usm_h%start_index(j,i)
     792                      surf_e = surf_usm_h%end_index(j,i)
     793                      DO  m = surf_s, surf_e
     794                         k = surf_lsm_h%k(m)
     795
     796                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
     797                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     798                            k2 = 0.61_wp * pt(k,j,i)
     799                         ELSE IF ( cloud_physics )  THEN
     800                            IF ( ql(k,j,i) == 0.0_wp )  THEN
     801                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     802                               k2 = 0.61_wp * pt(k,j,i)
     803                            ELSE
     804                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
     805                               temp  = theta * t_d_pt(k)
     806                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
     807                                             ( q(k,j,i) - ql(k,j,i) ) *        &
     808                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /   &
     809                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *     &
     810                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
     811                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
     812                            ENDIF
     813                         ELSE IF ( cloud_droplets )  THEN
     814                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
     815                            k2 = 0.61_wp * pt(k,j,i)
     816                         ENDIF
     817
     818                         tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) *          &
     819                                               ( k1 * surf_usm_h%shf(m) +      &
     820                                                 k2 * surf_usm_h%qsws(m) )
     821                      ENDDO
     822
     823                   ENDDO
     824
    696825                ENDIF
    697826
    … …  
    700829                   DO  j = nys, nyn
    701830
    702                       k = nzt
     831                      surf_s = surf_def_h(2)%start_index(j,i)
     832                      surf_e = surf_def_h(2)%end_index(j,i)
     833                      DO  m = surf_s, surf_e
     834                         k = surf_def_h(2)%k(m)
     835
     836                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
     837                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     838                            k2 = 0.61_wp * pt(k,j,i)
     839                         ELSE IF ( cloud_physics )  THEN
     840                            IF ( ql(k,j,i) == 0.0_wp )  THEN
     841                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
     842                               k2 = 0.61_wp * pt(k,j,i)
     843                            ELSE
     844                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
     845                               temp  = theta * t_d_pt(k)
     846                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
     847                                          ( q(k,j,i) - ql(k,j,i) ) *           &
     848                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
     849                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
     850                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
     851                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
     852                            ENDIF
     853                         ELSE IF ( cloud_droplets )  THEN
     854                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
     855                            k2 = 0.61_wp * pt(k,j,i)
     856                         ENDIF
     857
     858                         tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) *          &
     859                                               ( k1 * surf_def_h(2)%shf(m) +   &
     860                                                 k2 * surf_def_h(2)%qsws(m) )
     861
     862                      ENDDO
     863
     864                   ENDDO
     865
     866                ENDIF
     867
     868             ENDIF
     869
     870          ENDIF
     871
     872       ENDDO
     873
     874    END SUBROUTINE production_e
     875
     876
     877!------------------------------------------------------------------------------!
     878! Description:
     879! ------------
     880!> Call for grid point i,j
     881!------------------------------------------------------------------------------!
     882    SUBROUTINE production_e_ij( i, j )
     883
     884       USE arrays_3d,                                                          &
     885           ONLY:  ddzw, dd2zu, kh, km, prho, pt, q, ql, tend, u, v, vpt, w
     886
     887       USE cloud_parameters,                                                   &
     888           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
     889
     890       USE control_parameters,                                                 &
     891           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
     892                  humidity, kappa, neutral, ocean, pt_reference,               &
     893                  rho_reference, use_single_reference_value,                   &
     894                  use_surface_fluxes, use_top_fluxes
     895
     896       USE grid_variables,                                                     &
     897           ONLY:  ddx, dx, ddy, dy
     898
     899       USE indices,                                                            &
     900           ONLY:  nxl, nxr, nys, nyn, nzb, nzb, nzt, wall_flags_0
     901
     902       USE surface_mod,                                                        &
     903           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
     904                   surf_usm_v
     905
     906       IMPLICIT NONE
     907
     908       INTEGER(iwp) ::  i       !< running index x-direction
     909       INTEGER(iwp) ::  j       !< running index y-direction
     910       INTEGER(iwp) ::  k       !< running index z-direction
     911       INTEGER(iwp) ::  l       !< running index for different surface type orientation
     912       INTEGER(iwp) ::  m       !< running index surface elements
     913       INTEGER(iwp) ::  surf_e  !< end index of surface elements at given i-j position
     914       INTEGER(iwp) ::  surf_s  !< start index of surface elements at given i-j position
     915
     916       REAL(wp)     ::  def         !<
     917       REAL(wp)     ::  flag        !< flag to mask topography
     918       REAL(wp)     ::  k1          !<
     919       REAL(wp)     ::  k2          !<
     920       REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
     921       REAL(wp)     ::  theta       !<
     922       REAL(wp)     ::  temp        !<
     923       REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
     924       REAL(wp)     ::  usvs        !< momentum flux u"v"
     925       REAL(wp)     ::  vsus        !< momentum flux v"u"
     926       REAL(wp)     ::  wsus        !< momentum flux w"u"
     927       REAL(wp)     ::  wsvs        !< momentum flux w"v"
     928
     929
     930       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dudx        !< Gradient of u-component in x-direction
     931       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dudy        !< Gradient of u-component in y-direction
     932       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dudz        !< Gradient of u-component in z-direction
     933       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dvdx        !< Gradient of v-component in x-direction
     934       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dvdy        !< Gradient of v-component in y-direction
     935       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dvdz        !< Gradient of v-component in z-direction
     936       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dwdx        !< Gradient of w-component in x-direction
     937       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dwdy        !< Gradient of w-component in y-direction
     938       REAL(wp), DIMENSION(nzb+1:nzt)  ::  dwdz        !< Gradient of w-component in z-direction
     939
     940
     941       IF ( constant_flux_layer )  THEN
     942!
     943!--       Calculate TKE production by shear. Calculate gradients at all grid
     944!--       points first, gradients at surface-bounded grid points will be
     945!--       overwritten further below.
     946          DO  k = nzb+1, nzt
     947
     948             dudx(k)  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
     949             dudy(k)  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) -                &
     950                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
     951             dudz(k)  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) -                &
     952                                    u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
     953
     954             dvdx(k)  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) -                &
     955                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx     
     956             dvdy(k)  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
     957             dvdz(k)  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) -                &
     958                                    v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
     959
     960             dwdx(k)  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) -                &
     961                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx     
     962             dwdy(k)  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) -                &
     963                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy     
     964             dwdz(k)  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
     965
     966          ENDDO
     967!
     968!--       Compute gradients at north- and south-facing surfaces.
     969!--       Note, no vertical natural surfaces so far.
     970          DO  l = 0, 1
     971!
     972!--          Default surfaces
     973             surf_s = surf_def_v(l)%start_index(j,i)
     974             surf_e = surf_def_v(l)%end_index(j,i)
     975             DO  m = surf_s, surf_e
     976                k           = surf_def_v(l)%k(m)
     977                usvs        = surf_def_v(l)%mom_flux_tke(0,m)
     978                wsvs        = surf_def_v(l)%mom_flux_tke(1,m)
     979
     980                km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp            &
     981                                * 0.5_wp * dy
     982!
     983!--             -1.0 for right-facing wall, 1.0 for left-facing wall
     984                sign_dir = MERGE( 1.0_wp, -1.0_wp,                             &
     985                                  BTEST( wall_flags_0(k,j-1,i), 0 ) )
     986                dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
     987                dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
     988             ENDDO   
     989!
     990!--          Natural surfaces
     991             surf_s = surf_lsm_v(l)%start_index(j,i)
     992             surf_e = surf_lsm_v(l)%end_index(j,i)
     993             DO  m = surf_s, surf_e
     994                k           = surf_lsm_v(l)%k(m)
     995                usvs        = surf_lsm_v(l)%mom_flux_tke(0,m)
     996                wsvs        = surf_lsm_v(l)%mom_flux_tke(1,m)
     997
     998                km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp            &
     999                                * 0.5_wp * dy
     1000!
     1001!--             -1.0 for right-facing wall, 1.0 for left-facing wall
     1002                sign_dir = MERGE( 1.0_wp, -1.0_wp,                             &
     1003                                  BTEST( wall_flags_0(k,j-1,i), 0 ) )
     1004                dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
     1005                dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
     1006             ENDDO
     1007!
     1008!--          Urban surfaces
     1009             surf_s = surf_usm_v(l)%start_index(j,i)
     1010             surf_e = surf_usm_v(l)%end_index(j,i)
     1011             DO  m = surf_s, surf_e
     1012                k           = surf_usm_v(l)%k(m)
     1013                usvs        = surf_usm_v(l)%mom_flux_tke(0,m)
     1014                wsvs        = surf_usm_v(l)%mom_flux_tke(1,m)
     1015
     1016                km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp            &
     1017                                * 0.5_wp * dy
     1018!
     1019!--             -1.0 for right-facing wall, 1.0 for left-facing wall
     1020                sign_dir = MERGE( 1.0_wp, -1.0_wp,                             &
     1021                                  BTEST( wall_flags_0(k,j-1,i), 0 ) )
     1022                dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
     1023                dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
     1024             ENDDO
     1025          ENDDO
     1026!
     1027!--       Compute gradients at east- and west-facing walls
     1028          DO  l = 2, 3
     1029!
     1030!--          Default surfaces
     1031             surf_s = surf_def_v(l)%start_index(j,i)
     1032             surf_e = surf_def_v(l)%end_index(j,i)
     1033             DO  m = surf_s, surf_e
     1034                k           = surf_def_v(l)%k(m)
     1035                vsus        = surf_def_v(l)%mom_flux_tke(0,m)
     1036                wsus        = surf_def_v(l)%mom_flux_tke(1,m)
     1037
     1038                km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp            &
     1039                                   * 0.5_wp * dx
     1040!
     1041!--             -1.0 for right-facing wall, 1.0 for left-facing wall
     1042                sign_dir = MERGE( 1.0_wp, -1.0_wp,                             &
     1043                                  BTEST( wall_flags_0(k,j,i-1), 0 ) )
     1044                dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
     1045                dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
     1046             ENDDO
     1047!
     1048!--          Natural surfaces
     1049             surf_s = surf_lsm_v(l)%start_index(j,i)
     1050             surf_e = surf_lsm_v(l)%end_index(j,i)
     1051             DO  m = surf_s, surf_e
     1052                k           = surf_lsm_v(l)%k(m)
     1053                vsus        = surf_lsm_v(l)%mom_flux_tke(0,m)
     1054                wsus        = surf_lsm_v(l)%mom_flux_tke(1,m)
     1055
     1056                km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp            &
     1057                                   * 0.5_wp * dx
     1058!
     1059!--             -1.0 for right-facing wall, 1.0 for left-facing wall
     1060                sign_dir = MERGE( 1.0_wp, -1.0_wp,                             &
     1061                                  BTEST( wall_flags_0(k,j,i-1), 0 ) )
     1062                dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
     1063                dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
     1064             ENDDO
     1065!
     1066!--          Urban surfaces
     1067             surf_s = surf_usm_v(l)%start_index(j,i)
     1068             surf_e = surf_usm_v(l)%end_index(j,i)
     1069             DO  m = surf_s, surf_e
     1070                k           = surf_usm_v(l)%k(m)
     1071                vsus        = surf_usm_v(l)%mom_flux_tke(0,m)
     1072                wsus        = surf_usm_v(l)%mom_flux_tke(1,m)
     1073
     1074                km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp            &
     1075                                   * 0.5_wp * dx
     1076!
     1077!--             -1.0 for right-facing wall, 1.0 for left-facing wall
     1078                sign_dir = MERGE( 1.0_wp, -1.0_wp,                             &
     1079                                  BTEST( wall_flags_0(k,j,i-1), 0 ) )
     1080                dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
     1081                dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
     1082             ENDDO
     1083          ENDDO
     1084!
     1085!--       Compute gradients at upward-facing walls, first for
     1086!--       non-natural default surfaces
     1087          surf_s = surf_def_h(0)%start_index(j,i)
     1088          surf_e = surf_def_h(0)%end_index(j,i)
     1089          DO  m = surf_s, surf_e
     1090             k = surf_def_h(0)%k(m)
     1091!
     1092!--          Please note, actually, an interpolation of u_0 and v_0
     1093!--          onto the grid center would be required. However, this
     1094!--          would require several data transfers between 2D-grid and
     1095!--          wall type. The effect of this missing interpolation is
     1096!--          negligible. (See also production_e_init).
     1097             dudz(k)     = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)   
     1098             dvdz(k)     = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
     1099
     1100          ENDDO
     1101!
     1102!--       Natural surfaces
     1103          surf_s = surf_lsm_h%start_index(j,i)
     1104          surf_e = surf_lsm_h%end_index(j,i)
     1105          DO  m = surf_s, surf_e
     1106             k = surf_lsm_h%k(m)
     1107!
     1108!--          Please note, actually, an interpolation of u_0 and v_0
     1109!--          onto the grid center would be required. However, this
     1110!--          would require several data transfers between 2D-grid and
     1111!--          wall type. The effect of this missing interpolation is
     1112!--          negligible. (See also production_e_init).
     1113             dudz(k)     = ( u(k+1,j,i) - surf_lsm_h%u_0(m) ) * dd2zu(k)   
     1114             dvdz(k)     = ( v(k+1,j,i) - surf_lsm_h%v_0(m) ) * dd2zu(k)
     1115          ENDDO
     1116!
     1117!--       Urban surfaces
     1118          surf_s = surf_usm_h%start_index(j,i)
     1119          surf_e = surf_usm_h%end_index(j,i)
     1120          DO  m = surf_s, surf_e
     1121             k = surf_usm_h%k(m)
     1122!
     1123!--          Please note, actually, an interpolation of u_0 and v_0
     1124!--          onto the grid center would be required. However, this
     1125!--          would require several data transfers between 2D-grid and
     1126!--          wall type. The effect of this missing interpolation is
     1127!--          negligible. (See also production_e_init).
     1128             dudz(k)     = ( u(k+1,j,i) - surf_usm_h%u_0(m) ) * dd2zu(k)   
     1129             dvdz(k)     = ( v(k+1,j,i) - surf_usm_h%v_0(m) ) * dd2zu(k)
     1130          ENDDO
     1131!
     1132!--       Compute gradients at downward-facing walls, only for
     1133!--       non-natural default surfaces
     1134          surf_s = surf_def_h(1)%start_index(j,i)
     1135          surf_e = surf_def_h(1)%end_index(j,i)
     1136          DO  m = surf_s, surf_e
     1137             k = surf_def_h(1)%k(m)
     1138!
     1139!--          Please note, actually, an interpolation of u_0 and v_0
     1140!--          onto the grid center would be required. However, this
     1141!--          would require several data transfers between 2D-grid and
     1142!--          wall type. The effect of this missing interpolation is
     1143!--          negligible. (See also production_e_init).
     1144             dudz(k)     = ( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)   
     1145             dvdz(k)     = ( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
     1146
     1147          ENDDO
     1148
     1149          DO  k = nzb+1, nzt
     1150
     1151             def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) +         &
     1152                              dudy(k)**2 + dvdx(k)**2 + dwdx(k)**2   +         &
     1153                              dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2   +         &
     1154                   2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) + dwdy(k)*dvdz(k) )
     1155
     1156             IF ( def < 0.0_wp )  def = 0.0_wp
     1157
     1158             flag  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     1159
     1160             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
     1161
     1162          ENDDO
     1163
     1164       ELSEIF ( use_surface_fluxes )  THEN
     1165!
     1166!--       Calculate TKE production by shear. Here, no additional
     1167!--       wall-bounded code is considered.
     1168!--       Why?
     1169          DO  k = nzb+1, nzt
     1170
     1171             dudx(k)  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
     1172             dudy(k)  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) -                &
     1173                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
     1174             dudz(k)  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) -                &
     1175                                    u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
     1176
     1177             dvdx(k)  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) -                &
     1178                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
     1179             dvdy(k)  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
     1180             dvdz(k)  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) -                &
     1181                                    v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
     1182
     1183             dwdx(k)  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) -                &
     1184                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
     1185             dwdy(k)  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) -                &
     1186                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
     1187             dwdz(k)  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
     1188
     1189             def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) +         &
     1190                              dudy(k)**2 + dvdx(k)**2 + dwdx(k)**2   +         &
     1191                              dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2   +         &
     1192                   2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) + dwdy(k)*dvdz(k) )
     1193
     1194             IF ( def < 0.0_wp )  def = 0.0_wp
     1195
     1196             flag        = MERGE( 1.0_wp, 0.0_wp,                              &
     1197                                  BTEST( wall_flags_0(k,j,i), 29 ) )
     1198             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
     1199
     1200          ENDDO
     1201
     1202       ENDIF
     1203
     1204!
     1205!--    If required, calculate TKE production by buoyancy
     1206       IF ( .NOT. neutral )  THEN
     1207
     1208          IF ( .NOT. humidity )  THEN
     1209
     1210             IF ( use_single_reference_value )  THEN
     1211
     1212                IF ( ocean )  THEN
     1213!
     1214!--                So far in the ocean no special treatment of density flux in
     1215!--                the bottom and top surface layer
     1216                   DO  k = nzb+1, nzt
     1217                      tend(k,j,i) = tend(k,j,i) +                              &
     1218                                    kh(k,j,i) * g / rho_reference *            &
     1219                                    ( prho(k+1,j,i) - prho(k-1,j,i) ) *        &
     1220                                    dd2zu(k) *                                 &