Home


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

Changeset 1320 for palm/trunk


Ignore:
Timestamp:
Mar 20, 2014 8:40:49 AM (9 years ago)
Author:
raasch
Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

Location:
palm/trunk
Files:
163 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SCRIPTS/mrun

    r1310 r1320  
    2222# Current revisions:
    2323# ------------------
    24 #
     24# check namelist file set false by default
    2525#
    2626# Former revisions:
    … …  
    166166 archive_save=true
    167167 archive_system=none
    168  check_namelist_files=true
     168 check_namelist_files=false
    169169 combine_plot_fields=true
    170170 compiler_name=""

  • palm/trunk/SOURCE/Makefile

    r1319 r1320  
    2020# Current revisions:
    2121# ------------------
    22 #
     22# +mod_kinds in dependency list
    2323#
    2424# Former revisions:
    … …  
    170170        lpm_set_attributes.f90 lpm_sort_arrays.f90 \
    171171        lpm_write_exchange_statistics.f90 lpm_write_restart_file.f90 \
    172    ls_forcing.f90 message.f90 microphysics.f90 modules.f90 mod_kinds.f90 \
    173    netcdf.f90 nudging.f90 \
    174    package_parin.f90 palm.f90 parin.f90 plant_canopy_model.f90 poisfft.f90 \
     172        ls_forcing.f90 message.f90 microphysics.f90 modules.f90 mod_kinds.f90 \
     173        netcdf.f90 nudging.f90 \
     174        package_parin.f90 palm.f90 parin.f90 plant_canopy_model.f90 poisfft.f90 \
    175175        poismg.f90 prandtl_fluxes.f90 pres.f90 print_1d.f90 \
    176176        production_e.f90 prognostic_equations.f90 random_function.f90 \
    … …  
    224224
    225225
    226 advec_s_bc.o: modules.o cpulog.o
    227 advec_s_pw.o: modules.o
    228 advec_s_up.o: modules.o
    229 advec_u_pw.o: modules.o
    230 advec_u_up.o: modules.o
    231 advec_v_pw.o: modules.o
    232 advec_v_up.o: modules.o
    233 advec_ws.o: modules.o
    234 advec_w_pw.o: modules.o
    235 advec_w_up.o: modules.o
    236 average_3d_data.o: modules.o cpulog.o
    237 boundary_conds.o: modules.o
    238 buoyancy.o: modules.o
    239 calc_liquid_water_content.o: modules.o
    240 calc_precipitation.o: modules.o
    241 calc_radiation.o: modules.o
    242 calc_spectra.o: modules.o cpulog.o fft_xy.o
    243 check_for_restart.o: modules.o
    244 check_open.o: modules.o
    245 check_parameters.o: modules.o subsidence.o
    246 close_file.o: modules.o
    247 compute_vpt.o: modules.o
    248 coriolis.o: modules.o
    249 cpulog.o: modules.o
    250 cpu_statistics.o: modules.o
    251 cuda_fft_interfaces.o: cuda_fft_interfaces.f90 modules.o
    252 data_log.o: modules.o
    253 data_output_dvrp.o: modules.o cpulog.o
    254 data_output_mask.o: modules.o cpulog.o
    255 data_output_profiles.o: modules.o cpulog.o
    256 data_output_ptseries.o: modules.o cpulog.o
    257 data_output_spectra.o: modules.o cpulog.o
    258 data_output_tseries.o: modules.o cpulog.o
    259 data_output_2d.o: modules.o cpulog.o
    260 data_output_3d.o: modules.o cpulog.o
    261 diffusion_e.o: modules.o
    262 diffusion_s.o: modules.o
    263 diffusion_u.o: modules.o wall_fluxes.o
    264 diffusion_v.o: modules.o wall_fluxes.o
    265 diffusion_w.o: modules.o wall_fluxes.o
    266 diffusivities.o: modules.o
    267 disturb_field.o: modules.o cpulog.o random_function.o
    268 disturb_heatflux.o: modules.o
    269 eqn_state_seawater.o: modules.o
    270 exchange_horiz.o: modules.o cpulog.o
    271 exchange_horiz_2d.o: modules.o cpulog.o
    272 fft_xy.o: cuda_fft_interfaces.o modules.o singleton.o temperton_fft.o
    273 flow_statistics.o: modules.o cpulog.o
    274 global_min_max.o: modules.o
    275 header.o: modules.o cpulog.o subsidence.o
    276 impact_of_latent_heat.o: modules.o
    277 inflow_turbulence.o: modules.o cpulog.o
    278 init_1d_model.o: modules.o
    279 init_3d_model.o: modules.o cpulog.o random_function.o advec_ws.o ls_forcing.o
    280 init_advec.o: modules.o
    281 init_cloud_physics.o: modules.o
    282 init_coupling.o: modules.o
    283 init_dvrp.o: modules.o
    284 init_grid.o: modules.o
    285 init_masks.o: modules.o
    286 init_ocean.o: modules.o eqn_state_seawater.o
    287 init_pegrid.o: modules.o
    288 init_pt_anomaly.o: modules.o
    289 init_rankine.o: modules.o
    290 init_slope.o: modules.o
    291 interaction_droplets_ptq.o: modules.o
    292 local_getenv.o: modules.o
    293 local_stop.o: modules.o
    294 local_tremain.o: modules.o cpulog.o
    295 local_tremain_ini.o: modules.o cpulog.o
    296 lpm.o: modules.o cpulog.o
    297 lpm_advec.o: modules.o
    298 lpm_boundary_conds.o: modules.o cpulog.o
    299 lpm_calc_liquid_water_content.o: modules.o cpulog.o
    300 lpm_collision_kernels.o: modules.o cpulog.o user_module.o
    301 lpm_data_output_particles.o: modules.o cpulog.o
    302 lpm_droplet_collision.o: modules.o cpulog.o lpm_collision_kernels.o
    303 lpm_droplet_condensation.o: modules.o cpulog.o lpm_collision_kernels.o
    304 lpm_exchange_horiz.o: modules.o cpulog.o
    305 lpm_extend_particle_array.o: modules.o
    306 lpm_extend_tails.o: modules.o
    307 lpm_extend_tail_array.o: modules.o
    308 lpm_init.o: modules.o lpm_collision_kernels.o random_function.o
    309 lpm_init_sgs_tke.o: modules.o
    310 lpm_pack_arrays.o: modules.o
    311 lpm_read_restart_file.o: modules.o
    312 lpm_release_set.o: modules.o random_function.o
    313 lpm_set_attributes.o: modules.o cpulog.o
    314 lpm_sort_arrays.o: modules.o cpulog.o
    315 lpm_write_exchange_statistics.o: modules.o
    316 lpm_write_restart_file.o: modules.o
    317 ls_forcing.o: modules.o cpulog.o
    318 message.o: modules.o
    319 microphysics.o: modules.o
    320 modules.o: modules.f90
    321 netcdf.o: modules.o
    322 nudging.o: modules.o buoyancy.o cpulog.o
    323 package_parin.o: modules.o
    324 palm.o: modules.o cpulog.o ls_forcing.o nudging.o
    325 parin.o: modules.o cpulog.o
    326 plant_canopy_model.o: modules.o
    327 poisfft.o: modules.o cpulog.o fft_xy.o tridia_solver.o
    328 poismg.o: modules.o cpulog.o
    329 prandtl_fluxes.o: modules.o
    330 pres.o: modules.o cpulog.o poisfft.o
    331 print_1d.o: modules.o cpulog.o
    332 production_e.o: modules.o wall_fluxes.o
     226advec_s_bc.o: modules.o cpulog.o mod_kinds.o
     227advec_s_pw.o: modules.o mod_kinds.o
     228advec_s_up.o: modules.o mod_kinds.o
     229advec_u_pw.o: modules.o mod_kinds.o
     230advec_u_up.o: modules.o mod_kinds.o
     231advec_v_pw.o: modules.o mod_kinds.o
     232advec_v_up.o: modules.o mod_kinds.o
     233advec_ws.o: modules.o mod_kinds.o
     234advec_w_pw.o: modules.o mod_kinds.o
     235advec_w_up.o: modules.o mod_kinds.o
     236average_3d_data.o: modules.o cpulog.o mod_kinds.o
     237boundary_conds.o: modules.o mod_kinds.o
     238buoyancy.o: modules.o mod_kinds.o
     239calc_liquid_water_content.o: modules.o mod_kinds.o
     240calc_precipitation.o: modules.o mod_kinds.o
     241calc_radiation.o: modules.o mod_kinds.o
     242calc_spectra.o: modules.o cpulog.o fft_xy.o mod_kinds.o
     243check_for_restart.o: modules.o mod_kinds.o
     244check_open.o: modules.o mod_kinds.o
     245check_parameters.o: modules.o mod_kinds.o subsidence.o
     246close_file.o: modules.o mod_kinds.o
     247compute_vpt.o: modules.o mod_kinds.o
     248coriolis.o: modules.o mod_kinds.o
     249cpulog.o: modules.o mod_kinds.o
     250cpu_statistics.o: modules.o mod_kinds.o
     251cuda_fft_interfaces.o: cuda_fft_interfaces.f90 modules.o mod_kinds.o
     252data_log.o: modules.o mod_kinds.o
     253data_output_dvrp.o: modules.o cpulog.o mod_kinds.o
     254data_output_mask.o: modules.o cpulog.o mod_kinds.o
     255data_output_profiles.o: modules.o cpulog.o mod_kinds.o
     256data_output_ptseries.o: modules.o cpulog.o mod_kinds.o
     257data_output_spectra.o: modules.o cpulog.o mod_kinds.o
     258data_output_tseries.o: modules.o cpulog.o mod_kinds.o
     259data_output_2d.o: modules.o cpulog.o mod_kinds.o
     260data_output_3d.o: modules.o cpulog.o mod_kinds.o
     261diffusion_e.o: modules.o mod_kinds.o
     262diffusion_s.o: modules.o mod_kinds.o
     263diffusion_u.o: modules.o mod_kinds.o wall_fluxes.o
     264diffusion_v.o: modules.o mod_kinds.o wall_fluxes.o
     265diffusion_w.o: modules.o mod_kinds.o wall_fluxes.o
     266diffusivities.o: modules.o mod_kinds.o
     267disturb_field.o: modules.o cpulog.o mod_kinds.o random_function.o
     268disturb_heatflux.o: modules.o mod_kinds.o
     269eqn_state_seawater.o: modules.o mod_kinds.o
     270exchange_horiz.o: modules.o cpulog.o mod_kinds.o
     271exchange_horiz_2d.o: modules.o cpulog.o mod_kinds.o
     272fft_xy.o: cuda_fft_interfaces.o modules.o mod_kinds.o singleton.o temperton_fft.o
     273flow_statistics.o: modules.o cpulog.o mod_kinds.o
     274global_min_max.o: modules.o mod_kinds.o
     275header.o: modules.o cpulog.o mod_kinds.o subsidence.o
     276impact_of_latent_heat.o: modules.o mod_kinds.o
     277inflow_turbulence.o: modules.o cpulog.o mod_kinds.o
     278init_1d_model.o: modules.o mod_kinds.o
     279init_3d_model.o: modules.o cpulog.o mod_kinds.o random_function.o advec_ws.o ls_forcing.o
     280init_advec.o: modules.o mod_kinds.o
     281init_cloud_physics.o: modules.o mod_kinds.o
     282init_coupling.o: modules.o mod_kinds.o
     283init_dvrp.o: modules.o mod_kinds.o
     284init_grid.o: modules.o mod_kinds.o
     285init_masks.o: modules.o mod_kinds.o
     286init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o
     287init_pegrid.o: modules.o mod_kinds.o
     288init_pt_anomaly.o: modules.o mod_kinds.o
     289init_rankine.o: modules.o mod_kinds.o
     290init_slope.o: modules.o mod_kinds.o
     291interaction_droplets_ptq.o: modules.o mod_kinds.o
     292local_flush.o: mod_kinds.o
     293local_getenv.o: modules.o mod_kinds.o
     294local_stop.o: modules.o mod_kinds.o
     295local_tremain.o: modules.o cpulog.o mod_kinds.o
     296local_tremain_ini.o: modules.o cpulog.o mod_kinds.o
     297lpm.o: modules.o cpulog.o mod_kinds.o
     298lpm_advec.o: modules.o mod_kinds.o
     299lpm_boundary_conds.o: modules.o cpulog.o mod_kinds.o
     300lpm_calc_liquid_water_content.o: modules.o cpulog.o mod_kinds.o
     301lpm_collision_kernels.o: modules.o cpulog.o user_module.o mod_kinds.o
     302lpm_data_output_particles.o: modules.o cpulog.o mod_kinds.o
     303lpm_droplet_collision.o: modules.o cpulog.o lpm_collision_kernels.o mod_kinds.o
     304lpm_droplet_condensation.o: modules.o cpulog.o lpm_collision_kernels.o mod_kinds.o
     305lpm_exchange_horiz.o: modules.o cpulog.o mod_kinds.o
     306lpm_extend_particle_array.o: modules.o mod_kinds.o
     307lpm_extend_tails.o: modules.o mod_kinds.o
     308lpm_extend_tail_array.o: modules.o mod_kinds.o
     309lpm_init.o: modules.o lpm_collision_kernels.o mod_kinds.o random_function.o
     310lpm_init_sgs_tke.o: modules.o mod_kinds.o
     311lpm_pack_arrays.o: modules.o mod_kinds.o
     312lpm_read_restart_file.o: modules.o mod_kinds.o
     313lpm_release_set.o: modules.o mod_kinds.o random_function.o
     314lpm_set_attributes.o: modules.o cpulog.o mod_kinds.o
     315lpm_sort_arrays.o: modules.o cpulog.o mod_kinds.o
     316lpm_write_exchange_statistics.o: modules.o mod_kinds.o
     317lpm_write_restart_file.o: modules.o mod_kinds.o
     318ls_forcing.o: modules.o cpulog.o mod_kinds.o
     319message.o: modules.o mod_kinds.o
     320microphysics.o: modules.o mod_kinds.o
     321modules.o: modules.f90 mod_kinds.o
     322mod_kinds.o: mod_kinds.f90
     323netcdf.o: modules.o mod_kinds.o
     324nudging.o: modules.o buoyancy.o cpulog.o mod_kinds.o
     325package_parin.o: modules.o mod_kinds.o
     326palm.o: modules.o cpulog.o ls_forcing.o mod_kinds.o nudging.o
     327parin.o: modules.o cpulog.o mod_kinds.o
     328plant_canopy_model.o: modules.o mod_kinds.o
     329poisfft.o: modules.o cpulog.o fft_xy.o mod_kinds.o tridia_solver.o
     330poismg.o: modules.o cpulog.o mod_kinds.o
     331prandtl_fluxes.o: modules.o mod_kinds.o
     332pres.o: modules.o cpulog.o mod_kinds.o poisfft.o
     333print_1d.o: modules.o cpulog.o mod_kinds.o
     334production_e.o: modules.o mod_kinds.o wall_fluxes.o
    333335prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_u_pw.o \
    334336        advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o  \
    335337   advec_ws.o buoyancy.o calc_precipitation.o calc_radiation.o coriolis.o \
    336338        cpulog.o diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
    337         eqn_state_seawater.o impact_of_latent_heat.o microphysics.o \
     339        eqn_state_seawater.o impact_of_latent_heat.o mod_kinds.o microphysics.o \
    338340        nudging.o plant_canopy_model.o production_e.o subsidence.o user_actions.o
    339 random_gauss.o: random_function.o
    340 read_3d_binary.o: modules.o cpulog.o random_function.o
    341 read_var_list.o: modules.o
    342 run_control.o: modules.o cpulog.o
    343 set_slicer_attributes_dvrp.o: modules.o
    344 singleton.o: singleton.f90
    345 sor.o: modules.o
    346 subsidence.o: modules.o
    347 sum_up_3d_data.o: modules.o cpulog.o
    348 surface_coupler.o: modules.o cpulog.o
    349 swap_timelevel.o: modules.o cpulog.o
    350 temperton_fft.o: modules.o
     341random_function.o: mod_kinds.o
     342random_gauss.o: mod_kinds.o random_function.o
     343read_3d_binary.o: modules.o cpulog.o mod_kinds.o random_function.o
     344read_var_list.o: modules.o mod_kinds.o
     345run_control.o: modules.o cpulog.o mod_kinds.o
     346set_slicer_attributes_dvrp.o: modules.o mod_kinds.o
     347singleton.o: mod_kinds.o singleton.f90
     348sor.o: modules.o mod_kinds.o
     349subsidence.o: modules.o mod_kinds.o
     350sum_up_3d_data.o: modules.o cpulog.o mod_kinds.o
     351surface_coupler.o: modules.o cpulog.o mod_kinds.o
     352swap_timelevel.o: modules.o cpulog.o mod_kinds.o
     353temperton_fft.o: modules.o mod_kinds.o
    351354time_integration.o: modules.o advec_ws.o buoyancy.o cpulog.o interaction_droplets_ptq.o \
    352         ls_forcing.o production_e.o prognostic_equations.o user_actions.o
    353 timestep.o: modules.o cpulog.o
    354 timestep_scheme_steering.o: modules.o
    355 transpose.o: modules.o cpulog.o
    356 tridia_solver.o: modules.o
    357 user_3d_data_averaging.o: modules.o user_module.o
    358 user_actions.o: modules.o cpulog.o user_module.o
    359 user_additional_routines.o: modules.o user_module.o
    360 user_check_data_output.o: modules.o user_module.o
    361 user_check_data_output_pr.o: modules.o user_module.o
    362 user_check_parameters.o: modules.o user_module.o
    363 user_data_output_2d.o: modules.o user_module.o
    364 user_data_output_3d.o: modules.o user_module.o
    365 user_data_output_mask.o: modules.o user_module.o
    366 user_data_output_dvrp.o: modules.o user_module.o
    367 user_define_netcdf_grid.o: modules.o user_module.o
    368 user_dvrp_coltab.o: modules.o user_module.o
    369 user_header.o: modules.o user_module.o
    370 user_init.o: modules.o user_module.o
    371 user_init_3d_model.o: modules.o user_module.o
    372 user_init_grid.o: modules.o user_module.o
    373 user_init_plant_canopy.o: modules.o user_module.o
    374 user_last_actions.o: modules.o user_module.o
    375 user_lpm_advec.o: modules.o user_module.o
    376 user_lpm_init.o: modules.o user_module.o
    377 user_lpm_set_attributes.o: modules.o user_module.o
    378 user_module.o: user_module.f90
    379 user_parin.o: modules.o user_module.o
    380 user_read_restart_data.o: modules.o user_module.o
    381 user_spectra.o: modules.o user_module.o
    382 user_statistics.o: modules.o user_module.o
    383 wall_fluxes.o: modules.o
    384 write_3d_binary.o: modules.o cpulog.o random_function.o
    385 write_compressed.o: modules.o
    386 write_var_list.o: modules.o
     355        ls_forcing.o mod_kinds.o production_e.o prognostic_equations.o user_actions.o
     356time_to_string.o: mod_kinds.o
     357timestep.o: modules.o cpulog.o mod_kinds.o
     358timestep_scheme_steering.o: modules.o mod_kinds.o
     359transpose.o: modules.o cpulog.o mod_kinds.o
     360tridia_solver.o: modules.o mod_kinds.o
     361user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o
     362user_actions.o: modules.o cpulog.o mod_kinds.o user_module.o
     363user_additional_routines.o: modules.o mod_kinds.o user_module.o
     364user_check_data_output.o: modules.o mod_kinds.o user_module.o
     365user_check_data_output_pr.o: modules.o mod_kinds.o user_module.o
     366user_check_parameters.o: modules.o mod_kinds.o user_module.o
     367user_data_output_2d.o: modules.o mod_kinds.o user_module.o
     368user_data_output_3d.o: modules.o mod_kinds.o user_module.o
     369user_data_output_mask.o: modules.o mod_kinds.o user_module.o
     370user_data_output_dvrp.o: modules.o mod_kinds.o user_module.o
     371user_define_netcdf_grid.o: modules.o mod_kinds.o user_module.o
     372user_dvrp_coltab.o: modules.o mod_kinds.o user_module.o
     373user_header.o: modules.o mod_kinds.o user_module.o
     374user_init.o: modules.o mod_kinds.o user_module.o
     375user_init_3d_model.o: modules.o mod_kinds.o user_module.o
     376user_init_grid.o: modules.o mod_kinds.o user_module.o
     377user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o
     378user_last_actions.o: modules.o mod_kinds.o user_module.o
     379user_lpm_advec.o: modules.o mod_kinds.o user_module.o
     380user_lpm_init.o: modules.o mod_kinds.o user_module.o
     381user_lpm_set_attributes.o: modules.o mod_kinds.o user_module.o
     382user_module.o: mod_kinds.o user_module.f90
     383user_parin.o: modules.o mod_kinds.o user_module.o
     384user_read_restart_data.o: modules.o mod_kinds.o user_module.o
     385user_spectra.o: modules.o mod_kinds.o user_module.o
     386user_statistics.o: modules.o mod_kinds.o user_module.o
     387wall_fluxes.o: modules.o mod_kinds.o
     388write_3d_binary.o: modules.o cpulog.o mod_kinds.o random_function.o
     389write_compressed.o: modules.o mod_kinds.o
     390write_var_list.o: modules.o mod_kinds.o

  • palm/trunk/SOURCE/Makefile_check

    r1310 r1320  
    2020# Current revisions:
    2121# ------------------
    22 #
     22# cpu_log renamed cpulog, + mod_kinds in dependency list
    2323#
    2424# Former revisions:
    … …  
    6969
    7070SOURCES = check_open.f90 check_namelist_files.f90 check_parameters.f90 \
    71       close_file.f90 cpu_log.f90 cuda_fft_interfaces.f90 exchange_horiz.f90 \
     71      close_file.f90 cpulog.f90 cuda_fft_interfaces.f90 exchange_horiz.f90 \
    7272      exchange_horiz_2d.f90 fft_xy.f90 init_grid.f90 init_masks.f90 \
    7373      init_cloud_physics.f90 init_pegrid.f90 local_flush.f90 local_stop.f90 \
    74       local_system.f90 message.f90 modules.f90 package_parin.f90 parin.f90 \
    75       poisfft.f90 random_function.f90 singleton.f90 \
     74      local_system.f90 message.f90 modules.f90 mod_kinds.f90 package_parin.f90 \
     75      parin.f90 poisfft.f90 random_function.f90 singleton.f90 \
    7676      subsidence.f90 temperton_fft.f90 tridia_solver.f90 \
    7777      user_3d_data_averaging.f90 user_actions.f90 \
    … …  
    115115
    116116
    117 check_open.o: modules.o
    118 check_namelist_files.o: modules.o
    119 check_parameters.o: modules.o subsidence.o
    120 close_file.o: modules.o
    121 cpu_log.o: modules.o
    122 cuda_fft_interfaces.o: cuda_fft_interfaces.f90
    123 exchange_horiz.o: modules.o
    124 exchange_horiz_2d.o: modules.o
    125 fft_xy.o: cuda_fft_interfaces.o modules.o singleton.o temperton_fft.o
    126 init_cloud_physics.o: modules.o
    127 init_grid.o: modules.o
    128 init_masks.o: modules.o
    129 init_pegrid.o: modules.o
    130 local_stop.o: modules.o
    131 message.o: modules.o
    132 modules.o: modules.f90
    133 package_parin.o: modules.o
    134 parin.o: modules.o
    135 poisfft.o: modules.o fft_xy.o tridia_solver.o
    136 random_function.o: modules.o
    137 singleton.o: singleton.f90
    138 subsidence.o: modules.o
    139 temperton_fft.o: modules.o
    140 tridia_solver.o: modules.o
    141 user_3d_data_averaging.o: modules.o user_module.o
    142 user_actions.o: modules.o user_module.o
    143 user_additional_routines.o: modules.o user_module.o
    144 user_check_data_output.o: modules.o user_module.o
    145 user_check_data_output_pr.o: modules.o user_module.o
    146 user_check_parameters.o: modules.o user_module.o
    147 user_data_output_2d.o: modules.o user_module.o
    148 user_data_output_3d.o: modules.o user_module.o
    149 user_data_output_mask.o: modules.o user_module.o
    150 user_data_output_dvrp.o: modules.o user_module.o
    151 user_define_netcdf_grid.o: modules.o user_module.o
    152 user_dvrp_coltab.o: modules.o user_module.o
    153 user_header.o: modules.o user_module.o
    154 user_init.o: modules.o user_module.o
    155 user_init_3d_model.o: modules.o user_module.o
    156 user_init_grid.o: modules.o user_module.o
    157 user_init_plant_canopy.o: modules.o user_module.o
    158 user_last_actions.o: modules.o user_module.o
    159 user_lpm_advec.o: modules.o user_module.o
    160 user_lpm_init.o: modules.o user_module.o
    161 user_lpm_set_attributes.o: modules.o user_module.o
    162 user_module.o: user_module.f90
    163 user_parin.o: modules.o user_module.o
    164 user_read_restart_data.o: modules.o user_module.o
    165 user_spectra.o: modules.o user_module.o
    166 user_statistics.o: modules.o user_module.o
     117check_open.o: modules.o mod_kinds.o
     118check_namelist_files.o: modules.o mod_kinds.o
     119check_parameters.o: modules.o mod_kinds.o subsidence.o
     120close_file.o: modules.o mod_kinds.o
     121cpulog.o: modules.o mod_kinds.o
     122cuda_fft_interfaces.o: cuda_fft_interfaces.f90 modules.o mod_kinds.o
     123exchange_horiz.o: modules.o cpulog.o mod_kinds.o
     124exchange_horiz_2d.o: modules.o cpulog.o mod_kinds.o
     125fft_xy.o: cuda_fft_interfaces.o modules.o mod_kinds.o singleton.o temperton_fft.o
     126init_cloud_physics.o: modules.o mod_kinds.o
     127init_grid.o: modules.o mod_kinds.o
     128init_masks.o: modules.o mod_kinds.o
     129init_pegrid.o: modules.o mod_kinds.o
     130local_flush.o: mod_kinds.o
     131local_stop.o: modules.o mod_kinds.o
     132message.o: modules.o mod_kinds.o
     133modules.o: modules.f90 mod_kinds.o
     134mod_kinds.o: mod_kinds.f90
     135package_parin.o: modules.o mod_kinds.o
     136parin.o: modules.o cpulog.o mod_kinds.o
     137poisfft.o: cpulog.o modules.o mod_kinds.o fft_xy.o tridia_solver.o
     138singleton.o: mod_kinds.o singleton.f90
     139subsidence.o: modules.o mod_kinds.o
     140temperton_fft.o: modules.o mod_kinds.o
     141tridia_solver.o: modules.o mod_kinds.o
     142user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o
     143user_actions.o: cpulog.o modules.o mod_kinds.o user_module.o
     144user_additional_routines.o: modules.o mod_kinds.o user_module.o
     145user_check_data_output.o: modules.o mod_kinds.o user_module.o
     146user_check_data_output_pr.o: modules.o mod_kinds.o user_module.o
     147user_check_parameters.o: modules.o mod_kinds.o user_module.o
     148user_data_output_2d.o: modules.o mod_kinds.o user_module.o
     149user_data_output_3d.o: modules.o mod_kinds.o user_module.o
     150user_data_output_mask.o: modules.o mod_kinds.o user_module.o
     151user_data_output_dvrp.o: modules.o mod_kinds.o user_module.o
     152user_define_netcdf_grid.o: modules.o mod_kinds.o user_module.o
     153user_dvrp_coltab.o: modules.o mod_kinds.o user_module.o
     154user_header.o: modules.o mod_kinds.o user_module.o
     155user_init.o: modules.o mod_kinds.o user_module.o
     156user_init_3d_model.o: modules.o mod_kinds.o user_module.o
     157user_init_grid.o: modules.o mod_kinds.o user_module.o
     158user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o
     159user_last_actions.o: modules.o mod_kinds.o user_module.o
     160user_lpm_advec.o: modules.o mod_kinds.o user_module.o
     161user_lpm_init.o: modules.o mod_kinds.o user_module.o
     162user_lpm_set_attributes.o: modules.o mod_kinds.o user_module.o
     163user_module.o: mod_kinds.o user_module.f90
     164user_parin.o: modules.o mod_kinds.o user_module.o
     165user_read_restart_data.o: modules.o mod_kinds.o user_module.o
     166user_spectra.o: modules.o mod_kinds.o user_module.o
     167user_statistics.o: modules.o mod_kinds.o user_module.o

  • palm/trunk/SOURCE/advec_s_bc.f90

    r1319 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    3742! 1010 2012-09-20 07:59:54Z raasch
    3843! cpp switch __nopointer added for pointer free version
    39 !
    40 ! 622 2010-12-10 08:08:13Z raasch
    41 ! optional barriers included in order to speed up collective operations
    42 !
    43 ! 247 2009-02-27 14:01:30Z heinze
    44 ! Output of messages replaced by message handling routine
    45 !
    46 ! 216 2008-11-25 07:12:43Z raasch
    47 ! Neumann boundary condition at k=nzb is explicitly set for better reading,
    48 ! although this has been already done in boundary_conds
    49 !
    50 ! 97 2007-06-21 08:23:15Z raasch
    51 ! Advection of salinity included
    52 ! Bugfix: Error in boundary condition for TKE removed
    53 !
    54 ! 63 2007-03-13 03:52:49Z raasch
    55 ! Calculation extended for gridpoint nzt
    56 !
    57 ! RCS Log replace by Id keyword, revision history cleaned up
    58 !
    59 ! Revision 1.22  2006/02/23 09:42:08  raasch
    60 ! anz renamed ngp
    6144!
    6245! Revision 1.1  1997/08/29 08:53:46  raasch
    … …  
    7760!------------------------------------------------------------------------------!
    7861
    79     USE advection
    80     USE arrays_3d
    81     USE control_parameters
    82     USE cpulog
    83     USE grid_variables
    84     USE indices
     62    USE advection,                                                             &
     63        ONLY:  aex, bex, dex, eex
     64
     65    USE arrays_3d,                                                             &
     66        ONLY:  d, ddzw, dzu, dzw, tend, u, v, w
     67
     68    USE control_parameters,                                                    &
     69        ONLY:  dt_3d, bc_pt_t_val, bc_q_t_val, ibc_pt_b, ibc_pt_t, ibc_q_t,    &
     70               message_string, pt_slope_offset, sloping_surface, u_gtrans,     &
     71               v_gtrans
     72
     73    USE cpulog,                                                                &
     74        ONLY:  cpu_log, log_point_s
     75
     76    USE grid_variables,                                                        &
     77        ONLY:  ddx, ddy
     78
     79    USE indices,                                                               &
     80        ONLY:  nx, nxl, nxr, nyn, nys, nzb, nzt
     81
     82    USE kinds
     83
    8584    USE pegrid
    86     USE statistics
     85
     86    USE statistics,                                                            &
     87        ONLY:  rmask, statistic_regions, sums_wsts_bc_l
     88
    8789
    8890    IMPLICIT NONE
    8991
    90     CHARACTER (LEN=*) ::  sk_char
    91 
    92     INTEGER ::  i, ix, j, k, ngp, sr, type_xz_2
    93 
    94     REAL ::  cim, cimf, cip, cipf, d_new, fminus, fplus, f2, f4, f8,        &
    95              f12, f24, f48, f1920, im, ip, m2, m3, nenner, snenn, sterm,    &
    96              tendenz, t1, t2, zaehler
    97     REAL ::  fmax(2), fmax_l(2)
     92    CHARACTER (LEN=*) ::  sk_char !:
     93
     94    INTEGER(iwp) ::  i         !:
     95    INTEGER(iwp) ::  ix        !:
     96    INTEGER(iwp) ::  j         !:
     97    INTEGER(iwp) ::  k         !:
     98    INTEGER(iwp) ::  ngp       !:
     99    INTEGER(iwp) ::  sr        !:
     100    INTEGER(iwp) ::  type_xz_2 !:
     101
     102    REAL(wp) ::  cim    !:
     103    REAL(wp) ::  cimf   !:
     104    REAL(wp) ::  cip    !:
     105    REAL(wp) ::  cipf   !:
     106    REAL(wp) ::  d_new  !:
     107    REAL(wp) ::  denomi !: denominator
     108    REAL(wp) ::  fminus !:
     109    REAL(wp) ::  fplus  !:
     110    REAL(wp) ::  f2     !:
     111    REAL(wp) ::  f4     !:
     112    REAL(wp) ::  f8     !:
     113    REAL(wp) ::  f12    !:
     114    REAL(wp) ::  f24    !:
     115    REAL(wp) ::  f48    !:
     116    REAL(wp) ::  f1920  !:
     117    REAL(wp) ::  im     !:
     118    REAL(wp) ::  ip     !:
     119    REAL(wp) ::  m2     !:
     120    REAL(wp) ::  m3     !:
     121    REAL(wp) ::  numera !: numerator
     122    REAL(wp) ::  snenn  !:
     123    REAL(wp) ::  sterm  !:
     124    REAL(wp) ::  tendcy !:
     125    REAL(wp) ::  t1     !:
     126    REAL(wp) ::  t2     !:
     127
     128    REAL(wp) ::  fmax(2)   !:
     129    REAL(wp) ::  fmax_l(2) !:
     130   
    98131#if defined( __nopointer )
    99     REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     132    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    100133#else
    101     REAL, DIMENSION(:,:,:), POINTER ::  sk
     134    REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
    102135#endif
    103136
    104     REAL, DIMENSION(:,:), ALLOCATABLE ::  a0, a1, a12, a2, a22, immb, imme,  &
    105                                           impb, impe, ipmb, ipme, ippb, ippe
    106     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  sk_p
     137    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a0   !:
     138    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a1   !:
     139    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a12  !:
     140    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a2   !:
     141    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a22  !:
     142    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  immb !:
     143    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  imme !:
     144    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  impb !:
     145    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  impe !:
     146    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ipmb !:
     147    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ipme !:
     148    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ippb !:
     149    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ippe !:
     150   
     151    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  sk_p !:
    107152
    108153#if defined( __nec )
    109     REAL (kind=4) ::  m1n, m1z  !Wichtig: Division
    110     REAL (kind=4), DIMENSION(:,:), ALLOCATABLE :: m1, sw
     154    REAL(sp) ::  m1n, m1z  !Wichtig: Division !:
     155    REAL(sp), DIMENSION(:,:), ALLOCATABLE :: m1, sw !:
    111156#else
    112     REAL ::  m1n, m1z
    113     REAL, DIMENSION(:,:), ALLOCATABLE :: m1, sw
     157    REAL(wp) ::  m1n, m1z
     158    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m1, sw
    114159#endif
    115160
    … …  
    148193!
    149194!-- Send left boundary, receive right boundary
    150     CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxl+1), ngp, MPI_REAL, pleft,  0, &
    151                        sk_p(nzb-2,nys-3,nxr+2), ngp, MPI_REAL, pright, 0, &
     195    CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxl+1), ngp, MPI_REAL, pleft,  0,      &
     196                       sk_p(nzb-2,nys-3,nxr+2), ngp, MPI_REAL, pright, 0,      &
    152197                       comm2d, status, ierr )
    153198!
    154199!-- Send right boundary, receive left boundary
    155     CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxr-2), ngp, MPI_REAL, pright, 1, &
    156                        sk_p(nzb-2,nys-3,nxl-3), ngp, MPI_REAL, pleft,  1, &
     200    CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxr-2), ngp, MPI_REAL, pright, 1,      &
     201                       sk_p(nzb-2,nys-3,nxl-3), ngp, MPI_REAL, pleft,  1,      &
    157202                       comm2d, status, ierr )
    158203    CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
    … …  
    192237       DO  j = nys, nyn
    193238          DO  k = nzb+1, nzt
    194              zaehler = ABS( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) + sk_p(k,j,i-1) )
    195              nenner  = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
    196              fmax_l(1) = MAX( fmax_l(1) , zaehler )
    197              fmax_l(2) = MAX( fmax_l(2) , nenner  )
     239             numera = ABS( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) + sk_p(k,j,i-1) )
     240             denomi  = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
     241             fmax_l(1) = MAX( fmax_l(1) , numera )
     242             fmax_l(2) = MAX( fmax_l(2) , denomi  )
    198243          ENDDO
    199244       ENDDO
    … …  
    210255!
    211256!-- Allocate temporary arrays
    212     ALLOCATE( a0(nzb+1:nzt,nxl-1:nxr+1),   a1(nzb+1:nzt,nxl-1:nxr+1),   &
    213               a2(nzb+1:nzt,nxl-1:nxr+1),   a12(nzb+1:nzt,nxl-1:nxr+1),  &
    214               a22(nzb+1:nzt,nxl-1:nxr+1),  immb(nzb+1:nzt,nxl-1:nxr+1), &
    215               imme(nzb+1:nzt,nxl-1:nxr+1), impb(nzb+1:nzt,nxl-1:nxr+1), &
    216               impe(nzb+1:nzt,nxl-1:nxr+1), ipmb(nzb+1:nzt,nxl-1:nxr+1), &
    217               ipme(nzb+1:nzt,nxl-1:nxr+1), ippb(nzb+1:nzt,nxl-1:nxr+1), &
    218               ippe(nzb+1:nzt,nxl-1:nxr+1), m1(nzb+1:nzt,nxl-2:nxr+2),   &
    219               sw(nzb+1:nzt,nxl-1:nxr+1)                                 &
     257    ALLOCATE( a0(nzb+1:nzt,nxl-1:nxr+1),   a1(nzb+1:nzt,nxl-1:nxr+1),          &
     258              a2(nzb+1:nzt,nxl-1:nxr+1),   a12(nzb+1:nzt,nxl-1:nxr+1),         &
     259              a22(nzb+1:nzt,nxl-1:nxr+1),  immb(nzb+1:nzt,nxl-1:nxr+1),        &
     260              imme(nzb+1:nzt,nxl-1:nxr+1), impb(nzb+1:nzt,nxl-1:nxr+1),        &
     261              impe(nzb+1:nzt,nxl-1:nxr+1), ipmb(nzb+1:nzt,nxl-1:nxr+1),        &
     262              ipme(nzb+1:nzt,nxl-1:nxr+1), ippb(nzb+1:nzt,nxl-1:nxr+1),        &
     263              ippe(nzb+1:nzt,nxl-1:nxr+1), m1(nzb+1:nzt,nxl-2:nxr+2),          &
     264              sw(nzb+1:nzt,nxl-1:nxr+1)                                        &
    220265            )
    221266    imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
    … …  
    236281          DO  k = nzb+1, nzt
    237282             a12(k,i) = 0.5 * ( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
    238              a22(k,i) = 0.5 * ( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) &
     283             a22(k,i) = 0.5 * ( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i)              &
    239284                                              + sk_p(k,j,i-1) )
    240              a0(k,i) = ( 9.0 * sk_p(k,j,i+2) - 116.0 * sk_p(k,j,i+1)    &
    241                          + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j,i-1) &
     285             a0(k,i) = ( 9.0 * sk_p(k,j,i+2) - 116.0 * sk_p(k,j,i+1)           &
     286                         + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j,i-1)        &
    242287                         + 9.0 * sk_p(k,j,i-2) ) * f1920
    243              a1(k,i) = ( -5.0 * sk_p(k,j,i+2) + 34.0 * sk_p(k,j,i+1)  &
    244                          - 34.0 * sk_p(k,j,i-1) + 5.0 * sk_p(k,j,i-2) &
     288             a1(k,i) = ( -5.0 * sk_p(k,j,i+2) + 34.0 * sk_p(k,j,i+1)           &
     289                         - 34.0 * sk_p(k,j,i-1) + 5.0 * sk_p(k,j,i-2)          &
    245290                       ) * f48
    246              a2(k,i) = ( -3.0 * sk_p(k,j,i+2) + 36.0 * sk_p(k,j,i+1) &
    247                          - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j,i-1) &
     291             a2(k,i) = ( -3.0 * sk_p(k,j,i+2) + 36.0 * sk_p(k,j,i+1)           &
     292                         - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j,i-1)           &
    248293                         - 3.0 * sk_p(k,j,i-2) ) * f48
    249294          ENDDO
    … …  
    259304             cipf = 1.0 - 2.0 * cip
    260305             cimf = 1.0 - 2.0 * cim
    261              ip   =   a0(k,i)   * f2  * ( 1.0 - cipf )             &
    262                     + a1(k,i)   * f8  * ( 1.0 - cipf*cipf )        &
     306             ip   =   a0(k,i)   * f2  * ( 1.0 - cipf )                         &
     307                    + a1(k,i)   * f8  * ( 1.0 - cipf*cipf )                    &
    263308                    + a2(k,i)   * f24 * ( 1.0 - cipf*cipf*cipf )
    264              im   =   a0(k,i+1) * f2  * ( 1.0 - cimf )             &
    265                     - a1(k,i+1) * f8  * ( 1.0 - cimf*cimf )        &
     309             im   =   a0(k,i+1) * f2  * ( 1.0 - cimf )                         &
     310                    - a1(k,i+1) * f8  * ( 1.0 - cimf*cimf )                    &
    266311                    + a2(k,i+1) * f24 * ( 1.0 - cimf*cimf*cimf )
    267312             ip   = MAX( ip, 0.0 )
    … …  
    274319             cipf = 1.0 - 2.0 * cip
    275320             cimf = 1.0 - 2.0 * cim
    276              ip   =   a0(k,i-1) * f2  * ( 1.0 - cipf )             &
    277                     + a1(k,i-1) * f8  * ( 1.0 - cipf*cipf )        &
     321             ip   =   a0(k,i-1) * f2  * ( 1.0 - cipf )                         &
     322                    + a1(k,i-1) * f8  * ( 1.0 - cipf*cipf )                    &
    278323                    + a2(k,i-1) * f24 * ( 1.0 - cipf*cipf*cipf )
    279              im   =   a0(k,i)   * f2  * ( 1.0 - cimf )             &
    280                     - a1(k,i)   * f8  * ( 1.0 - cimf*cimf )        &
     324             im   =   a0(k,i)   * f2  * ( 1.0 - cimf )                         &
     325                    - a1(k,i)   * f8  * ( 1.0 - cimf*cimf )                    &
    281326                    + a2(k,i)   * f24 * ( 1.0 - cimf*cimf*cimf )
    282327             ip   = MAX( ip, 0.0 )
    … …  
    309354       DO  i = nxl-1, nxr+1
    310355          DO  k = nzb+1, nzt
    311              m2 = 2.0 * ABS( a1(k,i) - a12(k,i) ) / &
     356             m2 = 2.0 * ABS( a1(k,i) - a12(k,i) ) /                            &
    312357                  MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35 )
    313358             IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) )  m2 = 0.0
    314359
    315              m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) / &
     360             m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) /                            &
    316361                  MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35 )
    317362             IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) )  m3 = 0.0
    … …  
    322367
    323368!--          *VOCL STMT,IF(10)
    324              IF ( m1(k,i-1) == 1.0 .OR. m1(k,i) == 1.0 .OR. m1(k,i+1) == 1.0 &
    325                   .OR.  m2 > t2  .OR.  m3 > T2  .OR.                         &
    326                   ( m1(k,i) > t1  .AND.  m1(k,i-1) /= -1.0  .AND.            &
    327                     m1(k,i) /= -1.0  .AND.  m1(k,i+1) /= -1.0 )              &
     369             IF ( m1(k,i-1) == 1.0 .OR. m1(k,i) == 1.0 .OR. m1(k,i+1) == 1.0   &
     370                  .OR.  m2 > t2  .OR.  m3 > t2  .OR.                           &
     371                  ( m1(k,i) > t1  .AND.  m1(k,i-1) /= -1.0  .AND.              &
     372                    m1(k,i) /= -1.0  .AND.  m1(k,i+1) /= -1.0 )                &
    328373                )  sw(k,i) = 1.0
    329374          ENDDO
    … …  
    425470       DO  i = nxl, nxr
    426471          DO  k = nzb+1, nzt
    427              fplus  = ( 1.0 - sw(k,i)   ) * ippb(k,i) + sw(k,i)   * ippe(k,i) &
     472             fplus  = ( 1.0 - sw(k,i)   ) * ippb(k,i) + sw(k,i)   * ippe(k,i)  &
    428473                    - ( 1.0 - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i)
    429              fminus = ( 1.0 - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i) &
     474             fminus = ( 1.0 - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i)  &
    430475                    - ( 1.0 - sw(k,i)   ) * immb(k,i) - sw(k,i)   * imme(k,i)
    431              tendenz = fplus - fminus
     476             tendcy = fplus - fminus
    432477!
    433478!--           Removed in order to optimize speed
    434479!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
    435 !             IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 )  tendenz = 0.0
     480!             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 )  tendcy = 0.0
    436481!
    437482!--          Density correction because of possible remaining divergences
    438483             d_new = d(k,j,i) - ( u(k,j,i+1) - u(k,j,i) ) * dt_3d * ddx
    439              sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
     484             sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /    &
    440485                           ( 1.0 + d_new )
    441486             d(k,j,i)  = d_new
    … …  
    447492!
    448493!-- Deallocate temporary arrays
    449     DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme, &
     494    DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
    450495                ippb, ippe, m1, sw )
    451496
    … …  
    455500#if defined( __parallel )
    456501    ngp = ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
    457     CALL MPI_TYPE_VECTOR( nxr-nxl+7, 3*(nzt-nzb+6), ngp, MPI_REAL, &
     502    CALL MPI_TYPE_VECTOR( nxr-nxl+7, 3*(nzt-nzb+6), ngp, MPI_REAL,             &
    458503                          type_xz_2, ierr )
    459504    CALL MPI_TYPE_COMMIT( type_xz_2, ierr )
    … …  
    461506!-- Send front boundary, receive rear boundary
    462507    CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
    463     CALL MPI_SENDRECV( sk_p(nzb-2,nys,nxl-3),   1, type_xz_2, psouth, 0, &
    464                        sk_p(nzb-2,nyn+1,nxl-3), 1, type_xz_2, pnorth, 0, &
     508    CALL MPI_SENDRECV( sk_p(nzb-2,nys,nxl-3),   1, type_xz_2, psouth, 0,       &
     509                       sk_p(nzb-2,nyn+1,nxl-3), 1, type_xz_2, pnorth, 0,       &
    465510                       comm2d, status, ierr )
    466511!
    467512!-- Send rear boundary, receive front boundary
    468     CALL MPI_SENDRECV( sk_p(nzb-2,nyn-2,nxl-3), 1, type_xz_2, pnorth, 1, &
    469                        sk_p(nzb-2,nys-3,nxl-3), 1, type_xz_2, psouth, 1, &
     513    CALL MPI_SENDRECV( sk_p(nzb-2,nyn-2,nxl-3), 1, type_xz_2, pnorth, 1,       &
     514                       sk_p(nzb-2,nys-3,nxl-3), 1, type_xz_2, psouth, 1,       &
    470515                       comm2d, status, ierr )
    471516    CALL MPI_TYPE_FREE( type_xz_2, ierr )
    … …  
    490535       DO  j = nys, nyn
    491536          DO  k = nzb+1, nzt
    492              zaehler = ABS( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) + sk_p(k,j-1,i) )
    493              nenner  = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
    494              fmax_l(1) = MAX( fmax_l(1) , zaehler )
    495              fmax_l(2) = MAX( fmax_l(2) , nenner  )
     537             numera = ABS( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) + sk_p(k,j-1,i) )
     538             denomi  = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
     539             fmax_l(1) = MAX( fmax_l(1) , numera )
     540             fmax_l(2) = MAX( fmax_l(2) , denomi  )
    496541          ENDDO
    497542       ENDDO
    … …  
    508553!
    509554!-- Allocate temporary arrays
    510     ALLOCATE( a0(nzb+1:nzt,nys-1:nyn+1),   a1(nzb+1:nzt,nys-1:nyn+1),   &
    511               a2(nzb+1:nzt,nys-1:nyn+1),   a12(nzb+1:nzt,nys-1:nyn+1),  &
    512               a22(nzb+1:nzt,nys-1:nyn+1),  immb(nzb+1:nzt,nys-1:nyn+1), &
    513               imme(nzb+1:nzt,nys-1:nyn+1), impb(nzb+1:nzt,nys-1:nyn+1), &
    514               impe(nzb+1:nzt,nys-1:nyn+1), ipmb(nzb+1:nzt,nys-1:nyn+1), &
    515               ipme(nzb+1:nzt,nys-1:nyn+1), ippb(nzb+1:nzt,nys-1:nyn+1), &
    516               ippe(nzb+1:nzt,nys-1:nyn+1), m1(nzb+1:nzt,nys-2:nyn+2),   &
    517               sw(nzb+1:nzt,nys-1:nyn+1)                                 &
     555    ALLOCATE( a0(nzb+1:nzt,nys-1:nyn+1),   a1(nzb+1:nzt,nys-1:nyn+1),          &
     556              a2(nzb+1:nzt,nys-1:nyn+1),   a12(nzb+1:nzt,nys-1:nyn+1),         &
     557              a22(nzb+1:nzt,nys-1:nyn+1),  immb(nzb+1:nzt,nys-1:nyn+1),        &
     558              imme(nzb+1:nzt,nys-1:nyn+1), impb(nzb+1:nzt,nys-1:nyn+1),        &
     559              impe(nzb+1:nzt,nys-1:nyn+1), ipmb(nzb+1:nzt,nys-1:nyn+1),        &
     560              ipme(nzb+1:nzt,nys-1:nyn+1), ippb(nzb+1:nzt,nys-1:nyn+1),        &
     561              ippe(nzb+1:nzt,nys-1:nyn+1), m1(nzb+1:nzt,nys-2:nyn+2),          &
     562              sw(nzb+1:nzt,nys-1:nyn+1)                                        &
    518563            )
    519564    imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
    … …  
    528573          DO  k = nzb+1, nzt
    529574             a12(k,j) = 0.5 * ( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
    530              a22(k,j) = 0.5 * ( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) &
     575             a22(k,j) = 0.5 * ( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i)              &
    531576                                              + sk_p(k,j-1,i) )
    532              a0(k,j) = ( 9.0 * sk_p(k,j+2,i) - 116.0 * sk_p(k,j+1,i)    &
    533                          + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j-1,i) &
     577             a0(k,j) = ( 9.0 * sk_p(k,j+2,i) - 116.0 * sk_p(k,j+1,i)           &
     578                         + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j-1,i)        &
    534579                         + 9.0 * sk_p(k,j-2,i) ) * f1920
    535              a1(k,j) = ( -5.0 * sk_p(k,j+2,i) + 34.0 * sk_p(k,j+1,i)  &
    536                          - 34.0 * sk_p(k,j-1,i) + 5.0 * sk_p(k,j-2,i) &
     580             a1(k,j) = ( -5.0 * sk_p(k,j+2,i) + 34.0 * sk_p(k,j+1,i)           &
     581                         - 34.0 * sk_p(k,j-1,i) + 5.0 * sk_p(k,j-2,i)          &
    537582                       ) * f48
    538              a2(k,j) = ( -3.0 * sk_p(k,j+2,i) + 36.0 * sk_p(k,j+1,i) &
    539                          - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j-1,i) &
     583             a2(k,j) = ( -3.0 * sk_p(k,j+2,i) + 36.0 * sk_p(k,j+1,i)           &
     584                         - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j-1,i)           &
    540585                         - 3.0 * sk_p(k,j-2,i) ) * f48
    541586          ENDDO
    … …  
    551596             cipf = 1.0 - 2.0 * cip
    552597             cimf = 1.0 - 2.0 * cim
    553              ip   =   a0(k,j)   * f2  * ( 1.0 - cipf )             &
    554                     + a1(k,j)   * f8  * ( 1.0 - cipf*cipf )        &
     598             ip   =   a0(k,j)   * f2  * ( 1.0 - cipf )                         &
     599                    + a1(k,j)   * f8  * ( 1.0 - cipf*cipf )                    &
    555600                    + a2(k,j)   * f24 * ( 1.0 - cipf*cipf*cipf )
    556              im   =   a0(k,j+1) * f2  * ( 1.0 - cimf )             &
    557                     - a1(k,j+1) * f8  * ( 1.0 - cimf*cimf )        &
     601             im   =   a0(k,j+1) * f2  * ( 1.0 - cimf )                         &
     602                    - a1(k,j+1) * f8  * ( 1.0 - cimf*cimf )                    &
    558603                    + a2(k,j+1) * f24 * ( 1.0 - cimf*cimf*cimf )
    559604             ip   = MAX( ip, 0.0 )
    … …  
    566611             cipf = 1.0 - 2.0 * cip
    567612             cimf = 1.0 - 2.0 * cim
    568              ip   =   a0(k,j-1) * f2  * ( 1.0 - cipf )             &
    569                     + a1(k,j-1) * f8  * ( 1.0 - cipf*cipf )        &
     613             ip   =   a0(k,j-1) * f2  * ( 1.0 - cipf )                         &
     614                    + a1(k,j-1) * f8  * ( 1.0 - cipf*cipf )                    &
    570615                    + a2(k,j-1) * f24 * ( 1.0 - cipf*cipf*cipf )
    571              im   =   a0(k,j)   * f2  * ( 1.0 - cimf )             &
    572                     - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )        &
     616             im   =   a0(k,j)   * f2  * ( 1.0 - cimf )                         &
     617                    - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )                    &
    573618                    + a2(k,j)   * f24 * ( 1.0 - cimf*cimf*cimf )
    574619             ip   = MAX( ip, 0.0 )
    … …  
    601646       DO  j = nys-1, nyn+1
    602647          DO  k = nzb+1, nzt
    603              m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / &
     648             m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) /                            &
    604649                  MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )
    605650             IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0
    606651
    607              m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &
     652             m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) /                            &
    608653                  MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )
    609654             IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0
    … …  
    614659
    615660!--          *VOCL STMT,IF(10)
    616              IF ( m1(k,j-1) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k,j+1) == 1.0 &
    617                   .OR.  m2 > t2  .OR.  m3 > T2  .OR.                         &
    618                   ( m1(k,j) > t1  .AND.  m1(k,j-1) /= -1.0  .AND.            &
    619                     m1(k,j) /= -1.0  .AND.  m1(k,j+1) /= -1.0 )              &
     661             IF ( m1(k,j-1) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k,j+1) == 1.0   &
     662                  .OR.  m2 > t2  .OR.  m3 > t2  .OR.                           &
     663                  ( m1(k,j) > t1  .AND.  m1(k,j-1) /= -1.0  .AND.              &
     664                    m1(k,j) /= -1.0  .AND.  m1(k,j+1) /= -1.0 )                &
    620665                )  sw(k,j) = 1.0
    621666          ENDDO
    … …  
    717762       DO  j = nys, nyn
    718763          DO  k = nzb+1, nzt
    719              fplus  = ( 1.0 - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
     764             fplus  = ( 1.0 - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j)  &
    720765                    - ( 1.0 - sw(k,j+1) ) * impb(k,j) - sw(k,j+1) * impe(k,j)
    721              fminus = ( 1.0 - sw(k,j-1) ) * ipmb(k,j) + sw(k,j-1) * ipme(k,j) &
     766             fminus = ( 1.0 - sw(k,j-1) ) * ipmb(k,j) + sw(k,j-1) * ipme(k,j)  &
    722767                    - ( 1.0 - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
    723              tendenz = fplus - fminus
     768             tendcy = fplus - fminus
    724769!
    725770!--           Removed in order to optimise speed
    726771!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
    727 !             IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 )  tendenz = 0.0
     772!             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 )  tendcy = 0.0
    728773!
    729774!--          Density correction because of possible remaining divergences
    730775             d_new = d(k,j,i) - ( v(k,j+1,i) - v(k,j,i) ) * dt_3d * ddy
    731              sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
     776             sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /    &
    732777                           ( 1.0 + d_new )
    733778             d(k,j,i)  = d_new
    … …  
    741786!
    742787!-- Deallocate temporary arrays
    743     DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme, &
     788    DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
    744789                ippb, ippe, m1, sw )
    745790
    … …  
    879924    ELSE
    880925
    881        WRITE( message_string, * ) 'no vertical boundary condi', &
     926       WRITE( message_string, * ) 'no vertical boundary condi',                &
    882927                                'tion for variable "', sk_char, '"'
    883928       CALL message( 'advec_s_bc', 'PA0158', 1, 2, 0, 6, 0 )
    … …  
    891936       DO  j = nys, nyn
    892937          DO  k = nzb, nzt+1
    893              zaehler = ABS( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) + sk_p(k-1,j,i) )
    894              nenner  = ABS( sk_p(k+1,j,i+1) - sk_p(k-1,j,i) )
    895              fmax_l(1) = MAX( fmax_l(1) , zaehler )
    896              fmax_l(2) = MAX( fmax_l(2) , nenner  )
     938             numera = ABS( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) + sk_p(k-1,j,i) )
     939             denomi  = ABS( sk_p(k+1,j,i+1) - sk_p(k-1,j,i) )
     940             fmax_l(1) = MAX( fmax_l(1) , numera )
     941             fmax_l(2) = MAX( fmax_l(2) , denomi  )
    897942          ENDDO
    898943       ENDDO
    … …  
    909954!
    910955!-- Allocate temporary arrays
    911     ALLOCATE( a0(nzb:nzt+1,nys:nyn),   a1(nzb:nzt+1,nys:nyn),   &
    912               a2(nzb:nzt+1,nys:nyn),   a12(nzb:nzt+1,nys:nyn),  &
    913               a22(nzb:nzt+1,nys:nyn),  immb(nzb+1:nzt,nys:nyn), &
    914               imme(nzb+1:nzt,nys:nyn), impb(nzb+1:nzt,nys:nyn), &
    915               impe(nzb+1:nzt,nys:nyn), ipmb(nzb+1:nzt,nys:nyn), &
    916               ipme(nzb+1:nzt,nys:nyn), ippb(nzb+1:nzt,nys:nyn), &
    917               ippe(nzb+1:nzt,nys:nyn), m1(nzb-1:nzt+2,nys:nyn), &
    918               sw(nzb:nzt+1,nys:nyn)                             &
     956    ALLOCATE( a0(nzb:nzt+1,nys:nyn),   a1(nzb:nzt+1,nys:nyn),                  &
     957              a2(nzb:nzt+1,nys:nyn),   a12(nzb:nzt+1,nys:nyn),                 &
     958              a22(nzb:nzt+1,nys:nyn),  immb(nzb+1:nzt,nys:nyn),                &
     959              imme(nzb+1:nzt,nys:nyn), impb(nzb+1:nzt,nys:nyn),                &
     960              impe(nzb+1:nzt,nys:nyn), ipmb(nzb+1:nzt,nys:nyn),                &
     961              ipme(nzb+1:nzt,nys:nyn), ippb(nzb+1:nzt,nys:nyn),                &
     962              ippe(nzb+1:nzt,nys:nyn), m1(nzb-1:nzt+2,nys:nyn),                &
     963              sw(nzb:nzt+1,nys:nyn)                                            &
    919964            )
    920965    imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
    … …  
    929974          DO  k = nzb, nzt+1
    930975             a12(k,j) = 0.5 * ( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
    931              a22(k,j) = 0.5 * ( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) &
     976             a22(k,j) = 0.5 * ( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i)              &
    932977                                              + sk_p(k-1,j,i) )
    933              a0(k,j) = ( 9.0 * sk_p(k+2,j,i) - 116.0 * sk_p(k+1,j,i)    &
    934                          + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k-1,j,i) &
     978             a0(k,j) = ( 9.0 * sk_p(k+2,j,i) - 116.0 * sk_p(k+1,j,i)           &
     979                         + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k-1,j,i)        &
    935980                         + 9.0 * sk_p(k-2,j,i) ) * f1920
    936              a1(k,j) = ( -5.0 * sk_p(k+2,j,i) + 34.0 * sk_p(k+1,j,i)  &
    937                          - 34.0 * sk_p(k-1,j,i) + 5.0 * sk_p(k-2,j,i) &
     981             a1(k,j) = ( -5.0 * sk_p(k+2,j,i) + 34.0 * sk_p(k+1,j,i)           &
     982                         - 34.0 * sk_p(k-1,j,i) + 5.0 * sk_p(k-2,j,i)          &
    938983                       ) * f48
    939              a2(k,j) = ( -3.0 * sk_p(k+2,j,i) + 36.0 * sk_p(k+1,j,i) &
    940                          - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k-1,j,i) &
     984             a2(k,j) = ( -3.0 * sk_p(k+2,j,i) + 36.0 * sk_p(k+1,j,i)           &
     985                         - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k-1,j,i)           &
    941986                         - 3.0 * sk_p(k-2,j,i) ) * f48
    942987          ENDDO
    … …  
    952997             cipf = 1.0 - 2.0 * cip
    953998             cimf = 1.0 - 2.0 * cim
    954              ip   =   a0(k,j)   * f2  * ( 1.0 - cipf )             &
    955                     + a1(k,j)   * f8  * ( 1.0 - cipf*cipf )        &
     999             ip   =   a0(k,j)   * f2  * ( 1.0 - cipf )                         &
     1000                    + a1(k,j)   * f8  * ( 1.0 - cipf*cipf )                    &
    9561001                    + a2(k,j)   * f24 * ( 1.0 - cipf*cipf*cipf )
    957              im   =   a0(k+1,j) * f2  * ( 1.0 - cimf )             &
    958                     - a1(k+1,j) * f8  * ( 1.0 - cimf*cimf )        &
     1002             im   =   a0(k+1,j) * f2  * ( 1.0 - cimf )                         &
     1003                    - a1(k+1,j) * f8  * ( 1.0 - cimf*cimf )                    &
    9591004                    + a2(k+1,j) * f24 * ( 1.0 - cimf*cimf*cimf )
    9601005             ip   = MAX( ip, 0.0 )
    … …  
    9671012             cipf = 1.0 - 2.0 * cip
    9681013             cimf = 1.0 - 2.0 * cim
    969              ip   =   a0(k-1,j) * f2  * ( 1.0 - cipf )             &
    970                     + a1(k-1,j) * f8  * ( 1.0 - cipf*cipf )        &
     1014             ip   =   a0(k-1,j) * f2  * ( 1.0 - cipf )                         &
     1015                    + a1(k-1,j) * f8  * ( 1.0 - cipf*cipf )                    &
    9711016                    + a2(k-1,j) * f24 * ( 1.0 - cipf*cipf*cipf )
    972              im   =   a0(k,j)   * f2  * ( 1.0 - cimf )             &
    973                     - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )        &
     1017             im   =   a0(k,j)   * f2  * ( 1.0 - cimf )                         &
     1018                    - a1(k,j)   * f8  * ( 1.0 - cimf*cimf )                    &
    9741019                    + a2(k,j)   * f24 * ( 1.0 - cimf*cimf*cimf )
    9751020             ip   = MAX( ip, 0.0 )
    … …  
    10021047       DO  j = nys, nyn
    10031048          DO  k = nzb, nzt+1
    1004              m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / &
     1049             m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) /                            &
    10051050                  MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )
    10061051             IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0
    10071052
    1008              m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &
     1053             m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) /                            &
    10091054                  MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )
    10101055             IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0
    … …  
    10151060
    10161061!--          *VOCL STMT,IF(10)
    1017              IF ( m1(k-1,j) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k+1,j) == 1.0 &
    1018                   .OR.  m2 > t2  .OR.  m3 > T2  .OR.                         &
    1019                   ( m1(k,j) > t1  .AND.  m1(k-1,j) /= -1.0  .AND.            &
    1020                     m1(k,j) /= -1.0  .AND.  m1(k+1,j) /= -1.0 )              &
     1062             IF ( m1(k-1,j) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k+1,j) == 1.0   &
     1063                  .OR.  m2 > t2  .OR.  m3 > t2  .OR.                           &
     1064                  ( m1(k,j) > t1  .AND.  m1(k-1,j) /= -1.0  .AND.              &
     1065                    m1(k,j) /= -1.0  .AND.  m1(k+1,j) /= -1.0 )                &
    10211066                )  sw(k,j) = 1.0
    10221067          ENDDO
    … …  
    11181163       DO  j = nys, nyn
    11191164          DO  k = nzb+1, nzt
    1120              fplus  = ( 1.0 - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
     1165             fplus  = ( 1.0 - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j)  &
    11211166                    - ( 1.0 - sw(k+1,j) ) * impb(k,j) - sw(k+1,j) * impe(k,j)
    1122              fminus = ( 1.0 - sw(k-1,j) ) * ipmb(k,j) + sw(k-1,j) * ipme(k,j) &
     1167             fminus = ( 1.0 - sw(k-1,j) ) * ipmb(k,j) + sw(k-1,j) * ipme(k,j)  &
    11231168                    - ( 1.0 - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
    1124              tendenz = fplus - fminus
     1169             tendcy = fplus - fminus
    11251170!
    11261171!--           Removed in order to optimise speed
    11271172!             ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
    1128 !             IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 )  tendenz = 0.0
     1173!             IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 )  tendcy = 0.0
    11291174!
    11301175!--          Density correction because of possible remaining divergences
    11311176             d_new = d(k,j,i) - ( w(k,j,i) - w(k-1,j,i) ) * dt_3d * ddzw(k)
    1132              sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
     1177             sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /    &
    11331178                           ( 1.0 + d_new )
    11341179!
    … …  
    11451190             DO  j = nys, nyn
    11461191                DO  k = nzb+1, nzt
    1147                    sums_wsts_bc_l(k,sr) = sums_wsts_bc_l(k,sr) + &
     1192                   sums_wsts_bc_l(k,sr) = sums_wsts_bc_l(k,sr) +               &
    11481193                                          m1(k,j) * rmask(j,i,sr)
    11491194                ENDDO
    … …  
    11581203!
    11591204!-- Deallocate temporary arrays
    1160     DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme, &
     1205    DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
    11611206                ippb, ippe, m1, sw )
    11621207

  • palm/trunk/SOURCE/advec_s_pw.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    3136! 1010 2012-09-20 07:59:54Z raasch
    3237! cpp switch __nopointer added for pointer free version
    33 !
    34 ! 19 2007-02-23 04:53:48Z raasch
    35 ! Calculation extended for gridpoint nzt
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.12  2006/02/23 09:42:55  raasch
    40 ! nzb_2d replaced by nzb_s_inner
    4138!
    4239! Revision 1.1  1997/08/29 08:54:20  raasch
    … …  
    7067    SUBROUTINE advec_s_pw( sk )
    7168
    72        USE arrays_3d
    73        USE control_parameters
    74        USE grid_variables
    75        USE indices
     69       USE arrays_3d,                                                          &
     70           ONLY:  dd2zu, tend, u, v, w
     71
     72       USE control_parameters,                                                 &
     73           ONLY:  u_gtrans, v_gtrans
     74
     75       USE grid_variables,                                                     &
     76           ONLY:  ddx, ddy
     77
     78       USE indices,                                                            &
     79           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
     80
     81       USE kinds
     82
    7683
    7784       IMPLICIT NONE
    7885
    79        INTEGER ::  i, j, k
     86       INTEGER(iwp) ::  i !:
     87       INTEGER(iwp) ::  j !:
     88       INTEGER(iwp) ::  k !:
    8089
    8190#if defined( __nopointer )
    82        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     91       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    8392#else
    84        REAL, DIMENSION(:,:,:), POINTER ::  sk
     93       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
    8594#endif
    8695 
    … …  
    111120    SUBROUTINE advec_s_pw_ij( i, j, sk )
    112121
    113        USE arrays_3d
    114        USE control_parameters
    115        USE grid_variables
    116        USE indices
     122       USE arrays_3d,                                                          &
     123           ONLY:  dd2zu, tend, u, v, w
     124
     125       USE control_parameters,                                                 &
     126           ONLY:  u_gtrans, v_gtrans
     127
     128       USE grid_variables,                                                     &
     129           ONLY:  ddx, ddy
     130
     131       USE indices,                                                            &
     132           ONLY:  nzb_s_inner, nzt
     133
     134       USE kinds
     135
    117136
    118137       IMPLICIT NONE
    119138
    120        INTEGER ::  i, j, k
     139       INTEGER(iwp) ::  i !:
     140       INTEGER(iwp) ::  j !:
     141       INTEGER(iwp) ::  k !:
    121142
    122143#if defined( __nopointer )
    123        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     144       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    124145#else
    125        REAL, DIMENSION(:,:,:), POINTER ::  sk
     146       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
    126147#endif
    127148

  • palm/trunk/SOURCE/advec_s_up.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    3439! 981 2012-08-09 14:57:44Z maronga
    3540! Typo removed
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.11  2006/02/23 09:43:44  raasch
    40 ! nzb_2d replaced by nzb_s_inner
    4141!
    4242! Revision 1.1  1997/08/29 08:54:33  raasch
    … …  
    6767    SUBROUTINE advec_s_up( sk )
    6868
    69        USE arrays_3d
    70        USE control_parameters
    71        USE grid_variables
    72        USE indices
     69       USE arrays_3d,                                                          &
     70           ONLY:  ddzu, tend, u, v, w
     71
     72       USE control_parameters,                                                 &
     73           ONLY:  u_gtrans, v_gtrans
     74
     75       USE grid_variables,                                                     &
     76           ONLY:  ddx, ddy
     77
     78       USE indices,                                                            &
     79           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
     80
     81       USE kinds
     82
    7383
    7484       IMPLICIT NONE
    7585
    76        INTEGER ::  i, j, k
    77 
    78        REAL ::  ukomp, vkomp, wkomp
     86       INTEGER(iwp) ::  i !:
     87       INTEGER(iwp) ::  j !:
     88       INTEGER(iwp) ::  k !:
     89
     90       REAL(wp) ::  ukomp !:
     91       REAL(wp) ::  vkomp !:
     92       REAL(wp) ::  wkomp !:
    7993#if defined( __nopointer )
    80        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     94       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    8195#else
    82        REAL, DIMENSION(:,:,:), POINTER ::  sk
     96       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
    8397#endif
    8498
    … …  
    91105                ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
    92106                IF ( ukomp > 0.0 )  THEN
    93                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     107                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    94108                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
    95109                ELSE
    96                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     110                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    97111                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
    98112                ENDIF
    … …  
    101115                vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
    102116                IF ( vkomp > 0.0 )  THEN
    103                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     117                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    104118                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
    105119                ELSE
    106                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     120                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    107121                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
    108122                ENDIF
    … …  
    111125                wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
    112126                IF ( wkomp > 0.0 )  THEN
    113                    tend(k,j,i) = tend(k,j,i) - wkomp * &
     127                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    114128                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
    115129                ELSE
    116                    tend(k,j,i) = tend(k,j,i) - wkomp * &
     130                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    117131                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
    118132                ENDIF
    … …  
    130144    SUBROUTINE advec_s_up_ij( i, j, sk )
    131145
    132        USE arrays_3d
    133        USE control_parameters
    134        USE grid_variables
    135        USE indices
     146       USE arrays_3d,                                                          &
     147           ONLY:  ddzu, tend, u, v, w
     148
     149       USE control_parameters,                                                 &
     150           ONLY:  u_gtrans, v_gtrans
     151
     152       USE grid_variables,                                                     &
     153           ONLY:  ddx, ddy
     154
     155       USE indices,                                                            &
     156           ONLY:  nzb_s_inner, nzt
     157
     158       USE kinds
     159
    136160
    137161       IMPLICIT NONE
    138162
    139        INTEGER ::  i, j, k
    140 
    141        REAL ::  ukomp, vkomp, wkomp
     163       INTEGER(iwp) ::  i !:
     164       INTEGER(iwp) ::  j !:
     165       INTEGER(iwp) ::  k !:
     166
     167       REAL(wp) ::  ukomp !:
     168       REAL(wp) ::  vkomp !:
     169       REAL(wp) ::  wkomp !:
     170       
    142171#if defined( __nopointer )
    143        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     172       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    144173#else
    145        REAL, DIMENSION(:,:,:), POINTER ::  sk
     174       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
    146175#endif
    147176
    … …  
    152181          ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
    153182          IF ( ukomp > 0.0 )  THEN
    154              tend(k,j,i) = tend(k,j,i) - ukomp * &
     183             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    155184                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
    156185          ELSE
    157              tend(k,j,i) = tend(k,j,i) - ukomp * &
     186             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    158187                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
    159188          ENDIF
    … …  
    162191          vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
    163192          IF ( vkomp > 0.0 )  THEN
    164              tend(k,j,i) = tend(k,j,i) - vkomp * &
     193             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    165194                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
    166195          ELSE
    167              tend(k,j,i) = tend(k,j,i) - vkomp * &
     196             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    168197                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
    169198          ENDIF
    … …  
    172201          wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
    173202          IF ( wkomp > 0.0 )  THEN
    174              tend(k,j,i) = tend(k,j,i) - wkomp * &
     203             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    175204                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
    176205          ELSE
    177              tend(k,j,i) = tend(k,j,i) - wkomp * &
     206             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    178207                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
    179208          ENDIF

  • palm/trunk/SOURCE/advec_u_pw.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! 106 2007-08-16 14:30:26Z raasch
    32 ! i loop is starting from nxlu (needed for non-cyclic boundary conditions)
    33 !
    34 ! 75 2007-03-22 09:54:05Z raasch
    35 ! uxrp eliminated
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.15  2006/02/23 09:44:21  raasch
    40 ! nzb_2d replaced by nzb_u_inner
    4135!
    4236! Revision 1.1  1997/08/11 06:09:21  raasch
    … …  
    6862    SUBROUTINE advec_u_pw
    6963
    70        USE arrays_3d
    71        USE control_parameters
    72        USE grid_variables
    73        USE indices
     64       USE arrays_3d,                                                          &
     65           ONLY:  ddzw, tend, u, v, w
     66
     67       USE control_parameters,                                                 &
     68           ONLY:  u_gtrans, v_gtrans
     69
     70       USE grid_variables,                                                     &
     71           ONLY:  ddx, ddy
     72
     73       USE indices,                                                            &
     74           ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
     75
     76       USE kinds
     77
    7478
    7579       IMPLICIT NONE
    7680
    77        INTEGER ::  i, j, k
    78        REAL    ::  gu, gv
     81       INTEGER(iwp) ::  i !:
     82       INTEGER(iwp) ::  j !:
     83       INTEGER(iwp) ::  k !:
     84       
     85       REAL(wp)    ::  gu !:
     86       REAL(wp)    ::  gv !:
    7987 
    8088       gu = 2.0 * u_gtrans
    … …  
    104112    SUBROUTINE advec_u_pw_ij( i, j )
    105113
    106        USE arrays_3d
    107        USE control_parameters
    108        USE grid_variables
    109        USE indices
     114       USE arrays_3d,                                                          &
     115           ONLY:  ddzw, tend, u, v, w
     116
     117       USE control_parameters,                                                 &
     118           ONLY:  u_gtrans, v_gtrans
     119
     120       USE grid_variables,                                                     &
     121           ONLY:  ddx, ddy
     122
     123       USE indices,                                                            &
     124           ONLY:  nzb_u_inner, nzt
     125
     126       USE kinds
     127
    110128
    111129       IMPLICIT NONE
    112130
    113        INTEGER ::  i, j, k
    114        REAL    ::  gu, gv
     131       INTEGER(iwp) ::  i !:
     132       INTEGER(iwp) ::  j !:
     133       INTEGER(iwp) ::  k !:
     134       
     135       REAL(wp)    ::  gu !:
     136       REAL(wp)    ::  gv !:
    115137
    116138       gu = 2.0 * u_gtrans

  • palm/trunk/SOURCE/advec_u_up.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! 106 2007-08-16 14:30:26Z raasch
    32 ! i loop is starting from nxlu (needed for non-cyclic boundary conditions)
    33 !
    34 ! 75 2007-03-22 09:54:05Z raasch
    35 ! uxrp eliminated
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.12  2006/02/23 09:45:04  raasch
    40 ! nzb_2d replaced by nzb_u_inner
    4135!
    4236! Revision 1.1  1997/08/29 08:55:25  raasch
    … …  
    6761    SUBROUTINE advec_u_up
    6862
    69        USE arrays_3d
    70        USE control_parameters
    71        USE grid_variables
    72        USE indices
     63       USE arrays_3d,                                                          &
     64           ONLY:  ddzu, tend, u, v, w
     65
     66       USE control_parameters,                                                 &
     67           ONLY:  u_gtrans, v_gtrans
     68
     69       USE grid_variables,                                                     &
     70           ONLY:  ddx, ddy
     71
     72       USE indices,                                                            &
     73           ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
     74
     75       USE kinds
     76
    7377
    7478       IMPLICIT NONE
    7579
    76        INTEGER ::  i, j, k
    77 
    78        REAL ::  ukomp, vkomp, wkomp
    79 
    80 
     80       INTEGER(iwp) ::  i !:
     81       INTEGER(iwp) ::  j !:
     82       INTEGER(iwp) ::  k !:
     83
     84       REAL(wp) ::  ukomp !:
     85       REAL(wp) ::  vkomp !:
     86       REAL(wp) ::  wkomp !:
     87
     88       
    8189       DO  i = nxlu, nxr
    8290          DO  j = nys, nyn
    … …  
    8694                ukomp = u(k,j,i) - u_gtrans
    8795                IF ( ukomp > 0.0 )  THEN
    88                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     96                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    8997                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx
    9098                ELSE
    91                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     99                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    92100                                          ( u(k,j,i+1) - u(k,j,i) ) * ddx
    93101                ENDIF
    94102!
    95103!--             y-direction
    96                 vkomp = 0.25 * ( v(k,j,i)   + v(k,j+1,i) + &
     104                vkomp = 0.25 * ( v(k,j,i)   + v(k,j+1,i) +                     &
    97105                                 v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
    98106                IF ( vkomp > 0.0 )  THEN
    99                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     107                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    100108                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy
    101109                ELSE
    102                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     110                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    103111                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy
    104112                ENDIF
    105113!
    106114!--             z-direction
    107                 wkomp = 0.25 * ( w(k,j,i)   + w(k-1,j,i) + &
     115                wkomp = 0.25 * ( w(k,j,i)   + w(k-1,j,i) +                     &
    108116                                 w(k,j,i-1) + w(k-1,j,i-1) )
    109117                IF ( wkomp > 0.0 )  THEN
    110                    tend(k,j,i) = tend(k,j,i) - wkomp * &
     118                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    111119                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
    112120                ELSE
    113                    tend(k,j,i) = tend(k,j,i) - wkomp * &
     121                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    114122                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
    115123                ENDIF
    … …  
    127135    SUBROUTINE advec_u_up_ij( i, j )
    128136
    129        USE arrays_3d
    130        USE control_parameters
    131        USE grid_variables
    132        USE indices
     137       USE arrays_3d,                                                          &
     138           ONLY:  ddzu, tend, u, v, w
     139
     140       USE control_parameters,                                                 &
     141           ONLY:  u_gtrans, v_gtrans
     142
     143       USE grid_variables,                                                     &
     144           ONLY:  ddx, ddy
     145
     146       USE indices,                                                            &
     147           ONLY:  nzb_u_inner, nzt
     148
     149       USE kinds
     150
    133151
    134152       IMPLICIT NONE
    135153
    136        INTEGER ::  i, j, k
    137 
    138        REAL ::  ukomp, vkomp, wkomp
     154       INTEGER(iwp) ::  i !:
     155       INTEGER(iwp) ::  j !:
     156       INTEGER(iwp) ::  k !:
     157
     158       REAL(wp) ::  ukomp !:
     159       REAL(wp) ::  vkomp !:
     160       REAL(wp) ::  wkomp !:
    139161
    140162
    … …  
    144166          ukomp = u(k,j,i) - u_gtrans
    145167          IF ( ukomp > 0.0 )  THEN
    146              tend(k,j,i) = tend(k,j,i) - ukomp * &
     168             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    147169                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx
    148170          ELSE
    149              tend(k,j,i) = tend(k,j,i) - ukomp * &
     171             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    150172                                         ( u(k,j,i+1) - u(k,j,i) ) * ddx
    151173          ENDIF
    152174!
    153175!--       y-direction
    154           vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
     176          vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1)   &
    155177                         ) - v_gtrans
    156178          IF ( vkomp > 0.0 )  THEN
    157              tend(k,j,i) = tend(k,j,i) - vkomp * &
     179             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    158180                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy
    159181          ELSE
    160              tend(k,j,i) = tend(k,j,i) - vkomp * &
     182             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    161183                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy
    162184          ENDIF
    … …  
    165187          wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
    166188          IF ( wkomp > 0.0 )  THEN
    167              tend(k,j,i) = tend(k,j,i) - wkomp * &
     189             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    168190                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
    169191          ELSE
    170              tend(k,j,i) = tend(k,j,i) - wkomp * &
     192             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    171193                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
    172194          ENDIF

  • palm/trunk/SOURCE/advec_v_pw.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! 106 2007-08-16 14:30:26Z raasch
    32 ! j loop is starting from nysv (needed for non-cyclic boundary conditions)
    33 !
    34 ! 75 2007-03-22 09:54:05Z raasch
    35 ! vynp eliminated
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.15  2006/02/23 09:46:08  raasch
    40 ! nzb_2d replaced by nzb_v_inner
    4135!
    4236! Revision 1.1  1997/08/11 06:09:57  raasch
    … …  
    6862    SUBROUTINE advec_v_pw
    6963
    70        USE arrays_3d
    71        USE control_parameters
    72        USE grid_variables
    73        USE indices
     64       USE arrays_3d,                                                          &
     65           ONLY:  ddzw, tend, u, v, w
     66
     67       USE control_parameters,                                                 &
     68           ONLY:  u_gtrans, v_gtrans
     69
     70       USE grid_variables,                                                     &
     71           ONLY:  ddx, ddy
     72
     73       USE indices,                                                            &
     74           ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
     75
     76       USE kinds
     77
    7478
    7579       IMPLICIT NONE
    7680
    77        INTEGER ::  i, j, k
    78        REAL    ::  gu, gv
     81       INTEGER(iwp) ::  i !:
     82       INTEGER(iwp) ::  j !:
     83       INTEGER(iwp) ::  k !:
     84       
     85       REAL(wp)    ::  gu !:
     86       REAL(wp)    ::  gv !:
    7987 
    8088
    … …  
    105113    SUBROUTINE advec_v_pw_ij( i, j )
    106114
    107        USE arrays_3d
    108        USE control_parameters
    109        USE grid_variables
    110        USE indices
     115       USE arrays_3d,                                                          &
     116           ONLY:  ddzw, tend, u, v, w
     117
     118       USE control_parameters,                                                 &
     119           ONLY:  u_gtrans, v_gtrans
     120
     121       USE grid_variables,                                                     &
     122           ONLY:  ddx, ddy
     123
     124       USE indices,                                                            &
     125           ONLY:  nzb_v_inner, nzt
     126
     127       USE kinds
     128
    111129
    112130       IMPLICIT NONE
    113131
    114        INTEGER ::  i, j, k
    115        REAL    ::  gu, gv
     132       INTEGER(iwp) ::  i !:
     133       INTEGER(iwp) ::  j !:
     134       INTEGER(iwp) ::  k !:
     135       
     136       REAL(wp)    ::  gu !:
     137       REAL(wp)    ::  gv !:
    116138
    117139
    … …  
    119141       gv = 2.0 * v_gtrans
    120142       DO  k = nzb_v_inner(j,i)+1, nzt
    121           tend(k,j,i) = tend(k,j,i) - 0.25 * (                              &
     143          tend(k,j,i) = tend(k,j,i) - 0.25 * (                                 &
    122144                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
    123145                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &

  • palm/trunk/SOURCE/advec_v_up.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! 106 2007-08-16 14:30:26Z raasch
    32 ! j loop is starting from nysv (needed for non-cyclic boundary conditions)
    33 !
    34 ! 75 2007-03-22 09:54:05Z raasch
    35 ! vynp eliminated
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.12  2006/02/23 09:46:37  raasch
    40 ! nzb_2d replaced by nzb_v_inner
    4135!
    4236! Revision 1.1  1997/08/29 08:56:05  raasch
    … …  
    6761    SUBROUTINE advec_v_up
    6862
    69        USE arrays_3d
    70        USE control_parameters
    71        USE grid_variables
    72        USE indices
     63       USE arrays_3d,                                                          &
     64           ONLY:  ddzu, tend, u, v, w
     65
     66       USE control_parameters,                                                 &
     67           ONLY:  u_gtrans, v_gtrans
     68
     69       USE grid_variables,                                                     &
     70           ONLY:  ddx, ddy
     71
     72       USE indices,                                                            &
     73           ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
     74
     75       USE kinds
     76
    7377
    7478       IMPLICIT NONE
    7579
    76        INTEGER ::  i, j, k
    77        REAL    ::  ukomp, vkomp, wkomp
     80       INTEGER(iwp) ::  i !:
     81       INTEGER(iwp) ::  j !:
     82       INTEGER(iwp) ::  k !:
     83
     84       REAL(wp) ::  ukomp !:
     85       REAL(wp) ::  vkomp !:
     86       REAL(wp) ::  wkomp !:       
    7887
    7988
    … …  
    8392!
    8493!--             x-direction
    85                 ukomp = 0.25 * ( u(k,j,i)   + u(k,j-1,i) + &
     94                ukomp = 0.25 * ( u(k,j,i)   + u(k,j-1,i) +                     &
    8695                                 u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans
    8796                IF ( ukomp > 0.0 )  THEN
    88                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     97                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    8998                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
    9099                ELSE
    91                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     100                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    92101                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
    93102                ENDIF
    … …  
    96105                vkomp = v(k,j,i) - v_gtrans
    97106                IF ( vkomp > 0.0 )  THEN
    98                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     107                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    99108                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
    100109                ELSE
    101                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     110                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    102111                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
    103112                ENDIF
    104113!
    105114!--             z-direction
    106                 wkomp = 0.25 * ( w(k,j,i)  + w(k-1,j,i) + &
     115                wkomp = 0.25 * ( w(k,j,i)  + w(k-1,j,i) +                      &
    107116                                 w(k,j-1,i) + w(k-1,j-1,i) )
    108117                IF ( wkomp > 0.0 )  THEN
    109                    tend(k,j,i) = tend(k,j,i) - wkomp * &
     118                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    110119                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
    111120                ELSE
    112                    tend(k,j,i) = tend(k,j,i) - wkomp * &
     121                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
    113122                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
    114123                ENDIF
    … …  
    126135    SUBROUTINE advec_v_up_ij( i, j )
    127136
    128        USE arrays_3d
    129        USE control_parameters
    130        USE grid_variables
    131        USE indices
     137       USE arrays_3d,                                                          &
     138           ONLY:  ddzu, tend, u, v, w
     139
     140       USE control_parameters,                                                 &
     141           ONLY:  u_gtrans, v_gtrans
     142
     143       USE grid_variables,                                                     &
     144           ONLY:  ddx, ddy
     145
     146       USE indices,                                                            &
     147           ONLY:  nzb_v_inner, nzt
     148
     149       USE kinds
     150
    132151
    133152       IMPLICIT NONE
    134153
    135        INTEGER ::  i, j, k
    136 
    137        REAL ::  ukomp, vkomp, wkomp
     154       INTEGER(iwp) ::  i !:
     155       INTEGER(iwp) ::  j !:
     156       INTEGER(iwp) ::  k !:
     157
     158       REAL(wp) ::  ukomp !:
     159       REAL(wp) ::  vkomp !:
     160       REAL(wp) ::  wkomp !:
    138161
    139162
    … …  
    141164!
    142165!--       x-direction
    143           ukomp = 0.25 * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1) &
     166          ukomp = 0.25 * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1)   &
    144167                         ) - u_gtrans
    145168          IF ( ukomp > 0.0 )  THEN
    146              tend(k,j,i) = tend(k,j,i) - ukomp * &
     169             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    147170                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
    148171          ELSE
    149              tend(k,j,i) = tend(k,j,i) - ukomp * &
     172             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    150173                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
    151174          ENDIF
    … …  
    154177          vkomp = v(k,j,i) - v_gtrans
    155178          IF ( vkomp > 0.0 )  THEN
    156              tend(k,j,i) = tend(k,j,i) - vkomp * &
     179             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    157180                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
    158181          ELSE
    159              tend(k,j,i) = tend(k,j,i) - vkomp * &
     182             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    160183                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
    161184          ENDIF
    … …  
    164187          wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
    165188          IF ( wkomp > 0.0 )  THEN
    166              tend(k,j,i) = tend(k,j,i) - wkomp * &
     189             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    167190                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
    168191          ELSE
    169              tend(k,j,i) = tend(k,j,i) - wkomp * &
     192             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
    170193                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
    171194          ENDIF

  • palm/trunk/SOURCE/advec_w_pw.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! RCS Log replace by Id keyword, revision history cleaned up
    32 !
    33 ! Revision 1.15  2006/02/23 09:47:01  raasch
    34 ! nzb_2d replaced by nzb_w_inner
    3535!
    3636! Revision 1.1  1997/08/11 06:10:29  raasch
    … …  
    6262    SUBROUTINE advec_w_pw
    6363
    64        USE arrays_3d
    65        USE control_parameters
    66        USE grid_variables
    67        USE indices
     64       USE arrays_3d,                                                          &
     65           ONLY:  ddzu, tend, u, v, w
     66
     67       USE control_parameters,                                                 &
     68           ONLY:  u_gtrans, v_gtrans
     69
     70       USE grid_variables,                                                     &
     71           ONLY:  ddx, ddy
     72
     73       USE indices,                                                            &
     74           ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
     75
     76       USE kinds
     77
    6878
    6979       IMPLICIT NONE
    7080
    71        INTEGER ::  i, j, k
    72        REAL    ::  gu, gv
     81       INTEGER(iwp) ::  i !:
     82       INTEGER(iwp) ::  j !:
     83       INTEGER(iwp) ::  k !:
     84       
     85       REAL(wp)    ::  gu !:
     86       REAL(wp)    ::  gv !:
    7387
    7488 
    … …  
    99113    SUBROUTINE advec_w_pw_ij( i, j )
    100114
    101        USE arrays_3d
    102        USE control_parameters
    103        USE grid_variables
    104        USE indices
     115       USE arrays_3d,                                                          &
     116           ONLY:  ddzu, tend, u, v, w
     117
     118       USE control_parameters,                                                 &
     119           ONLY:  u_gtrans, v_gtrans
     120
     121       USE grid_variables,                                                     &
     122           ONLY:  ddx, ddy
     123
     124       USE indices,                                                            &
     125           ONLY:  nzb_w_inner, nzt
     126
     127       USE kinds
     128
    105129
    106130       IMPLICIT NONE
    107131
    108        INTEGER ::  i, j, k
    109        REAL    ::  gu, gv
     132       INTEGER(iwp) ::  i !:
     133       INTEGER(iwp) ::  j !:
     134       INTEGER(iwp) ::  k !:
     135       
     136       REAL(wp)    ::  gu !:
     137       REAL(wp)    ::  gv !:
    110138
    111139       gu = 2.0 * u_gtrans
    112140       gv = 2.0 * v_gtrans
    113141       DO  k = nzb_w_inner(j,i)+1, nzt
    114           tend(k,j,i) = tend(k,j,i) - 0.25 * (                              &
     142          tend(k,j,i) = tend(k,j,i) - 0.25 * (                                 &
    115143                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
    116144                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &

  • palm/trunk/SOURCE/advec_w_up.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! RCS Log replace by Id keyword, revision history cleaned up
    32 !
    33 ! Revision 1.11  2006/02/23 09:47:23  raasch
    34 ! *** empty log message ***
    3535!
    3636! Revision 1.1  1997/08/29 08:56:33  raasch
    … …  
    6161    SUBROUTINE advec_w_up
    6262
    63        USE arrays_3d
    64        USE control_parameters
    65        USE grid_variables
    66        USE indices
     63       USE arrays_3d,                                                          &
     64           ONLY:  ddzw, tend, u, v, w
     65
     66       USE control_parameters,                                                 &
     67           ONLY:  u_gtrans, v_gtrans
     68
     69       USE grid_variables,                                                     &
     70           ONLY:  ddx, ddy
     71
     72       USE indices,                                                            &
     73           ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
     74
     75       USE kinds
     76
    6777
    6878       IMPLICIT NONE
    6979
    70        INTEGER ::  i, j, k
    71        REAL    ::  ukomp, vkomp
     80       INTEGER(iwp) ::  i !:
     81       INTEGER(iwp) ::  j !:
     82       INTEGER(iwp) ::  k !:
     83
     84       REAL(wp) ::  ukomp !:
     85       REAL(wp) ::  vkomp !:
    7286
    7387
    … …  
    7791!
    7892!--             x-direction
    79                 ukomp = 0.25 * ( u(k,j,i)   + u(k,j,i+1) + &
     93                ukomp = 0.25 * ( u(k,j,i)   + u(k,j,i+1) +                     &
    8094                                 u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans
    8195                IF ( ukomp > 0.0 )  THEN
    82                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     96                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    8397                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
    8498                ELSE
    85                    tend(k,j,i) = tend(k,j,i) - ukomp * &
     99                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
    86100                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
    87101                ENDIF
    88102!
    89103!--             y-direction
    90                 vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + &
     104                vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) +                       &
    91105                                 v(k+1,j,i) + v(k+1,j+1,i) ) - v_gtrans
    92106                IF ( vkomp > 0.0 )  THEN
    93                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     107                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    94108                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
    95109                ELSE
    96                    tend(k,j,i) = tend(k,j,i) - vkomp * &
     110                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
    97111                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
    98112                ENDIF
    … …  
    100114!--             z-direction
    101115                IF ( w(k,j,i) > 0.0 )  THEN
    102                    tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
     116                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
    103117                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
    104118                ELSE
    105                    tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
     119                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
    106120                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
    107121                ENDIF
    … …  
    119133    SUBROUTINE advec_w_up_ij( i, j )
    120134
    121        USE arrays_3d
    122        USE control_parameters
    123        USE grid_variables
    124        USE indices
     135       USE arrays_3d,                                                          &
     136           ONLY:  ddzw, tend, u, v, w
     137
     138       USE control_parameters,                                                 &
     139           ONLY:  u_gtrans, v_gtrans
     140
     141       USE grid_variables,                                                     &
     142           ONLY:  ddx, ddy
     143
     144       USE indices,                                                            &
     145           ONLY:  nzb_w_inner, nzt
     146
     147       USE kinds
     148
    125149
    126150       IMPLICIT NONE
    127151
    128        INTEGER ::  i, j, k
    129        REAL    ::  ukomp, vkomp
     152       INTEGER(iwp) ::  i !:
     153       INTEGER(iwp) ::  j !:
     154       INTEGER(iwp) ::  k !:
     155
     156       REAL(wp) ::  ukomp !:
     157       REAL(wp) ::  vkomp !:
    130158
    131159
    … …  
    133161!
    134162!--       x-direction
    135           ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) &
     163          ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1)   &
    136164                         ) - u_gtrans
    137165          IF ( ukomp > 0.0 )  THEN
    138              tend(k,j,i) = tend(k,j,i) - ukomp * &
     166             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    139167                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
    140168          ELSE
    141              tend(k,j,i) = tend(k,j,i) - ukomp * &
     169             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
    142170                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
    143171          ENDIF
    144172!
    145173!--       y-direction
    146           vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) &
     174          vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i)   &
    147175                         ) - v_gtrans
    148176          IF ( vkomp > 0.0 )  THEN
    149              tend(k,j,i) = tend(k,j,i) - vkomp * &
     177             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    150178                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
    151179          ELSE
    152              tend(k,j,i) = tend(k,j,i) - vkomp * &
     180             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
    153181                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
    154182          ENDIF
    … …  
    156184!--       z-direction
    157185          IF ( w(k,j,i) > 0.0 )  THEN
    158              tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
     186             tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                            &
    159187                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
    160188          ELSE
    161              tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
     189             tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                            &
    162190                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
    163191          ENDIF

  • palm/trunk/SOURCE/advec_ws.f90

    r1310 r1320  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! old module precision_kind is removed,
     26! revision history before 2012 removed,
     27! comment fields (!:) to be used for variable explanations added to
     28! all variable declaration statements
    2329!
    2430! Former revisions:
    … …  
    8591! dimension.
    8692!
    87 ! 743 2011-08-18 16:10:16Z suehring
    88 ! Evaluation of turbulent fluxes with WS-scheme only for the whole model
    89 ! domain. Therefor dimension of arrays needed for statistical evaluation
    90 ! decreased.
    91 !
    92 ! 736 2011-08-17 14:13:26Z suehring
    93 ! Bugfix concerning OpenMP parallelization. i_omp introduced, because first
    94 ! index where fluxes on left side have to be calculated explicitly is
    95 ! different on each thread. Furthermore the swapping of fluxes is now
    96 ! thread-safe by adding an additional dimension.
    97 !
    98 ! 713 2011-03-30 14:21:21Z suehring
    99 ! File reformatted.
    100 ! Bugfix in vertical advection of w concerning the optimized version for   
    101 ! vector architecture.
    102 ! Constants adv_mom_3, adv_mom_5, adv_sca_5, adv_sca_3 reformulated as
    103 ! broken numbers.
    104 !
    105 ! 709 2011-03-30 09:31:40Z raasch
    106 ! formatting adjustments
    107 !
    108 ! 705 2011-03-25 11:21:43 Z suehring $
    109 ! Bugfix in declaration of logicals concerning outflow boundaries.
    110 !
    111 ! 411 2009-12-11 12:31:43 Z suehring
    112 ! Allocation of weight_substep moved to init_3d_model.
    113 ! Declaration of ws_scheme_sca and ws_scheme_mom moved to check_parameters.
    114 ! Setting bc for the horizontal velocity variances added (moved from
    115 ! flow_statistics).
    116 !
    11793! Initial revision
    11894!
    … …  
    186162    SUBROUTINE ws_init
    187163
    188        USE arrays_3d
    189        USE constants
    190        USE control_parameters
    191        USE indices
     164       USE arrays_3d,                                                          &
     165           ONLY:  diss_l_e, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr,         &
     166                  diss_l_sa, diss_l_u, diss_l_v, diss_l_w,  flux_l_e,          &
     167                  flux_l_nr, flux_l_pt, flux_l_q, flux_l_qr, flux_l_sa,        &
     168                  flux_l_u, flux_l_v, flux_l_w, diss_s_e, diss_s_nr, diss_s_pt,&
     169                  diss_s_q, diss_s_qr, diss_s_sa, diss_s_u, diss_s_v, diss_s_w,&
     170                  flux_s_e, flux_s_nr, flux_s_pt, flux_s_q, flux_s_qr,         &
     171                  flux_s_sa, flux_s_u, flux_s_v, flux_s_w
     172
     173       USE constants,                                                          &
     174           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5, adv_sca_1, adv_sca_3,       &
     175                  adv_sca_5
     176
     177       USE control_parameters,                                                 &
     178           ONLY:  cloud_physics, humidity, icloud_scheme, loop_optimization,   &
     179                  passive_scalar, precipitation, ocean, ws_scheme_mom,         &
     180                  ws_scheme_sca
     181
     182       USE indices,                                                            &
     183           ONLY:  nyn, nys, nzb, nzt 
     184       
    192185       USE pegrid
    193        USE statistics
     186
     187       USE statistics,                                                         &
     188           ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,&
     189                  sums_wspts_ws_l, sums_wsqrs_ws_l, sums_wsqs_ws_l,            &
     190                  sums_wssas_ws_l,  sums_wsus_ws_l, sums_wsvs_ws_l 
    194191
    195192!
    … …  
    205202       IF ( ws_scheme_mom )  THEN
    206203
    207           ALLOCATE( sums_wsus_ws_l(nzb:nzt+1,0:threads_per_task-1),  &
    208                     sums_wsvs_ws_l(nzb:nzt+1,0:threads_per_task-1),  &
    209                     sums_us2_ws_l(nzb:nzt+1,0:threads_per_task-1),   &
    210                     sums_vs2_ws_l(nzb:nzt+1,0:threads_per_task-1),   &
     204          ALLOCATE( sums_wsus_ws_l(nzb:nzt+1,0:threads_per_task-1),            &
     205                    sums_wsvs_ws_l(nzb:nzt+1,0:threads_per_task-1),            &
     206                    sums_us2_ws_l(nzb:nzt+1,0:threads_per_task-1),             &
     207                    sums_vs2_ws_l(nzb:nzt+1,0:threads_per_task-1),             &
    211208                    sums_ws2_ws_l(nzb:nzt+1,0:threads_per_task-1) )
    212209
    … …  
    229226          ENDIF
    230227
    231           IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.  &
     228          IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.                 &
    232229               precipitation )  THEN
    233230             ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
    … …  
    253250          IF ( ws_scheme_mom )  THEN
    254251
    255              ALLOCATE( flux_s_u(nzb+1:nzt,0:threads_per_task-1),            &
    256                        flux_s_v(nzb+1:nzt,0:threads_per_task-1),            &
    257                        flux_s_w(nzb+1:nzt,0:threads_per_task-1),            &
    258                        diss_s_u(nzb+1:nzt,0:threads_per_task-1),            &
    259                        diss_s_v(nzb+1:nzt,0:threads_per_task-1),            &
     252             ALLOCATE( flux_s_u(nzb+1:nzt,0:threads_per_task-1),               &
     253                       flux_s_v(nzb+1:nzt,0:threads_per_task-1),               &
     254                       flux_s_w(nzb+1:nzt,0:threads_per_task-1),               &
     255                       diss_s_u(nzb+1:nzt,0:threads_per_task-1),               &
     256                       diss_s_v(nzb+1:nzt,0:threads_per_task-1),               &
    260257                       diss_s_w(nzb+1:nzt,0:threads_per_task-1) )
    261              ALLOCATE( flux_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    262                        flux_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    263                        flux_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    264                        diss_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    265                        diss_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
     258             ALLOCATE( flux_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     259                       flux_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     260                       flux_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     261                       diss_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     262                       diss_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
    266263                       diss_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    267264
    … …  
    270267          IF ( ws_scheme_sca )  THEN
    271268
    272              ALLOCATE( flux_s_pt(nzb+1:nzt,0:threads_per_task-1),           &
    273                        flux_s_e(nzb+1:nzt,0:threads_per_task-1),            &
    274                        diss_s_pt(nzb+1:nzt,0:threads_per_task-1),           &
     269             ALLOCATE( flux_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
     270                       flux_s_e(nzb+1:nzt,0:threads_per_task-1),               &
     271                       diss_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
    275272                       diss_s_e(nzb+1:nzt,0:threads_per_task-1) )
    276              ALLOCATE( flux_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
    277                        flux_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    278                        diss_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
     273             ALLOCATE( flux_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
     274                       flux_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     275                       diss_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
    279276                       diss_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    280277
    281278             IF ( humidity  .OR.  passive_scalar )  THEN
    282                 ALLOCATE( flux_s_q(nzb+1:nzt,0:threads_per_task-1),          &
     279                ALLOCATE( flux_s_q(nzb+1:nzt,0:threads_per_task-1),            &
    283280                          diss_s_q(nzb+1:nzt,0:threads_per_task-1) )
    284                 ALLOCATE( flux_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1),  &
     281                ALLOCATE( flux_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    285282                          diss_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    286283             ENDIF
    287284
    288              IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.            &
     285             IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.              &
    289286                  precipitation )  THEN
    290                 ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1),         &
    291                           diss_s_qr(nzb+1:nzt,0:threads_per_task-1),         &
    292                           flux_s_nr(nzb+1:nzt,0:threads_per_task-1),         &
     287                ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1),           &
     288                          diss_s_qr(nzb+1:nzt,0:threads_per_task-1),           &
     289                          flux_s_nr(nzb+1:nzt,0:threads_per_task-1),           &
    293290                          diss_s_nr(nzb+1:nzt,0:threads_per_task-1) )
    294                 ALLOCATE( flux_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
    295                           diss_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
    296                           flux_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
     291                ALLOCATE( flux_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
     292                          diss_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
     293                          flux_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
    297294                          diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    298295             ENDIF
    299296
    300297             IF ( ocean )  THEN
    301                 ALLOCATE( flux_s_sa(nzb+1:nzt,0:threads_per_task-1),         &
     298                ALLOCATE( flux_s_sa(nzb+1:nzt,0:threads_per_task-1),           &
    302299                          diss_s_sa(nzb+1:nzt,0:threads_per_task-1) )
    303                 ALLOCATE( flux_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &
     300                ALLOCATE( flux_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
    304301                          diss_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    305302             ENDIF
    … …  
    317314    SUBROUTINE ws_statistics
    318315   
    319        USE control_parameters
    320        USE statistics
     316       USE control_parameters,                                                 &
     317           ONLY:  cloud_physics, humidity, icloud_scheme, passive_scalar,      &
     318                  precipitation, ocean, ws_scheme_mom, ws_scheme_sca
     319
     320       USE statistics,                                                         &
     321           ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,&
     322                  sums_wspts_ws_l, sums_wsqrs_ws_l, sums_wsqs_ws_l,            &
     323                  sums_wssas_ws_l,  sums_wsus_ws_l, sums_wsvs_ws_l 
    321324
    322325       IMPLICIT NONE
    … …  
    336339          sums_wspts_ws_l = 0.0
    337340          IF ( humidity  .OR.  passive_scalar )  sums_wsqs_ws_l = 0.0
    338           IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.  &
     341          IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.                 &
    339342               precipitation )  THEN
    340343             sums_wsqrs_ws_l = 0.0
    … …  
    351354! Scalar advection - Call for grid point i,j
    352355!------------------------------------------------------------------------------!
    353     SUBROUTINE advec_s_ws_ij( i, j, sk, sk_char, swap_flux_y_local,  &
    354                               swap_diss_y_local, swap_flux_x_local,  &
     356    SUBROUTINE advec_s_ws_ij( i, j, sk, sk_char, swap_flux_y_local,            &
     357                              swap_diss_y_local, swap_flux_x_local,            &
    355358                              swap_diss_x_local, i_omp, tn )
    356359
    357        USE arrays_3d
    358        USE constants
    359        USE control_parameters
    360        USE grid_variables
    361        USE indices
     360       USE arrays_3d,                                                          &
     361           ONLY:  ddzw, tend, u, v, w
     362
     363       USE constants,                                                          &
     364           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
     365
     366       USE control_parameters,                                                 &
     367           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     368
     369       USE grid_variables,                                                     &
     370           ONLY:  ddx, ddy
     371
     372       USE indices,                                                            &
     373           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
     374
     375       USE kinds
     376
    362377       USE pegrid
    363        USE statistics
     378
     379       USE statistics,                                                         &
     380           ONLY:  sums_wsnrs_ws_l, sums_wspts_ws_l, sums_wsqrs_ws_l,           &
     381                  sums_wsqs_ws_l, sums_wssas_ws_l, weight_substep
    364382
    365383       IMPLICIT NONE
    366384
    367        INTEGER ::  i, ibit0, ibit1, ibit2, ibit3, ibit4, ibit5, ibit6,        &
    368                    ibit7, ibit8, i_omp, j, k, k_mm, k_pp, k_ppp,  tn
    369        REAL    ::  diss_d, div, flux_d, u_comp, v_comp
     385       CHARACTER (LEN = *), INTENT(IN) ::  sk_char !:
     386       
     387       INTEGER(iwp) ::  i     !:
     388       INTEGER(iwp) ::  ibit0 !:
     389       INTEGER(iwp) ::  ibit1 !:
     390       INTEGER(iwp) ::  ibit2 !:
     391       INTEGER(iwp) ::  ibit3 !:
     392       INTEGER(iwp) ::  ibit4 !:
     393       INTEGER(iwp) ::  ibit5 !:
     394       INTEGER(iwp) ::  ibit6 !:
     395       INTEGER(iwp) ::  ibit7 !:
     396       INTEGER(iwp) ::  ibit8 !:
     397       INTEGER(iwp) ::  i_omp !:
     398       INTEGER(iwp) ::  j     !:
     399       INTEGER(iwp) ::  k     !:
     400       INTEGER(iwp) ::  k_mm  !:
     401       INTEGER(iwp) ::  k_pp  !:
     402       INTEGER(iwp) ::  k_ppp !:
     403       INTEGER(iwp) ::  tn    !:
     404       
     405       REAL(wp)     ::  diss_d !:
     406       REAL(wp)     ::  div    !:
     407       REAL(wp)     ::  flux_d !:
     408       REAL(wp)     ::  u_comp !:
     409       REAL(wp)     ::  v_comp !:
     410       
    370411#if defined( __nopointer )
    371        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     412       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    372413#else
    373        REAL, DIMENSION(:,:,:), POINTER    ::  sk
     414       REAL(wp), DIMENSION(:,:,:), POINTER    ::  sk     !:
    374415#endif
    375        REAL, DIMENSION(nzb:nzt+1)         ::  diss_n, diss_r, diss_t, flux_n,  &
    376                                               flux_r, flux_t
    377        REAL, DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local,  &
    378                                                            swap_flux_y_local
    379        REAL, DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::              &
    380                                                           swap_diss_x_local,   &
    381                                                           swap_flux_x_local
    382        CHARACTER (LEN = *), INTENT(IN)    ::  sk_char
     416       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n !:
     417       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r !:
     418       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t !:
     419       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n !:
     420       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r !:
     421       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t !:
     422       
     423       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !:
     424       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !:
     425       
     426       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !:
     427       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !:
     428       
    383429
    384430!
    … …  
    800846    SUBROUTINE advec_u_ws_ij( i, j, i_omp, tn )
    801847
    802        USE arrays_3d
    803        USE constants
    804        USE control_parameters
    805        USE grid_variables
    806        USE indices
    807        USE statistics
     848       USE arrays_3d,                                                          &
     849           ONLY:  ddzw, diss_l_u, diss_s_u, flux_l_u, flux_s_u, tend, u, v, w
     850
     851       USE constants,                                                          &
     852           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     853
     854       USE control_parameters,                                                 &
     855           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     856
     857       USE grid_variables,                                                     &
     858           ONLY:  ddx, ddy
     859
     860       USE indices,                                                            &
     861           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
     862
     863       USE kinds
     864
     865       USE statistics,                                                         &
     866           ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
    808867
    809868       IMPLICIT NONE
    810869
    811        INTEGER ::  i, ibit9, ibit10, ibit11, ibit12, ibit13, ibit14, ibit15,  &
    812                    ibit16, ibit17, i_omp, j, k, k_mm, k_pp, k_ppp, tn
    813        REAL    ::  diss_d, div, flux_d, gu, gv, u_comp_l, v_comp, w_comp
    814        REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r,  &
    815                                      flux_t, u_comp
     870       INTEGER(iwp) ::  i      !:
     871       INTEGER(iwp) ::  ibit9  !:
     872       INTEGER(iwp) ::  ibit10 !:
     873       INTEGER(iwp) ::  ibit11 !:
     874       INTEGER(iwp) ::  ibit12 !:
     875       INTEGER(iwp) ::  ibit13 !:
     876       INTEGER(iwp) ::  ibit14 !:
     877       INTEGER(iwp) ::  ibit15 !:
     878       INTEGER(iwp) ::  ibit16 !:
     879       INTEGER(iwp) ::  ibit17 !:
     880       INTEGER(iwp) ::  i_omp  !:
     881       INTEGER(iwp) ::  j      !:
     882       INTEGER(iwp) ::  k      !:
     883       INTEGER(iwp) ::  k_mm   !:
     884       INTEGER(iwp) ::  k_pp   !:
     885       INTEGER(iwp) ::  k_ppp  !:
     886       INTEGER(iwp) ::  tn     !:
     887       
     888       REAL(wp)    ::  diss_d   !:
     889       REAL(wp)    ::  div      !:
     890       REAL(wp)    ::  flux_d   !:
     891       REAL(wp)    ::  gu       !:
     892       REAL(wp)    ::  gv       !:
     893       REAL(wp)    ::  u_comp_l !:
     894       REAL(wp)    ::  v_comp   !:
     895       REAL(wp)    ::  w_comp   !:
     896       
     897       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !:
     898       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !:
     899       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !:
     900       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !:
     901       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !:
     902       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !:
     903       REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !:
    816904
    817905       gu = 2.0 * u_gtrans
    … …  
    12121300   SUBROUTINE advec_v_ws_ij( i, j, i_omp, tn )
    12131301
    1214        USE arrays_3d
    1215        USE constants
    1216        USE control_parameters
    1217        USE grid_variables
    1218        USE indices
    1219        USE statistics
     1302       USE arrays_3d,                                                          &
     1303           ONLY:  ddzw, diss_l_v, diss_s_v, flux_l_v, flux_s_v, tend, u, v, w
     1304
     1305       USE constants,                                                          &
     1306           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     1307
     1308       USE control_parameters,                                                 &
     1309           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     1310
     1311       USE grid_variables,                                                     &
     1312           ONLY:  ddx, ddy
     1313
     1314       USE indices,                                                            &
     1315           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
     1316
     1317       USE kinds
     1318
     1319       USE statistics,                                                         &
     1320           ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
    12201321
    12211322       IMPLICIT NONE
    12221323
    1223        INTEGER  ::  i, ibit18, ibit19, ibit20, ibit21, ibit22, ibit23, ibit24, &
    1224                     ibit25, ibit26, i_omp, j, k, k_mm, k_pp, k_ppp, tn
    1225        REAL     ::  diss_d, div, flux_d, gu, gv, u_comp, v_comp_l, w_comp
    1226        REAL, DIMENSION(nzb:nzt+1)  :: diss_n, diss_r, diss_t, flux_n, flux_r,  &
    1227                                       flux_t, v_comp
     1324       INTEGER(iwp)  ::  i      !:
     1325       INTEGER(iwp)  ::  ibit18 !:
     1326       INTEGER(iwp)  ::  ibit19 !:
     1327       INTEGER(iwp)  ::  ibit20 !:
     1328       INTEGER(iwp)  ::  ibit21 !:
     1329       INTEGER(iwp)  ::  ibit22 !:
     1330       INTEGER(iwp)  ::  ibit23 !:
     1331       INTEGER(iwp)  ::  ibit24 !:
     1332       INTEGER(iwp)  ::  ibit25 !:
     1333       INTEGER(iwp)  ::  ibit26 !:
     1334       INTEGER(iwp)  ::  i_omp  !:
     1335       INTEGER(iwp)  ::  j      !:
     1336       INTEGER(iwp)  ::  k      !:
     1337       INTEGER(iwp)  ::  k_mm   !:
     1338       INTEGER(iwp)  ::  k_pp   !:
     1339       INTEGER(iwp)  ::  k_ppp  !:
     1340       INTEGER(iwp)  ::  tn     !:
     1341       
     1342       REAL(wp)     ::  diss_d   !:
     1343       REAL(wp)     ::  div      !:
     1344       REAL(wp)     ::  flux_d   !:
     1345       REAL(wp)     ::  gu       !:
     1346       REAL(wp)     ::  gv       !:
     1347       REAL(wp)     ::  u_comp   !:
     1348       REAL(wp)     ::  v_comp_l !:
     1349       REAL(wp)     ::  w_comp   !:
     1350       
     1351       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !:
     1352       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !:
     1353       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !:
     1354       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !:
     1355       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !:
     1356       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !:
     1357       REAL(wp), DIMENSION(nzb:nzt+1)  ::  v_comp !:
    12281358
    12291359       gu = 2.0 * u_gtrans
    … …  
    16311761    SUBROUTINE advec_w_ws_ij( i, j, i_omp, tn )
    16321762
    1633        USE arrays_3d
    1634        USE constants
    1635        USE control_parameters
    1636        USE grid_variables
    1637        USE indices
    1638        USE statistics
     1763       USE arrays_3d,                                                          &
     1764           ONLY:  ddzu, diss_l_w, diss_s_w, flux_l_w, flux_s_w, tend, u, v, w
     1765
     1766       USE constants,                                                          &
     1767           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     1768
     1769       USE control_parameters,                                                 &
     1770           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     1771
     1772       USE grid_variables,                                                     &
     1773           ONLY:  ddx, ddy
     1774
     1775       USE indices,                                                            &
     1776           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,         &
     1777                  wall_flags_00
     1778
     1779       USE kinds
     1780       
     1781       USE statistics,                                                         &
     1782           ONLY:  hom, sums_ws2_ws_l, weight_substep
    16391783
    16401784       IMPLICIT NONE
    16411785
    1642        INTEGER ::  i, ibit27, ibit28, ibit29, ibit30, ibit31, ibit32, ibit33, &
    1643                    ibit34, ibit35, i_omp, j, k, k_mm, k_pp, k_ppp, tn
    1644        REAL    ::  diss_d, div, flux_d, gu, gv, u_comp, v_comp, w_comp
    1645        REAL, DIMENSION(nzb:nzt+1)  :: diss_n, diss_r, diss_t, flux_n, flux_r, &
    1646                                       flux_t
     1786       INTEGER(iwp) ::  i      !:
     1787       INTEGER(iwp) ::  ibit27 !:
     1788       INTEGER(iwp) ::  ibit28 !:
     1789       INTEGER(iwp) ::  ibit29 !:
     1790       INTEGER(iwp) ::  ibit30 !:
     1791       INTEGER(iwp) ::  ibit31 !:
     1792       INTEGER(iwp) ::  ibit32 !:
     1793       INTEGER(iwp) ::  ibit33 !:
     1794       INTEGER(iwp) ::  ibit34 !:
     1795       INTEGER(iwp) ::  ibit35 !:
     1796       INTEGER(iwp) ::  i_omp  !:
     1797       INTEGER(iwp) ::  j      !:
     1798       INTEGER(iwp) ::  k      !:
     1799       INTEGER(iwp) ::  k_mm   !:
     1800       INTEGER(iwp) ::  k_pp   !:
     1801       INTEGER(iwp) ::  k_ppp  !:
     1802       INTEGER(iwp) ::  tn     !:
     1803       
     1804       REAL(wp)    ::  diss_d  !:
     1805       REAL(wp)    ::  div     !:
     1806       REAL(wp)    ::  flux_d  !:
     1807       REAL(wp)    ::  gu      !:
     1808       REAL(wp)    ::  gv      !:
     1809       REAL(wp)    ::  u_comp  !:
     1810       REAL(wp)    ::  v_comp  !:
     1811       REAL(wp)    ::  w_comp  !:
     1812       
     1813       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !:
     1814       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !:
     1815       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !:
     1816       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !:
     1817       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !:
     1818       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !:
    16471819
    16481820       gu = 2.0 * u_gtrans
    … …  
    20272199    SUBROUTINE advec_s_ws( sk, sk_char )
    20282200
    2029        USE arrays_3d
    2030        USE constants
    2031        USE control_parameters
    2032        USE grid_variables
    2033        USE indices
    2034        USE statistics
     2201       USE arrays_3d,                                                          &
     2202           ONLY:  ddzw, tend, u, v, w
     2203
     2204       USE constants,                                                          &
     2205           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
     2206
     2207       USE control_parameters,                                                 &
     2208           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     2209
     2210       USE grid_variables,                                                     &
     2211           ONLY:  ddx, ddy
     2212
     2213       USE indices,                                                            &
     2214           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
     2215           
     2216       USE kinds
     2217       
     2218       USE statistics,                                                         &
     2219           ONLY:  sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,            &
     2220                  weight_substep
    20352221
    20362222       IMPLICIT NONE
    20372223
    2038        INTEGER ::  i, ibit0, ibit1, ibit2, ibit3, ibit4, ibit5, ibit6,        &
    2039                    ibit7, ibit8, j, k, k_mm, k_pp, k_ppp, tn = 0
     2224       CHARACTER (LEN = *), INTENT(IN)    ::  sk_char !:
     2225       
     2226       INTEGER(iwp) ::  i      !:
     2227       INTEGER(iwp) ::  ibit0  !:
     2228       INTEGER(iwp) ::  ibit1  !:
     2229       INTEGER(iwp) ::  ibit2  !:
     2230       INTEGER(iwp) ::  ibit3  !:
     2231       INTEGER(iwp) ::  ibit4  !:
     2232       INTEGER(iwp) ::  ibit5  !:
     2233       INTEGER(iwp) ::  ibit6  !:
     2234       INTEGER(iwp) ::  ibit7  !:
     2235       INTEGER(iwp) ::  ibit8  !:
     2236       INTEGER(iwp) ::  j      !:
     2237       INTEGER(iwp) ::  k      !:
     2238       INTEGER(iwp) ::  k_mm   !:
     2239       INTEGER(iwp) ::  k_pp   !:
     2240       INTEGER(iwp) ::  k_ppp  !:
     2241       INTEGER(iwp) ::  tn = 0 !:
     2242       
    20402243#if defined( __nopointer )
    2041        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk
     2244       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !:
    20422245#else
    2043        REAL, DIMENSION(:,:,:), POINTER ::  sk
     2246       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk !:
    20442247#endif
    2045        REAL ::  diss_d, div, flux_d, u_comp, v_comp
    2046        REAL, DIMENSION(nzb:nzt)   ::  diss_n, diss_r, diss_t, flux_n, flux_r,  &
    2047                                       flux_t
    2048        REAL, DIMENSION(nzb+1:nzt) ::  swap_diss_y_local, swap_flux_y_local
    2049        REAL, DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local,               &
    2050                                               swap_flux_x_local
    2051        CHARACTER (LEN = *), INTENT(IN)    ::  sk_char
     2248
     2249       REAL(wp) ::  diss_d !:
     2250       REAL(wp) ::  div    !:
     2251       REAL(wp) ::  flux_d !:
     2252       REAL(wp) ::  u_comp !:
     2253       REAL(wp) ::  v_comp !:
     2254       
     2255       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_n !:
     2256       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_r !:
     2257       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_t !:
     2258       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_n !:
     2259       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_r !:
     2260       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_t !:
     2261       
     2262       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local !:
     2263       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local !:
     2264       
     2265       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local !:
     2266       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local !:
     2267       
    20522268
    20532269!
    … …  
    24392655    SUBROUTINE advec_s_ws_acc ( sk, sk_char )
    24402656
    2441        USE arrays_3d
    2442        USE constants
    2443        USE control_parameters
    2444        USE grid_variables
    2445        USE indices
    2446        USE statistics
     2657       USE arrays_3d,                                                          &
     2658           ONLY:  ddzw, tend, u, v, w
     2659
     2660       USE constants,                                                          &
     2661           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
     2662
     2663       USE control_parameters,                                                 &
     2664           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     2665
     2666       USE grid_variables,                                                     &
     2667           ONLY:  ddx, ddy
     2668
     2669       USE indices,                                                            &
     2670           ONLY:  i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,   &
     2671                  nzb, nzb_max, nzt, wall_flags_0
     2672
     2673       USE kinds
     2674       
     2675!        USE statistics,                                                       &
     2676!            ONLY:  sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,          &
     2677!                   weight_substep
    24472678
    24482679       IMPLICIT NONE
    24492680
    2450        CHARACTER (LEN = *), INTENT(IN)    :: sk_char
    2451 
    2452        INTEGER ::  i, ibit0, ibit1, ibit2, ibit3, ibit4, ibit5, ibit6,        &
    2453                    ibit7, ibit8, j, k, k_mm, k_mmm, k_pp, k_ppp, tn = 0
    2454 
    2455        REAL    :: diss_d, diss_l, diss_n, diss_r, diss_s, diss_t, div, flux_d, &
    2456                   flux_l, flux_n, flux_r, flux_s, flux_t, u_comp, v_comp
    2457 
    2458        REAL, INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  ::  sk
     2681       CHARACTER (LEN = *), INTENT(IN)    :: sk_char !:
     2682
     2683       INTEGER(iwp) ::  i      !:
     2684       INTEGER(iwp) ::  ibit0  !:
     2685       INTEGER(iwp) ::  ibit1  !:
     2686       INTEGER(iwp) ::  ibit2  !:
     2687       INTEGER(iwp) ::  ibit3  !:
     2688       INTEGER(iwp) ::  ibit4  !:
     2689       INTEGER(iwp) ::  ibit5  !:
     2690       INTEGER(iwp) ::  ibit6  !:
     2691       INTEGER(iwp) ::  ibit7  !:
     2692       INTEGER(iwp) ::  ibit8  !:
     2693       INTEGER(iwp) ::  j      !:
     2694       INTEGER(iwp) ::  k      !:
     2695       INTEGER(iwp) ::  k_mm   !:
     2696       INTEGER(iwp) ::  k_mmm  !:
     2697       INTEGER(iwp) ::  k_pp   !:
     2698       INTEGER(iwp) ::  k_ppp  !:
     2699       INTEGER(iwp) ::  tn = 0 !:
     2700
     2701       REAL(wp)    ::  diss_d !:
     2702       REAL(wp)    ::  diss_l !:
     2703       REAL(wp)    ::  diss_n !:
     2704       REAL(wp)    ::  diss_r !:
     2705       REAL(wp)    ::  diss_s !:
     2706       REAL(wp)    ::  diss_t !:
     2707       REAL(wp)    ::  div    !:
     2708       REAL(wp)    ::  flux_d !:
     2709       REAL(wp)    ::  flux_l !:
     2710       REAL(wp)    ::  flux_n !:
     2711       REAL(wp)    ::  flux_r !:
     2712       REAL(wp)    ::  flux_s !:
     2713       REAL(wp)    ::  flux_t !:
     2714       REAL(wp)    ::  u_comp !:
     2715       REAL(wp)    ::  v_comp !:
     2716
     2717       REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  ::  sk !:
    24592718
    24602719!
    … …  
    27192978    SUBROUTINE advec_u_ws
    27202979
    2721        USE arrays_3d
    2722        USE constants
    2723        USE control_parameters
    2724        USE grid_variables
    2725        USE indices
    2726        USE statistics
     2980       USE arrays_3d,                                                          &
     2981           ONLY:  ddzw, tend, u, v, w
     2982
     2983       USE constants,                                                          &
     2984           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     2985
     2986       USE control_parameters,                                                 &
     2987           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     2988
     2989       USE grid_variables,                                                     &
     2990           ONLY:  ddx, ddy
     2991
     2992       USE indices,                                                            &
     2993           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
     2994           
     2995       USE kinds
     2996       
     2997       USE statistics,                                                         &
     2998           ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
    27272999
    27283000       IMPLICIT NONE
    27293001
    2730        INTEGER ::  i, ibit9, ibit10, ibit11, ibit12, ibit13, ibit14, ibit15,   &
    2731                    ibit16, ibit17, j, k, k_mm, k_pp, k_ppp, tn = 0
    2732        REAL    ::  diss_d, div, flux_d, gu, gv, v_comp, w_comp
    2733        REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local_u, swap_flux_y_local_u
    2734        REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_u,              &
    2735                                              swap_flux_x_local_u
    2736        REAL, DIMENSION(nzb:nzt) :: diss_n, diss_r, diss_t, flux_n, flux_r,     &
    2737                                    flux_t, u_comp
     3002       INTEGER(iwp) ::  i      !:
     3003       INTEGER(iwp) ::  ibit9  !:
     3004       INTEGER(iwp) ::  ibit10 !:
     3005       INTEGER(iwp) ::  ibit11 !:
     3006       INTEGER(iwp) ::  ibit12 !:
     3007       INTEGER(iwp) ::  ibit13 !:
     3008       INTEGER(iwp) ::  ibit14 !:
     3009       INTEGER(iwp) ::  ibit15 !:
     3010       INTEGER(iwp) ::  ibit16 !:
     3011       INTEGER(iwp) ::  ibit17 !:
     3012       INTEGER(iwp) ::  j      !:
     3013       INTEGER(iwp) ::  k      !:
     3014       INTEGER(iwp) ::  k_mm   !:
     3015       INTEGER(iwp) ::  k_pp   !:
     3016       INTEGER(iwp) ::  k_ppp  !:
     3017       INTEGER(iwp) ::  tn = 0 !:
     3018       
     3019       REAL(wp)    ::  diss_d !:
     3020       REAL(wp)    ::  div    !:
     3021       REAL(wp)    ::  flux_d !:
     3022       REAL(wp)    ::  gu     !:
     3023       REAL(wp)    ::  gv     !:
     3024       REAL(wp)    ::  v_comp !:
     3025       REAL(wp)    ::  w_comp !:
     3026       
     3027       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_u !:
     3028       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_u !:
     3029       
     3030       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_u !:
     3031       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_u !:
     3032       
     3033       REAL(wp), DIMENSION(nzb:nzt) ::  diss_n !:
     3034       REAL(wp), DIMENSION(nzb:nzt) ::  diss_r !:
     3035       REAL(wp), DIMENSION(nzb:nzt) ::  diss_t !:
     3036       REAL(wp), DIMENSION(nzb:nzt) ::  flux_n !:
     3037       REAL(wp), DIMENSION(nzb:nzt) ::  flux_r !:
     3038       REAL(wp), DIMENSION(nzb:nzt) ::  flux_t !:
     3039       REAL(wp), DIMENSION(nzb:nzt) ::  u_comp !:
    27383040 
    27393041       gu = 2.0 * u_gtrans
    … …  
    31373439    SUBROUTINE advec_u_ws_acc
    31383440
    3139        USE arrays_3d
    3140        USE constants
    3141        USE control_parameters
    3142        USE grid_variables
    3143        USE indices
    3144        USE statistics
     3441       USE arrays_3d,                                                          &
     3442           ONLY:  ddzw, tend, u, v, w
     3443
     3444       USE constants,                                                          &
     3445           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     3446
     3447       USE control_parameters,                                                 &
     3448           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     3449
     3450       USE grid_variables,                                                     &
     3451           ONLY:  ddx, ddy
     3452
     3453       USE indices,                                                            &
     3454           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
     3455                  nzb_max, nzt, wall_flags_0
     3456           
     3457       USE kinds
     3458       
     3459!        USE statistics,                                                       &
     3460!            ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
    31453461
    31463462       IMPLICIT NONE
    31473463
    3148        INTEGER ::  i, ibit9, ibit10, ibit11, ibit12, ibit13, ibit14, ibit15,   &
    3149                    ibit16, ibit17, j, k, k_mmm, k_mm, k_pp, k_ppp, tn = 0
    3150 
    3151        REAL    ::  diss_d, diss_l, diss_n, diss_r, diss_s, diss_t, div,    &
    3152                    flux_d, flux_l, flux_n, flux_r, flux_s, flux_t, gu, gv, &
    3153                    u_comp, u_comp_l, v_comp, v_comp_s, w_comp
     3464       INTEGER(iwp) ::  i      !:
     3465       INTEGER(iwp) ::  ibit9  !:
     3466       INTEGER(iwp) ::  ibit10 !:
     3467       INTEGER(iwp) ::  ibit11 !:
     3468       INTEGER(iwp) ::  ibit12 !:
     3469       INTEGER(iwp) ::  ibit13 !:
     3470       INTEGER(iwp) ::  ibit14 !:
     3471       INTEGER(iwp) ::  ibit15 !:
     3472       INTEGER(iwp) ::  ibit16 !:
     3473       INTEGER(iwp) ::  ibit17 !:
     3474       INTEGER(iwp) ::  j      !:
     3475       INTEGER(iwp) ::  k      !:
     3476       INTEGER(iwp) ::  k_mmm  !:
     3477       INTEGER(iwp) ::  k_mm   !:
     3478       INTEGER(iwp) ::  k_pp   !:
     3479       INTEGER(iwp) ::  k_ppp  !:
     3480       INTEGER(iwp) ::  tn = 0 !:
     3481
     3482       REAL(wp)    ::  diss_d   !:
     3483       REAL(wp)    ::  diss_l   !:
     3484       REAL(wp)    ::  diss_n   !:
     3485       REAL(wp)    ::  diss_r   !:
     3486       REAL(wp)    ::  diss_s   !:
     3487       REAL(wp)    ::  diss_t   !:
     3488       REAL(wp)    ::  div      !:
     3489       REAL(wp)    ::  flux_d   !:
     3490       REAL(wp)    ::  flux_l   !:
     3491       REAL(wp)    ::  flux_n   !:
     3492       REAL(wp)    ::  flux_r   !:
     3493       REAL(wp)    ::  flux_s   !:
     3494       REAL(wp)    ::  flux_t   !:
     3495       REAL(wp)    ::  gu       !:
     3496       REAL(wp)    ::  gv       !:
     3497       REAL(wp)    ::  u_comp   !:
     3498       REAL(wp)    ::  u_comp_l !:
     3499       REAL(wp)    ::  v_comp   !:
     3500       REAL(wp)    ::  v_comp_s !:
     3501       REAL(wp)    ::  w_comp   !:
    31543502
    31553503
    … …  
    34243772    SUBROUTINE advec_v_ws
    34253773
    3426        USE arrays_3d
    3427        USE constants
    3428        USE control_parameters
    3429        USE grid_variables
    3430        USE indices
    3431        USE statistics
     3774       USE arrays_3d,                                                          &
     3775           ONLY:  ddzw, tend, u, v, w
     3776
     3777       USE constants,                                                          &
     3778           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     3779
     3780       USE control_parameters,                                                 &
     3781           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     3782
     3783       USE grid_variables,                                                     &
     3784           ONLY:  ddx, ddy
     3785
     3786       USE indices,                                                            &
     3787           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
     3788
     3789       USE kinds
     3790
     3791       USE statistics,                                                         &
     3792           ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
    34323793
    34333794       IMPLICIT NONE
    34343795
    34353796
    3436        INTEGER ::  i, ibit18, ibit19, ibit20, ibit21, ibit22, ibit23, ibit24, &
    3437                     ibit25, ibit26, j, k, k_mm, k_pp, k_ppp, tn = 0
    3438        REAL    ::  diss_d, div, flux_d, gu, gv, u_comp, w_comp
    3439        REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local_v, swap_flux_y_local_v
    3440        REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_v,             &
    3441                                              swap_flux_x_local_v
    3442        REAL, DIMENSION(nzb:nzt) :: diss_n, diss_r, diss_t, flux_n, flux_r,    &
    3443                                    flux_t, v_comp
     3797       INTEGER(iwp) ::  i      !:
     3798       INTEGER(iwp) ::  ibit18 !:
     3799       INTEGER(iwp) ::  ibit19 !:
     3800       INTEGER(iwp) ::  ibit20 !:
     3801       INTEGER(iwp) ::  ibit21 !:
     3802       INTEGER(iwp) ::  ibit22 !:
     3803       INTEGER(iwp) ::  ibit23 !:
     3804       INTEGER(iwp) ::  ibit24 !:
     3805       INTEGER(iwp) ::  ibit25 !:
     3806       INTEGER(iwp) ::  ibit26 !:
     3807       INTEGER(iwp) ::  j      !:
     3808       INTEGER(iwp) ::  k      !:
     3809       INTEGER(iwp) ::  k_mm   !:
     3810       INTEGER(iwp) ::  k_pp   !:
     3811       INTEGER(iwp) ::  k_ppp  !:
     3812       INTEGER(iwp) ::  tn = 0 !:
     3813       
     3814       REAL(wp)    ::  diss_d !:
     3815       REAL(wp)    ::  div    !:
     3816       REAL(wp)    ::  flux_d !:
     3817       REAL(wp)    ::  gu     !:
     3818       REAL(wp)    ::  gv     !:
     3819       REAL(wp)    ::  u_comp !:
     3820       REAL(wp)    ::  w_comp !:
     3821       
     3822       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_v !:
     3823       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_v !:
     3824       
     3825       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_v !:
     3826       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_v !:
     3827       
     3828       REAL(wp), DIMENSION(nzb:nzt) ::  diss_n !:
     3829       REAL(wp), DIMENSION(nzb:nzt) ::  diss_r !:
     3830       REAL(wp), DIMENSION(nzb:nzt) ::  diss_t !:
     3831       REAL(wp), DIMENSION(nzb:nzt) ::  flux_n !:
     3832       REAL(wp), DIMENSION(nzb:nzt) ::  flux_r !:
     3833       REAL(wp), DIMENSION(nzb:nzt) ::  flux_t !:
     3834       REAL(wp), DIMENSION(nzb:nzt) ::  v_comp !:
    34443835
    34453836       gu = 2.0 * u_gtrans
    … …  
    38524243    SUBROUTINE advec_v_ws_acc
    38534244
    3854        USE arrays_3d
    3855        USE constants
    3856        USE control_parameters
    3857        USE grid_variables
    3858        USE indices
    3859        USE statistics
     4245       USE arrays_3d,                                                          &
     4246           ONLY:  ddzw, tend, u, v, w
     4247
     4248       USE constants,                                                          &
     4249           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     4250
     4251       USE control_parameters,                                                 &
     4252           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     4253
     4254       USE grid_variables,                                                     &
     4255           ONLY:  ddx, ddy
     4256
     4257       USE indices,                                                            &
     4258           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
     4259                  nzb_max, nzt, wall_flags_0
     4260           
     4261       USE kinds
     4262       
     4263!        USE statistics,                                                       &
     4264!            ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
    38604265
    38614266       IMPLICIT NONE
    38624267
    38634268
    3864        INTEGER ::  i, ibit18, ibit19, ibit20, ibit21, ibit22, ibit23, ibit24, &
    3865                     ibit25, ibit26, j, k, k_mm, k_mmm, k_pp, k_ppp, tn = 0
    3866 
    3867        REAL    ::  diss_d, diss_l, diss_n, diss_r, diss_s, diss_t, div,    &
    3868                    flux_d, flux_l, flux_n, flux_r, flux_s, flux_t, gu, gv, &
    3869                    u_comp, u_comp_l, v_comp, v_comp_s, w_comp
     4269       INTEGER(iwp) ::  i      !:
     4270       INTEGER(iwp) ::  ibit18 !:
     4271       INTEGER(iwp) ::  ibit19 !:
     4272       INTEGER(iwp) ::  ibit20 !:
     4273       INTEGER(iwp) ::  ibit21 !:
     4274       INTEGER(iwp) ::  ibit22 !:
     4275       INTEGER(iwp) ::  ibit23 !:
     4276       INTEGER(iwp) ::  ibit24 !:
     4277       INTEGER(iwp) ::  ibit25 !:
     4278       INTEGER(iwp) ::  ibit26 !:
     4279       INTEGER(iwp) ::  j      !:
     4280       INTEGER(iwp) ::  k      !:
     4281       INTEGER(iwp) ::  k_mm   !:
     4282       INTEGER(iwp) ::  k_mmm  !:
     4283       INTEGER(iwp) ::  k_pp   !:
     4284       INTEGER(iwp) ::  k_ppp  !:
     4285       INTEGER(iwp) ::  tn = 0 !:
     4286
     4287       REAL(wp)    ::  diss_d   !:
     4288       REAL(wp)    ::  diss_l   !:
     4289       REAL(wp)    ::  diss_n   !:
     4290       REAL(wp)    ::  diss_r   !:
     4291       REAL(wp)    ::  diss_s   !:
     4292       REAL(wp)    ::  diss_t   !:
     4293       REAL(wp)    ::  div      !:
     4294       REAL(wp)    ::  flux_d   !:
     4295       REAL(wp)    ::  flux_l   !:
     4296       REAL(wp)    ::  flux_n   !:
     4297       REAL(wp)    ::  flux_r   !:
     4298       REAL(wp)    ::  flux_s   !:
     4299       REAL(wp)    ::  flux_t   !:
     4300       REAL(wp)    ::  gu       !:
     4301       REAL(wp)    ::  gv       !:
     4302       REAL(wp)    ::  u_comp   !:
     4303       REAL(wp)    ::  u_comp_l !:
     4304       REAL(wp)    ::  v_comp   !:
     4305       REAL(wp)    ::  v_comp_s !:
     4306       REAL(wp)    ::  w_comp   !:
    38704307
    38714308       gu = 2.0 * u_gtrans
    … …  
    41414578    SUBROUTINE advec_w_ws
    41424579
    4143        USE arrays_3d
    4144        USE constants
    4145        USE control_parameters
    4146        USE grid_variables
    4147        USE indices
    4148        USE statistics
     4580       USE arrays_3d,                                                          &
     4581           ONLY:  ddzu, tend, u, v, w
     4582
     4583       USE constants,                                                          &
     4584           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     4585
     4586       USE control_parameters,                                                 &
     4587           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     4588
     4589       USE grid_variables,                                                     &
     4590           ONLY:  ddx, ddy
     4591
     4592       USE indices,                                                            &
     4593           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,         &
     4594                  wall_flags_00
     4595
     4596       USE kinds
     4597       
     4598       USE statistics,                                                         &
     4599           ONLY:  hom, sums_ws2_ws_l, weight_substep
    41494600
    41504601       IMPLICIT NONE
    41514602
    4152        INTEGER ::  i, ibit27, ibit28, ibit29, ibit30, ibit31, ibit32, ibit33, &
    4153                    ibit34, ibit35, j, k, k_mm, k_pp, k_ppp, tn = 0
    4154        REAL    ::  diss_d, div, flux_d, gu, gv, u_comp, v_comp, w_comp
    4155        REAL, DIMENSION(nzb:nzt)    ::  diss_t, flux_t
    4156        REAL, DIMENSION(nzb+1:nzt)  ::  diss_n, diss_r, flux_n, flux_r,        &
    4157                                        swap_diss_y_local_w,                   &
    4158                                        swap_flux_y_local_w
    4159        REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_w,             &
    4160                                              swap_flux_x_local_w
     4603       INTEGER(iwp) ::  i      !:
     4604       INTEGER(iwp) ::  ibit27 !:
     4605       INTEGER(iwp) ::  ibit28 !:
     4606       INTEGER(iwp) ::  ibit29 !:
     4607       INTEGER(iwp) ::  ibit30 !:
     4608       INTEGER(iwp) ::  ibit31 !:
     4609       INTEGER(iwp) ::  ibit32 !:
     4610       INTEGER(iwp) ::  ibit33 !:
     4611       INTEGER(iwp) ::  ibit34 !:
     4612       INTEGER(iwp) ::  ibit35 !:
     4613       INTEGER(iwp) ::  j      !:
     4614       INTEGER(iwp) ::  k      !:
     4615       INTEGER(iwp) ::  k_mm   !:
     4616       INTEGER(iwp) ::  k_pp   !:
     4617       INTEGER(iwp) ::  k_ppp  !:
     4618       INTEGER(iwp) ::  tn = 0 !:
     4619       
     4620       REAL(wp)    ::  diss_d !:
     4621       REAL(wp)    ::  div    !:
     4622       REAL(wp)    ::  flux_d !:
     4623       REAL(wp)    ::  gu     !:
     4624       REAL(wp)    ::  gv     !:
     4625       REAL(wp)    ::  u_comp !:
     4626       REAL(wp)    ::  v_comp !:
     4627       REAL(wp)    ::  w_comp !:
     4628       
     4629       REAL(wp), DIMENSION(nzb:nzt)    ::  diss_t !:
     4630       REAL(wp), DIMENSION(nzb:nzt)    ::  flux_t !:
     4631       
     4632       REAL(wp), DIMENSION(nzb+1:nzt)  ::  diss_n !:
     4633       REAL(wp), DIMENSION(nzb+1:nzt)  ::  diss_r !:
     4634       REAL(wp), DIMENSION(nzb+1:nzt)  ::  flux_n !:
     4635       REAL(wp), DIMENSION(nzb+1:nzt)  ::  flux_r !:
     4636       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_diss_y_local_w !:
     4637       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_flux_y_local_w !:
     4638       
     4639       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_w !:
     4640       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_w !:
    41614641 
    41624642       gu = 2.0 * u_gtrans
    … …  
    45465026    SUBROUTINE advec_w_ws_acc
    45475027
    4548        USE arrays_3d
    4549        USE constants
    4550        USE control_parameters
    4551        USE grid_variables
    4552        USE indices
    4553        USE statistics
     5028       USE arrays_3d,                                                          &
     5029           ONLY:  ddzu, tend, u, v, w
     5030
     5031       USE constants,                                                          &
     5032           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
     5033
     5034       USE control_parameters,                                                 &
     5035           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
     5036
     5037       USE grid_variables,                                                     &
     5038           ONLY:  ddx, ddy
     5039
     5040       USE indices,                                                            &
     5041           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
     5042                  nzb_max, nzt, wall_flags_0, wall_flags_00
     5043           
     5044       USE kinds
     5045       
     5046!        USE statistics,                                                       &
     5047!            ONLY:  hom, sums_ws2_ws_l, weight_substep
    45545048
    45555049       IMPLICIT NONE
    45565050
    4557        INTEGER ::  i, ibit27, ibit28, ibit29, ibit30, ibit31, ibit32, ibit33, &
    4558                    ibit34, ibit35, j, k, k_mmm, k_mm, k_pp, k_ppp, tn = 0
    4559 
    4560        REAL    ::  diss_d, diss_l, diss_n, diss_r, diss_s, diss_t, div,    &
    4561                    flux_d, flux_l, flux_n, flux_r, flux_s, flux_t, gu, gv, &
    4562                    u_comp, u_comp_l, v_comp, v_comp_s, w_comp
     5051       INTEGER(iwp) ::  i      !:
     5052       INTEGER(iwp) ::  ibit27 !:
     5053       INTEGER(iwp) ::  ibit28 !:
     5054       INTEGER(iwp) ::  ibit29 !:
     5055       INTEGER(iwp) ::  ibit30 !:
     5056       INTEGER(iwp) ::  ibit31 !:
     5057       INTEGER(iwp) ::  ibit32 !:
     5058       INTEGER(iwp) ::  ibit33 !:
     5059       INTEGER(iwp) ::  ibit34 !:
     5060       INTEGER(iwp) ::  ibit35 !:
     5061       INTEGER(iwp) ::  j      !:
     5062       INTEGER(iwp) ::  k      !:
     5063       INTEGER(iwp) ::  k_mmm  !:
     5064       INTEGER(iwp) ::  k_mm   !:
     5065       INTEGER(iwp) ::  k_pp   !:
     5066       INTEGER(iwp) ::  k_ppp  !:
     5067       INTEGER(iwp) ::  tn = 0 !:
     5068
     5069       REAL(wp)    ::  diss_d   !:
     5070       REAL(wp)    ::  diss_l   !:
     5071       REAL(wp)    ::  diss_n   !:
     5072       REAL(wp)    ::  diss_r   !:
     5073       REAL(wp)    ::  diss_s   !:
     5074       REAL(wp)    ::  diss_t   !:
     5075       REAL(wp)    ::  div      !:
     5076       REAL(wp)    ::  flux_d   !:
     5077       REAL(wp)    ::  flux_l   !:
     5078       REAL(wp)    ::  flux_n   !:
     5079       REAL(wp)    ::  flux_r   !:
     5080       REAL(wp)    ::  flux_s   !:
     5081       REAL(wp)    ::  flux_t   !:
     5082       REAL(wp)    ::  gu       !:
     5083       REAL(wp)    ::  gv       !:
     5084       REAL(wp)    ::  u_comp   !:
     5085       REAL(wp)    ::  u_comp_l !:
     5086       REAL(wp)    ::  v_comp   !:
     5087       REAL(wp)    ::  v_comp_s !:
     5088       REAL(wp)    ::  w_comp   !:
    45635089
    45645090       gu = 2.0 * u_gtrans

  • palm/trunk/SOURCE/average_3d_data.f90

    r1319 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    4146! 978 2012-08-09 08:28:32Z fricke
    4247! +z0h_av
    43 !
    44 ! 771 2011-10-27 10:56:21Z heinze
    45 ! +lpt_av
    46 !
    47 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    48 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    49 !
    50 ! 367 2009-08-25 08:35:52Z maronga
    51 ! Added calculation of shf* and qsws*
    52 !
    53 ! 96 2007-06-04 08:07:41Z raasch
    54 ! Averaging of density and salinity
    55 !
    56 ! 72 2007-03-19 08:20:46Z raasch
    57 ! Averaging the precipitation rate and roughness length (prr*, z0*)
    58 !
    59 ! RCS Log replace by Id keyword, revision history cleaned up
    6048!
    6149! Revision 1.1  2006/02/23 09:48:58  raasch
    … …  
    6856!------------------------------------------------------------------------------!
    6957
    70     USE arrays_3d
    7158    USE averaging
    72     USE cloud_parameters
    73     USE control_parameters
    74     USE cpulog
    75     USE indices
     59
     60    USE control_parameters,                                                    &
     61        ONLY:  average_count_3d, doav, doav_n
     62
     63    USE cpulog,                                                                &
     64        ONLY:  cpu_log, log_point
     65
     66    USE indices,                                                               &
     67        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     68
     69    USE kinds
     70
    7671
    7772    IMPLICIT NONE
    7873
    79     INTEGER ::  i, ii, j, k
     74    INTEGER(iwp) ::  i  !:
     75    INTEGER(iwp) ::  ii !:
     76    INTEGER(iwp) ::  j  !:
     77    INTEGER(iwp) ::  k  !:
    8078
    8179
    … …  
    165163             DO  i = nxlg, nxrg
    166164                DO  j = nysg, nyng
    167                    precipitation_rate_av(j,i) = precipitation_rate_av(j,i) / &
     165                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) /   &
    168166                                                REAL( average_count_3d )
    169167                ENDDO
    … …  
    228226                DO  j = nysg, nyng
    229227                   DO  k = nzb, nzt+1
    230                       ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / &
     228                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) /                      &
    231229                                        REAL( average_count_3d )
    232230                   ENDDO

  • palm/trunk/SOURCE/boundary_conds.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328! 
    2429! Former revisions:
    … …  
    6772! 875 2012-04-02 15:35:15Z gryschka
    6873! Bugfix in case of dirichlet inflow bc at the right or north boundary
    69 !
    70 ! 767 2011-10-14 06:39:12Z raasch
    71 ! ug,vg replaced by u_init,v_init as the Dirichlet top boundary condition
    72 !
    73 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    74 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    75 ! Removed mirror boundary conditions for u and v at the bottom in case of
    76 ! ibc_uv_b == 0. Instead, dirichelt boundary conditions (u=v=0) are set
    77 ! in init_3d_model
    78 !
    79 ! 107 2007-08-17 13:54:45Z raasch
    80 ! Boundary conditions for temperature adjusted for coupled runs,
    81 ! bugfixes for the radiation boundary conditions at the outflow: radiation
    82 ! conditions are used for every substep, phase speeds are calculated for the
    83 ! first Runge-Kutta substep only and then reused, several index values changed
    84 !
    85 ! 95 2007-06-02 16:48:38Z raasch
    86 ! Boundary conditions for salinity added
    87 !
    88 ! 75 2007-03-22 09:54:05Z raasch
    89 ! The "main" part sets conditions for time level t+dt instead of level t,
    90 ! outflow boundary conditions changed from Neumann to radiation condition,
    91 ! uxrp, vynp eliminated, moisture renamed humidity
    92 !
    93 ! 19 2007-02-23 04:53:48Z raasch
    94 ! Boundary conditions for e(nzt), pt(nzt), and q(nzt) removed because these
    95 ! gridpoints are now calculated by the prognostic equation,
    96 ! Dirichlet and zero gradient condition for pt established at top boundary
    97 !
    98 ! RCS Log replace by Id keyword, revision history cleaned up
    99 !
    100 ! Revision 1.15  2006/02/23 09:54:55  raasch
    101 ! Surface boundary conditions in case of topography: nzb replaced by
    102 ! 2d-k-index-arrays (nzb_w_inner, etc.). Conditions for u and v remain
    103 ! unchanged (still using nzb) because a non-flat topography must use a
    104 ! Prandtl-layer, which don't requires explicit setting of the surface values.
    10574!
    10675! Revision 1.1  1997/09/12 06:21:34  raasch
    … …  
    11786!------------------------------------------------------------------------------!
    11887
    119     USE arrays_3d
    120     USE control_parameters
    121     USE grid_variables
    122     USE indices
     88    USE arrays_3d,                                                             &
     89        ONLY:  c_u, c_u_m, c_u_m_l, c_v, c_v_m, c_v_m_l, c_w, c_w_m, c_w_m_l,  &
     90               dzu, e_p, nr_p, pt, pt_p, q, q_p, qr_p, sa, sa_p,               &
     91               u, ug, u_init, u_m_l, u_m_n, u_m_r, u_m_s, u_p,                 &
     92               v, vg, v_init, v_m_l, v_m_n, v_m_r, v_m_s, v_p,                 &
     93               w, w_p, w_m_l, w_m_n, w_m_r, w_m_s
     94
     95    USE control_parameters,                                                    &
     96        ONLY:  bc_pt_t_val, bc_q_t_val, constant_diffusion,                    &
     97               cloud_physics, dt_3d, humidity,                                 &
     98               ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_sa_t, ibc_uv_b, ibc_uv_t,      &
     99               icloud_scheme, inflow_l, inflow_n, inflow_r, inflow_s,          &
     100               intermediate_timestep_count, large_scale_forcing, ocean,        &
     101               outflow_l, outflow_n, outflow_r, outflow_s, passive_scalar,     &
     102               precipitation, tsc, use_cmax
     103
     104    USE grid_variables,                                                        &
     105        ONLY:  ddx, ddy, dx, dy
     106
     107    USE indices,                                                               &
     108        ONLY:  nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,             &
     109               nzb, nzb_s_inner, nzb_w_inner, nzt
     110
     111    USE kinds
     112
    123113    USE pegrid
    124114
     115
    125116    IMPLICIT NONE
    126117
    127     INTEGER ::  i, j, k
    128 
    129     REAL    ::  c_max, denom
     118    INTEGER(iwp) ::  i !:
     119    INTEGER(iwp) ::  j !:
     120    INTEGER(iwp) ::  k !:
     121
     122    REAL(wp)    ::  c_max !:
     123    REAL(wp)    ::  denom !:
    130124
    131125
    … …  
    271265       q_p(nzt+1,:,:) = q_p(nzt,:,:)   + bc_q_t_val * dzu(nzt+1)
    272266
    273        IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.  &
     267       IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.                    &
    274268            precipitation )  THEN
    275269!             
    … …  
    312306          IF ( humidity  .OR.  passive_scalar )  THEN
    313307             q_p(:,nys-1,:) = q_p(:,nys,:)
    314              IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.  &
     308             IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.              &
    315309                  precipitation)  THEN
    316310                qr_p(:,nys-1,:) = qr_p(:,nys,:)
    … …  
    323317          IF ( humidity  .OR.  passive_scalar )  THEN
    324318             q_p(:,nyn+1,:) = q_p(:,nyn,:)
    325              IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.  &
     319             IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.              &
    326320                  precipitation )  THEN
    327321                qr_p(:,nyn+1,:) = qr_p(:,nyn,:)
    … …  
    334328          IF ( humidity  .OR.  passive_scalar )  THEN
    335329             q_p(:,:,nxl-1) = q_p(:,:,nxl)
    336              IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.  &
     330             IF ( cloud_physics  .AND.  icloud_scheme == 0  .AND.              &
    337331                  precipitation )  THEN
    338332                qr_p(:,:,nxl-1) = qr_p(:,:,nxl)

  • palm/trunk/SOURCE/buoyancy.f90

    r1310 r1320  
    2020! Currrent revisions:
    2121! ------------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    5560! 1010 2012-09-20 07:59:54Z raasch
    5661! cpp switch __nopointer added for pointer free version
    57 !
    58 ! 622 2010-12-10 08:08:13Z raasch
    59 ! optional barriers included in order to speed up collective operations
    60 !
    61 ! 515 2010-03-18 02:30:38Z raasch
    62 ! PGI-compiler creates SIGFPE in routine buoyancy, if opt>1 is used! Therefore,
    63 ! opt=1 is forced by compiler-directive.
    64 !
    65 ! 247 2009-02-27 14:01:30Z heinze
    66 ! Output of messages replaced by message handling routine
    67 !
    68 ! 132 2007-11-20 09:46:11Z letzel
    69 ! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.
    70 !
    71 ! 106 2007-08-16 14:30:26Z raasch
    72 ! i loop for u-component (sloping surface) is starting from nxlu (needed for
    73 ! non-cyclic boundary conditions)
    74 !
    75 ! 97 2007-06-21 08:23:15Z raasch
    76 ! Routine reneralized to be used with temperature AND density:
    77 ! argument theta renamed var, new argument var_reference,
    78 ! use_pt_reference renamed use_reference,
    79 ! calc_mean_pt_profile renamed calc_mean_profile
    80 !
    81 ! 57 2007-03-09 12:05:41Z raasch
    82 ! Reference temperature pt_reference can be used.
    83 !
    84 ! RCS Log replace by Id keyword, revision history cleaned up
    85 !
    86 ! Revision 1.19  2006/04/26 12:09:56  raasch
    87 ! OpenMP optimization (one dimension added to sums_l)
    8862!
    8963! Revision 1.1  1997/08/29 08:56:48  raasch
    … …  
    12195    SUBROUTINE buoyancy( var, wind_component )
    12296
    123        USE arrays_3d
    124        USE control_parameters
    125        USE indices
     97       USE arrays_3d,                                                          &
     98           ONLY:  pt, pt_slope_ref, ref_state, tend
     99
     100       USE control_parameters,                                                 &
     101           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
     102                  pt_surface, sin_alpha_surface, sloping_surface
     103
     104       USE indices,                                                            &
     105           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb_s_inner, nzt
     106
     107       USE kinds
     108
    126109       USE pegrid
    127110
     111
    128112       IMPLICIT NONE
    129113
    130        INTEGER ::  i, j, k, wind_component
     114       INTEGER(iwp) ::  i              !:
     115       INTEGER(iwp) ::  j              !:
     116       INTEGER(iwp) ::  k              !:
     117       INTEGER(iwp) ::  wind_component !:
     118       
    131119#if defined( __nopointer )
    132        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var
     120       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !:
    133121#else
    134        REAL, DIMENSION(:,:,:), POINTER ::  var
     122       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
    135123#endif
    136124
    … …  
    185173          ELSE
    186174             
    187              WRITE( message_string, * ) 'no term for component "',&
     175             WRITE( message_string, * ) 'no term for component "',             &
    188176                                       wind_component,'"'
    189177             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
    … …  
    201189    SUBROUTINE buoyancy_acc( var, wind_component )
    202190
    203        USE arrays_3d
    204        USE control_parameters
    205        USE indices
     191       USE arrays_3d,                                                          &
     192           ONLY:  pt, pt_slope_ref, ref_state, tend
     193
     194       USE control_parameters,                                                 &
     195           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
     196                  pt_surface, sin_alpha_surface, sloping_surface
     197
     198       USE indices,                                                            &
     199           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlu, nxr, nyn, nys, &
     200                  nzb_s_inner, nzt
     201
     202       USE kinds
     203
    206204       USE pegrid
    207205
     206
    208207       IMPLICIT NONE
    209208
    210        INTEGER ::  i, j, k, wind_component
     209       INTEGER(iwp) ::  i              !:
     210       INTEGER(iwp) ::  j              !:
     211       INTEGER(iwp) ::  k              !:
     212       INTEGER(iwp) ::  wind_component !:
     213       
    211214#if defined( __nopointer )
    212        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var
     215       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !:
    213216#else
    214        REAL, DIMENSION(:,:,:), POINTER ::  var
     217       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
    215218#endif
    216219
    … …  
    269272          ELSE
    270273
    271              WRITE( message_string, * ) 'no term for component "',&
     274             WRITE( message_string, * ) 'no term for component "',             &
    272275                                       wind_component,'"'
    273276             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
    … …  
    288291    SUBROUTINE buoyancy_ij( i, j, var, wind_component )
    289292
    290        USE arrays_3d
    291        USE control_parameters
    292        USE indices
     293       USE arrays_3d,                                                          &
     294           ONLY:  pt, pt_slope_ref, ref_state, tend
     295
     296       USE control_parameters,                                                 &
     297           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
     298                  pt_surface, sin_alpha_surface, sloping_surface
     299
     300       USE indices,                                                            &
     301           ONLY:  nzb_s_inner, nzt
     302
     303       USE kinds
     304
    293305       USE pegrid
    294306
     307
    295308       IMPLICIT NONE
    296309
    297        INTEGER ::  i, j, k, pr, wind_component
     310       INTEGER(iwp) ::  i              !:
     311       INTEGER(iwp) ::  j              !:
     312       INTEGER(iwp) ::  k              !:
     313       INTEGER(iwp) ::  pr             !:
     314       INTEGER(iwp) ::  wind_component !:
     315       
    298316#if defined( __nopointer )
    299        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var
     317       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !:
    300318#else
    301        REAL, DIMENSION(:,:,:), POINTER ::  var
     319       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
    302320#endif
    303321
    … …  
    307325!--       Normal case: horizontal surface
    308326          DO  k = nzb_s_inner(j,i)+1, nzt-1
    309               tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * (     &
    310                         ( var(k,j,i)   - ref_state(k)   ) / ref_state(k)   + &
    311                         ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1)   &
     327              tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * (       &
     328                        ( var(k,j,i)   - ref_state(k)   ) / ref_state(k)   +   &
     329                        ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1)     &
    312330                                                                       )
    313331          ENDDO
    … …  
    340358          ELSE
    341359
    342              WRITE( message_string, * ) 'no term for component "',&
     360             WRITE( message_string, * ) 'no term for component "',             &
    343361                                       wind_component,'"'
    344362             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
    … …  
    361379!------------------------------------------------------------------------------!
    362380
    363        USE arrays_3d,  ONLY: ref_state
    364        USE control_parameters
    365        USE indices
     381       USE arrays_3d,                                                          &
     382           ONLY:  ref_state
     383
     384       USE control_parameters,                                                 &
     385           ONLY:  intermediate_timestep_count, message_string
     386
     387       USE indices,                                                            &
     388           ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
     389
     390       USE kinds
     391
    366392       USE pegrid
    367        USE statistics
     393
     394       USE statistics,                                                         &
     395           ONLY:  flow_statistics_called, hom, sums, sums_l
     396
    368397
    369398       IMPLICIT NONE
    370399
    371        INTEGER ::  i, j, k, omp_get_thread_num, pr, tn
    372        CHARACTER (LEN=*) ::  loc
     400       CHARACTER (LEN=*) ::  loc !:
     401       
     402       INTEGER(iwp) ::  i                  !:
     403       INTEGER(iwp) ::  j                  !:
     404       INTEGER(iwp) ::  k                  !:
     405       INTEGER(iwp) ::  pr                 !:
     406       INTEGER(iwp) ::  omp_get_thread_num !:
     407       INTEGER(iwp) ::  tn                 !:
     408       
    373409#if defined( __nopointer )
    374        REAL, DIMENSION(:,:,:) ::  var
     410       REAL(wp), DIMENSION(:,:,:) ::  var  !:
    375411#else
    376        REAL, DIMENSION(:,:,:), POINTER ::  var
     412       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
    377413#endif
    378414
    … …  
    383419!--    spare communication time and to produce identical model results with jobs
    384420!--    which are calling flow_statistics at different time intervals.
    385        IF ( .NOT. flow_statistics_called  .AND. &
     421       IF ( .NOT. flow_statistics_called  .AND.                                &
    386422            intermediate_timestep_count == 1 )  THEN
    387423
    … …  
    409445
    410446          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    411           CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb, &
     447          CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb,       &
    412448                              MPI_REAL, MPI_SUM, comm2d, ierr )
    413449

  • palm/trunk/SOURCE/calc_liquid_water_content.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    3843! code put under GPL (PALM 3.9)
    3944!
    40 ! 667 2010-12-23 12:06:00Z suehring/gyschka
    41 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    42 !
    43 ! 95 2007-06-02 16:48:38Z raasch
    44 ! hydro_press renamed hyp
    45 !
    46 ! 19 2007-02-23 04:53:48Z raasch
    47 ! Old comment removed
    48 !
    49 ! RCS Log replace by Id keyword, revision history cleaned up
    50 !
    51 ! Revision 1.5  2005/03/26 15:22:06  raasch
    52 ! Arguments for non-cyclic boundary conditions added to argument list of
    53 ! routine exchange_horiz,
    54 ! ql calculated for the ghost points, exchange of ghost points removed
    55 !
    5645! Revision 1.1  2000/04/13 14:50:45  schroeter
    5746! Initial revision
    … …  
    6756
    6857
    69     USE arrays_3d
    70     USE cloud_parameters
    71     USE constants
    72     USE control_parameters
    73     USE grid_variables
    74     USE indices
     58    USE arrays_3d,                                                             &
     59        ONLY:  hyp, pt, q, qc, ql, qr
     60
     61    USE cloud_parameters,                                                      &
     62        ONLY:  l_d_cp, l_d_r, t_d_pt
     63
     64    USE control_parameters,                                                    &
     65        ONLY:  icloud_scheme, precipitation
     66
     67    USE indices,                                                               &
     68        ONLY:  nxlg, nxrg, nyng, nysg, nzb_s_inner, nzt
     69
     70    USE kinds
     71
    7572    USE pegrid
     73
    7674
    7775    IMPLICIT NONE
    7876
    79     INTEGER :: i, j, k
     77    INTEGER(iwp) ::  i !:
     78    INTEGER(iwp) ::  j !:
     79    INTEGER(iwp) ::  k !:
    8080
    81     REAL :: alpha, e_s, q_s, t_l
     81    REAL(wp) ::  alpha !:
     82    REAL(wp) ::  e_s   !:
     83    REAL(wp) ::  q_s   !:
     84    REAL(wp) ::  t_l   !:
    8285
    8386    DO  i = nxlg, nxrg
    … …  
    9194!
    9295!--          Compute saturation water vapor pressure at t_l
    93              e_s = 610.78 * EXP( 17.269 * ( t_l - 273.16 ) / &
     96             e_s = 610.78 * EXP( 17.269 * ( t_l - 273.16 ) /                   &
    9497                                          ( t_l - 35.86 ) )
    9598

  • palm/trunk/SOURCE/calc_precipitation.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! 403 2009-10-22 13:57:16Z franke
    32 ! Bugfix in calculation of precipitation_rate(j,i)
    33 !
    34 ! 73 2007-03-20 08:33:14Z raasch
    35 ! Precipitation rate and amount are calculated/stored,
    36 ! + module control_parameters
    37 !
    38 ! 19 2007-02-23 04:53:48Z raasch
    39 ! Calculation extended for gridpoint nzt
    40 !
    41 ! RCS Log replace by Id keyword, revision history cleaned up
    42 !
    43 ! Revision 1.5  2004/01/30 10:15:57  raasch
    44 ! Scalar lower k index nzb replaced by 2d-array nzb_2d
    4535!
    4636! Revision 1.1  2000/04/13 14:45:22  schroeter
    … …  
    7161    SUBROUTINE calc_precipitation
    7262
    73        USE arrays_3d
    74        USE cloud_parameters
    75        USE constants
    76        USE control_parameters
    77        USE indices
     63       USE arrays_3d,                                                          &
     64           ONLY:  dzw, ql, tend
     65
     66       USE cloud_parameters,                                                   &
     67           ONLY:  precipitation_amount, precipitation_rate, prec_time_const,   &
     68                  ql_crit
     69
     70       USE control_parameters,                                                 &
     71           ONLY:  dt_do2d_xy, dt_3d,                                           &
     72                  intermediate_timestep_count, intermediate_timestep_count_max,&
     73                  precipitation_amount_interval, time_do2d_xy
     74
     75       USE indices,                                                            &
     76           ONLY:  nxl, nxr, nyn, nys, nzb_2d, nzt
     77
     78       USE kinds
     79
    7880
    7981       IMPLICIT NONE
    8082
    81        INTEGER ::  i, j, k
    82        REAL    ::  dqdt_precip
     83       INTEGER(iwp) ::  i !:
     84       INTEGER(iwp) ::  j !:
     85       INTEGER(iwp) ::  k !:
     86       
     87       REAL(wp)    ::  dqdt_precip !:
    8388
    8489       precipitation_rate = 0.0
    … …  
    96101!
    97102!--             Precipitation rate in kg / m**2 / s (= mm/s)
    98                 precipitation_rate(j,i) = precipitation_rate(j,i) + &
     103                precipitation_rate(j,i) = precipitation_rate(j,i) +            &
    99104                                          dqdt_precip * dzw(k)
    100105
    … …  
    102107!
    103108!--          Sum up the precipitation amount, unit kg / m**2 (= mm)
    104              IF ( intermediate_timestep_count ==         &
    105                   intermediate_timestep_count_max  .AND. &
     109             IF ( intermediate_timestep_count ==                               &
     110                  intermediate_timestep_count_max  .AND.                       &
    106111                  ( dt_do2d_xy-time_do2d_xy ) < precipitation_amount_interval )&
    107112             THEN
    108                 precipitation_amount(j,i) = precipitation_amount(j,i) + &
     113                precipitation_amount(j,i) = precipitation_amount(j,i) +        &
    109114                                            precipitation_rate(j,i) * dt_3d
    110115             ENDIF
    … …  
    120125    SUBROUTINE calc_precipitation_ij( i, j )
    121126
    122        USE arrays_3d
    123        USE cloud_parameters
    124        USE constants
    125        USE control_parameters
    126        USE indices
     127       USE arrays_3d,                                                          &
     128           ONLY:  dzw, ql, tend
     129
     130       USE cloud_parameters,                                                   &
     131           ONLY:  precipitation_amount, precipitation_rate, prec_time_const,   &
     132                  ql_crit
     133
     134       USE control_parameters,                                                 &
     135           ONLY:  dt_do2d_xy, dt_3d,                                           &
     136                  intermediate_timestep_count, intermediate_timestep_count_max,&
     137                  precipitation_amount_interval, time_do2d_xy
     138
     139       USE indices,                                                            &
     140           ONLY:  nzb_2d, nzt
     141
     142       USE kinds
     143
    127144
    128145       IMPLICIT NONE
    129146
    130        INTEGER ::  i, j, k
    131        REAL    ::  dqdt_precip
     147       INTEGER(iwp) ::  i !:
     148       INTEGER(iwp) ::  j !:
     149       INTEGER(iwp) ::  k !:
     150       
     151       REAL(wp)    ::  dqdt_precip !:       
    132152
    133153       precipitation_rate(j,i) = 0.0
    … …  
    147167!
    148168!--       Precipitation rate in kg / m**2 / s (= mm/s)
    149           precipitation_rate(j,i) = precipitation_rate(j,i) + dqdt_precip * &
     169          precipitation_rate(j,i) = precipitation_rate(j,i) + dqdt_precip *    &
    150170                                                              dzw(k)
    151171
    … …  
    157177            .AND. ( dt_do2d_xy-time_do2d_xy ) < precipitation_amount_interval )&
    158178       THEN
    159           precipitation_amount(j,i) = precipitation_amount(j,i) + &
     179          precipitation_amount(j,i) = precipitation_amount(j,i) +              &
    160180                                      precipitation_rate(j,i) * dt_3d
    161181       ENDIF

  • palm/trunk/SOURCE/calc_radiation.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    2833! 1036 2012-10-22 13:43:42Z raasch
    2934! code put under GPL (PALM 3.9)
    30 !
    31 ! RCS Log replace by Id keyword, revision history cleaned up
    32 !
    33 ! Revision 1.6  2004/01/30 10:17:03  raasch
    34 ! Scalar lower k index nzb replaced by 2d-array nzb_2d
    3535!
    3636! Revision 1.1  2000/04/13 14:42:45  schroeter
    … …  
    4343! based on the parameterization of the cloud effective emissivity
    4444!------------------------------------------------------------------------------!
    45 
     45    USE kinds
     46   
    4647    PRIVATE
    4748    PUBLIC calc_radiation
    4849   
    49     LOGICAL, SAVE ::  first_call = .TRUE.
    50     REAL, SAVE    ::  sigma = 5.67E-08
    51 
    52     REAL, DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_ground, lwp_top, &
    53                                               blackbody_emission
     50    LOGICAL, SAVE ::  first_call = .TRUE. !:
     51    REAL(wp), SAVE ::  sigma = 5.67E-08   !:
     52
     53    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_ground         !:
     54    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_top            !:
     55    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  blackbody_emission !:
    5456
    5557    INTERFACE calc_radiation
    … …  
    6668    SUBROUTINE calc_radiation
    6769
    68        USE arrays_3d
    69        USE cloud_parameters
    70        USE control_parameters
    71        USE indices
     70       USE arrays_3d,                                                          &
     71           ONLY:  dzw, pt, ql, tend
     72
     73       USE cloud_parameters,                                                   &
     74           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
     75
     76       USE control_parameters,                                                 &
     77           ONLY:  rho_surface
     78
     79       USE indices,                                                            &
     80           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_2d, nzt
     81
     82       USE kinds
     83
    7284       USE pegrid
    7385
     86
    7487       IMPLICIT NONE
    7588
    76        INTEGER ::  i, j, k, k_help
     89       INTEGER(iwp) ::  i      !:
     90       INTEGER(iwp) ::  j      !:
     91       INTEGER(iwp) ::  k      !:
     92       INTEGER(iwp) ::  k_help !:
    7793 
    78        REAL :: df_p, df_m , effective_emission_up_m, effective_emission_up_p, &
    79                effective_emission_down_m, effective_emission_down_p,          &
    80                f_up_m, f_up_p, f_down_m, f_down_p, impinging_flux_at_top,     &
    81                temperature
     94       REAL(wp) :: df_p                      !:
     95       REAL(wp) :: df_m                      !:
     96       REAL(wp) :: effective_emission_up_m   !:
     97       REAL(wp) :: effective_emission_up_p   !:
     98       REAL(wp) :: effective_emission_down_m !:
     99       REAL(wp) :: effective_emission_down_p !:
     100       REAL(wp) :: f_up_m                    !:
     101       REAL(wp) :: f_up_p                    !:
     102       REAL(wp) :: f_down_m                  !:
     103       REAL(wp) :: f_down_p                  !:
     104       REAL(wp) :: impinging_flux_at_top     !:
     105       REAL(wp) :: temperature               !:
    82106
    83107
    … …  
    85109!--    On first call, allocate temporary arrays
    86110       IF ( first_call )  THEN
    87           ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1), &
     111          ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1),      &
    88112                    lwp_top(nzb:nzt+1) )
    89113          first_call = .FALSE.
    … …  
    105129
    106130                k_help = ( nzt+nzb+1 ) - k
    107                 lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) * &
     131                lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) *  &
    108132                                  dzw(k)
    109133
    110                 lwp_top(k_help) = lwp_top(k_help+1) + &
     134                lwp_top(k_help) = lwp_top(k_help+1) +                          &
    111135                                  rho_surface * ql(k_help,j,i) * dzw(k_help)
    112136
    … …  
    116140             ENDDO
    117141
    118              lwp_ground(nzt+1) = lwp_ground(nzt) + &
     142             lwp_ground(nzt+1) = lwp_ground(nzt) +                             &
    119143                                 rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
    120144             lwp_top(nzb)      = lwp_top(nzb+1)
    121145
    122              temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp * &
     146             temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *      &
    123147                                 ql(nzt+1,j,i)
    124148             blackbody_emission(nzt+1) = sigma * temperature**4.0
    … …  
    135159!
    136160!--                Compute effective emissivities
    137                    effective_emission_up_p   = 1.0 - &
     161                   effective_emission_up_p   = 1.0 -                           &
    138162                                               EXP( -130.0 * lwp_ground(k+1) )
    139                    effective_emission_up_m   = 1.0 - &
     163                   effective_emission_up_m   = 1.0 -                           &
    140164                                               EXP( -130.0 * lwp_ground(k-1) )
    141                    effective_emission_down_p = 1.0 - &
     165                   effective_emission_down_p = 1.0 -                           &
    142166                                               EXP( -158.0 * lwp_top(k+1) )
    143                    effective_emission_down_m = 1.0 - &
     167                   effective_emission_down_m = 1.0 -                           &
    144168                                               EXP( -158.0 * lwp_top(k-1) ) 
    145169
    146170!
    147171!--                Compute vertical long wave radiation fluxes
    148                    f_up_p = blackbody_emission(nzb) + &
    149                             effective_emission_up_p * &
     172                   f_up_p = blackbody_emission(nzb) +                          &
     173                            effective_emission_up_p *                          &
    150174                           ( blackbody_emission(k) - blackbody_emission(nzb) )
    151175
    152                    f_up_m = blackbody_emission(nzb) + &
    153                             effective_emission_up_m * &
     176                   f_up_m = blackbody_emission(nzb) +                          &
     177                            effective_emission_up_m *                          &
    154178                           ( blackbody_emission(k-1) - blackbody_emission(nzb) )
    155179
    156                    f_down_p = impinging_flux_at_top + &
    157                               effective_emission_down_p * &
     180                   f_down_p = impinging_flux_at_top +                          &
     181                              effective_emission_down_p *                      &
    158182                             ( blackbody_emission(k) - impinging_flux_at_top )
    159183
    160                    f_down_m = impinging_flux_at_top + &
    161                               effective_emission_down_m * &
     184                   f_down_m = impinging_flux_at_top +                          &
     185                              effective_emission_down_m *                      &
    162186                             ( blackbody_emission(k-1) - impinging_flux_at_top )
    163187
    … …  
    169193!
    170194!--                Compute tendency term         
    171                    tend(k,j,i) = tend(k,j,i) - &
    172                                 ( pt_d_t(k) / ( rho_surface * cp ) * &
     195                   tend(k,j,i) = tend(k,j,i) -                                 &
     196                                ( pt_d_t(k) / ( rho_surface * cp ) *           &
    173197                                  ( df_p - df_m ) / dzw(k) )
    174198
    … …  
    187211    SUBROUTINE calc_radiation_ij( i, j )
    188212
    189        USE arrays_3d
    190        USE cloud_parameters
    191        USE control_parameters
    192        USE indices
     213       USE arrays_3d,                                                          &
     214           ONLY:  dzw, pt, ql, tend
     215
     216       USE cloud_parameters,                                                   &
     217           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
     218
     219       USE control_parameters,                                                 &
     220           ONLY:  rho_surface
     221
     222       USE indices,                                                            &
     223           ONLY:  nzb, nzb_2d, nzt
     224
     225       USE kinds
     226
    193227       USE pegrid
     228
    194229   
    195230       IMPLICIT NONE
    196231
    197        INTEGER :: i, j, k, k_help
    198 
    199        REAL :: df_p, df_m , effective_emission_up_m, effective_emission_up_p, &
    200                effective_emission_down_m, effective_emission_down_p,          &
    201                f_up_m, f_up_p, f_down_m, f_down_p, impinging_flux_at_top,     &
    202                temperature
    203 
     232       INTEGER(iwp) ::  i      !:
     233       INTEGER(iwp) ::  j      !:
     234       INTEGER(iwp) ::  k      !:
     235       INTEGER(iwp) ::  k_help !:
     236
     237       REAL(wp) :: df_p                      !:
     238       REAL(wp) :: df_m                      !:
     239       REAL(wp) :: effective_emission_up_m   !:
     240       REAL(wp) :: effective_emission_up_p   !:
     241       REAL(wp) :: effective_emission_down_m !:
     242       REAL(wp) :: effective_emission_down_p !:
     243       REAL(wp) :: f_up_m                    !:
     244       REAL(wp) :: f_up_p                    !:
     245       REAL(wp) :: f_down_m                  !:
     246       REAL(wp) :: f_down_p                  !:
     247       REAL(wp) :: impinging_flux_at_top     !:
     248       REAL(wp) :: temperature               !:
     249
     250       
    204251!
    205252!--    On first call, allocate temporary arrays
    206253       IF ( first_call )  THEN
    207           ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1), &
     254          ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1),      &
    208255                    lwp_top(nzb:nzt+1) )
    209256          first_call = .FALSE.
    … …  
    223270          lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k)
    224271
    225           lwp_top(k_help) = lwp_top(k_help+1) + &
     272          lwp_top(k_help) = lwp_top(k_help+1) +                                &
    226273                            rho_surface * ql(k_help,j,i) * dzw(k_help)
    227274
    … …  
    230277
    231278       ENDDO
    232        lwp_ground(nzt+1) = lwp_ground(nzt) + &
     279       lwp_ground(nzt+1) = lwp_ground(nzt) +                                   &
    233280                           rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
    234281       lwp_top(nzb)      = lwp_top(nzb+1)
    235282
    236        temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp * &
     283       temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *            &
    237284                           ql(nzt+1,j,i)
    238285       blackbody_emission(nzt+1) = sigma * temperature**4.0
    … …  
    249296!
    250297!--          Compute effective emissivities
    251              effective_emission_up_p   = 1.0 - &
     298             effective_emission_up_p   = 1.0 -                                 &
    252299                                         EXP( -130.0 * lwp_ground(k+1) )
    253              effective_emission_up_m   = 1.0 - &
     300             effective_emission_up_m   = 1.0 -                                 &
    254301                                         EXP( -130.0 * lwp_ground(k-1) )
    255              effective_emission_down_p = 1.0 - &
     302             effective_emission_down_p = 1.0 -                                 &
    256303                                         EXP( -158.0 * lwp_top(k+1) )
    257              effective_emission_down_m = 1.0 - &
     304             effective_emission_down_m = 1.0 -                                 &
    258305                                         EXP( -158.0 * lwp_top(k-1) ) 
    259306             
    260307!
    261308!--          Compute vertical long wave radiation fluxes
    262              f_up_p = blackbody_emission(nzb) + effective_emission_up_p * &
     309             f_up_p = blackbody_emission(nzb) + effective_emission_up_p *      &
    263310                     ( blackbody_emission(k) - blackbody_emission(nzb) )
    264311
    265              f_up_m = blackbody_emission(nzb) + effective_emission_up_m * &
     312             f_up_m = blackbody_emission(nzb) + effective_emission_up_m *      &
    266313                     ( blackbody_emission(k-1) - blackbody_emission(nzb) )
    267314
    268              f_down_p = impinging_flux_at_top + effective_emission_down_p * &
     315             f_down_p = impinging_flux_at_top + effective_emission_down_p *    &
    269316                       ( blackbody_emission(k) - impinging_flux_at_top )
    270317
    271              f_down_m = impinging_flux_at_top + effective_emission_down_m * &
     318             f_down_m = impinging_flux_at_top + effective_emission_down_m *    &
    272319                       ( blackbody_emission(k-1) - impinging_flux_at_top )
    273320
    … …  
    279326!
    280327!--          Compute tendency term         
    281              tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) * &
     328             tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) *  &
    282329                                         ( df_p - df_m ) / dzw(k) )
    283330

  • palm/trunk/SOURCE/calc_spectra.f90

    r1319 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!
    2429! Former revisions:
    … …  
    4146! 1003 2012-09-14 14:35:53Z raasch
    4247! adjustment of array tend for cases with unequal subdomain sizes removed
    43 !
    44 ! 707 2011-03-29 11:39:40Z raasch
    45 ! bc_lr/ns replaced by bc_lr/ns_cyc
    46 !
    47 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    48 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation
    49 ! of tend
    50 !
    51 ! 274 2009-03-26 15:11:21Z heinze
    52 ! Output of messages replaced by message handling routine
    53 !
    54 ! 225 2009-01-26 14:44:20Z raasch
    55 ! Bugfix: array d is reallocated in case that multigrid is used
    56 !
    57 ! 192 2008-08-27 16:51:49Z letzel
    58 ! bugfix in calc_spectra_x: exponent = 1.0 / ( ny + 1.0 )
    59 ! allow 100 spectra levels instead of 10 for consistency with
    60 ! define_netcdf_header
    61 ! user-defined spectra, arguments removed from transpose routines
    62 !
    63 ! February 2007
    64 ! RCS Log replace by Id keyword, revision history cleaned up
    65 !
    66 ! Revision 1.9  2006/04/11 14:56:00  raasch
    67 ! pl_spectra renamed data_output_sp
    6848!
    6949! Revision 1.1  2001/01/05 15:08:07  raasch
    … …  
    8161
    8262#if defined( __spectra )
    83     USE arrays_3d
    84     USE control_parameters
    85     USE cpulog
    86     USE fft_xy
    87     USE indices
     63    USE arrays_3d,                                                             &
     64        ONLY:  d, tend
     65
     66    USE control_parameters,                                                    &
     67        ONLY:  average_count_sp, bc_lr_cyc, bc_ns_cyc, message_string, psolver
     68
     69    USE cpulog,                                                                &
     70        ONLY:  cpu_log, log_point
     71
     72    USE fft_xy,                                                                &
     73        ONLY:  fft_init
     74
     75    USE indices,                                                               &
     76        ONLY:  nxl, nxr, nyn, nys, nzb, nzt, nzt_x, nzt_yd
     77
     78    USE kinds
     79
    8880    USE pegrid
    89     USE spectrum
     81
     82    USE spectrum,                                                              &
     83        ONLY:  data_output_sp, spectra_direction
     84
    9085
    9186    IMPLICIT NONE
    9287
    93     INTEGER ::  m, pr
     88    INTEGER(iwp) ::  m  !:
     89    INTEGER(iwp) ::  pr !:
    9490
    9591
    … …  
    163159          CALL calc_spectra_y( d, pr, m )
    164160#else
    165           message_string = 'sorry, calculation of spectra in non parallel' // &
     161          message_string = 'sorry, calculation of spectra in non parallel' //  &
    166162                           'mode& is still not realized'
    167163          CALL message( 'calc_spectra', 'PA0161', 1, 2, 0, 6, 0 )
    … …  
    189185 SUBROUTINE preprocess_spectra( m, pr )
    190186
    191     USE arrays_3d
    192     USE indices
     187    USE arrays_3d,                                                             &
     188        ONLY:  d, pt, q, u, v, w
     189
     190    USE indices,                                                               &
     191        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
     192
     193    USE kinds
     194
    193195    USE pegrid
    194     USE spectrum
    195     USE statistics
     196
     197    USE spectrum,                                                              &
     198        ONLY:  data_output_sp
     199
     200    USE statistics,                                                            &
     201        ONLY:  sums
     202
    196203
    197204    IMPLICIT NONE
    198205
    199     INTEGER :: i, j, k, m, pr
     206    INTEGER(iwp) :: i  !:
     207    INTEGER(iwp) :: j  !:
     208    INTEGER(iwp) :: k  !:
     209    INTEGER(iwp) :: m  !:
     210    INTEGER(iwp) :: pr !:
    200211
    201212    SELECT CASE ( TRIM( data_output_sp(m) ) )
    … …  
    247258 SUBROUTINE calc_spectra_x( ddd, pr, m )
    248259
    249     USE arrays_3d
    250     USE constants
    251     USE control_parameters
    252     USE fft_xy
    253     USE grid_variables
    254     USE indices
     260    USE arrays_3d,                                                             &
     261        ONLY: 
     262
     263    USE control_parameters,                                                    &
     264        ONLY:  fft_method
     265
     266    USE fft_xy,                                                                &
     267        ONLY:  fft_x_1d
     268
     269    USE grid_variables,                                                        &
     270        ONLY:  dx
     271
     272    USE indices,                                                               &
     273        ONLY:  nx, ny, nyn_x, nys_x, nzb_x, nzt_x
     274
     275    USE kinds
     276
    255277    USE pegrid
    256     USE spectrum
    257     USE statistics
     278
     279    USE spectrum,                                                              &
     280        ONLY:  comp_spectra_level, n_sp_x
     281
     282    USE statistics,                                                            &
     283        ONLY:  spectrum_x
     284
    258285    USE transpose_indices
    259286
     287
    260288    IMPLICIT NONE
    261289
    262     INTEGER                    ::  i, ishape(1), j, k, m, n, pr
    263 
    264     REAL                       ::  fac, exponent
    265     REAL, DIMENSION(0:nx)      ::  work
    266     REAL, DIMENSION(0:nx/2)    ::  sums_spectra_l
    267     REAL, DIMENSION(0:nx/2,100)::  sums_spectra
    268 
    269     REAL, DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::  ddd
     290    INTEGER(iwp) ::  i         !:
     291    INTEGER(iwp) ::  ishape(1) !:
     292    INTEGER(iwp) ::  j         !:
     293    INTEGER(iwp) ::  k         !:
     294    INTEGER(iwp) ::  m         !:
     295    INTEGER(iwp) ::  n         !:
     296    INTEGER(iwp) ::  pr        !:
     297
     298    REAL(wp) ::  fac      !:
     299    REAL(wp) ::  exponent !:
     300   
     301    REAL(wp), DIMENSION(0:nx) ::  work !:
     302   
     303    REAL(wp), DIMENSION(0:nx/2) ::  sums_spectra_l !:
     304   
     305    REAL(wp), DIMENSION(0:nx/2,100) ::  sums_spectra !:
     306   
     307    REAL(wp), DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::  ddd !:
    270308
    271309!
    … …  
    320358#if defined( __parallel )   
    321359       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
    322        CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1, &
     360       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1,          &
    323361                        MPI_REAL, MPI_PROD, 0, comm2d, ierr )
    324362#else
    … …  
    357395 SUBROUTINE calc_spectra_y( ddd, pr, m )
    358396
    359     USE arrays_3d
    360     USE constants
    361     USE control_parameters
    362     USE fft_xy
    363     USE grid_variables
    364     USE indices
     397    USE arrays_3d,                                                             &
     398        ONLY: 
     399
     400    USE control_parameters,                                                    &
     401        ONLY:  fft_method
     402
     403    USE fft_xy,                                                                &
     404        ONLY:  fft_y_1d
     405
     406    USE grid_variables,                                                        &
     407        ONLY:  dy
     408
     409    USE indices,                                                               &
     410        ONLY:  nx, ny, nxl_yd, nxr_yd, nzb_yd, nzt_yd
     411
     412    USE kinds
     413
    365414    USE pegrid
    366     USE spectrum
    367     USE statistics
     415
     416    USE spectrum,                                                              &
     417        ONLY:  comp_spectra_level, n_sp_y
     418
     419    USE statistics,                                                            &
     420        ONLY:  spectrum_y
     421
    368422    USE transpose_indices
    369423
     424
    370425    IMPLICIT NONE
    371426
    372     INTEGER :: i, j, jshape(1), k, m, n, pr
    373 
    374     REAL                       ::  fac, exponent
    375     REAL, DIMENSION(0:ny)      ::  work
    376     REAL, DIMENSION(0:ny/2)    ::  sums_spectra_l
    377     REAL, DIMENSION(0:ny/2,100)::  sums_spectra
    378 
    379     REAL, DIMENSION(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) :: ddd
     427    INTEGER(iwp) ::  i         !:
     428    INTEGER(iwp) ::  j         !:
     429    INTEGER(iwp) ::  jshape(1) !:
     430    INTEGER(iwp) ::  k         !:
     431    INTEGER(iwp) ::  m         !:
     432    INTEGER(iwp) ::  n         !:
     433    INTEGER(iwp) ::  pr        !:
     434
     435    REAL(wp) ::  fac      !:
     436    REAL(wp) ::  exponent !:
     437   
     438    REAL(wp), DIMENSION(0:ny) ::  work !:
     439   
     440    REAL(wp), DIMENSION(0:ny/2) ::  sums_spectra_l !:
     441   
     442    REAL(wp), DIMENSION(0:ny/2,100) ::  sums_spectra !:
     443   
     444    REAL(wp), DIMENSION(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) :: ddd !:
    380445
    381446
    … …  
    431496#if defined( __parallel )   
    432497       CALL MPI_BARRIER( comm2d, ierr )  ! Necessary?
    433        CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1, &
     498       CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1,          &
    434499                        MPI_REAL, MPI_PROD, 0, comm2d, ierr )
    435500#else

  • palm/trunk/SOURCE/check_for_restart.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER and REAL declaration statements,
     24! kinds are defined in new module kinds,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2328!