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 (11 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!
    2429! Former revisions:
    … …  
    3237! minor reformatting
    3338!
    34 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    35 ! Exchange of terminate_coupled between ocean and atmosphere by PE0
    36 !
    37 ! 622 2010-12-10 08:08:13Z raasch
    38 ! optional barriers included in order to speed up collective operations
    39 !
    40 ! 291 2009-04-16 12:07:26Z raasch
    41 ! Coupling with independent precursor runs.
    42 ! Output of messages replaced by message handling routine
    43 !
    44 ! 222 2009-01-12 16:04:16Z letzel
    45 ! Implementation of an MPI-1 coupling: replaced myid with target_id
    46 ! Bugfix for nonparallel execution
    47 !
    48 ! 108 2007-08-24 15:10:38Z letzel
    49 ! modifications to terminate coupled runs
    50 !
    51 ! RCS Log replace by Id keyword, revision history cleaned up
    52 !
    53 ! Revision 1.11  2007/02/11 12:55:13  raasch
    54 ! Informative output to the job protocol
    55 !
    5639! Revision 1.1  1998/03/18 20:06:51  raasch
    5740! Initial revision
    … …  
    6447!------------------------------------------------------------------------------!
    6548
     49    USE control_parameters,                                                    &
     50        ONLY:  coupling_mode, dt_restart, end_time, message_string,            &
     51               run_description_header, simulated_time, terminate_coupled,      &
     52               terminate_coupled_remote, terminate_run,                        &
     53               termination_time_needed, time_restart,                          &
     54               time_since_reference_point, write_binary
     55    USE kinds
    6656    USE pegrid
    67     USE control_parameters
    6857
    6958    IMPLICIT NONE
    7059
    7160
    72     LOGICAL :: terminate_run_l
    73     REAL ::  remaining_time
     61    LOGICAL :: terminate_run_l  !:
     62
     63    REAL(wp) ::  remaining_time !:
    7464
    7565
    … …  
    8171!-- If necessary set a flag to stop the model run
    8272    terminate_run_l = .FALSE.
    83     IF ( remaining_time <= termination_time_needed  .AND. &
     73    IF ( remaining_time <= termination_time_needed  .AND.                      &
    8474         write_binary(1:4) == 'true' )  THEN
    8575
    … …  
    9282!-- one processor has reached the time limit.
    9383    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    94     CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, &
     84    CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL,        &
    9585                        MPI_LOR, comm2d, ierr )
    9686#else
    … …  
    10191!-- Output that job will be terminated
    10292    IF ( terminate_run  .AND.  myid == 0 )  THEN
    103        WRITE( message_string, * ) 'run will be terminated because it is ', &
    104                        'running out of job cpu limit & ',                  &
    105                        'remaining time:         ', remaining_time, ' s',   &
     93       WRITE( message_string, * ) 'run will be terminated because it is ',     &
     94                       'running out of job cpu limit & ',                      &
     95                       'remaining time:         ', remaining_time, ' s',       &
    10696                       'termination time needed:', termination_time_needed, ' s'
    10797       CALL message( 'check_for_restart', 'PA0163', 0, 1, 0, 6, 0 )
    … …  
    113103!-- informed of another termination reason (terminate_coupled > 0) before,
    114104!-- or vice versa (terminate_coupled_remote > 0).
    115     IF ( terminate_run .AND. TRIM( coupling_mode ) /= 'uncoupled'  .AND. &
     105    IF ( terminate_run .AND. TRIM( coupling_mode ) /= 'uncoupled'  .AND.       &
    116106         terminate_coupled == 0  .AND.  terminate_coupled_remote == 0 )  THEN
    117107
    … …  
    125115                             comm_inter, status, ierr )
    126116       ENDIF
    127        CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d,  &
     117       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d,    &
    128118                       ierr )
    129119#endif
    … …  
    132122!
    133123!-- Set the stop flag also, if restart is forced by user
    134     IF ( time_restart /= 9999999.9  .AND.  &
     124    IF ( time_restart /= 9999999.9  .AND.                                      &
    135125         time_restart < time_since_reference_point )  THEN
    136126
    … …  
    149139          ENDIF
    150140
    151           WRITE( message_string, * ) 'run will be terminated due to user ', &
    152                                   'settings of',                            &
    153                                   '&restart_time / dt_restart',             &
     141          WRITE( message_string, * ) 'run will be terminated due to user ',    &
     142                                  'settings of',                               &
     143                                  '&restart_time / dt_restart',                &
    154144                                  '&new restart time is: ', time_restart, ' s'
    155145          CALL message( 'check_for_restart', 'PA0164', 0, 0, 0, 6, 0 )
    … …  
    160150!--       informed of another termination reason (terminate_coupled > 0) before,
    161151!--       or vice versa (terminate_coupled_remote > 0).
    162           IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0  &
     152          IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0       &
    163153               .AND.  terminate_coupled_remote == 0 )  THEN
    164154
    … …  
    176166                                   comm_inter, status, ierr )   
    177167             ENDIF
    178              CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0,  &
     168             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0,      &
    179169                             comm2d, ierr ) 
    180170#endif

  • palm/trunk/SOURCE/check_namelist_files.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements
    2323!
    2424! Former revisions:
    … …  
    5151
    5252
     53    USE control_parameters,                                                    &
     54        ONLY:  check_restart, max_pr_user
     55
    5356    USE pegrid
    54     USE control_parameters
     57
    5558
    5659    IMPLICIT NONE

  • palm/trunk/SOURCE/check_open.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:
    … …  
    5258! 807 2012-01-25 11:53:51Z maronga
    5359! New cpp directive "__check" implemented which is used by check_namelist_files
    54 !
    55 ! Bugfix concerning opening of 3D files in restart runs in case of netCDF4
    56 !
    57 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    58 ! Output of total array size was adapted to nbgp.
    59 !
    60 ! 600 2010-11-24 16:10:51Z raasch
    61 ! bugfix in opening of cross section netcdf-files (parallel opening with
    62 ! netcdf4 only works for netcdf_data_format > 2)
    63 !
    64 ! 564 2010-09-30 13:18:59Z helmke
    65 ! start number of mask output files changed to 201, netcdf message identifiers
    66 ! of masked output changed
    67 !
    68 ! 519 2010-03-19 05:30:02Z raasch
    69 ! netCDF4 support for particle data
    70 !
    71 ! 493 2010-03-01 08:30:24Z raasch
    72 ! netCDF4 support (parallel output)
    73 !
    74 ! 410 2009-12-04 17:05:40Z letzel
    75 ! masked data output
    76 !
    77 ! 277 2009-03-31 09:13:47Z heinze
    78 ! Output of netCDF messages with aid of message handling routine.
    79 ! Output of messages replaced by message handling routine
    80 !
    81 ! 146 2008-01-17 13:08:34Z raasch
    82 ! First opening of unit 13 openes file _0000 on all PEs (parallel version)
    83 ! because only this file contains the global variables,
    84 ! myid_char_14 removed
    85 !
    86 ! 120 2007-10-17 11:54:43Z raasch
    87 ! Status of 3D-volume netCDF data file only depends on switch netcdf_64bit_3d
    88 !
    89 ! 105 2007-08-08 07:12:55Z raasch
    90 ! Different filenames are used in case of a coupled simulation,
    91 ! coupling_char added to all relevant filenames
    92 !
    93 ! 82 2007-04-16 15:40:52Z raasch
    94 ! Call of local_getenv removed, preprocessor directives for old systems removed
    95 !
    96 ! 46 2007-03-05 06:00:47Z raasch
    97 ! +netcdf_64bit_3d to switch on 64bit offset only for 3D files
    98 !
    99 ! RCS Log replace by Id keyword, revision history cleaned up
    100 !
    101 ! Revision 1.44  2006/08/22 13:48:34  raasch
    102 ! xz and yz cross sections now up to nzt+1
    10360!
    10461! Revision 1.1  1997/08/11 06:10:55  raasch
    … …  
    11269!------------------------------------------------------------------------------!
    11370
    114     USE arrays_3d
    115     USE control_parameters
    116     USE grid_variables
    117     USE indices
     71    USE arrays_3d,                                                             &
     72        ONLY:  zu
     73
     74    USE control_parameters,                                                    &
     75        ONLY:  avs_data_file, avs_output, coupling_char,                       &
     76               data_output_2d_on_each_pe, do3d_compress, host, iso2d_output,   &
     77               message_string, mid, netcdf_data_format, nz_do3d, openfile,     &
     78               return_addres, return_username, run_description_header, runnr
     79
     80    USE grid_variables,                                                        &
     81        ONLY:  dx, dy
     82
     83    USE indices,                                                               &
     84        ONLY:  nbgp, nx, nxlg, nxrg, ny, nyng, nysg, nz, nzb
     85
     86    USE kinds
     87
    11888    USE netcdf_control
    119     USE particle_attributes
     89
     90    USE particle_attributes,                                                   &
     91        ONLY:  max_number_of_particle_groups, number_of_particle_groups,       &
     92               particle_groups
     93
    12094    USE pegrid
    121     USE precision_kind
    122     USE profil_parameter
    123     USE statistics
     95
     96    USE profil_parameter,                                                      &
     97        ONLY:  cross_ts_numbers, cross_ts_number_count
     98
     99    USE statistics,                                                            &
     100        ONLY:  region, statistic_regions
     101
    124102
    125103    IMPLICIT NONE
    126104
    127     CHARACTER (LEN=2)   ::  mask_char, suffix
    128     CHARACTER (LEN=20)  ::  xtext = 'time in s'
    129     CHARACTER (LEN=30)  ::  filename
    130     CHARACTER (LEN=40)  ::  avs_coor_file, avs_coor_file_localname, &
    131                             avs_data_file_localname
    132     CHARACTER (LEN=80)  ::  rtext
    133     CHARACTER (LEN=100) ::  avs_coor_file_catalog, avs_data_file_catalog, &
    134                             batch_scp, zeile
    135     CHARACTER (LEN=400) ::  command
    136 
    137     INTEGER ::  av, anzzeile = 1, cranz, file_id, i, iaddres, iusern, &
    138                 j, k, legpos = 1, timodex = 1
    139     INTEGER, DIMENSION(10) ::  klist
    140 
    141     LOGICAL ::  avs_coor_file_found = .FALSE., avs_data_file_found = .FALSE., &
    142                 datleg = .TRUE., get_filenames, grid = .TRUE., netcdf_extend, &
    143                 rand = .TRUE., swap = .TRUE., twoxa = .TRUE., twoya = .TRUE.
    144 
    145     REAL ::  ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak = 1.5, &
    146              sizex = 250.0, sizey = 40.0, texfac = 1.5
    147 
    148     REAL, DIMENSION(:), ALLOCATABLE      ::  eta, ho, hu
    149     REAL(spk), DIMENSION(:), ALLOCATABLE ::  xkoor, ykoor, zkoor 
    150 
    151 
    152     NAMELIST /RAHMEN/  anzzeile, cranz, datleg, rtext, swap
    153     NAMELIST /CROSS/   ansx, ansy, grid, gwid, klist, legpos, &
    154                        rand, rlegfak, sizex, sizey, texfac, &
     105    CHARACTER (LEN=2)   ::  mask_char               !:
     106    CHARACTER (LEN=2)   ::  suffix                  !:
     107    CHARACTER (LEN=20)  ::  xtext = 'time in s'     !:
     108    CHARACTER (LEN=30)  ::  filename                !:
     109    CHARACTER (LEN=40)  ::  avs_coor_file           !:
     110    CHARACTER (LEN=40)  ::  avs_coor_file_localname !:
     111    CHARACTER (LEN=40)  ::  avs_data_file_localname !:
     112    CHARACTER (LEN=80)  ::  rtext                   !:
     113    CHARACTER (LEN=100) ::  avs_coor_file_catalog   !:
     114    CHARACTER (LEN=100) ::  avs_data_file_catalog   !:
     115    CHARACTER (LEN=100) ::  batch_scp               !:
     116    CHARACTER (LEN=100) ::  line                    !:
     117    CHARACTER (LEN=400) ::  command                 !:
     118
     119    INTEGER(iwp) ::  av          !:
     120    INTEGER(iwp) ::  numline = 1 !:
     121    INTEGER(iwp) ::  cranz       !:
     122    INTEGER(iwp) ::  file_id     !:
     123    INTEGER(iwp) ::  i           !:
     124    INTEGER(iwp) ::  iaddres     !:
     125    INTEGER(iwp) ::  iusern      !:
     126    INTEGER(iwp) ::  j           !:
     127    INTEGER(iwp) ::  k           !:
     128    INTEGER(iwp) ::  legpos = 1  !:
     129    INTEGER(iwp) ::  timodex = 1 !:
     130   
     131    INTEGER(iwp), DIMENSION(10) ::  klist !:
     132
     133    LOGICAL ::  avs_coor_file_found = .FALSE. !:
     134    LOGICAL ::  avs_data_file_found = .FALSE. !:
     135    LOGICAL ::  datleg = .TRUE.               !:
     136    LOGICAL ::  get_filenames                 !:
     137    LOGICAL ::  grid = .TRUE.                 !:
     138    LOGICAL ::  netcdf_extend                 !:
     139    LOGICAL ::  rand = .TRUE.                 !:
     140    LOGICAL ::  swap = .TRUE.                 !:
     141    LOGICAL ::  twoxa = .TRUE.                !:
     142    LOGICAL ::  twoya = .TRUE.                !:
     143
     144    REAL(wp) ::  ansx = -999.999 !:
     145    REAL(wp) ::  ansy = -999.999 !:
     146    REAL(wp) ::  gwid = 0.1      !:
     147    REAL(wp) ::  rlegfak = 1.5   !:
     148    REAL(wp) ::  sizex = 250.0   !:
     149    REAL(wp) ::  sizey = 40.0    !:
     150    REAL(wp) ::  texfac = 1.5    !:
     151
     152    REAL(wp), DIMENSION(:), ALLOCATABLE      ::  eta !:
     153    REAL(wp), DIMENSION(:), ALLOCATABLE      ::  ho  !:
     154    REAL(wp), DIMENSION(:), ALLOCATABLE      ::  hu  !:
     155   
     156    REAL(sp), DIMENSION(:), ALLOCATABLE ::  xkoor !:
     157    REAL(sp), DIMENSION(:), ALLOCATABLE ::  ykoor !:
     158    REAL(sp), DIMENSION(:), ALLOCATABLE ::  zkoor !: 
     159
     160
     161    NAMELIST /RAHMEN/  numline, cranz, datleg, rtext, swap
     162    NAMELIST /CROSS/   ansx, ansy, grid, gwid, klist, legpos,                  &
     163                       rand, rlegfak, sizex, sizey, texfac,                    &
    155164                       timodex, twoxa, twoya, xtext
    156165                       
    … …  
    169178          CASE ( 13, 14, 21, 22, 23, 80:85 )
    170179             IF ( file_id == 14 .AND. openfile(file_id)%opened_before )  THEN
    171                 message_string = 're-open of unit ' // &
     180                message_string = 're-open of unit ' //                         &
    172181                                 '14 is not verified. Please check results!'
    173182                CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )       
    … …  
    175184
    176185          CASE DEFAULT
    177              WRITE( message_string, * ) 're-opening of file-id ', file_id, &
     186             WRITE( message_string, * ) 're-opening of file-id ', file_id,     &
    178187                                        ' is not allowed'
    179188             CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )   
    … …  
    192201             
    193202          IF ( myid /= 0 )  THEN
    194              WRITE( message_string, * ) 'opening file-id ',file_id, &
     203             WRITE( message_string, * ) 'opening file-id ',file_id,            &
    195204                                        ' not allowed for PE ',myid
    196205             CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
    … …  
    202211         
    203212             IF ( myid /= 0 )  THEN
    204                 WRITE( message_string, * ) 'opening file-id ',file_id, &
     213                WRITE( message_string, * ) 'opening file-id ',file_id,         &
    205214                                           ' not allowed for PE ',myid
    206215                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
    … …  
    213222          IF ( .NOT.  data_output_2d_on_each_pe )  THEN
    214223             IF ( myid /= 0 )  THEN
    215                 WRITE( message_string, * ) 'opening file-id ',file_id, &
     224                WRITE( message_string, * ) 'opening file-id ',file_id,         &
    216225                                           ' not allowed for PE ',myid
    217226                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
    … …  
    223232!
    224233!--       File-ids that are used temporarily in other routines
    225           WRITE( message_string, * ) 'opening file-id ',file_id, &
     234          WRITE( message_string, * ) 'opening file-id ',file_id,               &
    226235                                    ' is not allowed since it is used otherwise'
    227236          CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
    … …  
    241250!--       check_namelist_files!
    242251          IF ( check_restart == 2 ) THEN
    243              OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED', &
     252             OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED',        &
    244253                        STATUS='OLD' )
    245254          ELSE
    246              OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
     255             OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED',         &
    247256                        STATUS='OLD' )
    248257          END IF
    249258#else
    250259
    251           OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
     260          OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED',            &
    252261                     STATUS='OLD' )
    253262#endif
    … …  
    256265
    257266          IF ( myid_char == '' )  THEN
    258              OPEN ( 13, FILE='BININ'//coupling_char//myid_char, &
     267             OPEN ( 13, FILE='BININ'//coupling_char//myid_char,                &
    259268                        FORM='UNFORMATTED', STATUS='OLD' )
    260269          ELSE
    … …  
    263272!--          this file contains the global variables
    264273             IF ( .NOT. openfile(file_id)%opened_before )  THEN
    265                 OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_0000',&
     274                OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_0000',      &
    266275                           FORM='UNFORMATTED', STATUS='OLD' )
    267276             ELSE
    … …  
    274283
    275284          IF ( myid_char == '' )  THEN
    276              OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, &
     285             OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char,               &
    277286                        FORM='UNFORMATTED', POSITION='APPEND' )
    278287          ELSE
    … …  
    286295             CALL MPI_BARRIER( comm2d, ierr )
    287296#endif
    288              OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
     297             OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char,    &
    289298                        FORM='UNFORMATTED' )
    290299          ENDIF
    … …  
    316325          ENDIF
    317326          IF ( myid_char == '' )  THEN
    318              OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', &
     327             OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000',      &
    319328                        FORM='UNFORMATTED', POSITION='APPEND' )
    320329          ELSE
    … …  
    332341
    333342          IF ( data_output_2d_on_each_pe )  THEN
    334              OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
     343             OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char,    &
    335344                        FORM='UNFORMATTED', POSITION='APPEND' )
    336345          ELSE
    337              OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, &
     346             OPEN ( 21, FILE='PLOT2D_XY'//coupling_char,                       &
    338347                        FORM='UNFORMATTED', POSITION='APPEND' )
    339348          ENDIF
    … …  
    363372!--          Create output file for local parameters
    364373             IF ( iso2d_output )  THEN
    365                 OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, &
     374                OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char,              &
    366375                           FORM='FORMATTED', DELIM='APOSTROPHE' )
    367376                openfile(27)%opened = .TRUE.
    … …  
    373382
    374383          IF ( data_output_2d_on_each_pe )  THEN
    375              OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
     384             OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char,    &
    376385                        FORM='UNFORMATTED', POSITION='APPEND' )
    377386          ELSE
    378              OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', &
     387             OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED',   &
    379388                        POSITION='APPEND' )
    380389          ENDIF
    … …  
    402411!
    403412!--          Create output file for local parameters
    404              OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, &
     413             OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char,                 &
    405414                        FORM='FORMATTED', DELIM='APOSTROPHE' )
    406415             openfile(28)%opened = .TRUE.
    … …  
    411420
    412421          IF ( data_output_2d_on_each_pe )  THEN
    413              OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
     422             OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char,    &
    414423                        FORM='UNFORMATTED', POSITION='APPEND' )
    415424          ELSE
    416              OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', &
     425             OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED',   &
    417426                        POSITION='APPEND' )
    418427          ENDIF
    … …  
    440449!
    441450!--          Create output file for local parameters
    442              OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, &
     451             OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char,                 &
    443452                        FORM='FORMATTED', DELIM='APOSTROPHE' )
    444453             openfile(29)%opened = .TRUE.
    … …  
    448457       CASE ( 30 )
    449458
    450           OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
     459          OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char,     &
    451460                     FORM='UNFORMATTED' )
    452461!
    … …  
    471480
    472481                OPEN ( 3, FILE='OUTPUT_FILE_CONNECTIONS', FORM='FORMATTED' )
    473                 DO  WHILE ( .NOT. avs_coor_file_found  .OR. &
     482                DO  WHILE ( .NOT. avs_coor_file_found  .OR.                    &
    474483                            .NOT. avs_data_file_found )
    475484
    476                    READ ( 3, '(A)', END=1 )  zeile
    477 
    478                    SELECT CASE ( zeile(1:11) )
     485                   READ ( 3, '(A)', END=1 )  line
     486
     487                   SELECT CASE ( line(1:11) )
    479488
    480489                      CASE ( 'PLOT3D_COOR' )
    481                          READ ( 3, '(A/A)' )  avs_coor_file_catalog, &
     490                         READ ( 3, '(A/A)' )  avs_coor_file_catalog,           &
    482491                                              avs_coor_file_localname
    483492                         avs_coor_file_found = .TRUE.
    484493
    485494                      CASE ( 'PLOT3D_DATA' )
    486                          READ ( 3, '(A/A)' )  avs_data_file_catalog, &
     495                         READ ( 3, '(A/A)' )  avs_data_file_catalog,           &
    487496                                              avs_data_file_localname
    488497                         avs_data_file_found = .TRUE.
    489498
    490499                      CASE DEFAULT
    491                          READ ( 3, '(A/A)' )  zeile, zeile
     500                         READ ( 3, '(A/A)' )  line, line
    492501
    493502                   END SELECT
    … …  
    498507!--             using batch_scp
    499508       1        CLOSE ( 3 )
    500                 IF ( .NOT. avs_coor_file_found  .OR. &
     509                IF ( .NOT. avs_coor_file_found  .OR.                           &
    501510                     .NOT. avs_data_file_found )  THEN
    502                    message_string= 'no filename for AVS-data-file ' //       &
    503                                    'found in MRUN-config-file' //            &
     511                   message_string= 'no filename for AVS-data-file ' //         &
     512                                   'found in MRUN-config-file' //              &
    504513                                   ' &filename in FLD-file set to "unknown"'
    505514                   CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 )
    … …  
    509518                ELSE
    510519                   get_filenames = .TRUE.
    511                    IF ( TRIM( host ) == 'hpmuk'  .OR.  &
     520                   IF ( TRIM( host ) == 'hpmuk'  .OR.                          &
    512521                        TRIM( host ) == 'lcmuk' )  THEN
    513522                      batch_scp = '/home/raasch/pub/batch_scp'
    514523                   ELSEIF ( TRIM( host ) == 'nech' )  THEN
    515524                      batch_scp = '/ipf/b/b323011/pub/batch_scp'
    516                    ELSEIF ( TRIM( host ) == 'ibmh'  .OR.  &
     525                   ELSEIF ( TRIM( host ) == 'ibmh'  .OR.                       &
    517526                            TRIM( host ) == 'ibmb' )  THEN
    518527                      batch_scp = '/home/h/niksiraa/pub/batch_scp'
    … …  
    520529                      batch_scp = '/home/nhbksira/pub/batch_scp'
    521530                   ELSE
    522                       message_string= 'no path for batch_scp on host "' // &
     531                      message_string= 'no path for batch_scp on host "' //     &
    523532                                       TRIM( host ) // '"'
    524533                      CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 )
    … …  
    531540!--                   /etc/passwd serves as Dummy-Datei, because it is not
    532541!--                   really transferred.
    533                       command = TRIM( batch_scp ) // ' -n -u ' // &
    534                          return_username(1:iusern) // ' ' // &
    535                          return_addres(1:iaddres) // ' /etc/passwd "' // &
    536                          TRIM( avs_coor_file_catalog ) // '" ' // &
     542                      command = TRIM( batch_scp ) // ' -n -u ' //              &
     543                         return_username(1:iusern) // ' ' //                   &
     544                         return_addres(1:iaddres) // ' /etc/passwd "' //       &
     545                         TRIM( avs_coor_file_catalog ) // '" ' //              &
    537546                         TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME'
    538547
    … …  
    543552!
    544553!--                   Determine the data file name
    545                       command = TRIM( batch_scp ) // ' -n -u ' // &
    546                          return_username(1:iusern) // ' ' // &
    547                          return_addres(1:iaddres) // ' /etc/passwd "' // &
    548                          TRIM( avs_data_file_catalog ) // '" ' // &
     554                      command = TRIM( batch_scp ) // ' -n -u ' //              &
     555                         return_username(1:iusern) // ' ' //                   &
     556                         return_addres(1:iaddres) // ' /etc/passwd "' //       &
     557                         TRIM( avs_data_file_catalog ) // '" ' //              &
    549558                         TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME'
    550559
    … …  
    567576                OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' )
    568577                openfile(33)%opened = .TRUE.
    569                 WRITE ( 33, 3300 )  TRIM( avs_coor_file ), &
    570                                     TRIM( avs_coor_file ), (nx+2*nbgp)*4, &
     578                WRITE ( 33, 3300 )  TRIM( avs_coor_file ),                     &
     579                                    TRIM( avs_coor_file ), (nx+2*nbgp)*4,      &
    571580                                    TRIM( avs_coor_file ), (nx+2*nbgp)*4+(ny+2*nbgp)*4
    572581           
    … …  
    623632             WRITE ( suffix, '(''_'',I1)' )  file_id - 50
    624633          ENDIF
    625           OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// &
    626                                TRIM( suffix ),                        &
     634          OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )//          &
     635                               TRIM( suffix ),                                 &
    627636                          FORM='FORMATTED', RECL=496 )
    628637!
    … …  
    638647             IF ( cross_ts_number_count(j) /= 0 )  cranz = cranz+1
    639648          ENDDO
    640           rtext = '\1.0 ' // TRIM( run_description_header ) // '    ' // &
     649          rtext = '\1.0 ' // TRIM( run_description_header ) // '    ' //       &
    641650                  TRIM( region( file_id - 50 ) )
    642651!
    643652!--       Write RAHMEN parameter
    644           OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// &
    645                            TRIM( suffix ),                      &
     653          OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )//                &
     654                           TRIM( suffix ),                                     &
    646655                     FORM='FORMATTED', DELIM='APOSTROPHE' )
    647656          WRITE ( 90, RAHMEN )
    … …  
    669678!--       series data to the bottom of that file.
    670679          IF ( runnr == 0 )  THEN
    671              WRITE ( file_id, 5000 )  TRIM( run_description_header ) // &
     680             WRITE ( file_id, 5000 )  TRIM( run_description_header ) //        &
    672681                                      '    ' // TRIM( region( file_id - 50 ) )
    673682          ENDIF
    … …  
    694703             ENDIF
    695704#endif
    696              OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
    697                              myid_char,                                     &
     705             OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'//    &
     706                             myid_char,                                        &
    698707                        FORM='FORMATTED', POSITION='APPEND' )
    699708          ENDIF
    … …  
    705714       CASE ( 81 )
    706715
    707              OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', &
     716             OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED',  &
    708717                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
    709718
    … …  
    715724       CASE ( 83 )
    716725
    717              OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', &
     726             OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED',  &
    718727                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
    719728
    … …  
    726735
    727736          IF ( myid_char == '' )  THEN
    728              OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
     737             OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char,  &
    729738                        FORM='UNFORMATTED', POSITION='APPEND' )
    730739          ELSE
    … …  
    738747             CALL MPI_BARRIER( comm2d, ierr )
    739748#endif
    740              OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
    741                         myid_char,                                         &
     749             OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'//     &
     750                        myid_char,                                             &
    742751                        FORM='UNFORMATTED', POSITION='APPEND' )
    743752          ENDIF
    … …  
    751760             rtext = 'data format version 3.0'
    752761             WRITE ( 85 )  rtext
    753              WRITE ( 85 )  number_of_particle_groups, &
     762             WRITE ( 85 )  number_of_particle_groups,                          &
    754763                           max_number_of_particle_groups
    755764             WRITE ( 85 )  particle_groups
    … …  
    11101119             filename = 'DATA_PRT_NETCDF' // coupling_char
    11111120          ELSE
    1112              filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
     1121             filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' //   &
    11131122                        myid_char
    11141123          ENDIF
    … …  
    11431152!--          For runs on multiple processors create the subdirectory
    11441153             IF ( myid_char /= '' )  THEN
    1145                 IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before ) &
     1154                IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  &
    11461155                THEN    ! needs modification in case of non-extendable sets
    1147                    CALL local_system( 'mkdir  DATA_PRT_NETCDF' // &
     1156                   CALL local_system( 'mkdir  DATA_PRT_NETCDF' //              &
    11481157                                       TRIM( coupling_char ) // '/' )
    11491158                ENDIF
    … …  
    12171226             mid = file_id - (200+max_masks)
    12181227             WRITE ( mask_char,'(I2.2)')  mid
    1219              filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // &
     1228             filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' //           &
    12201229                  coupling_char
    12211230             av = 1
    … …  
    12301239!
    12311240!--          Open an existing netCDF file for output
    1232              CALL open_write_netcdf_file( filename, id_set_mask(mid,av), &
     1241             CALL open_write_netcdf_file( filename, id_set_mask(mid,av),       &
    12331242                                          .TRUE., 456 )
    12341243!
    … …  
    12821291!
    12831292!-- Formats
    1284 3300 FORMAT ('#'/                                                   &
    1285              'coord 1  file=',A,'  filetype=unformatted'/           &
    1286              'coord 2  file=',A,'  filetype=unformatted  skip=',I6/ &
    1287              'coord 3  file=',A,'  filetype=unformatted  skip=',I6/ &
     12933300 FORMAT ('#'/                                                              &
     1294             'coord 1  file=',A,'  filetype=unformatted'/                      &
     1295             'coord 2  file=',A,'  filetype=unformatted  skip=',I6/            &
     1296             'coord 3  file=',A,'  filetype=unformatted  skip=',I6/            &
    12881297             '#')
    128912984000 FORMAT ('# ',A)
    1290 5000 FORMAT ('# ',A/                                                          &
    1291              '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/     &
    1292              '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
    1293              '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/     &
     12995000 FORMAT ('# ',A/                                                           &
     1300             '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/      &
     1301             '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/  &
     1302             '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/      &
    12941303             '#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
    1295 8000 FORMAT (A/                                                            &
    1296              '  step    time  # of parts   lPE sent/recv  rPE sent/recv  ',&
    1297              'sPE sent/recv  nPE sent/recv  max # of parts'/               &
     13048000 FORMAT (A/                                                                &
     1305             '  step    time  # of parts   lPE sent/recv  rPE sent/recv  ',    &
     1306             'sPE sent/recv  nPE sent/recv  max # of parts'/                   &
    12981307             103('-'))
    12991308

  • palm/trunk/SOURCE/check_parameters.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:
    … …  
    167173! New cpp directive "__check" implemented which is used by check_namelist_files
    168174!
    169 ! 774 2011-10-27 13:34:16Z letzel
    170 ! bugfix for prescribed u,v-profiles
    171 !
    172 ! 767 2011-10-14 06:39:12Z raasch
    173 ! Calculating u,v-profiles from given profiles by linear interpolation.
    174 ! bugfix: dirichlet_0 conditions for ug/vg moved from init_3d_model to here
    175 !
    176 ! 707 2011-03-29 11:39:40Z raasch
    177 ! setting of bc_lr/ns_dirrad/raddir
    178 !
    179 ! 689 2011-02-20 19:31:12z gryschka
    180 ! Bugfix for some logical expressions
    181 ! (syntax was not compatible with all compilers)
    182 !
    183 ! 680 2011-02-04 23:16:06Z gryschka
    184 ! init_vortex is not allowed with volume_flow_control
    185 !
    186 ! 673 2011-01-18 16:19:48Z suehring
    187 ! Declaration of ws_scheme_sca and ws_scheme_mom added (moved from advec_ws).
    188 !
    189 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    190 ! Exchange of parameters between ocean and atmosphere via PE0
    191 ! Check for illegal combination of ws-scheme and timestep scheme.
    192 ! Check for topography and ws-scheme.
    193 ! Check for not cyclic boundary conditions in combination with ws-scheme and
    194 ! loop_optimization = 'vector'.
    195 ! Check for call_psolver_at_all_substeps and ws-scheme for momentum_advec.
    196 ! Different processor/grid topology in atmosphere and ocean is now allowed!
    197 ! Bugfixes in checking for conserve_volume_flow_mode
    198 ! 600 2010-11-24 16:10:51Z raasch
    199 ! change due to new default value of surface_waterflux
    200 ! 580 2010-10-05 13:59:11Z heinze
    201 ! renaming of ws_vertical_gradient_level to subs_vertical_gradient_level
    202 !
    203 ! 567 2010-10-01 10:46:30Z helmke
    204 ! calculating masks changed
    205 !
    206 ! 564 2010-09-30 13:18:59Z helmke
    207 ! palm message identifiers of masked output changed, 20 replaced by max_masks
    208 !
    209 ! 553 2010-09-01 14:09:06Z weinreis
    210 ! masks is calculated and removed from inipar
    211 !
    212 ! 531 2010-04-21 06:47:21Z heinze
    213 ! Bugfix: unit of hyp changed to dbar
    214 !
    215 ! 524 2010-03-30 02:04:51Z raasch
    216 ! Bugfix: "/" in netcdf profile variable names replaced by ":"
    217 !
    218 ! 493 2010-03-01 08:30:24Z raasch
    219 ! netcdf_data_format is checked
    220 !
    221 ! 411 2009-12-11 14:15:58Z heinze
    222 ! Enabled passive scalar/humidity wall fluxes for non-flat topography
    223 ! Initialization of large scale vertical motion (subsidence/ascent)
    224 !
    225 ! 410 2009-12-04 17:05:40Z letzel
    226 ! masked data output
    227 !
    228 ! 388 2009-09-23 09:40:33Z raasch
    229 ! Check profiles fpr prho and hyp.
    230 ! Bugfix: output of averaged 2d/3d quantities requires that an avaraging
    231 ! interval has been set, respective error message is included
    232 ! bc_lr_cyc and bc_ns_cyc are set,
    233 ! initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill'
    234 ! Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
    235 ! Coupling with independent precursor runs.
    236 ! Check particle_color, particle_dvrpsize, color_interval, dvrpsize_interval
    237 ! Bugfix: pressure included for profile output
    238 ! Check pressure gradient conditions
    239 ! topography_grid_convention moved from user_check_parameters
    240 ! 'single_street_canyon'
    241 ! Added shf* and qsws* to the list of available output data
    242 !
    243 ! 222 2009-01-12 16:04:16Z letzel
    244 ! +user_check_parameters
    245 ! Output of messages replaced by message handling routine.
    246 ! Implementation of an MPI-1 coupling: replaced myid with target_id,
    247 ! deleted __mpi2 directives
    248 ! Check that PALM is called with mrun -K parallel for coupling
    249 !
    250 ! 197 2008-09-16 15:29:03Z raasch
    251 ! Bug fix: Construction of vertical profiles when 10 gradients have been
    252 ! specified in the parameter list (ug, vg, pt, q, sa, lad)
    253 !   
    254 ! Strict grid matching along z is not needed for mg-solver.
    255 ! Leaf area density (LAD) explicitly set to its surface value at k=0
    256 ! Case of reading data for recycling included in initializing_actions,
    257 ! check of turbulent_inflow and calculation of recycling_plane.
    258 ! q*2 profile added
    259 !
    260 ! 138 2007-11-28 10:03:58Z letzel
    261 ! Plant canopy added
    262 ! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
    263 ! Multigrid solver allows topography, checking of dt_sort_particles
    264 ! Bugfix: initializing u_init and v_init in case of ocean runs
    265 !
    266 ! 109 2007-08-28 15:26:47Z letzel
    267 ! Check coupling_mode and set default (obligatory) values (like boundary
    268 ! conditions for temperature and fluxes) in case of coupled runs.
    269 ! +profiles for w*p* and w"e
    270 ! Bugfix: Error message concerning output of particle concentration (pc)
    271 ! modified
    272 ! More checks and more default values for coupled runs
    273 ! allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of
    274 ! cloud_physics = .T.)
    275 ! Rayleigh damping for ocean fixed.
    276 ! Check and, if necessary, set default value for dt_coupling
    277 !
    278 ! 97 2007-06-21 08:23:15Z raasch
    279 ! Initial salinity profile is calculated, salinity boundary conditions are
    280 ! checked,
    281 ! z_max_do1d is checked only in case of ocean = .f.,
    282 ! +initial temperature and geostrophic velocity profiles for the ocean version,
    283 ! use_pt_reference renamed use_reference
    284 !
    285 ! 89 2007-05-25 12:08:31Z raasch
    286 ! Check for user-defined profiles
    287 !
    288 ! 75 2007-03-22 09:54:05Z raasch
    289 ! "by_user" allowed as initializing action, -data_output_ts,
    290 ! leapfrog with non-flat topography not allowed any more, loop_optimization
    291 ! and pt_reference are checked, moisture renamed humidity,
    292 ! output of precipitation amount/rate and roughnes length + check
    293 ! possible negative humidities are avoided in initial profile,
    294 ! dirichlet/neumann changed to dirichlet/radiation, etc.,
    295 ! revision added to run_description_header
    296 !
    297 ! 20 2007-02-26 00:12:32Z raasch
    298 ! Temperature and humidity gradients at top are now calculated for nzt+1,
    299 ! top_heatflux and respective boundary condition bc_pt_t is checked
    300 !
    301 ! RCS Log replace by Id keyword, revision history cleaned up
    302 !
    303 ! Revision 1.61  2006/08/04 14:20:25  raasch
    304 ! do2d_unit and do3d_unit now defined as 2d-arrays, check of
    305 ! use_upstream_for_tke, default value for dt_dopts,
    306 ! generation of file header moved from routines palm and header to here
    307 !
    308175! Revision 1.1  1997/08/26 06:29:23  raasch
    309176! Initial revision
    … …  
    322189    USE grid_variables
    323190    USE indices
     191    USE kinds
    324192    USE model_1d
    325193    USE netcdf_control
    … …  
    335203    IMPLICIT NONE
    336204
    337     CHARACTER (LEN=1)   ::  sq
    338     CHARACTER (LEN=6)   ::  var
    339     CHARACTER (LEN=7)   ::  unit
    340     CHARACTER (LEN=8)   ::  date
    341     CHARACTER (LEN=10)  ::  time
    342     CHARACTER (LEN=40)  ::  coupling_string
    343     CHARACTER (LEN=100) ::  action
    344 
    345     INTEGER ::  i, ilen, iremote = 0, j, k, kk, netcdf_data_format_save, &
    346                 position, prec
    347     LOGICAL ::  found, ldum
    348     REAL    ::  gradient, remote = 0.0, simulation_time_since_reference
     205    CHARACTER (LEN=1)   ::  sq                       !:
     206    CHARACTER (LEN=6)   ::  var                      !:
     207    CHARACTER (LEN=7)   ::  unit                     !:
     208    CHARACTER (LEN=8)   ::  date                     !:
     209    CHARACTER (LEN=10)  ::  time                     !:
     210    CHARACTER (LEN=40)  ::  coupling_string          !:
     211    CHARACTER (LEN=100) ::  action                   !:
     212
     213    INTEGER(iwp) ::  i                               !:
     214    INTEGER(iwp) ::  ilen                            !:
     215    INTEGER(iwp) ::  iremote = 0                     !:
     216    INTEGER(iwp) ::  j                               !:
     217    INTEGER(iwp) ::  k                               !:
     218    INTEGER(iwp) ::  kk                              !:
     219    INTEGER(iwp) ::  netcdf_data_format_save         !:
     220    INTEGER(iwp) ::  position                        !:
     221    INTEGER(iwp) ::  prec                            !:
     222   
     223    LOGICAL     ::  found                            !:
     224    LOGICAL     ::  ldum                             !:
     225   
     226    REAL(wp)    ::  gradient                         !:
     227    REAL(wp)    ::  remote = 0.0                     !:
     228    REAL(wp)    ::  simulation_time_since_reference  !:
    349229
    350230!

  • palm/trunk/SOURCE/close_file.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:
    … …  
    3743! 964 2012-07-26 09:14:24Z raasch
    3844! old profil-units (40:49) and respective code removed
    39 !
    40 ! 564 2010-09-30 13:18:59Z helmke
    41 ! start number of mask output files changed to 201, netcdf message identifiers
    42 ! of masked output changed
    43 !
    44 ! 493 2010-03-01 08:30:24Z raasch
    45 ! Adjustments for NetCDF parallel data output
    46 !
    47 ! 410 2009-12-04 17:05:40Z letzel
    48 ! masked data output
    49 !
    50 ! 263 2009-03-18 12:26:04Z heinze
    51 ! Output of NetCDF messages with aid of message handling routine.
    52 !
    53 ! Feb. 2007
    54 ! RCS Log replace by Id keyword, revision history cleaned up
    55 !
    56 ! Revision 1.10  2006/08/22 13:50:01  raasch
    57 ! xz and yz cross sections now up to nzt+1
    58 !
    59 ! Revision 1.1  2001/01/02 17:23:41  raasch
    60 ! Initial revision
    61 !
    62 ! Last revision before renaming subroutine  2001/01/01  raasch
    63 ! Subroutine name changed from close_files to close_file. Closing of a single
    64 ! file is allowed by passing its file-id as an argument. Variable openfile now
    65 ! is of type file_status and contains a flag which indicates if a file has
    66 ! been opened before. Old revision remarks deleted.
    67 !
    68 ! Revision 1.13 (close_files) 2000/12/20 09:10:24  letzel
    69 ! All comments translated into English.
    70 !
    71 ! Revision 1.12 (close_files) 1999/03/02 09:22:46  raasch
    72 ! FLD-Header fuer komprimierte 3D-Daten
    7345!
    7446! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
    … …  
    8355!------------------------------------------------------------------------------!
    8456
    85     USE control_parameters
    86     USE grid_variables
    87     USE indices
     57    USE control_parameters,                                                    &
     58        ONLY:  do2d_xz_n, do2d_xy_n, do2d_yz_n, do3d_avs_n, do3d_compress,     &
     59               host, iso2d_output, max_masks, mid, netcdf_data_format,         &
     60               netcdf_output, nz_do3d, openfile, run_description_header,       &
     61               z_max_do2d
     62               
     63    USE grid_variables,                                                        &
     64        ONLY:  dy
     65       
     66    USE indices,                                                               &
     67        ONLY:  nx, ny, nz
     68       
     69    USE kinds
     70   
    8871    USE netcdf_control
    89     USE pegrid
    90     USE profil_parameter
    91     USE statistics
     72               
     73    USE pegrid                                           
    9274
    9375    IMPLICIT NONE
    9476
    95     CHARACTER (LEN=10)  ::  datform = 'lit_endian'
    96     CHARACTER (LEN=80)  ::  title
    97 
    98     INTEGER ::  av, dimx, dimy, &
    99                 fid, file_id, planz
    100 
    101     LOGICAL ::  checkuf = .TRUE., datleg = .TRUE., dp = .FALSE.
    102 
    103     REAL ::  sizex, sizey, yright
    104 
    105     NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dp, planz, &
     77    CHARACTER (LEN=10)  ::  datform = 'lit_endian' !:
     78    CHARACTER (LEN=80)  ::  title                  !:
     79
     80    INTEGER(iwp) ::  av           !:
     81    INTEGER(iwp) ::  dimx         !:
     82    INTEGER(iwp) ::  dimy         !:
     83    INTEGER(iwp) ::  fid          !:
     84    INTEGER(iwp) ::  file_id      !:
     85    INTEGER(iwp) ::  planz        !:
     86
     87    LOGICAL ::  checkuf = .TRUE.  !:
     88    LOGICAL ::  datleg = .TRUE.   !:
     89    LOGICAL ::  dbp = .FALSE.     !:
     90
     91    REAL(wp) ::  sizex            !:
     92    REAL(wp) ::  sizey            !:
     93    REAL(wp) ::  yright           !:
     94
     95    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dbp, planz,               &
    10696                       title
    10797    NAMELIST /RAHMEN/  datleg
    … …  
    140130                   yright = ( ny + 1.0 ) * dy
    141131                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
    142                       checkuf = .FALSE.; dp = .TRUE.
     132                      checkuf = .FALSE.; dbp = .TRUE.
    143133                   ENDIF
    144134                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
    145135                      datform = 'big_endian'
    146136                   ENDIF
    147                    OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
     137                   OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED',       &
    148138                              DELIM='APOSTROPHE' )
    149139                   WRITE ( 90, GLOBAL )
    … …  
    163153                   yright = z_max_do2d
    164154                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
    165                       checkuf = .FALSE.; dp = .TRUE.
     155                      checkuf = .FALSE.; dbp = .TRUE.
    166156                   ENDIF
    167157                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
    168158                      datform = 'big_endian'
    169159                   ENDIF
    170                    OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
     160                   OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED',       &
    171161                              DELIM='APOSTROPHE' )
    172162                   WRITE ( 90, GLOBAL )
    … …  
    186176                   yright = z_max_do2d
    187177                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
    188                       checkuf = .FALSE.; dp = .TRUE.
     178                      checkuf = .FALSE.; dbp = .TRUE.
    189179                   ENDIF
    190180                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
    191181                      datform = 'big_endian'
    192182                   ENDIF
    193                    OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
     183                   OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED',       &
    194184                              DELIM='APOSTROPHE' )
    195185                   WRITE ( 90, GLOBAL )
    … …  
    201191!--             Write header for FLD-file
    202192                IF ( do3d_compress )  THEN
    203                    WRITE ( 32, 3200)  ' compressed ',                       &
    204                                       TRIM( run_description_header ), nx+2, &
     193                   WRITE ( 32, 3200)  ' compressed ',                          &
     194                                      TRIM( run_description_header ), nx+2,    &
    205195                                      ny+2, nz_do3d+1, do3d_avs_n
    206196                ELSE
    207                    WRITE ( 32, 3200)  ' ', TRIM( run_description_header ), &
     197                   WRITE ( 32, 3200)  ' ', TRIM( run_description_header ),     &
    208198                                      nx+2, ny+2, nz_do3d+1, do3d_avs_n
    209199                ENDIF
    … …  
    212202             CASE ( 101 )
    213203
    214                 IF ( netcdf_output  .AND.  &
     204                IF ( netcdf_output  .AND.                                      &
    215205                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    216206                   nc_stat = NF90_CLOSE( id_set_xy(0) )
    … …  
    220210             CASE ( 102 )
    221211
    222                 IF ( netcdf_output  .AND.  &
     212                IF ( netcdf_output  .AND.                                      &
    223213                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    224214                   nc_stat = NF90_CLOSE( id_set_xz(0) )
    … …  
    228218             CASE ( 103 )
    229219
    230                 IF ( netcdf_output  .AND.  &
     220                IF ( netcdf_output  .AND.                                      &
    231221                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    232222                   nc_stat = NF90_CLOSE( id_set_yz(0) )
    … …  
    279269             CASE ( 111 )
    280270
    281                 IF ( netcdf_output  .AND.  &
     271                IF ( netcdf_output  .AND.                                      &
    282272                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    283273                   nc_stat = NF90_CLOSE( id_set_xy(1) )
    … …  
    287277             CASE ( 112 )
    288278
    289                 IF ( netcdf_output  .AND.  &
     279                IF ( netcdf_output  .AND.                                      &
    290280                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    291281                   nc_stat = NF90_CLOSE( id_set_xz(1) )
    … …  
    295285             CASE ( 113 )
    296286
    297                 IF ( netcdf_output  .AND.  &
     287                IF ( netcdf_output  .AND.                                      &
    298288                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    299289                   nc_stat = NF90_CLOSE( id_set_yz(1) )
    … …  
    303293             CASE ( 116 )
    304294
    305                 IF ( netcdf_output  .AND.  &
     295                IF ( netcdf_output  .AND.                                      &
    306296                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    307297                   nc_stat = NF90_CLOSE( id_set_3d(1) )
    … …  
    311301             CASE ( 201:200+2*max_masks )
    312302             
    313                 IF ( netcdf_output  .AND.  &
     303                IF ( netcdf_output  .AND.                                      &
    314304                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
    315305!
    … …  
    340330!
    341331!-- Formats
    342 3200 FORMAT ('# AVS',A,'field file'/ &
    343              '#'/                &
    344              '# ',A/             &
    345              'ndim=3'/           &
    346              'dim1=',I5/         &
    347              'dim2=',I5/         &
    348              'dim3=',I5/         &
    349              'nspace=3'/         &
    350              'veclen=',I5/       &
    351              'data=xdr_float'/   &
     3323200 FORMAT ('# AVS',A,'field file'/                                           &
     333             '#'/                                                              &
     334             '# ',A/                                                           &
     335             'ndim=3'/                                                         &
     336             'dim1=',I5/                                                       &
     337             'dim2=',I5/                                                       &
     338             'dim3=',I5/                                                       &
     339             'nspace=3'/                                                       &
     340             'veclen=',I5/                                                     &
     341             'data=xdr_float'/                                                 &
    352342             'field=rectilinear')
    3533434000 FORMAT ('time averaged over',F7.1,' s')

  • palm/trunk/SOURCE/compute_vpt.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:
    … …  
    3238! Bugfix: wrong factor in calculation of vpt in case of cloud droplets
    3339!
    34 ! 799 2011-12-21 17:48:03Z franke
    35 ! Bugfix: ql is now included in calculation of vpt in case of
    36 !         cloud droplets
    37 !
    38 ! RCS Log replace by Id keyword, revision history cleaned up
    39 !
    40 ! Revision 1.5  2001/03/30 06:58:52  raasch
    41 ! Translation of remaining German identifiers (variables, subroutines, etc.)
    42 !
    4340! Revision 1.1  2000/04/13 14:40:53  schroeter
    4441! Initial revision
    … …  
    4845! -------------
    4946! Computation of the virtual potential temperature
    50 !-------------------------------------------------------------------------------!
     47!------------------------------------------------------------------------------!
    5148
    52     USE arrays_3d
    53     USE indices
    54     USE cloud_parameters
    55     USE control_parameters
     49    USE arrays_3d,                                                             &
     50        ONLY:  pt, q, ql, vpt
     51       
     52    USE indices,                                                               &
     53        ONLY:  nzb, nzt
     54       
     55    USE cloud_parameters,                                                      &
     56        ONLY:  l_d_cp, pt_d_t
     57       
     58    USE control_parameters,                                                    &
     59        ONLY:  cloud_droplets, cloud_physics
     60       
     61    USE kinds
    5662
    5763    IMPLICIT NONE
    5864
    59     INTEGER :: k
     65    INTEGER(iwp) :: k   !:
    6066
    61     IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
     67    IF ( .NOT. cloud_physics  .AND.  .NOT. cloud_droplets ) THEN
    6268       vpt = pt * ( 1.0 + 0.61 * q )
    63     ELSE IF (cloud_physics) THEN
     69    ELSE IF (cloud_physics)  THEN
    6470       DO  k = nzb, nzt+1
    65           vpt(k,:,:) = ( pt(k,:,:) + pt_d_t(k) * l_d_cp * ql(k,:,:) ) * &
     71          vpt(k,:,:) = ( pt(k,:,:) + pt_d_t(k) * l_d_cp * ql(k,:,:) ) *        &
    6672                       ( 1.0 + 0.61 * q(k,:,:) - 1.61 * ql(k,:,:) )
    6773       ENDDO

  • palm/trunk/SOURCE/coriolis.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:
    … …  
    3844! 1015 2012-09-27 09:23:24Z raasch
    3945! accelerator version (*_acc) added
    40 !
    41 ! 254 2009-03-05 15:33:42Z heinze
    42 ! Output of messages replaced by message handling routine.
    43 !
    44 ! 106 2007-08-16 14:30:26Z raasch
    45 ! loops for u and v are starting from index nxlu, nysv, respectively (needed
    46 ! for non-cyclic boundary conditions)
    47 !
    48 ! 75 2007-03-22 09:54:05Z raasch
    49 ! uxrp, vynp eliminated
    50 !
    51 ! RCS Log replace by Id keyword, revision history cleaned up
    52 !
    53 ! Revision 1.12  2006/02/23 10:08:57  raasch
    54 ! nzb_2d replaced by nzb_u/v/w_inner
    5546!
    5647! Revision 1.1  1997/08/29 08:57:38  raasch
    … …  
    8374    SUBROUTINE coriolis( component )
    8475
    85        USE arrays_3d
    86        USE control_parameters
    87        USE indices
    88        USE pegrid
     76       USE arrays_3d,                                                          &
     77           ONLY:  tend, u, ug, v, vg, w
     78           
     79       USE control_parameters,                                                 &
     80           ONLY:  f, fs, message_string
     81           
     82       USE indices,                                                            &
     83           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner,    &
     84                  nzb_w_inner, nzt
     85                   
     86       USE kinds
    8987
    9088       IMPLICIT NONE
    9189
    92        INTEGER ::  component, i, j, k
     90       INTEGER(iwp) ::  component  !:
     91       INTEGER(iwp) ::  i          !:
     92       INTEGER(iwp) ::  j          !:
     93       INTEGER(iwp) ::  k          !:
    9394
    9495
    … …  
    103104                DO  j = nys, nyn
    104105                   DO  k = nzb_u_inner(j,i)+1, nzt
    105                       tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *            &
    106                                    ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
    107                                      v(k,j+1,i) ) - vg(k) )                   &
    108                                              - fs *    ( 0.25 *               &
    109                                    ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
     106                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *             &
     107                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
     108                                     v(k,j+1,i) ) - vg(k) )                    &
     109                                             - fs *    ( 0.25 *                &
     110                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
    110111                                     w(k,j,i)   ) &
    111112                                                          )
    … …  
    120121                DO  j = nysv, nyn
    121122                   DO  k = nzb_v_inner(j,i)+1, nzt
    122                       tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *          &
    123                                    ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
     123                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *             &
     124                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
    124125                                     u(k,j,i+1) ) - ug(k) )
    125126                   ENDDO
    … …  
    133134                DO  j = nys, nyn
    134135                   DO  k = nzb_w_inner(j,i)+1, nzt
    135                       tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
    136                                    ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
     136                      tend(k,j,i) = tend(k,j,i) + fs * 0.25 *                  &
     137                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
    137138                                     u(k+1,j,i+1) )
    138139                   ENDDO
    … …  
    155156    SUBROUTINE coriolis_acc( component )
    156157
    157        USE arrays_3d
    158        USE control_parameters
    159        USE indices
    160        USE pegrid
     158       USE arrays_3d,                                                          &
     159           ONLY:  tend, u, ug, v, vg, w
     160           
     161       USE control_parameters,                                                 &
     162           ONLY:  f, fs, message_string
     163           
     164       USE indices,                                                            &
     165           ONLY:  i_left, i_right, j_north, j_south, nzb_u_inner,              &
     166                  nzb_v_inner, nzb_w_inner, nzt
     167                   
     168       USE kinds
    161169
    162170       IMPLICIT NONE
    163171
    164        INTEGER ::  component, i, j, k
     172       INTEGER(iwp) ::  component  !:
     173       INTEGER(iwp) ::  i          !:
     174       INTEGER(iwp) ::  j          !:
     175       INTEGER(iwp) ::  k          !:
    165176
    166177
    … …  
    215226                   DO  k = 1, nzt
    216227                      IF  ( k > nzb_w_inner(j,i) )  THEN
    217                          tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
    218                                       ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
     228                         tend(k,j,i) = tend(k,j,i) + fs * 0.25 *               &
     229                                      ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +   &
    219230                                        u(k+1,j,i+1) )
    220231                      ENDIF
    … …  
    239250    SUBROUTINE coriolis_ij( i, j, component )
    240251
    241        USE arrays_3d
    242        USE control_parameters
    243        USE indices
    244        USE pegrid
    245 
     252       USE arrays_3d,                                                          &
     253           ONLY:  tend, u, ug, v, vg, w
     254           
     255       USE control_parameters,                                                 &
     256           ONLY:  f, fs, message_string
     257           
     258       USE indices,                                                            &
     259           ONLY:  nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
     260           
     261       USE kinds
     262       
    246263       IMPLICIT NONE
    247264
    248        INTEGER ::  component, i, j, k
     265       INTEGER(iwp) ::  component  !:
     266       INTEGER(iwp) ::  i          !:
     267       INTEGER(iwp) ::  j          !:
     268       INTEGER(iwp) ::  k          !:
    249269
    250270!
    … …  
    256276          CASE ( 1 )
    257277             DO  k = nzb_u_inner(j,i)+1, nzt
    258                 tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *               &
    259                                 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
    260                                   v(k,j+1,i) ) - vg(k) )                   &
    261                                           - fs *    ( 0.25 *               &
    262                                 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
    263                                   w(k,j,i)   ) &
    264                                                     )
     278                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *                   &
     279                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
     280                                  v(k,j+1,i) ) - vg(k) )                       &
     281                                          - fs *    ( 0.25 *                   &
     282                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
     283                                  w(k,j,i)   ) )
    265284             ENDDO
    266285
    … …  
    269288          CASE ( 2 )
    270289             DO  k = nzb_v_inner(j,i)+1, nzt
    271                 tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *             &
    272                                 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
     290                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *                   &
     291                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
    273292                                  u(k,j,i+1) ) - ug(k) )
    274293             ENDDO
    … …  
    278297          CASE ( 3 )
    279298             DO  k = nzb_w_inner(j,i)+1, nzt
    280                 tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
    281                                 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
     299                tend(k,j,i) = tend(k,j,i) + fs * 0.25 *                        &
     300                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
    282301                                  u(k+1,j,i+1) )
    283302             ENDDO

  • palm/trunk/SOURCE/cpulog.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! 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:
    … …  
    3238! 1036 2012-10-22 13:43:42Z raasch
    3339! code put under GPL (PALM 3.9)
    34 !
    35 ! 274 2009-03-26 15:11:21Z heinze
    36 ! Output of messages replaced by message handling routine.
    37 ! Type of count and count_rate changed to default INTEGER on NEC machines
    38 !
    39 ! 225 2009-01-26 14:44:20Z raasch
    40 ! Type of count and count_rate changed to INTEGER(8)
    41 !
    42 ! 82 2007-04-16 15:40:52Z raasch
    43 ! Preprocessor strings for different linux clusters changed to "lc",
    44 ! preprocessor directives for old systems removed
    45 !
    46 ! RCS Log replace by Id keyword, revision history cleaned up
    47 !
    48 ! Revision 1.24  2006/06/02 15:12:17  raasch
    49 ! cpp-directives extended for lctit
    5040!
    5141! Revision 1.1  1997/07/24 11:12:29  raasch
    … …  
    5848!------------------------------------------------------------------------------!
    5949
    60     USE control_parameters
    61     USE indices,  ONLY: nx, ny, nz
     50    USE control_parameters,                                                    &
     51        ONLY: message_string, nr_timesteps_this_run, run_description_header,   &
     52              synchronous_exchange
     53               
     54    USE indices,                                                               &
     55        ONLY: nx, ny, nz
     56       
     57    USE kinds
     58   
    6259    USE pegrid
    6360
    … …  
    6562
    6663    PRIVATE
    67     PUBLIC   cpu_log, cpu_log_barrierwait, cpu_log_nowait, cpu_statistics, &
     64    PUBLIC   cpu_log, cpu_log_barrierwait, cpu_log_nowait, cpu_statistics,     &
    6865             initial_wallclock_time, log_point, log_point_s
    6966
    … …  
    7673    END INTERFACE cpu_statistics
    7774
    78     INTEGER, PARAMETER ::  cpu_log_continue = 0, cpu_log_pause = 1, &
    79                            cpu_log_start = 2, cpu_log_stop = 3
    80 
    81     LOGICAL            ::  cpu_log_barrierwait = .FALSE.
    82     LOGICAL, PARAMETER ::  cpu_log_nowait = .FALSE.
    83 
    84     REAL ::  initial_wallclock_time
     75    INTEGER(iwp), PARAMETER ::  cpu_log_continue = 0  !:
     76    INTEGER(iwp), PARAMETER ::  cpu_log_pause = 1     !:
     77    INTEGER(iwp), PARAMETER ::  cpu_log_start = 2     !:
     78    INTEGER(iwp), PARAMETER ::  cpu_log_stop = 3      !:
     79
     80    LOGICAL            ::  cpu_log_barrierwait = .FALSE.  !:
     81    LOGICAL, PARAMETER ::  cpu_log_nowait = .FALSE.       !:
     82
     83    REAL(wp) ::  initial_wallclock_time  !:
    8584
    8685    TYPE logpoint
    87        REAL               ::  isum, ivect, mean, mtime, mtimevec, sum, vector
    88        INTEGER            ::  counts
    89        CHARACTER (LEN=20) ::  place
     86       REAL(wp)           ::  isum       !:
     87       REAL(wp)           ::  ivect      !:
     88       REAL(wp)           ::  mean       !:
     89       REAL(wp)           ::  mtime      !:
     90       REAL(wp)           ::  mtimevec   !:
     91       REAL(wp)           ::  sum        !:
     92       REAL(wp)           ::  vector     !:
     93       INTEGER(iwp)       ::  counts     !:
     94       CHARACTER (LEN=20) ::  place      !:
    9095    END TYPE logpoint
    9196
    … …  
    103108       IMPLICIT NONE
    104109
    105        CHARACTER (LEN=*)           ::  modus, place
    106        LOGICAL                     ::  wait_allowed
    107        LOGICAL, OPTIONAL           ::  barrierwait
    108        LOGICAL, SAVE               ::  first = .TRUE.
    109        REAL                        ::  mtime = 0.0, mtimevec = 0.0
    110        TYPE(logpoint)              ::  log_event
     110       CHARACTER (LEN=*) ::  modus              !:
     111       CHARACTER (LEN=*) ::  place              !:
     112       
     113       LOGICAL           ::  wait_allowed       !:
     114       LOGICAL, OPTIONAL ::  barrierwait        !:
     115       LOGICAL, SAVE     ::  first = .TRUE.     !:
     116       
     117       REAL(wp)          ::  mtime = 0.0        !:
     118       REAL(wp)          ::   mtimevec = 0.0    !:
     119       TYPE(logpoint)    ::  log_event          !:
    111120
    112121#if defined( __lc ) || defined( __decalpha )
    113        INTEGER(8)                  ::  count, count_rate
     122       INTEGER(idp)     ::  count        !:
     123       INTEGER(idp)     ::  count_rate   !:
    114124#elif defined( __nec )
    115        INTEGER                     ::  count, count_rate
     125       INTEGER(iwp)      ::  count       !:
     126       INTEGER(iwp)      ::  count_rate  !:
    116127#elif defined( __ibm )
    117        INTEGER(8)                  ::  IRTC
     128       INTEGER(idp)     ::  IRTC         !:
    118129#endif
    119130
    … …  
    124135          log_event%place = place
    125136       ELSEIF ( log_event%place /= place )  THEN
    126           WRITE( message_string, * ) 'wrong argument & expected: ', &
     137          WRITE( message_string, * ) 'wrong argument & expected: ',            &
    127138                            TRIM(log_event%place), '  given: ',  TRIM( place )
    128139          CALL message( 'cpu_log', 'PA0174', 1, 2, 0, 6, 0 )
    … …  
    142153!--    PEs that have not yet finished
    143154#if defined( __parallel )
    144        IF ( cpu_log_barrierwait  .AND.  wait_allowed  .AND.  &
     155       IF ( cpu_log_barrierwait  .AND.  wait_allowed  .AND.                    &
    145156            ( modus == 'start'  .OR.  modus == 'continue' ) )  THEN
    146157          CALL MPI_BARRIER( comm2d, ierr )
    … …  
    167178       ELSEIF ( modus == 'pause' )  THEN
    168179          IF ( ( mtime - log_event%mtime ) < 0.0  .AND.  first )  THEN
    169              WRITE( message_string, * ) 'negative time interval occured',         &
    170                          ' &PE',myid,' L=PAUSE "',TRIM(log_event%place),'" new=', &
    171                          mtime,' last=',log_event%mtime
     180             WRITE( message_string, * ) 'negative time interval occured',      &
     181                         ' &PE',myid,' L=PAUSE "',TRIM(log_event%place),      &
     182                         '" new=', mtime,' last=',log_event%mtime
    172183             CALL message( 'cpu_log', 'PA0176', 0, 1, -1, 6, 0 )
    173184             first = .FALSE.
    … …  
    176187          log_event%ivect    = log_event%ivect  + mtimevec - log_event%mtimevec
    177188       ELSEIF ( modus == 'stop' )  THEN
    178           IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0  .AND. &
     189          IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0  .AND.       &
    179190               first )  THEN
    180              WRITE( message_string, * ) 'negative time interval occured',        &
     191             WRITE( message_string, * ) 'negative time interval occured',      &
    181192                         ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', &
    182193                         mtime,' last=',log_event%mtime,' isum=',log_event%isum
    … …  
    188199          log_event%sum      = log_event%sum  + log_event%mtime
    189200          IF ( log_event%sum < 0.0  .AND.  first )  THEN
    190              WRITE( message_string, * ) 'negative time interval occured',        &
     201             WRITE( message_string, * ) 'negative time interval occured',      &
    191202                         ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', &
    192203                                         log_event%sum,' mtime=',log_event%mtime
    … …  
    218229       IMPLICIT NONE
    219230
    220        INTEGER    ::  i, ii(1), iii, sender
    221        REAL       ::  average_cputime
    222        REAL, SAVE ::  norm = 1.0
    223        REAL, DIMENSION(:),   ALLOCATABLE ::  pe_max, pe_min, pe_rms, sum
    224        REAL, DIMENSION(:,:), ALLOCATABLE ::  pe_log_points
     231       INTEGER(iwp)    ::  i               !:
     232       INTEGER(iwp)    ::  ii(1)           !:
     233       INTEGER(iwp)    ::  iii             !:
     234       INTEGER(iwp)    ::  sender          !:
     235       REAL(wp)       ::  average_cputime  !:
     236       REAL(wp), SAVE ::  norm = 1.0       !:
     237       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  pe_max        !:
     238       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  pe_min        !:
     239       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  pe_rms        !:
     240       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  sum           !:
     241       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pe_log_points !:
    225242
    226243
    … …  
    240257!
    241258!--       Allocate and initialize temporary arrays needed for statistics
    242           ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ), &
    243                     pe_rms( SIZE( log_point ) ),                              &
     259          ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ),  &
     260                    pe_rms( SIZE( log_point ) ),                               &
    244261                    pe_log_points( SIZE( log_point ), 0:numprocs-1 ) )
    245262          pe_min = log_point%sum
    … …  
    251268!--       Receive data from all PEs
    252269          DO  i = 1, numprocs-1
    253              CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
     270             CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL,            &
    254271                            i, i, comm2d, status, ierr )
    255272             sender = status(MPI_SOURCE)
    … …  
    270287!--          Calculate rms
    271288             DO  i = 0, numprocs-1
    272                 pe_rms(iii) = pe_rms(iii) + ( &
    273                                     pe_log_points(iii,i) - log_point(iii)%sum &
     289                pe_rms(iii) = pe_rms(iii) + (                                  &
     290                                    pe_log_points(iii,i) - log_point(iii)%sum  &
    274291                                            )**2
    275292             ENDDO

  • palm/trunk/SOURCE/cuda_fft_interfaces.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:
    … …  
    5056#if defined ( __cuda_fft )
    5157
    52     INTEGER :: CUFFT_FORWARD = -1,  &
    53                CUFFT_INVERSE =  1,  &
    54                CUFFT_R2C = Z'2a',   &    ! Real to Complex (interleaved)
    55                CUFFT_C2R = Z'2c',   &    ! Complex (interleaved) to Real
    56                CUFFT_C2C = Z'29',   &    ! Complex to Complex, interleaved
    57                CUFFT_D2Z = Z'6a',   &    ! Double to Double-Complex
    58                CUFFT_Z2D = Z'6c',   &    ! Double-Complex to Double
    59                CUFFT_Z2Z = Z'69'         ! Double-Complex to Double-Complex
     58    INTEGER(iwp) ::  CUFFT_FORWARD = -1   !:
     59    INTEGER(iwp) ::  CUFFT_INVERSE =  1   !:
     60    INTEGER(iwp) ::  CUFFT_R2C = Z'2a'    !: Real to Complex (interleaved)
     61    INTEGER(iwp) ::  CUFFT_C2R = Z'2c'    !: Complex (interleaved) to Real
     62    INTEGER(iwp) ::  CUFFT_C2C = Z'29'    !: Complex to Complex, interleaved
     63    INTEGER(iwp) ::  CUFFT_D2Z = Z'6a'    !: Double to Double-Complex
     64    INTEGER(iwp) ::  CUFFT_Z2D = Z'6c'    !: Double-Complex to Double
     65    INTEGER(iwp) ::  CUFFT_Z2Z = Z'69'    !: Double-Complex to Double-Complex
    6066
    6167    PUBLIC
    … …  
    7076          USE ISO_C_BINDING
    7177
    72           INTEGER(C_INT) ::  plan
    73           INTEGER(C_INT), value ::  batch, nx, type
    74 
     78          INTEGER(C_INT)        ::  plan   !:
     79          INTEGER(C_INT), value ::  batch  !:
     80          INTEGER(C_INT), value ::  nx     !:
     81          INTEGER(C_INT), value ::  type   !:
    7582       END SUBROUTINE CUFFTPLAN1D
    7683
    … …  
    97104
    98105          USE ISO_C_BINDING
    99           USE precision_kind
     106          USE kinds
    100107
    101           INTEGER(C_INT), VALUE ::  plan
    102           COMPLEX(dpk), DEVICE  ::  idata(:,:,:)
    103           REAL(dpk), DEVICE     ::  odata(:,:,:)
     108          INTEGER(C_INT), VALUE ::  plan          !:
     109          COMPLEX(dp), DEVICE   ::  idata(:,:,:)  !:
     110          REAL(dp), DEVICE      ::  odata(:,:,:)  !:
    104111
    105112       END SUBROUTINE CUFFTEXECZ2D
    … …  
    113120
    114121          USE ISO_C_BINDING
    115           USE precision_kind
     122         
     123          USE kinds
    116124
    117           INTEGER(C_INT), VALUE ::  plan
    118           REAL(dpk), DEVICE     ::  idata(:,:,:)
    119           COMPLEX(dpk), DEVICE  ::  odata(:,:,:)
     125          INTEGER(C_INT), VALUE ::  plan          !:
     126          REAL(dp), DEVICE      ::  idata(:,:,:)  !:
     127          COMPLEX(dp), DEVICE   ::  odata(:,:,:)  !:
    120128
    121129       END SUBROUTINE CUFFTEXECD2Z
    … …  
    131139
    132140       SUBROUTINE CUFFTdummy( dummy )
     141       
     142          USE kinds
    133143
    134           REAL ::  dummy
     144          REAL(wp) ::  dummy  !:
    135145
    136146       END SUBROUTINE CUFFTdummy

  • palm/trunk/SOURCE/data_log.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:
    … …  
    4147#if defined( __logging )
    4248
    43     USE control_parameters
     49    USE control_parameters,                                                    &
     50        ONLY:  log_message, simulated_time
     51       
     52    USE kinds
     53       
    4454    USE pegrid
    4555
    4656    IMPLICIT NONE
    4757
    48     INTEGER ::  i1, i2, j1, j2, k1, k2
     58    INTEGER(iwp) ::  i1  !:
     59    INTEGER(iwp) ::  i2  !:
     60    INTEGER(iwp) ::  j1  !:
     61    INTEGER(iwp) ::  j2  !:
     62    INTEGER(iwp) ::  k1  !:
     63    INTEGER(iwp) ::  k2  !:
    4964
    50     REAL, DIMENSION(i1:i2,j1:j2,k1:k2) ::  array
     65    REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) ::  array  !:
    5166
    5267
    … …  
    8196#if defined( __logging )
    8297
    83     USE control_parameters
     98    USE control_parameters,                                                    &
     99        ONLY:  log_message, simulated_time
     100
     101    USE kinds
     102           
    84103    USE pegrid
    85104
    86105    IMPLICIT NONE
    87106
    88     INTEGER ::  i1, i2, j1, j2
     107    INTEGER(iwp) ::  i1  !:
     108    INTEGER(iwp) ::  i2  !:
     109    INTEGER(iwp) ::  j1  !:
     110    INTEGER(iwp) ::  j2  !:
    89111
    90     REAL, DIMENSION(i1:i2,j1:j2) ::  array
     112    REAL(wp), DIMENSION(i1:i2,j1:j2) ::  array  !:
    91113
    92114
    … …  
    121143#if defined( __logging )
    122144
    123     USE control_parameters
     145    USE control_parameters,                                                    &
     146        ONLY:  log_message, simulated_time
     147
     148    USE kinds
     149           
    124150    USE pegrid
    125151
    126152    IMPLICIT NONE
    127153
    128     INTEGER ::  i1, i2, j1, j2
     154    INTEGER(iwp) ::  i1  !:
     155    INTEGER(iwp) ::  i2  !:
     156    INTEGER(iwp) ::  j1  !:
     157    INTEGER(iwp) ::  j2  !:
    129158
    130     INTEGER, DIMENSION(i1:i2,j1:j2) ::  array
     159    INTEGER(iwp), DIMENSION(i1:i2,j1:j2) ::  array  !:
    131160
    132161

  • palm/trunk/SOURCE/data_output_2d.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! 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:
    … …  
    6571! +z0h
    6672!
    67 ! 790 2011-11-29 03:11:20Z raasch
    68 ! bugfix: calculation of 'pr' must depend on the particle weighting factor
    69 !
    70 ! 771 2011-10-27 10:56:21Z heinze
    71 ! +lpt
    72 !
    73 ! 759 2011-09-15 13:58:31Z raasch
    74 ! Splitting of parallel I/O
    75 !
    76 ! 729 2011-05-26 10:33:34Z heinze
    77 ! Exchange ghost layers for p regardless of used pressure solver (except SOR).
    78 !
    79 ! 691 2011-03-04 08:45:30Z maronga
    80 ! Replaced simulated_time by time_since_reference_point
    81 !
    82 ! 673 2011-01-18 16:19:48Z suehring
    83 ! When using Multigrid or SOR solver an additional CALL exchange_horiz is
    84 ! is needed for pressure output.
    85 !
    86 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    87 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
    88 ! allocation of arrays local_2d and total_2d.
    89 ! Calls of exchange_horiz are modiefied.
    90 !
    91 ! 622 2010-12-10 08:08:13Z raasch
    92 ! optional barriers included in order to speed up collective operations
    93 !
    94 ! 493 2010-03-01 08:30:24Z raasch
    95 ! netCDF4 support (parallel output)
    96 !
    97 ! 367 2009-08-25 08:35:52Z maronga
    98 ! simulated_time in netCDF output replaced by time_since_reference_point.
    99 ! Output of netCDF messages with aid of message handling routine.
    100 ! Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0)
    101 ! Output of messages replaced by message handling routine.
    102 ! Output of user defined 2D (XY) arrays at z=nzb+1 is now possible
    103 ! Bugfix: to_be_resorted => s_av for time-averaged scalars
    104 ! Calculation of shf* and qsws* added.
    105 !
    106 ! 215 2008-11-18 09:54:31Z raasch
    107 ! Bugfix: no output of particle concentration and radius unless particles
    108 ! have been started
    109 !
    110 ! 96 2007-06-04 08:07:41Z raasch
    111 ! Output of density and salinity
    112 !
    113 ! 75 2007-03-22 09:54:05Z raasch
    114 ! Output of precipitation amount/rate and roughness length,
    115 ! 2nd+3rd argument removed from exchange horiz
    116 !
    117 ! RCS Log replace by Id keyword, revision history cleaned up
    118 !
    119 ! Revision 1.5  2006/08/22 13:50:29  raasch
    120 ! xz and yz cross sections now up to nzt+1
    121 !
    122 ! Revision 1.2  2006/02/23 10:19:22  raasch
    123 ! Output of time-averaged data, output of averages along x, y, or z,
    124 ! output of user-defined quantities,
    125 ! section data are copied from local_pf to local_2d before they are output,
    126 ! output of particle concentration and mean radius,
    127 ! Former subroutine plot_2d renamed data_output_2d, pl2d.. renamed do2d..,
    128 ! anz renamed ngp, ebene renamed section, pl2d_.._anz renamed do2d_.._n
    129 !
    13073! Revision 1.1  1997/08/11 06:24:09  raasch
    13174! Initial revision
    … …  
    14083!------------------------------------------------------------------------------!
    14184
    142     USE arrays_3d
     85    USE arrays_3d,                                                             &
     86        ONLY:  dzw, e, nr, p, pt, q, qc, ql, ql_c, ql_v, ql_vp, qr, qsws,      &
     87               rho, sa, shf, tend, ts, u, us, v, vpt, w, z0, z0h, zu, zw
     88       
    14389    USE averaging
    144     USE cloud_parameters
    145     USE control_parameters
    146     USE cpulog
    147     USE grid_variables
    148     USE indices
     90       
     91    USE cloud_parameters,                                                      &
     92        ONLY:  hyrho, l_d_cp, precipitation_amount, precipitation_rate, prr,   &
     93               pt_d_t
     94               
     95    USE control_parameters,                                                    &
     96        ONLY:  cloud_physics, data_output_2d_on_each_pe, data_output_xy,       &
     97               data_output_xz, data_output_yz, do2d,                           &
     98               do2d_xy_last_time, do2d_xy_n, do2d_xy_time_count,               &
     99               do2d_xz_last_time, do2d_xz_n, do2d_xz_time_count,               &
     100               do2d_yz_last_time, do2d_yz_n, do2d_yz_time_count,               &
     101               ibc_uv_b, icloud_scheme, io_blocks, io_group, iso2d_output,     &
     102               message_string, netcdf_data_format, netcdf_output,              &
     103               ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, psolver, section,        &
     104               simulated_time,  simulated_time_chr, time_since_reference_point
     105       
     106    USE cpulog,                                                                &
     107        ONLY:  cpu_log, log_point
     108       
     109    USE grid_variables,                                                        &
     110        ONLY:  dx, dy
     111       
     112    USE indices,                                                               &
     113        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,       &
     114               nz, nzb, nzt
     115               
     116    USE kinds
     117       
    149118    USE netcdf_control
    150     USE particle_attributes
     119
     120    USE particle_attributes,                                                   &
     121        ONLY:  particle_advection_start, particles, prt_count,                 &
     122               prt_start_index
     123   
    151124    USE pegrid
    152125
    153126    IMPLICIT NONE
    154127
    155     CHARACTER (LEN=2)  ::  do2d_mode, mode
    156     CHARACTER (LEN=4)  ::  grid
    157     CHARACTER (LEN=25) ::  section_chr
    158     CHARACTER (LEN=50) ::  rtext
    159     INTEGER ::  av, ngp, file_id, i, if, is, iis, j, k, l, layer_xy, n, ns, &
    160                 psi, s, sender, &
    161                 ind(4)
    162     LOGICAL ::  found, resorted, two_d
    163     REAL    ::  mean_r, s_r3, s_r4
    164     REAL, DIMENSION(:), ALLOCATABLE ::      level_z
    165     REAL, DIMENSION(:,:), ALLOCATABLE ::    local_2d, local_2d_l
    166     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf, local_2d_sections, &
    167                                             local_2d_sections_l
     128    CHARACTER (LEN=2)  ::  do2d_mode    !:
     129    CHARACTER (LEN=2)  ::  mode         !:
     130    CHARACTER (LEN=4)  ::  grid         !:
     131    CHARACTER (LEN=25) ::  section_chr  !:
     132    CHARACTER (LEN=50) ::  rtext        !:
     133   
     134    INTEGER(iwp) ::  av        !:
     135    INTEGER(iwp) ::  ngp       !:
     136    INTEGER(iwp) ::  file_id   !:
     137    INTEGER(iwp) ::  i         !:
     138    INTEGER(iwp) ::  if        !:
     139    INTEGER(iwp) ::  is        !:
     140    INTEGER(iwp) ::  iis       !:
     141    INTEGER(iwp) ::  j         !:
     142    INTEGER(iwp) ::  k         !:
     143    INTEGER(iwp) ::  l         !:
     144    INTEGER(iwp) ::  layer_xy  !:
     145    INTEGER(iwp) ::  n         !:
     146    INTEGER(iwp) ::  ns        !:
     147    INTEGER(iwp) ::  psi       !:
     148    INTEGER(iwp) ::  s         !:
     149    INTEGER(iwp) ::  sender    !:
     150    INTEGER(iwp) ::  ind(4)    !:
     151   
     152    LOGICAL ::  found          !:
     153    LOGICAL ::  resorted       !:
     154    LOGICAL ::  two_d          !:
     155   
     156    REAL(wp) ::  mean_r         !:
     157    REAL(wp) ::  s_r3           !:
     158    REAL(wp) ::  s_r4           !:
     159   
     160    REAL(wp), DIMENSION(:), ALLOCATABLE ::      level_z     !:
     161    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::    local_2d    !:
     162    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::    local_2d_l  !:
     163    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !:
     164    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_2d_sections   !:
     165    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_2d_sections_l !:
    168166#if defined( __parallel )
    169     REAL, DIMENSION(:,:),   ALLOCATABLE ::  total_2d
    170 #endif
    171     REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
     167    REAL(wp), DIMENSION(:,:),   ALLOCATABLE ::  total_2d  !:
     168#endif
     169    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !:
    172170
    173171    NAMELIST /LOCAL/  rtext
    … …  
    184182!-- the given end time by the length of the given output interval.
    185183    IF ( netcdf_data_format > 4 )  THEN
    186        IF ( mode == 'xy'  .AND.  do2d_xy_time_count(av) + 1 > &
     184       IF ( mode == 'xy'  .AND.  do2d_xy_time_count(av) + 1 >                  &
    187185            ntdim_2d_xy(av) )  THEN
    188           WRITE ( message_string, * ) 'Output of xy cross-sections is not ', &
    189                           'given at t=', simulated_time, '&because the', &
     186          WRITE ( message_string, * ) 'Output of xy cross-sections is not ',   &
     187                          'given at t=', simulated_time, '&because the',       &
    190188                          ' maximum number of output time levels is exceeded.'
    191189          CALL message( 'data_output_2d', 'PA0384', 0, 1, 0, 6, 0 )         
    192190          RETURN
    193191       ENDIF
    194        IF ( mode == 'xz'  .AND.  do2d_xz_time_count(av) + 1 > &
     192       IF ( mode == 'xz'  .AND.  do2d_xz_time_count(av) + 1 >                  &
    195193            ntdim_2d_xz(av) )  THEN
    196           WRITE ( message_string, * ) 'Output of xz cross-sections is not ',  &
    197                           'given at t=', simulated_time, '&because the', &
     194          WRITE ( message_string, * ) 'Output of xz cross-sections is not ',   &
     195                          'given at t=', simulated_time, '&because the',       &
    198196                          ' maximum number of output time levels is exceeded.'
    199197          CALL message( 'data_output_2d', 'PA0385', 0, 1, 0, 6, 0 )         
    200198          RETURN
    201199       ENDIF
    202        IF ( mode == 'yz'  .AND.  do2d_yz_time_count(av) + 1 > &
     200       IF ( mode == 'yz'  .AND.  do2d_yz_time_count(av) + 1 >                  &
    203201            ntdim_2d_yz(av) )  THEN
    204           WRITE ( message_string, * ) 'Output of yz cross-sections is not ', &
    205                           'given at t=', simulated_time, '&because the', &
     202          WRITE ( message_string, * ) 'Output of yz cross-sections is not ',   &
     203                          'given at t=', simulated_time, '&because the',       &
    206204                          ' maximum number of output time levels is exceeded.'
    207205          CALL message( 'data_output_2d', 'PA0386', 0, 1, 0, 6, 0 )         
    … …  
    363361                   DO  i = nxlg, nxrg
    364362                      DO  j = nysg, nyng
    365                          local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
     363                         local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) *          &
    366364                                                    dzw(1:nzt+1) )
    367365                      ENDDO
    … …  
    427425                               s_r4 = 0.0
    428426                               DO  n = psi, psi+prt_count(k,j,i)-1
    429                                   s_r3 = s_r3 + particles(n)%radius**3 * &
     427                                  s_r3 = s_r3 + particles(n)%radius**3 *       &
    430428                                                particles(n)%weight_factor
    431                                   s_r4 = s_r4 + particles(n)%radius**4 * &
     429                                  s_r4 = s_r4 + particles(n)%radius**4 *       &
    432430                                                particles(n)%weight_factor
    433431                               ENDDO
    … …  
    499497                      DO  i = nxlg, nxrg
    500498                         DO  j = nysg, nyng
    501                             local_pf(i,j,nzb+1) = prr_av(nzb+1,j,i) * hyrho(nzb+1)
     499                            local_pf(i,j,nzb+1) = prr_av(nzb+1,j,i) *          &
     500                                                  hyrho(nzb+1)
    502501                         ENDDO
    503502                      ENDDO
    … …  
    539538                      DO  j = nysg, nyng
    540539                            DO  k = nzb, nzt+1
    541                                local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
    542                                                              pt_d_t(k) * &
     540                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *          &
     541                                                             pt_d_t(k) *       &
    543542                                                             ql(k,j,i)
    544543                            ENDDO
    … …  
    600599                               psi = prt_start_index(k,j,i)
    601600                               DO  n = psi, psi+prt_count(k,j,i)-1
    602                                   tend(k,j,i) =  tend(k,j,i) + &
    603                                                  particles(n)%weight_factor / &
     601                                  tend(k,j,i) =  tend(k,j,i) +                 &
     602                                                 particles(n)%weight_factor /  &
    604603                                                 prt_count(k,j,i)
    605604                               ENDDO
    … …  
    824823!
    825824!--             User defined quantity
    826                 CALL user_data_output_2d( av, do2d(av,if), found, grid, &
     825                CALL user_data_output_2d( av, do2d(av,if), found, grid,        &
    827826                                          local_pf, two_d )
    828827                resorted = .TRUE.
    … …  
    837836
    838837                IF ( .NOT. found )  THEN
    839                    message_string = 'no output provided for: ' //    &
     838                   message_string = 'no output provided for: ' //              &
    840839                                    TRIM( do2d(av,if) )
    841840                   CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
    … …  
    881880                      do2d_xy_last_time(av)  = simulated_time
    882881                      IF ( myid == 0 )  THEN
    883                          IF ( ( .NOT. data_output_2d_on_each_pe  .AND. &
    884                               netcdf_output )  .OR.  netcdf_data_format > 4 ) &
     882                         IF ( ( .NOT. data_output_2d_on_each_pe  .AND.         &
     883                              netcdf_output )  .OR.  netcdf_data_format > 4 )  &
    885884                         THEN
    886885#if defined( __netcdf )
    … …  
    947946#if defined( __netcdf )
    948947                         IF ( netcdf_output  .AND.  myid == 0 )  THEN
    949                             WRITE ( 21 )  time_since_reference_point, &
     948                            WRITE ( 21 )  time_since_reference_point,          &
    950949                                          do2d_xy_time_count(av), av
    951950                         ENDIF
    … …  
    981980!--                            Index limits are received in arbitrary order from
    982981!--                            the PEs.
    983                                CALL MPI_RECV( ind(1), 4, MPI_INTEGER,    &
    984                                               MPI_ANY_SOURCE, 0, comm2d, &
     982                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,          &
     983                                              MPI_ANY_SOURCE, 0, comm2d,       &
    985984                                              status, ierr )
    986985                               sender = status(MPI_SOURCE)
    987986                               DEALLOCATE( local_2d )
    988987                               ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
    989                                CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp,  &
    990                                               MPI_REAL, sender, 1, comm2d,   &
     988                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp,    &
     989                                              MPI_REAL, sender, 1, comm2d,     &
    991990                                              status, ierr )
    992991                               total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
    … …  
    10261025                            ind(1) = nxlg; ind(2) = nxrg
    10271026                            ind(3) = nysg; ind(4) = nyng
    1028                             CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
     1027                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0,       &
    10291028                                           comm2d, ierr )
    10301029!
    10311030!--                         Send data to PE0
    1032                             CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &
     1031                            CALL MPI_SEND( local_2d(nxlg,nysg), ngp,           &
    10331032                                           MPI_REAL, 0, 1, comm2d, ierr )
    10341033                         ENDIF
    … …  
    10761075                      ENDIF
    10771076                      IF ( av == 0 )  THEN
    1078                          rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
    1079                                  TRIM( simulated_time_chr ) // '  ' // &
     1077                         rtext = TRIM( do2d(av,if) ) // '  t = ' //            &
     1078                                 TRIM( simulated_time_chr ) // '  ' //         &
    10801079                                 TRIM( section_chr )
    10811080                      ELSE
    1082                          rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
    1083                                  TRIM( simulated_time_chr ) // '  ' //       &
     1081                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' //   &
     1082                                 TRIM( simulated_time_chr ) // '  ' //         &
    10841083                                 TRIM( section_chr )
    10851084                      ENDIF
    … …  
    11031102                      do2d_xz_last_time(av)  = simulated_time
    11041103                      IF ( myid == 0 )  THEN
    1105                          IF ( ( .NOT. data_output_2d_on_each_pe  .AND.        &
    1106                               netcdf_output )  .OR.  netcdf_data_format > 4 ) &
     1104                         IF ( ( .NOT. data_output_2d_on_each_pe  .AND.         &
     1105                              netcdf_output )  .OR.  netcdf_data_format > 4 )  &
    11071106                         THEN
    11081107#if defined( __netcdf )
    … …  
    11301129                         DO  j = nys, nyn
    11311130                            DO  i = nxlg, nxrg
    1132                                local_2d_l(i,k) = local_2d_l(i,k) + &
     1131                               local_2d_l(i,k) = local_2d_l(i,k) +             &
    11331132                                                 local_pf(i,j,k)
    11341133                            ENDDO
    … …  
    11391138!--                   Now do the averaging over all PEs along y
    11401139                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    1141                       CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb),              &
    1142                                           local_2d(nxlg,nzb), ngp, MPI_REAL, &
     1140                      CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb),                &
     1141                                          local_2d(nxlg,nzb), ngp, MPI_REAL,   &
    11431142                                          MPI_SUM, comm1dy, ierr )
    11441143#else
    … …  
    11671166!--                   sections reside. Cross sections averaged along y are
    11681167!--                   output on the respective first PE along y (myidy=0).
    1169                       IF ( ( section(is,s) >= nys  .AND.  &
    1170                              section(is,s) <= nyn )  .OR.  &
     1168                      IF ( ( section(is,s) >= nys  .AND.                       &
     1169                             section(is,s) <= nyn )  .OR.                      &
    11711170                           ( section(is,s) == -1  .AND.  myidy == 0 ) )  THEN
    11721171#if defined( __netcdf )
    … …  
    11921191#if defined( __netcdf )
    11931192                         IF ( netcdf_output  .AND.  myid == 0 )  THEN
    1194                             WRITE ( 22 )  time_since_reference_point, &
     1193                            WRITE ( 22 )  time_since_reference_point,          &
    11951194                                          do2d_xz_time_count(av), av
    11961195                         ENDIF
    … …  
    11981197                         DO  i = 0, io_blocks-1
    11991198                            IF ( i == io_group )  THEN
    1200                                IF ( ( section(is,s) >= nys  .AND.   &
    1201                                       section(is,s) <= nyn )  .OR.  &
    1202                                     ( section(is,s) == -1  .AND.    &
    1203                                       nys-1 == -1 ) )               &
     1199                               IF ( ( section(is,s) >= nys  .AND.              &
     1200                                      section(is,s) <= nyn )  .OR.             &
     1201                                    ( section(is,s) == -1  .AND.               &
     1202                                      nys-1 == -1 ) )                          &
    12041203                               THEN
    12051204                                  WRITE (22)  nxlg, nxrg, nzb, nzt+1
    … …  
    12391238!--                            Index limits are received in arbitrary order from
    12401239!--                            the PEs.
    1241                                CALL MPI_RECV( ind(1), 4, MPI_INTEGER,     &
    1242                                               MPI_ANY_SOURCE, 0, comm2d,  &
     1240                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,          &
     1241                                              MPI_ANY_SOURCE, 0, comm2d,       &
    12431242                                              status, ierr )
    12441243!
    … …  
    12471246                                  sender = status(MPI_SOURCE)
    12481247                                  DEALLOCATE( local_2d )
    1249                                   ALLOCATE( local_2d(ind(1):ind(2), &
     1248                                  ALLOCATE( local_2d(ind(1):ind(2),            &
    12501249                                                     ind(3):ind(4)) )
    12511250                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
    12521251                                                 MPI_REAL, sender, 1, comm2d,  &
    12531252                                                 status, ierr )
    1254                                   total_2d(ind(1):ind(2),ind(3):ind(4)) = &
     1253                                  total_2d(ind(1):ind(2),ind(3):ind(4)) =      &
    12551254                                                                        local_2d
    12561255                               ENDIF
    … …  
    12911290                               ind(3) = -9999; ind(4) = -9999
    12921291                            ENDIF
    1293                             CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
     1292                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0,       &
    12941293                                           comm2d, ierr )
    12951294!
    12961295!--                         If applicable, send data to PE0.
    12971296                            IF ( ind(1) /= -9999 )  THEN
    1298                                CALL MPI_SEND( local_2d(nxlg,nzb), ngp, &
     1297                               CALL MPI_SEND( local_2d(nxlg,nzb), ngp,         &
    12991298                                              MPI_REAL, 0, 1, comm2d, ierr )
    13001299                            ENDIF
    … …  
    13351334                      ENDIF
    13361335                      IF ( av == 0 )  THEN
    1337                          rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
    1338                                  TRIM( simulated_time_chr ) // '  ' // &
     1336                         rtext = TRIM( do2d(av,if) ) // '  t = ' //            &
     1337                                 TRIM( simulated_time_chr ) // '  ' //         &
    13391338                                 TRIM( section_chr )
    13401339                      ELSE
    1341                          rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
    1342                                  TRIM( simulated_time_chr ) // '  ' //       &
     1340                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' //   &
     1341                                 TRIM( simulated_time_chr ) // '  ' //         &
    13431342                                 TRIM( section_chr )
    13441343                      ENDIF
    … …  
    13551354                      do2d_yz_last_time(av)  = simulated_time
    13561355                      IF ( myid == 0 )  THEN
    1357                          IF ( ( .NOT. data_output_2d_on_each_pe  .AND.        &
    1358                               netcdf_output )  .OR.  netcdf_data_format > 4 ) &
     1356                         IF ( ( .NOT. data_output_2d_on_each_pe  .AND.         &
     1357                              netcdf_output )  .OR.  netcdf_data_format > 4 )  &
    13591358                         THEN
    13601359#if defined( __netcdf )
    … …  
    13821381                         DO  j = nysg, nyng
    13831382                            DO  i = nxl, nxr
    1384                                local_2d_l(j,k) = local_2d_l(j,k) + &
     1383                               local_2d_l(j,k) = local_2d_l(j,k) +             &
    13851384                                                 local_pf(i,j,k)
    13861385                            ENDDO
    … …  
    13911390!--                   Now do the averaging over all PEs along x
    13921391                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    1393                       CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb),              &
    1394                                           local_2d(nysg,nzb), ngp, MPI_REAL, &
     1392                      CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb),                &
     1393                                          local_2d(nysg,nzb), ngp, MPI_REAL,   &
    13951394                                          MPI_SUM, comm1dx, ierr )
    13961395#else
    … …  
    14191418!--                   sections reside. Cross sections averaged along x are
    14201419!--                   output on the respective first PE along x (myidx=0).
    1421                       IF ( ( section(is,s) >= nxl  .AND.  &
    1422                              section(is,s) <= nxr )  .OR.  &
     1420                      IF ( ( section(is,s) >= nxl  .AND.                       &
     1421                             section(is,s) <= nxr )  .OR.                      &
    14231422                           ( section(is,s) == -1  .AND.  myidx == 0 ) )  THEN
    14241423#if defined( __netcdf )
    … …  
    14441443#if defined( __netcdf )
    14451444                         IF ( netcdf_output  .AND.  myid == 0 )  THEN
    1446                             WRITE ( 23 )  time_since_reference_point, &
     1445                            WRITE ( 23 )  time_since_reference_point,          &
    14471446                                          do2d_yz_time_count(av), av
    14481447                         ENDIF
    … …  
    14501449                         DO  i = 0, io_blocks-1
    14511450                            IF ( i == io_group )  THEN
    1452                                IF ( ( section(is,s) >= nxl  .AND.   &
    1453                                       section(is,s) <= nxr )  .OR.  &
    1454                                     ( section(is,s) == -1  .AND.    &
    1455                                       nxl-1 == -1 ) )               &
     1451                               IF ( ( section(is,s) >= nxl  .AND.              &
     1452                                      section(is,s) <= nxr )  .OR.             &
     1453                                    ( section(is,s) == -1  .AND.               &
     1454                                      nxl-1 == -1 ) )                          &
    14561455                               THEN
    14571456                                  WRITE (23)  nysg, nyng, nzb, nzt+1
    … …  
    14911490!--                            Index limits are received in arbitrary order from
    14921491!--                            the PEs.
    1493                                CALL MPI_RECV( ind(1), 4, MPI_INTEGER,     &
    1494                                               MPI_ANY_SOURCE, 0, comm2d,  &
     1492                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,          &
     1493                                              MPI_ANY_SOURCE, 0, comm2d,       &
    14951494                                              status, ierr )
    14961495!
    … …  
    14991498                                  sender = status(MPI_SOURCE)
    15001499                                  DEALLOCATE( local_2d )
    1501                                   ALLOCATE( local_2d(ind(1):ind(2), &
     1500                                  ALLOCATE( local_2d(ind(1):ind(2),            &
    15021501                                                     ind(3):ind(4)) )
    15031502                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
    15041503                                                 MPI_REAL, sender, 1, comm2d,  &
    15051504                                                 status, ierr )
    1506                                   total_2d(ind(1):ind(2),ind(3):ind(4)) = &
     1505                                  total_2d(ind(1):ind(2),ind(3):ind(4)) =      &
    15071506                                                                        local_2d
    15081507                               ENDIF
    … …  
    15431542                               ind(3) = -9999; ind(4) = -9999
    15441543                            ENDIF
    1545                             CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
     1544                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0,       &
    15461545                                           comm2d, ierr )
    15471546!
    15481547!--                         If applicable, send data to PE0.
    15491548                            IF ( ind(1) /= -9999 )  THEN
    1550                                CALL MPI_SEND( local_2d(nysg,nzb), ngp, &
     1549                               CALL MPI_SEND( local_2d(nysg,nzb), ngp,         &
    15511550                                              MPI_REAL, 0, 1, comm2d, ierr )
    15521551                            ENDIF
    … …  
    15871586                      ENDIF
    15881587                      IF ( av == 0 )  THEN
    1589                          rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
    1590                                  TRIM( simulated_time_chr ) // '  ' // &
     1588                         rtext = TRIM( do2d(av,if) ) // '  t = ' //            &
     1589                                 TRIM( simulated_time_chr ) // '  ' //         &
    15911590                                 TRIM( section_chr )
    15921591                      ELSE
    1593                          rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
    1594                                  TRIM( simulated_time_chr ) // '  ' //       &
     1592                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' //   &
     1593                                 TRIM( simulated_time_chr ) // '  ' //         &
    15951594                                 TRIM( section_chr )
    15961595                      ENDIF

  • palm/trunk/SOURCE/data_output_3d.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! 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:
    … …  
    5965! Bugfix: missing calculation of ql_vp added
    6066!
    61 ! 790 2011-11-29 03:11:20Z raasch
    62 ! bugfix: calculation of 'pr' must depend on the particle weighting factor,
    63 ! nzt+1 replaced by nz_do3d for 'pr'
    64 !
    65 ! 771 2011-10-27 10:56:21Z heinze
    66 ! +lpt
    67 !
    68 ! 759 2011-09-15 13:58:31Z raasch
    69 ! Splitting of parallel I/O
    70 !
    71 ! 727 2011-04-20 20:05:25Z suehring
    72 ! Exchange ghost layers also for p_av.
    73 !
    74 ! 725 2011-04-11 09:37:01Z suehring
    75 ! Exchange ghost layers for p regardless of used pressure solver (except SOR).
    76 !
    77 ! 691 2011-03-04 08:45:30Z maronga
    78 ! Replaced simulated_time by time_since_reference_point
    79 !
    80 ! 673 2011-01-18 16:19:48Z suehring
    81 ! When using Multigrid or SOR solver an additional CALL exchange_horiz is
    82 ! is needed for pressure output.
    83 !
    84 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    85 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
    86 ! allocation of arrays.  Calls of exchange_horiz are modified.
    87 ! Skip-value skip_do_avs changed to a dynamic adaption of ghost points.
    88 !
    89 ! 646 2010-12-15 13:03:52Z raasch
    90 ! bugfix: missing define statements for netcdf added
    91 !
    92 ! 493 2010-03-01 08:30:24Z raasch
    93 ! netCDF4 support (parallel output)
    94 !
    95 ! 355 2009-07-17 01:03:01Z letzel
    96 ! simulated_time in netCDF output replaced by time_since_reference_point.
    97 ! Output of netCDF messages with aid of message handling routine.
    98 ! Output of messages replaced by message handling routine.
    99 ! Bugfix: to_be_resorted => s_av for time-averaged scalars
    100 !
    101 ! 96 2007-06-04 08:07:41Z raasch
    102 ! Output of density and salinity
    103 !
    104 ! 75 2007-03-22 09:54:05Z raasch
    105 ! 2nd+3rd argument removed from exchange horiz
    106 !
    107 ! RCS Log replace by Id keyword, revision history cleaned up
    108 !
    109 ! Revision 1.3  2006/06/02 15:18:59  raasch
    110 ! +argument "found", -argument grid in call of routine user_data_output_3d
    111 !
    112 ! Revision 1.2  2006/02/23 10:23:07  raasch
    113 ! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
    114 ! .._anz renamed .._n,
    115 ! output extended to (almost) all quantities, output of user-defined quantities
    116 !
    11767! Revision 1.1  1997/09/03 06:29:36  raasch
    11868! Initial revision
    … …  
    12474!------------------------------------------------------------------------------!
    12575
    126     USE arrays_3d
     76    USE arrays_3d,                                                             &
     77        ONLY:  e, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho, sa, tend, u, v,   &
     78               vpt, w
     79       
    12780    USE averaging
    128     USE cloud_parameters
    129     USE control_parameters
    130     USE cpulog
    131     USE indices
     81       
     82    USE cloud_parameters,                                                      &
     83        ONLY:  l_d_cp, prr, pt_d_t
     84       
     85    USE control_parameters,                                                    &
     86        ONLY:  avs_data_file,avs_output, cloud_physics, do3d, do3d_avs_n,      &
     87               do3d_compress, do3d_no, do3d_time_count, io_blocks, io_group,   &
     88               message_string, netcdf_output, netcdf_data_format, ntdim_3d,    &
     89               nz_do3d, plot_3d_precision, psolver, simulated_time,            &
     90               simulated_time_chr, skip_do_avs, time_since_reference_point
     91       
     92    USE cpulog,                                                                &
     93        ONLY:  log_point, cpu_log
     94       
     95    USE indices,                                                               &
     96        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzt,  &
     97               nzb
     98       
     99    USE kinds
     100   
    132101    USE netcdf_control
    133     USE particle_attributes
     102       
     103    USE particle_attributes,                                                   &
     104        ONLY:  particles, prt_count, prt_start_index
     105       
    134106    USE pegrid
    135     USE precision_kind
    136107
    137108    IMPLICIT NONE
    138109
    139     CHARACTER (LEN=9) ::  simulated_time_mod
    140 
    141     INTEGER           ::  av, i, if, j, k, n, pos, prec, psi
    142 
    143     LOGICAL           ::  found, resorted
    144 
    145     REAL              ::  mean_r, s_r3, s_r4
    146 
    147     REAL(spk), DIMENSION(:,:,:), ALLOCATABLE  ::  local_pf
    148 
    149     REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
     110    CHARACTER (LEN=9) ::  simulated_time_mod  !:
     111
     112    INTEGER(iwp) ::  av        !:
     113    INTEGER(iwp) ::  i         !:
     114    INTEGER(iwp) ::  if        !:
     115    INTEGER(iwp) ::  j         !:
     116    INTEGER(iwp) ::  k         !:
     117    INTEGER(iwp) ::  n         !:
     118    INTEGER(iwp) ::  pos       !:
     119    INTEGER(iwp) ::  prec      !:
     120    INTEGER(iwp) ::  psi       !:
     121
     122    LOGICAL      ::  found     !:
     123    LOGICAL      ::  resorted  !:
     124
     125    REAL(wp)     ::  mean_r    !:
     126    REAL(wp)     ::  s_r3      !:
     127    REAL(wp)     ::  s_r4      !:
     128
     129    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf  !:
     130
     131    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !:
    150132
    151133!
    … …  
    202184    IF ( myid == 0 )  THEN
    203185       IF ( netcdf_output )  THEN
    204           nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
    205                                   (/ time_since_reference_point /),  &
    206                                   start = (/ do3d_time_count(av) /), &
     186          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av),           &
     187                                  (/ time_since_reference_point /),            &
     188                                  start = (/ do3d_time_count(av) /),           &
    207189                                  count = (/ 1 /) )
    208190          CALL handle_netcdf_error( 'data_output_3d', 376 )
    … …  
    288270                         s_r4 = 0.0
    289271                         DO  n = psi, psi+prt_count(k,j,i)-1
    290                          s_r3 = s_r3 + particles(n)%radius**3 * &
     272                         s_r3 = s_r3 + particles(n)%radius**3 *                &
    291273                                       particles(n)%weight_factor
    292                          s_r4 = s_r4 + particles(n)%radius**4 * &
     274                         s_r4 = s_r4 + particles(n)%radius**4 *                &
    293275                                       particles(n)%weight_factor
    294276                         ENDDO
    … …  
    346328                      DO  j = nysg, nyng
    347329                         DO  k = nzb, nz_do3d
    348                             local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
    349                                                           pt_d_t(k) * &
     330                            local_pf(i,j,k) = pt(k,j,i) + l_d_cp *             &
     331                                                          pt_d_t(k) *          &
    350332                                                          ql(k,j,i)
    351333                         ENDDO
    … …  
    400382                         psi = prt_start_index(k,j,i)
    401383                         DO  n = psi, psi+prt_count(k,j,i)-1
    402                             tend(k,j,i) = tend(k,j,i) + &
    403                                           particles(n)%weight_factor / &
     384                            tend(k,j,i) = tend(k,j,i) +                        &
     385                                          particles(n)%weight_factor /         &
    404386                                          prt_count(k,j,i)
    405387                         ENDDO
    … …  
    494476!
    495477!--          User defined quantity
    496              CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
     478             CALL user_data_output_3d( av, do3d(av,if), found, local_pf,       &
    497479                                       nz_do3d )
    498480             resorted = .TRUE.
    499481
    500482             IF ( .NOT. found )  THEN
    501                 message_string =  'no output available for: ' //   &
     483                message_string =  'no output available for: ' //               &
    502484                                  TRIM( do3d(av,if) )
    503485                CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
    … …  
    532514
    533515          IF ( av == 0 )  THEN
    534              WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ), &
    535                                  skip_do_avs, TRIM( do3d(av,if) ), &
     516             WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ),            &
     517                                 skip_do_avs, TRIM( do3d(av,if) ),             &
    536518                                 TRIM( simulated_time_mod )
    537519          ELSE
    538              WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ), &
    539                                  skip_do_avs, TRIM( do3d(av,if) ) // &
     520             WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ),            &
     521                                 skip_do_avs, TRIM( do3d(av,if) ) //           &
    540522                                 ' averaged', TRIM( simulated_time_mod )
    541523          ENDIF
    … …  
    543525!--       Determine the Skip-value for the next array. Record end and start
    544526!--       require 4 byte each.
    545           skip_do_avs = skip_do_avs + ( ( ( nx+2*nbgp ) * ( ny+2*nbgp ) * &
     527          skip_do_avs = skip_do_avs + ( ( ( nx+2*nbgp ) * ( ny+2*nbgp ) *      &
    546528                                          ( nz_do3d+1 ) ) * 4 + 8 )
    547529       ENDIF
    … …  
    553535!--       Compression, output of compression information on FLD-file and output
    554536!--       of compressed data.
    555           CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
     537          CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys,   &
    556538                                 nzb, nz_do3d, prec, nbgp )
    557539       ELSE
    … …  
    586568!--             boundaries of the total domain.
    587569                IF ( nxr == nx  .AND.  nyn /= ny )  THEN
    588                    nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    589                                      local_pf(nxl:nxr+1,nys:nyn,nzb:nz_do3d), &
    590                       start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
     570                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
     571                                     local_pf(nxl:nxr+1,nys:nyn,nzb:nz_do3d),  &
     572                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /),  &
    591573                      count = (/ nxr-nxl+2, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
    592574                ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
    593                    nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    594                                      local_pf(nxl:nxr,nys:nyn+1,nzb:nz_do3d), &
    595                       start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
     575                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
     576                                     local_pf(nxl:nxr,nys:nyn+1,nzb:nz_do3d),  &
     577                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /),  &
    596578                      count = (/ nxr-nxl+1, nyn-nys+2, nz_do3d-nzb+1, 1 /) )
    597579                ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
    598                    nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    599                                    local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), &
    600                       start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
     580                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
     581                                   local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d),  &
     582                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /),  &
    601583                      count = (/ nxr-nxl+2, nyn-nys+2, nz_do3d-nzb+1, 1 /) )
    602584                ELSE
    603                    nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
    604                                        local_pf(nxl:nxr,nys:nyn,nzb:nz_do3d), &
    605                       start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
     585                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
     586                                       local_pf(nxl:nxr,nys:nyn,nzb:nz_do3d),  &
     587                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /),  &
    606588                      count = (/ nxr-nxl+1, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
    607589                ENDIF
    … …  
    617599          IF ( netcdf_output )  THEN
    618600
    619              nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),    &
    620                                local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d),  &
    621                                start = (/ 1, 1, 1, do3d_time_count(av) /), &
     601             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),        &
     602                               local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d),      &
     603                               start = (/ 1, 1, 1, do3d_time_count(av) /),     &
    622604                               count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
    623605             CALL handle_netcdf_error( 'data_output_3d', 446 )
    … …  
    641623!
    642624!-- Formats.
    643 3300 FORMAT ('variable ',I4,'  file=',A,'  filetype=unformatted  skip=',I12/ &
     6253300 FORMAT ('variable ',I4,'  file=',A,'  filetype=unformatted  skip=',I12/   &
    644626             'label = ',A,A)
    645627

  • palm/trunk/SOURCE/data_output_dvrp.f90

    r1319 r1320  
     1 MODULE dvrp_color
     2
    13!--------------------------------------------------------------------------------!
    24! This file is part of PALM.
    … …  
    1820! Current revisions:
    1921! -----------------
    20 !
     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
    2129!
    2230! Former revisions:
    … …  
    3240! 828 2012-02-21 12:00:36Z raasch
    3341! particle feature color renamed class
    34 !
    35 ! 287 2009-04-09 08:59:36Z raasch
    36 ! Clipping of dvr-output implemented, using a default colourtable for
    37 ! particles,
    38 ! output of messages replaced by message handling routine.
    39 !
    40 ! 210 2008-11-06 08:54:02Z raasch
    41 ! DVRP arguments changed to single precision, mode pathlines added
    42 !
    43 ! 130 2007-11-13 14:08:40Z letzel
    44 ! allow two instead of one digit to specify isosurface and slicer variables
    45 ! for unknown variables (CASE DEFAULT) call new subroutine
    46 ! user_data_output_dvrp
    47 !
    48 ! 82 2007-04-16 15:40:52Z raasch
    49 ! Preprocessor strings for different linux clusters changed to "lc",
    50 ! routine local_flush is used for buffer flushing
    51 !
    52 ! 75 2007-03-22 09:54:05Z raasch
    53 ! Particles-package is now part of the default code,
    54 ! moisture renamed humidity
    55 !
    56 ! RCS Log replace by Id keyword, revision history cleaned up
    57 !
    58 ! Revision 1.13  2006/02/23 10:25:12  raasch
    59 ! Former routine plot_dvrp renamed data_output_dvrp,
    60 ! Only a fraction of the particles may have a tail,
    61 ! pl.. replaced by do.., %size renamed %dvrp_psize
    6242!
    6343! Revision 1.1  2000/04/27 06:27:17  raasch
    … …  
    7050!------------------------------------------------------------------------------!
    7151
    72  MODULE dvrp_color
    73 
    7452    USE dvrp_variables
     53   
     54    USE kinds
    7555
    7656    IMPLICIT NONE
    … …  
    8060    SUBROUTINE color_dvrp( value, color )
    8161
    82        REAL, INTENT(IN)  ::  value
    83        REAL, INTENT(OUT) ::  color(4)
    84 
    85        REAL              ::  scale
    86 
    87        scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) / &
    88                ( slicer_range_limits_dvrp(2,islice_dvrp) -           &
     62       REAL(wp), INTENT(IN)  ::  value    !:
     63       REAL(wp), INTENT(OUT) ::  color(4) !:
     64
     65       REAL(wp)              ::  scale    !:
     66
     67       scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) /           &
     68               ( slicer_range_limits_dvrp(2,islice_dvrp) -                     &
    8969                 slicer_range_limits_dvrp(1,islice_dvrp) )
    9070
    9171       scale = MODULO( 180.0 + 180.0 * scale, 360.0 )
    9272
    93        color = (/ scale, 0.5, 1.0, 0.0 /)
     73       color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /)
    9474
    9575    END SUBROUTINE color_dvrp
    … …  
    10282#if defined( __dvrp_graphics )
    10383
    104     USE arrays_3d
    105     USE cloud_parameters
    106     USE constants
    107     USE control_parameters
    108     USE cpulog
     84    USE arrays_3d,                                                             &
     85        ONLY:  p, pt, q, ql, ts, u, us, v, w, zu
     86       
     87    USE cloud_parameters,                                                      &
     88        ONLY:  l_d_cp, pt_d_t
     89       
     90    USE constants,                                                             &
     91        ONLY:  pi
     92       
     93    USE control_parameters,                                                    &
     94        ONLY:  cloud_droplets, cloud_physics, do2d, do3d, humidity, ibc_uv_b,  &
     95               message_string, nz_do3d, passive_scalar, simulated_time,        &
     96               threshold
     97       
     98    USE cpulog,                                                                &
     99        ONLY:  log_point, log_point_s, cpu_log
     100       
    109101    USE DVRP
     102   
    110103    USE dvrp_color
     104       
    111105    USE dvrp_variables
    112     USE grid_variables
    113     USE indices
    114     USE particle_attributes
     106       
     107    USE grid_variables,                                                        &
     108        ONLY:  dx, dy
     109       
     110    USE indices,                                                               &
     111        ONLY:  nxl, nxr, nyn, nys, nzb
     112       
     113    USE kinds
     114   
     115    USE particle_attributes,                                                   &
     116        ONLY:  maximum_number_of_tailpoints, number_of_particles,              &
     117               number_of_tails, particle_advection, particle_advection_start,  &
     118               particle_tail_coordinates, particles, uniform_particles,        &
     119               use_particle_tails
     120       
    115121    USE pegrid
    116122
    117123    IMPLICIT NONE
    118124
    119     CHARACTER (LEN=2) ::  section_chr
    120     CHARACTER (LEN=6) ::  output_variable
    121     INTEGER ::  c_mode, c_size_x, c_size_y, c_size_z, dvrp_nop, dvrp_not,     &
    122                 gradient_normals, i, ip, j, jp, k, l, m, n, n_isosurface,     &
    123                 n_slicer, nn, section_mode, vn
    124     INTEGER, DIMENSION(:), ALLOCATABLE ::  p_c, p_t
    125 
    126     LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask
    127 
    128     REAL(4) ::  slicer_position, tmp_alpha, tmp_alpha_w, tmp_b, tmp_c_alpha, &
    129                 tmp_g, tmp_norm, tmp_pos, tmp_r, tmp_t, tmp_th
    130     REAL(4), DIMENSION(:),     ALLOCATABLE   ::  psize, p_x, p_y, p_z
    131     REAL(4), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf
    132     REAL(4), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi
     125    CHARACTER (LEN=2) ::  section_chr      !:
     126    CHARACTER (LEN=6) ::  output_variable  !:
     127   
     128    INTEGER(iwp) ::  c_mode           !: 
     129    INTEGER(iwp) ::  c_size_x         !:
     130    INTEGER(iwp) ::  c_size_y         !:
     131    INTEGER(iwp) ::  c_size_z         !:
     132    INTEGER(iwp) ::  dvrp_nop         !:
     133    INTEGER(iwp) ::  dvrp_not         !:
     134    INTEGER(iwp) ::  gradient_normals !:
     135    INTEGER(iwp) ::  i                !:
     136    INTEGER(iwp) ::  ip               !:
     137    INTEGER(iwp) ::  j                !:
     138    INTEGER(iwp) ::  jp               !:
     139    INTEGER(iwp) ::  k                !:
     140    INTEGER(iwp) ::  l                !:
     141    INTEGER(iwp) ::  m                !:
     142    INTEGER(iwp) ::  n                !:
     143    INTEGER(iwp) ::  n_isosurface     !:
     144    INTEGER(iwp) ::  n_slicer         !:
     145    INTEGER(iwp) ::  nn               !:
     146    INTEGER(iwp) ::  section_mode     !:
     147    INTEGER(iwp) ::  vn               !:
     148    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_c  !:
     149    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_t  !:
     150
     151    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask  !:
     152
     153    REAL(sp) ::  slicer_position  !:
     154    REAL(sp) ::  tmp_alpha        !:
     155    REAL(sp) ::  tmp_alpha_w      !:
     156    REAL(sp) ::  tmp_b            !:
     157    REAL(sp) ::  tmp_c_alpha      !:
     158    REAL(sp) ::  tmp_g            !:
     159    REAL(sp) ::  tmp_norm         !:
     160    REAL(sp) ::  tmp_pos          !:
     161    REAL(sp) ::  tmp_r            !:
     162    REAL(sp) ::  tmp_t            !:
     163    REAL(sp) ::  tmp_th           !:
     164    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  psize  !:
     165    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_x    !:
     166    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_y    !:
     167    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_z    !:
     168    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf  !:
     169    REAL(sp), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi !:
    133170
    134171

  • palm/trunk/SOURCE/data_output_mask.f90

    r1319 r1320  
    4242! Bugfix: calculation of pr must depend on the particle weighting factor,
    4343! missing calculation of ql_vp added
    44 !
    45 ! 771 2011-10-27 10:56:21Z heinze
    46 ! +lpt
    47 !
    48 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    49 ! Calls of exchange_horiz are modified.
    50 !
    51 ! 564 2010-09-30 13:18:59Z helmke
    52 ! start number of mask output files changed to 201, netcdf message identifiers
    53 ! of masked output changed, palm message identifiers of masked output changed
    54 !
    55 ! 493 2010-03-01 08:30:24Z raasch
    56 ! netcdf_format_mask* and format_parallel_io replaced by netcdf_data_format
    57 !
    58 ! 475 2010-02-04 02:26:16Z raasch
    59 ! Bugfix in serial branch: arguments from array local_pf removed in N90_PUT_VAR
    6044!
    6145! 410 2009-12-04 17:05:40Z letzel
    … …  
    6852
    6953#if defined( __netcdf )
    70     USE arrays_3d
    71     USE averaging
    72     USE cloud_parameters
    73     USE control_parameters
    74     USE cpulog
    75     USE grid_variables
    76     USE indices
     54    USE arrays_3d,                                                             &
     55        ONLY:  e, p, pt, q, ql, ql_c, ql_v, rho, sa, tend, u, v, vpt, w
     56   
     57    USE averaging,                                                             &
     58        ONLY:  e_av, lpt_av, p_av, pc_av, pr_av, pt_av, q_av, ql_av, ql_c_av,  &
     59               ql_v_av, ql_vp_av, qv_av, rho_av, s_av, sa_av, u_av, v_av,      &
     60               vpt_av, w_av
     61   
     62    USE cloud_parameters,                                                      &
     63        ONLY:  l_d_cp, pt_d_t
     64   
     65    USE control_parameters,                                                    &
     66        ONLY:  cloud_physics, domask, domask_no, domask_time_count, mask_i,    &
     67               mask_j, mask_k, mask_size, mask_size_l, mask_start_l,           &
     68               max_masks, message_string, mid, netcdf_data_format,             &
     69               netcdf_output, nz_do3d, simulated_time
     70   
     71    USE cpulog,                                                                &
     72        ONLY:  cpu_log, log_point
     73   
     74    USE indices,                                                               &
     75        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
     76       
     77    USE kinds
     78   
    7779    USE netcdf
     80   
    7881    USE netcdf_control
    79     USE particle_attributes
     82   
     83    USE particle_attributes,                                                   &
     84        ONLY:  particles, prt_count, prt_start_index
     85   
    8086    USE pegrid
    8187
    8288    IMPLICIT NONE
    8389
    84     INTEGER ::  av, ngp, i, if, j, k, n, psi, sender, &
    85                 ind(6)
    86     LOGICAL ::  found, resorted
    87     REAL    ::  mean_r, s_r3, s_r4
    88     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
     90    INTEGER(iwp) ::  av       !:
     91    INTEGER(iwp) ::  ngp      !:
     92    INTEGER(iwp) ::  i        !:
     93    INTEGER(iwp) ::  if       !:
     94    INTEGER(iwp) ::  j        !:
     95    INTEGER(iwp) ::  k        !:
     96    INTEGER(iwp) ::  n        !:
     97    INTEGER(iwp) ::  psi      !:
     98    INTEGER(iwp) ::  sender   !:
     99    INTEGER(iwp) ::  ind(6)   !:
     100   
     101    LOGICAL ::  found         !:
     102    LOGICAL ::  resorted      !:
     103   
     104    REAL(wp) ::  mean_r       !:
     105    REAL(wp) ::  s_r3         !:
     106    REAL(wp) ::  s_r4         !:
     107   
     108    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !:
    89109#if defined( __parallel )
    90     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  total_pf
    91 #endif
    92     REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
     110    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  total_pf    !:
     111#endif
     112    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !:
    93113
    94114!

  • palm/trunk/SOURCE/data_output_profiles.f90

    r1319 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! kind-parameters added to all INTEGER 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:
    … …  
    4247! 964 2012-07-26 09:14:24Z raasch
    4348! code for profil-output removed
    44 !
    45 ! 345 2009-07-01 14:37:56Z heinze
    46 ! In case of restart runs without extension, initial profiles are not written
    47 ! to NetCDF-file anymore.
    48 ! simulated_time in NetCDF output replaced by time_since_reference_point.
    49 ! Output of NetCDF messages with aid of message handling routine.
    50 ! Output of messages replaced by message handling routine.
    51 !
    52 ! 197 2008-09-16 15:29:03Z raasch
    53 ! Time coordinate t=0 stored on netcdf-file only if an output is required for
    54 ! this time for at least one of the profiles
    55 !
    56 ! February 2007
    57 ! RCS Log replace by Id keyword, revision history cleaned up
    58 !
    59 ! 87 2007-05-22 15:46:47Z raasch
    60 ! var_hom renamed pr_palm
    61 !
    62 ! Revision 1.18  2006/08/16 14:27:04  raasch
    63 ! PRINT* statements for testing removed
    6449!
    6550! Revision 1.1  1997/09/12 06:28:48  raasch
    … …  
    7257!------------------------------------------------------------------------------!
    7358
    74     USE control_parameters
    75     USE cpulog
    76     USE indices
     59    USE control_parameters,                                                    &
     60        ONLY:  average_count_pr, averaging_interval_pr, coupling_start_time,   &
     61               dopr_n, dopr_time_count, netcdf_output, normalizing_region,     &
     62               time_since_reference_point
     63
     64    USE cpulog,                                                                &
     65        ONLY:  cpu_log, log_point
     66
     67    USE indices,                                                               &
     68        ONLY:  nzb, nzt
     69
     70    USE kinds
     71
    7772    USE netcdf_control
     73
    7874    USE pegrid
     75
    7976    USE profil_parameter
    80     USE statistics
     77
     78    USE statistics,                                                            &
     79        ONLY:  flow_statistics_called, hom, hom_sum, pr_palm, statistic_regions
    8180
    8281    IMPLICIT NONE
    8382
    8483
    85     INTEGER ::  i, sr
     84    INTEGER(iwp) ::  i  !:
     85    INTEGER(iwp) ::  sr !:
    8686
    8787!

  • palm/trunk/SOURCE/data_output_ptseries.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:
    … …  
    3641! mean/minimum/maximum particle radius added as output quantity,
    3742! particle attributes speed_x|y|z_sgs renamed rvar1|2|3
    38 !
    39 ! 622 2010-12-10 08:08:13Z raasch
    40 ! optional barriers included in order to speed up collective operations
    41 !
    42 ! 291 2009-04-16 12:07:26Z raasch
    43 ! simulated_time in NetCDF output replaced by time_since_reference_point.
    44 ! Output of NetCDF messages with aid of message handling routine.
    45 !
    46 ! 60 2007-03-11 11:50:04Z raasch
    47 ! Particles-package is now part of the default code.
    48 !
    49 ! RCS Log replace by Id keyword, revision history cleaned up
    50 !
    51 ! Revision 1.2  2006/08/22 13:51:13  raasch
    52 ! Seperate output for particle groups
    5343!
    5444! Revision 1.1  2006/08/04 14:24:18  raasch
    … …  
    6151!------------------------------------------------------------------------------!
    6252
    63     USE cloud_parameters
    64     USE control_parameters
    65     USE cpulog
    66     USE indices
     53    USE cloud_parameters,                                                      &
     54        ONLY:  curvature_solution_effects
     55
     56    USE control_parameters,                                                    &
     57        ONLY:  dopts_time_count, netcdf_output, time_since_reference_point
     58
     59    USE cpulog,                                                                &
     60        ONLY:  cpu_log, log_point
     61
     62    USE indices,                                                               &
     63        ONLY:
     64
     65    USE kinds
     66
    6767    USE netcdf_control
    68     USE particle_attributes
     68
     69    USE particle_attributes,                                                   &
     70        ONLY:  number_of_particles, number_of_particle_groups, particles
     71
    6972    USE pegrid
    7073
    … …  
    7275
    7376
    74     INTEGER ::  i, inum, j, n
    75 
    76     REAL, DIMENSION(:,:), ALLOCATABLE ::  pts_value, pts_value_l
     77    INTEGER(iwp) ::  i    !:
     78    INTEGER(iwp) ::  inum !:
     79    INTEGER(iwp) ::  j    !:
     80    INTEGER(iwp) ::  n    !:
     81
     82    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pts_value   !:
     83    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pts_value_l !:
    7784
    7885

  • palm/trunk/SOURCE/data_output_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:
    … …  
    3439! 964 2012-07-26 09:14:24Z raasch
    3540! code for profil-output removed
    36 !
    37 ! 291 2009-04-16 12:07:26Z raasch
    38 ! simulated_time in NetCDF output replaced by time_since_reference_point.
    39 ! Output of NetCDF messages with aid of message handling routine.
    40 ! Output of messages replaced by message handling routine.
    41 !
    42 ! 189 2008-08-13 17:09:26Z letzel
    43 ! allow 100 spectra levels instead of 10 for consistency with
    44 ! define_netcdf_header, +user-defined spectra
    45 !
    46 ! February 2007
    47 ! RCS Log replace by Id keyword, revision history cleaned up
    48 !
    49 ! Revision 1.7  2006/04/11 14:56:38  raasch
    50 ! pl_spectra renamed data_output_sp
    5141!
    5242! Revision 1.1  2001/01/05 15:14:20  raasch
    … …  
    6151#if defined( __spectra )
    6252
    63     USE arrays_3d
    64     USE control_parameters
    65     USE cpulog
     53    USE control_parameters,                                                    &
     54        ONLY:  average_count_sp, averaging_interval_sp, dosp_time_count
     55
     56    USE cpulog,                                                                &
     57        ONLY:  cpu_log, log_point
     58
     59    USE kinds
     60
    6661    USE netcdf_control
     62
    6763    USE pegrid
    68     USE spectrum
    69     USE statistics
     64
     65    USE spectrum,                                                              &
     66        ONLY:  data_output_sp
     67
     68    USE statistics,                                                            &
     69        ONLY:  spectrum_x, spectrum_y
    7070
    7171
    7272    IMPLICIT NONE
    7373
    74     INTEGER :: m, pr, cranz_x, cranz_y
    75     LOGICAL :: frame_x, frame_y
     74    INTEGER(iwp) ::  cranz_x !:
     75    INTEGER(iwp) ::  cranz_y !:
     76    INTEGER(iwp) ::  m       !:
     77    INTEGER(iwp) ::  pr      !:
     78   
     79    LOGICAL      ::  frame_x !:
     80    LOGICAL      ::  frame_y !:
    7681
    7782    CALL cpu_log( log_point(31), 'data_output_spectra', 'start' )
    … …  
    183188#if defined( __netcdf )
    184189
    185     USE constants
    186     USE control_parameters
    187     USE grid_variables
    188     USE indices
     190    USE constants,                                                             &
     191        ONLY:  pi
     192
     193    USE control_parameters,                                                    &
     194        ONLY:  dosp_time_count
     195
     196    USE grid_variables,                                                        &
     197        ONLY:  dx, dy
     198
     199    USE indices,                                                               &
     200        ONLY:  nx, ny
     201
     202    USE kinds
     203
    189204    USE netcdf_control
    190     USE spectrum
    191     USE statistics
     205
     206    USE spectrum,                                                              &
     207        ONLY:  n_sp_x, n_sp_y
     208
     209    USE statistics,                                                            &
     210        ONLY:  spectrum_x, spectrum_y
    192211
    193212    IMPLICIT NONE
    194213
    195     CHARACTER (LEN=1), INTENT(IN) ::  direction
    196 
    197     INTEGER, INTENT(IN) ::  nsp
    198 
    199     INTEGER ::  i, k
    200 
    201     REAL ::  frequency
    202 
    203     REAL, DIMENSION(nx/2) ::  netcdf_data_x
    204     REAL, DIMENSION(ny/2) ::  netcdf_data_y
     214    CHARACTER (LEN=1), INTENT(IN) ::  direction     !:
     215
     216    INTEGER(iwp), INTENT(IN)      ::  nsp           !:
     217
     218    INTEGER(iwp)                  ::  i             !:
     219    INTEGER(iwp)                  ::  k             !:
     220
     221    REAL(wp)                      ::  frequency     !:
     222
     223    REAL(wp), DIMENSION(nx/2)     ::  netcdf_data_x !:
     224    REAL(wp), DIMENSION(ny/2)     ::  netcdf_data_y !:
    205225
    206226
    … …  
    248268 SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
    249269
    250     USE arrays_3d
    251     USE constants
    252     USE control_parameters
    253     USE grid_variables
    254     USE indices
     270    USE constants,                                                             &
     271        ONLY:  pi
     272
     273    USE control_parameters,                                                    &
     274        ONLY:  averaging_interval_sp
     275
     276    USE grid_variables,                                                        &
     277        ONLY:  dx
     278
     279    USE indices,                                                               &
     280        ONLY:  nx
     281
     282    USE kinds
     283
    255284    USE pegrid
    256     USE singleton
    257     USE spectrum
    258     USE statistics
    259     USE transpose_indices
     285
     286    USE spectrum,                                                              &
     287        ONLY:  comp_spectra_level, n_sp_x, plot_spectra_level
    260288
    261289    IMPLICIT NONE
    262290
    263     CHARACTER (LEN=30) ::  atext
    264     INTEGER            ::  i, j, k, m, pr
    265     LOGICAL            ::  frame_written
    266     REAL               ::  frequency = 0.0
    267 
     291    CHARACTER (LEN=30) ::  atext !:
     292   
     293    INTEGER(iwp)       ::  i     !:
     294    INTEGER(iwp)       ::  j     !:
     295    INTEGER(iwp)       ::  k     !:
     296    INTEGER(iwp)       ::  m     !:
     297    INTEGER(iwp)       ::  pr    !:
     298   
     299    LOGICAL            ::  frame_written   !:
     300   
     301    REAL(wp)           ::  frequency = 0.0 !:
    268302!
    269303!-- Variables needed for PROFIL-namelist
    270     INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
    271                                 timodex = 1
    272     INTEGER, DIMENSION(1:100):: cucol = 1, klist = 999999, lstyle = 0
    273     LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
    274                                 lclose = .TRUE., rand = .TRUE., &
    275                                 swap = .TRUE., twoxa = .TRUE.,  &
    276                                 xlog = .TRUE., ylog = .TRUE.
    277     CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
    278     REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
    279                                 uymin, uymax
    280     REAL, DIMENSION(1:100)   :: lwid = 0.6
    281     REAL, DIMENSION(100)     :: uyma, uymi
     304    CHARACTER (LEN=80) ::  rtext                !:
     305    CHARACTER (LEN=80) ::  utext                !:
     306    CHARACTER (LEN=80) ::  xtext = 'k in m>->1' !:
     307    CHARACTER (LEN=80) ::  ytext                !:
     308
     309    INTEGER(iwp)       ::  cranz       !:
     310    INTEGER(iwp)       ::  labforx = 3 !:
     311    INTEGER(iwp)       ::  labfory = 3 !:
     312    INTEGER(iwp)       ::  legpos  = 3 !:
     313    INTEGER(iwp)       ::  timodex = 1 !:
     314   
     315    INTEGER(iwp), DIMENSION(1:100) ::  cucol  = 1      !:
     316    INTEGER(iwp), DIMENSION(1:100) ::  klist  = 999999 !:
     317    INTEGER(iwp), DIMENSION(1:100) ::  lstyle = 0      !:
     318   
     319    LOGICAL ::  datleg = .TRUE. !:
     320    LOGICAL ::  grid = .TRUE.   !:
     321    LOGICAL ::  lclose = .TRUE. !:
     322    LOGICAL ::  rand = .TRUE.   !:
     323    LOGICAL ::  swap = .TRUE.   !:
     324    LOGICAL ::  twoxa = .TRUE.  !:
     325    LOGICAL ::  xlog = .TRUE.   !:
     326    LOGICAL ::  ylog = .TRUE.   !:
     327   
     328    REAL(wp) ::  gwid = 0.1    !:
     329    REAL(wp) ::  rlegfak = 0.7 !:
     330    REAL(wp) ::  uxmin         !:
     331    REAL(wp) ::  uxmax         !:
     332    REAL(wp) ::  uymin         !:
     333    REAL(wp) ::  uymax         !:
     334     
     335    REAL(wp), DIMENSION(1:100) ::  lwid = 0.6 !:
     336    REAL(wp), DIMENSION(100)   ::  uyma       !:
     337    REAL(wp), DIMENSION(100)   ::  uymi       !:
    282338
    283339    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
    … …  
    407463 SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
    408464
    409     USE arrays_3d
    410     USE constants
    411     USE control_parameters
    412     USE grid_variables
    413     USE indices
     465    USE constants,                                                             &
     466        ONLY:  pi
     467
     468    USE control_parameters,                                                    &
     469        ONLY:  averaging_interval_sp
     470
     471    USE grid_variables,                                                        &
     472        ONLY:  dy
     473
     474    USE indices,                                                               &
     475        ONLY:  ny
     476
     477    USE kinds
     478
    414479    USE pegrid
    415     USE singleton
    416     USE spectrum
    417     USE statistics
    418     USE transpose_indices
     480
     481    USE spectrum  comp_spectra_level, plot_spectra_level
    419482
    420483    IMPLICIT NONE
    421484
    422     CHARACTER (LEN=30) ::  atext
    423     INTEGER            :: i, j, k, m, pr
    424     LOGICAL            :: frame_written
    425     REAL               :: frequency = 0.0
     485   
     486    CHARACTER (LEN=30) ::  atext !:
     487   
     488    INTEGER(iwp)       ::  i     !:
     489    INTEGER(iwp)       ::  j     !:
     490    INTEGER(iwp)       ::  k     !:
     491    INTEGER(iwp)       ::  m     !:
     492    INTEGER(iwp)       ::  pr    !:
     493   
     494    LOGICAL            :: frame_written   !:
     495   
     496    REAL(wp)           :: frequency = 0.0 !:
    426497
    427498!
    428499!-- Variables needed for PROFIL-namelist
    429     INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
    430                                 timodex = 1
    431     INTEGER, DIMENSION(1:100):: cucol = 1, klist = 999999, lstyle = 0
    432     LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
    433                                 lclose = .TRUE., rand = .TRUE., &
    434                                 swap = .TRUE., twoxa = .TRUE.,  &
    435                                 xlog = .TRUE., ylog = .TRUE.
    436     CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
    437     REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
    438                                 uymin, uymax
    439     REAL, DIMENSION(1:100)   :: lwid = 0.6
    440     REAL, DIMENSION(100)     :: uyma, uymi
     500    CHARACTER (LEN=80) ::  rtext                !:
     501    CHARACTER (LEN=80) ::  utext                !:
     502    CHARACTER (LEN=80) ::  xtext = 'k in m>->1' !:
     503    CHARACTER (LEN=80) ::  ytext                !:
     504
     505    INTEGER(iwp) ::  cranz       !:
     506    INTEGER(iwp) ::  labforx = 3 !:
     507    INTEGER(iwp) ::  labfory = 3 !:
     508    INTEGER(iwp) ::  legpos  = 3 !:
     509    INTEGER(iwp) ::  timodex = 1 !:
     510   
     511    INTEGER(iwp), DIMENSION(1:100) ::  cucol  = 1      !:
     512    INTEGER(iwp), DIMENSION(1:100) ::  klist  = 999999 !:
     513    INTEGER(iwp), DIMENSION(1:100) ::  lstyle = 0      !:
     514   
     515    LOGICAL ::  datleg = .TRUE. !:
     516    LOGICAL ::  grid = .TRUE.   !:
     517    LOGICAL ::  lclose = .TRUE. !:
     518    LOGICAL ::  rand = .TRUE.   !:
     519    LOGICAL ::  swap = .TRUE.   !:
     520    LOGICAL ::  twoxa = .TRUE.  !:
     521    LOGICAL ::  xlog = .TRUE.   !:
     522    LOGICAL ::  ylog = .TRUE.   !:
     523   
     524    REAL(wp) ::  gwid = 0.1     !:
     525    REAL(wp) ::  rlegfak = 0.7  !:
     526    REAL(wp) ::  uxmin          !:
     527    REAL(wp) ::  uxmax          !:
     528    REAL(wp) ::  uymin          !:
     529    REAL(wp) ::  uymax          !:
     530   
     531    REAL(wp), DIMENSION(1:100) ::  lwid = 0.6 !:
     532   
     533    REAL(wp), DIMENSION(100)   ::  uyma       !:
     534    REAL(wp), DIMENSION(100)   ::  uymi       !:
    441535
    442536    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap

  • palm/trunk/SOURCE/data_output_tseries.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:
    … …  
    3641! code put under GPL (PALM 3.9)
    3742!
    38 ! 291 2009-04-16 12:07:26Z raasch
    39 ! simulated_time in NetCDF output replaced by time_since_reference_point.
    40 ! Output of NetCDF messages with aid of message handling routine.
    41 !
    42 ! 48 2007-03-06 12:28:36Z raasch
    43 ! Collection of time series quantities moved to routine flow_statistics,
    44 ! output for "profil" removed
    45 !
    46 ! RCS Log replace by Id keyword, revision history cleaned up
    47 !
    48 ! Revision 1.13  2006/03/14 12:42:51  raasch
    49 ! Error removed: NetCDF output only if switched on
    50 !
    5143! Revision 1.1  1998/03/03 08:00:13  raasch
    5244! Initial revision
    … …  
    5951!------------------------------------------------------------------------------!
    6052
    61     USE control_parameters
    62     USE cpulog
    63     USE indices
     53    USE control_parameters,                                                    &
     54        ONLY:  dots_time_count, netcdf_output, time_since_reference_point
     55
     56    USE cpulog,                                                                &
     57        ONLY:  cpu_log, log_point 
     58
     59    USE kinds
     60
    6461    USE netcdf_control
     62
    6563    USE pegrid
     64
    6665    USE profil_parameter
    67     USE statistics
     66   
     67    USE statistics,                                                            &
     68        ONLY:  flow_statistics_called, statistic_regions, ts_value
    6869
    6970    IMPLICIT NONE
    7071
    7172
    72     INTEGER ::  i, sr
     73    INTEGER(iwp) ::  i  !:
     74    INTEGER(iwp) ::  sr !:
    7375
    7476

  • palm/trunk/SOURCE/diffusion_e.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:
    … …  
    6066! 825 2012-02-19 03:03:44Z raasch
    6167! wang_collision_kernel renamed wang_kernel
    62 !
    63 ! 790 2011-11-29 03:11:20Z raasch
    64 ! diss is also calculated in case that the Wang kernel is used
    65 !
    66 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    67 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    68 !
    69 ! 97 2007-06-21 08:23:15Z raasch
    70 ! Adjustment of mixing length calculation for the ocean version. zw added to
    71 ! argument list.
    72 ! This is also a bugfix, because the height above the topography is now
    73 ! used instead of the height above level k=0.
    74 ! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference
    75 ! use_pt_reference renamed use_reference
    76 !
    77 ! 65 2007-03-13 12:11:43Z raasch
    78 ! Reference temperature pt_reference can be used in buoyancy term
    79 !
    80 ! 20 2007-02-26 00:12:32Z raasch
    81 ! Bugfix: ddzw dimensioned 1:nzt"+1"
    82 ! Calculation extended for gridpoint nzt
    83 !
    84 ! RCS Log replace by Id keyword, revision history cleaned up
    85 !
    86 ! Revision 1.18  2006/08/04 14:29:43  raasch
    87 ! dissipation is stored in extra array diss if needed later on for calculating
    88 ! the sgs particle velocities
    8968!
    9069! Revision 1.1  1997/09/19 07:40:24  raasch
    … …  
    11897    SUBROUTINE diffusion_e( var, var_reference )
    11998
    120        USE arrays_3d
    121        USE control_parameters
    122        USE grid_variables
    123        USE indices
    124        USE particle_attributes
     99       USE arrays_3d,                                                          &
     100           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
     101           
     102       USE control_parameters,                                                 &
     103           ONLY:  atmos_ocean_sign, g, turbulence, use_single_reference_value, &
     104                  wall_adjustment, wall_adjustment_factor
     105                 
     106       USE grid_variables,                                                     &
     107           ONLY:  ddx2, ddy2
     108           
     109       USE indices,                                                            &
     110           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
     111           
     112       USE kinds
     113       
     114       USE particle_attributes,                                                &
     115           ONLY:  use_sgs_for_particles, wang_kernel
    125116
    126117       IMPLICIT NONE
    127118
    128        INTEGER ::  i, j, k
    129        REAL    ::  dvar_dz, l_stable, var_reference
     119       INTEGER(iwp) ::  i              !:
     120       INTEGER(iwp) ::  j              !:
     121       INTEGER(iwp) ::  k              !:
     122       REAL(wp)     ::  dvar_dz        !:
     123       REAL(wp)     ::  l_stable       !:
     124       REAL(wp)     ::  var_reference  !:
    130125
    131126#if defined( __nopointer )
    132        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var
     127       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !:
    133128#else
    134        REAL, DIMENSION(:,:,:), POINTER ::  var
     129       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !:
    135130#endif
    136        REAL, DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation, l, ll
     131       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation  !:
     132       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  l            !:
     133       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  ll           !:
    137134 
    138135
    … …  
    304301    SUBROUTINE diffusion_e_acc( var, var_reference )
    305302
    306        USE arrays_3d
    307        USE control_parameters
    308        USE grid_variables
    309        USE indices
    310        USE particle_attributes
     303       USE arrays_3d,                                                          &
     304           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
     305         
     306       USE control_parameters,                                                 &
     307           ONLY:  atmos_ocean_sign, g, turbulence, use_single_reference_value, &
     308                  wall_adjustment, wall_adjustment_factor
     309               
     310       USE grid_variables,                                                     &
     311           ONLY:  ddx2, ddy2
     312           
     313       USE indices,                                                            &
     314           ONLY:  i_left, i_right, j_north, j_south, nzb_s_inner, nzt
     315           
     316       USE kinds
     317       
     318       USE particle_attributes,                                                &
     319           ONLY:  use_sgs_for_particles, wang_kernel
    311320
    312321       IMPLICIT NONE
    313322
    314        INTEGER ::  i, j, k
    315        REAL    ::  dissipation, dvar_dz, l, ll, l_stable, var_reference
     323       INTEGER(iwp) ::  i              !:
     324       INTEGER(iwp) ::  j              !:
     325       INTEGER(iwp) ::  k              !:
     326       REAL(wp)     ::  dissipation    !:
     327       REAL(wp)     ::  dvar_dz        !:
     328       REAL(wp)     ::  l              !:
     329       REAL(wp)     ::  ll             !:
     330       REAL(wp)     ::  l_stable       !:
     331       REAL(wp)     ::  var_reference  !:
    316332
    317333#if defined( __nopointer )
    318        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var
     334       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !:
    319335#else
    320        REAL, DIMENSION(:,:,:), POINTER ::  var
     336       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !:
    321337#endif
    322338
    … …  
    481497    SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
    482498
    483        USE arrays_3d
    484        USE control_parameters
    485        USE grid_variables
    486        USE indices
    487        USE particle_attributes
     499       USE arrays_3d,                                                          &
     500           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
     501         
     502       USE control_parameters,                                                 &
     503           ONLY:  atmos_ocean_sign, g, turbulence, use_single_reference_value, &
     504                  wall_adjustment, wall_adjustment_factor
     505               
     506       USE grid_variables,                                                     &
     507           ONLY:  ddx2, ddy2
     508           
     509       USE indices,                                                            &
     510           ONLY:  nzb, nzb_s_inner, nzt
     511           
     512       USE kinds
     513       
     514       USE particle_attributes,                                                &
     515           ONLY:  use_sgs_for_particles, wang_kernel
    488516
    489517       IMPLICIT NONE
    490518
    491        INTEGER ::  i, j, k
    492        REAL    ::  dvar_dz, l_stable, var_reference
     519       INTEGER(iwp) ::  i              !:
     520       INTEGER(iwp) ::  j              !:
     521       INTEGER(iwp) ::  k              !:
     522       REAL(wp)     ::  dvar_dz        !:
     523       REAL(wp)     ::  l_stable       !:
     524       REAL(wp)     ::  var_reference  !:
    493525
    494526#if defined( __nopointer )
    495        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var
     527       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !:
    496528#else
    497        REAL, DIMENSION(:,:,:), POINTER ::  var
     529       REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !:
    498530#endif
    499        REAL, DIMENSION(nzb+1:nzt) ::  dissipation, l, ll
     531       REAL(wp), DIMENSION(nzb+1:nzt) ::  dissipation  !:
     532       REAL(wp), DIMENSION(nzb+1:nzt) ::  l            !:
     533       REAL(wp), DIMENSION(nzb+1:nzt) ::  ll           !:
    500534
    501535

  • palm/trunk/SOURCE/diffusion_s.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:
    … …  
    4753! 1001 2012-09-13 14:08:46Z raasch
    4854! some arrays comunicated by module instead of parameter list
    49 !
    50 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    51 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    52 !
    53 ! 183 2008-08-04 15:39:12Z letzel
    54 ! bugfix: calculation of fluxes at vertical surfaces
    55 !
    56 ! 129 2007-10-30 12:12:24Z letzel
    57 ! replace wall_heatflux by wall_s_flux that is now included in the parameter
    58 ! list, bugfix for assignment of fluxes at walls
    59 !
    60 ! 20 2007-02-26 00:12:32Z raasch
    61 ! Bugfix: ddzw dimensioned 1:nzt"+1"
    62 ! Calculation extended for gridpoint nzt, fluxes can be given at top,
    63 ! +s_flux_t in parameter list, s_flux renamed s_flux_b
    64 !
    65 ! RCS Log replace by Id keyword, revision history cleaned up
    66 !
    67 ! Revision 1.8  2006/02/23 10:34:17  raasch
    68 ! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
    69 ! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
    70 ! fluxes at vertically oriented topography
    7155!
    7256! Revision 1.1  2000/04/13 14:54:02  schroeter
    … …  
    9983    SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
    10084
    101        USE arrays_3d
    102        USE control_parameters
    103        USE grid_variables
    104        USE indices
     85       USE arrays_3d,                                                          &
     86           ONLY:  ddzu, ddzw, kh, tend
     87       
     88       USE control_parameters,                                                 &
     89           ONLY: use_surface_fluxes, use_top_fluxes
     90       
     91       USE grid_variables,                                                     &
     92           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     93       
     94       USE indices,                                                            &
     95           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg,                  &
     96                  nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
     97       
     98       USE kinds
    10599
    106100       IMPLICIT NONE
    107101
    108        INTEGER ::  i, j, k
    109        REAL    ::  wall_s_flux(0:4)
    110        REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
     102       INTEGER(iwp) ::  i                 !:
     103       INTEGER(iwp) ::  j                 !:
     104       INTEGER(iwp) ::  k                 !:
     105       REAL(wp)     ::  wall_s_flux(0:4)  !:
     106       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t !:
    111107#if defined( __nopointer )
    112        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
     108       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !:
    113109#else
    114        REAL, DIMENSION(:,:,:), POINTER ::  s
     110       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !:
    115111#endif
    116112
    … …  
    121117             DO  k = nzb_s_outer(j,i)+1, nzt
    122118
    123                 tend(k,j,i) = tend(k,j,i)                                     &
    124                                           + 0.5 * (                           &
    125                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
    126                       - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
    127                                                   ) * ddx2                    &
    128                                           + 0.5 * (                           &
    129                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
    130                       - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
     119                tend(k,j,i) = tend(k,j,i)                                      &
     120                                          + 0.5 * (                            &
     121                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
     122                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
     123                                                  ) * ddx2                     &
     124                                          + 0.5 * (                            &
     125                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
     126                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    131127                                                  ) * ddy2
    132128             ENDDO
    … …  
    138134                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
    139135
    140                    tend(k,j,i) = tend(k,j,i)                                  &
    141                                                 + ( fwxp(j,i) * 0.5 *         &
    142                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
    143                         + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
    144                                                    -fwxm(j,i) * 0.5 *         &
    145                         ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
    146                         + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
    147                                                   ) * ddx2                    &
    148                                                 + ( fwyp(j,i) * 0.5 *         &
    149                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
    150                         + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
    151                                                    -fwym(j,i) * 0.5 *         &
    152                         ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
    153                         + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
     136                   tend(k,j,i) = tend(k,j,i)                                   &
     137                                                + ( fwxp(j,i) * 0.5 *          &
     138                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
     139                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                 &
     140                                                   -fwxm(j,i) * 0.5 *          &
     141                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
     142                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                 &
     143                                                  ) * ddx2                     &
     144                                                + ( fwyp(j,i) * 0.5 *          &
     145                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
     146                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                 &
     147                                                   -fwym(j,i) * 0.5 *          &
     148                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
     149                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                 &
    154150                                                  ) * ddy2
    155151                ENDDO
    … …  
    162158             DO  k = nzb_diff_s_inner(j,i), nzt_diff
    163159
    164                 tend(k,j,i) = tend(k,j,i)                                     &
    165                                        + 0.5 * (                              &
    166             ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
    167           - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
     160                tend(k,j,i) = tend(k,j,i)                                      &
     161                                       + 0.5 * (                               &
     162            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
     163          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
    168164                                               ) * ddzw(k)
    169165             ENDDO
    … …  
    176172                k = nzb_s_inner(j,i)+1
    177173
    178                 tend(k,j,i) = tend(k,j,i)                                     &
    179                                        + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )    &
    180                                                * ( s(k+1,j,i)-s(k,j,i) )      &
    181                                                * ddzu(k+1)                    &
    182                                            + s_flux_b(j,i)                    &
     174                tend(k,j,i) = tend(k,j,i)                                      &
     175                                       + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )     &
     176                                               * ( s(k+1,j,i)-s(k,j,i) )       &
     177                                               * ddzu(k+1)                     &
     178                                           + s_flux_b(j,i)                     &
    183179                                         ) * ddzw(k)
    184180
    … …  
    192188                k = nzt
    193189
    194                 tend(k,j,i) = tend(k,j,i)                                     &
    195                                        + ( - s_flux_t(j,i)                    &
    196                                            - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
    197                                                  * ( s(k,j,i)-s(k-1,j,i) )    &
    198                                                  * ddzu(k)                    &
     190                tend(k,j,i) = tend(k,j,i)                                      &
     191                                       + ( - s_flux_t(j,i)                     &
     192                                           - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )   &
     193                                                 * ( s(k,j,i)-s(k-1,j,i) )     &
     194                                                 * ddzu(k)                     &
    199195                                         ) * ddzw(k)
    200196
    … …  
    212208    SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux )
    213209
    214        USE arrays_3d
    215        USE control_parameters
    216        USE grid_variables
    217        USE indices
     210       USE arrays_3d,                                                          &
     211           ONLY:  ddzu, ddzw, kh, tend
     212           
     213       USE control_parameters,                                                 &
     214           ONLY: use_surface_fluxes, use_top_fluxes
     215       
     216       USE grid_variables,                                                     &
     217           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     218       
     219       USE indices, &
     220           ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,    &
     221                 nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
     222           
     223       USE kinds
    218224
    219225       IMPLICIT NONE
    220226
    221        INTEGER ::  i, j, k
    222        REAL    ::  wall_s_flux(0:4)
    223        REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
     227       INTEGER(iwp) ::  i                 !:
     228       INTEGER(iwp) ::  j                 !:
     229       INTEGER(iwp) ::  k                 !:
     230       REAL(wp)     ::  wall_s_flux(0:4)  !:
     231       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b !:
     232       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t !:
    224233#if defined( __nopointer )
    225        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
     234       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !:
    226235#else
    227        REAL, DIMENSION(:,:,:), POINTER ::  s
     236       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !:
    228237#endif
    229238
    … …  
    239248                IF ( k > nzb_s_outer(j,i) )  THEN
    240249
    241                    tend(k,j,i) = tend(k,j,i)                                  &
    242                                           + 0.5 * (                           &
    243                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
    244                       - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
    245                                                   ) * ddx2                    &
    246                                           + 0.5 * (                           &
    247                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
    248                       - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
     250                   tend(k,j,i) = tend(k,j,i)                                   &
     251                                          + 0.5 * (                            &
     252                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
     253                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
     254                                                  ) * ddx2                     &
     255                                          + 0.5 * (                            &
     256                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
     257                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    249258                                                  ) * ddy2
    250259                ENDIF
    … …  
    257266                     ( wall_w_x(j,i) /= 0.0  .OR.  wall_w_y(j,i) /= 0.0 ) )    &
    258267                THEN
    259                    tend(k,j,i) = tend(k,j,i)                                  &
    260                                                 + ( fwxp(j,i) * 0.5 *         &
    261                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
    262                         + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
    263                                                    -fwxm(j,i) * 0.5 *         &
    264                         ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
    265                         + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
    266                                                   ) * ddx2                    &
    267                                                 + ( fwyp(j,i) * 0.5 *         &
    268                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
    269                         + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
    270                                                    -fwym(j,i) * 0.5 *         &
    271                         ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
    272                         + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
     268                   tend(k,j,i) = tend(k,j,i)                                   &
     269                                                + ( fwxp(j,i) * 0.5 *          &
     270                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
     271                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                 &
     272                                                   -fwxm(j,i) * 0.5 *          &
     273                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
     274                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                 &
     275                                                  ) * ddx2                     &
     276                                                + ( fwyp(j,i) * 0.5 *          &
     277                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
     278                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                 &
     279                                                   -fwym(j,i) * 0.5 *          &
     280                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
     281                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                 &
    273282                                                  ) * ddy2
    274283                ENDIF
    … …  
    281290             DO  k = 1, nzt_diff
    282291                IF ( k >= nzb_diff_s_inner(j,i) )  THEN
    283                    tend(k,j,i) = tend(k,j,i)                                  &
    284                                        + 0.5 * (                              &
    285             ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
    286           - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
     292                   tend(k,j,i) = tend(k,j,i)                                   &
     293                                       + 0.5 * (                               &
     294            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
     295          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
    287296                                               ) * ddzw(k)
    288297                ENDIF
    … …  
    294303             DO  k = 1, nzt
    295304                IF ( use_surface_fluxes  .AND.  k == nzb_s_inner(j,i)+1 )  THEN
    296                    tend(k,j,i) = tend(k,j,i)                                  &
    297                                           + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
    298                                                   * ( s(k+1,j,i)-s(k,j,i) )   &
    299                                                   * ddzu(k+1)                 &
    300                                               + s_flux_b(j,i)                 &
     305                   tend(k,j,i) = tend(k,j,i)                                   &
     306                                          + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )  &
     307                                                  * ( s(k+1,j,i)-s(k,j,i) )    &
     308                                                  * ddzu(k+1)                  &
     309                                              + s_flux_b(j,i)                  &
    301310                                            ) * ddzw(k)
    302311                ENDIF
    … …  
    327336    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
    328337
    329        USE arrays_3d
    330        USE control_parameters
    331        USE grid_variables
    332        USE indices
     338       USE arrays_3d,                                                          &
     339           ONLY:  ddzu, ddzw, kh, tend
     340           
     341       USE control_parameters,                                                 &
     342           ONLY: use_surface_fluxes, use_top_fluxes
     343       
     344       USE grid_variables,                                                     &
     345           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     346       
     347       USE indices,                                                            &
     348           ONLY:  nxlg, nxrg, nyng, nysg, nzb_diff_s_inner, nzb_s_inner,       &
     349                  nzb_s_outer, nzt, nzt_diff
     350       
     351       USE kinds
    333352
    334353       IMPLICIT NONE
    335354
    336        INTEGER ::  i, j, k
    337        REAL    ::  wall_s_flux(0:4)
    338        REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
     355       INTEGER(iwp) ::  i                 !:
     356       INTEGER(iwp) ::  j                 !:
     357       INTEGER(iwp) ::  k                 !:
     358       REAL(wp)     ::  wall_s_flux(0:4)  !:
     359       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b  !:
     360       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t  !:
    339361#if defined( __nopointer )
    340        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
     362       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s !:
    341363#else
    342        REAL, DIMENSION(:,:,:), POINTER ::  s
     364       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !:
    343365#endif
    344366
    … …  
    347369       DO  k = nzb_s_outer(j,i)+1, nzt
    348370
    349           tend(k,j,i) = tend(k,j,i)                                           &
    350                                           + 0.5 * (                           &
    351                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
    352                       - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
    353                                                   ) * ddx2                    &
    354                                           + 0.5 * (                           &
    355                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
    356                       - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
     371          tend(k,j,i) = tend(k,j,i)                                            &
     372                                          + 0.5 * (                            &
     373                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
     374                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
     375                                                  ) * ddx2                     &
     376                                          + 0.5 * (                            &
     377                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
     378                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
    357379                                                  ) * ddy2
    358380       ENDDO
    … …  
    360382!
    361383!--    Apply prescribed horizontal wall heatflux where necessary
    362        IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
     384       IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) )       &
    363385       THEN
    364386          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
    365387
    366              tend(k,j,i) = tend(k,j,i)                                        &
    367                                                 + ( fwxp(j,i) * 0.5 *         &
    368                         ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
    369                         + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
    370                                                    -fwxm(j,i) * 0.5 *         &
    371                         ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
    372                         + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
    373                                                   ) * ddx2                    &
    374                                                 + ( fwyp(j,i) * 0.5 *         &
    375                         ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
    376                         + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
    377                                                    -fwym(j,i) * 0.5 *         &
    378                         ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
    379                         + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
     388             tend(k,j,i) = tend(k,j,i)                                         &
     389                                                + ( fwxp(j,i) * 0.5 *          &
     390                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
     391                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                 &
     392                                                   -fwxm(j,i) * 0.5 *          &
     393                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
     394                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                 &
     395                                                  ) * ddx2                     &
     396                                                + ( fwyp(j,i) * 0.5 *          &
     397                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
     398                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                 &
     399                                                   -fwym(j,i) * 0.5 *          &
     400                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
     401                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                 &
    380402                                                  ) * ddy2
    381403          ENDDO
    … …  
    388410       DO  k = nzb_diff_s_inner(j,i), nzt_diff
    389411
    390           tend(k,j,i) = tend(k,j,i)                                           &
    391                                        + 0.5 * (                              &
    392             ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
    393           - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
     412          tend(k,j,i) = tend(k,j,i)                                            &
     413                                       + 0.5 * (                               &
     414            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
     415          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
    394416                                               ) * ddzw(k)
    395417       ENDDO
    … …  
    401423          k = nzb_s_inner(j,i)+1
    402424
    403           tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )  &
    404                                             * ( s(k+1,j,i)-s(k,j,i) )    &
    405                                             * ddzu(k+1)                  &
    406                                         + s_flux_b(j,i)                  &
     425          tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) )        &
     426                                            * ( s(k+1,j,i)-s(k,j,i) )          &
     427                                            * ddzu(k+1)                        &
     428                                        + s_flux_b(j,i)                        &
    407429                                      ) * ddzw(k)
    408430
    … …  
    415437          k = nzt
    416438
    417           tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                  &
    418                                       - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )  &
    419                                             * ( s(k,j,i)-s(k-1,j,i) )    &
    420                                             * ddzu(k)                    &
     439          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                        &
     440                                      - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )        &
     441                                            * ( s(k,j,i)-s(k-1,j,i) )          &
     442                                            * ddzu(k)                          &
    421443                                      ) * ddzw(k)
    422444

  • palm/trunk/SOURCE/diffusion_u.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:
    … …  
    4652! outflow damping layer removed
    4753! kmym_x/_y and kmyp_x/_y change to kmym and kmyp
    48 !
    49 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    50 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    51 !
    52 ! 366 2009-08-25 08:06:27Z raasch
    53 ! bc_ns replaced by bc_ns_cyc
    54 !
    55 ! 106 2007-08-16 14:30:26Z raasch
    56 ! Momentumflux at top (uswst) included as boundary condition,
    57 ! i loop is starting from nxlu (needed for non-cyclic boundary conditions)
    58 !
    59 ! 75 2007-03-22 09:54:05Z raasch
    60 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,
    61 ! z0 removed from argument list, uxrp eliminated
    62 !
    63 ! 20 2007-02-26 00:12:32Z raasch
    64 ! Bugfix: ddzw dimensioned 1:nzt"+1"
    65 !
    66 ! RCS Log replace by Id keyword, revision history cleaned up
    67 !
    68 ! Revision 1.15  2006/02/23 10:35:35  raasch
    69 ! nzb_2d replaced by nzb_u_outer in horizontal diffusion and by nzb_u_inner
    70 ! or nzb_diff_u, respectively, in vertical diffusion,
    71 ! wall functions added for north and south walls, +z0 in argument list,
    72 ! terms containing w(k-1,..) are removed from the Prandtl-layer equation
    73 ! because they cause errors at the edges of topography
    74 ! WARNING: loops containing the MAX function are still not properly vectorized!
    7554!
    7655! Revision 1.1  1997/09/12 06:23:51  raasch
    … …  
    10786    SUBROUTINE diffusion_u
    10887
    109        USE arrays_3d
    110        USE control_parameters
    111        USE grid_variables
    112        USE indices
     88       USE arrays_3d,                                                          &
     89           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
     90       
     91       USE control_parameters,                                                 &
     92           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
     93                  use_top_fluxes
     94       
     95       USE grid_variables,                                                     &
     96           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
     97       
     98       USE indices,                                                            &
     99           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_diff_u, nzb_u_inner,      &
     100                  nzb_u_outer, nzt, nzt_diff
     101       
     102       USE kinds
    113103
    114104       IMPLICIT NONE
    115105
    116        INTEGER ::  i, j, k
    117        REAL    ::  kmym, kmyp, kmzm, kmzp
    118 
    119        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs
     106       INTEGER(iwp) ::  i     !:
     107       INTEGER(iwp) ::  j     !:
     108       INTEGER(iwp) ::  k     !:
     109       REAL(wp)     ::  kmym  !:
     110       REAL(wp)     ::  kmyp  !:
     111       REAL(wp)     ::  kmzm  !:
     112       REAL(wp)     ::  kmzp  !:
     113
     114       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !:
    120115
    121116!
    … …  
    123118!--    if neccessary
    124119       IF ( topography /= 'flat' )  THEN
    125           CALL wall_fluxes( usvs, 1.0, 0.0, 0.0, 0.0, nzb_u_inner, &
     120          CALL wall_fluxes( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, nzb_u_inner, &
    126121                            nzb_u_outer, wall_u )
    127122       ENDIF
    … …  
    134129!
    135130!--             Interpolate eddy diffusivities on staggered gridpoints
    136                 kmyp = 0.25 * &
     131                kmyp = 0.25 *                                                  &
    137132                       ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
    138                 kmym = 0.25 * &
     133                kmym = 0.25 *                                                  &
    139134                       ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    140135
    141                 tend(k,j,i) = tend(k,j,i)                                    &
    142                       & + 2.0 * (                                            &
    143                       &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )  &
    144                       &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )  &
    145                       &         ) * ddx2                                     &
    146                       & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy       &
    147                       &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx       &
    148                       &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy           &
    149                       &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx           &
     136                tend(k,j,i) = tend(k,j,i)                                      &
     137                      & + 2.0 * (                                              &
     138                      &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
     139                      &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
     140                      &         ) * ddx2                                       &
     141                      & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
     142                      &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
     143                      &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     144                      &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
    150145                      &   ) * ddy
    151146             ENDDO
    … …  
    156151
    157152                DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
    158                    kmyp = 0.25 * &
     153                   kmyp = 0.25 *                                               &
    159154                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
    160                    kmym = 0.25 * &
     155                   kmym = 0.25 *                                               &
    161156                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    162157
    … …  
    185180!
    186181!--             Interpolate eddy diffusivities on staggered gridpoints
    187                 kmzp = 0.25 * &
     182                kmzp = 0.25 *                                                  &
    188183                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    189                 kmzm = 0.25 * &
     184                kmzm = 0.25 *                                                  &
    190185                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    191186
    192                 tend(k,j,i) = tend(k,j,i)                                    &
    193                       & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1) &
    194                       &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx       &
    195                       &            )                                         &
    196                       &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k) &
    197                       &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx     &
    198                       &            )                                          &
     187                tend(k,j,i) = tend(k,j,i)                                      &
     188                      & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
     189                      &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
     190                      &            )                                           &
     191                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     192                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
     193                      &            )                                           &
    199194                      &   ) * ddzw(k)
    200195             ENDDO
    … …  
    206201!--          Difference quotient of the momentum flux is not formed over half
    207202!--          of the grid spacing (2.0*ddzw(k)) any more, since the comparison
    208 !--          with other (LES) modell showed that the values of the momentum
     203!--          with other (LES) models showed that the values of the momentum
    209204!--          flux becomes too large in this case.
    210205!--          The term containing w(k-1,..) (see above equation) is removed here
    … …  
    214209!
    215210!--             Interpolate eddy diffusivities on staggered gridpoints
    216                 kmzp = 0.25 * &
     211                kmzp = 0.25 *                                                  &
    217212                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    218                 kmzm = 0.25 * &
     213                kmzm = 0.25 *                                                  &
    219214                      ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    220215
    221                 tend(k,j,i) = tend(k,j,i)                                    &
    222                       & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx       &
    223                       &   ) * ddzw(k)                                        &
    224                       & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1) &
    225                       &   + usws(j,i)                                        &
     216                tend(k,j,i) = tend(k,j,i)                                      &
     217                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
     218                      &   ) * ddzw(k)                                          &
     219                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
     220                      &   + usws(j,i)                                          &
    226221                      &   ) * ddzw(k)
    227222             ENDIF
    … …  
    234229!
    235230!--             Interpolate eddy diffusivities on staggered gridpoints
    236                 kmzp = 0.25 * &
     231                kmzp = 0.25 *                                                  &
    237232                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    238                 kmzm = 0.25 * &
     233                kmzm = 0.25 *                                                  &
    239234                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    240235
    241                 tend(k,j,i) = tend(k,j,i)                                    &
    242                       & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    243                       &   ) * ddzw(k)                                        &
    244                       & + ( -uswst(j,i)                                      &
    245                       &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     236                tend(k,j,i) = tend(k,j,i)                                      &
     237                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
     238                      &   ) * ddzw(k)                                          &
     239                      & + ( -uswst(j,i)                                        &
     240                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
    246241                      &   ) * ddzw(k)
    247242             ENDIF
    … …  
    258253    SUBROUTINE diffusion_u_acc
    259254
    260        USE arrays_3d
    261        USE control_parameters
    262        USE grid_variables
    263        USE indices
     255       USE arrays_3d,                                                          &
     256           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
     257       
     258       USE control_parameters,                                                 &
     259           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
     260                  use_top_fluxes
     261       
     262       USE grid_variables,                                                     &
     263           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
     264       
     265       USE indices,                                                            &
     266           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
     267                  nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
     268       
     269       USE kinds
    264270
    265271       IMPLICIT NONE
    266272
    267        INTEGER ::  i, j, k
    268        REAL    ::  kmym, kmyp, kmzm, kmzp
    269 
    270        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs
     273       INTEGER(iwp) ::  i     !:
     274       INTEGER(iwp) ::  j     !:
     275       INTEGER(iwp) ::  k     !:
     276       REAL(wp)     ::  kmym  !:
     277       REAL(wp)     ::  kmyp  !:
     278       REAL(wp)     ::  kmzm  !:
     279       REAL(wp)     ::  kmzp  !:
     280
     281       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !:
    271282       !$acc declare create ( usvs )
    272283
    … …  
    275286!--    if neccessary
    276287       IF ( topography /= 'flat' )  THEN
    277           CALL wall_fluxes_acc( usvs, 1.0, 0.0, 0.0, 0.0, nzb_u_inner, &
    278                                 nzb_u_outer, wall_u )
    279        ENDIF
    280 
    281        !$acc kernels present ( u, v, w, km, tend, usws, uswst )   &
    282        !$acc         present ( ddzu, ddzw, fym, fyp, wall_u )           &
     288          CALL wall_fluxes_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,          &
     289                                nzb_u_inner, nzb_u_outer, wall_u )
     290       ENDIF
     291
     292       !$acc kernels present ( u, v, w, km, tend, usws, uswst )                &
     293       !$acc         present ( ddzu, ddzw, fym, fyp, wall_u )                  &
    283294       !$acc         present ( nzb_u_inner, nzb_u_outer, nzb_diff_u )
    284295       DO  i = i_left, i_right
    … …  
    290301!
    291302!--                Interpolate eddy diffusivities on staggered gridpoints
    292                    kmyp = 0.25 * &
     303                   kmyp = 0.25 *                                               &
    293304                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
    294                    kmym = 0.25 * &
     305                   kmym = 0.25 *                                               &
    295306                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    296307
    … …  
    311322!--          Wall functions at the north and south walls, respectively
    312323             DO  k = 1, nzt
    313                 IF( k > nzb_u_inner(j,i)  .AND.  k <= nzb_u_outer(j,i)  .AND. &
     324                IF( k > nzb_u_inner(j,i)  .AND.  k <= nzb_u_outer(j,i)  .AND.  &
    314325                    wall_u(j,i) /= 0.0 )  THEN
    315326
    316                    kmyp = 0.25 * &
     327                   kmyp = 0.25 *                                               &
    317328                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
    318                    kmym = 0.25 * &
     329                   kmym = 0.25 *                                               &
    319330                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    320331
    … …  
    344355!
    345356!--                Interpolate eddy diffusivities on staggered gridpoints
    346                    kmzp = 0.25 * &
     357                   kmzp = 0.25 *                                               &
    347358                          ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    348                    kmzm = 0.25 * &
     359                   kmzm = 0.25 *                                               &
    349360                          ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    350361
    … …  
    369380!--    Difference quotient of the momentum flux is not formed over half
    370381!--    of the grid spacing (2.0*ddzw(k)) any more, since the comparison
    371 !--    with other (LES) modell showed that the values of the momentum
     382!--    with other (LES) models showed that the values of the momentum
    372383!--    flux becomes too large in this case.
    373384!--    The term containing w(k-1,..) (see above equation) is removed here
    … …  
    381392!
    382393!--             Interpolate eddy diffusivities on staggered gridpoints
    383                 kmzp = 0.25 * &
     394                kmzp = 0.25 *                                                  &
    384395                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    385                 kmzm = 0.25 * &
     396                kmzm = 0.25 *                                                  &
    386397                      ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    387398
    388                 tend(k,j,i) = tend(k,j,i)                                    &
    389                       & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx       &
    390                       &   ) * ddzw(k)                                        &
    391                       & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1) &
    392                       &   + usws(j,i)                                        &
     399                tend(k,j,i) = tend(k,j,i)                                      &
     400                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
     401                      &   ) * ddzw(k)                                          &
     402                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
     403                      &   + usws(j,i)                                          &
    393404                      &   ) * ddzw(k)
    394405             ENDDO
    … …  
    409420!
    410421!--             Interpolate eddy diffusivities on staggered gridpoints
    411                 kmzp = 0.25 * &
     422                kmzp = 0.25 *                                                  &
    412423                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    413                 kmzm = 0.25 * &
     424                kmzm = 0.25 *                                                  &
    414425                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    415426
    416                 tend(k,j,i) = tend(k,j,i)                                    &
    417                       & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    418                       &   ) * ddzw(k)                                        &
    419                       & + ( -uswst(j,i)                                      &
    420                       &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     427                tend(k,j,i) = tend(k,j,i)                                      &
     428                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
     429                      &   ) * ddzw(k)                                          &
     430                      & + ( -uswst(j,i)                                        &
     431                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
    421432                      &   ) * ddzw(k)
    422433             ENDDO
    … …  
    434445    SUBROUTINE diffusion_u_ij( i, j )
    435446
    436        USE arrays_3d
    437        USE control_parameters
    438        USE grid_variables
    439        USE indices
     447       USE arrays_3d,                                                          &
     448           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
     449       
     450       USE control_parameters,                                                 &
     451           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
     452       
     453       USE grid_variables,                                                     &
     454           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
     455       
     456       USE indices,                                                            &
     457           ONLY:  nzb, nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
     458       
     459       USE kinds
    440460
    441461       IMPLICIT NONE
    442462
    443        INTEGER ::  i, j, k
    444        REAL    ::  kmym, kmyp, kmzm, kmzp
    445 
    446        REAL, DIMENSION(nzb:nzt+1) ::  usvs
     463       INTEGER(iwp) ::  i     !:
     464       INTEGER(iwp) ::  j     !:
     465       INTEGER(iwp) ::  k     !:
     466       REAL(wp)     ::  kmym  !:
     467       REAL(wp)     ::  kmyp  !:
     468       REAL(wp)     ::  kmzm  !:
     469       REAL(wp)     ::  kmzp  !:
     470
     471       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !:
    447472
    448473!
    … …  
    454479          kmym = 0.25 * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
    455480
    456           tend(k,j,i) = tend(k,j,i)                                          &
    457                       & + 2.0 * (                                            &
    458                       &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )  &
    459                       &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )  &
    460                       &         ) * ddx2                                     &
    461                       & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy       &
    462                       &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx       &
    463                       &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy           &
    464                       &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx           &
     481          tend(k,j,i) = tend(k,j,i)                                            &
     482                      & + 2.0 * (                                              &
     483                      &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
     484                      &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
     485                      &         ) * ddx2                                       &
     486                      & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
     487                      &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
     488                      &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     489                      &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
    465490                      &   ) * ddy
    466491       ENDDO
    … …  
    472497!
    473498!--       Calculate the horizontal momentum flux u'v'
    474           CALL wall_fluxes( i, j, nzb_u_inner(j,i)+1, nzb_u_outer(j,i),  &
    475                             usvs, 1.0, 0.0, 0.0, 0.0 )
     499          CALL wall_fluxes( i, j, nzb_u_inner(j,i)+1, nzb_u_outer(j,i),        &
     500                            usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
    476501
    477502          DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
    … …  
    506531          kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    507532
    508           tend(k,j,i) = tend(k,j,i)                                          &
    509                       & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1) &
    510                       &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx       &
    511                       &            )                                         &
    512                       &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k) &
    513                       &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx     &
    514                       &            )                                         &
     533          tend(k,j,i) = tend(k,j,i)                                            &
     534                      & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
     535                      &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
     536                      &            )                                           &
     537                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     538                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
     539                      &            )                                           &
    515540                      &   ) * ddzw(k)
    516541       ENDDO
    … …  
    522547!--    Difference quotient of the momentum flux is not formed over half of
    523548!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with
    524 !--    other (LES) modell showed that the values of the momentum flux becomes
     549!--    other (LES) models showed that the values of the momentum flux becomes
    525550!--    too large in this case.
    526551!--    The term containing w(k-1,..) (see above equation) is removed here
    … …  
    533558          kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    534559
    535           tend(k,j,i) = tend(k,j,i)                                          &
    536                       & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx       &
    537                       &   ) * ddzw(k)                                        &
    538                       & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1) &
    539                       &   + usws(j,i)                                        &
     560          tend(k,j,i) = tend(k,j,i)                                            &
     561                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
     562                      &   ) * ddzw(k)                                          &
     563                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
     564                      &   + usws(j,i)                                          &
    540565                      &   ) * ddzw(k)
    541566       ENDIF
    … …  
    548573!
    549574!--       Interpolate eddy diffusivities on staggered gridpoints
    550           kmzp = 0.25 * &
     575          kmzp = 0.25 *                                                        &
    551576                 ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
    552           kmzm = 0.25 * &
     577          kmzm = 0.25 *                                                        &
    553578                 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
    554579
    555           tend(k,j,i) = tend(k,j,i)                                          &
    556                       & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
    557                       &   ) * ddzw(k)                                        &
    558                       & + ( -uswst(j,i)                                      &
    559                       &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
     580          tend(k,j,i) = tend(k,j,i)                                            &
     581                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
     582                      &   ) * ddzw(k)                                          &
     583                      & + ( -uswst(j,i)                                        &
     584                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
    560585                      &   ) * ddzw(k)
    561586       ENDIF

  • palm/trunk/SOURCE/diffusion_v.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:
    … …  
    4652! outflow damping layer removed
    4753! kmxm_x/_y and kmxp_x/_y change to kmxm and kmxp
    48 !
    49 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    50 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    51 !
    52 ! 366 2009-08-25 08:06:27Z raasch
    53 ! bc_lr replaced by bc_lr_cyc
    54 !
    55 ! 106 2007-08-16 14:30:26Z raasch
    56 ! Momentumflux at top (vswst) included as boundary condition,
    57 ! j loop is starting from nysv (needed for non-cyclic boundary conditions)
    58 !
    59 ! 75 2007-03-22 09:54:05Z raasch
    60 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,
    61 ! z0 removed from argument list, vynp eliminated
    62 !
    63 ! 20 2007-02-26 00:12:32Z raasch
    64 ! Bugfix: ddzw dimensioned 1:nzt"+1"
    65 !
    66 ! RCS Log replace by Id keyword, revision history cleaned up
    67 !
    68 ! Revision 1.15  2006/02/23 10:36:00  raasch
    69 ! nzb_2d replaced by nzb_v_outer in horizontal diffusion and by nzb_v_inner
    70 ! or nzb_diff_v, respectively, in vertical diffusion,
    71 ! wall functions added for north and south walls, +z0 in argument list,
    72 ! terms containing w(k-1,..) are removed from the Prandtl-layer equation
    73 ! because they cause errors at the edges of topography
    74 ! WARNING: loops containing the MAX function are still not properly vectorized!
    7554!
    7655! Revision 1.1  1997/09/12 06:24:01  raasch
    … …  
    10584    SUBROUTINE diffusion_v
    10685
    107        USE arrays_3d
    108        USE control_parameters
    109        USE grid_variables
    110        USE indices
     86       USE arrays_3d,                                                          &
     87           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
     88       
     89       USE control_parameters,                                                 &
     90           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
     91                  use_top_fluxes
     92       
     93       USE grid_variables,                                                     &
     94           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
     95       
     96       USE indices,                                                            &
     97           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_diff_v, nzb_v_inner,      &
     98                  nzb_v_outer, nzt, nzt_diff
     99       
     100       USE kinds
    111101
    112102       IMPLICIT NONE
    113103
    114        INTEGER ::  i, j, k
    115        REAL    ::  kmxm, kmxp, kmzm, kmzp
    116 
    117        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus
     104       INTEGER(iwp) ::  i     !:
     105       INTEGER(iwp) ::  j     !:
     106       INTEGER(iwp) ::  k     !:
     107       REAL(wp)     ::  kmxm  !:
     108       REAL(wp)     ::  kmxp  !:
     109       REAL(wp)     ::  kmzm  !:
     110       REAL(wp)     ::  kmzp  !:
     111
     112       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !:
    118113
    119114!
    … …  
    121116!--    if neccessary
    122117       IF ( topography /= 'flat' )  THEN
    123           CALL wall_fluxes( vsus, 0.0, 1.0, 0.0, 0.0, nzb_v_inner, &
     118          CALL wall_fluxes( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, nzb_v_inner, &
    124119                            nzb_v_outer, wall_v )
    125120       ENDIF
    … …  
    137132                       ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    138133
    139                 tend(k,j,i) = tend(k,j,i)                                    &
    140                       & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx       &
    141                       &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy       &
    142                       &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx           &
    143                       &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy           &
    144                       &   ) * ddx                                            &
    145                       & + 2.0 * (                                            &
    146                       &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )    &
    147                       &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )    &
     134                tend(k,j,i) = tend(k,j,i)                                      &
     135                      & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
     136                      &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
     137                      &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
     138                      &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     139                      &   ) * ddx                                              &
     140                      & + 2.0 * (                                              &
     141                      &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
     142                      &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
    148143                      &         ) * ddy2
    149144             ENDDO
    … …  
    154149
    155150                DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
    156                    kmxp = 0.25 * &
     151                   kmxp = 0.25 *                                               &
    157152                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    158                    kmxm = 0.25 * &
     153                   kmxm = 0.25 *                                               &
    159154                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    160155                   
    … …  
    188183                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    189184
    190                 tend(k,j,i) = tend(k,j,i)                                    &
    191                       & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)   &
    192                       &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy         &
    193                       &            )                                         &
    194                       &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k) &
    195                       &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy     &
    196                       &            )                                         &
     185                tend(k,j,i) = tend(k,j,i)                                      &
     186                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
     187                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
     188                      &            )                                           &
     189                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
     190                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
     191                      &            )                                           &
    197192                      &   ) * ddzw(k)
    198193             ENDDO
    … …  
    204199!--          Difference quotient of the momentum flux is not formed over
    205200!--          half of the grid spacing (2.0*ddzw(k)) any more, since the
    206 !--          comparison with other (LES) modell showed that the values of
     201!--          comparison with other (LES) models showed that the values of
    207202!--          the momentum flux becomes too large in this case.
    208203!--          The term containing w(k-1,..) (see above equation) is removed here
    … …  
    212207!
    213208!--             Interpolate eddy diffusivities on staggered gridpoints
    214                 kmzp = 0.25 * &
     209                kmzp = 0.25 *                                                  &
    215210                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    216                 kmzm = 0.25 * &
     211                kmzm = 0.25 *                                                  &
    217212                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    218213
    219                 tend(k,j,i) = tend(k,j,i)                                    &
    220                       & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy       &
    221                       &   ) * ddzw(k)                                        &
    222                       & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1) &
    223                       &   + vsws(j,i)                                        &
     214                tend(k,j,i) = tend(k,j,i)                                      &
     215                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
     216                      &   ) * ddzw(k)                                          &
     217                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
     218                      &   + vsws(j,i)                                          &
    224219                      &   ) * ddzw(k)
    225220             ENDIF
    … …  
    232227!
    233228!--             Interpolate eddy diffusivities on staggered gridpoints
    234                 kmzp = 0.25 * &
     229                kmzp = 0.25 *                                                  &
    235230                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    236                 kmzm = 0.25 * &
     231                kmzm = 0.25 *                                                  &
    237232                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    238233
    239                 tend(k,j,i) = tend(k,j,i)                                    &
    240                       & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy      &
    241                       &   ) * ddzw(k)                                        &
    242                       & + ( -vswst(j,i)                                      &
    243                       &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)  &
     234                tend(k,j,i) = tend(k,j,i)                                      &
     235                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
     236                      &   ) * ddzw(k)                                          &
     237                      & + ( -vswst(j,i)                                        &
     238                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
    244239                      &   ) * ddzw(k)
    245240             ENDIF
    … …  
    256251    SUBROUTINE diffusion_v_acc
    257252
    258        USE arrays_3d
    259        USE control_parameters
    260        USE grid_variables
    261        USE indices
     253       USE arrays_3d,                                                          &
     254           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
     255       
     256       USE control_parameters,                                                 &
     257           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
     258                  use_top_fluxes
     259       
     260       USE grid_variables,                                                     &
     261           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
     262       
     263       USE indices,                                                            &
     264           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
     265                  nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
     266       
     267       USE kinds
    262268
    263269       IMPLICIT NONE
    264270
    265        INTEGER ::  i, j, k
    266        REAL    ::  kmxm, kmxp, kmzm, kmzp
    267 
    268        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus
     271       INTEGER(iwp) ::  i     !:
     272       INTEGER(iwp) ::  j     !:
     273       INTEGER(iwp) ::  k     !:
     274       REAL(wp)     ::  kmxm  !:
     275       REAL(wp)     ::  kmxp  !:
     276       REAL(wp)     ::  kmzm  !:
     277       REAL(wp)     ::  kmzp  !:
     278
     279       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !:
    269280       !$acc declare create ( vsus )
    270281
    … …  
    273284!--    if neccessary
    274285       IF ( topography /= 'flat' )  THEN
    275           CALL wall_fluxes_acc( vsus, 0.0, 1.0, 0.0, 0.0, nzb_v_inner, &
    276                                 nzb_v_outer, wall_v )
    277        ENDIF
    278 
    279        !$acc kernels present ( u, v, w, km, tend, vsws, vswst )   &
    280        !$acc         present ( ddzu, ddzw, fxm, fxp, wall_v )           &
     286          CALL wall_fluxes_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp,          &
     287                                nzb_v_inner, nzb_v_outer, wall_v )
     288       ENDIF
     289
     290       !$acc kernels present ( u, v, w, km, tend, vsws, vswst )                &
     291       !$acc         present ( ddzu, ddzw, fxm, fxp, wall_v )                  &
    281292       !$acc         present ( nzb_v_inner, nzb_v_outer, nzb_diff_v )
    282293       DO  i = i_left, i_right
    … …  
    288299!
    289300!--                Interpolate eddy diffusivities on staggered gridpoints
    290                    kmxp = 0.25 * &
     301                   kmxp = 0.25 *                                               &
    291302                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    292                    kmxm = 0.25 * &
     303                   kmxm = 0.25 *                                               &
    293304                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    294305
    … …  
    309320!--          Wall functions at the left and right walls, respectively
    310321             DO  k = 1, nzt
    311                 IF( k > nzb_v_inner(j,i)  .AND.  k <= nzb_v_outer(j,i)  .AND. &
     322                IF( k > nzb_v_inner(j,i)  .AND.  k <= nzb_v_outer(j,i)  .AND.  &
    312323                    wall_v(j,i) /= 0.0 )  THEN
    313324
    314                    kmxp = 0.25 * &
     325                   kmxp = 0.25 *                                               &
    315326                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    316                    kmxm = 0.25 * &
     327                   kmxm = 0.25 *                                               &
    317328                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    318329                   
    … …  
    342353!
    343354!--                Interpolate eddy diffusivities on staggered gridpoints
    344                    kmzp = 0.25 * &
     355                   kmzp = 0.25 *                                               &
    345356                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    346                    kmzm = 0.25 * &
     357                   kmzm = 0.25 *                                               &
    347358                          ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    348359
    … …  
    367378!--    Difference quotient of the momentum flux is not formed over
    368379!--    half of the grid spacing (2.0*ddzw(k)) any more, since the
    369 !--    comparison with other (LES) modell showed that the values of
     380!--    comparison with other (LES) models showed that the values of
    370381!--    the momentum flux becomes too large in this case.
    371382!--    The term containing w(k-1,..) (see above equation) is removed here
    … …  
    379390!
    380391!--             Interpolate eddy diffusivities on staggered gridpoints
    381                 kmzp = 0.25 * &
     392                kmzp = 0.25 *                                                  &
    382393                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    383                 kmzm = 0.25 * &
     394                kmzm = 0.25 *                                                  &
    384395                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    385396
    386                 tend(k,j,i) = tend(k,j,i)                                    &
    387                       & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy       &
    388                       &   ) * ddzw(k)                                        &
    389                       & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1) &
    390                       &   + vsws(j,i)                                        &
     397                tend(k,j,i) = tend(k,j,i)                                      &
     398                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
     399                      &   ) * ddzw(k)                                          &
     400                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
     401                      &   + vsws(j,i)                                          &
    391402                      &   ) * ddzw(k)
    392403             ENDDO
    … …  
    407418!
    408419!--             Interpolate eddy diffusivities on staggered gridpoints
    409                 kmzp = 0.25 * &
     420                kmzp = 0.25 *                                                  &
    410421                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
    411                 kmzm = 0.25 * &
     422                kmzm = 0.25 *                                                  &
    412423                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    413424
    414                 tend(k,j,i) = tend(k,j,i)                                    &
    415                       & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy      &
    416                       &   ) * ddzw(k)                                        &
    417                       & + ( -vswst(j,i)                                      &
    418                       &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)  &
     425                tend(k,j,i) = tend(k,j,i)                                      &
     426                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
     427                      &   ) * ddzw(k)                                          &
     428                      & + ( -vswst(j,i)                                        &
     429                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
    419430                      &   ) * ddzw(k)
    420431             ENDDO
    … …  
    432443    SUBROUTINE diffusion_v_ij( i, j )
    433444
    434        USE arrays_3d
    435        USE control_parameters
    436        USE grid_variables
    437        USE indices
     445       USE arrays_3d,                                                          &
     446           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
     447       
     448       USE control_parameters,                                                 &
     449           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
     450       
     451       USE grid_variables,                                                     &
     452           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
     453       
     454       USE indices,                                                            &
     455           ONLY:  nzb, nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
     456       
     457       USE kinds
    438458
    439459       IMPLICIT NONE
    440460
    441        INTEGER ::  i, j, k
    442        REAL    ::  kmxm, kmxp, kmzm, kmzp
    443 
    444        REAL, DIMENSION(nzb:nzt+1) ::  vsus
     461       INTEGER(iwp) ::  i     !:
     462       INTEGER(iwp) ::  j     !:
     463       INTEGER(iwp) ::  k     !:
     464       REAL(wp)     ::  kmxm  !:
     465       REAL(wp)     ::  kmxp  !:
     466       REAL(wp)     ::  kmzm  !:
     467       REAL(wp)     ::  kmzp  !:
     468
     469       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !:
    445470
    446471!
    … …  
    452477          kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    453478
    454           tend(k,j,i) = tend(k,j,i)                                          &
    455                       & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx       &
    456                       &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy       &
    457                       &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx           &
    458                       &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy           &
    459                       &   ) * ddx                                            &
    460                       & + 2.0 * (                                            &
    461                       &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )    &
    462                       &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )    &
     479          tend(k,j,i) = tend(k,j,i)                                            &
     480                      & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
     481                      &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
     482                      &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
     483                      &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
     484                      &   ) * ddx                                              &
     485                      & + 2.0 * (                                              &
     486                      &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
     487                      &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
    463488                      &         ) * ddy2
    464489       ENDDO
    … …  
    470495!
    471496!--       Calculate the horizontal momentum flux v'u'
    472           CALL wall_fluxes( i, j, nzb_v_inner(j,i)+1, nzb_v_outer(j,i), &
    473                             vsus, 0.0, 1.0, 0.0, 0.0 )
     497          CALL wall_fluxes( i, j, nzb_v_inner(j,i)+1, nzb_v_outer(j,i),        &
     498                            vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
    474499
    475500          DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
    476              kmxp = 0.25 * &
     501             kmxp = 0.25 *                                                     &
    477502                    ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
    478              kmxm = 0.25 * &
     503             kmxm = 0.25 *                                                     &
    479504                    ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
    480505
    … …  
    506531          kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    507532
    508           tend(k,j,i) = tend(k,j,i)                                          &
    509                       & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)   &
    510                       &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy         &
    511                       &            )                                         &
    512                       &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k) &
    513                       &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy     &
    514                       &            )                                         &
     533          tend(k,j,i) = tend(k,j,i)                                            &
     534                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
     535                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
     536                      &            )                                           &
     537                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
     538                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
     539                      &            )                                           &
    515540                      &   ) * ddzw(k)
    516541       ENDDO
    … …  
    522547!--    Difference quotient of the momentum flux is not formed over half of
    523548!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with
    524 !--    other (LES) modell showed that the values of the momentum flux becomes
     549!--    other (LES) models showed that the values of the momentum flux becomes
    525550!--    too large in this case.
    526551!--    The term containing w(k-1,..) (see above equation) is removed here
    … …  
    533558          kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    534559
    535           tend(k,j,i) = tend(k,j,i)                                          &
    536                       & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy       &
    537                       &   ) * ddzw(k)                                        &
    538                       & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1) &
    539                       &   + vsws(j,i)                                        &
     560          tend(k,j,i) = tend(k,j,i)                                            &
     561                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
     562                      &   ) * ddzw(k)                                          &
     563                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
     564                      &   + vsws(j,i)                                          &
    540565                      &   ) * ddzw(k)
    541566       ENDIF
    … …  
    553578                 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
    554579
    555           tend(k,j,i) = tend(k,j,i)                                          &
    556                       & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy      &
    557                       &   ) * ddzw(k)                                        &
    558                       & + ( -vswst(j,i)                                      &
    559                       &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)  &
     580          tend(k,j,i) = tend(k,j,i)                                            &
     581                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
     582                      &   ) * ddzw(k)                                          &
     583                      & + ( -vswst(j,i)                                        &
     584                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
    560585                      &   ) * ddzw(k)
    561586       ENDIF

  • palm/trunk/SOURCE/diffusion_w.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:
    … …  
    4854! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
    4955!
    50 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    51 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    52 !
    53 ! 366 2009-08-25 08:06:27Z raasch
    54 ! bc_lr/bc_ns replaced by bc_lr_cyc/bc_ns_cyc
    55 !
    56 ! 75 2007-03-22 09:54:05Z raasch
    57 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,
    58 ! z0 removed from argument list
    59 !
    60 ! 20 2007-02-26 00:12:32Z raasch
    61 ! Bugfix: ddzw dimensioned 1:nzt"+1"
    62 !
    63 ! RCS Log replace by Id keyword, revision history cleaned up
    64 !
    65 ! Revision 1.12  2006/02/23 10:38:03  raasch
    66 ! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,
    67 ! +z0 in argument list
    68 ! WARNING: loops containing the MAX function are still not properly vectorized!
    69 !
    7056! Revision 1.1  1997/09/12 06:24:11  raasch
    7157! Initial revision
    … …  
    7763!------------------------------------------------------------------------------!
    7864
    79     USE wall_fluxes_mod
     65    USE wall_fluxes_mod,                                                       &
     66        ONLY :  wall_fluxes, wall_fluxes_acc
    8067
    8168    PRIVATE
    … …  
    9986    SUBROUTINE diffusion_w
    10087
    101        USE arrays_3d
    102        USE control_parameters
    103        USE grid_variables
    104        USE indices
     88       USE arrays_3d,                                                          &         
     89           ONLY :  ddzu, ddzw, km, tend, u, v, w
     90           
     91       USE control_parameters,                                                 &
     92           ONLY :  topography
     93           
     94       USE grid_variables,                                                     &     
     95           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     96           
     97       USE indices,                                                            &           
     98           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
     99           
     100       USE kinds
    105101
    106102       IMPLICIT NONE
    107103
    108        INTEGER ::  i, j, k
    109        REAL    ::  kmxm, kmxp, kmym, kmyp
    110 
    111        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus, wsvs
     104       INTEGER(iwp) ::  i     !:
     105       INTEGER(iwp) ::  j     !:
     106       INTEGER(iwp) ::  k     !:
     107       
     108       REAL(wp) ::  kmxm  !:
     109       REAL(wp) ::  kmxp  !:
     110       REAL(wp) ::  kmym  !:
     111       REAL(wp) ::  kmyp  !:
     112
     113       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !:
     114       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !:
    112115
    113116
    … …  
    116119!--    walls, if neccessary
    117120       IF ( topography /= 'flat' )  THEN
    118           CALL wall_fluxes( wsus, 0.0, 0.0, 0.0, 1.0, nzb_w_inner, &
     121          CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner,            &
    119122                            nzb_w_outer, wall_w_x )
    120           CALL wall_fluxes( wsvs, 0.0, 0.0, 1.0, 0.0, nzb_w_inner, &
     123          CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner,            &
    121124                            nzb_w_outer, wall_w_y )
    122125       ENDIF
    … …  
    208211    SUBROUTINE diffusion_w_acc
    209212
    210        USE arrays_3d
    211        USE control_parameters
    212        USE grid_variables
    213        USE indices
     213       USE arrays_3d,                                                          &
     214           ONLY :  ddzu, ddzw, km, tend, u, v, w
     215           
     216       USE control_parameters,                                                 &
     217           ONLY :  topography
     218           
     219       USE grid_variables,                                                     &
     220           ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     221           
     222       USE indices,                                                            &
     223           ONLY :  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, &
     224                   nzb_w_inner, nzb_w_outer, nzt
     225                   
     226       USE kinds
    214227
    215228       IMPLICIT NONE
    216229
    217        INTEGER ::  i, j, k
    218        REAL    ::  kmxm, kmxp, kmym, kmyp
    219 
    220        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus, wsvs
     230       INTEGER(iwp) ::  i     !:
     231       INTEGER(iwp) ::  j     !:
     232       INTEGER(iwp) ::  k     !:
     233       
     234       REAL(wp) ::  kmxm  !:
     235       REAL(wp) ::  kmxp  !:
     236       REAL(wp) ::  kmym  !:
     237       REAL(wp) ::  kmyp  !:
     238
     239       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !:
     240       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !:
    221241       !$acc declare create ( wsus, wsvs )
    222242
    … …  
    225245!--    walls, if neccessary
    226246       IF ( topography /= 'flat' )  THEN
    227           CALL wall_fluxes_acc( wsus, 0.0, 0.0, 0.0, 1.0, nzb_w_inner, &
    228                                 nzb_w_outer, wall_w_x )
    229           CALL wall_fluxes_acc( wsvs, 0.0, 0.0, 1.0, 0.0, nzb_w_inner, &
    230                                 nzb_w_outer, wall_w_y )
     247          CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp,          &
     248                                nzb_w_inner, nzb_w_outer, wall_w_x )
     249          CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp,          &
     250                                nzb_w_inner, nzb_w_outer, wall_w_y )
    231251       ENDIF
    232252
    … …  
    324344    SUBROUTINE diffusion_w_ij( i, j )
    325345
    326        USE arrays_3d
    327        USE control_parameters
    328        USE grid_variables
    329        USE indices
     346       USE arrays_3d,                                                          &         
     347           ONLY :  ddzu, ddzw, km, tend, u, v, w
     348           
     349       USE control_parameters,                                                 &
     350           ONLY :  topography
     351           
     352       USE grid_variables,                                                     &     
     353           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
     354           
     355       USE indices,                                                            &           
     356           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
     357           
     358       USE kinds
    330359
    331360       IMPLICIT NONE
    332361
    333        INTEGER ::  i, j, k
    334        REAL    ::  kmxm, kmxp, kmym, kmyp
    335 
    336        REAL, DIMENSION(nzb:nzt+1) ::  wsus, wsvs
     362       INTEGER(iwp) ::  i     !:
     363       INTEGER(iwp) ::  j     !:
     364       INTEGER(iwp) ::  k     !:
     365       
     366       REAL(wp) ::  kmxm  !:
     367       REAL(wp) ::  kmxp  !:
     368       REAL(wp) ::  kmym  !:
     369       REAL(wp) ::  kmyp  !:
     370
     371       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus
     372       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs
    337373
    338374
    … …  
    369405!--       Calculate the horizontal momentum fluxes w'u' and/or w'v'
    370406          IF ( wall_w_x(j,i) /= 0.0 )  THEN
    371              CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
    372                                wsus, 0.0, 0.0, 0.0, 1.0 )
     407             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
     408                               wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
    373409          ELSE
    374410             wsus = 0.0
    … …  
    376412
    377413          IF ( wall_w_y(j,i) /= 0.0 )  THEN
    378              CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),  &
    379                                wsvs, 0.0, 0.0, 1.0, 0.0 )
     414             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
     415                               wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
    380416          ELSE
    381417             wsvs = 0.0

  • palm/trunk/SOURCE/diffusivities.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:
    … …  
    3642! adjustment of mixing length to the Prandtl mixing length at first grid point
    3743! above ground removed
    38 !
    39 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    40 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    41 !
    42 ! 137 2007-11-28 08:50:10Z letzel
    43 ! Bugfix for summation of sums_l_l for flow_statistics
    44 ! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.
    45 !
    46 ! 97 2007-06-21 08:23:15Z raasch
    47 ! Adjustment of mixing length calculation for the ocean version.
    48 ! This is also a bugfix, because the height above the topography is now
    49 ! used instead of the height above level k=0.
    50 ! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference
    51 ! use_pt_reference renamed use_reference
    52 !
    53 ! 57 2007-03-09 12:05:41Z raasch
    54 ! Reference temperature pt_reference can be used in buoyancy term
    55 !
    56 ! RCS Log replace by Id keyword, revision history cleaned up
    57 !
    58 ! Revision 1.24  2006/04/26 12:16:26  raasch
    59 ! OpenMP optimization (+sums_l_l_t), sqrt_e must be private
    6044!
    6145! Revision 1.1  1997/09/19 07:41:10  raasch
    … …  
    6953!------------------------------------------------------------------------------!
    7054
    71     USE arrays_3d
    72     USE control_parameters
    73     USE grid_variables
    74     USE indices
     55    USE arrays_3d,                                                             &
     56        ONLY:  dd2zu, e, kh, km, l_grid, l_wall
     57       
     58    USE control_parameters,                                                    &
     59        ONLY:  atmos_ocean_sign, e_min, g, outflow_l, outflow_n, outflow_r,    &
     60                outflow_s, use_single_reference_value, wall_adjustment
     61               
     62    USE indices,                                                               &
     63        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb_s_inner, nzb, nzt
     64    USE kinds
     65   
    7566    USE pegrid
    76     USE statistics
     67   
     68    USE statistics,                                                            &
     69        ONLY :  rmask, statistic_regions, sums_l_l
    7770
    7871    IMPLICIT NONE
    7972
    80     INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
    81 
    82     REAL    ::  dvar_dz, l, ll, l_stable, sqrt_e, var_reference
    83 
    84     REAL    ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
     73    INTEGER(iwp) ::  i                   !:
     74    INTEGER(iwp) ::  j                   !:
     75    INTEGER(iwp) ::  k                   !:
     76    INTEGER(iwp) ::  omp_get_thread_num  !:
     77    INTEGER(iwp) ::  sr                  !:
     78    INTEGER(iwp) ::  tn                  !:
     79
     80    REAL(wp)     ::  dvar_dz             !:
     81    REAL(wp)     ::  l                   !:
     82    REAL(wp)     ::  ll                  !:
     83    REAL(wp)     ::  l_stable            !:
     84    REAL(wp)     ::  sqrt_e              !:
     85    REAL(wp)     ::  var_reference       !:
     86
     87    REAL(wp)     ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !:
    8588
    8689
    … …  
    136139                IF ( dvar_dz > 0.0 ) THEN
    137140                   IF ( use_single_reference_value )  THEN
    138                       l_stable = 0.76 * sqrt_e / &
     141                      l_stable = 0.76 * sqrt_e /                               &
    139142                                 SQRT( g / var_reference * dvar_dz ) + 1E-5
    140143                   ELSE
    141                       l_stable = 0.76 * sqrt_e / &
     144                      l_stable = 0.76 * sqrt_e /                               &
    142145                                 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5
    143146                   ENDIF

  • palm/trunk/SOURCE/disturb_field.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! 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:
    … …  
    2632! $Id$
    2733!
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    30 !
    3134! 1036 2012-10-22 13:43:42Z raasch
    3235! code put under GPL (PALM 3.9)
    33 !
    34 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    35 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    36 ! Calls of exchange_horiz are modified.
    37 !
    38 ! 420 2010-01-13 15:10:53Z franke
    39 ! Loop was split to make runs reproducible when using ifort compiler
    40 !
    41 ! 75 2007-03-22 09:54:05Z raasch
    42 ! xrp, ynp eliminated, 2nd+3rd argument removed from exchange horiz
    43 !
    44 ! RCS Log replace by Id keyword, revision history cleaned up
    45 !
    46 ! Revision 1.11  2006/08/04 14:31:59  raasch
    47 ! izuf renamed iran
    4836!
    4937! Revision 1.1  1998/02/04 15:40:45  raasch
    … …  
    6048!------------------------------------------------------------------------------!
    6149
    62     USE control_parameters
    63     USE cpulog
    64     USE grid_variables
    65     USE indices
    66     USE random_function_mod
     50    USE control_parameters,   &
     51        ONLY:  dist_nxl, dist_nxr, dist_nyn, dist_nys, dist_range,             &
     52               disturbance_amplitude, disturbance_created,                     &
     53               disturbance_level_ind_b, disturbance_level_ind_t, iran,         &
     54               random_generator, topography
     55               
     56    USE cpulog,                                                                &
     57        ONLY:  cpu_log, log_point
     58       
     59    USE indices,                                                               &
     60        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     61       
     62    USE kinds
     63   
     64    USE random_function_mod,                                                   &
     65        ONLY: random_function
    6766
    6867    IMPLICIT NONE
    6968
    70     INTEGER ::  i, j, k
    71     INTEGER ::  nzb_uv_inner(nysg:nyng,nxlg:nxrg)
    72 
    73     REAL    ::  randomnumber,                             &
    74                 dist1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
    75                 field(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    76     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  dist2
     69    INTEGER(iwp) ::  i  !:
     70    INTEGER(iwp) ::  j  !:
     71    INTEGER(iwp) ::  k  !:
     72   
     73    INTEGER(iwp) ::  nzb_uv_inner(nysg:nyng,nxlg:nxrg) !:
     74
     75    REAL(wp) ::  randomnumber  !:
     76   
     77    REAL(wp) ::  dist1(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !:
     78    REAL(wp) ::  field(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !:
     79   
     80    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  dist2  !:
    7781
    7882
    … …  
    9296          DO  j = dist_nys(dist_range), dist_nyn(dist_range)
    9397             DO  k = disturbance_level_ind_b, disturbance_level_ind_t
    94                 randomnumber = 3.0 * disturbance_amplitude * &
     98                randomnumber = 3.0 * disturbance_amplitude *                   &
    9599                               ( random_function( iran ) - 0.5 )
    96                 IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  &
    97                      nyn >= j ) &
     100                IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.         &
     101                     nyn >= j )                                                &
    98102                THEN
    99103                   dist1(k,j,i) = randomnumber
    … …  
    107111             DO  k = disturbance_level_ind_b, disturbance_level_ind_t
    108112#if defined( __nec )
    109                 randomnumber = 3.0 * disturbance_amplitude * &
     113                randomnumber = 3.0 * disturbance_amplitude *                   &
    110114                               ( RANDOM( 0 ) - 0.5 )
    111115#else
    112116                CALL RANDOM_NUMBER( randomnumber )
    113                 randomnumber = 3.0 * disturbance_amplitude * &
     117                randomnumber = 3.0 * disturbance_amplitude *                   &
    114118                                ( randomnumber - 0.5 )
    115119#endif
    116                 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) &
     120                IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j )   &
    117121                THEN
    118122                   dist1(k,j,i) = randomnumber
    … …  
    137141        DO  j = nys, nyn
    138142          DO  k = disturbance_level_ind_b-1, disturbance_level_ind_t+1
    139              dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1) &
    140                             + dist1(k,j+1,i) + dist1(k+1,j,i) &
     143             dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1)                  &
     144                            + dist1(k,j+1,i) + dist1(k+1,j,i)                  &
    141145                            ) / 12.0
    142146          ENDDO

  • palm/trunk/SOURCE/disturb_heatflux.f90

    r1319 r1320  
    1616!
    1717! Copyright 1997-2014 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!------------------------------------------------------------------------------!
    1919!
    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:
    … …  
    2632! $Id$
    2733!
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    30 !
    3134! 1036 2012-10-22 13:43:42Z raasch
    3235! code put under GPL (PALM 3.9)
    33 !
    34 ! 555 2010-09-07 07:32:53Z raasch
    35 ! Bugfix in if statement
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.7  2006/08/04 14:35:07  raasch
    40 ! Additional parameter in function random_gauss which limits the range of the
    41 ! created random numbers, izuf renamed iran
    4236!
    4337! Revision 1.1  1998/03/25 20:03:47  raasch
    … …  
    5448!------------------------------------------------------------------------------!
    5549
    56     USE arrays_3d
    57     USE control_parameters
    58     USE cpulog
    59     USE grid_variables
    60     USE indices
     50    USE arrays_3d,                                                             &
     51        ONLY:  shf
     52       
     53    USE control_parameters,                                                    &
     54        ONLY:  iran, surface_heatflux, wall_heatflux
     55       
     56    USE cpulog,                                                                &
     57        ONLY:  cpu_log, log_point
     58       
     59    USE kinds
     60   
     61    USE indices,                                                               &
     62        ONLY:  nx, nxl, nxr, ny, nyn, nys, nzb_s_inner
    6163
    6264    IMPLICIT NONE
    6365
    64     INTEGER ::  i, j
    65     REAL    ::  random_gauss, randomnumber
     66    INTEGER(iwp) ::  j  !:
     67    INTEGER(iwp) ::  i  !:
     68   
     69    REAL(wp) ::  random_gauss  !:
     70    REAL(wp) ::  randomnumber  !:
    6671
    6772
    … …  
    7378       DO  j = 0, ny
    7479          randomnumber = random_gauss( iran, 5.0 )
    75           IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j ) &
     80          IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j )   &
    7681          THEN
    7782             IF ( nzb_s_inner(j,i) == 0 )  THEN

  • palm/trunk/SOURCE/eqn_state_seawater.f90

    r1310 r1320  
    11 MODULE eqn_state_seawater_mod
    22
    3 !--------------------------------------------------------------------------------!
     3!------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2014 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!------------------------------------------------------------------------------!
    1919!
    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:
    … …  
    2834! 1036 2012-10-22 13:43:42Z raasch
    2935! code put under GPL (PALM 3.9)
    30 !
    31 ! 388 2009-09-23 09:40:33Z raasch
    32 ! Potential density is additionally calculated in eqn_state_seawater,
    33 ! first constant in array den also defined as type double.
    3436!
    3537! 97 2007-06-21 08:23:15Z raasch
    … …  
    4547! eqn_state_seawater_func calculates density.
    4648!------------------------------------------------------------------------------!
     49   
     50    USE kinds
    4751
    4852    IMPLICIT NONE
    … …  
    5155    PUBLIC eqn_state_seawater, eqn_state_seawater_func
    5256
    53     REAL, DIMENSION(12), PARAMETER ::  nom =                             &
    54                       (/ 9.9984085444849347D2,   7.3471625860981584D0,   &
    55                         -5.3211231792841769D-2,  3.6492439109814549D-4,  &
    56                          2.5880571023991390D0,  -6.7168282786692354D-3,  &
    57                          1.9203202055760151D-3,  1.1798263740430364D-2,  &
    58                          9.8920219266399117D-8,  4.6996642771754730D-6,  &
    59                         -2.5862187075154352D-8, -3.2921414007960662D-12 /)
    60 
    61     REAL, DIMENSION(13), PARAMETER ::  den =                             &
    62                       (/ 1.0D0,                  7.2815210113327091D-3,  &
    63                         -4.4787265461983921D-5,  3.3851002965802430D-7,  &
    64                          1.3651202389758572D-10, 1.7632126669040377D-3,  &
    65                         -8.8066583251206474D-6, -1.8832689434804897D-10, &
    66                          5.7463776745432097D-6,  1.4716275472242334D-9,  &
    67                          6.7103246285651894D-6, -2.4461698007024582D-17, &
    68                         -9.1534417604289062D-18 /)
     57    REAL(wp), DIMENSION(12), PARAMETER ::  nom =                               &
     58                          (/ 9.9984085444849347D2,   7.3471625860981584D0,     &
     59                            -5.3211231792841769D-2,  3.6492439109814549D-4,    &
     60                             2.5880571023991390D0,  -6.7168282786692354D-3,    &
     61                             1.9203202055760151D-3,  1.1798263740430364D-2,    &
     62                             9.8920219266399117D-8,  4.6996642771754730D-6,    &
     63                            -2.5862187075154352D-8, -3.2921414007960662D-12 /)
     64                          !:
     65
     66    REAL(wp), DIMENSION(13), PARAMETER ::  den =                               &
     67                          (/ 1.0D0,                  7.2815210113327091D-3,    &
     68                            -4.4787265461983921D-5,  3.3851002965802430D-7,    &
     69                             1.3651202389758572D-10, 1.7632126669040377D-3,    &
     70                            -8.8066583251206474D-6, -1.8832689434804897D-10,   &
     71                             5.7463776745432097D-6,  1.4716275472242334D-9,    &
     72                             6.7103246285651894D-6, -2.4461698007024582D-17,   &
     73                            -9.1534417604289062D-18 /)
     74                          !:
    6975
    7076    INTERFACE eqn_state_seawater
    … …  
    8591    SUBROUTINE eqn_state_seawater
    8692
    87        USE arrays_3d
    88        USE indices
     93       USE arrays_3d,                                                          &
     94           ONLY:  hyp, prho, pt_p, rho, sa_p
     95       USE indices,                                                            &
     96           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
    8997
    9098       IMPLICIT NONE
    9199
    92        INTEGER ::  i, j, k
    93 
    94        REAL ::  pden, pnom, p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, sa2
     100       INTEGER(iwp) ::  i  !:
     101       INTEGER(iwp) ::  j  !:
     102       INTEGER(iwp) ::  k  !:
     103
     104       REAL(wp) ::  pden  !:
     105       REAL(wp) ::  pnom  !:
     106       REAL(wp) ::  p1    !:
     107       REAL(wp) ::  p2    !:
     108       REAL(wp) ::  p3    !:
     109       REAL(wp) ::  pt1   !:
     110       REAL(wp) ::  pt2   !:
     111       REAL(wp) ::  pt3   !:
     112       REAL(wp) ::  pt4   !:
     113       REAL(wp) ::  sa1   !:
     114       REAL(wp) ::  sa15  !:
     115       REAL(wp) ::  sa2   !:
     116       
     117                       
    95118
    96119       DO  i = nxl, nxr
    … …  
    114137                sa2  = sa1 * sa1
    115138
    116                 pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     + &
    117                        nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 + &
     139                pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     +    &
     140                       nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 +    &
    118141                       nom(7)*sa2
    119142
    120                 pden = den(1)           + den(2)*pt1     + den(3)*pt2     + &
    121                        den(4)*pt3       + den(5)*pt4     + den(6)*sa1     + &
    122                        den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    + &
     143                pden = den(1)           + den(2)*pt1     + den(3)*pt2     +    &
     144                       den(4)*pt3       + den(5)*pt4     + den(6)*sa1     +    &
     145                       den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +    &
    123146                       den(10)*sa15*pt2
    124147
    … …  
    127150                prho(k,j,i) = pnom / pden
    128151
    129                 pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  + &
     152                pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +    &
    130153                       nom(10)*p1*sa1   + nom(11)*p2     + nom(12)*p2*pt2
    131154
    132                 pden = pden +             den(11)*p1     + den(12)*p2*pt3 + &
     155                pden = pden +             den(11)*p1     + den(12)*p2*pt3 +    &
    133156                       den(13)*p3*pt1
    134157
    … …  
    156179    SUBROUTINE eqn_state_seawater_ij( i, j )
    157180
    158        USE arrays_3d
    159        USE indices
     181       USE arrays_3d,                                                          &
     182           ONLY:  hyp, prho, pt_p, rho, sa_p
     183           
     184       USE indices,                                                            &
     185           ONLY:  nzb_s_inner, nzt
    160186
    161187       IMPLICIT NONE
    162188
    163        INTEGER ::  i, j, k
    164 
    165        REAL ::  pden, pnom, p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, sa2
     189       INTEGER(iwp) ::  i, j, k
     190
     191       REAL(wp)     ::  pden, pnom, p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, &
     192                        sa2
    166193
    167194       DO  k = nzb_s_inner(j,i)+1, nzt
    … …  
    183210          sa2  = sa1 * sa1
    184211
    185           pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     + &
    186                  nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 + &
     212          pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     +          &
     213                 nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 +          &
    187214                 nom(7)*sa2
    188215
    189           pden = den(1)           + den(2)*pt1     + den(3)*pt2     + &
    190                  den(4)*pt3       + den(5)*pt4     + den(6)*sa1     + &
    191                  den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    + &
     216          pden = den(1)           + den(2)*pt1     + den(3)*pt2     +          &
     217                 den(4)*pt3       + den(5)*pt4     + den(6)*sa1     +          &
     218                 den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +          &
    192219                 den(10)*sa15*pt2
    193220
    … …  
    196223          prho(k,j,i) = pnom / pden
    197224
    198           pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  + &
     225          pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +          &
    199226                 nom(10)*p1*sa1   + nom(11)*p2     + nom(12)*p2*pt2
    200           pden = pden +             den(11)*p1     + den(12)*p2*pt3 + &
     227          pden = pden +             den(11)*p1     + den(12)*p2*pt3 +          &
    201228                 den(13)*p3*pt1
    202229
    … …  
    221248! Equation of state as a function
    222249!------------------------------------------------------------------------------!
    223     REAL FUNCTION eqn_state_seawater_func( p, pt, sa )
     250    REAL(wp) FUNCTION eqn_state_seawater_func( p, pt, sa )
    224251
    225252       IMPLICIT NONE
    226253
    227        REAL ::  p, p1, p2, p3, pt, pt1, pt2, pt3, pt4, sa, sa15, sa2
     254       REAL(wp) ::  p      !:
     255       REAL(wp) ::  p1     !:
     256       REAL(wp) ::  p2     !:
     257       REAL(wp) ::  p3     !:
     258       REAL(wp) ::  pt     !:
     259       REAL(wp) ::  pt1    !:
     260       REAL(wp) ::  pt2    !:
     261       REAL(wp) ::  pt3    !:
     262       REAL(wp) ::  pt4    !:
     263       REAL(wp) ::  sa     !:
     264       REAL(wp) ::  sa15   !:
     265       REAL(wp) ::  sa2    !:
    228266
    229267!

  • palm/trunk/SOURCE/exchange_horiz.f90

    r1319 r1320  
    11 SUBROUTINE exchange_horiz( ar, nbgp_local)
    22
    3 !--------------------------------------------------------------------------------!
     3!------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2014 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!------------------------------------------------------------------------------!
    1919!
    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:
    2531! -----------------
    2632! $Id$
    27 !
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    3033!
    3134! 1257 2013-11-08 15:18:40Z raasch
    … …  
    4548! 841 2012-02-28 12:29:49Z maronga
    4649! Excluded routine from compilation of namelist_file_check
    47 !
    48 ! 709 2011-03-30 09:31:40Z raasch
    49 ! formatting adjustments
    50 !
    51 ! 707 2011-03-29 11:39:40Z raasch
    52 ! grid_level directly used as index for MPI data type arrays,
    53 ! bc_lr/ns replaced by bc_lr/ns_cyc
    54 !
    55 ! 689 2011-02-20 19:31:12z gryschka
    56 ! Bugfix for some logical expressions
    57 ! (syntax was not compatible with all compilers)
    58 !
    59 ! 683 2011-02-09 14:25:15Z raasch
    60 ! optional synchronous exchange (sendrecv) implemented, code partly reformatted
    61 !
    62 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    63 ! Dynamic exchange of ghost points with nbgp_local to ensure that no useless
    64 ! ghost points exchanged in case of multigrid. type_yz(0) and type_xz(0)
    65 ! used for normal grid, the remaining types used for the several grid levels.
    66 ! Exchange is done via MPI-Vectors with a dynamic value of ghost points which
    67 ! depend on the advection scheme. Exchange of left and right PEs is 10% faster
    68 ! with MPI-Vectors than without.
    69 !
    70 ! 75 2007-03-22 09:54:05Z raasch
    71 ! Special cases for additional gridpoints along x or y in case of non-cyclic
    72 ! boundary conditions are not regarded any more
    73 !
    74 ! RCS Log replace by Id keyword, revision history cleaned up
    75 !
    76 ! Revision 1.16  2006/02/23 12:19:08  raasch
    77 ! anz_yz renamed ngp_yz
    7850!
    7951! Revision 1.1  1997/07/24 11:13:29  raasch
    … …  
    8759!------------------------------------------------------------------------------!
    8860
    89     USE control_parameters
    90     USE cpulog
    91     USE indices
     61    USE control_parameters,                                                    &
     62        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, mg_switch_to_pe0,             &
     63               synchronous_exchange
     64               
     65    USE cpulog,                                                                &
     66        ONLY:  cpu_log, log_point_s
     67       
     68    USE indices,                                                               &
     69        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
     70       
     71    USE kinds
     72   
    9273    USE pegrid
    9374
    … …  
    9576
    9677
    97     INTEGER ::  i, j, k, nbgp_local
    98     REAL, DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
    99                     nxl-nbgp_local:nxr+nbgp_local) ::  ar
     78    INTEGER(iwp) ::  i           !:
     79    INTEGER(iwp) ::  j           !:
     80    INTEGER(iwp) ::  k           !:
     81    INTEGER(iwp) ::  nbgp_local  !:
     82   
     83    REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,               &
     84                        nxl-nbgp_local:nxr+nbgp_local) ::  ar  !:
     85                       
    10086
    10187#if ! defined( __check )
    … …  
    127113!
    128114!--       Send right boundary, receive left one (synchronous)
    129           CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
    130                              type_yz(grid_level), pright, 1,             &
    131                              ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1,   &
    132                              type_yz(grid_level), pleft,  1,             &
     115          CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,       &
     116                             type_yz(grid_level), pright, 1,                   &
     117                             ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1,         &
     118                             type_yz(grid_level), pleft,  1,                   &
    133119                             comm2d, status, ierr )
    134120
    … …  
    152138!
    153139!--          Send right boundary, receive left one (asynchronous)
    154              CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,          &
    155                              type_yz(grid_level), pright, req_count+1, comm2d,    &
     140             CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,       &
     141                             type_yz(grid_level), pright, req_count+1, comm2d, &
    156142                             req(req_count+3), ierr )
    157              CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,          &
    158                              type_yz(grid_level), pleft,  req_count+1, comm2d,    &
     143             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
     144                             type_yz(grid_level), pleft,  req_count+1, comm2d, &
    159145                             req(req_count+4), ierr )
    160146
    … …  
    192178!
    193179!--       Send rear boundary, receive front one (synchronous)
    194           CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
    195                              type_xz(grid_level), pnorth, 1,             &
    196                              ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1, &
    197                              type_xz(grid_level), psouth, 1,             &
     180          CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,       &
     181                             type_xz(grid_level), pnorth, 1,                   &
     182                             ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
     183                             type_xz(grid_level), psouth, 1,                   &
    198184                             comm2d, status, ierr )
    199185
    … …  
    218204!
    219205!--          Send rear boundary, receive front one (asynchronous)
    220              CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,          &
    221                              type_xz(grid_level), pnorth, req_count+1, comm2d,    &
     206             CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,       &
     207                             type_xz(grid_level), pnorth, req_count+1, comm2d, &
    222208                             req(req_count+3), ierr )
    223              CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,          &
    224                              type_xz(grid_level), psouth, req_count+1, comm2d,    &
     209             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
     210                             type_xz(grid_level), psouth, req_count+1, comm2d, &
    225211                             req(req_count+4), ierr )
    226212

  • palm/trunk/SOURCE/exchange_horiz_2d.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! 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:
    … …  
    2632! $Id$
    2733!
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    30 !
    3134! 1092 2013-02-02 11:24:22Z raasch
    3235! unused variables removed
    … …  
    3740! 841 2012-02-28 12:29:49Z maronga
    3841! Excluded routine from compilation of namelist_file_check
    39 !
    40 ! 707 2011-03-29 11:39:40Z raasch
    41 ! bc_lr/ns replaced by bc_lr/ns_cyc
    42 !
    43 ! 702 2011-03-24 19:33:15Z suehring
    44 ! Bugfix in declaration of ar in exchange_horiz_2d_int and number of MPI-blocks
    45 ! in MPI_SENDRECV().
    46 !
    47 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    48 ! Dynamic exchange of ghost points with nbgp, which depends on the advection
    49 ! scheme. Exchange between left and right PEs is now done with MPI-vectors.
    50 !
    51 ! 73 2007-03-20 08:33:14Z raasch
    52 ! Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary
    53 ! conditions
    54 !
    55 ! RCS Log replace by Id keyword, revision history cleaned up
    56 !
    57 ! Revision 1.9  2006/05/12 19:15:52  letzel
    58 ! MPI_REAL replaced by MPI_INTEGER in exchange_horiz_2d_int
    5942!
    6043! Revision 1.1  1998/01/23 09:58:21  raasch
    … …  
    6851!------------------------------------------------------------------------------!
    6952
    70     USE control_parameters
    71     USE cpulog
    72     USE indices
     53    USE control_parameters,                                                    &
     54        ONLY :  inflow_l, inflow_n, inflow_r, inflow_s, outflow_l, outflow_n,  &
     55                outflow_r, outflow_s
     56               
     57    USE cpulog,                                                                &
     58        ONLY :  cpu_log, log_point_s
     59       
     60    USE indices,                                                               &
     61        ONLY :  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
     62       
     63    USE kinds
     64   
    7365    USE pegrid
    7466
    … …  
    7668
    7769
    78     REAL ::  ar(nysg:nyng,nxlg:nxrg)
    79     INTEGER :: i
     70    INTEGER(iwp) :: i  !:
     71   
     72    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !:
     73   
    8074
    8175#if ! defined( __check )
    … …  
    188182!------------------------------------------------------------------------------!
    189183
    190     USE control_parameters
    191     USE cpulog
    192     USE indices
     184    USE control_parameters,                                                    &
     185        ONLY:  bc_lr_cyc, bc_ns_cyc
     186       
     187    USE cpulog,                                                                &
     188        ONLY:  cpu_log, log_point_s
     189       
     190    USE indices,                                                               &
     191        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
     192       
     193    USE kinds
     194   
    193195    USE pegrid
    194196
    195197    IMPLICIT NONE
    196198
    197     INTEGER ::  ar(nysg:nyng,nxlg:nxrg)
     199    INTEGER(iwp) ::  ar(nysg:nyng,nxlg:nxrg)  !:
    198200
    199201#if ! defined( __check )

  • palm/trunk/SOURCE/fft_xy.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:
    … …  
    6571! 1036 2012-10-22 13:43:42Z raasch
    6672! code put under GPL (PALM 3.9)
    67 !
    68 ! 274 2009-03-26 15:11:21Z heinze
    69 ! Output of messages replaced by message handling routine.
    70 !
    71 ! Feb. 2007
    72 ! RCS Log replace by Id keyword, revision history cleaned up
    73 !
    74 ! Revision 1.4  2006/03/28 12:27:09  raasch
    75 ! Stop when system-specific fft is selected on NEC. For unknown reasons this
    76 ! causes a program abort during first allocation in init_grid.
    77 !
    78 ! Revision 1.2  2004/04/30 11:44:27  raasch
    79 ! Module renamed from fft_for_1d_decomp to fft_xy, 1d-routines renamed to
    80 ! fft_x and fft_y,
    81 ! function FFT replaced by subroutine FFTN due to problems with 64-bit
    82 ! mode on ibm,
    83 ! shape of array cwork is explicitly stored in ishape/jshape and handled
    84 ! to routine FFTN instead of shape-function (due to compiler error on
    85 ! decalpha),
    86 ! non vectorized FFT for nec included
    8773!
    8874! Revision 1.1  2002/06/11 13:00:49  raasch
    … …  
    9682!------------------------------------------------------------------------------!
    9783
    98     USE control_parameters
    99     USE indices
     84    USE control_parameters,                                                    &
     85        ONLY:  fft_method, message_string
     86       
     87    USE indices,                                                               &
     88        ONLY:  nx, ny, nz
     89       
    10090#if defined( __cuda_fft )
    10191    USE ISO_C_BINDING
    … …  
    10393    USE, INTRINSIC ::  ISO_C_BINDING
    10494#endif
    105     USE precision_kind
    106     USE singleton
     95
     96    USE kinds
     97   
     98    USE singleton,                                                             &
     99        ONLY: fftn
     100   
    107101    USE temperton_fft
    108     USE transpose_indices
     102   
     103    USE transpose_indices,                                                     &
     104        ONLY:  nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
    109105
    110106    IMPLICIT NONE
    … …  
    113109    PUBLIC fft_x, fft_x_1d, fft_y, fft_y_1d, fft_init, fft_x_m, fft_y_m
    114110
    115     INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::  ifax_x, ifax_y
    116 
    117     LOGICAL, SAVE                            ::  init_fft = .FALSE.
    118 
    119     REAL, SAVE ::  dnx, dny, sqr_dnx, sqr_dny
    120     REAL, DIMENSION(:), ALLOCATABLE, SAVE    ::  trigs_x, trigs_y
     111    INTEGER(iwp), DIMENSION(:), ALLOCATABLE, SAVE ::  ifax_x  !:
     112    INTEGER(iwp), DIMENSION(:), ALLOCATABLE, SAVE ::  ifax_y  !:
     113
     114    LOGICAL, SAVE ::  init_fft = .FALSE.  !:
     115
     116    REAL(wp), SAVE ::  dnx      !:
     117    REAL(wp), SAVE ::  dny      !:
     118    REAL(wp), SAVE ::  sqr_dnx  !:
     119    REAL(wp), SAVE ::  sqr_dny  !:
     120   
     121    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trigs_x  !:
     122    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trigs_y  !:
    121123
    122124#if defined( __ibm )
    123     INTEGER, PARAMETER ::  nau1 = 20000, nau2 = 22000
     125    INTEGER(iwp), PARAMETER ::  nau1 = 20000  !:
     126    INTEGER(iwp), PARAMETER ::  nau2 = 22000  !:
    124127!
    125128!-- The following working arrays contain tables and have to be "save" and
    126129!-- shared in OpenMP sense
    127     REAL, DIMENSION(nau1), SAVE ::  aux1, auy1, aux3, auy3
     130    REAL(wp), DIMENSION(nau1), SAVE ::  aux1  !:
     131    REAL(wp), DIMENSION(nau1), SAVE ::  auy1  !:
     132    REAL(wp), DIMENSION(nau1), SAVE ::  aux3  !:
     133    REAL(wp), DIMENSION(nau1), SAVE ::  auy3  !:
     134   
    128135#elif defined( __nec )
    129     INTEGER, SAVE ::  nz1
    130     REAL, DIMENSION(:), ALLOCATABLE, SAVE ::  trig_xb, trig_xf, trig_yb, &
    131                                               trig_yf
     136    INTEGER(iwp), SAVE ::  nz1  !:
     137   
     138    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_xb  !:
     139    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_xf  !:
     140    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_yb  !:
     141    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_yf  !:
     142   
    132143#elif defined( __cuda_fft )
    133     INTEGER(C_INT), SAVE ::  plan_xf, plan_xi, plan_yf, plan_yi
    134     INTEGER, SAVE        ::  total_points_x_transpo, total_points_y_transpo
     144    INTEGER(C_INT), SAVE ::  plan_xf  !:
     145    INTEGER(C_INT), SAVE ::  plan_xi  !:
     146    INTEGER(C_INT), SAVE ::  plan_yf  !:
     147    INTEGER(C_INT), SAVE ::  plan_yi  !:
     148   
     149    INTEGER(iwp), SAVE   ::  total_points_x_transpo  !:
     150    INTEGER(iwp), SAVE   ::  total_points_y_transpo  !:
    135151#endif
    136152
    137153#if defined( __fftw )
    138154    INCLUDE  'fftw3.f03'
    139     INTEGER(KIND=C_INT) ::  nx_c, ny_c
    140     COMPLEX(KIND=C_DOUBLE_COMPLEX), DIMENSION(:), ALLOCATABLE, SAVE ::  x_out, y_out
    141     REAL(KIND=C_DOUBLE), DIMENSION(:), ALLOCATABLE, SAVE            ::  x_in, y_in
     155    INTEGER(KIND=C_INT) ::  nx_c  !:
     156    INTEGER(KIND=C_INT) ::  ny_c  !:
     157   
     158    COMPLEX(KIND=C_DOUBLE_COMPLEX), DIMENSION(:), ALLOCATABLE, SAVE ::         &
     159       x_out  !:
     160    COMPLEX(KIND=C_DOUBLE_COMPLEX), DIMENSION(:), ALLOCATABLE, SAVE ::         &
     161       y_out  !:
     162   
     163    REAL(KIND=C_DOUBLE), DIMENSION(:), ALLOCATABLE, SAVE ::                    &
     164       x_in   !:
     165    REAL(KIND=C_DOUBLE), DIMENSION(:), ALLOCATABLE, SAVE ::                    &
     166       y_in   !:
     167   
     168   
    142169    TYPE(C_PTR), SAVE ::  plan_xf, plan_xi, plan_yf, plan_yi
    143170#endif
    … …  
    186213!--    in OpenMP sense
    187214#if defined( __ibm )
    188        REAL, DIMENSION(0:nx+2) :: workx
    189        REAL, DIMENSION(0:ny+2) :: worky
    190        REAL, DIMENSION(nau2)   :: aux2, auy2, aux4, auy4
     215       REAL(wp), DIMENSION(0:nx+2) ::  workx  !:
     216       REAL(wp), DIMENSION(0:ny+2) ::  worky  !:
     217       REAL(wp), DIMENSION(nau2)   ::  aux2   !:
     218       REAL(wp), DIMENSION(nau2)   ::  auy2   !:
     219       REAL(wp), DIMENSION(nau2)   ::  aux4   !:
     220       REAL(wp), DIMENSION(nau2)   ::  auy4   !:
    191221#elif defined( __nec )
    192        REAL, DIMENSION(0:nx+3,nz+1)   ::  work_x
    193        REAL, DIMENSION(0:ny+3,nz+1)   ::  work_y
    194        REAL, DIMENSION(6*(nx+3),nz+1) ::  workx
    195        REAL, DIMENSION(6*(ny+3),nz+1) ::  worky
     222       REAL(wp), DIMENSION(0:nx+3,nz+1)   ::  work_x  !:
     223       REAL(wp), DIMENSION(0:ny+3,nz+1)   ::  work_y  !:
     224       REAL(wp), DIMENSION(6*(nx+3),nz+1) ::  workx   !:
     225       REAL(wp), DIMENSION(6*(ny+3),nz+1) ::  worky   !:
    196226#endif
    197227
    … …  
    228258          CALL message( 'fft_init', 'PA0187', 1, 2, 0, 6, 0 )
    229259
    230           ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), &
     260          ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)),                      &
    231261                    trig_yb(2*(ny+1)), trig_yf(2*(ny+1)) )
    232262
    … …  
    240270          CALL DZFFT( 0, nx+1, sqr_dnx, work_x, work_x, trig_xf, workx, 0 )
    241271          CALL ZDFFT( 0, nx+1, sqr_dnx, work_x, work_x, trig_xb, workx, 0 )
    242           CALL DZFFTM( 0, nx+1, nz1, sqr_dnx, work_x, nx+4, work_x, nx+4, &
     272          CALL DZFFTM( 0, nx+1, nz1, sqr_dnx, work_x, nx+4, work_x, nx+4,      &
    243273                       trig_xf, workx, 0 )
    244           CALL ZDFFTM( 0, nx+1, nz1, sqr_dnx, work_x, nx+4, work_x, nx+4, &
     274          CALL ZDFFTM( 0, nx+1, nz1, sqr_dnx, work_x, nx+4, work_x, nx+4,      &
    245275                       trig_xb, workx, 0 )
    246276!
    … …  
    248278          CALL DZFFT( 0, ny+1, sqr_dny, work_y, work_y, trig_yf, worky, 0 )
    249279          CALL ZDFFT( 0, ny+1, sqr_dny, work_y, work_y, trig_yb, worky, 0 )
    250           CALL DZFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4, &
     280          CALL DZFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4,      &
    251281                       trig_yf, worky, 0 )
    252           CALL ZDFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4, &
     282          CALL ZDFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4,      &
    253283                       trig_yb, worky, 0 )
    254284#elif defined( __cuda_fft )
    … …  
    278308          nx_c = nx+1
    279309          ny_c = ny+1
    280           ALLOCATE( x_in(0:nx+2), y_in(0:ny+2), x_out(0:(nx+1)/2), &
     310          ALLOCATE( x_in(0:nx+2), y_in(0:ny+2), x_out(0:(nx+1)/2),             &
    281311                    y_out(0:(ny+1)/2) )
    282312          plan_xf = FFTW_PLAN_DFT_R2C_1D( nx_c, x_in, x_out, FFTW_ESTIMATE )
    … …  
    322352       IMPLICIT NONE
    323353
    324        CHARACTER (LEN=*) ::  direction
    325        INTEGER ::  i, ishape(1), j, k
    326 
    327        LOGICAL ::  forward_fft
    328 
    329        REAL, DIMENSION(0:nx+2)   ::  work
    330        REAL, DIMENSION(nx+2)     ::  work1
    331        COMPLEX, DIMENSION(:), ALLOCATABLE ::  cwork
     354       CHARACTER (LEN=*) ::  direction  !:
     355       
     356       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !:
     357
     358       INTEGER(iwp) ::  i          !:
     359       INTEGER(iwp) ::  ishape(1)  !:
     360       INTEGER(iwp) ::  j          !:
     361       INTEGER(iwp) ::  k          !:
     362
     363       LOGICAL ::  forward_fft !:
     364       
     365       REAL(wp), DIMENSION(0:nx+2) ::  work   !:
     366       REAL(wp), DIMENSION(nx+2)   ::  work1  !:
     367       
    332368#if defined( __ibm )
    333        REAL, DIMENSION(nau2)     ::  aux2, aux4
     369       REAL(wp), DIMENSION(nau2) ::  aux2  !:
     370       REAL(wp), DIMENSION(nau2) ::  aux4  !:
    334371#elif defined( __nec )
    335        REAL, DIMENSION(6*(nx+1)) ::  work2
     372       REAL(wp), DIMENSION(6*(nx+1)) ::  work2  !:
    336373#elif defined( __cuda_fft )
    337        COMPLEX(dpk), DIMENSION(0:(nx+1)/2,nys_x:nyn_x,nzb_x:nzt_x) ::  ar_tmp
     374       COMPLEX(dpk), DIMENSION(0:(nx+1)/2,nys_x:nyn_x,nzb_x:nzt_x) ::          &
     375          ar_tmp  !:
    338376       !$acc declare create( ar_tmp )
    339377#endif
    340        REAL, DIMENSION(0:nx,nys_x:nyn_x), OPTIONAL   ::  ar_2d
    341        REAL, DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::  ar
     378
     379       REAL(wp), DIMENSION(0:nx,nys_x:nyn_x), OPTIONAL   ::                    &
     380          ar_2d   !:
     381       REAL(wp), DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) ::                    &
     382          ar      !:
    342383
    343384       IF ( direction == 'forward' )  THEN
    … …  
    540581                DO  j = nys_x, nyn_x
    541582
    542                    CALL DRCFT( 0, ar, 1, work, 1, nx+1, 1, 1, sqr_dnx, aux1, nau1, &
    543                                aux2, nau2 )
     583                   CALL DRCFT( 0, ar, 1, work, 1, nx+1, 1, 1, sqr_dnx, aux1,   &
     584                               nau1, aux2, nau2 )
    544585
    545586                   DO  i = 0, (nx+1)/2
    … …  
    570611                   work(nx+2) = 0.0
    571612
    572                    CALL DCRFT( 0, work, 1, work, 1, nx+1, 1, -1, sqr_dnx, aux3, nau1, &
    573                                aux4, nau2 )
     613                   CALL DCRFT( 0, work, 1, work, 1, nx+1, 1, -1, sqr_dnx,      &
     614                               aux3, nau1, aux4, nau2 )
    574615
    575616                   DO  i = 0, nx
    … …  
    709750       IMPLICIT NONE
    710751
    711        CHARACTER (LEN=*) ::  direction
    712        INTEGER ::  i, ishape(1)
    713 
    714        LOGICAL ::  forward_fft
    715 
    716        REAL, DIMENSION(0:nx)     ::  ar
    717        REAL, DIMENSION(0:nx+2)   ::  work
    718        REAL, DIMENSION(nx+2)     ::  work1
    719        COMPLEX, DIMENSION(:), ALLOCATABLE ::  cwork
     752       CHARACTER (LEN=*) ::  direction  !:
     753       
     754       INTEGER(iwp) ::  i               !:
     755       INTEGER(iwp) ::  ishape(1)       !:
     756
     757       LOGICAL ::  forward_fft          !:
     758
     759       REAL(wp), DIMENSION(0:nx)   ::  ar     !:
     760       REAL(wp), DIMENSION(0:nx+2) ::  work   !:
     761       REAL(wp), DIMENSION(nx+2)   ::  work1  !:
     762       
     763       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !:
     764       
    720765#if defined( __ibm )
    721        REAL, DIMENSION(nau2)     ::  aux2, aux4
     766       REAL(wp), DIMENSION(nau2) ::  aux2       !:
     767       REAL(wp), DIMENSION(nau2) ::  aux4       !:
    722768#elif defined( __nec )
    723        REAL, DIMENSION(6*(nx+1)) ::  work2
     769       REAL(wp), DIMENSION(6*(nx+1)) ::  work2  !:
    724770#endif
    725771
    … …  
    838884          IF ( forward_fft )  THEN
    839885
    840              CALL DRCFT( 0, ar, 1, work, 1, nx+1, 1, 1, sqr_dnx, aux1, nau1, &
     886             CALL DRCFT( 0, ar, 1, work, 1, nx+1, 1, 1, sqr_dnx, aux1, nau1,   &
    841887                         aux2, nau2 )
    842888
    … …  
    945991       IMPLICIT NONE
    946992
    947        CHARACTER (LEN=*) ::  direction
    948        INTEGER ::  i, j, jshape(1), k
    949        INTEGER ::  nxl_y_bound, nxl_y_l, nxr_y_bound, nxr_y_l
    950 
    951        LOGICAL ::  forward_fft
    952 
    953        REAL, DIMENSION(0:ny+2)   ::  work
    954        REAL, DIMENSION(ny+2)     ::  work1
    955        COMPLEX, DIMENSION(:), ALLOCATABLE ::  cwork
     993       CHARACTER (LEN=*) ::  direction  !:
     994       
     995       INTEGER(iwp) ::  i            !:
     996       INTEGER(iwp) ::  j            !:
     997       INTEGER(iwp) ::  jshape(1)    !:
     998       INTEGER(iwp) ::  k            !:
     999       INTEGER(iwp) ::  nxl_y_bound  !:
     1000       INTEGER(iwp) ::  nxl_y_l      !:
     1001       INTEGER(iwp) ::  nxr_y_bound  !:
     1002       INTEGER(iwp) ::  nxr_y_l      !:
     1003
     1004       LOGICAL ::  forward_fft  !:
     1005
     1006       REAL(wp), DIMENSION(0:ny+2) ::  work   !:
     1007       REAL(wp), DIMENSION(ny+2)   ::  work1  !:
     1008       
     1009       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !:
     1010       
    9561011#if defined( __ibm )
    957        REAL, DIMENSION(nau2)     ::  auy2, auy4
     1012       REAL(wp), DIMENSION(nau2) ::  auy2  !:
     1013       REAL(wp), DIMENSION(nau2) ::  auy4  !:
    9581014#elif defined( __nec )
    959        REAL, DIMENSION(6*(ny+1)) ::  work2
     1015       REAL(wp), DIMENSION(6*(ny+1)) ::  work2  !:
    9601016#elif defined( __cuda_fft )
    961        COMPLEX(dpk), DIMENSION(0:(ny+1)/2,nxl_y:nxr_y,nzb_y:nzt_y) ::  ar_tmp
     1017       COMPLEX(dpk), DIMENSION(0:(ny+1)/2,nxl_y:nxr_y,nzb_y:nzt_y) ::          &
     1018          ar_tmp  !:
    9621019       !$acc declare create( ar_tmp )
    9631020#endif
    964        REAL, DIMENSION(0:ny,nxl_y_l:nxr_y_l,nzb_y:nzt_y) ::  ar
    965        REAL, DIMENSION(0:ny,nxl_y_bound:nxr_y_bound,nzb_y:nzt_y) ::  ar_tr
     1021
     1022       REAL(wp), DIMENSION(0:ny,nxl_y_l:nxr_y_l,nzb_y:nzt_y)         ::        &
     1023          ar     !:
     1024       REAL(wp), DIMENSION(0:ny,nxl_y_bound:nxr_y_bound,nzb_y:nzt_y) ::        &
     1025          ar_tr  !:
    9661026
    9671027       IF ( direction == 'forward' )  THEN
    … …  
    11401200                DO  i = nxl_y_l, nxr_y_l
    11411201
    1142                    CALL DRCFT( 0, ar, 1, work, 1, ny+1, 1, 1, sqr_dny, auy1, nau1, &
    1143                                auy2, nau2 )
     1202                   CALL DRCFT( 0, ar, 1, work, 1, ny+1, 1, 1, sqr_dny, auy1,   &
     1203                               nau1, auy2, nau2 )
    11441204
    11451205                   DO  j = 0, (ny+1)/2
    … …  
    11701230                   work(ny+2) = 0.0
    11711231
    1172                    CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_dny, auy3, nau1, &
    1173                                auy4, nau2 )
     1232                   CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_dny,     &
     1233                               auy3, nau1, auy4, nau2 )
    11741234
    11751235                   DO  j = 0, ny
    … …  
    13071367
    13081368       CHARACTER (LEN=*) ::  direction
    1309        INTEGER ::  j, jshape(1)
    1310 
    1311        LOGICAL ::  forward_fft
    1312 
    1313        REAL, DIMENSION(0:ny)     ::  ar
    1314        REAL, DIMENSION(0:ny+2)   ::  work
    1315        REAL, DIMENSION(ny+2)     ::  work1
    1316        COMPLEX, DIMENSION(:), ALLOCATABLE ::  cwork
     1369       
     1370       INTEGER(iwp) ::  j          !:
     1371       INTEGER(iwp) ::  jshape(1)  !:
     1372
     1373       LOGICAL ::  forward_fft  !:
     1374
     1375       REAL(wp), DIMENSION(0:ny)    ::  ar     !:
     1376       REAL(wp), DIMENSION(0:ny+2)  ::  work   !:
     1377       REAL(wp), DIMENSION(ny+2)    ::  work1  !:
     1378       
     1379       COMPLEX(wp), DIMENSION(:), ALLOCATABLE ::  cwork  !:
     1380       
    13171381#if defined( __ibm )
    1318        REAL, DIMENSION(nau2)     ::  auy2, auy4
     1382       REAL(wp), DIMENSION(nau2) ::  auy2  !:
     1383       REAL(wp), DIMENSION(nau2) ::  auy4  !:
    13191384#elif defined( __nec )
    1320        REAL, DIMENSION(6*(ny+1)) ::  work2
     1385       REAL(wp), DIMENSION(6*(ny+1)) ::  work2  !:
    13211386#endif
    13221387
    … …  
    14371502          IF ( forward_fft )  THEN
    14381503
    1439              CALL DRCFT( 0, ar, 1, work, 1, ny+1, 1, 1, sqr_dny, auy1, nau1, &
     1504             CALL DRCFT( 0, ar, 1, work, 1, ny+1, 1, 1, sqr_dny, auy1, nau1,   &
    14401505                         auy2, nau2 )
    14411506
    … …  
    14581523             work(ny+2) = 0.0
    14591524
    1460              CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_dny, auy3, nau1, &
    1461                          auy4, nau2 )
     1525             CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_dny, auy3,     &
     1526                         nau1, auy4, nau2 )
    14621527
    14631528             DO  j = 0, ny
    … …  
    15271592       IMPLICIT NONE
    15281593
    1529        CHARACTER (LEN=*)              ::  direction
    1530        INTEGER                        ::  i, k, siza
    1531 
    1532        REAL, DIMENSION(0:nx,nz)       ::  ar
    1533        REAL, DIMENSION(0:nx+3,nz+1)   ::  ai
    1534        REAL, DIMENSION(6*(nx+4),nz+1) ::  work1
     1594       CHARACTER (LEN=*) ::  direction  !:
     1595       
     1596       INTEGER(iwp) ::  i     !:
     1597       INTEGER(iwp) ::  k     !:
     1598       INTEGER(iwp) ::  siza  !:
     1599
     1600       REAL(wp), DIMENSION(0:nx,nz)       ::  ar     !:
     1601       REAL(wp), DIMENSION(0:nx+3,nz+1)   ::  ai     !:
     1602       REAL(wp), DIMENSION(6*(nx+4),nz+1) ::  work1  !:
     1603       
    15351604#if defined( __nec )
    1536        INTEGER                             ::  sizw
    1537        COMPLEX, DIMENSION((nx+4)/2+1,nz+1) ::  work
     1605       INTEGER(iwp) ::  sizw  !:
     1606       
     1607       COMPLEX(wp), DIMENSION((nx+4)/2+1,nz+1) ::  work  !:
    15381608#endif
    15391609
    … …  
    15881658!--          Tables are initialized once more. This call should not be
    15891659!--          necessary, but otherwise program aborts in asymmetric case
    1590              CALL DZFFTM( 0, nx+1, nz1, sqr_dnx, work, nx+4, work, nx+4, &
     1660             CALL DZFFTM( 0, nx+1, nz1, sqr_dnx, work, nx+4, work, nx+4,       &
    15911661                          trig_xf, work1, 0 )
    15921662
    … …  
    15961666             ENDIF
    15971667
    1598              CALL DZFFTM( 1, nx+1, nz1, sqr_dnx, ai, siza, work, sizw, &
     1668             CALL DZFFTM( 1, nx+1, nz1, sqr_dnx, ai, siza, work, sizw,         &
    15991669                          trig_xf, work1, 0 )
    16001670
    … …  
    16131683!--          Tables are initialized once more. This call should not be
    16141684!--          necessary, but otherwise program aborts in asymmetric case
    1615              CALL ZDFFTM( 0, nx+1, nz1, sqr_dnx, work, nx+4, work, nx+4, &
     1685             CALL ZDFFTM( 0, nx+1, nz1, sqr_dnx, work, nx+4, work, nx+4,       &
    16161686                          trig_xb, work1, 0 )
    16171687
    … …  
    16641734       IMPLICIT NONE
    16651735
    1666        CHARACTER (LEN=*)              ::  direction
    1667        INTEGER                        ::  j, k, ny1, siza
    1668 
    1669        REAL, DIMENSION(0:ny1,nz)      ::  ar
    1670        REAL, DIMENSION(0:ny+3,nz+1)   ::  ai
    1671        REAL, DIMENSION(6*(ny+4),nz+1) ::  work1
     1736       CHARACTER (LEN=*) ::  direction  !:
     1737       
     1738       INTEGER(iwp) ::  j     !:
     1739       INTEGER(iwp) ::  k     !:
     1740       INTEGER(iwp) ::  ny1   !:
     1741       INTEGER(iwp) ::  siza  !:
     1742
     1743       REAL(wp), DIMENSION(0:ny1,nz)      ::  ar     !:
     1744       REAL(wp), DIMENSION(0:ny+3,nz+1)   ::  ai     !:
     1745       REAL(wp), DIMENSION(6*(ny+4),nz+1) ::  work1  !:
     1746       
    16721747#if defined( __nec )
    1673        INTEGER                             ::  sizw
    1674        COMPLEX, DIMENSION((ny+4)/2+1,nz+1) ::  work
     1748       INTEGER(iwp) ::  sizw  !:
     1749       
     1750       COMPLEX(wp), DIMENSION((ny+4)/2+1,nz+1) ::  work !:
    16751751#endif
    16761752

  • palm/trunk/SOURCE/flow_statistics.f90

    r1319 r1320  
    2121! Current revisions:
    2222! -----------------
    23 !
     23! ONLY-attribute added to USE-statements,
     24! kind-parameters added to all INTEGER and REAL declaration statements,
     25! kinds are defined in new module kinds,
     26! old module precision_kind is removed,
     27! revision history before 2012 removed,
     28! comment fields (!:) to be used for variable explanations added to
     29! all variable declaration statements
    2430!
    2531! Former revisions:
    2632! -----------------
    2733! $Id$
    28 !
    29 ! 1318 2014-03-17 13:35:16Z raasch
    30 ! module interfaces removed
    3134!
    3235! 1299 2014-03-06 13:15:21Z heinze
    … …  
    6669! 801 2012-01-10 17:30:36Z suehring
    6770! Calculation of turbulent fluxes in advec_ws is now thread-safe.
    68 !
    69 ! 743 2011-08-18 16:10:16Z suehring
    70 ! Calculation of turbulent fluxes with WS-scheme only for the whole model
    71 ! domain, not for user-defined subregions.
    72 !
    73 ! 709 2011-03-30 09:31:40Z raasch
    74 ! formatting adjustments
    75 !
    76 ! 699 2011-03-22 17:52:22Z suehring
    77 ! Bugfix in calculation of vertical velocity skewness. The added absolute value
    78 ! avoid negative values in the root. Negative values of w'w' can occur at the
    79 ! top or bottom of the model domain due to degrading the order of advection
    80 ! scheme. Furthermore the calculation will be the same for all advection
    81 ! schemes.
    82 !, tend
    83 ! 696 2011-03-18 07:03:49Z raasch
    84 ! Bugfix: Summation of Wicker-Skamarock scheme fluxes and variances for all
    85 ! threads
    86 !
    87 ! 678 2011-02-02 14:31:56Z raasch
    88 ! Bugfix in calculation of the divergence of vertical flux of resolved scale
    89 ! energy, pressure fluctuations, and flux of pressure fluctuation itself
    90 !
    91 ! 673 2011-01-18 16:19:48Z suehring
    92 ! Top bc for the horizontal velocity variances added for ocean runs.
    93 ! Setting the corresponding bottom bc moved to advec_ws.
    94 !
    95 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    96 ! When advection is computed with ws-scheme, turbulent fluxes are already
    97 ! computed in the respective advection routines and buffered in arrays
    98 ! sums_xx_ws_l(). This is due to a consistent treatment of statistics with the
    99 ! numerics and to avoid unphysical kinks near the surface.
    100 ! So some if requests has to be done to dicern between fluxes from ws-scheme
    101 ! other advection schemes.
    102 ! Furthermore the computation of z_i is only done if the heat flux exceeds a
    103 ! minimum value. This affects only simulations of a neutral boundary layer and
    104 ! is due to reasons of computations in the advection scheme.
    105 !
    106 ! 624 2010-12-10 11:46:30Z heinze
    107 ! Calculation of q*2 added
    108 !
    109 ! 622 2010-12-10 08:08:13Z raasch
    110 ! optional barriers included in order to speed up collective operations
    111 !
    112 ! 388 2009-09-23 09:40:33Z raasch
    113 ! Vertical profiles of potential density and hydrostatic pressure are
    114 ! calculated.
    115 ! Added missing timeseries calculation of w"q"(0), moved timeseries q* to the
    116 ! end.
    117 ! Temperature gradient criterion for estimating the boundary layer height
    118 ! replaced by the gradient criterion of Sullivan et al. (1998).
    119 ! Output of messages replaced by message handling routine.
    120 !
    121 ! 197 2008-09-16 15:29:03Z raasch
    122 ! Spline timeseries splptx etc. removed, timeseries w'u', w'v', w'q' (k=0)
    123 ! added,
    124 ! bugfix: divide sums(k,8) (e) and sums(k,34) (e*) by ngp_2dh_s_inner(k,sr)
    125 ! (like other scalars)
    126 !
    127 ! 133 2007-11-20 10:10:53Z letzel
    128 ! Vertical profiles now based on nzb_s_inner; they are divided by
    129 ! ngp_2dh_s_inner (scalars, procucts of scalars) and ngp_2dh (staggered
    130 ! velocity components and their products, procucts of scalars and velocity
    131 ! components), respectively.
    132 !
    133 ! 106 2007-08-16 14:30:26Z raasch
    134 ! Prescribed momentum fluxes at the top surface are used,
    135 ! profiles for w*p* and w"e are calculated
    136 !
    137 ! 97 2007-06-21 08:23:15Z raasch
    138 ! Statistics for ocean version (salinity, density) added,
    139 ! calculation of z_i and Deardorff velocity scale adjusted to be used with
    140 ! the ocean version
    141 !
    142 ! 87 2007-05-22 15:46:47Z raasch
    143 ! Two more arguments added to user_statistics, which is now also called for
    144 ! user-defined profiles,
    145 ! var_hom and var_sum renamed pr_palm
    146 !
    147 ! 82 2007-04-16 15:40:52Z raasch
    148 ! Cpp-directive lcmuk changed to intel_openmp_bug
    149 !
    150 ! 75 2007-03-22 09:54:05Z raasch
    151 ! Collection of time series quantities moved from routine flow_statistics to
    152 ! here, routine user_statistics is called for each statistic region,
    153 ! moisture renamed humidity
    154 !
    155 ! 19 2007-02-23 04:53:48Z raasch
    156 ! fluxes at top modified (tswst, qswst)
    157 !
    158 ! RCS Log replace by Id keyword, revision history cleaned up
    159 !
    160 ! Revision 1.41  2006/08/04 14:37:50  raasch
    161 ! Error removed in non-parallel part (sums_l)
    16271!
    16372! Revision 1.1  1997/08/11 06:15:17  raasch
    … …  
    17786!------------------------------------------------------------------------------!
    17887
    179     USE arrays_3d
    180     USE cloud_parameters
    181     USE control_parameters
    182     USE cpulog
    183     USE grid_variables
    184     USE indices
     88    USE arrays_3d,                                                             &
     89        ONLY :  ddzu, ddzw, e, hyp, km, kh,nr,  p, prho, pt, q, qc, ql, qr,    &
     90                qs, qsws, qswst, rho, sa, saswsb, saswst, shf, ts, tswst, u,   &
     91                ug, us, usws, uswst, vsws, v, vg, vpt, vswst, w, w_subs, zw
     92       
     93    USE cloud_parameters,                                                      &
     94        ONLY :  l_d_cp, prr, pt_d_t
     95       
     96    USE control_parameters,                                                    &
     97        ONLY :  average_count_pr, cloud_droplets, cloud_physics, do_sum,       &
     98                dt_3d, g, humidity, icloud_scheme, kappa, max_pr_user,         &
     99                message_string, ocean, passive_scalar, precipitation,          &
     100                use_surface_fluxes, use_top_fluxes, ws_scheme_mom, ws_scheme_sca
     101       
     102    USE cpulog,                                                                &
     103        ONLY :  cpu_log, log_point
     104       
     105    USE grid_variables,                                                        &
     106        ONLY :  ddx, ddy
     107       
     108    USE indices,                                                               &
     109        ONLY :  ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, ngp_sums, nxl, &
     110                nxr, nyn, nys, nzb, nzb_diff_s_inner, nzb_s_inner, nzt, nzt_diff
     111       
     112    USE kinds
     113   
    185114    USE pegrid
     115   
    186116    USE statistics
    187117
    188118    IMPLICIT NONE
    189119
    190     INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
    191     LOGICAL ::  first
    192     REAL    ::  dptdz_threshold, height, pts, sums_l_eper, sums_l_etot, ust, &
    193                 ust2, u2, vst, vst2, v2, w2, z_i(2)
    194     REAL    ::  dptdz(nzb+1:nzt+1)
    195     REAL    ::  sums_ll(nzb:nzt+1,2)
     120    INTEGER(iwp) ::  i                   !:
     121    INTEGER(iwp) ::  j                   !:
     122    INTEGER(iwp) ::  k                   !:
     123    INTEGER(iwp) ::  omp_get_thread_num  !:
     124    INTEGER(iwp) ::  sr                  !:
     125    INTEGER(iwp) ::  tn                  !:
     126   
     127    LOGICAL ::  first  !:
     128   
     129    REAL(wp) ::  dptdz_threshold  !:
     130    REAL(wp) ::  height           !:
     131    REAL(wp) ::  pts              !:
     132    REAL(wp) ::  sums_l_eper      !:
     133    REAL(wp) ::  sums_l_etot      !:
     134    REAL(wp) ::  ust              !:
     135    REAL(wp) ::  ust2             !:
     136    REAL(wp) ::  u2               !:
     137    REAL(wp) ::  vst              !:
     138    REAL(wp) ::  vst2             !:
     139    REAL(wp) ::  v2               !:
     140    REAL(wp) ::  w2               !:
     141    REAL(wp) ::  z_i(2)           !:
     142   
     143    REAL(wp) ::  dptdz(nzb+1:nzt+1)    !:
     144    REAL(wp) ::  sums_ll(nzb:nzt+1,2)  !:
    196145
    197146    CALL cpu_log( log_point(10), 'flow_statistics', 'start' )
    … …  
    248197             sums_l(:,31,i) = sums_vs2_ws_l(:,i)        ! v*2
    249198             sums_l(:,32,i) = sums_ws2_ws_l(:,i)        ! w*2
    250              sums_l(:,34,i) = sums_l(:,34,i) + 0.5 *                        &
    251                               ( sums_us2_ws_l(:,i) + sums_vs2_ws_l(:,i) +   &
     199             sums_l(:,34,i) = sums_l(:,34,i) + 0.5 *                           &
     200                              ( sums_us2_ws_l(:,i) + sums_vs2_ws_l(:,i) +      &
    252201                                sums_ws2_ws_l(:,i) )    ! e*
    253202             DO  k = nzb, nzt
    254                 sums_l(nzb+5,pr_palm,i) = sums_l(nzb+5,pr_palm,i) + 0.5 * ( &
    255                                                       sums_us2_ws_l(k,i) +  &
    256                                                       sums_vs2_ws_l(k,i) +  &
     203                sums_l(nzb+5,pr_palm,i) = sums_l(nzb+5,pr_palm,i) + 0.5 * (    &
     204                                                      sums_us2_ws_l(k,i) +     &
     205                                                      sums_vs2_ws_l(k,i) +     &
    257206                                                      sums_ws2_ws_l(k,i) )
    258207             ENDDO
    … …  
    382331!--    Compute total sum from local sums
    383332       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    384        CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL, &
     333       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL,  &
    385334                           MPI_SUM, comm2d, ierr )
    386335       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    387        CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL, &
     336       CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL,  &
    388337                           MPI_SUM, comm2d, ierr )
    389338       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    390        CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL, &
     339       CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL,  &
    391340                           MPI_SUM, comm2d, ierr )
    392341       IF ( ocean )  THEN
    393342          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    394           CALL MPI_ALLREDUCE( sums_l(nzb,23,0), sums(nzb,23), nzt+2-nzb, &
     343          CALL MPI_ALLREDUCE( sums_l(nzb,23,0), sums(nzb,23), nzt+2-nzb,       &
    395344                              MPI_REAL, MPI_SUM, comm2d, ierr )
    396345       ENDIF
    397346       IF ( humidity ) THEN
    398347          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    399           CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb, &
     348          CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb,       &
    400349                              MPI_REAL, MPI_SUM, comm2d, ierr )
    401350          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    402           CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
     351          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb,       &
    403352                              MPI_REAL, MPI_SUM, comm2d, ierr )
    404353          IF ( cloud_physics ) THEN
    405354             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    406              CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb, &
     355             CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb,    &
    407356                                 MPI_REAL, MPI_SUM, comm2d, ierr )
    408357             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    409              CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb, &
     358             CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb,    &
    410359                                 MPI_REAL, MPI_SUM, comm2d, ierr )
    411360          ENDIF
    … …  
    414363       IF ( passive_scalar )  THEN
    415364          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    416           CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
     365          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb,       &
    417366                              MPI_REAL, MPI_SUM, comm2d, ierr )
    418367       ENDIF
    … …  
    468417!
    469418!--    Passive scalar
    470        IF ( passive_scalar )  hom(:,1,41,sr) = sums(:,41) /  &
     419       IF ( passive_scalar )  hom(:,1,41,sr) = sums(:,41) /                    &
    471420            ngp_2dh_s_inner(:,sr)                    ! s (q)
    472421
    … …  
    527476!
    528477!--          2D-arrays (being collected in the last column of sums_l)
    529              sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +   &
     478             sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
    530479                                        us(j,i)   * rmask(j,i,sr)
    531              sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) + &
     480             sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +             &
    532481                                        usws(j,i) * rmask(j,i,sr)
    533              sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) + &
     482             sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +             &
    534483                                        vsws(j,i) * rmask(j,i,sr)
    535              sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) + &
     484             sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +             &
    536485                                        ts(j,i)   * rmask(j,i,sr)
    537486             IF ( humidity )  THEN
    538                 sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) + &
     487                sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +        &
    539488                                            qs(j,i)   * rmask(j,i,sr)
    540489             ENDIF
    … …  
    13491298 SUBROUTINE flow_statistics
    13501299
    1351     USE arrays_3d
    1352     USE cloud_parameters
    1353     USE control_parameters
    1354     USE cpulog
    1355     USE grid_variables
    1356     USE indices
     1300    USE arrays_3d,                                                             &
     1301        ONLY:  ddzu, ddzw, e, hyp, km, kh,nr,  p, prho, pt, q, qc, ql, qr,     &
     1302               qs, qsws, qswst, rho, sa, saswsb, saswst, shf, ts, tswst, u,    &
     1303               ug, us, usws, uswst, vsws, v, vg, vpt, vswst, w, w_subs, zw
     1304       
     1305    USE cloud_parameters,                                                      &
     1306        ONLY:  l_d_cp, prr, pt_d_t
     1307       
     1308    USE control_parameters,                                                    &
     1309        ONLY:  average_count_pr, cloud_droplets, cloud_physics, do_sum,        &
     1310               dt_3d, g, humidity, icloud_scheme, kappa, max_pr_user,          &
     1311               message_string, ocean, passive_scalar, precipitation,           &
     1312               use_surface_fluxes, use_top_fluxes, ws_scheme_mom, ws_scheme_sca
     1313       
     1314    USE cpulog,                                                                &
     1315        ONLY:  cpu_log, log_point
     1316       
     1317    USE grid_variables,                                                        &
     1318        ONLY:  ddx, ddy
     1319       
     1320    USE indices,                                                               &
     1321        ONLY:  ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, ngp_sums, nxl,  &
     1322               nxr, nyn, nys, nzb, nzb_diff_s_inner, nzb_s_inner, nzt, nzt_diff
     1323       
     1324    USE kinds
     1325   
    13571326    USE pegrid
     1327   
    13581328    USE statistics
    13591329
    13601330    IMPLICIT NONE
    13611331
    1362     INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
    1363     LOGICAL ::  first
    1364     REAL    ::  dptdz_threshold, height, pts, sums_l_eper, sums_l_etot, ust, &
    1365                 ust2, u2, vst, vst2, v2, w2, z_i(2)
    1366     REAL    ::  s1, s2, s3, s4, s5, s6, s7
    1367     REAL    ::  dptdz(nzb+1:nzt+1)
    1368     REAL    ::  sums_ll(nzb:nzt+1,2)
     1332    INTEGER(iwp) ::  i                   !:
     1333    INTEGER(iwp) ::  j                   !:
     1334    INTEGER(iwp) ::  k                   !:
     1335    INTEGER(iwp) ::  omp_get_thread_num  !:
     1336    INTEGER(iwp) ::  sr                  !:
     1337    INTEGER(iwp) ::  tn                  !:
     1338   
     1339    LOGICAL ::  first  !:
     1340   
     1341    REAL(wp) ::  dptdz_threshold  !:
     1342    REAL(wp) ::  height           !:
     1343    REAL(wp) ::  pts              !:
     1344    REAL(wp) ::  sums_l_eper      !:
     1345    REAL(wp) ::  sums_l_etot      !:
     1346    REAL(wp) ::  s1               !:
     1347    REAL(wp) ::  s2               !:
     1348    REAL(wp) ::  s3               !:
     1349    REAL(wp) ::  s4               !:
     1350    REAL(wp) ::  s5               !:
     1351    REAL(wp) ::  s6               !:
     1352    REAL(wp) ::  s7               !:
     1353    REAL(wp) ::  ust              !:
     1354    REAL(wp) ::  ust2             !:
     1355    REAL(wp) ::  u2,              !:
     1356    REAL(wp) ::  vst              !:
     1357    REAL(wp) ::  vst2             !:
     1358    REAL(wp) ::  v2               !:
     1359    REAL(wp) ::  w2               !:
     1360    REAL(wp) ::  z_i(2)           !:
     1361
     1362    REAL(wp) ::  dptdz(nzb+1:nzt+1)    !:
     1363    REAL(wp) ::  sums_ll(nzb:nzt+1,2)  !:
    13691364
    13701365    CALL cpu_log( log_point(10), 'flow_statistics', 'start' )

  • palm/trunk/SOURCE/global_min_max.f90

    r1310 r1320  
    2121! Current revisions:
    2222! ------------------
    23 !
     23! ONLY-attribute added to USE-statements,
     24! kind-parameters added to all INTEGER and REAL declaration statements,
     25! kinds are defined in new module kinds,
     26! old module precision_kind is removed,
     27! revision history before 2012 removed,
     28! comment fields (!:) to be used for variable explanations added to
     29! all variable declaration statements
    2430!
    2531! Former revisions:
    … …  
    3541! 866 2012-03-28 06:44:41Z raasch
    3642! new mode "absoff" accounts for an offset in the respective array
    37 !
    38 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    39 ! Adapting of the index arrays, because MINLOC assumes lowerbound at 1 and not
    40 ! at nbgp.
    41 !
    42 ! 622 2010-12-10 08:08:13Z raasch
    43 ! optional barriers included in order to speed up collective operations
    44 !
    45 ! Feb. 2007
    46 ! RCS Log replace by Id keyword, revision history cleaned up
    47 !
    48 ! Revision 1.11  2003/04/16 12:56:58  raasch
    49 ! Index values of the extrema are limited to the range 0..nx, 0..ny
    5043!
    5144! Revision 1.1  1997/07/24 11:14:03  raasch
    … …  
    5851!------------------------------------------------------------------------------!
    5952
    60     USE indices
     53    USE indices,                                                               &
     54        ONLY:  nbgp, ny, nx
     55       
     56    USE kinds
     57   
    6158    USE pegrid
    6259
    6360    IMPLICIT NONE
    6461
    65     CHARACTER (LEN=*) ::  mode
    66 
    67     INTEGER           ::  i, i1, i2, id_fmax, id_fmin, j, j1, j2, k, k1, k2, &
    68                           fmax_ijk(3), fmax_ijk_l(3), fmin_ijk(3), &
    69                           fmin_ijk_l(3), value_ijk(3)
    70     INTEGER, OPTIONAL ::  value1_ijk(3)
    71     REAL              ::  offset, value, &
    72                           ar(i1:i2,j1:j2,k1:k2)
     62    CHARACTER (LEN=*) ::  mode  !:
     63
     64    INTEGER(iwp) ::  i              !:
     65    INTEGER(iwp) ::  i1             !:
     66    INTEGER(iwp) ::  i2             !:
     67    INTEGER(iwp) ::  id_fmax        !:
     68    INTEGER(iwp) ::  id_fmin        !:
     69    INTEGER(iwp) ::  j              !:
     70    INTEGER(iwp) ::  j1             !:
     71    INTEGER(iwp) ::  j2             !:
     72    INTEGER(iwp) ::  k              !:
     73    INTEGER(iwp) ::  k1             !:
     74    INTEGER(iwp) ::  k2             !:
     75    INTEGER(iwp) ::  fmax_ijk(3)    !:
     76    INTEGER(iwp) ::  fmax_ijk_l(3)  !:
     77    INTEGER(iwp) ::  fmin_ijk(3)    !:
     78    INTEGER(iwp) ::  fmin_ijk_l(3)  !:
     79    INTEGER(iwp) ::  value_ijk(3)   !:
     80   
     81    INTEGER(iwp), OPTIONAL ::  value1_ijk(3)  !:
     82   
     83    REAL(wp) ::  offset                 !:
     84    REAL(wp) ::  value                  !:
     85    REAL(wp) ::  ar(i1:i2,j1:j2,k1:k2)  !:
     86   
    7387#if defined( __ibm )
    74     REAL (KIND=4)     ::  fmax(2), fmax_l(2), fmin(2), fmin_l(2)  ! on 32bit-
    75                           ! machines MPI_2REAL must not be replaced by
    76                           ! MPI_2DOUBLE_PRECISION
    77 #else
    78     REAL              ::  fmax(2), fmax_l(2), fmin(2), fmin_l(2)
    79 #endif
    80     REAL, OPTIONAL    ::  value1
     88    REAL(sp) ::  fmax(2)    !:
     89    REAL(sp) ::  fmax_l(2)  !:
     90    REAL(sp) ::  fmin(2)    !:
     91    REAL(sp) ::  fmin_l(2)  !:
     92             ! on 32bit-machines MPI_2REAL must not be replaced
     93             ! by MPI_2DOUBLE_PRECISION
     94#else
     95    REAL(wp) ::  fmax(2)    !:
     96    REAL(wp) ::  fmax_l(2)  !:
     97    REAL(wp) ::  fmin(2)    !:
     98    REAL(wp) ::  fmin_l(2)  !:
     99#endif
     100    REAL(wp), OPTIONAL ::  value1  !:
    81101
    82102

  • palm/trunk/SOURCE/header.f90

    r1313 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:
    … …  
    108114! 825 2012-02-19 03:03:44Z raasch
    109115! Output of cloud physics parameters/quantities complemented and restructured
    110 !
    111 ! 767 2011-10-14 06:39:12Z raasch
    112 ! Output of given initial u,v-profiles
    113 !
    114 ! 759 2011-09-15 13:58:31Z raasch
    115 ! output of maximum number of parallel io streams
    116 !
    117 ! 707 2011-03-29 11:39:40Z raasch
    118 ! bc_lr/ns replaced by bc_lr/ns_cyc
    119 !
    120 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    121 ! Output of advection scheme.
    122 ! Modified output of Prandtl-layer height.
    123 !
    124 ! 580 2010-10-05 13:59:11Z heinze
    125 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,
    126 ! ws_vertical_gradient_level to subs_vertical_gradient_level and
    127 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i
    128 !
    129 ! 493 2010-03-01 08:30:24Z raasch
    130 ! NetCDF data output format extendend for NetCDF4/HDF5
    131 !
    132 ! 449 2010-02-02 11:23:59Z raasch
    133 ! +large scale vertical motion (subsidence/ascent)
    134 ! Bugfix: index problem concerning gradient_level indices removed
    135 !
    136 ! 410 2009-12-04 17:05:40Z letzel
    137 ! Masked data output: + dt_domask, mask_01~20_x|y|z, mask_01~20_x|y|z_loop,
    138 ! mask_scale|_x|y|z, masks, skip_time_domask
    139 !
    140 ! 346 2009-07-06 10:13:41Z raasch
    141 ! initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill'
    142 ! Coupling with independent precursor runs.
    143 ! Output of messages replaced by message handling routine.
    144 ! Output of several additional dvr parameters
    145 ! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
    146 ! canyon_wall_south, conserve_volume_flow_mode, dp_external, dp_level_b,
    147 ! dp_smooth, dpdxy, u_bulk, v_bulk
    148 ! topography_grid_convention moved from user_header
    149 ! small bugfix concerning 3d 64bit netcdf output format
    150 !
    151 ! 206 2008-10-13 14:59:11Z raasch
    152 ! Bugfix: error in zu index in case of section_xy = -1
    153 !
    154 ! 198 2008-09-17 08:55:28Z raasch
    155 ! Format adjustments allowing output of larger revision numbers
    156 !
    157 ! 197 2008-09-16 15:29:03Z raasch
    158 ! allow 100 spectra levels instead of 10 for consistency with
    159 ! define_netcdf_header,
    160 ! bugfix in the output of the characteristic levels of potential temperature,
    161 ! geostrophic wind, scalar concentration, humidity and leaf area density,
    162 ! output of turbulence recycling informations
    163 !
    164 ! 138 2007-11-28 10:03:58Z letzel
    165 ! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
    166 ! Allow two instead of one digit to specify isosurface and slicer variables.
    167 ! Output of sorting frequency of particles
    168 !
    169 ! 108 2007-08-24 15:10:38Z letzel
    170 ! Output of informations for coupled model runs (boundary conditions etc.)
    171 ! + output of momentumfluxes at the top boundary
    172 ! Rayleigh damping for ocean, e_init
    173 !
    174 ! 97 2007-06-21 08:23:15Z raasch
    175 ! Adjustments for the ocean version.
    176 ! use_pt_reference renamed use_reference
    177 !
    178 ! 87 2007-05-22 15:46:47Z raasch
    179 ! Bugfix: output of use_upstream_for_tke
    180 !
    181 ! 82 2007-04-16 15:40:52Z raasch
    182 ! Preprocessor strings for different linux clusters changed to "lc",
    183 ! routine local_flush is used for buffer flushing
    184 !
    185 ! 76 2007-03-29 00:58:32Z raasch
    186 ! Output of netcdf_64bit_3d, particles-package is now part of the default code,
    187 ! output of the loop optimization method, moisture renamed humidity,
    188 ! output of subversion revision number
    189 !
    190 ! 19 2007-02-23 04:53:48Z raasch
    191 ! Output of scalar flux applied at top boundary
    192 !
    193 ! RCS Log replace by Id keyword, revision history cleaned up
    194 !
    195 ! Revision 1.63  2006/08/22 13:53:13  raasch
    196 ! Output of dz_max
    197116!
    198117! Revision 1.1  1997/08/11 06:17:20  raasch
    … …  
    209128!-----------------------------------------------------------------------------!
    210129
    211     USE arrays_3d
     130    USE arrays_3d,                                                             &
     131        ONLY:  lad, pt_init, qsws, q_init, sa_init, shf, ug, vg, w_subs, zu
     132       
    212133    USE control_parameters
    213     USE cloud_parameters
    214     USE cpulog
    215     USE dvrp_variables
    216     USE grid_variables
    217     USE indices
    218     USE model_1d
    219     USE particle_attributes
     134       
     135    USE cloud_parameters,                                                      &
     136        ONLY:  cp, curvature_solution_effects, c_sedimentation,                &
     137               limiter_sedimentation, l_v, nc_const, r_d, ventilation_effect
     138       
     139    USE cpulog,                                                                &
     140        ONLY:  log_point_s
     141       
     142    USE dvrp_variables,                                                        &
     143        ONLY:  use_seperate_pe_for_dvrp_output
     144       
     145    USE grid_variables,                                                        &
     146        ONLY:  dx, dy
     147       
     148    USE indices,                                                               &
     149        ONLY:  mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg,      &
     150               nys_mg, nzt, nzt_mg
     151       
     152    USE kinds
     153   
     154    USE model_1d,                                                              &
     155        ONLY:  damp_level_ind_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
     156       
     157    USE particle_attributes,                                                   &
     158        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,     &
     159               density_ratio, dissipation_classes, dt_min_part, dt_prel,       &
     160               dt_sort_particles, dt_write_particle_data, end_time_prel,       &
     161               maximum_number_of_tailpoints, maximum_tailpoint_age,            &
     162               minimum_tailpoint_distance, number_of_particle_groups,          &
     163               particle_advection, particle_advection_start,                   &
     164               particles_per_point, pdx, pdy, pdz,  psb, psl, psn, psr, pss,   &
     165               pst, radius, radius_classes, random_start_position,             &
     166               total_number_of_particles, use_particle_tails,                  &
     167               use_sgs_for_particles, total_number_of_tails,                   &
     168               vertical_particle_advection, write_particle_statistics
     169       
    220170    USE pegrid
    221     USE subsidence_mod
    222     USE spectrum
    223171
    224172    IMPLICIT NONE
    225173
    226     CHARACTER (LEN=1)  ::  prec
    227     CHARACTER (LEN=2)  ::  do2d_mode
    228     CHARACTER (LEN=5)  ::  section_chr
    229     CHARACTER (LEN=10) ::  coor_chr, host_chr
    230     CHARACTER (LEN=16) ::  begin_chr
    231     CHARACTER (LEN=26) ::  ver_rev
    232     CHARACTER (LEN=40) ::  output_format
    233     CHARACTER (LEN=70) ::  char1, char2, dopr_chr, &
    234                            do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
    235                            domask_chr, run_classification
    236     CHARACTER (LEN=86) ::  coordinates, gradients, learde, slices,  &
    237                            temperatures, ugcomponent, vgcomponent
    238     CHARACTER (LEN=85) ::  roben, runten
    239 
    240     CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)
    241 
    242     INTEGER ::  av, bh, blx, bly, bxl, bxr, byn, bys, ch, count, cwx, cwy,  &
    243                 cxl, cxr, cyn, cys, dim, i, io, j, l, ll, mpi_type
    244     REAL    ::  cpuseconds_per_simulated_second
     174    CHARACTER (LEN=1)  ::  prec                !:
     175   
     176    CHARACTER (LEN=2)  ::  do2d_mode           !:
     177   
     178    CHARACTER (LEN=5)  ::  section_chr         !:
     179   
     180    CHARACTER (LEN=10) ::  coor_chr            !:
     181    CHARACTER (LEN=10) ::  host_chr            !:
     182   
     183    CHARACTER (LEN=16) ::  begin_chr           !:
     184   
     185    CHARACTER (LEN=26) ::  ver_rev             !:
     186   
     187    CHARACTER (LEN=40) ::  output_format       !:
     188   
     189    CHARACTER (LEN=70) ::  char1               !:
     190    CHARACTER (LEN=70) ::  char2               !:
     191    CHARACTER (LEN=70) ::  dopr_chr            !:
     192    CHARACTER (LEN=70) ::  do2d_xy             !:
     193    CHARACTER (LEN=70) ::  do2d_xz             !:
     194    CHARACTER (LEN=70) ::  do2d_yz             !:
     195    CHARACTER (LEN=70) ::  do3d_chr            !:
     196    CHARACTER (LEN=70) ::  domask_chr          !:
     197    CHARACTER (LEN=70) ::  run_classification  !:
     198   
     199    CHARACTER (LEN=85) ::  roben               !:
     200    CHARACTER (LEN=85) ::  runten              !:
     201   
     202    CHARACTER (LEN=86) ::  coordinates         !:
     203    CHARACTER (LEN=86) ::  gradients           !:
     204    CHARACTER (LEN=86) ::  learde              !:
     205    CHARACTER (LEN=86) ::  slices              !:
     206    CHARACTER (LEN=86) ::  temperatures        !:
     207    CHARACTER (LEN=86) ::  ugcomponent         !:
     208    CHARACTER (LEN=86) ::  vgcomponent         !:
     209
     210    CHARACTER (LEN=1), DIMENSION(1:3) ::  dir = (/ 'x', 'y', 'z' /)  !:
     211
     212    INTEGER(iwp) ::  av        !:
     213    INTEGER(iwp) ::  bh        !:
     214    INTEGER(iwp) ::  blx       !:
     215    INTEGER(iwp) ::  bly       !:
     216    INTEGER(iwp) ::  bxl       !:
     217    INTEGER(iwp) ::  bxr       !:
     218    INTEGER(iwp) ::  byn       !:
     219    INTEGER(iwp) ::  bys       !:
     220    INTEGER(iwp) ::  ch        !:
     221    INTEGER(iwp) ::  count     !:
     222    INTEGER(iwp) ::  cwx       !:
     223    INTEGER(iwp) ::  cwy       !:
     224    INTEGER(iwp) ::  cxl       !:
     225    INTEGER(iwp) ::  cxr       !:
     226    INTEGER(iwp) ::  cyn       !:
     227    INTEGER(iwp) ::  cys       !:
     228    INTEGER(iwp) ::  dim       !:
     229    INTEGER(iwp) ::  i         !:
     230    INTEGER(iwp) ::  io        !:
     231    INTEGER(iwp) ::  j         !:
     232    INTEGER(iwp) ::  l         !:
     233    INTEGER(iwp) ::  ll        !:
     234    INTEGER(iwp) ::  mpi_type  !:
     235   
     236    REAL(wp) ::  cpuseconds_per_simulated_second  !:
    245237
    246238!

  • palm/trunk/SOURCE/impact_of_latent_heat.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:
    … …  
    2834! 1036 2012-10-22 13:43:42Z raasch
    2935! code put under GPL (PALM 3.9)
    30 !
    31 ! 72 2007-03-19 08:20:46Z
    32 ! precipitation_rate renamed dqdt_precip
    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.5  2004/01/30 10:25:59  raasch
    40 ! Scalar lower k index nzb replaced by 2d-array nzb_2d
    4136!
    4237! Revision 1.1  2000/04/13 14:48:40  schroeter
    … …  
    6661    SUBROUTINE impact_of_latent_heat
    6762
    68        USE arrays_3d
    69        USE cloud_parameters
    70        USE constants
    71        USE indices
     63       USE arrays_3d,                                                          &
     64           ONLY:  ql, tend
     65           
     66       USE cloud_parameters,                                                   &
     67           ONLY:  l_d_cp, prec_time_const, pt_d_t, ql_crit
     68           
     69       USE indices,                                                            &
     70           ONLY:  nxl, nxr, nyn, nys, nzb_2d, nzt
     71           
     72       USE kinds
    7273
    7374       IMPLICIT NONE
    7475
    75        INTEGER ::  i, j, k
    76        REAL    ::  dqdt_precip
     76       INTEGER(iwp) ::  i  !:
     77       INTEGER(iwp) ::  j  !:
     78       INTEGER(iwp) ::  k  !:
     79       
     80       REAL(wp) ::  dqdt_precip  !:
    7781
    7882 
    … …  
    100104    SUBROUTINE impact_of_latent_heat_ij( i, j )
    101105
    102        USE arrays_3d
    103        USE cloud_parameters
    104        USE constants
    105        USE indices
     106       USE arrays_3d,                                                          &
     107           ONLY:  ql, tend
     108           
     109       USE cloud_parameters,                                                   &
     110           ONLY:  l_d_cp, prec_time_const, pt_d_t, ql_crit
     111           
     112       USE indices,                                                            &
     113           ONLY:  nzb_2d, nzt
     114           
     115       USE kinds                                                               
    106116   
    107117       IMPLICIT NONE
    108118
    109        INTEGER ::  i, j, k
    110        REAL    ::  dqdt_precip
     119       INTEGER(iwp) ::  i  !:
     120       INTEGER(iwp) ::  j  !:
     121       INTEGER(iwp) ::  k  !:
     122       
     123       REAL(wp) ::  dqdt_precip  !:
    111124
    112125

  • palm/trunk/SOURCE/inflow_turbulence.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! 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
     29!
     30! module interfaces removed
    2331!
    2432! Former revisions:
    … …  
    2634! $Id$
    2735!
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    30 !
    3136! 1092 2013-02-02 11:24:22Z raasch
    3237! unused variables removed
    … …  
    3439! 1036 2012-10-22 13:43:42Z raasch
    3540! code put under GPL (PALM 3.9)
    36 !
    37 ! 709 2011-03-30 09:31:40Z raasch
    38 ! formatting adjustments
    39 !
    40 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    41 ! Using nbgp recycling planes for a better resolution of the turbulent flow
    42 ! near the inflow.
    43 !
    44 ! 622 2010-12-10 08:08:13Z raasch
    45 ! optional barriers included in order to speed up collective operations
    46 !
    47 ! 222 2009-01-12 16:04:16Z letzel
    48 ! Bugfix for nonparallel execution
    4941!
    5042! Initial version (2008/03/07)
    … …  
    5648!------------------------------------------------------------------------------!
    5749
    58     USE arrays_3d
    59     USE control_parameters
    60     USE cpulog
    61     USE grid_variables
    62     USE indices
     50    USE arrays_3d,                                                             &
     51        ONLY:  e, inflow_damping_factor, mean_inflow_profiles, pt, u, v, w
     52       
     53    USE control_parameters,                                                    &
     54        ONLY:  recycling_plane
     55       
     56    USE cpulog,                                                                &
     57        ONLY:  cpu_log, log_point
     58       
     59    USE grid_variables,                                                        &
     60        ONLY: 
     61       
     62    USE indices,                                                               &
     63        ONLY:  nbgp, nxl, ny, nyn, nys, nyng, nysg, nzb, nzt
     64       
     65    USE kinds
     66   
    6367    USE pegrid
    6468
    … …  
    6670    IMPLICIT NONE
    6771
    68     INTEGER ::  i, j, k, l, ngp_ifd, ngp_pr
    69 
    70     REAL, DIMENSION(nzb:nzt+1,5,nbgp) ::  avpr, avpr_l
    71     REAL, DIMENSION(nzb:nzt+1,nysg:nyng,5,nbgp) ::  inflow_dist
     72    INTEGER(iwp) ::  i        !:
     73    INTEGER(iwp) ::  j        !:
     74    INTEGER(iwp) ::  k        !:
     75    INTEGER(iwp) ::  l        !:
     76    INTEGER(iwp) ::  ngp_ifd  !:
     77    INTEGER(iwp) ::  ngp_pr   !:
     78
     79    REAL(wp), DIMENSION(nzb:nzt+1,5,nbgp)           ::                         &
     80       avpr, avpr_l  !:
     81    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,5,nbgp) ::                         &
     82       inflow_dist   !:
    7283
    7384    CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' )

  • palm/trunk/SOURCE/init_1d_model.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:
    … …  
    4147! 978 2012-08-09 08:28:32Z fricke
    4248! roughness length for scalar quantities z0h1d added
    43 !
    44 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    45 ! replaced mirror boundary conditions for u and v  at the ground
    46 ! by dirichlet boundary conditions
    47 !
    48 ! 254 2009-03-05 15:33:42Z heinze
    49 ! Output of messages replaced by message handling routine.
    50 !
    51 ! 184 2008-08-04 15:53:39Z letzel
    52 ! provisional solution for run_control_1d output: add 'CALL check_open( 15 )'
    53 !
    54 ! 135 2007-11-22 12:24:23Z raasch
    55 ! Bugfix: absolute value of f must be used when calculating the Blackadar
    56 ! mixing length
    57 !
    58 ! 82 2007-04-16 15:40:52Z raasch
    59 ! Preprocessor strings for different linux clusters changed to "lc",
    60 ! routine local_flush is used for buffer flushing
    61 !
    62 ! 75 2007-03-22 09:54:05Z raasch
    63 ! Bugfix: preset of tendencies te_em, te_um, te_vm,
    64 ! moisture renamed humidity
    65 !
    66 ! RCS Log replace by Id keyword, revision history cleaned up
    67 !
    68 ! Revision 1.21  2006/06/02 15:19:57  raasch
    69 ! cpp-directives extended for lctit
    7049!
    7150! Revision 1.1  1998/03/09 16:22:10  raasch
    … …  
    8160!------------------------------------------------------------------------------!
    8261
    83     USE arrays_3d
    84     USE indices
    85     USE model_1d
    86     USE control_parameters
     62    USE arrays_3d,                                                             &
     63        ONLY:  l_grid, ug, u_init, vg, v_init, zu
     64   
     65    USE indices,                                                               &
     66        ONLY:  nzb, nzt
     67   
     68    USE kinds
     69   
     70    USE model_1d,                                                              &
     71        ONLY:  e1d, e1d_p, kh1d, km1d, l1d, l_black, qs1d, rif1d,              &
     72               simulated_time_1d, te_e, te_em, te_u, te_um, te_v, te_vm, ts1d, &
     73               u1d, u1d_p, us1d, usws1d, v1d, v1d_p, vsws1d, z01d, z0h1d
     74   
     75    USE control_parameters,                                                    &
     76        ONLY:  constant_diffusion, f, humidity, kappa, km_constant,            &
     77               mixing_length_1d, passive_scalar, prandtl_layer,                &
     78               prandtl_number, roughness_length, simulated_time_chr,           &
     79               z0h_factor
    8780
    8881    IMPLICIT NONE
    8982
    90     CHARACTER (LEN=9) ::  time_to_string
    91     INTEGER ::  k
    92     REAL    ::  lambda
     83    CHARACTER (LEN=9) ::  time_to_string  !:
     84   
     85    INTEGER(iwp) ::  k  !:
     86   
     87    REAL(wp) ::  lambda !:
    9388
    9489!
    9590!-- Allocate required 1D-arrays
    96     ALLOCATE( e1d(nzb:nzt+1),    e1d_p(nzb:nzt+1), &
    97               kh1d(nzb:nzt+1),   km1d(nzb:nzt+1),  &
    98               l_black(nzb:nzt+1), l1d(nzb:nzt+1),   &
    99               rif1d(nzb:nzt+1),   te_e(nzb:nzt+1),  &
    100               te_em(nzb:nzt+1),  te_u(nzb:nzt+1),    te_um(nzb:nzt+1), &
    101               te_v(nzb:nzt+1),   te_vm(nzb:nzt+1),    u1d(nzb:nzt+1),   &
    102               u1d_p(nzb:nzt+1),  v1d(nzb:nzt+1),   &
     91    ALLOCATE( e1d(nzb:nzt+1),    e1d_p(nzb:nzt+1),                             &
     92              kh1d(nzb:nzt+1),   km1d(nzb:nzt+1),                              &
     93              l_black(nzb:nzt+1), l1d(nzb:nzt+1),                              &
     94              rif1d(nzb:nzt+1),   te_e(nzb:nzt+1),                             &
     95              te_em(nzb:nzt+1),  te_u(nzb:nzt+1),    te_um(nzb:nzt+1),         &
     96              te_v(nzb:nzt+1),   te_vm(nzb:nzt+1),    u1d(nzb:nzt+1),          &
     97              u1d_p(nzb:nzt+1),  v1d(nzb:nzt+1),                               &
    10398              v1d_p(nzb:nzt+1) )
    10499
    … …  
    120115!--       Blackadar mixing length
    121116          IF ( f /= 0.0 )  THEN
    122              lambda = 2.7E-4 * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / &
     117             lambda = 2.7E-4 * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) /           &
    123118                               ABS( f ) + 1E-10
    124119          ELSE
    … …  
    197192!------------------------------------------------------------------------------!
    198193
    199     USE arrays_3d
    200     USE control_parameters
    201     USE indices
    202     USE model_1d
     194    USE arrays_3d,                                                             &
     195        ONLY:  dd2zu, ddzu, ddzw, l_grid, pt_init, q_init, ug, vg, zu
     196       
     197    USE control_parameters,                                                    &
     198        ONLY:  constant_diffusion, dissipation_1d, humidity,                   &
     199               intermediate_timestep_count, intermediate_timestep_count_max,   &
     200               f, g, ibc_e_b, kappa, mixing_length_1d, passive_scalar,         &
     201               prandtl_layer, rif_max, rif_min, simulated_time_chr,            &
     202               timestep_scheme, tsc
     203               
     204    USE indices,                                                               &
     205        ONLY:  nzb, nzb_diff, nzt
     206       
     207    USE kinds
     208   
     209    USE model_1d,                                                              &
     210        ONLY:  current_timestep_number_1d, damp_level_ind_1d, dt_1d,           &
     211               dt_pr_1d, dt_run_control_1d, e1d, e1d_p, end_time_1d,           &
     212               kh1d, km1d, l1d, l_black, qs1d, rif1d, simulated_time_1d,       &
     213               stop_dt_1d, te_e, te_em, te_u, te_um, te_v, te_vm, time_pr_1d,  &
     214               ts1d, time_run_control_1d, u1d, u1d_p, us1d, usws1d, v1d,       &
     215               v1d_p, vsws1d, z01d, z0h1d
     216       
    203217    USE pegrid
    204218
    205219    IMPLICIT NONE
    206220
    207     CHARACTER (LEN=9) ::  time_to_string
    208     INTEGER ::  k
    209     REAL    ::  a, b, dissipation, dpt_dz, flux, kmzm, kmzp, l_stable, pt_0, &
    210                 uv_total
     221    CHARACTER (LEN=9) ::  time_to_string  !:
     222   
     223    INTEGER(iwp) ::  k  !:
     224   
     225    REAL(wp) ::  a            !:
     226    REAL(wp) ::  b            !:
     227    REAL(wp) ::  dissipation  !:
     228    REAL(wp) ::  dpt_dz       !:
     229    REAL(wp) ::  flux         !:
     230    REAL(wp) ::  kmzm         !:
     231    REAL(wp) ::  kmzp         !:
     232    REAL(wp) ::  l_stable     !:
     233    REAL(wp) ::  pt_0         !:
     234    REAL(wp) ::  uv_total     !:
    211235
    212236!
    … …  
    704728!------------------------------------------------------------------------------!
    705729
    706     USE constants
    707     USE indices
    708     USE model_1d
     730    USE constants,                                                             &
     731        ONLY:  pi
     732       
     733    USE indices,                                                               &
     734        ONLY:  nzb, nzt
     735       
     736    USE kinds
     737   
     738    USE model_1d,                                                              &
     739        ONLY:  current_timestep_number_1d, dt_1d, run_control_header_1d, u1d,  &
     740               us1d, v1d
     741   
    709742    USE pegrid
    710     USE control_parameters
     743   
     744    USE control_parameters,                                                    &
     745        ONLY:  simulated_time_chr
    711746
    712747    IMPLICIT NONE
    713748
    714     INTEGER ::  k
    715     REAL    ::  alpha, energy, umax, uv_total, vmax
     749    INTEGER(iwp) ::  k  !:
     750   
     751    REAL(wp) ::  alpha
     752    REAL(wp) ::  energy
     753    REAL(wp) ::  umax
     754    REAL(wp) ::  uv_total
     755    REAL(wp) ::  vmax
    716756
    717757!
    … …  
    775815!------------------------------------------------------------------------------!
    776816
    777     USE arrays_3d
    778     USE indices
    779     USE model_1d
     817    USE arrays_3d,                                                             &
     818        ONLY:  dzu, zu
     819       
     820    USE indices,                                                               &
     821        ONLY:  nzb, nzt
     822   
     823    USE kinds
     824   
     825    USE model_1d,                                                              &
     826        ONLY:  dt_1d, dt_max_1d, km1d, old_dt_1d, stop_dt_1d
     827   
    780828    USE pegrid
    781     USE control_parameters
     829   
     830    USE control_parameters,                                                              &
     831        ONLY:  message_string
    782832
    783833    IMPLICIT NONE
    784834
    785     INTEGER ::  k
    786     REAL    ::  div, dt_diff, fac, value
     835    INTEGER(iwp) ::  k !:
     836   
     837    REAL(wp) ::  div      !:
     838    REAL(wp) ::  dt_diff  !:
     839    REAL(wp) ::  fac      !:
     840    REAL(wp) ::  value    !:
    787841
    788842
    … …  
    834888!------------------------------------------------------------------------------!
    835889
    836     USE arrays_3d
    837     USE indices
    838     USE model_1d
     890    USE arrays_3d,                                                             &
     891        ONLY:  pt_init, zu
     892       
     893    USE indices,                                                               &
     894        ONLY:  nzb, nzt
     895       
     896    USE kinds
     897   
     898    USE model_1d,                                                              &
     899        ONLY:  e1d, kh1d, km1d, l1d, rif1d, u1d, v1d
     900   
    839901    USE pegrid
    840     USE control_parameters
     902   
     903    USE control_parameters,                                                    &
     904        ONLY:  run_description_header, simulated_time_chr
    841905
    842906    IMPLICIT NONE
    843907
    844908
    845     INTEGER ::  k
     909    INTEGER(iwp) ::  k  !:
    846910
    847911

  • palm/trunk/SOURCE/init_3d_model.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! 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
     29!
     30! module interfaces removed
    2331!
    2432! Former revisions:
    2533! -----------------
    2634! $Id$
    27 !
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    3035!
    3136! 1316 2014-03-17 07:44:59Z heinze
    … …  
    122127! 825 2012-02-19 03:03:44Z raasch
    123128! wang_collision_kernel renamed wang_kernel
    124 !
    125 ! 790 2011-11-29 03:11:20Z raasch
    126 ! diss is also allocated in case that the Wang kernel is used
    127 !
    128 ! 787 2011-11-28 12:49:05Z heinze $
    129 ! bugfix: call init_advec in every case - not only for inital runs
    130 !
    131 ! 785 2011-11-28 09:47:19Z raasch
    132 ! initialization of rdf_sc
    133 !
    134 ! 767 2011-10-14 06:39:12Z raasch
    135 ! adjustments concerning implementation of prescribed u,v-profiles
    136 ! bugfix: dirichlet_0 conditions for ug/vg moved to check_parameters
    137 !
    138 ! 759 2011-09-15 13:58:31Z raasch
    139 ! Splitting of parallel I/O in blocks of PEs
    140 ! Bugfix: No zero assignments to volume_flow_initial and volume_flow_area in
    141 ! case of normal restart runs.
    142 !
    143 ! 713 2011-03-30 14:21:21Z suehring
    144 ! weight_substep and weight_pres are given as fractions.
    145 !
    146 ! 709 2011-03-30 09:31:40Z raasch
    147 ! formatting adjustments
    148 !
    149 ! 707 2011-03-29 11:39:40Z raasch
    150 ! p_sub renamed p_loc and allocated depending on the chosen pressure solver,
    151 ! initial assignments of zero to array p for iterative solvers only,
    152 ! bc_lr/ns replaced by bc_lr/ns_dirrad/raddir
    153 !
    154 ! 680 2011-02-04 23:16:06Z gryschka
    155 ! bugfix: volume_flow_control
    156 !
    157 ! 673 2011-01-18 16:19:48Z suehring
    158 ! weight_substep (moved from advec_ws) and weight_pres added.
    159 ! Allocate p_sub when using Multigrid or SOR solver.
    160 ! Call of ws_init moved behind the if requests.
    161 !
    162 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    163 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
    164 ! allocation of arrays. Calls of exchange_horiz are modified.
    165 ! Call ws_init to initialize arrays needed for calculating statisticas and for
    166 ! optimization when ws-scheme is used.
    167 ! Initial volume flow is now calculated by using the variable hom_sum.
    168 ! Therefore the correction of initial volume flow for non-flat topography
    169 ! removed (removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc)
    170 ! Changed surface boundary conditions for u and v in case of ibc_uv_b == 0 from
    171 ! mirror to Dirichlet boundary conditions (u=v=0), so that k=nzb is
    172 ! representative for the height z0.
    173 ! Bugfix: type conversion of '1' to 64bit for the MAX function (ngp_3d_inner)
    174 !
    175 ! 622 2010-12-10 08:08:13Z raasch
    176 ! optional barriers included in order to speed up collective operations
    177 !
    178 ! 560 2010-09-09 10:06:09Z weinreis
    179 ! bugfix: correction of calculating ngp_3d for 64 bit
    180 !
    181 ! 485 2010-02-05 10:57:51Z raasch
    182 ! calculation of ngp_3d + ngp_3d_inner changed because they have now 64 bit
    183 !
    184 ! 407 2009-12-01 15:01:15Z maronga
    185 ! var_ts is replaced by dots_max
    186 ! Enabled passive scalar/humidity wall fluxes for non-flat topography
    187 !
    188 ! 388 2009-09-23 09:40:33Z raasch
    189 ! Initialization of prho added.
    190 ! bugfix: correction of initial volume flow for non-flat topography
    191 ! bugfix: zero initialization of arrays within buildings for 'cyclic_fill'
    192 ! bugfix: avoid that ngp_2dh_s_inner becomes zero
    193 ! initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
    194 ! independent of turbulent_inflow
    195 ! Output of messages replaced by message handling routine.
    196 ! Set the starting level and the vertical smoothing factor used for
    197 ! the external pressure gradient
    198 ! +conserve_volume_flow_mode: 'default', 'initial_profiles', 'inflow_profile'
    199 ! and 'bulk_velocity'
    200 ! If the inversion height calculated by the prerun is zero,
    201 ! inflow_damping_height must be explicitly specified.
    202 !
    203 ! 181 2008-07-30 07:07:47Z raasch
    204 ! bugfix: zero assignments to tendency arrays in case of restarts,
    205 ! further extensions and modifications in the initialisation of the plant
    206 ! canopy model,
    207 ! allocation of hom_sum moved to parin, initialization of spectrum_x|y directly
    208 ! after allocating theses arrays,
    209 ! read data for recycling added as new initialization option,
    210 ! dummy allocation for diss
    211 !
    212 ! 138 2007-11-28 10:03:58Z letzel
    213 ! New counter ngp_2dh_s_inner.
    214 ! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
    215 ! Corrected calculation of initial volume flow for 'set_1d-model_profiles' and
    216 ! 'set_constant_profiles' in case of buildings in the reference cross-sections.
    217 !
    218 ! 108 2007-08-24 15:10:38Z letzel
    219 ! Flux initialization in case of coupled runs, +momentum fluxes at top boundary,
    220 ! +arrays for phase speed c_u, c_v, c_w, indices for u|v|w_m_l|r changed
    221 ! +qswst_remote in case of atmosphere model with humidity coupled to ocean
    222 ! Rayleigh damping for ocean, optionally calculate km and kh from initial
    223 ! TKE e_init
    224 !
    225 ! 97 2007-06-21 08:23:15Z raasch
    226 ! Initialization of salinity, call of init_ocean
    227 !
    228 ! 87 2007-05-22 15:46:47Z raasch
    229 ! var_hom and var_sum renamed pr_palm
    230 !
    231 ! 75 2007-03-22 09:54:05Z raasch
    232 ! Arrays for radiation boundary conditions are allocated (u_m_l, u_m_r, etc.),
    233 ! bugfix for cases with the outflow damping layer extending over more than one
    234 ! subdomain, moisture renamed humidity,
    235 ! new initializing action "by_user" calls user_init_3d_model,
    236 ! precipitation_amount/rate, ts_value are allocated, +module netcdf_control,
    237 ! initial velocities at nzb+1 are regarded for volume
    238 ! flow control in case they have been set zero before (to avoid small timesteps)
    239 ! -uvmean_outflow, uxrp, vynp eliminated
    240 !
    241 ! 19 2007-02-23 04:53:48Z raasch
    242 ! +handling of top fluxes
    243 !
    244 ! RCS Log replace by Id keyword, revision history cleaned up
    245 !
    246 ! Revision 1.49  2006/08/22 15:59:07  raasch
    247 ! No optimization of this file on the ibmy (Yonsei Univ.)
    248129!
    249130! Revision 1.1  1998/03/09 16:22:22  raasch
    … …  
    262143
    263144    USE advec_ws
     145
    264146    USE arrays_3d
    265     USE averaging
    266     USE cloud_parameters
    267     USE constants
     147   
     148    USE cloud_parameters,                                                      &
     149        ONLY:  nc_const, precipitation_amount, precipitation_rate, prr
     150   
     151    USE constants,                                                             &
     152        ONLY:  pi
     153   
    268154    USE control_parameters
    269     USE cpulog
    270     USE grid_variables
     155   
     156    USE grid_variables,                                                        &
     157        ONLY:  dx, dy
     158   
    271159    USE indices
     160   
     161    USE kinds
     162   
    272163    USE ls_forcing_mod
    273     USE model_1d
     164   
     165    USE model_1d,                                                              &
     166        ONLY:  e1d, kh1d, km1d, l1d, rif1d, u1d, us1d, usws1d, v1d, vsws1d
     167   
    274168    USE netcdf_control
    275     USE particle_attributes
     169   
     170    USE particle_attributes,                                                   &
     171        ONLY:  particle_advection, use_sgs_for_particles, wang_kernel
     172   
    276173    USE pegrid
    277     USE profil_parameter
    278     USE random_function_mod
    279     USE statistics
    280     USE transpose_indices
     174   
     175    USE random_function_mod
     176   
     177    USE statistics,                                                            &
     178        ONLY:  hom, hom_sum, pr_palm, rmask, spectrum_x, spectrum_y,           &
     179               statistic_regions, sums, sums_divnew_l, sums_divold_l, sums_l,  &
     180               sums_l_l, sums_up_fraction_l, sums_wsts_bc_l, ts_value,         &
     181               weight_pres, weight_substep
     182   
     183    USE transpose_indices
    281184
    282185    IMPLICIT NONE
    283186
    284     INTEGER ::  i, ind_array(1), j, k, sr
    285 
    286     INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_2dh_l
    287 
    288     INTEGER, DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_outer_l,  &
    289                                              ngp_2dh_s_inner_l
    290 
    291     REAL, DIMENSION(1:2) ::  volume_flow_area_l, volume_flow_initial_l
    292 
    293     REAL, DIMENSION(:), ALLOCATABLE ::  ngp_3d_inner_l, ngp_3d_inner_tmp
     187    INTEGER(iwp) ::  i             !:
     188    INTEGER(iwp) ::  ind_array(1)  !:
     189    INTEGER(iwp) ::  j             !:
     190    INTEGER(iwp) ::  k             !:
     191    INTEGER(iwp) ::  sr            !:
     192
     193    INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::  ngp_2dh_l  !:
     194
     195    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_outer_l    !:
     196    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  ngp_2dh_s_inner_l  !:
     197
     198    REAL(wp), DIMENSION(1:2) ::  volume_flow_area_l     !:
     199    REAL(wp), DIMENSION(1:2) ::  volume_flow_initial_l  !:
     200
     201    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ngp_3d_inner_l    !:
     202    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ngp_3d_inner_tmp  !:
    294203
    295204

  • palm/trunk/SOURCE/init_advec.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:
    … …  
    3541! all actions concerning upstream-spline-method removed
    3642!
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.6  2004/04/30 11:59:31  raasch
    40 ! impulse_advec renamed momentum_advec
    41 !
    4243! Revision 1.1  1999/02/05 09:07:38  raasch
    4344! Initial revision
    … …  
    4950!------------------------------------------------------------------------------!
    5051
    51     USE advection
    52     USE arrays_3d
    53     USE indices
    54     USE control_parameters
     52    USE advection,                                                             &
     53        ONLY:  aex, bex, dex, eex
     54       
     55    USE kinds
     56   
     57    USE control_parameters,                                                    &
     58        ONLY:  scalar_advec
    5559
    5660    IMPLICIT NONE
    5761
    58     INTEGER :: i, intervals, j
    59     REAL    :: delt, dn, dnneu, ex1, ex2, ex3, ex4, ex5, ex6, sterm
     62    INTEGER(iwp) ::  i          !:
     63    INTEGER(iwp) ::  intervals  !:
     64    INTEGER(iwp) ::  j          !:
     65   
     66    REAL(wp) :: delt   !:
     67    REAL(wp) :: dn     !:
     68    REAL(wp) :: dnneu  !:
     69    REAL(wp) :: ex1    !:
     70    REAL(wp) :: ex2    !:
     71    REAL(wp) :: ex3    !:
     72    REAL(wp) :: ex4    !:
     73    REAL(wp) :: ex5    !:
     74    REAL(wp) :: ex6    !:
     75    REAL(wp) :: sterm  !:
    6076
    6177

  • palm/trunk/SOURCE/init_cloud_physics.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
     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 mod_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
    2229!
    2330! Former revisions:
    … …  
    4148! calculation of b_cond replaced by calculation of bfactor
    4249!
    43 ! 221 2009-01-12 15:32:23Z raasch
    44 ! Bugfix: abort in case that absolute temperature is below zero
    45 !
    46 ! 95 2007-06-02 16:48:38Z raasch
    47 ! hydro_press renamed hyp
    48 !
    49 ! February 2007
    50 ! RCS Log replace by Id keyword, revision history cleaned up
    51 !
    52 ! Revision 1.5  2005/06/26 19:55:58  raasch
    53 ! Initialization of cloud droplet constants, gas_constant renamed r_d,
    54 ! latent_heat renamed l_v
    55 !
    5650! Revision 1.1  2000/04/13 14:37:22  schroeter
    5751! Initial revision
    … …  
    6357!------------------------------------------------------------------------------!
    6458
    65     USE arrays_3d
    66     USE cloud_parameters
    67     USE constants
    68     USE control_parameters
    69     USE grid_variables
    70     USE indices
     59    USE arrays_3d,                                                             &
     60        ONLY:  dzu, hyp, pt_init, zu
     61       
     62    USE cloud_parameters,                                                      &
     63        ONLY:  bfactor, cp, c_sedimentation, dpirho_l, dt_precipitation,       &
     64               hyrho, l_d_cp, l_d_r, l_d_rv, l_v, mass_of_solute,              &
     65               molecular_weight_of_solute, molecular_weight_of_water, pirho_l, &
     66               pt_d_t, rho_l, r_d, r_v, schmidt, schmidt_p_1d3, t_d_pt,        &
     67               vanthoff, w_precipitation
     68       
     69    USE constants,                                                             &
     70        ONLY:  pi
     71       
     72    USE control_parameters,                                                    &
     73        ONLY:  g, icloud_scheme, message_string, precipitation, pt_surface,    &
     74               rho_surface, surface_pressure
     75   
     76    USE indices,                                                               &
     77        ONLY:  nzb, nzt
     78   
     79    USE kinds
    7180
    7281    IMPLICIT NONE
    7382
    74     INTEGER ::  k
    75     REAL    ::  t_surface
     83    INTEGER(iwp) ::  k      !:
     84   
     85    REAL(wp) ::  t_surface  !:
    7686
    7787    ALLOCATE( hyp(nzb:nzt+1), pt_d_t(nzb:nzt+1), t_d_pt(nzb:nzt+1),  &

  • palm/trunk/SOURCE/init_coupling.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:
    … …  
    2834! 1036 2012-10-22 13:43:42Z raasch
    2935! code put under GPL (PALM 3.9)
    30 !
    31 ! 709 2011-03-30 09:31:40Z raasch
    32 ! formatting adjustments
    33 !
    34 ! 691 2011-03-04 08:45:30Z maronga
    35 ! Bugfix: combine_plot_fields did not work with data_output_2d_on_each_pe = .T.
    36 ! for precursor ocean runs
    37 !
    38 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    39 ! determination of target_id's moved to init_pegrid
    40 !
    41 ! 291 2009-04-16 12:07:26Z raasch
    42 ! Coupling with independent precursor runs.
    4336!
    4437! 222 2009-01-12 16:04:16Z letzel
    … …  
    5144!------------------------------------------------------------------------------!
    5245
     46    USE control_parameters,                                                    &
     47        ONLY:  coupling_char, coupling_mode
     48       
     49    USE kinds
     50   
    5351    USE pegrid
    54     USE control_parameters
    55     USE indices
    5652
    5753    IMPLICIT NONE
    … …  
    5955!
    6056!-- Local variables
    61     INTEGER               ::  i, inter_color
    62     INTEGER, DIMENSION(:) ::  bc_data(0:3) = 0
     57    INTEGER(iwp) ::  i            !:
     58    INTEGER(iwp) ::  inter_color  !:
     59   
     60    INTEGER(iwp), DIMENSION(:) ::  bc_data(0:3) = 0  !:
    6361
    6462!

  • palm/trunk/SOURCE/init_dvrp.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:
    … …  
    2834! 1036 2012-10-22 13:43:42Z raasch
    2935! code put under GPL (PALM 3.9)
    30 !
    31 ! 284 2009-04-06 06:36:10Z raasch
    32 ! Definition of a colortable to be used for particles.
    33 ! Output names are changed: surface=groundplate, buildings=topography
    34 ! Output of messages replaced by message handling routine.
    35 ! Clipping implemented.
    36 ! Polygon reduction for building and ground plate isosurface. Reduction level
    37 ! for buildings can be chosen with parameter cluster_size.
    38 ! Steering, splitting, and rtsp routines not used on nec.
    39 ! ToDo: checking of mode_dvrp for legal values is not correct
    40 ! Implementation of a MPI-1 coupling: __mpi2 adjustments for MPI_COMM_WORLD
    41 !
    42 ! 210 2008-11-06 08:54:02Z raasch
    43 ! DVRP arguments changed to single precision, mode pathlines added
    44 !
    45 ! 155 2008-03-28 10:56:30Z letzel
    46 ! introduce prefix_chr to ensure unique dvrp_file path
    47 !
    48 ! 130 2007-11-13 14:08:40Z letzel
    49 ! allow two instead of one digit to specify isosurface and slicer variables
    50 ! Test output of isosurface on camera file
    51 !
    52 ! 82 2007-04-16 15:40:52Z raasch
    53 ! Preprocessor strings for different linux clusters changed to "lc",
    54 ! routine local_flush is used for buffer flushing
    55 !
    56 ! 17 2007-02-19 01:57:39Z raasch
    57 ! dvrp_output_local activated for all streams
    58 !
    59 ! 13 2007-02-14 12:15:07Z raasch
    60 ! RCS Log replace by Id keyword, revision history cleaned up
    61 !
    62 ! Revision 1.12  2006/02/23 12:30:22  raasch
    63 ! ebene renamed section, pl.. replaced by do..,
    6436!
    6537! Revision 1.1  2000/04/27 06:24:39  raasch
    … …  
    7345#if defined( __dvrp_graphics )
    7446
    75     USE arrays_3d
     47    USE arrays_3d,                                                             &
     48        ONLY:  zu
     49       
    7650    USE DVRP
     51   
    7752    USE dvrp_variables
    78     USE grid_variables
    79     USE indices
     53   
     54    USE grid_variables,                                                        &
     55        ONLY:  dx, dy
     56       
     57    USE indices,                                                               &
     58        ONLY:  nx, nxl, nxr, ny, nyn, nys, nzb, nzb_s_inner
     59       
     60    USE kinds
     61   
    8062    USE pegrid
    81     USE control_parameters
     63   
     64    USE control_parameters,                                                               &
     65        ONLY:  message_string, nz_do3d, run_identifier, topography
    8266
    8367    IMPLICIT NONE
    8468
    85     CHARACTER (LEN=2)  ::  section_chr
    86     CHARACTER (LEN=3)  ::  prefix_chr
    87     CHARACTER (LEN=80) ::  dvrp_file_local
    88     INTEGER ::  cluster_mode, cluster_size_x, cluster_size_y, cluster_size_z, &
    89                 gradient_normals, i, j, k, l, m, nx_dvrp_l, nx_dvrp_r,        &
    90                 ny_dvrp_n, ny_dvrp_s, pn, tv, vn
    91     LOGICAL ::  allocated
    92     REAL(4) ::  center(3), cluster_alpha, distance, tmp_b, tmp_g, tmp_r, &
    93                 tmp_t, tmp_th, tmp_thr, tmp_x1, tmp_x2, tmp_y1, tmp_y2,  &
    94                 tmp_z1, tmp_z2, tmp_1, tmp_2, tmp_3, tmp_4, tmp_5, tmp_6, tmp_7
    95 
    96     REAL(4), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
    97 
    98     TYPE(CSTRING), SAVE ::  dvrp_directory_c, dvrp_file_c, &
    99                             dvrp_file_local_c,dvrp_host_c, &
    100                             dvrp_password_c, dvrp_username_c, name_c
     69    CHARACTER (LEN=2)  ::  section_chr      !:
     70    CHARACTER (LEN=3)  ::  prefix_chr       !:
     71    CHARACTER (LEN=80) ::  dvrp_file_local  !:
     72   
     73    INTEGER(iwp) ::  cluster_mode      !:
     74    INTEGER(iwp) ::  cluster_size_x    !:
     75    INTEGER(iwp) ::  cluster_size_y    !:
     76    INTEGER(iwp) ::  cluster_size_z    !:
     77    INTEGER(iwp) ::  gradient_normals  !:
     78    INTEGER(iwp) ::  i                 !:
     79    INTEGER(iwp) ::  j                 !:
     80    INTEGER(iwp) ::  k                 !:
     81    INTEGER(iwp) ::  l                 !:
     82    INTEGER(iwp) ::  m                 !:
     83    INTEGER(iwp) ::  nx_dvrp_l         !:
     84    INTEGER(iwp) ::  nx_dvrp_r         !:
     85    INTEGER(iwp) ::  ny_dvrp_n         !:
     86    INTEGER(iwp) ::  ny_dvrp_s         !:
     87    INTEGER(iwp) ::  pn                !:
     88    INTEGER(iwp) ::  tv                !:
     89    INTEGER(iwp) ::  vn                !:
     90                     
     91    LOGICAL  ::  allocated  !:
     92   
     93    REAL(sp) ::  center(3)      !:
     94    REAL(sp) ::  cluster_alpha  !:
     95    REAL(sp) ::  distance       !:
     96    REAL(sp) ::  tmp_b          !:
     97    REAL(sp) ::  tmp_g          !:
     98    REAL(sp) ::  tmp_r          !:
     99    REAL(sp) ::  tmp_t          !:
     100    REAL(sp) ::  tmp_th         !:
     101    REAL(sp) ::  tmp_thr        !:
     102    REAL(sp) ::  tmp_x1         !:
     103    REAL(sp) ::  tmp_x2         !:
     104    REAL(sp) ::  tmp_y1         !:
     105    REAL(sp) ::  tmp_y2         !:
     106    REAL(sp) ::  tmp_z1         !:
     107    REAL(sp) ::  tmp_z2         !:
     108    REAL(sp) ::  tmp_1          !:
     109    REAL(sp) ::  tmp_2          !:
     110    REAL(sp) ::  tmp_3          !:
     111    REAL(sp) ::  tmp_4          !:
     112    REAL(sp) ::  tmp_5          !:
     113    REAL(sp) ::  tmp_6          !:
     114    REAL(sp) ::  tmp_7          !:
     115
     116    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf  !:
     117
     118    TYPE(CSTRING), SAVE ::  dvrp_directory_c   !:
     119    TYPE(CSTRING), SAVE ::  dvrp_file_c        !:
     120    TYPE(CSTRING), SAVE ::  dvrp_file_local_c  !:
     121    TYPE(CSTRING), SAVE ::  dvrp_host_c        !:
     122    TYPE(CSTRING), SAVE ::  dvrp_password_c    !:
     123    TYPE(CSTRING), SAVE ::  dvrp_username_c    !:
     124    TYPE(CSTRING), SAVE ::  name_c             !:
    101125
    102126!
    … …  
    718742#if defined( __dvrp_graphics )
    719743
    720     USE control_parameters
    721     USE dvrp_variables
     744    USE dvrp_variables,                                                        &
     745        ONLY:  use_seperate_pe_for_dvrp_output
     746   
     747    USE kinds
     748   
    722749    USE pegrid
    723750
    724751    IMPLICIT NONE
    725752
    726     CHARACTER (LEN=4) ::  chr
    727     INTEGER           ::  idummy
     753    CHARACTER (LEN=4) ::  chr  !:
     754   
     755    INTEGER(iwp) ::  idummy    !:
    728756
    729757!
    … …  
    778806!------------------------------------------------------------------------------!
    779807#if defined( __dvrp_graphics )
    780 
    781     USE control_parameters
    782     USE dvrp
    783     USE dvrp_variables
    784 
    785     INTEGER ::  m
     808                                               
     809    USE DVRP
     810   
     811    USE dvrp_variables,                                                        &
     812        ONLY: use_seperate_pe_for_dvrp_output
     813   
     814    USE kinds
     815
     816    INTEGER(iwp) ::  m  !:
    786817
    787818!

  • palm/trunk/SOURCE/init_grid.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:
    … …  
    8187! New cpp directive "__check" implemented which is used by check_namelist_files
    8288!
    83 ! 759 2011-09-15 13:58:31Z raasch
    84 ! Splitting of parallel I/O in blocks of PEs
    85 !
    86 ! 722 2011-04-11 06:21:09Z raasch
    87 ! Bugfix: bc_lr/ns_cyc replaced by bc_lr/ns, because variables are not yet set
    88 !         here
    89 !
    90 ! 709 2011-03-30 09:31:40Z raasch
    91 ! formatting adjustments
    92 !
    93 ! 707 2011-03-29 11:39:40Z raasch
    94 ! bc_lr/ns replaced by bc_lr/ns_cyc
    95 !
    96 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    97 ! Definition of new array bounds nxlg, nxrg, nysg, nyng on each PE.
    98 ! Furthermore the allocation of arrays and steering of loops is done with these
    99 ! parameters. Call of exchange_horiz are modified.
    100 ! In case of dirichlet bounday condition at the bottom zu(0)=0.0
    101 ! dzu_mg has to be set explicitly for a equally spaced grid near bottom.
    102 ! ddzu_pres added to use a equally spaced grid near bottom.
    103 !
    104 ! 555 2010-09-07 07:32:53Z raasch
    105 ! Bugfix: default setting of nzb_local for flat topography
    106 !
    107 ! 274 2009-03-26 15:11:21Z heinze
    108 ! Output of messages replaced by message handling routine.
    109 ! new topography case 'single_street_canyon'
    110 !
    111 ! 217 2008-12-09 18:00:48Z letzel
    112 ! +topography_grid_convention
    113 !
    114 ! 134 2007-11-21 07:28:38Z letzel
    115 ! Redefine initial nzb_local as the actual total size of topography (later the
    116 ! extent of topography in nzb_local is reduced by 1dx at the E topography walls
    117 ! and by 1dy at the N topography walls to form the basis for nzb_s_inner);
    118 ! for consistency redefine 'single_building' case.
    119 ! Calculation of wall flag arrays
    120 !
    121 ! 94 2007-06-01 15:25:22Z raasch
    122 ! Grid definition for ocean version
    123 !
    124 ! 75 2007-03-22 09:54:05Z raasch
    125 ! storage of topography height arrays zu_s_inner and zw_s_inner,
    126 ! 2nd+3rd argument removed from exchange horiz
    127 !
    128 ! 19 2007-02-23 04:53:48Z raasch
    129 ! Setting of nzt_diff
    130 !
    131 ! RCS Log replace by Id keyword, revision history cleaned up
    132 !
    133 ! Revision 1.17  2006/08/22 14:00:05  raasch
    134 ! +dz_max to limit vertical stretching,
    135 ! bugfix in index array initialization for line- or point-like topography
    136 ! structures
    137 !
    13889! Revision 1.1  1997/08/11 06:17:45  raasch
    13990! Initial revision (Testversion)
    … …  
    14596!------------------------------------------------------------------------------!
    14697
    147     USE arrays_3d
    148     USE control_parameters
    149     USE grid_variables
    150     USE indices
     98    USE arrays_3d,                                                             &
     99        ONLY:  dd2zu, ddzu, ddzu_pres, ddzw, dzu, dzu_mg, dzw, dzw_mg, f1_mg,  &
     100               f2_mg, f3_mg, l_grid, l_wall, zu, zw
     101       
     102    USE control_parameters,                                                             &
     103        ONLY:  bc_lr, bc_ns, building_height, building_length_x,               &
     104               building_length_y, building_wall_left, building_wall_south,     &
     105               canyon_height, canyon_wall_left, canyon_wall_south,             &
     106               canyon_width_x, canyon_width_y, coupling_char, dp_level_ind_b,  &
     107               dz, dz_max, dz_stretch_factor, dz_stretch_level,                &
     108               dz_stretch_level_index, ibc_uv_b, io_blocks, io_group,          &
     109               inflow_l, inflow_n, inflow_r, inflow_s, masking_method,         &
     110               maximum_grid_level, message_string, momentum_advec, ocean,      &
     111               outflow_l, outflow_n, outflow_r, outflow_s, prandtl_layer,      &
     112               psolver, scalar_advec, topography, topography_grid_convention,  &
     113               use_surface_fluxes, use_top_fluxes, wall_adjustment_factor
     114       
     115    USE grid_variables,                                                        &
     116        ONLY:  ddx, ddx2, ddx2_mg, ddy, ddy2, ddy2_mg, dx, dx2, dy, dy2, fwxm, &
     117               fwxp, fwym, fwyp, fxm, fxp, fym, fyp, wall_e_x, wall_e_y,       &
     118               wall_u, wall_v, wall_w_x, wall_w_y, zu_s_inner, zw_w_inner
     119       
     120    USE indices,                                                               &
     121        ONLY:  flags, nbgp, nx, nxl, nxlg, nxlu, nxl_mg, nxr, nxrg, nxr_mg,    &
     122               ny, nyn, nyng, nyn_mg, nys, nysv, nys_mg, nysg, nz, nzb,        &
     123               nzb_2d, nzb_diff, nzb_diff_s_inner, nzb_diff_s_outer,           &
     124               nzb_diff_u, nzb_diff_v, nzb_max, nzb_s_inner, nzb_s_outer,      &
     125               nzb_u_inner, nzb_u_outer, nzb_v_inner, nzb_v_outer,             &
     126               nzb_w_inner, nzb_w_outer, nzt, nzt_diff, nzt_mg, rflags_invers, &
     127               rflags_s_inner, wall_flags_0, wall_flags_00, wall_flags_1,      &
     128               wall_flags_10, wall_flags_2, wall_flags_3,  wall_flags_4,       &
     129               wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,         &
     130               wall_flags_9
     131   
     132    USE kinds
     133   
    151134    USE pegrid
    152135
    153136    IMPLICIT NONE
    154137
    155     INTEGER ::  bh, blx, bly, bxl, bxr, byn, bys, ch, cwx, cwy, cxl, cxr, cyn, &
    156                 cys, gls, i, ii, inc, j, k, l, nxl_l, nxr_l, nyn_l, nys_l,     &
    157                 nzb_si, nzt_l, vi
    158 
    159     INTEGER, DIMENSION(:), ALLOCATABLE   ::  vertical_influence
    160 
    161     INTEGER, DIMENSION(:,:), ALLOCATABLE ::  corner_nl, corner_nr, corner_sl,  &
    162                                              corner_sr, wall_l, wall_n, wall_r,&
    163                                              wall_s, nzb_local, nzb_tmp
    164 
    165     LOGICAL :: flag_set = .FALSE.
    166 
    167     REAL    ::  dx_l, dy_l, dz_stretched
    168 
    169     REAL, DIMENSION(:,:), ALLOCATABLE   ::  topo_height
     138    INTEGER(iwp) ::  bh      !:
     139    INTEGER(iwp) ::  blx     !:
     140    INTEGER(iwp) ::  bly     !:
     141    INTEGER(iwp) ::  bxl     !:
     142    INTEGER(iwp) ::  bxr     !:
     143    INTEGER(iwp) ::  byn     !:
     144    INTEGER(iwp) ::  bys     !:
     145    INTEGER(iwp) ::  ch      !:
     146    INTEGER(iwp) ::  cwx     !:
     147    INTEGER(iwp) ::  cwy     !:
     148    INTEGER(iwp) ::  cxl     !:
     149    INTEGER(iwp) ::  cxr     !:
     150    INTEGER(iwp) ::  cyn     !:
     151    INTEGER(iwp) ::  cys     !:
     152    INTEGER(iwp) ::  gls     !:
     153    INTEGER(iwp) ::  i       !:
     154    INTEGER(iwp) ::  ii      !:
     155    INTEGER(iwp) ::  inc     !:
     156    INTEGER(iwp) ::  j       !:
     157    INTEGER(iwp) ::  k       !:
     158    INTEGER(iwp) ::  l       !:
     159    INTEGER(iwp) ::  nxl_l   !:
     160    INTEGER(iwp) ::  nxr_l   !:
     161    INTEGER(iwp) ::  nyn_l   !:
     162    INTEGER(iwp) ::  nys_l   !:
     163    INTEGER(iwp) ::  nzb_si  !:
     164    INTEGER(iwp) ::  nzt_l   !:
     165    INTEGER(iwp) ::  vi      !:
     166
     167    INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::  vertical_influence  !:
     168
     169    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_nl  !:
     170    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_nr  !:
     171    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_sl  !:
     172    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  corner_sr  !:
     173    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_l     !:
     174    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_n     !:
     175    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_r     !:
     176    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  wall_s     !:
     177    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_local  !:
     178    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_tmp    !:
     179
     180    LOGICAL :: flag_set = .FALSE.  !:
     181
     182    REAL(wp) ::  dx_l          !:
     183    REAL(wp) ::  dy_l          !:
     184    REAL(wp) ::  dz_stretched  !:
     185
     186    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  topo_height  !:
    170187
    171188   

  • palm/trunk/SOURCE/init_masks.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:
    … …  
    5055! 807 2012-01-25 11:53:51Z maronga
    5156! New cpp directive "__check" implemented which is used by check_namelist_files
    52 !
    53 ! 771 2011-10-27 10:56:21Z heinze
    54 ! +lpt
    55 !
    56 ! 595 2010-11-12 09:52:10Z helmke
    57 ! Calculation of z locations for masked output changed
    58 !
    59 ! 564 2010-09-30 13:18:59Z helmke
    60 ! assignment of mask_xyz_loop added, palm message identifiers of masked output
    61 ! changed
    62 !/localdata/raasch.14299
    63 ! 557 2010-09-07 14:50:07Z weinreis
    64 ! bugfix message string in set_mask_locations
    65 !
    66 ! 553 2010-09-01 14:09:06Z weinreis
    67 ! parameters for masked output are replaced by arrays
    68 !
    69 ! 493 2010-03-01 08:30:24Z raasch
    70 ! netcdf_format_mask* and format_parallel_io replaced by netcdf_data_format
    7157!
    7258! 410 2009-12-04 17:05:40Z letzel
    … …  
    7965!------------------------------------------------------------------------------!
    8066
    81     USE arrays_3d
    82     USE control_parameters
    83     USE grid_variables
    84     USE indices
    85     USE netcdf_control
    86     USE particle_attributes
     67    USE arrays_3d,                                                             &
     68        ONLY:  zu, zw
     69
     70    USE control_parameters,                                                    &
     71        ONLY:  constant_diffusion, cloud_droplets, cloud_physics,              &
     72               data_output_masks, data_output_masks_user,                      &
     73               doav, doav_n, domask, domask_no, dz, dz_stretch_level, humidity,&
     74               mask, masks, mask_scale, mask_i,                                &
     75               mask_i_global, mask_j, mask_j_global, mask_k, mask_k_global,    &
     76               mask_loop, mask_size, mask_size_l, mask_start_l, mask_x,        &
     77               mask_x_loop, mask_xyz_dimension, mask_y, mask_y_loop, mask_z,   &
     78               mask_z_loop, max_masks,  message_string, mid,                   &
     79               netcdf_data_format, passive_scalar, ocean
     80
     81    USE grid_variables,                                                        &
     82        ONLY:  dx, dy
     83
     84    USE indices,                                                               &
     85        ONLY:  nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt
     86
     87    USE kinds
     88
     89    USE netcdf_control,                                                        &
     90        ONLY:  domask_unit
     91
     92    USE particle_attributes,                                                   &
     93        ONLY:  particle_advection
     94
    8795    USE pegrid
    8896
    8997    IMPLICIT NONE
    9098
    91     CHARACTER (LEN=6)   ::  var
    92     CHARACTER (LEN=7)   ::  unit
    93     CHARACTER (LEN=10), DIMENSION(max_masks,100) ::  do_mask, do_mask_user
    94 
    95     INTEGER :: i, ilen, ind(6), ind_array(1), j, k, n, sender
    96     INTEGER, DIMENSION(:), ALLOCATABLE ::  tmp_array
    97 
    98     LOGICAL ::  found
     99    CHARACTER (LEN=6) ::  var  !:
     100    CHARACTER (LEN=7) ::  unit !:
     101   
     102    CHARACTER (LEN=10), DIMENSION(max_masks,100) ::  do_mask      !:
     103    CHARACTER (LEN=10), DIMENSION(max_masks,100) ::  do_mask_user !:
     104
     105    INTEGER(iwp) ::  i            !:
     106    INTEGER(iwp) ::  ilen         !:
     107    INTEGER(iwp) ::  ind(6)       !:
     108    INTEGER(iwp) ::  ind_array(1) !:
     109    INTEGER(iwp) ::  j            !:
     110    INTEGER(iwp) ::  k            !:
     111    INTEGER(iwp) ::  n            !:
     112    INTEGER(iwp) ::  sender       !:
     113   
     114    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  tmp_array !:
     115
     116    LOGICAL ::  found !:
    99117!
    100118!-- Allocation and initialization
    … …  
    480498       IMPLICIT NONE
    481499
    482        CHARACTER (LEN=2) :: dxyz_string, nxyz_string
    483        INTEGER  ::  count, count_l, dim, m, loop_begin, loop_end, loop_stride, &
    484                     lb, nxyz, ub
    485        REAL     ::  dxyz, ddxyz, tmp1, tmp2
     500       CHARACTER (LEN=2) ::  dxyz_string !:
     501       CHARACTER (LEN=2) ::  nxyz_string !:
     502       
     503       INTEGER(iwp)  ::  count       !:
     504       INTEGER(iwp)  ::  count_l     !:
     505       INTEGER(iwp)  ::  dim         !:
     506       INTEGER(iwp)  ::  m           !:
     507       INTEGER(iwp)  ::  loop_begin  !:
     508       INTEGER(iwp)  ::  loop_end    !:
     509       INTEGER(iwp)  ::  loop_stride !:
     510       INTEGER(iwp)  ::  lb          !:
     511       INTEGER(iwp)  ::  nxyz        !:
     512       INTEGER(iwp)  ::  ub          !:
     513       
     514       REAL(wp)      ::  dxyz  !:
     515       REAL(wp)      ::  ddxyz !:
     516       REAL(wp)      ::  tmp1  !:
     517       REAL(wp)      ::  tmp2  !:
    486518
    487519       count = 0;  count_l = 0;  ddxyz = 1.0 / dxyz;  tmp1 = 0.0;  tmp2 = 0.0

  • palm/trunk/SOURCE/init_ocean.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:
    … …  
    3237! code put under GPL (PALM 3.9)
    3338!
    34 ! 388 2009-09-23 09:40:33Z raasch
    35 ! Bugfix: Initial profiles of hydrostatic pressure and density are calculated
    36 ! iteratively. First calculation of hyp(0) changed.
    37 !
    38 ! 124 2007-10-19 15:47:46Z raasch
    39 ! Bugfix: Initial density rho is calculated
    40 !
    4139! 97 2007-06-21 08:23:15Z raasch
    4240! Initial revision
    … …  
    4745!------------------------------------------------------------------------------!
    4846
    49     USE arrays_3d
    50     USE control_parameters
    51     USE eqn_state_seawater_mod
    52     USE grid_variables
    53     USE indices
     47    USE arrays_3d,                                                             &
     48        ONLY:  dzu, hyp, pt_init, ref_state, sa_init, zu, zw
     49
     50    USE control_parameters,                                                    &
     51        ONLY:  g, prho_reference, rho_surface, rho_reference,                  &
     52               surface_pressure, use_single_reference_value
     53
     54    USE eqn_state_seawater_mod,                                                &
     55        ONLY:  eqn_state_seawater, eqn_state_seawater_func
     56
     57    USE indices,                                                               &
     58        ONLY:  nzb, nzt
     59
     60    USE kinds
     61
    5462    USE pegrid
    55     USE statistics
     63
     64    USE statistics,                                                            &
     65        ONLY:  hom, statistic_regions
    5666
    5767    IMPLICIT NONE
    5868
    59     INTEGER ::  k, n
     69    INTEGER(iwp) ::  k !:
     70    INTEGER(iwp) ::  n !:
    6071
    61     REAL    ::  sa_l, pt_l
     72    REAL(wp)     ::  pt_l !:
     73    REAL(wp)     ::  sa_l !:
    6274
    63     REAL, DIMENSION(nzb:nzt+1) ::  rho_init
     75    REAL(wp), DIMENSION(nzb:nzt+1) ::  rho_init !:
    6476
    6577    ALLOCATE( hyp(nzb:nzt+1) )
    … …  
    119131
    120132       prho_reference = prho_reference + dzu(k+1) * &
    121                         eqn_state_seawater_func( 0.0, pt_l, sa_l )
     133                        eqn_state_seawater_func( 0.0_wp, pt_l, sa_l )
    122134
    123135    ENDDO

  • palm/trunk/SOURCE/init_pegrid.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:
    … …  
    6974! 807 2012-01-25 11:53:51Z maronga
    7075! New cpp directive "__check" implemented which is used by check_namelist_files
    71 !
    72 ! 780 2011-11-10 07:16:47Z raasch
    73 ! Bugfix for rev 778: Misplaced error message moved to the rigth place
    74 !
    75 ! 778 2011-11-07 14:18:25Z fricke
    76 ! Calculation of subdomain_size now considers the number of ghost points.
    77 ! Further coarsening on PE0 is now possible for multigrid solver if the
    78 ! collected field has more grid points than the subdomain of an PE.
    79 !
    80 ! 759 2011-09-15 13:58:31Z raasch
    81 ! calculation of number of io_blocks and the io_group to which the respective
    82 ! PE belongs
    83 !
    84 ! 755 2011-08-29 09:55:16Z witha
    85 ! 2d-decomposition is default for lcflow (ForWind cluster in Oldenburg)
    86 !
    87 ! 722 2011-04-11 06:21:09Z raasch
    88 ! Bugfix: bc_lr/ns_cyc/dirrad/raddir replaced by bc_lr/ns, because variables
    89 !         are not yet set here; grid_level set to 0
    90 !
    91 ! 709 2011-03-30 09:31:40Z raasch
    92 ! formatting adjustments
    93 !
    94 ! 707 2011-03-29 11:39:40Z raasch
    95 ! bc_lr/ns replaced by bc_lr/ns_cyc/dirrad/raddir
    96 !
    97 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    98 ! Moved determination of target_id's from init_coupling
    99 ! Determination of parameters needed for coupling (coupling_topology, ngp_a,
    100 ! ngp_o) with different grid/processor-topology in ocean and atmosphere
    101 ! Adaption of ngp_xy, ngp_y to a dynamic number of ghost points.
    102 ! The maximum_grid_level changed from 1 to 0. 0 is the normal grid, 1 to
    103 ! maximum_grid_level the grids for multigrid, in which 0 and 1 are normal grids.
    104 ! This distinction is due to reasons of data exchange and performance for the
    105 ! normal grid and grids in poismg.
    106 ! The definition of MPI-Vectors adapted to a dynamic numer of ghost points.
    107 ! New MPI-Vectors for data exchange between left and right boundaries added.
    108 ! This is due to reasons of performance (10% faster).
    109 !
    110 ! 646 2010-12-15 13:03:52Z raasch
    111 ! lctit is now using a 2d decomposition by default
    112 !
    113 ! 622 2010-12-10 08:08:13Z raasch
    114 ! optional barriers included in order to speed up collective operations
    115 !
    116 ! 438 2010-02-01 04:32:43Z raasch
    117 ! 2d-decomposition is default for Cray-XT machines
    118 !
    119 ! 274 2009-03-26 15:11:21Z heinze
    120 ! Output of messages replaced by message handling routine.
    121 !
    122 ! 206 2008-10-13 14:59:11Z raasch
    123 ! Implementation of a MPI-1 coupling: added __parallel within the __mpi2 part
    124 ! 2d-decomposition is default on SGI-ICE systems
    125 !
    126 ! 197 2008-09-16 15:29:03Z raasch
    127 ! multigrid levels are limited by subdomains if mg_switch_to_pe0_level = -1,
    128 ! nz is used instead nnz for calculating mg-levels
    129 ! Collect on PE0 horizontal index bounds from all other PEs,
    130 ! broadcast the id of the inflow PE (using the respective communicator)
    131 !
    132 ! 114 2007-10-10 00:03:15Z raasch
    133 ! Allocation of wall flag arrays for multigrid solver
    134 !
    135 ! 108 2007-08-24 15:10:38Z letzel
    136 ! Intercommunicator (comm_inter) and derived data type (type_xy) for
    137 ! coupled model runs created, assign coupling_mode_remote,
    138 ! indices nxlu and nysv are calculated (needed for non-cyclic boundary
    139 ! conditions)
    140 !
    141 ! 82 2007-04-16 15:40:52Z raasch
    142 ! Cpp-directive lcmuk changed to intel_openmp_bug, setting of host on lcmuk by
    143 ! cpp-directive removed
    144 !
    145 ! 75 2007-03-22 09:54:05Z raasch
    146 ! uxrp, vynp eliminated,
    147 ! dirichlet/neumann changed to dirichlet/radiation, etc.,
    148 ! poisfft_init is only called if fft-solver is switched on
    149 !
    150 ! RCS Log replace by Id keyword, revision history cleaned up
    151 !
    152 ! Revision 1.28  2006/04/26 13:23:32  raasch
    153 ! lcmuk does not understand the !$ comment so a cpp-directive is required
    15476!
    15577! Revision 1.1  1997/07/24 11:15:09  raasch
    … …  
    16486!------------------------------------------------------------------------------!
    16587
    166     USE control_parameters
    167     USE grid_variables
    168     USE indices
     88    USE control_parameters,                                                    &
     89        ONLY:  bc_lr, bc_ns, coupling_mode, coupling_topology, dt_dosp,        &
     90               gathered_size, grid_level, grid_level_count, host, inflow_l,    &
     91               inflow_n, inflow_r, inflow_s, io_blocks, io_group,              & 
     92               maximum_grid_level, maximum_parallel_io_streams, message_string,&
     93               mg_switch_to_pe0_level, momentum_advec, psolver, outflow_l,     &
     94               outflow_n, outflow_r, outflow_s, recycling_width, scalar_advec, &
     95               subdomain_size
     96
     97    USE grid_variables,                                                        &
     98        ONLY:  dx
     99       
     100    USE indices,                                                               &
     101        ONLY:  mg_loc_ind, nbgp, nnx, nny, nnz, nx, nx_a, nx_o, nxl, nxl_mg,   &
     102               nxlu, nxr, nxr_mg, ny, ny_a, ny_o, nyn, nyn_mg, nys, nys_mg,    &
     103               nysv, nz, nzb, nzt, nzt_mg, wall_flags_1, wall_flags_2,         &
     104               wall_flags_3, wall_flags_4, wall_flags_5, wall_flags_6,         &
     105               wall_flags_7, wall_flags_8, wall_flags_9, wall_flags_10
     106
     107    USE kinds
     108     
    169109    USE pegrid
    170     USE statistics
    171     USE transpose_indices
    172 
    173 
     110 
     111    USE transpose_indices,                                                     &
     112        ONLY:  nxl_y, nxl_yd, nxl_z, nxr_y, nxr_yd, nxr_z, nyn_x, nyn_z, nys_x,&
     113               nys_z, nzb_x, nzb_y, nzb_yd, nzt_x, nzt_yd, nzt_y
    174114
    175115    IMPLICIT NONE
    176116
    177     INTEGER ::  i, id_inflow_l, id_recycling_l, ind(5), j, k,                &
    178                 maximum_grid_level_l, mg_switch_to_pe0_level_l, mg_levels_x, &
    179                 mg_levels_y, mg_levels_z, nnx_y, nnx_z, nny_x, nny_z, nnz_x, &
    180                 nnz_y, numproc_sqr, nxl_l, nxr_l, nyn_l, nys_l,    &
    181                 nzb_l, nzt_l, omp_get_num_threads
    182 
    183     INTEGER, DIMENSION(:), ALLOCATABLE ::  ind_all, nxlf, nxrf, nynf, nysf
    184 
    185     INTEGER, DIMENSION(2) :: pdims_remote
     117    INTEGER(iwp) ::  i                        !:
     118    INTEGER(iwp) ::  id_inflow_l              !:
     119    INTEGER(iwp) ::  id_recycling_l           !:
     120    INTEGER(iwp) ::  ind(5)                   !:
     121    INTEGER(iwp) ::  j                        !:
     122    INTEGER(iwp) ::  k                        !:
     123    INTEGER(iwp) ::  maximum_grid_level_l     !:
     124    INTEGER(iwp) ::  mg_levels_x              !:
     125    INTEGER(iwp) ::  mg_levels_y              !:
     126    INTEGER(iwp) ::  mg_levels_z              !:
     127    INTEGER(iwp) ::  mg_switch_to_pe0_level_l !:
     128    INTEGER(iwp) ::  nnx_y                    !:
     129    INTEGER(iwp) ::  nnx_z                    !:
     130    INTEGER(iwp) ::  nny_x                    !:
     131    INTEGER(iwp) ::  nny_z                    !:
     132    INTEGER(iwp) ::  nnz_x                    !:
     133    INTEGER(iwp) ::  nnz_y                    !:
     134    INTEGER(iwp) ::  numproc_sqr              !:
     135    INTEGER(iwp) ::  nxl_l                    !:
     136    INTEGER(iwp) ::  nxr_l                    !:
     137    INTEGER(iwp) ::  nyn_l                    !:
     138    INTEGER(iwp) ::  nys_l                    !:
     139    INTEGER(iwp) ::  nzb_l                    !:
     140    INTEGER(iwp) ::  nzt_l                    !:
     141    INTEGER(iwp) ::  omp_get_num_threads      !:
     142
     143    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ind_all !:
     144    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nxlf    !:
     145    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nxrf    !:
     146    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nynf    !:
     147    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nysf    !:
     148
     149    INTEGER(iwp), DIMENSION(2) :: pdims_remote          !:
    186150
    187151#if defined( __mpi2 )
    188     LOGICAL ::  found
     152    LOGICAL ::  found                                   !:
    189153#endif
    190154

  • palm/trunk/SOURCE/init_pt_anomaly.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:
    … …  
    3237! Modification of the amplitude to obtain a visible temperature perturbation.
    3338!
    34 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    35 ! Call of exchange_horiz are modified.
    36 !
    37 ! 75 2007-03-22 09:54:05Z raasch
    38 ! 2nd+3rd argument removed from exchange horiz
    39 !
    40 ! 19 2007-02-23 04:53:48Z raasch
    41 ! Calculation extended for gridpoint nzt
    42 !
    43 ! RCS Log replace by Id keyword, revision history cleaned up
    44 !
    45 ! Revision 1.7  2005/03/26 20:36:55  raasch
    46 ! Arguments for non-cyclic boundary conditions added to argument list of
    47 ! routine exchange_horiz
    48 !
    4939! Revision 1.1  1997/08/29 08:58:56  raasch
    5040! Initial revision
    … …  
    5646!------------------------------------------------------------------------------!
    5747
    58     USE arrays_3d
    59     USE constants
    60     USE grid_variables
    61     USE indices
    62     USE control_parameters
     48    USE arrays_3d,                                                             &
     49        ONLY:  pt, zu
     50
     51    USE grid_variables,                                                        &
     52        ONLY:  dx, dy
     53
     54    USE indices,                                                               &
     55        ONLY:  nbgp, nx, nxl, nxr, nyn, nys, nzb, nzt
     56       
     57    USE kinds
    6358
    6459    IMPLICIT NONE
    6560
    66     INTEGER ::  i, ic, j, jc, k, kc
    67     REAL    ::  betrag, radius, rc, x, y, z
    68 
     61    INTEGER(iwp) ::  i  !:
     62    INTEGER(iwp) ::  ic !:
     63    INTEGER(iwp) ::  j  !:
     64    INTEGER(iwp) ::  jc !:
     65    INTEGER(iwp) ::  k  !:
     66    INTEGER(iwp) ::  kc !:
     67   
     68    REAL(wp)     ::  betrag !:
     69    REAL(wp)     ::  radius !:
     70    REAL(wp)     ::  rc     !:
     71    REAL(wp)     ::  x      !:
     72    REAL(wp)     ::  y      !:
     73    REAL(wp)     ::  z      !:
     74   
    6975!
    7076!-- Defaults: radius rc, strength z,

  • palm/trunk/SOURCE/init_rankine.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
     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
    2228!
    2329! Former revisions:
    … …  
    2733! 1036 2012-10-22 13:43:42Z raasch
    2834! code put under GPL (PALM 3.9)
    29 !
    30 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    31 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    32 ! Calls of exchange_horiz are modified.
    33 !
    34 ! 107 2007-08-17 13:54:45Z raasch
    35 ! Initial profiles are reset to constant profiles
    36 !
    37 ! 75 2007-03-22 09:54:05Z raasch
    38 ! uxrp, vynp eliminated, 2nd+3rd argument removed from exchange horiz
    39 !
    40 ! RCS Log replace by Id keyword, revision history cleaned up
    41 !
    42 ! Revision 1.11  2005/03/26 20:38:49  raasch
    43 ! Arguments for non-cyclic boundary conditions added to argument list of
    44 ! routine exchange_horiz
    4535!
    4636! Revision 1.1  1997/08/11 06:18:43  raasch
    … …  
    5444!------------------------------------------------------------------------------!
    5545
    56     USE arrays_3d
    57     USE constants
    58     USE grid_variables
    59     USE indices
    60     USE control_parameters
     46    USE arrays_3d,                                                             &
     47        ONLY:  pt, pt_init, u, u_init, v, v_init
     48
     49    USE control_parameters,                                                    &
     50        ONLY:  initializing_actions, n_sor, nsor, nsor_ini   
     51
     52    USE constants,                                                             &
     53        ONLY:  pi
     54
     55    USE grid_variables,                                                        &
     56        ONLY:  dx, dy
     57
     58    USE indices,                                                               &
     59        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt     
     60               
     61    USE kinds
    6162
    6263    IMPLICIT NONE
    6364
    64     INTEGER ::  i, ic, j, jc, k, kc1, kc2
    65     REAL    ::  alpha, betrag, radius, rc, uw, vw, x, y
     65    INTEGER(iwp) ::  i   !:
     66    INTEGER(iwp) ::  ic  !:
     67    INTEGER(iwp) ::  j   !:
     68    INTEGER(iwp) ::  jc  !:
     69    INTEGER(iwp) ::  k   !:
     70    INTEGER(iwp) ::  kc1 !:
     71    INTEGER(iwp) ::  kc2 !:
     72   
     73    REAL(wp)     ::  alpha  !:
     74    REAL(wp)     ::  betrag !:
     75    REAL(wp)     ::  radius !:
     76    REAL(wp)     ::  rc     !:
     77    REAL(wp)     ::  uw     !:
     78    REAL(wp)     ::  vw     !:
     79    REAL(wp)     ::  x      !:
     80    REAL(wp)     ::  y      !:
    6681
    6782!

  • palm/trunk/SOURCE/init_slope.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
     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
    2228!
    2329! Former revisions:
    … …  
    2733! 1036 2012-10-22 13:43:42Z raasch
    2834! code put under GPL (PALM 3.9)
    29 !
    30 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    31 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    32 !
    33 ! 622 2010-12-10 08:08:13Z raasch
    34 ! optional barriers included in order to speed up collective operations
    35 !
    36 ! Feb. 2007
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.5  2006/02/23 12:35:34  raasch
    40 ! nanz_2dh renamed ngp_2dh
    4135!
    4236! Revision 1.1  2000/04/27 07:06:24  raasch
    … …  
    5246!------------------------------------------------------------------------------!
    5347
    54     USE arrays_3d
    55     USE constants
    56     USE grid_variables
    57     USE indices
     48    USE arrays_3d,                                                             &
     49        ONLY:  pt, pt_init, pt_slope_ref, zu
     50       
     51    USE constants,                                                             &
     52        ONLY:  pi
     53                   
     54    USE control_parameters,                                                    &
     55        ONLY:  alpha_surface, initializing_actions, pt_slope_offset,           &
     56               pt_surface, pt_vertical_gradient, sin_alpha_surface
     57       
     58    USE grid_variables,                                                        &
     59        ONLY:  dx
     60       
     61    USE indices,                                                               &
     62        ONLY:  ngp_2dh, nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     63       
     64    USE kinds
     65
    5866    USE pegrid
    59     USE control_parameters
     67
    6068
    6169    IMPLICIT NONE
    6270
    63     INTEGER ::  i, j, k
    64     REAL    ::  alpha, height, pt_value, radius
    65     REAL, DIMENSION(:), ALLOCATABLE ::  pt_init_local
     71    INTEGER(iwp) ::  i        !:
     72    INTEGER(iwp) ::  j        !:
     73    INTEGER(iwp) ::  k        !:
     74   
     75    REAL(wp)     ::  alpha    !:
     76    REAL(wp)     ::  height   !:
     77    REAL(wp)     ::  pt_value !:
     78    REAL(wp)     ::  radius   !:
     79   
     80    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_init_local !:
    6681
    6782!

  • palm/trunk/SOURCE/interaction_droplets_ptq.f90

    r1310 r1320  
    6060    SUBROUTINE interaction_droplets_ptq
    6161
    62        USE arrays_3d
    63        USE cloud_parameters
    64        USE control_parameters
    65        USE indices
     62       USE arrays_3d,                                                          &
     63           ONLY:  pt_p, ql_c, q_p
     64           
     65       USE cloud_parameters,                                                   &
     66           ONLY:  l_d_cp, pt_d_t
     67           
     68       USE indices,                                                            &
     69           ONLY:  nxl, nxr, nyn, nys, nzb_2d, nzt
     70           
     71       USE kinds
    6672
    6773       USE pegrid
    … …  
    6975       IMPLICIT NONE
    7076
    71        INTEGER ::  i, j, k
     77       INTEGER(iwp) ::  i !:
     78       INTEGER(iwp) ::  j !:
     79       INTEGER(iwp) ::  k !:
    7280
    7381 
    … …  
    8997    SUBROUTINE interaction_droplets_ptq_ij( i, j )
    9098
    91        USE arrays_3d
    92        USE cloud_parameters
    93        USE control_parameters
    94        USE indices
     99       USE arrays_3d,                                                          &
     100           ONLY:  pt_p, ql_c, q_p
     101
     102       USE cloud_parameters,                                                   &
     103           ONLY:  l_d_cp, pt_d_t
     104
     105       USE indices,                                                            &
     106           ONLY:  nxl, nxr, nyn, nys, nzb_2d, nzt
     107
     108       USE kinds,                                                              &
     109           ONLY:  iwp, wp
    95110
    96111       USE pegrid
    … …  
    98113       IMPLICIT NONE
    99114
    100        INTEGER ::  i, j, k
     115       INTEGER(iwp) ::  i !:
     116       INTEGER(iwp) ::  j !:
     117       INTEGER(iwp) ::  k !:
    101118
    102119

  • palm/trunk/SOURCE/local_flush.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! kind-parameters added to all INTEGER and REAL declaration statements,
     23! kinds are defined in new module kinds,
     24! comment fields (!:) to be used for variable explanations added to
     25! all variable declaration statements
    2326!
    2427! Former revisions:
    … …  
    3740!------------------------------------------------------------------------------!
    3841
    39     INTEGER ::  file_id
     42    USE kinds
     43
     44    INTEGER(iwp) ::  file_id !:
    4045
    4146#if defined( __ibm )

  • palm/trunk/SOURCE/local_getenv.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 ! 82 2007-04-16 15:40:52Z raasch
    32 ! Preprocessor directives for old systems removed
    33 !
    34 ! RCS Log replace by Id keyword, revision history cleaned up
    35 !
    36 ! Revision 1.5  2003/05/09 14:37:07  raasch
    37 ! On the MUK cluster, only PE0 is able to read environment variables.
    38 ! Therefore, they have to be communicated via broadcast to the other PEs.
    3935!
    4036! Revision 1.1  1997/08/11 06:21:01  raasch
    … …  
    4743!------------------------------------------------------------------------------!
    4844
     45    USE kinds
     46       
    4947#if defined( __lcmuk )
    5048    USE pegrid
    5149#endif
    52     CHARACTER (LEN=*) ::  var, value
    53     INTEGER           ::  ivalue, ivar
     50    CHARACTER (LEN=*) ::  value  !:
     51    CHARACTER (LEN=*) ::  var    !:
     52   
     53    INTEGER(iwp)      ::  ivalue !:
     54    INTEGER(iwp)      ::  ivar   !:
    5455#if defined( __lcmuk )
    55     INTEGER            ::  i, ia(20)
     56    INTEGER(iwp)      ::  i      !:
     57    INTEGER(iwp)      ::  ia(20) !:
    5658#endif
    5759

  • palm/trunk/SOURCE/local_stop.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! revision history before 2012 removed,
    2324!
    2425! Former revisions:
    … …  
    3536! New cpp directive "__check" implemented which is used by check_namelist_files
    3637!
    37 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    38 ! Exchange of terminate_coupled between ocean and atmosphere via PE0
    39 !
    40 ! 213 2008-11-13 10:26:18Z raasch
    41 ! Implementation of a MPI-1 coupling: replaced myid with target_id.
    42 ! The uncoupled case allows stop or mpi_abort depending on new steering
    43 ! parameter abort_mode, which is set in routine message.
    44 !
    45 ! 147 2008-02-01 12:41:46Z raasch
    46 ! Bugfix: a stop command was missing in some cases of the parallel branch
    47 !
    48 ! 108 2007-08-24 15:10:38Z letzel
    49 ! modifications to terminate coupled runs
    50 !
    51 ! RCS Log replace by Id keyword, revision history cleaned up
    52 !
    53 ! Revision 1.2  2003/03/16 09:40:28  raasch
    54 ! Two underscores (_) are placed in front of all define-strings
    55 !
    5638! Revision 1.1  2002/12/19 15:46:23  raasch
    5739! Initial revision
    … …  
    6446
    6547    USE pegrid
    66     USE control_parameters
     48   
     49    USE control_parameters,                                                    &
     50        ONLY:  abort_mode, coupling_mode, coupling_mode_remote, dt_restart,    &
     51               stop_dt, terminate_coupled, terminate_coupled_remote,           &
     52               terminate_run, time_restart
    6753
    6854

  • palm/trunk/SOURCE/local_system.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! revision history before 2012 removed,
     23! comment fields (!:) to be used for variable explanations added to
     24! all variable declaration statements
    2325!
    2426! Former revisions:
    … …  
    2830! 1036 2012-10-22 13:43:42Z raasch
    2931! code put under GPL (PALM 3.9)
    30 !
    31 ! 82 2007-04-16 15:40:52Z raasch
    32 ! Preprocessor directives for old systems removed
    33 !
    34 ! RCS Log replace by Id keyword, revision history cleaned up
    35 !
    36 ! Revision 1.4  2003/03/16 09:40:33  raasch
    37 ! Two underscores (_) are placed in front of all define-strings
    3832!
    3933! Revision 1.1  1997/09/03 06:27:27  raasch
    … …  
    4640!------------------------------------------------------------------------------!
    4741
    48     CHARACTER (LEN=*) ::  command
     42    CHARACTER (LEN=*) ::  command !:
    4943
    5044    CALL SYSTEM( command )

  • palm/trunk/SOURCE/local_tremain.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 ! 225 2009-01-26 14:44:20Z raasch
    32 ! Type of count and count_rate changed to INTEGER(8) in order to avoid out of
    33 ! range problems (which result in measured negative time intervals)
    34 !
    35 ! 82 2007-04-16 15:40:52Z raasch
    36 ! Preprocessor strings for different linux clusters changed to "lc",
    37 ! preprocessor directives for old systems removed
    38 !
    39 ! RCS Log replace by Id keyword, revision history cleaned up
    40 !
    41 ! Revision 1.14  2006/06/02 15:20:33  raasch
    42 ! Extended to TIT Sun Fire X4600 System (lctit)
    4335!
    4436! Revision 1.1  1998/03/18 20:14:47  raasch
    … …  
    5143!------------------------------------------------------------------------------!
    5244
    53     USE control_parameters
    54     USE cpulog
     45    USE control_parameters,                                                    &
     46        ONLY:  maximum_cpu_time_allowed
     47
     48    USE cpulog,                                                                &
     49        ONLY:  initial_wallclock_time
     50
     51    USE kinds
     52
    5553    USE pegrid
    5654
    5755    IMPLICIT NONE
    5856
    59     REAL ::  remaining_time
     57    REAL(wp)     ::  remaining_time        !:
    6058#if defined( __ibm )
    61     INTEGER(8) ::  IRTC
    62     REAL       ::  actual_wallclock_time
     59    INTEGER(idp) ::  IRTC                  !:
     60    REAL(wp)     ::  actual_wallclock_time !:
    6361#elif defined( __lc )
    64     INTEGER(8) ::  count, count_rate
    65     REAL       ::  actual_wallclock_time
     62    INTEGER(idp) ::  count                 !:
     63    INTEGER(idp) ::  count_rate            !:
     64    REAL(wp)     ::  actual_wallclock_time !:
    6665#endif
    6766

  • palm/trunk/SOURCE/local_tremain_ini.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:
    … …  
    3237! code put under GPL (PALM 3.9)
    3338!
    34 ! 225 2009-01-26 14:44:20Z raasch
    35 ! Type of count and count_rate changed to INTEGER(8) in order to avoid out of
    36 ! range problems (which result in measured negative time intervals)
    37 !
    38 ! 82 2007-04-16 15:40:52Z raasch
    39 ! Cpp-directive lctit renamed lc
    40 !
    41 ! RCS Log replace by Id keyword, revision history cleaned up
    42 !
    43 ! Revision 1.13  2007/02/11 13:07:03  raasch
    44 ! Allowed cpu limit is now read from file instead of reading the value from
    45 ! environment variable (see routine parin)
    46 !
    4739! Revision 1.1  1998/03/18 20:15:05  raasch
    4840! Initial revision
    … …  
    5345! Initialization of CPU-time measurements for different operating systems
    5446!------------------------------------------------------------------------------!
    55 
    56     USE control_parameters
    57     USE cpulog
     47     
     48    USE cpulog,                                                                &
     49        ONLY:  initial_wallclock_time
     50       
     51    USE kinds
    5852
    5953    IMPLICIT NONE
    6054
    6155#if defined( __ibm )
    62     INTEGER(8)         ::  IRTC
     56    INTEGER(idp)     ::  IRTC       !:
    6357#elif defined( __lc )
    64     INTEGER(8)         ::  count, count_rate
     58    INTEGER(idp)     ::  count      !:
     59    INTEGER(idp)     ::  count_rate !:
    6560#endif
    6661

  • palm/trunk/SOURCE/lpm.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:
    … …  
    5964! wang_collision_kernel renamed wang_kernel
    6065!
    61 ! 799 2011-12-21 17:48:03Z franke
    62 ! Implementation of Wang collision kernel and corresponding new parameter
    63 ! wang_collision_kernel
    64 !
    65 ! 792 2011-12-01 raasch
    66 ! particle arrays (particles, particles_temp) implemented as pointers in
    67 ! order to speed up sorting (see routine sort_particles)
    68 !
    69 ! 759 2011-09-15 13:58:31Z raasch
    70 ! Splitting of parallel I/O (routine write_particles)
    7166!
    7267! Revision 1.1  1999/11/25 16:16:06  raasch
    … …  
    7974!------------------------------------------------------------------------------!
    8075
    81     USE arrays_3d
    82     USE control_parameters
    83     USE cpulog
    84     USE particle_attributes
     76    USE arrays_3d,                                                             &
     77        ONLY:  ql_c, ql_v, ql_vp
     78
     79    USE control_parameters,                                                    &
     80        ONLY:  cloud_droplets, dt_3d, dt_3d_reached, dt_3d_reached_l,          &
     81               molecular_viscosity, simulated_time
     82
     83    USE cpulog,                                                                &
     84        ONLY:  cpu_log, log_point, log_point_s
     85
     86    USE kinds
     87
     88    USE particle_attributes,                                                   &
     89        ONLY:  collision_kernel, deleted_particles, dt_sort_particles,         &
     90               deleted_tails, dt_write_particle_data, dt_prel, end_time_prel,  &
     91               number_of_particles, number_of_particle_groups,particles,       &
     92               particle_groups, particle_mask, trlp_count_sum, tail_mask,      &
     93               time_prel, time_sort_particles, time_write_particle_data,       &
     94               trlp_count_recv_sum, trnp_count_sum, trnp_count_recv_sum,       &
     95               trrp_count_sum, trrp_count_recv_sum, trsp_count_sum,            &
     96               trsp_count_recv_sum, use_particle_tails, use_sgs_for_particles, &
     97               write_particle_statistics
     98
    8599    USE pegrid
    86     USE statistics
    87100
    88101    IMPLICIT NONE
    89102
    90     INTEGER ::  m
     103    INTEGER(iwp) ::  m                       !:
    91104
    92105

  • palm/trunk/SOURCE/lpm_advec.f90

    r1315 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:
    … …  
    4449!------------------------------------------------------------------------------!
    4550
    46     USE arrays_3d
    47     USE control_parameters
    48     USE grid_variables
    49     USE indices
    50     USE particle_attributes
    51     USE statistics
     51    USE arrays_3d,                                                             &
     52        ONLY:  de_dx, de_dy, de_dz, diss, e, u, us, usws, v, vsws, w, z0, zu, zw
     53
     54    USE control_parameters,                                                    &
     55        ONLY:  atmos_ocean_sign, cloud_droplets, dt_3d, dt_3d_reached_l, dz,   &
     56               g, kappa, molecular_viscosity, prandtl_layer, topography,       &
     57               u_gtrans, v_gtrans
     58
     59    USE grid_variables,                                                        &
     60        ONLY:  ddx, dx, ddy, dy
     61       
     62    USE indices,                                                               &
     63        ONLY:  nzb, nzb_s_inner, nzt
     64       
     65    USE kinds
     66   
     67    USE particle_attributes,                                                   &
     68        ONLY:  c_0, density_ratio, dt_min_part, iran_part, log_z_z0,           &
     69               number_of_particles, number_of_sublayers, particles,            &
     70               particle_groups, offset_ocean_nzt, offset_ocean_nzt_m1,         &
     71               sgs_wfu_part, sgs_wfv_part, sgs_wfw_part, use_sgs_for_particles,&
     72               vertical_particle_advection, z0_av_global
     73       
     74    USE statistics,                                                            &
     75        ONLY:  hom
     76       
    5277
    5378    IMPLICIT NONE
    5479
    55     INTEGER ::  i, j, k, n
    56 
    57     REAL ::  aa, bb, cc, dd, dens_ratio, exp_arg, exp_term, gg, u_int,  &
    58              u_int_l, u_int_u, v_int, v_int_l, v_int_u, w_int, w_int_l, &
    59              w_int_u, x, y
    60 
    61 
    62     INTEGER ::  agp, kw, num_gp
    63     INTEGER ::  gp_outside_of_building(1:8)
    64 
    65     REAL ::  d_sum, de_dx_int, de_dx_int_l, de_dx_int_u, de_dy_int,       &
    66              de_dy_int_l, de_dy_int_u, de_dt, de_dt_min, de_dz_int,       &
    67              de_dz_int_l, de_dz_int_u, diss_int, diss_int_l, diss_int_u,  &
    68              dt_gap, dt_particle, dt_particle_m, e_int, e_int_l, e_int_u, &
    69              e_mean_int, fs_int, lagr_timescale, random_gauss, vv_int
    70 
    71     REAL ::    height_int, height_p, log_z_z0_int, us_int, z_p, d_z_p_z0
    72 
    73     REAL ::  location(1:30,1:3)
    74     REAL, DIMENSION(1:30) ::  de_dxi, de_dyi, de_dzi, dissi, d_gp_pl, ei
     80    INTEGER(iwp) ::  agp                         !:
     81    INTEGER(iwp) ::  gp_outside_of_building(1:8) !:
     82    INTEGER(iwp) ::  i                           !:
     83    INTEGER(iwp) ::  j                           !:
     84    INTEGER(iwp) ::  k                           !:
     85    INTEGER(iwp) ::  kw                          !:
     86    INTEGER(iwp) ::  n                           !:
     87    INTEGER(iwp) ::  num_gp                      !:
     88
     89    REAL(wp) ::  aa                 !:
     90    REAL(wp) ::  bb                 !:
     91    REAL(wp) ::  cc                 !:
     92    REAL(wp) ::  d_sum              !:
     93    REAL(wp) ::  d_z_p_z0           !:
     94    REAL(wp) ::  dd                 !:
     95    REAL(wp) ::  de_dx_int          !:
     96    REAL(wp) ::  de_dx_int_l        !:
     97    REAL(wp) ::  de_dx_int_u        !:
     98    REAL(wp) ::  de_dy_int          !:
     99    REAL(wp) ::  de_dy_int_l        !:
     100    REAL(wp) ::  de_dy_int_u        !:
     101    REAL(wp) ::  de_dt              !:
     102    REAL(wp) ::  de_dt_min          !:
     103    REAL(wp) ::  de_dz_int          !:
     104    REAL(wp) ::  de_dz_int_l        !:
     105    REAL(wp) ::  de_dz_int_u        !:
     106    REAL(wp) ::  dens_ratio         !:
     107    REAL(wp) ::  diss_int           !:
     108    REAL(wp) ::  diss_int_l         !:
     109    REAL(wp) ::  diss_int_u         !:
     110    REAL(wp) ::  dt_gap             !:
     111    REAL(wp) ::  dt_particle        !:
     112    REAL(wp) ::  dt_particle_m      !:
     113    REAL(wp) ::  e_int              !:
     114    REAL(wp) ::  e_int_l            !:
     115    REAL(wp) ::  e_int_u            !:
     116    REAL(wp) ::  e_mean_int         !:
     117    REAL(wp) ::  exp_arg            !:
     118    REAL(wp) ::  exp_term           !:
     119    REAL(wp) ::  fs_int             !:
     120    REAL(wp) ::  gg                 !:
     121    REAL(wp) ::  height_int         !:
     122    REAL(wp) ::  height_p           !:
     123    REAL(wp) ::  lagr_timescale     !:
     124    REAL(wp) ::  location(1:30,1:3) !:
     125    REAL(wp) ::  log_z_z0_int       !:
     126    REAL(wp) ::  random_gauss       !:
     127    REAL(wp) ::  u_int              !:
     128    REAL(wp) ::  u_int_l            !:
     129    REAL(wp) ::  u_int_u            !:
     130    REAL(wp) ::  us_int             !:
     131    REAL(wp) ::  v_int              !:
     132    REAL(wp) ::  v_int_l            !:
     133    REAL(wp) ::  v_int_u            !:
     134    REAL(wp) ::  vv_int             !:
     135    REAL(wp) ::  w_int              !:
     136    REAL(wp) ::  w_int_l            !:
     137    REAL(wp) ::  w_int_u            !:
     138    REAL(wp) ::  x                  !:
     139    REAL(wp) ::  y                  !:
     140    REAL(wp) ::  z_p                !:   
     141
     142    REAL(wp), DIMENSION(1:30) ::  d_gp_pl !:
     143    REAL(wp), DIMENSION(1:30) ::  de_dxi  !:
     144    REAL(wp), DIMENSION(1:30) ::  de_dyi  !:
     145    REAL(wp), DIMENSION(1:30) ::  de_dzi  !:
     146    REAL(wp), DIMENSION(1:30) ::  dissi   !:
     147    REAL(wp), DIMENSION(1:30) ::  ei      !:
    75148
    76149!

  • palm/trunk/SOURCE/lpm_boundary_conds.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:
    … …  
    2631! $Id$
    2732!
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    30 !
    3133! 1036 2012-10-22 13:43:42Z raasch
    3234! code put under GPL (PALM 3.9)
    … …  
    3840! 824 2012-02-17 09:09:57Z raasch
    3941! particle attributes speed_x|y|z_sgs renamed rvar1|2|3
    40 !
    41 ! 150 2008-02-29 08:19:58Z raasch
    42 ! Vertical index calculations adjusted for ocean runs.
    4342!
    4443! Initial version (2007/03/09)
    … …  
    6160!------------------------------------------------------------------------------!
    6261
    63     USE arrays_3d
    64     USE control_parameters
    65     USE cpulog
    66     USE grid_variables
    67     USE indices
    68     USE particle_attributes
     62    USE arrays_3d,                                                             &
     63        ONLY:  zu, zw
     64
     65    USE control_parameters,                                                    &
     66        ONLY:  dz, message_string, particle_maximum_age
     67
     68    USE cpulog,                                                                &
     69        ONLY:  cpu_log, log_point_s
     70
     71    USE grid_variables,                                                        &
     72        ONLY:  ddx, dx, ddy, dy
     73
     74    USE indices,                                                               &
     75        ONLY:  nxl, nxr, nyn, nys, nz, nzb_s_inner
     76
     77    USE kinds
     78
     79    USE particle_attributes,                                                   &
     80        ONLY:  deleted_particles, deleted_tails, ibc_par_b, ibc_par_t,         &
     81               number_of_particles, particles, particle_mask,                  &
     82               particle_tail_coordinates, particle_type, offset_ocean_nzt_m1,  &
     83               tail_mask, use_particle_tails, use_sgs_for_particles
     84
    6985    USE pegrid
    7086
    7187    IMPLICIT NONE
    7288
    73     CHARACTER (LEN=*) ::  range
    74 
    75     INTEGER ::  i, inc, ir, i1, i2, i3, i5, j, jr, j1, j2, j3, j5, k, k1, k2, &
    76                 k3, k5, n, nn, t_index, t_index_number
    77 
    78     LOGICAL ::  reflect_x, reflect_y, reflect_z
    79 
    80     REAL ::  dt_particle, pos_x, pos_x_old, pos_y, pos_y_old, pos_z, &
    81              pos_z_old, prt_x, prt_y, prt_z, tmp_t, xline, yline, zline
    82 
    83     REAL ::  t(1:200)
    84 
    85 
     89    CHARACTER (LEN=*) ::  range     !:
     90   
     91    INTEGER(iwp) ::  i              !:
     92    INTEGER(iwp) ::  inc            !:
     93    INTEGER(iwp) ::  ir             !:
     94    INTEGER(iwp) ::  i1             !:
     95    INTEGER(iwp) ::  i2             !:
     96    INTEGER(iwp) ::  i3             !:
     97    INTEGER(iwp) ::  i5             !:
     98    INTEGER(iwp) ::  j              !:
     99    INTEGER(iwp) ::  jr             !:
     100    INTEGER(iwp) ::  j1             !:
     101    INTEGER(iwp) ::  j2             !:
     102    INTEGER(iwp) ::  j3             !:
     103    INTEGER(iwp) ::  j5             !:
     104    INTEGER(iwp) ::  k              !:
     105    INTEGER(iwp) ::  k1             !:
     106    INTEGER(iwp) ::  k2             !:
     107    INTEGER(iwp) ::  k3             !:
     108    INTEGER(iwp) ::  k5             !:
     109    INTEGER(iwp) ::  n              !:
     110    INTEGER(iwp) ::  nn             !:
     111    INTEGER(iwp) ::  t_index        !:
     112    INTEGER(iwp) ::  t_index_number !:
     113   
     114    LOGICAL  ::  reflect_x   !:
     115    LOGICAL  ::  reflect_y   !:
     116    LOGICAL  ::  reflect_z   !:
     117
     118    REAL(wp) ::  dt_particle !:
     119    REAL(wp) ::  pos_x       !:
     120    REAL(wp) ::  pos_x_old   !:
     121    REAL(wp) ::  pos_y       !:
     122    REAL(wp) ::  pos_y_old   !:
     123    REAL(wp) ::  pos_z       !:
     124    REAL(wp) ::  pos_z_old   !:
     125    REAL(wp) ::  prt_x       !:
     126    REAL(wp) ::  prt_y       !:
     127    REAL(wp) ::  prt_z       !:
     128    REAL(wp) ::  t(1:200)    !:
     129    REAL(wp) ::  tmp_t       !:
     130    REAL(wp) ::  xline       !:
     131    REAL(wp) ::  yline       !:
     132    REAL(wp) ::  zline       !:
    86133
    87134    IF ( range == 'bottom/top' )  THEN

  • palm/trunk/SOURCE/lpm_calc_liquid_water_content.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    2529! -----------------
    2630! $Id$
    27 !
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    3031!
    3132! 1036 2012-10-22 13:43:42Z raasch
    … …  
    4142!------------------------------------------------------------------------------!
    4243
    43     USE arrays_3d
    44     USE cloud_parameters
    45     USE constants
    46     USE control_parameters
    47     USE cpulog
    48     USE grid_variables
    49     USE indices
    50     USE particle_attributes
     44    USE arrays_3d,                                                             &
     45        ONLY:  ql, ql_v, ql_vp
     46
     47    USE cloud_parameters,                                                      &
     48        ONLY:  rho_l
     49
     50    USE constants,                                                             &
     51        ONLY:  pi
     52
     53    USE control_parameters,                                                    &
     54        ONLY:  dz, message_string, rho_surface
     55
     56    USE cpulog,                                                                &
     57        ONLY:  cpu_log, log_point_s
     58
     59    USE grid_variables,                                                        &
     60        ONLY:  dx, dy
     61
     62    USE indices,                                                               &
     63        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
     64
     65    USE kinds
     66
     67    USE particle_attributes,                                                   &
     68        ONLY:  particles, prt_count, prt_start_index
    5169
    5270    IMPLICIT NONE
    5371
    54     INTEGER ::  i, j, k, n, psi
     72    INTEGER(iwp) ::  i   !:
     73    INTEGER(iwp) ::  j   !:
     74    INTEGER(iwp) ::  k   !:
     75    INTEGER(iwp) ::  n   !:
     76    INTEGER(iwp) ::  psi !:
    5577
    5678

  • palm/trunk/SOURCE/lpm_collision_kernels.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:
    2530! -----------------
    2631! $Id$
    27 !
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    3032!
    3133! 1092 2013-02-02 11:24:22Z raasch
    … …  
    6264! routine renamed from wang_kernel to lpm_collision_kernels,
    6365! turbulence_effects on collision replaced by wang_kernel
    64 !
    65 ! 799 2011-12-21 17:48:03Z franke
    66 ! speed optimizations and formatting
    67 ! Bugfix: iq=1 is not allowed (routine effic)
    68 ! Bugfix: replaced stop by ec=0.0 in case of very small ec (routine effic)
    6966!
    7067! 790 2011-11-29 03:11:20Z raasch
    … …  
    8683!------------------------------------------------------------------------------!
    8784
    88     USE arrays_3d
    89     USE cloud_parameters
    90     USE constants
    91     USE particle_attributes
     85    USE constants,                                                             &
     86        ONLY:  pi
     87       
     88    USE kinds
     89
     90    USE particle_attributes,                                                   &
     91        ONLY:  collision_kernel, dissipation_classes, particles, radius_classes
     92
    9293    USE pegrid
    9394
    … …  
    100101            rclass_lbound, rclass_ubound, recalculate_kernel
    101102
    102     REAL ::  epsilon, eps2, rclass_lbound, rclass_ubound, urms, urms2
    103 
    104     REAL, DIMENSION(:),   ALLOCATABLE ::  epsclass, radclass, winf
    105     REAL, DIMENSION(:,:), ALLOCATABLE ::  ec, ecf, gck, hkernel, hwratio
    106     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  ckernel
     103    REAL(wp) ::  epsilon       !:
     104    REAL(wp) ::  eps2          !:
     105    REAL(wp) ::  rclass_lbound !:
     106    REAL(wp) ::  rclass_ubound !:
     107    REAL(wp) ::  urms          !:
     108    REAL(wp) ::  urms2         !:
     109
     110    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  epsclass !:
     111    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  radclass !:
     112    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  winf     !:
     113   
     114    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ec       !:
     115    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ecf      !:
     116    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gck      !:
     117    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hkernel  !:
     118    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hwratio  !:
     119   
     120    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  ckernel !:
    107121
    108122    SAVE
    … …  
    134148       IMPLICIT NONE
    135149
    136        INTEGER ::  i, j, k
     150       INTEGER(iwp) ::  i !:
     151       INTEGER(iwp) ::  j !:
     152       INTEGER(iwp) ::  k !:
    137153
    138154
    … …  
    262278    SUBROUTINE recalculate_kernel( i1, j1, k1 )
    263279
    264        USE arrays_3d
    265        USE cloud_parameters
    266        USE constants
    267        USE cpulog
    268        USE indices
    269        USE particle_attributes
     280       USE arrays_3d,                                                          &
     281           ONLY:  diss
     282
     283       USE particle_attributes,                                                &
     284           ONLY:  prt_count, prt_start_index, radius_classes, wang_kernel
    270285
    271286       IMPLICIT NONE
    272287
    273        INTEGER ::  i, i1, j, j1, k1, pend, pstart
     288       INTEGER(iwp) ::  i      !:
     289       INTEGER(iwp) ::  i1     !:
     290       INTEGER(iwp) ::  j      !:
     291       INTEGER(iwp) ::  j1     !:
     292       INTEGER(iwp) ::  k1     !:
     293       INTEGER(iwp) ::  pend   !:
     294       INTEGER(iwp) ::  pstart !:
    274295
    275296
    … …  
    340361    SUBROUTINE turbsd
    341362
    342        USE constants
    343        USE cloud_parameters
    344        USE particle_attributes
    345        USE arrays_3d
    346        USE control_parameters
     363       USE control_parameters,                                                 &
     364           ONLY:  g, molecular_viscosity
     365   
     366       USE particle_attributes,                                                &
     367           ONLY:  radius_classes
    347368
    348369       IMPLICIT NONE
    349 
    350        INTEGER ::  i, j
    351 
    352        LOGICAL, SAVE ::  first = .TRUE.
    353 
    354        REAL ::  ao, ao_gr, bbb, be, b1, b2, ccc, c1, c1_gr, c2, d1, d2, eta, &
    355                 e1, e2, fao_gr, fr, grfin, lambda, lambda_re, lf, rc, rrp,   &
    356                 sst, tauk, tl, t2, tt, t1, vk, vrms1xy, vrms2xy, v1, v1v2xy, &
    357                 v1xysq, v2, v2xysq, wrfin, wrgrav2, wrtur2xy, xx, yy, z
    358 
    359        REAL, DIMENSION(1:radius_classes) ::  st, tau
    360 
    361 
     370       
     371       LOGICAL, SAVE ::  first = .TRUE. !:
     372
     373       INTEGER(iwp) ::  i     !:
     374       INTEGER(iwp) ::  j     !:
     375
     376       REAL(wp) ::  ao        !:
     377       REAL(wp) ::  ao_gr     !:
     378       REAL(wp) ::  bbb       !:
     379       REAL(wp) ::  be        !:
     380       REAL(wp) ::  b1        !:
     381       REAL(wp) ::  b2        !:
     382       REAL(wp) ::  ccc       !:
     383       REAL(wp) ::  c1        !:
     384       REAL(wp) ::  c1_gr     !:
     385       REAL(wp) ::  c2        !:
     386       REAL(wp) ::  d1        !:
     387       REAL(wp) ::  d2        !:
     388       REAL(wp) ::  eta       !:
     389       REAL(wp) ::  e1        !:
     390       REAL(wp) ::  e2        !:
     391       REAL(wp) ::  fao_gr    !:
     392       REAL(wp) ::  fr        !:
     393       REAL(wp) ::  grfin     !:
     394       REAL(wp) ::  lambda    !:
     395       REAL(wp) ::  lambda_re !:
     396       REAL(wp) ::  lf        !:
     397       REAL(wp) ::  rc        !:
     398       REAL(wp) ::  rrp       !:
     399       REAL(wp) ::  sst       !:
     400       REAL(wp) ::  tauk      !:
     401       REAL(wp) ::  tl        !:
     402       REAL(wp) ::  t2        !:
     403       REAL(wp) ::  tt        !:
     404       REAL(wp) ::  t1        !:
     405       REAL(wp) ::  vk        !:
     406       REAL(wp) ::  vrms1xy   !:
     407       REAL(wp) ::  vrms2xy   !:
     408       REAL(wp) ::  v1        !:
     409       REAL(wp) ::  v1v2xy    !:
     410       REAL(wp) ::  v1xysq    !:
     411       REAL(wp) ::  v2        !:
     412       REAL(wp) ::  v2xysq    !:
     413       REAL(wp) ::  wrfin     !:
     414       REAL(wp) ::  wrgrav2   !:
     415       REAL(wp) ::  wrtur2xy  !:
     416       REAL(wp) ::  xx        !:
     417       REAL(wp) ::  yy        !:
     418       REAL(wp) ::  z         !:
     419
     420       REAL(wp), DIMENSION(1:radius_classes) ::  st  !:
     421       REAL(wp), DIMENSION(1:radius_classes) ::  tau !:
     422       
    362423!
    363424!--    Initial assignment of constants
    … …  
    478539! phi_w as a function
    479540!------------------------------------------------------------------------------!
    480     REAL FUNCTION phi_w( a, b, vsett, tau0 )
     541    REAL(wp) FUNCTION phi_w( a, b, vsett, tau0 )
    481542
    482543       IMPLICIT NONE
    483544
    484        REAL ::  a, aa1, b, tau0, vsett
     545       REAL(wp) ::  a     !:
     546       REAL(wp) ::  aa1   !:
     547       REAL(wp) ::  b     !:
     548       REAL(wp) ::  tau0  !:
     549       REAL(wp) ::  vsett !:
    485550
    486551       aa1 = 1.0 / tau0 + 1.0 / a + vsett / b
    … …  
    493558! zhi as a function
    494559!------------------------------------------------------------------------------!
    495     REAL FUNCTION zhi( a, b, vsett1, tau1, vsett2, tau2 )
     560    REAL(wp) FUNCTION zhi( a, b, vsett1, tau1, vsett2, tau2 )
    496561
    497562       IMPLICIT NONE
    498563
    499        REAL ::  a, aa1, aa2, aa3, aa4, aa5, aa6, b, tau1, tau2, vsett1, vsett2
     564       REAL(wp) ::  a      !:
     565       REAL(wp) ::  aa1    !:
     566       REAL(wp) ::  aa2    !:
     567       REAL(wp) ::  aa3    !:
     568       REAL(wp) ::  aa4    !:
     569       REAL(wp) ::  aa5    !:
     570       REAL(wp) ::  aa6    !:
     571       REAL(wp) ::  b      !:
     572       REAL(wp) ::  tau1   !:
     573       REAL(wp) ::  tau2   !:
     574       REAL(wp) ::  vsett1 !:
     575       REAL(wp) ::  vsett2 !:
    500576
    501577       aa1 = vsett2 / b - 1.0 / tau2 - 1.0 / a
    … …  
    518594!------------------------------------------------------------------------------!
    519595    SUBROUTINE fallg
    520 
    521        USE constants
    522        USE cloud_parameters
    523        USE particle_attributes
    524        USE arrays_3d
    525        USE control_parameters
     596 
     597       USE cloud_parameters,                                                   &
     598           ONLY:  rho_l
     599   
     600       USE control_parameters,                                                 &
     601           ONLY:  g
     602
     603       USE particle_attributes,                                                &
     604           ONLY:  radius_classes
     605
    526606
    527607       IMPLICIT NONE
    528608
    529        INTEGER ::  i, j
    530 
    531        LOGICAL, SAVE ::  first = .TRUE.
    532 
    533        REAL, SAVE ::  cunh, eta, phy, py, rho_a, sigma, stb, stok, xlamb
    534 
    535        REAL ::  bond, x, xrey, y
    536 
    537        REAL, DIMENSION(1:7), SAVE  ::  b
    538        REAL, DIMENSION(1:6), SAVE  ::  c
     609       INTEGER(iwp) ::  i !:
     610       INTEGER(iwp) ::  j !:
     611
     612       LOGICAL, SAVE ::  first = .TRUE. !:
     613
     614       REAL(wp), SAVE ::  cunh  !:
     615       REAL(wp), SAVE ::  eta   !:
     616       REAL(wp), SAVE ::  phy   !:
     617       REAL(wp), SAVE ::  py    !:
     618       REAL(wp), SAVE ::  rho_a !:
     619       REAL(wp), SAVE ::  sigma !:
     620       REAL(wp), SAVE ::  stb   !:
     621       REAL(wp), SAVE ::  stok  !:
     622       REAL(wp), SAVE ::  xlamb !:
     623
     624       REAL(wp) ::  bond        !:
     625       REAL(wp) ::  x           !:
     626       REAL(wp) ::  xrey        !:
     627       REAL(wp) ::  y           !:
     628
     629       REAL(wp), DIMENSION(1:7), SAVE  ::  b !:
     630       REAL(wp), DIMENSION(1:6), SAVE  ::  c !:
    539631
    540632!
    … …  
    617709!------------------------------------------------------------------------------!
    618710    SUBROUTINE effic
    619 
    620        USE arrays_3d
    621        USE cloud_parameters
    622        USE constants
    623        USE particle_attributes
     711 
     712       USE particle_attributes,                                                &
     713           ONLY:  radius_classes
    624714
    625715       IMPLICIT NONE
    626716
    627        INTEGER ::  i, iq, ir, j, k
    628 
    629        INTEGER, DIMENSION(:), ALLOCATABLE ::  ira
    630 
    631        LOGICAL, SAVE ::  first = .TRUE.
    632 
    633        REAL ::  ek, particle_radius, pp, qq, rq
    634 
    635        REAL, DIMENSION(1:21), SAVE ::  rat
    636        REAL, DIMENSION(1:15), SAVE ::  r0
    637        REAL, DIMENSION(1:15,1:21), SAVE ::  ecoll
     717       INTEGER(iwp) ::  i  !:
     718       INTEGER(iwp) ::  iq !:
     719       INTEGER(iwp) ::  ir !:
     720       INTEGER(iwp) ::  j  !:
     721       INTEGER(iwp) ::  k  !:
     722
     723       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ira !:
     724
     725       LOGICAL, SAVE ::  first = .TRUE. !:
     726
     727       REAL(wp) ::  ek              !:
     728       REAL(wp) ::  particle_radius !:
     729       REAL(wp) ::  pp              !:
     730       REAL(wp) ::  qq              !:
     731       REAL(wp) ::  rq              !:
     732
     733       REAL(wp), DIMENSION(1:21), SAVE ::  rat        !:
     734       
     735       REAL(wp), DIMENSION(1:15), SAVE ::  r0         !:
     736       
     737       REAL(wp), DIMENSION(1:15,1:21), SAVE ::  ecoll !:
    638738
    639739!
    … …  
    754854    SUBROUTINE turb_enhance_eff
    755855
    756        USE constants
    757        USE cloud_parameters
    758        USE particle_attributes
    759        USE arrays_3d
     856       USE particle_attributes,                                                &
     857           ONLY:  radius_classes
    760858
    761859       IMPLICIT NONE
    762860
    763        INTEGER :: i, iq, ir, j, k, kk
    764 
    765        INTEGER, DIMENSION(:), ALLOCATABLE ::  ira
    766 
    767        REAL ::  particle_radius, pp, qq, rq, y1, y2, y3
    768 
    769        LOGICAL, SAVE ::  first = .TRUE.
    770 
    771        REAL, DIMENSION(1:11), SAVE ::  rat
    772        REAL, DIMENSION(1:7), SAVE  ::  r0
    773        REAL, DIMENSION(1:7,1:11), SAVE ::  ecoll_100, ecoll_400
     861       INTEGER(iwp) :: i  !:
     862       INTEGER(iwp) :: iq !:
     863       INTEGER(iwp) :: ir !:
     864       INTEGER(iwp) :: j  !:
     865       INTEGER(iwp) :: k  !:
     866       INTEGER(iwp) :: kk !:
     867
     868       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ira !:
     869       
     870       LOGICAL, SAVE ::  first = .TRUE. !:
     871
     872       REAL(wp) ::  particle_radius !:
     873       REAL(wp) ::  pp              !:
     874       REAL(wp) ::  qq              !:
     875       REAL(wp) ::  rq              !:
     876       REAL(wp) ::  y1              !:
     877       REAL(wp) ::  y2              !:
     878       REAL(wp) ::  y3              !:
     879
     880       REAL(wp), DIMENSION(1:11), SAVE ::  rat           !:
     881       
     882       REAL(wp), DIMENSION(1:7), SAVE  ::  r0            !:
     883       
     884       REAL(wp), DIMENSION(1:7,1:11), SAVE ::  ecoll_100 !:
     885       REAL(wp), DIMENSION(1:7,1:11), SAVE ::  ecoll_400 !:
    774886
    775887!
    … …  
    8981010       IMPLICIT NONE
    8991011
    900        INTEGER       ::  i, j, k
    901 
    902        LOGICAL, SAVE ::  first = .TRUE.
    903 
    904        REAL          ::  aa, bb, cc, dd, dx, dy, e, gg, mean_r, mean_rm, r, &
    905                          rm, x, y
    906 
    907        REAL, DIMENSION(1:9), SAVE      ::  collected_r = 0.0
    908        REAL, DIMENSION(1:19), SAVE     ::  collector_r = 0.0
    909        REAL, DIMENSION(1:9,1:19), SAVE ::  ef = 0.0
     1012       INTEGER(iwp)  ::  i !:
     1013       INTEGER(iwp)  ::  j !:
     1014       INTEGER(iwp)  ::  k !:
     1015
     1016       LOGICAL, SAVE ::  first = .TRUE. !:
     1017
     1018       REAL(wp)      ::  aa      !:
     1019       REAL(wp)      ::  bb      !:
     1020       REAL(wp)      ::  cc      !:
     1021       REAL(wp)      ::  dd      !:
     1022       REAL(wp)      ::  dx      !:
     1023       REAL(wp)      ::  dy      !:
     1024       REAL(wp)      ::  e       !:
     1025       REAL(wp)      ::  gg      !:
     1026       REAL(wp)      ::  mean_r  !:
     1027       REAL(wp)      ::  mean_rm !:
     1028       REAL(wp)      ::  r       !:
     1029       REAL(wp)      ::  rm      !:
     1030       REAL(wp)      ::  x       !:
     1031       REAL(wp)      ::  y       !:
     1032 
     1033       REAL(wp), DIMENSION(1:9), SAVE      ::  collected_r = 0.0 !:
     1034       
     1035       REAL(wp), DIMENSION(1:19), SAVE     ::  collector_r = 0.0 !:
     1036       
     1037       REAL(wp), DIMENSION(1:9,1:19), SAVE ::  ef = 0.0          !:
    9101038
    9111039       mean_rm = mean_r * 1.0E06

  • palm/trunk/SOURCE/lpm_data_output_particles.f90

    r1319 r1320  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! revision history before 2012 removed,
    2324!
    2425! Former revisions:
    2526! -----------------
    2627! $Id$
    27 !
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    30 !
    3128!
    3229! 1036 2012-10-22 13:43:42Z raasch
    … …  
    4340!------------------------------------------------------------------------------!
    4441
    45     USE control_parameters
    46     USE cpulog
     42    USE control_parameters,                                                    &
     43        ONLY:  netcdf_output, prt_time_count, simulated_time
     44
     45    USE cpulog,                                                                &
     46        ONLY:  cpu_log, log_point_s
     47
    4748    USE netcdf_control
    48     USE particle_attributes
     49
     50    USE particle_attributes,                                                   &
     51        ONLY:  maximum_number_of_particles, maximum_number_of_tailpoints,      &
     52               maximum_number_of_tails, number_of_particles, number_of_tails,  &
     53               particles, particle_tail_coordinates
    4954
    5055    IMPLICIT NONE
    … …  
    6469                  number_of_tails
    6570    IF ( maximum_number_of_tails > 0 )  THEN
    66        WRITE ( 85 )  particle_tail_coordinates
     71       WRITE ( 85 )  particle_tail_coordinates, prt_time_count
    6772    ENDIF
    6873

  • palm/trunk/SOURCE/lpm_droplet_collision.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:
    2530! -----------------
    2631! $Id$
    27 !
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! module interfaces removed
    3032!
    3133! 1092 2013-02-02 11:24:22Z raasch
    … …  
    6769!------------------------------------------------------------------------------!
    6870
    69     USE arrays_3d
    70     USE cloud_parameters
    71     USE constants
    72     USE control_parameters
    73     USE cpulog
    74     USE grid_variables
    75     USE indices
    76     USE lpm_collision_kernels_mod
    77     USE particle_attributes
     71    USE arrays_3d,                                                             &
     72        ONLY:  diss, ql, ql_v, ql_vp, u, v, w, zu, zw
     73
     74    USE cloud_parameters,                                                      &
     75        ONLY:  effective_coll_efficiency
     76
     77    USE constants,                                                             &
     78        ONLY:  pi
     79
     80    USE control_parameters,                                                    &
     81        ONLY:  dt_3d, message_string, u_gtrans, v_gtrans, dz
     82
     83    USE cpulog,                                                                &
     84        ONLY:  cpu_log, log_point_s
     85
     86    USE grid_variables,                                                        &
     87        ONLY:  ddx, dx, ddy, dy
     88
     89    USE indices,                                                               &
     90        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
     91
     92    USE kinds
     93
     94    USE lpm_collision_kernels_mod,                                             &
     95        ONLY:  ckernel, collision_efficiency_rogers, recalculate_kernel
     96
     97    USE particle_attributes,                                                   &
     98        ONLY:  deleted_particles, dissipation_classes, hall_kernel,            &
     99               palm_kernel, particles, particle_mask, particle_type,           &
     100               prt_count, prt_start_index, use_kernel_tables, wang_kernel
    78101
    79102    IMPLICIT NONE
    80103
    81     INTEGER ::  eclass, i, ii, inc, is, j, jj, js, k, kk, n, pse, psi, rclass_l, &
    82                 rclass_s
    83 
    84     REAL ::  aa, bb, cc, dd, delta_r, delta_v, gg, epsilon, mean_r, ql_int,    &
    85              ql_int_l, ql_int_u, u_int, u_int_l, u_int_u, v_int, v_int_l,      &
    86              v_int_u, w_int, w_int_l, w_int_u, sl_r3, sl_r4, x, y, sum1, sum2, &
    87              sum3, r3, ddV
    88 
    89     TYPE(particle_type) ::  tmp_particle
    90     REAL, DIMENSION(:), ALLOCATABLE :: rad, weight
     104    INTEGER(iwp) ::  eclass   !:
     105    INTEGER(iwp) ::  i        !:
     106    INTEGER(iwp) ::  ii       !:
     107    INTEGER(iwp) ::  inc      !:
     108    INTEGER(iwp) ::  is       !:
     109    INTEGER(iwp) ::  j        !:
     110    INTEGER(iwp) ::  jj       !:
     111    INTEGER(iwp) ::  js       !:
     112    INTEGER(iwp) ::  k        !:
     113    INTEGER(iwp) ::  kk       !:
     114    INTEGER(iwp) ::  n        !:
     115    INTEGER(iwp) ::  pse      !:
     116    INTEGER(iwp) ::  psi      !:
     117    INTEGER(iwp) ::  rclass_l !:
     118    INTEGER(iwp) ::  rclass_s !:
     119
     120    REAL(wp) ::  aa       !:
     121    REAL(wp) ::  bb       !:
     122    REAL(wp) ::  cc       !:
     123    REAL(wp) ::  dd       !:
     124    REAL(wp) ::  ddV      !:
     125    REAL(wp) ::  delta_r  !:
     126    REAL(wp) ::  delta_v  !:
     127    REAL(wp) ::  epsilon  !:
     128    REAL(wp) ::  gg       !:
     129    REAL(wp) ::  mean_r   !:
     130    REAL(wp) ::  ql_int   !:
     131    REAL(wp) ::  ql_int_l !:
     132    REAL(wp) ::  ql_int_u !:
     133    REAL(wp) ::  r3       !:
     134    REAL(wp) ::  sl_r3    !:
     135    REAL(wp) ::  sl_r4    !:
     136    REAL(wp) ::  sum1     !:
     137    REAL(wp) ::  sum2     !:
     138    REAL(wp) ::  sum3     !:
     139    REAL(wp) ::  u_int    !:
     140    REAL(wp) ::  u_int_l  !:
     141    REAL(wp) ::  u_int_u  !:
     142    REAL(wp) ::  v_int    !:
     143    REAL(wp) ::  v_int_l  !:
     144    REAL(wp) ::  v_int_u  !:
     145    REAL(wp) ::  w_int    !:
     146    REAL(wp) ::  w_int_l  !:
     147    REAL(wp) ::  w_int_u  !:
     148    REAL(wp) ::  x        !:
     149    REAL(wp) ::  y        !:
     150
     151    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad    !:
     152    REAL(wp), DIMENSION(:), ALLOCATABLE ::  weight !:
     153
     154
     155    TYPE(particle_type) ::  tmp_particle           !:
     156
    91157
    92158

  • palm/trunk/SOURCE/lpm_droplet_condensation.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    6165!------------------------------------------------------------------------------!
    6266
    63     USE arrays_3d
    64     USE cloud_parameters
    65     USE constants
    66     USE control_parameters
    67     USE cpulog
    68     USE grid_variables
    69     USE lpm_collision_kernels_mod
    70     USE particle_attributes
     67    USE arrays_3d,                                                             &
     68        ONLY:  hyp, pt, q,  ql_c, ql_v, zu
     69
     70    USE cloud_parameters,                                                      &
     71        ONLY:  bfactor, curvature_solution_effects, diff_coeff_l,              &
     72               eps_ros, l_d_rv, l_v, rho_l,  r_v, thermal_conductivity_l
     73
     74    USE constants,                                                             &
     75        ONLY:  pi
     76
     77    USE control_parameters,                                                    &
     78        ONLY:  atmos_ocean_sign, dt_3d, dz, message_string,                    &
     79               molecular_viscosity, rho_surface
     80    USE cpulog,                                                                &
     81        ONLY:  cpu_log, log_point_s
     82
     83    USE grid_variables,                                                        &
     84        ONLY:  dx, ddx, dy, ddy
     85
     86    USE lpm_collision_kernels_mod,                                             &
     87        ONLY:  rclass_lbound, rclass_ubound
     88
     89    USE kinds
     90
     91    USE particle_attributes,                                                   &
     92        ONLY:  hall_kernel, number_of_particles, offset_ocean_nzt,             &
     93               offset_ocean_nzt_m1, particles, radius_classes,                 &
     94               use_kernel_tables, wang_kernel
     95
    7196
    7297    IMPLICIT NONE
    7398
    74     INTEGER ::  i, internal_timestep_count, j, jtry, k, n, ros_count
    75 
    76     INTEGER, PARAMETER ::  maxtry = 40
    77 
    78     LOGICAL ::  repeat
    79 
    80     REAL ::  aa, afactor, arg, bb, cc, dd, ddenom, delta_r, drdt, drdt_ini,    &
    81              dt_ros, dt_ros_next, dt_ros_sum, dt_ros_sum_ini, d2rdtdr, errmax, &
    82              err_ros, g1, g2, g3, g4, e_a, e_s, gg, new_r, p_int, pt_int,      &
    83              pt_int_l, pt_int_u, q_int, q_int_l, q_int_u, r_ros, r_ros_ini,    &
    84              sigma, t_int, x, y, re_p
    85 
    86 !
     99    INTEGER(iwp) :: i                          !:
     100    INTEGER(iwp) :: internal_timestep_count    !:
     101    INTEGER(iwp) :: j                          !:
     102    INTEGER(iwp) :: jtry                       !:
     103    INTEGER(iwp) :: k                          !:
     104    INTEGER(iwp) :: n                          !:
     105    INTEGER(iwp) :: ros_count                  !:
     106 
     107    INTEGER(iwp), PARAMETER ::  maxtry = 40    !:
     108
     109    LOGICAL ::  repeat                         !:
     110
     111    REAL(wp) ::  aa                            !:
     112    REAL(wp) ::  afactor                       !:
     113    REAL(wp) ::  arg                           !:
     114    REAL(wp) ::  bb                            !:
     115    REAL(wp) ::  cc                            !:
     116    REAL(wp) ::  dd                            !:
     117    REAL(wp) ::  ddenom                        !:
     118    REAL(wp) ::  delta_r                       !:
     119    REAL(wp) ::  drdt                          !:
     120    REAL(wp) ::  drdt_ini                      !:
     121    REAL(wp) ::  dt_ros                        !:
     122    REAL(wp) ::  dt_ros_next                   !:
     123    REAL(wp) ::  dt_ros_sum                    !:
     124    REAL(wp) ::  dt_ros_sum_ini                !:
     125    REAL(wp) ::  d2rdtdr                       !:
     126    REAL(wp) ::  errmax                        !:
     127    REAL(wp) ::  err_ros                       !:
     128    REAL(wp) ::  g1                            !:
     129    REAL(wp) ::  g2                            !:
     130    REAL(wp) ::  g3                            !:
     131    REAL(wp) ::  g4                            !:
     132    REAL(wp) ::  e_a                           !:
     133    REAL(wp) ::  e_s                           !:
     134    REAL(wp) ::  gg                            !:
     135    REAL(wp) ::  new_r                         !:
     136    REAL(wp) ::  p_int                         !:
     137    REAL(wp) ::  pt_int                        !:
     138    REAL(wp) ::  pt_int_l                      !:
     139    REAL(wp) ::  pt_int_u                      !:
     140    REAL(wp) ::  q_int                         !:
     141    REAL(wp) ::  q_int_l                       !:
     142    REAL(wp) ::  q_int_u                       !:
     143    REAL(wp) ::  r_ros                         !:
     144    REAL(wp) ::  r_ros_ini                     !:
     145    REAL(wp) ::  sigma                         !:
     146    REAL(wp) ::  t_int                         !:
     147    REAL(wp) ::  x                             !:
     148    REAL(wp) ::  y                             !:
     149    REAL(wp) ::  re_p                          !:
     150 
    87151!-- Parameters for Rosenbrock method
    88     REAL, PARAMETER ::  a21 = 2.0, a31 = 48.0/25.0, a32 = 6.0/25.0,        &
    89                         b1 = 19.0/9.0, b2 = 0.5, b3 = 25.0/108.0,          &
    90                         b4 = 125.0/108.0, c21 = -8.0, c31 = 372.0/25.0,    &
    91                         c32 = 12.0/5.0, c41 = -112.0/125.0,                &
    92                         c42 = -54.0/125.0, c43 = -2.0/5.0,                 &
    93                         errcon = 0.1296, e1 = 17.0/54.0, e2 = 7.0/36.0,    &
    94                         e3 = 0.0, e4 = 125.0/108.0, gam = 0.5, grow = 1.5, &
    95                         pgrow = -0.25, pshrnk = -1.0/3.0, shrnk = 0.5
     152    REAL(wp), PARAMETER ::  a21 = 2.0          !:
     153    REAL(wp), PARAMETER ::  a31 = 48.0/25.0    !:
     154    REAL(wp), PARAMETER ::  a32 = 6.0/25.0     !:
     155    REAL(wp), PARAMETER ::  b1 = 19.0/9.0      !:
     156    REAL(wp), PARAMETER ::  b2 = 0.5           !:
     157    REAL(wp), PARAMETER ::  b3 = 25.0/108.0    !:
     158    REAL(wp), PARAMETER ::  b4 = 125.0/108.0   !:
     159    REAL(wp), PARAMETER ::  c21 = -8.0         !:
     160    REAL(wp), PARAMETER ::  c31 = 372.0/25.0   !:
     161    REAL(wp), PARAMETER ::  c32 = 12.0/5.0     !:
     162    REAL(wp), PARAMETER ::  c41 = -112.0/125.0 !:
     163    REAL(wp), PARAMETER ::  c42 = -54.0/125.0  !:
     164    REAL(wp), PARAMETER ::  c43 = -2.0/5.0     !:
     165    REAL(wp), PARAMETER ::  errcon = 0.1296    !:
     166    REAL(wp), PARAMETER ::  e1 = 17.0/54.0     !:
     167    REAL(wp), PARAMETER ::  e2 = 7.0/36.0      !:
     168    REAL(wp), PARAMETER ::  e3 = 0.0           !:
     169    REAL(wp), PARAMETER ::  e4 = 125.0/108.0   !:
     170    REAL(wp), PARAMETER ::  gam = 0.5          !:
     171    REAL(wp), PARAMETER ::  grow = 1.5         !:
     172    REAL(wp), PARAMETER ::  pgrow = -0.25      !:
     173    REAL(wp), PARAMETER ::  pshrnk = -1.0/3.0  !:
     174    REAL(wp), PARAMETER ::  shrnk = 0.5        !:
     175
    96176
    97177

  • palm/trunk/SOURCE/lpm_exchange_horiz.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    4549!------------------------------------------------------------------------------!
    4650
    47     USE control_parameters
    48     USE cpulog
    49     USE grid_variables
    50     USE indices
    51     USE particle_attributes
     51    USE control_parameters,                                                    &
     52        ONLY:  message_string, netcdf_output, netcdf_data_format
     53
     54    USE cpulog,                                                                &
     55        ONLY:  cpu_log, log_point_s
     56
     57    USE grid_variables,                                                        &
     58        ONLY:  ddx, ddy, dx, dy
     59
     60    USE indices,                                                               &
     61        ONLY:  nx, nxl, nxr, ny, nyn, nys
     62
     63    USE kinds
     64
     65    USE particle_attributes,                                                   &
     66        ONLY:  deleted_particles, deleted_tails, ibc_par_lr, ibc_par_ns,       &
     67               maximum_number_of_particles, maximum_number_of_tails,           &
     68               maximum_number_of_tailpoints, mpi_particle_type,                &
     69               number_of_tails, number_of_particles, particles, particle_mask, &
     70               particle_tail_coordinates, particle_type, tail_mask,            &
     71               trlp_count_sum, trlp_count_recv_sum, trnp_count_sum,            &
     72               trnp_count_recv_sum, trrp_count_sum, trrp_count_recv_sum,       &
     73               trsp_count_sum, trsp_count_recv_sum, use_particle_tails
     74
    5275    USE pegrid
    5376
    5477    IMPLICIT NONE
    5578
    56     INTEGER ::  i, j, n, nn, tlength, &
    57                 trlp_count, trlp_count_recv, trlpt_count, trlpt_count_recv, &
    58                 trnp_count, trnp_count_recv, trnpt_count, trnpt_count_recv, &
    59                 trrp_count, trrp_count_recv, trrpt_count, trrpt_count_recv, &
    60                 trsp_count, trsp_count_recv, trspt_count, trspt_count_recv
    61 
    62     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  trlpt, trnpt, trrpt, trspt
    63 
    64     TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp, trnp, trrp, trsp
    65 
     79    INTEGER(iwp) ::  i                                       !:
     80    INTEGER(iwp) ::  j                                       !:
     81    INTEGER(iwp) ::  n                                       !:
     82    INTEGER(iwp) ::  nn                                      !:
     83    INTEGER(iwp) ::  tlength                                 !:
     84    INTEGER(iwp) ::  trlp_count                              !:
     85    INTEGER(iwp) ::  trlp_count_recv                         !:
     86    INTEGER(iwp) ::  trlpt_count                             !:
     87    INTEGER(iwp) ::  trlpt_count_recv                        !:
     88    INTEGER(iwp) ::  trnp_count                              !:
     89    INTEGER(iwp) ::  trnp_count_recv                         !:
     90    INTEGER(iwp) ::  trnpt_count                             !:
     91    INTEGER(iwp) ::  trnpt_count_recv                        !:
     92    INTEGER(iwp) ::  trrp_count                              !:
     93    INTEGER(iwp) ::  trrp_count_recv                         !:
     94    INTEGER(iwp) ::  trrpt_count                             !:
     95    INTEGER(iwp) ::  trrpt_count_recv                        !:
     96    INTEGER(iwp) ::  trsp_count                              !:
     97    INTEGER(iwp) ::  trsp_count_recv                         !:
     98    INTEGER(iwp) ::  trspt_count                             !:
     99    INTEGER(iwp) ::  trspt_count_recv                        !:
     100
     101    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  trlpt        !:
     102    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  trnpt        !:
     103    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  trrpt        !:
     104    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  trspt        !:
     105
     106
     107    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp  !:
     108    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trnp  !:
     109    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trrp  !:
     110    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trsp  !:
    66111
    67112#if defined( __parallel )

  • palm/trunk/SOURCE/lpm_extend_particle_array.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3842!------------------------------------------------------------------------------!
    3943
    40     USE particle_attributes
     44    USE kinds
     45
     46    USE particle_attributes,                                                   &
     47        ONLY:  number_of_initial_particles, number_of_particles,               &
     48               maximum_number_of_particles, particles, particle_mask,          &
     49               particle_type, write_particle_statistics
    4150
    4251    IMPLICIT NONE
    4352
    44     INTEGER ::  new_maximum_number, number_of_new_particles
     53    INTEGER(iwp) ::  new_maximum_number                              !:
     54    INTEGER(iwp) ::  number_of_new_particles                         !:
    4555
    46     LOGICAL, DIMENSION(:), ALLOCATABLE ::  tmp_particle_mask
    4756
    48     TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles
     57    LOGICAL, DIMENSION(:), ALLOCATABLE ::  tmp_particle_mask         !:
     58
     59    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles !:
    4960
    5061

  • palm/trunk/SOURCE/lpm_extend_tail_array.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3842!------------------------------------------------------------------------------!
    3943
    40     USE particle_attributes
     44    USE kinds
     45
     46    USE particle_attributes,                                                   &
     47        ONLY:  maximum_number_of_tails, maximum_number_of_tailpoints,          &
     48               new_tail_id, number_of_initial_tails, number_of_tails,          &
     49               particle_tail_coordinates, tail_mask, write_particle_statistics
    4150
    4251    IMPLICIT NONE
    4352
    44     INTEGER ::  new_maximum_number, number_of_new_tails
     53    INTEGER(iwp) ::  new_maximum_number                           !:
     54    INTEGER(iwp) ::  number_of_new_tails                          !:
    4555
    46     LOGICAL, DIMENSION(maximum_number_of_tails) ::  tmp_tail_mask
     56    LOGICAL, DIMENSION(maximum_number_of_tails) ::  tmp_tail_mask !:
    4757
    48     REAL, DIMENSION(maximum_number_of_tailpoints,5,maximum_number_of_tails) :: &
    49                                                     tmp_tail
     58    REAL(wp), DIMENSION(maximum_number_of_tailpoints,5,maximum_number_of_tails) :: &
     59                                                    tmp_tail      !:
    5060
    5161

  • palm/trunk/SOURCE/lpm_extend_tails.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3842!------------------------------------------------------------------------------!
    3943
    40     USE control_parameters
    41     USE particle_attributes
     44    USE control_parameters,                                                    &
     45        ONLY:  dt_3d
     46
     47    USE kinds
     48
     49    USE particle_attributes,                                                   &
     50        ONLY:  maximum_number_of_tailpoints, maximum_tailpoint_age,            &
     51               minimum_tailpoint_distance, number_of_particles, particles,     &
     52               particle_tail_coordinates
    4253
    4354    IMPLICIT NONE
    4455
    45     INTEGER ::  i, n, nn
     56    INTEGER(iwp) ::  i       !:
     57    INTEGER(iwp) ::  n       !:
     58    INTEGER(iwp) ::  nn      !:
    4659
    47     REAL ::  distance
     60    REAL(wp) ::  distance    !:
    4861
    4962

  • palm/trunk/SOURCE/lpm_init.f90

    r1315 r1320  
    2020! Current revisions:
    2121! -----------------
     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
     28! bugfix: #if defined( __parallel ) added
    2229!
    2330! Former revisions:
    … …  
    5259! of arrays.
    5360!
    54 ! 622 2010-12-10 08:08:13Z raasch
    55 ! optional barriers included in order to speed up collective operations
    56 !
    57 ! 336 2009-06-10 11:19:35Z raasch
    58 ! Maximum number of tails is calculated from maximum number of particles and
    59 ! skip_particles_for_tail,
    60 ! output of messages replaced by message handling routine
    61 ! Bugfix: arrays for tails are allocated with a minimum size of 10 tails if
    62 ! there is no tail initially
    63 !
    64 ! 150 2008-02-29 08:19:58Z raasch
    65 ! Setting offset_ocean_* needed for calculating vertical indices within ocean
    66 ! runs
    67 !
    68 ! 117 2007-10-11 03:27:59Z raasch
    69 ! Sorting of particles only in case of cloud droplets
    70 !
    71 ! 106 2007-08-16 14:30:26Z raasch
    72 ! variable iran replaced by iran_part
    73 !
    74 ! 82 2007-04-16 15:40:52Z raasch
    75 ! Preprocessor directives for old systems removed
    76 !
    77 ! 70 2007-03-18 23:46:30Z raasch
    78 ! displacements for mpi_particle_type changed, age_m initialized,
    79 ! particles-package is now part of the default code
    80 !
    81 ! 16 2007-02-15 13:16:47Z raasch
    82 ! Bugfix: MPI_REAL in MPI_ALLREDUCE replaced by MPI_INTEGER
    83 !
    84 ! r4 | raasch | 2007-02-13 12:33:16 +0100 (Tue, 13 Feb 2007)
    85 ! RCS Log replace by Id keyword, revision history cleaned up
    86 !
    87 ! Revision 1.24  2007/02/11 13:00:17  raasch
    88 ! Bugfix: allocation of tail_mask and new_tail_id in case of restart-runs
    89 ! Bugfix: __ was missing in a cpp-directive
    90 !
    9161! Revision 1.1  1999/11/25 16:22:38  raasch
    9262! Initial revision
    … …  
    9969!------------------------------------------------------------------------------!
    10070
    101     USE arrays_3d
    102     USE cloud_parameters
    103     USE control_parameters
    104     USE dvrp_variables
    105     USE grid_variables
    106     USE indices
    107     USE lpm_collision_kernels_mod
    108     USE particle_attributes
     71    USE arrays_3d,                                                             &
     72        ONLY:  de_dx, de_dy, de_dz, zu, zw, z0
     73
     74    USE cloud_parameters,                                                      &
     75        ONLY:  curvature_solution_effects
     76
     77    USE control_parameters,                                                    &
     78        ONLY:  cloud_droplets, current_timestep_number, initializing_actions,  &
     79               message_string, netcdf_output,netcdf_data_format, ocean,        &
     80               prandtl_layer, simulated_time
     81
     82    USE dvrp_variables,                                                        &
     83        ONLY:  particle_color, particle_dvrpsize
     84
     85    USE grid_variables,                                                        &
     86        ONLY:  dx, dy
     87
     88    USE indices,                                                               &
     89        ONLY:  nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb, nzt
     90
     91    USE kinds
     92
     93    USE lpm_collision_kernels_mod,                                             &
     94        ONLY:  init_kernels
     95
     96    USE particle_attributes,                                                   &
     97        ONLY:   bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,    &
     98                density_ratio, dvrp_psize, initial_weighting_factor, ibc_par_b,&
     99                ibc_par_lr, ibc_par_ns, ibc_par_t, initial_particles,          &
     100                iran_part, log_z_z0, max_number_of_particle_groups,            &
     101                maximum_number_of_particles, maximum_number_of_tailpoints,     &
     102                minimum_tailpoint_distance, maximum_number_of_tails,           &
     103                mpi_particle_type, new_tail_id, number_of_initial_particles,   &
     104                number_of_initial_tails, number_of_particles,                  &
     105                number_of_particle_groups, number_of_sublayers,                &
     106                number_of_tails, offset_ocean_nzt, offset_ocean_nzt_m1, part_1,&
     107                part_2, particles, particle_advection_start, particle_groups,  &
     108                particle_groups_type, particle_mask, particles_per_point,      &
     109                particle_tail_coordinates,  particle_type, pdx, pdy, pdz,      &
     110                prt_count, prt_start_index, psb, psl, psn, psr, pss, pst,      &
     111                radius, random_start_position, read_particles_from_restartfile,&
     112                skip_particles_for_tail, sort_count, tail_mask,                &
     113                total_number_of_particles, total_number_of_tails,              &
     114                use_particle_tails, use_sgs_for_particles,                     &
     115                write_particle_statistics, uniform_particles, z0_av_global
     116
    109117    USE pegrid
    110     USE random_function_mod
     118
     119    USE random_function_mod,                                                   &
     120        ONLY:  random_function
    111121
    112122
    113123    IMPLICIT NONE
    114124
    115     INTEGER ::  i, j, k, n, nn
     125    INTEGER(iwp) ::  i                           !:
     126    INTEGER(iwp) ::  j                           !:
     127    INTEGER(iwp) ::  k                           !:
     128    INTEGER(iwp) ::  n                           !:
     129    INTEGER(iwp) ::  nn                          !:
     130
    116131#if defined( __parallel )
    117     INTEGER, DIMENSION(3) ::  blocklengths, displacements, types
     132    INTEGER(iwp), DIMENSION(3) ::  blocklengths  !:
     133    INTEGER(iwp), DIMENSION(3) ::  displacements !:
     134    INTEGER(iwp), DIMENSION(3) ::  types         !:
    118135#endif
    119     LOGICAL ::  uniform_particles_l
    120     REAL    ::  height_int, height_p, pos_x, pos_y, pos_z, z_p,            &
    121                 z0_av_local = 0.0
     136    LOGICAL ::  uniform_particles_l              !:
     137
     138    REAL(wp)    ::  height_int                   !:
     139    REAL(wp)    ::  height_p                     !:
     140    REAL(wp)    ::  pos_x                        !:
     141    REAL(wp)    ::  pos_y                        !:
     142    REAL(wp)    ::  pos_z                        !:
     143    REAL(wp)    ::  z_p                          !:
     144    REAL(wp)    ::  z0_av_local = 0.0            !:
     145
     146               
    122147
    123148
    … …  
    211236       z0_av_global = 0.0
    212237
     238#if defined( __parallel )
    213239       CALL MPI_ALLREDUCE(z0_av_local, z0_av_global, 1, MPI_REAL, MPI_SUM, &
    214240                          comm2d, ierr )
     241#else
     242       z0_av_global = z0_av_local
     243#endif
    215244
    216245       z0_av_global = z0_av_global  / ( ( ny + 1 ) * ( nx + 1 ) )

  • palm/trunk/SOURCE/lpm_init_sgs_tke.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    4145!------------------------------------------------------------------------------!
    4246
    43     USE arrays_3d
    44     USE control_parameters
    45     USE grid_variables
    46     USE indices
    47     USE particle_attributes
     47    USE arrays_3d,                                                             &
     48        ONLY:  de_dx, de_dy, de_dz, diss, e, u, v, w, zu
     49
     50    USE grid_variables,                                                        &
     51        ONLY:  ddx, ddy
     52
     53    USE indices,                                                               &
     54        ONLY:  nbgp, ngp_2dh_outer, nx, nxl, nxr, ny, nyn, nys, nz, nzb,       &
     55                      nzb_s_inner, nzb_s_outer, nzt
     56
     57    USE kinds
     58
     59    USE particle_attributes,                                                   &
     60        ONLY:  sgs_wfu_part, sgs_wfv_part, sgs_wfw_part
     61
    4862    USE pegrid
    49     USE statistics
     63
     64    USE statistics,                                                            &
     65        ONLY:  flow_statistics_called, hom, sums, sums_l
    5066
    5167    IMPLICIT NONE
    5268
    53     INTEGER ::  i, j, k
     69    INTEGER(iwp) ::  i      !:
     70    INTEGER(iwp) ::  j      !:
     71    INTEGER(iwp) ::  k      !:
    5472
    5573

  • palm/trunk/SOURCE/lpm_pack_arrays.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    4044!------------------------------------------------------------------------------!
    4145
    42     USE particle_attributes
     46    USE kinds
     47
     48    USE particle_attributes,                                                   &
     49        ONLY:  deleted_particles, deleted_tails, new_tail_id,                  &
     50               number_of_particles, number_of_tails, particles, particle_mask, &
     51               particle_tail_coordinates, tail_mask, use_particle_tails
     52
    4353
    4454    IMPLICIT NONE
    4555
    46     INTEGER ::  n, nd, nn
    47 
    48 
     56    INTEGER(iwp) ::  n       !:
     57    INTEGER(iwp) ::  nd      !:
     58    INTEGER(iwp) ::  nn      !:
    4959!
    5060!-- Find out elements marked for deletion and move data with higher index

  • palm/trunk/SOURCE/lpm_read_restart_file.f90

    r1310 r1320  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! comment fields (!:) to be used for variable explanations added to
     24! all variable declaration statements
    2325!
    2426! Former revisions:
    … …  
    3840!------------------------------------------------------------------------------!
    3941
    40     USE control_parameters
    41     USE indices
    42     USE particle_attributes
     42    USE control_parameters,                                                    &
     43        ONLY:  message_string
     44
     45    USE indices,                                                               &
     46        ONLY:  nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
     47
     48    USE particle_attributes,                                                   &
     49        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, initial_particles,    &
     50               number_of_initial_particles, maximum_number_of_particles,       &
     51               maximum_number_of_tailpoints, maximum_number_of_tails,          &
     52               new_tail_id, number_of_particles, number_of_particle_groups,    &
     53               number_of_tails, particles, particle_groups, particle_mask,     &
     54               particle_tail_coordinates, particle_type, part_1, part_2,       &
     55               prt_count, prt_start_index,  sort_count, tail_mask, time_prel,  &
     56               time_write_particle_data, uniform_particles, use_particle_tails
     57
     58
    4359    USE pegrid
    4460
    4561    IMPLICIT NONE
    4662
    47     CHARACTER (LEN=10) ::  particle_binary_version, version_on_file
     63    CHARACTER (LEN=10) ::  particle_binary_version    !:
     64    CHARACTER (LEN=10) ::  version_on_file            !:
    4865
    4966!

  • palm/trunk/SOURCE/lpm_release_set.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    4044!------------------------------------------------------------------------------!
    4145
    42     USE control_parameters
    43     USE grid_variables
    44     USE indices
    45     USE particle_attributes
    46     USE random_function_mod
     46    USE control_parameters,                                                    &
     47        ONLY:  iran, message_string, netcdf_data_format, netcdf_output
     48
     49    USE grid_variables,                                                        &
     50        ONLY:  dx, dy
     51
     52    USE indices,                                                               &
     53        ONLY:  nxl, nxr, nyn, nys
     54
     55    USE kinds
     56
     57    USE particle_attributes,                                                   &
     58        ONLY:  initial_particles, iran_part, maximum_number_of_particles,      &
     59               maximum_number_of_tails, minimum_tailpoint_distance,            &
     60               number_of_initial_particles, number_of_initial_tails,           &
     61               number_of_particles, number_of_tails, particles,                &
     62               particle_tail_coordinates, pdx, pdy, pdz, psb, psl, psn, psr,   &
     63               pss, pst, random_start_position, use_particle_tails
     64
     65    USE random_function_mod,                                                   &
     66        ONLY:  random_function
    4767
    4868    IMPLICIT NONE
    4969
    50     INTEGER ::  ie, is, n, nn
     70    INTEGER(iwp) ::  ie     !:
     71    INTEGER(iwp) ::  is     !:
     72    INTEGER(iwp) ::  n      !:
     73    INTEGER(iwp) ::  nn     !:
    5174
    5275

  • palm/trunk/SOURCE/lpm_set_attributes.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! 828 2012-02-21 12:00:36Z raasch
    3843! particle feature color renamed class
    39 !
    40 ! 622 2010-12-10 08:08:13Z raasch
    41 ! optional barriers included in order to speed up collective operations
    4244!
    4345! 271 2009-03-26 00:47:14Z raasch
    … …  
    5052!------------------------------------------------------------------------------!
    5153
    52     USE arrays_3d
    53     USE control_parameters
    54     USE cpulog
    55     USE dvrp_variables
    56     USE grid_variables
    57     USE indices
    58     USE particle_attributes
     54    USE arrays_3d,                                                             &
     55        ONLY:  pt, u, v, w, zu, zw
     56
     57    USE control_parameters,                                                    &
     58        ONLY:  atmos_ocean_sign, u_gtrans, v_gtrans, dz
     59
     60    USE cpulog,                                                                &
     61        ONLY:  cpu_log, log_point_s
     62
     63    USE dvrp_variables,                                                        &
     64        ONLY:  color_interval, dvrp_colortable_entries_prt, dvrpsize_interval, &
     65               particle_color, particle_dvrpsize
     66
     67    USE grid_variables,                                                        &
     68        ONLY:  ddx, dx, ddy, dy
     69
     70    USE indices,                                                               &
     71        ONLY:  ngp_2dh, nxl, nxr, nyn, nys, nzb, nzt
     72
     73    USE kinds
     74
     75    USE particle_attributes,                                                   &
     76        ONLY:  number_of_particles, offset_ocean_nzt, particles
     77
    5978    USE pegrid
    60     USE statistics
     79
     80    USE statistics,                                                            &
     81        ONLY:  sums, sums_l
    6182
    6283    IMPLICIT NONE
    6384
    64     INTEGER ::  i, j, k, n
    65     REAL    ::  aa, absuv, bb, cc, dd, gg, height, pt_int, pt_int_l, pt_int_u, &
    66                 u_int, u_int_l, u_int_u, v_int, v_int_l, v_int_u, w_int,       &
    67                 w_int_l, w_int_u, x, y
    68 
     85    INTEGER(iwp) ::  i        !:
     86    INTEGER(iwp) ::  j        !:
     87    INTEGER(iwp) ::  k        !:
     88    INTEGER(iwp) ::  n        !:
     89
     90    REAL(wp)    ::  aa        !:
     91    REAL(wp)    ::  absuv     !:
     92    REAL(wp)    ::  bb        !:
     93    REAL(wp)    ::  cc        !:
     94    REAL(wp)    ::  dd        !:
     95    REAL(wp)    ::  gg        !:
     96    REAL(wp)    ::  height    !:
     97    REAL(wp)    ::  pt_int    !:
     98    REAL(wp)    ::  pt_int_l  !:
     99    REAL(wp)    ::  pt_int_u  !:
     100    REAL(wp)    ::  u_int     !:
     101    REAL(wp)    ::  u_int_l   !:
     102    REAL(wp)    ::  u_int_u   !:
     103    REAL(wp)    ::  v_int     !:
     104    REAL(wp)    ::  v_int_l   !:
     105    REAL(wp)    ::  v_int_u   !:
     106    REAL(wp)    ::  w_int     !:
     107    REAL(wp)    ::  w_int_l   !:
     108    REAL(wp)    ::  w_int_u   !:
     109    REAL(wp)    ::  x         !:
     110    REAL(wp)    ::  y         !:
    69111
    70112    CALL cpu_log( log_point_s(49), 'lpm_set_attributes', 'start' )

  • palm/trunk/SOURCE/lpm_sort_arrays.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    4145!------------------------------------------------------------------------------!
    4246
    43     USE arrays_3d
    44     USE control_parameters
    45     USE cpulog
    46     USE grid_variables
    47     USE indices
    48     USE particle_attributes
     47    USE control_parameters,                                                     &
     48        ONLY:  message_string, dz
     49
     50    USE cpulog,                                                                 &
     51        ONLY:  cpu_log, log_point_s
     52
     53    USE grid_variables,                                                         &
     54        ONLY:  ddx, dx, ddy, dy
     55
     56    USE indices,                                                                &
     57        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
     58
     59    USE kinds
     60
     61    USE particle_attributes,                                                    &
     62        ONLY:  number_of_particles, offset_ocean_nzt, part_1, part_2, particles,&
     63               particle_type, prt_count, prt_start_index, sort_count
    4964
    5065    IMPLICIT NONE
    5166
    52     INTEGER ::  i, ilow, j, k, n
     67    INTEGER(iwp) ::  i                                            !:
     68    INTEGER(iwp) ::  ilow                                         !:
     69    INTEGER(iwp) ::  j                                            !:
     70    INTEGER(iwp) ::  k                                            !:
     71    INTEGER(iwp) ::  n                                            !:
    5372
    54     TYPE(particle_type), DIMENSION(:), POINTER ::  particles_temp
     73    TYPE(particle_type), DIMENSION(:), POINTER ::  particles_temp !:
    5574
    5675

  • palm/trunk/SOURCE/lpm_write_exchange_statistics.f90

    r1310 r1320  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! comment fields (!:) to be used for variable explanations added to
     24! all variable declaration statements
    2325!
    2426! Former revisions:
    … …  
    4244!------------------------------------------------------------------------------!
    4345
    44     USE control_parameters
    45     USE particle_attributes
     46    USE control_parameters,                                                     &
     47        ONLY:  current_timestep_number, dt_3d, simulated_time
     48
     49    USE particle_attributes,                                                    &
     50        ONLY:  maximum_number_of_particles, number_of_particles, trlp_count_sum,&
     51               trlp_count_recv_sum, trnp_count_sum, trnp_count_recv_sum,        &
     52               trrp_count_sum, trrp_count_recv_sum, trsp_count_sum,             &
     53               trsp_count_recv_sum
     54
    4655    USE pegrid
    4756

  • palm/trunk/SOURCE/lpm_write_restart_file.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3842!------------------------------------------------------------------------------!
    3943
    40     USE control_parameters
    41     USE particle_attributes
     44    USE control_parameters,                                                    &
     45        ONLY:  io_blocks, io_group
     46
     47    USE kinds
     48
     49    USE particle_attributes,                                                   &
     50        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, initial_particles,    &
     51        maximum_number_of_particles,  maximum_number_of_tails,                 &
     52        maximum_number_of_tailpoints, number_of_initial_particles,             &
     53        number_of_particles, number_of_particle_groups, number_of_tails,       &
     54        particles, particle_groups, particle_tail_coordinates, prt_count,      &
     55        prt_start_index, time_prel, time_write_particle_data,                  &
     56        uniform_particles, use_particle_tails
     57
    4258    USE pegrid
    4359
    4460    IMPLICIT NONE
    4561
    46     CHARACTER (LEN=10) ::  particle_binary_version
    47     INTEGER ::  i
     62    CHARACTER (LEN=10) ::  particle_binary_version   !:
     63    INTEGER(iwp) ::  i                               !:
    4864
    4965!

  • palm/trunk/SOURCE/ls_forcing.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    5963    SUBROUTINE init_ls_forcing
    6064
    61        USE arrays_3d
    62        USE control_parameters
    63        USE cpulog
    64        USE indices
    65        USE pegrid
     65       USE arrays_3d,                                                          &
     66           ONLY:  p_surf, pt_surf, q_surf, qsws_surf, shf_surf, time_surf,     &
     67                  time_vert, ug_vert, vg_vert, wsubs_vert, zu
     68
     69       USE control_parameters,                                                 &
     70           ONLY:  end_time, lsf_surf, lsf_vert, message_string, nlsf
     71
     72       USE indices,                                                            &
     73           ONLY:  nzb, nzt
     74
     75       USE kinds
     76
    6677
    6778       IMPLICIT NONE
    6879
    69        INTEGER ::  finput = 90, ierrn, k, t
    70        CHARACTER (100)::  chmess
    71        CHARACTER(1) ::  hash
    72        REAL ::  r_dummy, fac
    73        REAL ::  highheight, highug_vert, highvg_vert, highwsubs_vert
    74        REAL ::  lowheight, lowug_vert, lowvg_vert, lowwsubs_vert
     80       CHARACTER(100) ::  chmess              !:
     81       CHARACTER(1)   ::  hash                !:
     82
     83       INTEGER(iwp) ::  ierrn                 !:
     84       INTEGER(iwp) ::  finput = 90           !:
     85       INTEGER(iwp) ::  k                     !:
     86       INTEGER(iwp) ::  t                     !:
     87
     88       REAL(wp) ::  fac                       !:
     89       REAL(wp) ::  highheight                !:
     90       REAL(wp) ::  highug_vert               !:
     91       REAL(wp) ::  highvg_vert               !:
     92       REAL(wp) ::  highwsubs_vert            !:
     93       REAL(wp) ::  lowheight                 !:
     94       REAL(wp) ::  lowug_vert                !:
     95       REAL(wp) ::  lowvg_vert                !:
     96       REAL(wp) ::  lowwsubs_vert             !:
     97       REAL(wp) ::  r_dummy                   !:
    7598
    7699       ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf),         &
    … …  
    226249    SUBROUTINE ls_forcing_surf ( time )
    227250
    228        USE arrays_3d
    229        USE control_parameters
    230        USE cpulog
    231        USE indices
    232        USE pegrid
     251       USE arrays_3d,                                                          &
     252           ONLY:  p_surf, pt_surf, q_surf, qsws, qsws_surf, shf, shf_surf,     &
     253                  time_surf, time_vert, ug, ug_vert, vg, vg_vert
     254
     255       USE control_parameters,                                                 &
     256           ONLY:  bc_q_b, ibc_pt_b, ibc_q_b, pt_surface, q_surface,            &
     257                  surface_pressure
     258
     259       USE kinds
     260
    233261
    234262       IMPLICIT NONE
    235263
    236        REAL, INTENT(in)  :: time
    237        REAL :: fac
    238        INTEGER :: t
     264       INTEGER(iwp) ::  t                     !:
     265
     266       REAL(wp)             :: fac            !:
     267       REAL(wp), INTENT(in) :: time           !:
    239268
    240269!
    … …  
    284313    SUBROUTINE ls_forcing_vert ( time )
    285314
    286        USE arrays_3d
    287        USE control_parameters
    288        USE cpulog
    289        USE indices
    290        USE pegrid
     315       USE arrays_3d,                                                          &
     316           ONLY:  time_vert, ug, ug_vert, vg, vg_vert, w_subs, wsubs_vert
     317
     318       USE control_parameters,                                                 &
     319           ONLY:  large_scale_subsidence
     320
     321       USE kinds
     322
    291323
    292324       IMPLICIT NONE
    293325
    294        REAL, INTENT(in)  :: time
    295        REAL :: fac
    296        INTEGER :: t
     326       INTEGER(iwp) ::  t                     !:
     327
     328       REAL(wp)             ::  fac           !:
     329       REAL(wp), INTENT(in) ::  time          !:
    297330
    298331!

  • palm/trunk/SOURCE/message.f90

    r1310 r1320  
    2121! Current revisions:
    2222! -----------------
    23 !
     23! ONLY-attribute added to USE-statements,
     24! kind-parameters added to all INTEGER and REAL declaration statements,
     25! revision history before 2012 removed,
     26! comment fields (!:) to be used for variable explanations added to
     27! all variable declaration statements
    2428!
    2529! Former revisions:
    … …  
    2933! 1036 2012-10-22 13:43:42Z raasch
    3034! code put under GPL (PALM 3.9)
    31 !
    32 ! 746 2011-08-18 21:14:48Z letzel
    33 ! 'wiki' inserted into weblink path to error message database
    34 !
    35 ! 563 2010-09-30 13:08:44Z raasch
    36 ! Weblink to error message database changed to new trac server
    3735!
    3836! 213 2008-11-13 10:26:18Z raasch
    … …  
    5048!------------------------------------------------------------------------------!
    5149
     50    USE control_parameters,                                                  &
     51        ONLY:  abort_mode, message_string
     52
     53    USE kinds
     54
    5255    USE pegrid
    53     USE control_parameters
    5456
    5557    IMPLICIT NONE
    5658
    57     CHARACTER(LEN=6)   ::  message_identifier
    58     CHARACTER(LEN=*)   ::  routine_name
    59     CHARACTER(LEN=200) ::  header_string, information_string_1,information_string_2
    60 
    61     INTEGER ::  file_id, flush, i, message_level, output_on_pe, requested_action
    62 
    63     LOGICAL ::  do_output, pe_out_of_range
     59    CHARACTER(LEN=6)   ::  message_identifier            !:
     60    CHARACTER(LEN=*)   ::  routine_name                  !:
     61    CHARACTER(LEN=200) ::  header_string                 !:
     62    CHARACTER(LEN=200) ::  information_string_1          !:
     63    CHARACTER(LEN=200) ::  information_string_2          !:
     64
     65    INTEGER(iwp) ::  file_id                             !:
     66    INTEGER(iwp) ::  flush                               !:
     67    INTEGER(iwp) ::  i                                   !:
     68    INTEGER(iwp) ::  message_level                       !:
     69    INTEGER(iwp) ::  output_on_pe                        !:
     70    INTEGER(iwp) ::  requested_action                    !:
     71
     72    LOGICAL ::  do_output                                !:
     73    LOGICAL ::  pe_out_of_range                          !:
    6474
    6575

  • palm/trunk/SOURCE/microphysics.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! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    111115       USE grid_variables
    112116       USE indices
     117       USE kinds
    113118       USE statistics
    114119
    115120       IMPLICIT NONE
    116121
    117        INTEGER ::  i, j, k
    118 
     122       INTEGER(iwp) ::  i                 !:
     123       INTEGER(iwp) ::  j                 !:
     124       INTEGER(iwp) ::  k                 !:
    119125 
    120126       DO  i = nxl, nxr
    … …  
    133139       USE cloud_parameters
    134140       USE indices
    135 
    136        IMPLICIT NONE
    137 
    138        INTEGER ::  i, j, k
     141       USE kinds
     142
     143       IMPLICIT NONE
     144
     145       INTEGER(iwp) ::  i                 !:
     146       INTEGER(iwp) ::  j                 !:
     147       INTEGER(iwp) ::  k                 !:
    139148
    140149 
    … …  
    157166       USE grid_variables
    158167       USE indices
    159 
    160        IMPLICIT NONE
    161 
    162        INTEGER ::  i, j, k
    163 
    164  
     168       USE kinds
     169
     170       IMPLICIT NONE
     171
     172       INTEGER(iwp) ::  i                 !:
     173       INTEGER(iwp) ::  j                 !:
     174       INTEGER(iwp) ::  k                 !:
     175
    165176       DO  i = nxl, nxr
    166177          DO  j = nys, nyn
    … …  
    180191       USE control_parameters
    181192       USE indices
    182 
    183        IMPLICIT NONE
    184 
    185        INTEGER ::  i, j, k
    186 
    187  
     193       USE kinds
     194
     195       IMPLICIT NONE
     196
     197       INTEGER(iwp) ::  i                 !:
     198       INTEGER(iwp) ::  j                 !:
     199       INTEGER(iwp) ::  k                 !:
     200
    188201       DO  i = nxl, nxr
    189202          DO  j = nys, nyn
    … …  
    203216       USE control_parameters
    204217       USE indices
    205 
    206        IMPLICIT NONE
    207 
    208        INTEGER ::  i, j, k
     218       USE kinds
     219
     220       IMPLICIT NONE
     221
     222       INTEGER(iwp) ::  i                 !:
     223       INTEGER(iwp) ::  j                 !:
     224       INTEGER(iwp) ::  k                 !:
    209225
    210226 
    … …  
    227243       USE control_parameters
    228244       USE indices
    229 
    230        IMPLICIT NONE
    231 
    232        INTEGER ::  i, j, k
    233 
     245       USE kinds
     246
     247       IMPLICIT NONE
     248
     249       INTEGER(iwp) ::  i                 !:
     250       INTEGER(iwp) ::  j                 !:
     251       INTEGER(iwp) ::  k                 !:
    234252 
    235253       DO  i = nxl, nxr
    … …  
    251269       USE control_parameters
    252270       USE indices
    253 
    254        IMPLICIT NONE
    255 
    256        INTEGER ::  i, j, k
    257 
     271       USE kinds
     272
     273       IMPLICIT NONE
     274
     275       INTEGER(iwp) ::  i                 !:
     276       INTEGER(iwp) ::  j                 !:
     277       INTEGER(iwp) ::  k                 !:
    258278 
    259279       DO  i = nxl, nxr
    … …  
    275295       USE control_parameters
    276296       USE indices
     297       USE kinds
    277298       USE statistics
    278299
    279300       IMPLICIT NONE
    280301
    281        INTEGER ::  i, j, k
    282 
     302       INTEGER(iwp) ::  i                 !:
     303       INTEGER(iwp) ::  j                 !:
     304       INTEGER(iwp) ::  k                 !:
    283305 
    284306       DO  i = nxl, nxr
    … …  
    299321    SUBROUTINE microphysics_control_ij( i, j )
    300322
    301        USE arrays_3d
    302        USE cloud_parameters
    303        USE control_parameters
    304        USE grid_variables
    305        USE indices
    306        USE statistics
    307 
    308        IMPLICIT NONE
    309 
    310        INTEGER ::  i, j, k
    311        REAL    ::  t_surface
     323       USE arrays_3d,                                                          &
     324           ONLY:  hyp, nc_1d,  nr, nr_1d, pt, pt_init, pt_1d, q, q_1d, qc,     &
     325                  qc_1d, qr, qr_1d, tend_nr, tend_pt, tend_q, tend_qr, zu
     326
     327       USE cloud_parameters,                                                   &
     328           ONLY:  cp, hyrho, nc_const, pt_d_t, r_d, t_d_pt
     329
     330       USE control_parameters,                                                 &
     331           ONLY:  drizzle, dt_3d, dt_micro, g, intermediate_timestep_count,    &
     332                  large_scale_forcing, lsf_surf, precipitation, pt_surface,    &
     333                  rho_surface,surface_pressure
     334
     335       USE indices,                                                            &
     336           ONLY:  nzb, nzt
     337
     338       USE kinds
     339
     340       USE statistics,                                                         &
     341           ONLY:  weight_pres
     342
     343       IMPLICIT NONE
     344
     345       INTEGER(iwp) ::  i                 !:
     346       INTEGER(iwp) ::  j                 !:
     347       INTEGER(iwp) ::  k                 !:
     348
     349       REAL(wp)     ::  t_surface         !:
    312350
    313351       IF ( large_scale_forcing .AND. lsf_surf ) THEN
    … …  
    369407    SUBROUTINE adjust_cloud_ij( i, j )
    370408
    371        USE arrays_3d
    372        USE cloud_parameters
    373        USE indices
    374 
    375        IMPLICIT NONE
    376 
    377        INTEGER ::  i, j, k
     409       USE arrays_3d,                                                          &
     410           ONLY:  qr, nr
     411
     412       USE cloud_parameters,                                                   &
     413           ONLY:  eps_sb, xrmin, xrmax, hyrho, k_cc, x0
     414
     415       USE indices,                                                            &
     416           ONLY:  nzb, nzb_s_inner, nzt
     417
     418       USE kinds
     419
     420       IMPLICIT NONE
     421
     422       INTEGER(iwp) ::  i                 !:
     423       INTEGER(iwp) ::  j                 !:
     424       INTEGER(iwp) ::  k                 !:
    378425!
    379426!--    Adjust number of raindrops to avoid nonlinear effects in
    … …  
    407454    SUBROUTINE autoconversion_ij( i, j )
    408455
    409        USE arrays_3d
    410        USE cloud_parameters
    411        USE control_parameters
    412        USE grid_variables
    413        USE indices
    414 
    415        IMPLICIT NONE
    416 
    417        INTEGER ::  i, j, k
    418        REAL    ::  alpha_cc, autocon, epsilon, k_au, l_mix, nu_c, phi_au,      &
    419                    r_cc, rc, re_lambda, selfcoll, sigma_cc, tau_cloud, xc                     
    420 
     456       USE arrays_3d,                                                          &
     457           ONLY:  diss, dzu, nc_1d, nr_1d, qc_1d, qr_1d
     458
     459       USE cloud_parameters,                                                   &
     460           ONLY:  a_1, a_2, a_3, b_1, b_2, b_3, beta_cc, c_1, c_2, c_3,        &
     461                  c_const, dpirho_l, eps_sb, hyrho, k_cc, kin_vis_air, x0
     462
     463       USE control_parameters,                                                 &
     464           ONLY:  dt_micro, rho_surface, turbulence
     465
     466       USE grid_variables,                                                     &
     467           ONLY:  dx, dy
     468
     469       USE indices,                                                            &
     470           ONLY:  nzb, nzb_s_inner, nzt
     471
     472       USE kinds
     473
     474       IMPLICIT NONE
     475
     476       INTEGER(iwp) ::  i                 !:
     477       INTEGER(iwp) ::  j                 !:
     478       INTEGER(iwp) ::  k                 !:
     479
     480       REAL(wp)     ::  alpha_cc          !:                   
     481       REAL(wp)     ::  autocon           !:
     482       REAL(wp)     ::  epsilon           !:
     483       REAL(wp)     ::  k_au              !:
     484       REAL(wp)     ::  l_mix             !:
     485       REAL(wp)     ::  nu_c              !:
     486       REAL(wp)     ::  phi_au            !:
     487       REAL(wp)     ::  r_cc              !:
     488       REAL(wp)     ::  rc                !:
     489       REAL(wp)     ::  re_lambda         !:
     490       REAL(wp)     ::  selfcoll          !:
     491       REAL(wp)     ::  sigma_cc          !:
     492       REAL(wp)     ::  tau_cloud         !:
     493       REAL(wp)     ::  xc                !:
    421494
    422495       k_au = k_cc / ( 20.0 * x0 )
    … …  
    491564    SUBROUTINE accretion_ij( i, j )
    492565
    493        USE arrays_3d
    494        USE cloud_parameters
    495        USE control_parameters
    496        USE indices
    497 
    498        IMPLICIT NONE
    499 
    500        INTEGER ::  i, j, k
    501        REAL    ::  accr, k_cr, phi_ac, tau_cloud, xc
     566       USE arrays_3d,                                                          &
     567           ONLY:  diss, qc_1d, qr_1d
     568
     569       USE cloud_parameters,                                                   &
     570           ONLY:  eps_sb, hyrho, k_cr0
     571
     572       USE control_parameters,                                                 &
     573           ONLY:  dt_micro, rho_surface, turbulence
     574
     575       USE indices,                                                            &
     576           ONLY:  nzb, nzb_s_inner, nzt
     577
     578       USE kinds
     579
     580       IMPLICIT NONE
     581
     582       INTEGER(iwp) ::  i                 !:
     583       INTEGER(iwp) ::  j                 !:
     584       INTEGER(iwp) ::  k                 !:
     585
     586       REAL(wp)     ::  accr              !:
     587       REAL(wp)     ::  k_cr              !:
     588       REAL(wp)     ::  phi_ac            !:
     589       REAL(wp)     ::  tau_cloud         !:
     590       REAL(wp)     ::  xc                !:
    502591
    503592       DO  k = nzb_s_inner(j,i)+1, nzt
    … …  
    539628    SUBROUTINE selfcollection_breakup_ij( i, j )
    540629
    541        USE arrays_3d
    542        USE cloud_parameters
    543        USE control_parameters
    544        USE indices
     630       USE arrays_3d,                                                          &
     631           ONLY:  nr_1d, qr_1d
     632
     633       USE cloud_parameters,                                                   &
     634           ONLY:  dpirho_l, eps_sb, hyrho, k_br, k_rr
     635
     636       USE control_parameters,                                                 &
     637           ONLY:  dt_micro, rho_surface
     638
     639       USE indices,                                                            &
     640           ONLY:  nzb, nzb_s_inner, nzt
     641
     642       USE kinds
    545643   
    546644       IMPLICIT NONE
    547645
    548        INTEGER ::  i, j, k
    549        REAL    ::  breakup, dr, phi_br, selfcoll
     646       INTEGER(iwp) ::  i                 !:
     647       INTEGER(iwp) ::  j                 !:
     648       INTEGER(iwp) ::  k                 !:
     649
     650       REAL(wp)     ::  breakup           !:
     651       REAL(wp)     ::  dr                !:
     652       REAL(wp)     ::  phi_br            !:
     653       REAL(wp)     ::  selfcoll          !:
    550654
    551655       DO  k = nzb_s_inner(j,i)+1, nzt
    … …  
    581685!--    precipitable water.
    582686
    583        USE arrays_3d
    584        USE cloud_parameters
    585        USE constants
    586        USE control_parameters
    587        USE indices
    588 
    589        IMPLICIT NONE
    590 
    591        INTEGER ::  i, j, k
    592        REAL    ::  alpha, dr, e_s, evap, evap_nr, f_vent, g_evap, lambda_r, &
    593                    mu_r, mu_r_2, mu_r_5d2, nr_0, q_s, sat, t_l, temp, xr
     687       USE arrays_3d,                                                          &
     688           ONLY:  hyp, nr_1d, pt_1d, q_1d,  qc_1d, qr_1d
     689
     690       USE cloud_parameters,                                                   &
     691           ONLY:  a_term, a_vent, b_term, b_vent, c_evap, c_term, diff_coeff_l,&
     692                  dpirho_l, eps_sb, hyrho, kin_vis_air, k_st, l_d_cp, l_d_r,   &
     693                  l_v, rho_l, r_v, schmidt_p_1d3, thermal_conductivity_l,      &
     694                  t_d_pt, ventilation_effect
     695
     696       USE constants,                                                          &
     697           ONLY:  pi
     698
     699       USE control_parameters,                                                 &
     700           ONLY:  dt_micro
     701
     702       USE indices,                                                            &
     703           ONLY:  nzb, nzb_s_inner, nzt
     704
     705       USE kinds
     706
     707       IMPLICIT NONE
     708
     709       INTEGER(iwp) ::  i                 !:
     710       INTEGER(iwp) ::  j                 !:
     711       INTEGER(iwp) ::  k                 !:
     712
     713       REAL(wp)     ::  alpha             !:
     714       REAL(wp)     ::  dr                !:
     715       REAL(wp)     ::  e_s               !:
     716       REAL(wp)     ::  evap              !:
     717       REAL(wp)     ::  evap_nr           !:
     718       REAL(wp)     ::  f_vent            !:
     719       REAL(wp)     ::  g_evap            !:
     720       REAL(wp)     ::  lambda_r          !:
     721       REAL(wp)     ::  mu_r              !:
     722       REAL(wp)     ::  mu_r_2            !:
     723       REAL(wp)     ::  mu_r_5d2          !:
     724       REAL(wp)     ::  nr_0              !:
     725       REAL(wp)     ::  q_s               !:
     726       REAL(wp)     ::  sat               !:
     727       REAL(wp)     ::  t_l               !:
     728       REAL(wp)     ::  temp              !:
     729       REAL(wp)     ::  xr                !:
    594730
    595731       DO  k = nzb_s_inner(j,i)+1, nzt
    … …  
    680816    SUBROUTINE sedimentation_cloud_ij( i, j )
    681817
    682        USE arrays_3d
    683        USE cloud_parameters
    684        USE constants
    685        USE control_parameters
    686        USE indices
     818       USE arrays_3d,                                                          &
     819           ONLY:  ddzu, dzu, nc_1d, pt_1d, q_1d, qc_1d
     820
     821       USE cloud_parameters,                                                   &
     822           ONLY:  eps_sb, hyrho, k_st, l_d_cp, prr, pt_d_t, rho_l, sigma_gc
     823
     824       USE constants,                                                          &
     825           ONLY:  pi
     826
     827       USE control_parameters,                                                 &
     828           ONLY:  dt_do2d_xy, dt_micro, intermediate_timestep_count
     829
     830       USE indices,                                                            &
     831           ONLY:  nzb, nzb_s_inner, nzt
     832
     833       USE kinds
    687834       
    688835       IMPLICIT NONE
    689836
    690        INTEGER ::  i, j, k
    691        REAL    ::  sed_qc_const
    692 
    693        REAL, DIMENSION(nzb:nzt+1) :: sed_qc
     837       INTEGER(iwp) ::  i                 !:
     838       INTEGER(iwp) ::  j                 !:
     839       INTEGER(iwp) ::  k                 !:
     840
     841       REAL(wp)     ::  sed_qc_const      !:
     842
     843
     844       REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc
    694845
    695846!
    … …  
    725876    SUBROUTINE sedimentation_rain_ij( i, j )
    726877
    727        USE arrays_3d
    728        USE cloud_parameters
    729        USE constants
    730        USE control_parameters
    731        USE indices
    732        USE statistics
     878       USE arrays_3d,                                                          &
     879           ONLY:  ddzu, dzu, nr_1d, pt_1d, q_1d, qr_1d
     880
     881       USE cloud_parameters,                                                   &
     882           ONLY:  a_term, b_term, c_term, cof, dpirho_l, eps_sb, hyrho,        &
     883                  limiter_sedimentation, l_d_cp, precipitation_amount, prr,    &
     884                  pt_d_t, stp
     885
     886       USE control_parameters,                                                 &
     887           ONLY:  dt_do2d_xy, dt_micro, dt_3d, intermediate_timestep_count,    &
     888                  intermediate_timestep_count_max,                             &
     889                  precipitation_amount_interval, time_do2d_xy
     890
     891       USE indices,                                                            &
     892           ONLY:  nzb, nzb_s_inner, nzt
     893
     894       USE kinds
     895
     896       USE statistics,                                                         &
     897           ONLY:  weight_substep
    733898       
    734899       IMPLICIT NONE
    735900
    736        INTEGER ::  i, j, k, k_run
    737        REAL    ::  c_run, d_max, d_mean, d_min, dr, dt_sedi, flux, lambda_r,  &
    738                    mu_r, z_run
    739 
    740        REAL, DIMENSION(nzb:nzt+1) :: c_nr, c_qr, d_nr, d_qr, nr_slope,        &
    741                                      qr_slope, sed_nr, sed_qr, w_nr, w_qr
     901       INTEGER(iwp) ::  i                          !:
     902       INTEGER(iwp) ::  j                          !:
     903       INTEGER(iwp) ::  k                          !:
     904       INTEGER(iwp) ::  k_run                      !:
     905
     906       REAL(wp)     ::  c_run                      !:
     907       REAL(wp)     ::  d_max                      !:
     908       REAL(wp)     ::  d_mean                     !:
     909       REAL(wp)     ::  d_min                      !:
     910       REAL(wp)     ::  dr                         !:
     911       REAL(wp)     ::  dt_sedi                    !:
     912       REAL(wp)     ::  flux                       !:
     913       REAL(wp)     ::  lambda_r                   !:
     914       REAL(wp)     ::  mu_r                       !:
     915       REAL(wp)     ::  z_run                      !:
     916
     917      REAL(wp), DIMENSION(nzb:nzt+1) ::  c_nr      !:
     918      REAL(wp), DIMENSION(nzb:nzt+1) ::  c_qr      !:
     919      REAL(wp), DIMENSION(nzb:nzt+1) ::  d_nr      !:
     920      REAL(wp), DIMENSION(nzb:nzt+1) ::  d_qr      !:
     921      REAL(wp), DIMENSION(nzb:nzt+1) ::  nr_slope  !:
     922      REAL(wp), DIMENSION(nzb:nzt+1) ::  qr_slope  !:
     923      REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_nr    !:
     924      REAL(wp), DIMENSION(nzb:nzt+1) ::  sed_qr    !:
     925      REAL(wp), DIMENSION(nzb:nzt+1) ::  w_nr      !:
     926      REAL(wp), DIMENSION(nzb:nzt+1) ::  w_qr      !:
     927
     928
    742929!
    743930!--    Computation of sedimentation flux. Implementation according to Stevens
    … …  
    8961083    FUNCTION gamm( xx )
    8971084       
    898        USE cloud_parameters
    899    
     1085       USE cloud_parameters,                                                   &
     1086           ONLY:  cof, stp
     1087
     1088       USE kinds
     1089
    9001090       IMPLICIT NONE
    901  
    902        REAL    ::  gamm, ser, tmp, x_gamm, xx, y_gamm
    903        INTEGER ::  j
    904 
    905  
     1091
     1092       INTEGER(iwp) ::  j            !:
     1093
     1094       REAL(wp)     ::  gamm         !:
     1095       REAL(wp)     ::  ser          !:
     1096       REAL(wp)     ::  tmp          !:
     1097       REAL(wp)     ::  x_gamm       !:
     1098       REAL(wp)     ::  xx           !:
     1099       REAL(wp)     ::  y_gamm       !:
     1100
    9061101       x_gamm = xx
    9071102       y_gamm = x_gamm

  • palm/trunk/SOURCE/mod_kinds.f90

    r1319 r1320  
    2626! $Id$
    2727!
    28 ! 1318 2014-03-17 13:35:16Z raasch
    29 ! bugfix: default integer kind changed to single precision
    30 !
    3128! 1306 2014-03-13 14:30:59Z raasch
    3229! Initial revision
    … …  
    4643!
    4744!-- Floating point kinds
    48     INTEGER, PARAMETER ::  sp = 4           ! single precision (32 bit)
    49     INTEGER, PARAMETER ::  dp = 8           ! double precision (64 bit)
     45    INTEGER, PARAMETER ::  sp = 4           !: single precision (32 bit)
     46    INTEGER, PARAMETER ::  dp = 8           !: double precision (64 bit)
    5047
    5148!
    5249!-- Integer kinds
    53     INTEGER, PARAMETER ::  isp = SELECTED_INT_KIND(  9 )   ! single precision (32 bit)
    54     INTEGER, PARAMETER ::  idp = SELECTED_INT_KIND( 14 )   ! double precision (64 bit)
     50    INTEGER, PARAMETER ::  isp = SELECTED_INT_KIND(  9 )   !: single precision (32 bit)
     51    INTEGER, PARAMETER ::  idp = SELECTED_INT_KIND( 14 )   !: double precision (64 bit)
    5552
    5653!
    5754!-- Set kinds to be used as defaults
    58     INTEGER, PARAMETER ::   wp =  dp          ! default real kind
    59     INTEGER, PARAMETER ::  iwp = isp          ! default integer kind
     55    INTEGER, PARAMETER ::   wp =  dp          !: default real kind
     56    INTEGER, PARAMETER ::  iwp = isp          !: default integer kind
    6057
    6158    SAVE

  • palm/trunk/SOURCE/modules.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! 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:
    … …  
    210216! for thread-safe summation in advec_ws.
    211217!
    212 ! 792 2011-12-01 01:23:23Z raasch
    213 ! particle arrays (particles, parrticles_temp) implemented as pointers,
    214 ! +particles_1, particles_2, sort_count
    215 !
    216 ! 790 2011-11-29 03:11:20Z raasch
    217 ! +turbulence_effects_on_collision, wang_collision_kernel
    218 !
    219 ! 785 2011-11-28 09:47:19Z raasch
    220 ! +scalar_rayleigh_damping, rdf_sc
    221 !
    222 ! 778 2011-11-07 14:18:25Z fricke
    223 ! +gathered_size, subdomain_size
    224 !
    225 ! 771 2011-10-27 10:56:21Z heinze
    226 ! +lpt_av
    227 !
    228 ! 767 2011-10-14 06:39:12Z raasch
    229 ! +u_profile, v_profile, uv_heights, use_prescribed_profile_data
    230 !
    231 ! 759 2011-09-15 13:58:31Z raasch
    232 ! +io_blocks, io_group, maximum_parallel_io_streams,
    233 ! synchronous_exchange moved to control_parameters
    234 !
    235 ! 743 2011-08-18 16:10:16Z suehring
    236 ! Dimension of sums_wsus_ws_l, sums_wsvs_ws_l, sums_us2_ws_l, sums_vs2_ws_l,
    237 ! sums_ws2_ws_l, sums_wspts_ws_l, sums_wssas_ws_l,sums_wsqs_ws_l needed for
    238 ! statistical evaluation of turbulent fluxes in WS-scheme decreased.
    239 ! 736 2011-08-17 14:13:26Z suehring
    240 ! Dimension of fluxes needed for WS-scheme increased.
    241 !
    242 ! 722 2011-04-11 06:21:09Z raasch
    243 ! Bugfix: default value for south_border_pe changed to .F.
    244 !
    245 ! 707 2011-03-29 11:39:40Z raasch
    246 ! +bc_lr_dirrad, bc_lr_raddir, bc_ns_dirrad, bc_ns_raddir, left_border_pe,
    247 ! north_border_pe, right_border_pe, south_border_pe
    248 ! p_sub renamed p_loc
    249 !
    250 ! 683 2011-02-09 14:25:15Z raasch
    251 ! +synchronous_exchange
    252 !
    253 ! 673 2011-01-18 16:19:48Z suehring
    254 ! +weight_pres to weight the respective contribution of the Runge-Kutta
    255 ! substeps. +p_sub to buffer the intermediate contributions for Multigrid and
    256 ! SOR.
    257 !
    258 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    259 ! Removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc
    260 ! For coupling with different resolution in ocean and atmophere:
    261 ! +nx_a, +nx_o, ny_a, +ny_o, ngp_a, ngp_o, +total_2d_o, +total_2d_a,
    262 ! +coupling_topology
    263 ! Buffer arrays for the left sided advective fluxes added in arrays_3d.
    264 ! +flux_s_u, +flux_s_v, +flux_s_w, +diss_s_u, +diss_s_v, +diss_s_w,
    265 ! +flux_s_pt, +diss_s_pt, +flux_s_e, +diss_s_e, +flux_s_q, +diss_s_q,
    266 ! +flux_s_sa, +diss_s_sa
    267 ! 3d arrays for dissipation control added. (only necessary for vector arch.)
    268 ! +var_x, +var_y, +var_z, +gamma_x, +gamma_y, +gamma_z
    269 ! Default of momentum_advec and scalar_advec changed to 'ws-scheme' .
    270 ! +exchange_mg added in control_parameters to steer the data exchange.
    271 ! Parameters +nbgp, +nxlg, +nxrg, +nysg, +nyng added in indices.
    272 ! flag array +boundary_flags added in indices to steer the degradation of order
    273 ! of the advective fluxes when non-cyclic boundaries are used.
    274 ! MPI-datatypes +type_y, +type_y_int and +type_yz for data_exchange added in
    275 ! pegrid.
    276 ! +sums_wsus_ws_l, +sums_wsvs_ws_l, +sums_us2_ws_l, +sums_vs2_ws_l,
    277 ! +sums_ws2_ws_l, +sums_wspts_ws_l, +sums_wssas_ws_l, +sums_wsqs_ws_l
    278 ! and +weight_substep added in statistics to steer the statistical evaluation
    279 ! of turbulent fluxes in the advection routines.
    280 ! LOGICALS +ws_scheme_sca and +ws_scheme_mom added to get a better performance
    281 ! in prognostic_equations.
    282 ! LOGICAL +dissipation_control control added to steer numerical dissipation
    283 ! in ws-scheme.
    284 ! Changed length of string run_description_header
    285 !
    286 ! 622 2010-12-10 08:08:13Z raasch
    287 ! +collective_wait in pegrid
    288 !
    289 ! 600 2010-11-24 16:10:51Z raasch
    290 ! default values of surface_scalarflux and surface_waterflux changed
    291 ! to 9999999.9
    292 !
    293 ! 580 2010-10-05 13:59:11Z heinze
    294 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,
    295 ! ws_vertical_gradient_level to subs_vertical_gradient_level and
    296 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i
    297 !
    298 ! 564 2010-09-30 13:18:59Z helmke
    299 ! nc_precision and netcdf_precision dimension changed to 11, all default
    300 ! values of mask_xyz_loop changed to -1.0, dimension of openfile changed to
    301 ! 200+2*max_masks, max_masks changed to 50
    302 !
    303 ! 553 2010-09-01 14:09:06Z weinreis
    304 ! parameters for masked output are replaced by arrays
    305 !
    306 ! 531 2010-04-21 06:47:21Z heinze
    307 ! character length of dopr_unit enlarged
    308 !
    309 ! 519 2010-03-19 05:30:02Z raasch
    310 ! -replace_char, replace_by
    311 !
    312 ! 493 2010-03-01 08:30:24Z raasch
    313 ! +netcdf_data_format, -netcdf_64bit, -netcdf_64bit_3d, -netcdf_format_mask*,
    314 ! -nc_format_mask, -format_parallel_io
    315 !
    316 ! 485 2010-02-05 10:57:51Z raasch
    317 ! ngp_3d, ngp_3d_inner changed to 64 bit
    318 !
    319 ! 449 2010-02-02 11:23:59Z raasch
    320 ! -var_ts: replaced by dots_max,
    321 ! initial data assignments to some dvrp arrays changed due to error messages
    322 ! from gfortran compiler
    323 ! +large_scale_subsidence, ws_vertical_gradient, ws_vertical_gradient_level,
    324 ! ws_vertical_gradient_level_ind, w_subs
    325 !
    326 ! 388 2009-09-23 09:40:33Z raasch
    327 ! +prho, prho_1
    328 ! +bc_lr_cyc, bc_ns_cyc
    329 ! +output_for_t0
    330 ! translation error of actual -> current revisions fixed
    331 ! +q* in dots_label, dots_unit. increased dots_num respectively
    332 ! typographical error in dots_unit fixed
    333 ! +clip_dvrp_*, cluster_size, color_interval, dvrpsize_interval, dvrp_overlap,
    334 ! dvrp_total_overlap, groundplate_color, local_dvrserver_running, n*_dvrp,
    335 ! interval_*_dvrp_prt, isosurface_color, particle_color, particle_dvrpsize,
    336 ! topography color in dvrp_variables,
    337 ! vertical_particle_advection is a 1d-array,
    338 ! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
    339 ! canyon_wall_south, conserve_volume_flow_mode, coupling_start_time,
    340 ! dp_external, dp_level_b, dp_level_ind_b, dp_smooth, dp_smooth_factor, dpdxy,
    341 ! run_coupled, time_since_reference_point, u_bulk, v_bulk in control_parameters,
    342 ! default value of grid_matching changed to strict
    343 ! +shf_av, qsws_av
    344 !
    345 ! 217 2008-12-09 18:00:48Z letzel
    346 ! +topography_grid_convention
    347 ! some dvrp-variables changed to single precision, variables for dvrp-mode
    348 ! pathlines added, +target_id, abort_mode, message_string
    349 !
    350 ! 197 2008-09-16 15:29:03Z raasch
    351 ! allow 100 spectra levels instead of 10 for consistency with
    352 ! define_netcdf_header, +canopy_heat_flux, cthf, lai,
    353 ! +leaf_surface_concentration, scalar_exchange_coefficient, sec, sls
    354 ! +hor_index_bounds, hor_index_bounds_previous_run, id_inflow, id_recycling,
    355 ! inflow_damping_*, mean_inflow_profiles, numprocs_previous_run, nx_on_file,
    356 ! ny_on_file, offset_ocean_*, recycling_plane, recycling_width, turbulent_inflow
    357 ! -myid_char_14
    358 !
    359 ! 138 2007-11-28 10:03:58Z letzel
    360 ! +drag_coefficient, pch_index, lad_surface, lad_vertical_gradient,
    361 ! lad_vertical_gradient_level, plant_canopy, lad, lad_s, lad_u, lad_v,
    362 ! lad_w, cdc, lad_vertical_gradient_level_ind, canopy_mode
    363 ! +dt_sort_particles, ngp_2dh_s_inner, time_sort_particles, flags,
    364 ! wall_flags_1..10, wall_humidityflux(0:4), wall_qflux(0:4),
    365 ! wall_salinityflux(0:4), wall_scalarflux(0:4)
    366 !
    367 ! 108 2007-08-24 15:10:38Z letzel
    368 ! +comm_inter, constant_top_momentumflux, coupling_char, coupling_mode,
    369 ! coupling_mode_remote, c_u, c_v, c_w, dt_coupling, e_init, humidity_remote,
    370 ! ngp_xy, nxlu, nysv, port_name, qswst_remote, terminate_coupled,
    371 ! terminate_coupled_remote, time_coupling, top_momentumflux_u|v, type_xy,
    372 ! uswst*, vswst*
    373 !
    374 ! 97 2007-06-21 08:23:15Z raasch
    375 ! +atmos_ocean_sign, ocean, r, + salinity variables
    376 ! defaults of .._vertical_gradient_levels changed from -1.0 to -9999999.9
    377 ! hydro_press renamed hyp, use_pt_reference renamed use_reference
    378 !
    379 ! 89 2007-05-25 12:08:31Z raasch
    380 ! +data_output_pr_user, max_pr_user, size of data_output_pr, dopr_index,
    381 ! dopr_initial_index and dopr_unit enlarged,
    382 ! var_hom and var_sum renamed pr_palm
    383 !
    384 ! 82 2007-04-16 15:40:52Z raasch
    385 ! +return_addres, return_username
    386 ! Cpp-directive lcmuk renamed lc
    387 !
    388 ! 75 2007-03-22 09:54:05Z raasch
    389 ! +arrays precipitation_amount, precipitation_rate, precipitation_rate_av,
    390 ! rif_wall, z0_av, +arrays u_m_l, u_m_r, etc. for radiation boundary conditions,
    391 ! +loop_optimization, netcdf_64bit_3d, zu_s_inner, zw_w_inner, id_var_zusi_*,
    392 ! id_var_zwwi_*, ts_value, u_nzb_p1_for_vfc, v_nzb_p1_for_vfc, pt_reference,
    393 ! use_pt_reference, precipitation_amount_interval, revision
    394 ! +age_m in particle_type, moisture renamed humidity,
    395 ! -data_output_ts, dots_n, uvmean_outflow, uxrp, vynp,
    396 ! arrays dots_label and dots_unit now dimensioned with dots_max,
    397 ! setting of palm version moved to main program
    398 !
    399 ! 37 2007-03-01 08:33:54Z raasch
    400 ! +constant_top_heatflux, top_heatflux, use_top_fluxes, +arrays for top fluxes,
    401 ! +nzt_diff, default of bc_pt_t renamed "initial_gradient"
    402 ! Bugfix: p is not a pointer
    403 !
    404218! RCS Log replace by Id keyword, revision history cleaned up
    405219!
    … …  
    415229! Definition of variables for special advection schemes
    416230!------------------------------------------------------------------------------!
    417 
    418     REAL, DIMENSION(:), ALLOCATABLE   ::  aex, bex, dex, eex
     231    USE kinds
     232
     233    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  aex, bex, dex, eex
    419234
    420235    SAVE
    … …  
    425240
    426241
    427  MODULE precision_kind
    428 
    429 !------------------------------------------------------------------------------!
    430 ! Description:
    431 ! ------------
    432 ! Definition of type parameters (used for the definition of single or double
    433 ! precision variables)
    434 !------------------------------------------------------------------------------!
    435 
    436     INTEGER, PARAMETER ::  dpk = SELECTED_REAL_KIND( 12 ), &
    437                            spk = SELECTED_REAL_KIND( 6 )
    438 
    439     SAVE
    440 
    441  END MODULE precision_kind
    442 
    443 
    444 
    445 
    446242 MODULE arrays_3d
    447243
    … …  
    452248!------------------------------------------------------------------------------!
    453249
    454     USE precision_kind
    455 
    456     REAL, DIMENSION(:), ALLOCATABLE ::                                         &
     250    USE kinds
     251
     252    REAL(wp), DIMENSION(:), ALLOCATABLE ::                                     &
    457253          c_u_m, c_u_m_l, c_v_m, c_v_m_l, c_w_m, c_w_m_l, ddzu, ddzu_pres,     &
    458254          dd2zu, dzu, ddzw, dzw, hyp, inflow_damping_factor, lad, l_grid,      &
    … …  
    462258          u_init, u_nzb_p1_for_vfc, vg, v_init, v_nzb_p1_for_vfc, w_subs, zu, zw
    463259
    464     REAL, DIMENSION(:,:), ALLOCATABLE ::                                       &
     260    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::                                   &
    465261          c_u, c_v, c_w, diss_s_e, diss_s_nr, diss_s_pt, diss_s_q,             &
    466262          diss_s_qr, diss_s_sa, diss_s_u, diss_s_v, diss_s_w, dzu_mg, dzw_mg,  &
    … …  
    473269          wnudge, wsubs_vert, z0, z0h
    474270
    475     REAL, DIMENSION(:,:,:), ALLOCATABLE ::                                     &
     271    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::                                 &
    476272          canopy_heat_flux, cdc, d, de_dx, de_dy, de_dz, diss, diss_l_e,       &
    477273          diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr, diss_l_sa, diss_l_u,      &
    … …  
    483279
    484280#if defined( __nopointer )
    485     REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                             &
     281    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                         &
    486282          e, e_p, nr, nr_p, p, prho, pt, pt_p, q, q_p, qc, ql, ql_c, ql_v,     &
    487283          ql_vp, qr, qr_p, rho, sa, sa_p, te_m, tnr_m, tpt_m, tq_m, tqr_m,     &
    488284          tsa_m, tu_m, tv_m, tw_m, u, u_p, v, v_p, vpt, w, w_p
    489285#else
    490     REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                             &
     286    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                         &
    491287          e_1, e_2, e_3, p, prho_1, nr_1, nr_2, nr_3, pt_1, pt_2, pt_3, q_1,   &
    492288          q_2, q_3, qc_1, ql_v, ql_vp, ql_1, ql_2, qr_1, qr_2, qr_3, rho_1,    &
    493289          sa_1, sa_2, sa_3, u_1, u_2, u_3, v_1, v_2, v_3, vpt_1, w_1, w_2, w_3
    494290
    495     REAL, DIMENSION(:,:,:), POINTER ::                                         &
     291    REAL(wp), DIMENSION(:,:,:), POINTER ::                                     &
    496292          e, e_p, nr, nr_p, prho, pt, pt_p, q, q_p, qc, ql, ql_c, qr, qr_p,    &
    497293          rho, sa, sa_p, te_m, tnr_m, tpt_m, tq_m, tqr_m, tsa_m, tu_m, tv_m,   &
    … …  
    499295#endif
    500296
    501     REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  rif_wall, tri
    502 
    503     REAL, DIMENSION(:,:,:), ALLOCATABLE :: var_x, var_y, var_z, gamma_x,       &
     297    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  rif_wall, tri
     298
     299    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_x, var_y, var_z, gamma_x,   &
    504300                                           gamma_y, gamma_z
    505301
    … …  
    519315! Definition of variables needed for time-averaging of 2d/3d data
    520316!------------------------------------------------------------------------------!
    521 
    522     REAL, DIMENSION(:,:), ALLOCATABLE ::  lwp_av, precipitation_rate_av,       &
     317    USE kinds
     318
     319    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lwp_av, precipitation_rate_av,   &
    523320                                          qsws_av, shf_av,ts_av, us_av, z0_av, &
    524321                                          z0h_av
    525322
    526     REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
     323    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                        &
    527324          e_av, lpt_av, nr_av, p_av, pc_av, pr_av, prr_av, pt_av, q_av, qc_av, &
    528325          ql_av, ql_c_av, ql_v_av, ql_vp_av, qr_av, qv_av, rho_av, s_av, sa_av,&
    … …  
    540337! Definition of variables and constants for cloud physics
    541338!------------------------------------------------------------------------------!
     339    USE kinds
    542340
    543341    LOGICAL ::  curvature_solution_effects = .FALSE., &
    … …  
    546344               
    547345
    548     REAL ::  a_1 = 8.69E-4,     & ! coef. in turb. parametrization (cm-2 s3)
    549              a_2 = -7.38E-5,    & ! coef. in turb. parametrization (cm-2 s3)
    550              a_3 = -1.40E-2,    & ! coef. in turb. parametrization
    551              a_term = 9.65,     & ! coef. for terminal velocity (m s-1)
    552              a_vent = 0.78,     & ! coef. for ventilation effect
    553              b_1 = 11.45E-6,    & ! coef. in turb. parametrization (m)
    554              b_2 = 9.68E-6,     & ! coef. in turb. parametrization (m)
    555              b_3 = 0.62,        & ! coef. in turb. parametrization
    556              b_term = 9.8,      & ! coef. for terminal velocity (m s-1)
    557              b_vent = 0.308,    & ! coef. for ventilation effect
    558              beta_cc = 3.09E-4, & ! coef. in turb. parametrization (cm-2 s3)
    559              bfactor,           &
    560              c_1 = 4.82E-6,     & ! coef. in turb. parametrization (m)
    561              c_2 = 4.8E-6,      & ! coef. in turb. parametrization (m)
    562              c_3 = 0.76,        & ! coef. in turb. parametrization
    563              c_const = 0.93,    & ! const. in Taylor-microscale Reynolds number
    564              c_evap = 0.7,      & ! constant in evaporation
    565              c_sedimentation = 2.0, & ! Courant number of sedimentation process
    566              c_term = 600.0,    & ! coef. for terminal velocity (m-1)
    567              cof(6) = (/ 76.18009172947146,      & ! coefficients in the
    568                          -86.50532032941677,     & ! numerical
    569                          24.01409824083091,      & ! calculation of the
    570                          -1.231739572450155,     & ! gamma function
    571                          0.1208650973866179E-2,  &
    572                          -0.5395239384953E-5 /), &
    573              cp = 1005.0,       & ! heat capacity of dry air (J kg-1 K-1)
    574              diff_coeff_l = 0.23E-4, & ! diffusivity of water vapor (m2 s-1)
    575              effective_coll_efficiency, &
    576              eps_ros = 1.0E-4,  & ! accuracy of Rosenbrock method
    577              eps_sb = 1.0E-20,  & ! threshold in two-moments scheme
    578              k_cc = 9.44E09,    & ! const. cloud-cloud kernel (m3 kg-2 s-1)
    579              k_cr0 = 4.33,      & ! const. cloud-rain kernel (m3 kg-1 s-1)
    580              k_rr = 7.12,       & ! const. rain-rain kernel (m3 kg-1 s-1)
    581              k_br = 1000.,      & ! const. in breakup parametrization (m-1)
    582              k_st = 1.2E8,      & ! const. in drizzle parametrization (m-1 s-1)
    583              kappa_rr = 60.7,   & ! const. in collision kernel (kg-1/3)
    584              kin_vis_air = 1.4086E-5, & ! kin. viscosity of air (m2 s-1)
    585              l_v = 2.5E+06,     & ! latent heat of vaporization (J kg-1)
    586              l_d_cp, l_d_r, l_d_rv, & ! l_v / cp, l_v / r_d, l_v / r_v
    587              mass_of_solute = 1.0E-17, & ! soluted NaCl (kg)
    588              molecular_weight_of_solute = 0.05844, & ! mol. m. NaCl (kg mol-1)
    589              molecular_weight_of_water = 0.01801528, & ! mol. m. H2O (kg mol-1)
    590              nc_const = 70.0E6, & ! cloud droplet concentration
    591              prec_time_const = 0.001, & !coef. in Kessler scheme
    592              pirho_l, dpirho_l, & ! pi * rho_l / 6.0; 6.0 / ( pi * rho_l )
    593              rho_l = 1.0E3,     & ! density of water (kg m-3)
    594              ql_crit = 0.0005,  & ! coef. in Kessler scheme
    595              r_d = 287.0,       & ! sp. gas const. dry air (J kg-1 K-1)
    596              r_v = 461.51,      & ! sp. gas const. water vapor (J kg-1 K-1)
    597              schmidt = 0.71,    & ! Schmidt number
    598              schmidt_p_1d3,     & ! schmidt**( 1.0 / 3.0 )
    599              sigma_gc = 1.3,    & ! log-normal geometric standard deviation
    600              stp = 2.5066282746310005, & ! parameter in gamma function
    601              thermal_conductivity_l = 2.43E-2, & ! therm. cond. air (J m-1 s-1 K-1)
    602              vanthoff = 2.0,    & ! van't Hoff factor for NaCl
    603              x0 = 2.6E-10,      & ! separating drop mass (kg)
    604              xrmin = 2.6E-10,   & ! minimum rain drop size (kg)
    605              xrmax = 5.0E-6,    & ! maximum rain drop site (kg)
    606              dt_precipitation = 100.0, & ! timestep precipitation (s)
    607              w_precipitation = 9.65      ! maximum terminal velocity (m s-1)
    608 
    609     REAL, DIMENSION(:), ALLOCATABLE     ::  hyrho, pt_d_t, t_d_pt 
    610 
    611     REAL, DIMENSION(:,:), ALLOCATABLE   ::  precipitation_amount, &
    612                                             precipitation_rate
     346    REAL(wp) ::  a_1 = 8.69E-4,     & !: coef. in turb. parametrization (cm-2 s3)
     347                 a_2 = -7.38E-5,    & !: coef. in turb. parametrization (cm-2 s3)
     348                 a_3 = -1.40E-2,    & !: coef. in turb. parametrization
     349                 a_term = 9.65,     & !: coef. for terminal velocity (m s-1)
     350                 a_vent = 0.78,     & !: coef. for ventilation effect
     351                 b_1 = 11.45E-6,    & !: coef. in turb. parametrization (m)
     352                 b_2 = 9.68E-6,     & !: coef. in turb. parametrization (m)
     353                 b_3 = 0.62,        & !: coef. in turb. parametrization
     354                 b_term = 9.8,      & !: coef. for terminal velocity (m s-1)
     355                 b_vent = 0.308,    & !: coef. for ventilation effect
     356                 beta_cc = 3.09E-4, & !: coef. in turb. parametrization (cm-2 s3)
     357                 bfactor,           &
     358                 c_1 = 4.82E-6,     & !: coef. in turb. parametrization (m)
     359                 c_2 = 4.8E-6,      & !: coef. in turb. parametrization (m)
     360                 c_3 = 0.76,        & !: coef. in turb. parametrization
     361                 c_const = 0.93,    & !: const. in Taylor-microscale Reynolds number
     362                 c_evap = 0.7,      & !: constant in evaporation
     363                 c_sedimentation = 2.0, & !: Courant number of sedimentation process
     364                 c_term = 600.0,    & !: coef. for terminal velocity (m-1)
     365                 cof(6) = (/ 76.18009172947146,      & !: coefficients in the
     366                             -86.50532032941677,     & !: numerical
     367                             24.01409824083091,      & !: calculation of the
     368                             -1.231739572450155,     & !: gamma function
     369                             0.1208650973866179E-2,  &
     370                             -0.5395239384953E-5 /), &
     371                cp = 1005.0,       & !: heat capacity of dry air (J kg-1 K-1)
     372                diff_coeff_l = 0.23E-4, & !: diffusivity of water vapor (m2 s-1)
     373                effective_coll_efficiency, & !:
     374                eps_ros = 1.0E-4,  & !: accuracy of Rosenbrock method
     375                eps_sb = 1.0E-20,  & !: threshold in two-moments scheme
     376                k_cc = 9.44E09,    & !: const. cloud-cloud kernel (m3 kg-2 s-1)
     377                k_cr0 = 4.33,      & !: const. cloud-rain kernel (m3 kg-1 s-1)
     378                k_rr = 7.12,       & !: const. rain-rain kernel (m3 kg-1 s-1)
     379                k_br = 1000.,      & !: const. in breakup parametrization (m-1)
     380                k_st = 1.2E8,      & !: const. in drizzle parametrization (m-1 s-1)
     381                kappa_rr = 60.7,   & !: const. in collision kernel (kg-1/3)
     382                kin_vis_air = 1.4086E-5, & !: kin. viscosity of air (m2 s-1)
     383                l_v = 2.5E+06,     & !: latent heat of vaporization (J kg-1)
     384                l_d_cp, l_d_r, l_d_rv, & !: l_v / cp, l_v / r_d, l_v / r_v
     385                mass_of_solute = 1.0E-17, & !: soluted NaCl (kg)
     386                molecular_weight_of_solute = 0.05844, & !: mol. m. NaCl (kg mol-1)
     387                molecular_weight_of_water = 0.01801528, & !: mol. m. H2O (kg mol-1)
     388                nc_const = 70.0E6, & !: cloud droplet concentration
     389                prec_time_const = 0.001, & !: coef. in Kessler scheme
     390                pirho_l, dpirho_l, & !: pi * rho_l / 6.0; 6.0 / ( pi * rho_l )
     391                rho_l = 1.0E3,     & !: density of water (kg m-3)
     392                ql_crit = 0.0005,  & !: coef. in Kessler scheme
     393                r_d = 287.0,       & !: sp. gas const. dry air (J kg-1 K-1)
     394                r_v = 461.51,      & !: sp. gas const. water vapor (J kg-1 K-1)
     395                schmidt = 0.71,    & !: Schmidt number
     396                schmidt_p_1d3,     & !: schmidt**( 1.0 / 3.0 )
     397                sigma_gc = 1.3,    & !: log-normal geometric standard deviation
     398                stp = 2.5066282746310005, & !: parameter in gamma function
     399                thermal_conductivity_l = 2.43E-2, & !: therm. cond. air (J m-1 s-1 K-1)
     400                vanthoff = 2.0,    & !: van't Hoff factor for NaCl
     401                x0 = 2.6E-10,      & !: separating drop mass (kg)
     402                xrmin = 2.6E-10,   & !: minimum rain drop size (kg)
     403                xrmax = 5.0E-6,    & !: maximum rain drop site (kg)
     404                dt_precipitation = 100.0, & !: timestep precipitation (s)
     405                w_precipitation = 9.65      !: maximum terminal velocity (m s-1)
     406
     407    REAL(wp), DIMENSION(:), ALLOCATABLE     ::  hyrho, pt_d_t, t_d_pt 
     408
     409    REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  precipitation_amount, &
     410                                                precipitation_rate
    613411!
    614412!-- 3D array of precipitation rate
    615     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  prr
     413    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  prr
    616414
    617415    SAVE
    … …  
    629427! Definition of general constants
    630428!------------------------------------------------------------------------------!
    631 
    632     REAL    ::  pi = 3.141592654
    633     REAL    ::  adv_mom_1, adv_mom_3, adv_mom_5, adv_sca_1, adv_sca_3, adv_sca_5
     429    USE kinds
     430
     431    REAL(wp)  ::  pi = 3.141592654_wp
     432    REAL(wp)  ::  adv_mom_1, adv_mom_3, adv_mom_5, adv_sca_1, adv_sca_3, adv_sca_5
    634433   
    635434
    … …  
    648447! Definition of parameters for program control
    649448!------------------------------------------------------------------------------!
     449    USE kinds
    650450
    651451    TYPE plot_precision
    652452       CHARACTER (LEN=8) ::  variable
    653        INTEGER           ::  precision
     453       INTEGER(iwp)      ::  precision
    654454    END TYPE plot_precision
    655455
    … …  
    722522    CHARACTER (LEN=10), DIMENSION(0:1,100) ::  do2d = ' ', do3d = ' '
    723523
    724     INTEGER ::  abort_mode = 1, average_count_pr = 0, average_count_sp = 0, &
    725                 average_count_3d = 0, current_timestep_number = 0, &
    726                 coupling_topology = 0, &
    727                 dist_range = 0, disturbance_level_ind_b, &
    728                 disturbance_level_ind_t, doav_n = 0, dopr_n = 0, &
    729                 dopr_time_count = 0, dopts_time_count = 0, &
    730                 dosp_time_count = 0, dots_time_count = 0, &
    731                 do2d_xy_n = 0, do2d_xz_n = 0, do2d_yz_n = 0, do3d_avs_n = 0, &
    732                 dp_level_ind_b = 0, dvrp_filecount = 0, &
    733                 dz_stretch_level_index, gamma_mg, gathered_size, &
    734                 grid_level, ibc_e_b, ibc_p_b, ibc_p_t, &
    735                 ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_q_t, &
    736                 ibc_sa_t, ibc_uv_b, ibc_uv_t, icloud_scheme, &
    737                 inflow_disturbance_begin = -1, inflow_disturbance_end = -1, &
    738                 intermediate_timestep_count, intermediate_timestep_count_max, &
    739                 io_group = 0, io_blocks = 1, iran = -1234567, &
    740                 masks = 0, maximum_grid_level, &
    741                 maximum_parallel_io_streams = -1, max_pr_user = 0, &
    742                 mgcycles = 0, mg_cycles = -1, mg_switch_to_pe0_level = 0, mid, &
    743                 nlsf = 1000, ntnudge = 100, netcdf_data_format = 2, ngsrb = 2, &
    744                 nr_timesteps_this_run = 0, &
    745                 nsor = 20, nsor_ini = 100, n_sor, normalizing_region = 0, &
    746                 nz_do3d = -9999, pch_index = 0, prt_time_count = 0, &
    747                 recycling_plane, runnr = 0, &
    748                 skip_do_avs = 0, subdomain_size, terminate_coupled = 0, &
    749                 terminate_coupled_remote = 0, timestep_count = 0
    750 
    751     INTEGER ::  dist_nxl(0:1), dist_nxr(0:1), dist_nyn(0:1), dist_nys(0:1), &
    752                 do2d_no(0:1) = 0, do2d_xy_time_count(0:1), &
    753                 do2d_xz_time_count(0:1), do2d_yz_time_count(0:1), &
    754                 do3d_no(0:1) = 0, do3d_time_count(0:1), &
    755                 domask_no(max_masks,0:1) = 0, domask_time_count(max_masks,0:1),&
    756                 lad_vertical_gradient_level_ind(10) = -9999, &
    757                 mask_size(max_masks,3) = -1, mask_size_l(max_masks,3) = -1, &
    758                 mask_start_l(max_masks,3) = -1, &
    759                 pt_vertical_gradient_level_ind(10) = -9999, &
    760                 q_vertical_gradient_level_ind(10) = -9999, &
    761                 sa_vertical_gradient_level_ind(10) = -9999, &
    762                 section(100,3), section_xy(100) = -9999, &
    763                 section_xz(100) = -9999, section_yz(100) = -9999, &
    764                 ug_vertical_gradient_level_ind(10) = -9999, &
    765                 vg_vertical_gradient_level_ind(10) = -9999, &
    766                 subs_vertical_gradient_level_i(10) = -9999
     524    INTEGER(iwp) ::  abort_mode = 1, average_count_pr = 0, average_count_sp = 0, &
     525                     average_count_3d = 0, current_timestep_number = 0, &
     526                     coupling_topology = 0, &
     527                     dist_range = 0, disturbance_level_ind_b, &
     528                     disturbance_level_ind_t, doav_n = 0, dopr_n = 0, &
     529                     dopr_time_count = 0, dopts_time_count = 0, &
     530                     dosp_time_count = 0, dots_time_count = 0, &
     531                     do2d_xy_n = 0, do2d_xz_n = 0, do2d_yz_n = 0, do3d_avs_n = 0, &
     532                     dp_level_ind_b = 0, dvrp_filecount = 0, &
     533                     dz_stretch_level_index, gamma_mg, gathered_size, &
     534                     grid_level, ibc_e_b, ibc_p_b, ibc_p_t, &
     535                     ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_q_t, &
     536                     ibc_sa_t, ibc_uv_b, ibc_uv_t, icloud_scheme, &
     537                     inflow_disturbance_begin = -1, inflow_disturbance_end = -1, &
     538                     intermediate_timestep_count, intermediate_timestep_count_max, &
     539                     io_group = 0, io_blocks = 1, iran = -1234567, &
     540                     masks = 0, maximum_grid_level, &
     541                     maximum_parallel_io_streams = -1, max_pr_user = 0, &
     542                     mgcycles = 0, mg_cycles = -1, mg_switch_to_pe0_level = 0, mid, &
     543                     nlsf = 1000, ntnudge = 100, netcdf_data_format = 2, ngsrb = 2, &
     544                     nr_timesteps_this_run = 0, &
     545                     nsor = 20, nsor_ini = 100, n_sor, normalizing_region = 0, &
     546                     nz_do3d = -9999, pch_index = 0, prt_time_count = 0, &
     547                     recycling_plane, runnr = 0, &
     548                     skip_do_avs = 0, subdomain_size, terminate_coupled = 0, &
     549                     terminate_coupled_remote = 0, timestep_count = 0
     550
     551    INTEGER(iwp) ::  dist_nxl(0:1), dist_nxr(0:1), dist_nyn(0:1), dist_nys(0:1), &
     552                     do2d_no(0:1) = 0, do2d_xy_time_count(0:1), &
     553                     do2d_xz_time_count(0:1), do2d_yz_time_count(0:1), &
     554                     do3d_no(0:1) = 0, do3d_time_count(0:1), &
     555                     domask_no(max_masks,0:1) = 0, domask_time_count(max_masks,0:1),&
     556                     lad_vertical_gradient_level_ind(10) = -9999, &
     557                     mask_size(max_masks,3) = -1, mask_size_l(max_masks,3) = -1, &
     558                     mask_start_l(max_masks,3) = -1, &
     559                     pt_vertical_gradient_level_ind(10) = -9999, &
     560                     q_vertical_gradient_level_ind(10) = -9999, &
     561                     sa_vertical_gradient_level_ind(10) = -9999, &
     562                     section(100,3), section_xy(100) = -9999, &
     563                     section_xz(100) = -9999, section_yz(100) = -9999, &
     564                     ug_vertical_gradient_level_ind(10) = -9999, &
     565                     vg_vertical_gradient_level_ind(10) = -9999, &
     566                     subs_vertical_gradient_level_i(10) = -9999
    767567
    768568#if defined ( __check )
    769     INTEGER :: check_restart = 0
     569    INTEGER(iwp) :: check_restart = 0
    770570#endif
    771571
    772     INTEGER, DIMENSION(0:1) :: ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, ntdim_3d
    773 
    774     INTEGER, DIMENSION(:), ALLOCATABLE ::  grid_level_count
    775 
    776     INTEGER, DIMENSION(:,:), ALLOCATABLE   ::  mask_i, mask_j, mask_k
    777     INTEGER, DIMENSION(:,:), ALLOCATABLE   ::  &
    778                 mask_i_global, mask_j_global, mask_k_global
     572    INTEGER(iwp), DIMENSION(0:1) :: ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, ntdim_3d
     573
     574    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  grid_level_count
     575
     576    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  mask_i, mask_j, mask_k
     577    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  &
     578                    mask_i_global, mask_j_global, mask_k_global
    779579
    780580    LOGICAL ::  avs_output = .FALSE., &
    … …  
    829629                data_output_yz(0:1) = .FALSE.
    830630
    831     REAL ::  advected_distance_x = 0.0, advected_distance_y = 0.0, &
    832              alpha_surface = 0.0, atmos_ocean_sign = 1.0, &
    833              averaging_interval = 0.0, averaging_interval_pr = 9999999.9, &
    834              averaging_interval_sp = 9999999.9, bc_pt_t_val, bc_q_t_val, &
    835              bottom_salinityflux = 0.0, &
    836              building_height = 50.0, building_length_x = 50.0, &
    837              building_length_y = 50.0, building_wall_left = 9999999.9, &
    838              building_wall_south = 9999999.9, canyon_height = 50.0, &
    839              canyon_width_x = 9999999.9, canyon_width_y = 9999999.9, &
    840              canyon_wall_left = 9999999.9, canyon_wall_south = 9999999.9, &
    841              cthf = 0.0, cfl_factor = -1.0, cos_alpha_surface, &
    842              coupling_start_time = 0.0, disturbance_amplitude = 0.25, &
    843              disturbance_energy_limit = 0.01, &
    844              disturbance_level_b = -9999999.9, &
    845              disturbance_level_t = -9999999.9, &
    846              dp_level_b = 0.0, drag_coefficient = 0.0, &
    847              dt = -1.0, dt_averaging_input = 0.0, &
    848              dt_averaging_input_pr = 9999999.9, dt_coupling = 9999999.9, &
    849              dt_data_output = 9999999.9, &
    850              dt_data_output_av = 9999999.9, dt_disturb = 9999999.9, &
    851              dt_dopr = 9999999.9, dt_dopr_listing = 9999999.9, &
    852              dt_dopts = 9999999.9, dt_dosp = 9999999.9, dt_dots = 9999999.9, &
    853              dt_do2d_xy = 9999999.9, dt_do2d_xz = 9999999.9, &
    854              dt_do2d_yz = 9999999.9, dt_do3d = 9999999.9, dt_dvrp = 9999999.9, &
    855              dt_max = 20.0, dt_micro = -1.0, dt_restart = 9999999.9, &
    856              dt_run_control = 60.0, dt_3d = -1.0, dz = -1.0, &
    857              dz_max = 9999999.9, dz_stretch_factor = 1.08, &
    858              dz_stretch_level = 100000.0, e_init = 0.0, e_min = 0.0, &
    859              end_time = 0.0, &
    860              f = 0.0, fs = 0.0, g = 9.81, inflow_damping_height = 9999999.9, &
    861              inflow_damping_width = 9999999.9, kappa = 0.4, km_constant = -1.0,&
    862              lad_surface = 0.0, leaf_surface_concentration = 0.0, &
    863              mask_scale_x = 1.0, mask_scale_y = 1.0, mask_scale_z = 1.0, &
    864              maximum_cpu_time_allowed = 0.0,  &
    865              molecular_viscosity = 1.461E-5, &
    866              old_dt = 1.0E-10, omega = 7.29212E-5, omega_sor = 1.8, &
    867              particle_maximum_age = 9999999.9, &
    868              phi = 55.0, prandtl_number = 1.0, &
    869              precipitation_amount_interval = 9999999.9, prho_reference, &
    870              pt_damping_factor = 0.0, pt_damping_width = 0.0, &
    871              pt_reference = 9999999.9, pt_slope_offset = 0.0, &
    872              pt_surface = 300.0, pt_surface_initial_change = 0.0, &
    873              q_surface = 0.0, q_surface_initial_change = 0.0, &
    874              rayleigh_damping_factor = -1.0, rayleigh_damping_height = -1.0, &
    875              recycling_width = 9999999.9, residual_limit = 1.0E-4, &
    876              restart_time = 9999999.9, rho_reference, rho_surface, &
    877              rif_max = 1.0, rif_min = -5.0, roughness_length = 0.1, &
    878              sa_surface = 35.0, scalar_exchange_coefficient = 0.0, &
    879              simulated_time = 0.0, simulated_time_at_begin, sin_alpha_surface, &
    880              skip_time_data_output = 0.0, skip_time_data_output_av = 9999999.9,&
    881              skip_time_dopr = 9999999.9, skip_time_dosp = 9999999.9, &
    882              skip_time_do2d_xy = 9999999.9, skip_time_do2d_xz = 9999999.9, &
    883              skip_time_do2d_yz = 9999999.9, skip_time_do3d = 9999999.9, &
    884              surface_heatflux = 9999999.9, surface_pressure = 1013.25, &
    885              surface_scalarflux = 9999999.9, surface_waterflux = 9999999.9, &
    886              s_surface = 0.0, s_surface_initial_change = 0.0, &
    887              termination_time_needed = -1.0, time_coupling = 0.0, &
    888              time_disturb = 0.0, time_dopr = 0.0, time_dopr_av = 0.0, &
    889              time_dopr_listing = 0.0, time_dopts = 0.0, time_dosp = 0.0, &
    890              time_dosp_av = 0.0, time_dots = 0.0, time_do2d_xy = 0.0, &
    891              time_do2d_xz = 0.0, time_do2d_yz = 0.0, time_do3d = 0.0, &
    892              time_do_av = 0.0, time_do_sla = 0.0, time_dvrp = 0.0, &
    893              time_restart = 9999999.9, time_run_control = 0.0,&
    894              time_since_reference_point, top_heatflux = 9999999.9, &
    895              top_momentumflux_u = 9999999.9, &
    896              top_momentumflux_v = 9999999.9, top_salinityflux = 9999999.9, &
    897              ug_surface = 0.0, u_bulk = 0.0, u_gtrans = 0.0, &
    898              vg_surface = 0.0, vpt_reference = 9999999.9, &
    899              v_bulk = 0.0, v_gtrans = 0.0, wall_adjustment_factor = 1.8, &
    900              z_max_do2d = -1.0, z0h_factor = 1.0
    901 
    902     REAL ::  do2d_xy_last_time(0:1) = -1.0, do2d_xz_last_time(0:1) = -1.0, &
    903              do2d_yz_last_time(0:1) = -1.0, dpdxy(1:2) = 0.0, &
    904              dt_domask(max_masks) = 9999999.9, lad_vertical_gradient(10) = 0.0,&
    905              lad_vertical_gradient_level(10) = -9999999.9, &
    906              mask_scale(3), &
    907              pt_vertical_gradient(10) = 0.0, &
    908              pt_vertical_gradient_level(10) = -9999999.9, &
    909              q_vertical_gradient(10) = 0.0, &
    910              q_vertical_gradient_level(10) = -1.0, &
    911              s_vertical_gradient(10) = 0.0, &
    912              s_vertical_gradient_level(10) = -1.0, &
    913              sa_vertical_gradient(10) = 0.0, &
    914              sa_vertical_gradient_level(10) = -9999999.9, &
    915              skip_time_domask(max_masks) = 9999999.9, threshold(20) = 0.0, &
    916              time_domask(max_masks) = 0.0, &
    917              tsc(10) = (/ 1.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /), &
    918              u_profile(100) = 9999999.9, uv_heights(100) = 9999999.9, &
    919              v_profile(100) = 9999999.9, &
    920              ug_vertical_gradient(10) = 0.0, &
    921              ug_vertical_gradient_level(10) = -9999999.9, &
    922              vg_vertical_gradient(10) = 0.0, &
    923              vg_vertical_gradient_level(10) = -9999999.9, &
    924              volume_flow(1:2) = 0.0, volume_flow_area(1:2) = 0.0, &
    925              volume_flow_initial(1:2) = 0.0, wall_heatflux(0:4) = 0.0, &
    926              wall_humidityflux(0:4) = 0.0, wall_nrflux(0:4) = 0.0, &
    927              wall_qflux(0:4) = 0.0, wall_qrflux(0:4) = 0.0, &
    928              wall_salinityflux(0:4) = 0.0, wall_scalarflux(0:4) = 0.0, &
    929              subs_vertical_gradient(10) = 0.0, &
    930              subs_vertical_gradient_level(10) = -9999999.9
    931 
    932     REAL, DIMENSION(:), ALLOCATABLE ::  dp_smooth_factor
    933 
    934     REAL, DIMENSION(max_masks,mask_xyz_dimension) :: &
    935         mask_x = -1.0, mask_y = -1.0, mask_z = -1.0
    936     REAL, DIMENSION(max_masks,3) ::                  &
    937         mask_x_loop = -1.0, mask_y_loop = -1.0, mask_z_loop = -1.0
     631    REAL(wp) ::  advected_distance_x = 0.0, advected_distance_y = 0.0, &
     632                 alpha_surface = 0.0, atmos_ocean_sign = 1.0, &
     633                 averaging_interval = 0.0, averaging_interval_pr = 9999999.9, &
     634                 averaging_interval_sp = 9999999.9, bc_pt_t_val, bc_q_t_val, &
     635                 bottom_salinityflux = 0.0, &
     636                 building_height = 50.0, building_length_x = 50.0, &
     637                 building_length_y = 50.0, building_wall_left = 9999999.9, &
     638                 building_wall_south = 9999999.9, canyon_height = 50.0, &
     639                 canyon_width_x = 9999999.9, canyon_width_y = 9999999.9, &
     640                 canyon_wall_left = 9999999.9, canyon_wall_south = 9999999.9, &
     641                 cthf = 0.0, cfl_factor = -1.0, cos_alpha_surface, &
     642                 coupling_start_time = 0.0, disturbance_amplitude = 0.25, &
     643                 disturbance_energy_limit = 0.01, &
     644                 disturbance_level_b = -9999999.9, &
     645                 disturbance_level_t = -9999999.9, &
     646                 dp_level_b = 0.0, drag_coefficient = 0.0, &
     647                 dt = -1.0, dt_averaging_input = 0.0, &
     648                 dt_averaging_input_pr = 9999999.9, dt_coupling = 9999999.9, &
     649                 dt_data_output = 9999999.9, &
     650                 dt_data_output_av = 9999999.9, dt_disturb = 9999999.9, &
     651                 dt_dopr = 9999999.9, dt_dopr_listing = 9999999.9, &
     652                 dt_dopts = 9999999.9, dt_dosp = 9999999.9, dt_dots = 9999999.9, &
     653                 dt_do2d_xy = 9999999.9, dt_do2d_xz = 9999999.9, &
     654                 dt_do2d_yz = 9999999.9, dt_do3d = 9999999.9, dt_dvrp = 9999999.9, &
     655                 dt_max = 20.0, dt_micro = -1.0, dt_restart = 9999999.9, &
     656                 dt_run_control = 60.0, dt_3d = -1.0, dz = -1.0, &
     657                 dz_max = 9999999.9, dz_stretch_factor = 1.08, &
     658                 dz_stretch_level = 100000.0, e_init = 0.0, e_min = 0.0, &
     659                 end_time = 0.0, &
     660                 f = 0.0, fs = 0.0, g = 9.81, inflow_damping_height = 9999999.9, &
     661                 inflow_damping_width = 9999999.9, kappa = 0.4, km_constant = -1.0,&
     662                 lad_surface = 0.0, leaf_surface_concentration = 0.0, &
     663                 mask_scale_x = 1.0, mask_scale_y = 1.0, mask_scale_z = 1.0, &
     664                 maximum_cpu_time_allowed = 0.0,  &
     665                 molecular_viscosity = 1.461E-5, &
     666                 old_dt = 1.0E-10, omega = 7.29212E-5, omega_sor = 1.8, &
     667                 particle_maximum_age = 9999999.9, &
     668                 phi = 55.0, prandtl_number = 1.0, &
     669                 precipitation_amount_interval = 9999999.9, prho_reference, &
     670                 pt_damping_factor = 0.0, pt_damping_width = 0.0, &
     671                 pt_reference = 9999999.9, pt_slope_offset = 0.0, &
     672                 pt_surface = 300.0, pt_surface_initial_change = 0.0, &
     673                 q_surface = 0.0, q_surface_initial_change = 0.0, &
     674                 rayleigh_damping_factor = -1.0, rayleigh_damping_height = -1.0, &
     675                 recycling_width = 9999999.9, residual_limit = 1.0E-4, &
     676                 restart_time = 9999999.9, rho_reference, rho_surface, &
     677                 rif_max = 1.0, rif_min = -5.0, roughness_length = 0.1, &
     678                 sa_surface = 35.0, scalar_exchange_coefficient = 0.0, &
     679                 simulated_time = 0.0, simulated_time_at_begin, sin_alpha_surface, &
     680                 skip_time_data_output = 0.0, skip_time_data_output_av = 9999999.9,&
     681                 skip_time_dopr = 9999999.9, skip_time_dosp = 9999999.9, &
     682                 skip_time_do2d_xy = 9999999.9, skip_time_do2d_xz = 9999999.9, &
     683                 skip_time_do2d_yz = 9999999.9, skip_time_do3d = 9999999.9, &
     684                 surface_heatflux = 9999999.9, surface_pressure = 1013.25, &
     685                 surface_scalarflux = 9999999.9, surface_waterflux = 9999999.9, &
     686                 s_surface = 0.0, s_surface_initial_change = 0.0, &
     687                 termination_time_needed = -1.0, time_coupling = 0.0, &
     688                 time_disturb = 0.0, time_dopr = 0.0, time_dopr_av = 0.0, &
     689                 time_dopr_listing = 0.0, time_dopts = 0.0, time_dosp = 0.0, &
     690                 time_dosp_av = 0.0, time_dots = 0.0, time_do2d_xy = 0.0, &
     691                 time_do2d_xz = 0.0, time_do2d_yz = 0.0, time_do3d = 0.0, &
     692                 time_do_av = 0.0, time_do_sla = 0.0, time_dvrp = 0.0, &
     693                 time_restart = 9999999.9, time_run_control = 0.0,&
     694                 time_since_reference_point, top_heatflux = 9999999.9, &
     695                 top_momentumflux_u = 9999999.9, &
     696                 top_momentumflux_v = 9999999.9, top_salinityflux = 9999999.9, &
     697                 ug_surface = 0.0, u_bulk = 0.0, u_gtrans = 0.0, &
     698                 vg_surface = 0.0, vpt_reference = 9999999.9, &
     699                 v_bulk = 0.0, v_gtrans = 0.0, wall_adjustment_factor = 1.8, &
     700                 z_max_do2d = -1.0, z0h_factor = 1.0
     701
     702    REAL(wp) ::  do2d_xy_last_time(0:1) = -1.0, do2d_xz_last_time(0:1) = -1.0, &
     703                 do2d_yz_last_time(0:1) = -1.0, dpdxy(1:2) = 0.0, &
     704                 dt_domask(max_masks) = 9999999.9, lad_vertical_gradient(10) = 0.0,&
     705                 lad_vertical_gradient_level(10) = -9999999.9, &
     706                 mask_scale(3), &
     707                 pt_vertical_gradient(10) = 0.0, &
     708                 pt_vertical_gradient_level(10) = -9999999.9, &
     709                 q_vertical_gradient(10) = 0.0, &
     710                 q_vertical_gradient_level(10) = -1.0, &
     711                 s_vertical_gradient(10) = 0.0, &
     712                 s_vertical_gradient_level(10) = -1.0, &
     713                 sa_vertical_gradient(10) = 0.0, &
     714                 sa_vertical_gradient_level(10) = -9999999.9, &
     715                 skip_time_domask(max_masks) = 9999999.9, threshold(20) = 0.0, &
     716                 time_domask(max_masks) = 0.0, &
     717                 tsc(10) = (/ 1.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /), &
     718                 u_profile(100) = 9999999.9, uv_heights(100) = 9999999.9, &
     719                 v_profile(100) = 9999999.9, &
     720                 ug_vertical_gradient(10) = 0.0, &
     721                 ug_vertical_gradient_level(10) = -9999999.9, &
     722                 vg_vertical_gradient(10) = 0.0, &
     723                 vg_vertical_gradient_level(10) = -9999999.9, &
     724                 volume_flow(1:2) = 0.0, volume_flow_area(1:2) = 0.0, &
     725                 volume_flow_initial(1:2) = 0.0, wall_heatflux(0:4) = 0.0, &
     726                 wall_humidityflux(0:4) = 0.0, wall_nrflux(0:4) = 0.0, &
     727                 wall_qflux(0:4) = 0.0, wall_qrflux(0:4) = 0.0, &
     728                 wall_salinityflux(0:4) = 0.0, wall_scalarflux(0:4) = 0.0, &
     729                 subs_vertical_gradient(10) = 0.0, &
     730                 subs_vertical_gradient_level(10) = -9999999.9
     731
     732    REAL(wp), DIMENSION(:), ALLOCATABLE ::  dp_smooth_factor
     733
     734    REAL(wp), DIMENSION(max_masks,mask_xyz_dimension) :: &
     735            mask_x = -1.0, mask_y = -1.0, mask_z = -1.0
     736    REAL(wp), DIMENSION(max_masks,3) ::                  &
     737            mask_x_loop = -1.0, mask_y_loop = -1.0, mask_z_loop = -1.0
    938738   
    939739!
    940740!--    internal mask arrays ("mask,dimension,selection")
    941        REAL, DIMENSION(:,:,:), ALLOCATABLE ::  mask, mask_loop
     741       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  mask, mask_loop
    942742
    943743    SAVE
    … …  
    954754! Definition of variables used with dvrp-software
    955755!------------------------------------------------------------------------------!
     756
     757     USE kinds
    956758
    957759    CHARACTER (LEN=10) ::  dvrp_output = 'rtsp', particle_color = 'none', &
    … …  
    967769                           dvrp_username  = ' '
    968770
    969     INTEGER ::  cluster_size = 1, dvrp_colortable_entries = 4,                 &
    970                 dvrp_colortable_entries_prt = 22, islice_dvrp,                 &
    971                 nx_dvrp, nxl_dvrp, nxr_dvrp, ny_dvrp, nyn_dvrp, nys_dvrp,      &
    972                 nz_dvrp, pathlines_fadeintime = 5, pathlines_fadeouttime = 5,  &
    973                 pathlines_linecount = 1000, pathlines_maxhistory = 40,         &
    974                 pathlines_wavecount = 10, pathlines_wavetime = 50,             &
    975                 vc_gradient_normals = 0, vc_mode = 0, vc_size_x = 2,           &
    976                 vc_size_y = 2, vc_size_z = 2
    977 
    978     INTEGER, DIMENSION(10) ::  slicer_position_dvrp
     771    INTEGER(iwp) ::  cluster_size = 1, dvrp_colortable_entries = 4,                 &
     772                     dvrp_colortable_entries_prt = 22, islice_dvrp,                 &
     773                     nx_dvrp, nxl_dvrp, nxr_dvrp, ny_dvrp, nyn_dvrp, nys_dvrp,      &
     774                     nz_dvrp, pathlines_fadeintime = 5, pathlines_fadeouttime = 5,  &
     775                     pathlines_linecount = 1000, pathlines_maxhistory = 40,         &
     776                     pathlines_wavecount = 10, pathlines_wavetime = 50,             &
     777                     vc_gradient_normals = 0, vc_mode = 0, vc_size_x = 2,           &
     778                     vc_size_y = 2, vc_size_z = 2
     779
     780    INTEGER(iwp), DIMENSION(10) ::  slicer_position_dvrp
    979781
    980782    LOGICAL ::  cyclic_dvrp = .FALSE., dvrp_overlap, dvrp_total_overlap, &
    … …  
    982784                use_seperate_pe_for_dvrp_output = .FALSE.
    983785
    984     REAL    ::  clip_dvrp_l = 9999999.9, clip_dvrp_n = 9999999.9, &
    985                 clip_dvrp_r = 9999999.9, clip_dvrp_s = 9999999.9, &
    986                 superelevation = 1.0, superelevation_x = 1.0,     &
    987                 superelevation_y = 1.0, vc_alpha = 38.0
    988 
    989     REAL, DIMENSION(2) ::  color_interval = (/ 0.0, 1.0 /), &
    990                            dvrpsize_interval = (/ 0.0, 1.0 /)
    991 
    992     REAL, DIMENSION(3) ::  groundplate_color = (/ 0.0, 0.6, 0.0 /), &
    993                            topography_color = (/ 0.8, 0.7, 0.6 /)
     786    REAL(wp)    ::  clip_dvrp_l = 9999999.9, clip_dvrp_n = 9999999.9, &
     787                    clip_dvrp_r = 9999999.9, clip_dvrp_s = 9999999.9, &
     788                    superelevation = 1.0, superelevation_x = 1.0,     &
     789                    superelevation_y = 1.0, vc_alpha = 38.0
     790
     791    REAL(wp), DIMENSION(2) ::  color_interval = (/ 0.0, 1.0 /), &
     792                               dvrpsize_interval = (/ 0.0, 1.0 /)
     793
     794    REAL(wp), DIMENSION(3) ::  groundplate_color = (/ 0.0, 0.6, 0.0 /), &
     795                               topography_color = (/ 0.8, 0.7, 0.6 /)
    994796
    995797#if defined( __decalpha )
    996     REAL, DIMENSION(2,10)  ::  slicer_range_limits_dvrp = RESHAPE( (/       &
    997                                 -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
    998                                 -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
    999                                 -1.0, 1.0, -1.0, 1.0 /), (/ 2, 10 /) )
    1000 
    1001     REAL, DIMENSION(3,10)  ::  isosurface_color = RESHAPE( (/                  &
    1002                                 0.9, 0.9, 0.9,  0.8, 0.1, 0.1,  0.1, 0.1, 0.8, &
    1003                                 0.1, 0.8, 0.1,  0.6, 0.1, 0.1,  0.1, 0.1, 0.6, &
    1004                                 0.1, 0.6, 0.1,  0.4, 0.1, 0.1,  0.1, 0.1, 0.4, &
    1005                                 0.1, 0.4, 0.1 /), (/ 3, 10 /) )
    1006 
    1007     REAL(4), DIMENSION(2,100) ::  interval_values_dvrp, interval_h_dvrp =      &
    1008                                   RESHAPE( (/ 270.0, 225.0, 225.0, 180.0,      &
    1009                                                70.0,  25.0,  25.0, -25.0,      &
    1010                                               ( 0.0, i9 = 1, 192 ) /),         &
    1011                                            (/ 2, 100 /) ),                     &
    1012                                   interval_l_dvrp = 0.5, interval_s_dvrp = 1.0,&
    1013                                   interval_a_dvrp = 0.0,                       &
    1014                                   interval_values_dvrp_prt,                    &
    1015                                   interval_h_dvrp_prt = RESHAPE(               &
    1016                                   (/ 270.0, 225.0, 225.0, 180.0, 70.0, 25.0,   &
    1017                                      25.0, -25.0, ( 0.0, i9 = 1, 192 ) /),     &
    1018                                                   (/ 2, 100 /) ),              &
    1019                                   interval_l_dvrp_prt = 0.5,                   &
    1020                                   interval_s_dvrp_prt = 1.0,                   &
    1021                                   interval_a_dvrp_prt = 0.0
     798    REAL(wp), DIMENSION(2,10)  ::  slicer_range_limits_dvrp = RESHAPE( (/      &
     799                                   -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
     800                                   -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
     801                                   -1.0, 1.0, -1.0, 1.0 /), (/ 2, 10 /) )
     802
     803    REAL(wp), DIMENSION(3,10)  ::  isosurface_color = RESHAPE( (/                 &
     804                                   0.9, 0.9, 0.9,  0.8, 0.1, 0.1,  0.1, 0.1, 0.8, &
     805                                   0.1, 0.8, 0.1,  0.6, 0.1, 0.1,  0.1, 0.1, 0.6, &
     806                                   0.1, 0.6, 0.1,  0.4, 0.1, 0.1,  0.1, 0.1, 0.4, &
     807                                   0.1, 0.4, 0.1 /), (/ 3, 10 /) )
     808
     809    REAL(sp), DIMENSION(2,100) ::  interval_values_dvrp, interval_h_dvrp =      &
     810                                   RESHAPE( (/ 270.0, 225.0, 225.0, 180.0,      &
     811                                                70.0,  25.0,  25.0, -25.0,      &
     812                                               ( 0.0, i9 = 1, 192 ) /),         &
     813                                            (/ 2, 100 /) ),                     &
     814                                   interval_l_dvrp = 0.5, interval_s_dvrp = 1.0,&
     815                                   interval_a_dvrp = 0.0,                       &
     816                                   interval_values_dvrp_prt,                    &
     817                                   interval_h_dvrp_prt = RESHAPE(               &
     818                                   (/ 270.0, 225.0, 225.0, 180.0, 70.0, 25.0,   &
     819                                      25.0, -25.0, ( 0.0, i9 = 1, 192 ) /),     &
     820                                                   (/ 2, 100 /) ),              &
     821                                   interval_l_dvrp_prt = 0.5,                   &
     822                                   interval_s_dvrp_prt = 1.0,                   &
     823                                   interval_a_dvrp_prt = 0.0
    1022824#else
    1023     REAL, DIMENSION(2,10)     ::  slicer_range_limits_dvrp
    1024 
    1025     REAL, DIMENSION(3,10)     ::  isosurface_color
    1026 
    1027     REAL(4), DIMENSION(2,100) ::  interval_values_dvrp,                       &
    1028                                   interval_values_dvrp_prt, interval_h_dvrp,  &
    1029                                   interval_h_dvrp_prt, interval_l_dvrp = 0.5, &
    1030                                   interval_l_dvrp_prt = 0.5, interval_s_dvrp = 1.0, &
    1031                                   interval_s_dvrp_prt = 1.0, interval_a_dvrp = 0.0, &
    1032                                   interval_a_dvrp_prt = 0.0
     825    REAL(wp), DIMENSION(2,10)     ::  slicer_range_limits_dvrp
     826
     827    REAL(wp), DIMENSION(3,10)     ::  isosurface_color
     828
     829    REAL(sp), DIMENSION(2,100) ::  interval_values_dvrp,                       &
     830                                   interval_values_dvrp_prt, interval_h_dvrp,  &
     831                                   interval_h_dvrp_prt, interval_l_dvrp = 0.5, &
     832                                   interval_l_dvrp_prt = 0.5, interval_s_dvrp = 1.0, &
     833                                   interval_s_dvrp_prt = 1.0, interval_a_dvrp = 0.0, &
     834                                   interval_a_dvrp_prt = 0.0
    1033835
    1034836    DATA  slicer_range_limits_dvrp / -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
    … …  
    1049851#endif
    1050852
    1051     REAL(4), DIMENSION(:), ALLOCATABLE ::  xcoor_dvrp, ycoor_dvrp, zcoor_dvrp
     853    REAL(sp), DIMENSION(:), ALLOCATABLE ::  xcoor_dvrp, ycoor_dvrp, zcoor_dvrp
    1052854
    1053855    TYPE steering
    1054856       CHARACTER (LEN=24) ::  name
    1055        REAL(4)            ::  min, max
    1056        INTEGER            ::  imin, imax
     857       REAL(sp)           ::  min, max
     858       INTEGER(iwp)       ::  imin, imax
    1057859    END TYPE steering
    1058860
    … …  
    1074876!------------------------------------------------------------------------------!
    1075877
    1076     REAL ::  ddx, ddx2, dx = 1.0, dx2, ddy, ddy2, dy = 1.0, dy2
    1077 
    1078     REAL, DIMENSION(:), ALLOCATABLE ::  ddx2_mg, ddy2_mg
    1079 
    1080     REAL, DIMENSION(:,:), ALLOCATABLE ::  fwxm, fwxp, fwym, fwyp, fxm, fxp,   &
    1081                                           fym, fyp, wall_e_x, wall_e_y,       &
    1082                                           wall_u, wall_v, wall_w_x, wall_w_y, &
    1083                                           zu_s_inner, zw_w_inner
     878    USE kinds
     879
     880    REAL(wp) ::  ddx, ddx2, dx = 1.0, dx2, ddy, ddy2, dy = 1.0, dy2
     881
     882    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ddx2_mg, ddy2_mg
     883
     884    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  fwxm, fwxp, fwym, fwyp, fxm, fxp,   &
     885                                              fym, fyp, wall_e_x, wall_e_y,       &
     886                                              wall_u, wall_v, wall_w_x, wall_w_y, &
     887                                              zu_s_inner, zw_w_inner
    1084888
    1085889    SAVE
    … …  
    1098902!------------------------------------------------------------------------------!
    1099903
    1100     INTEGER ::  i_left, i_right, j_north, j_south, nbgp = 3, ngp_sums, nnx,    &
    1101                 nx = 0, nx_a, nx_o, nxl, nxlg, nxlu, nxr, nxrg, nx_on_file,    &
    1102                 nny, ny = 0, ny_a, ny_o, nyn, nyng, nys, nysg, nysv,           &
    1103                 ny_on_file, nnz, nz = 0, nzb, nzb_diff, nzb_max, nzt, nzt_diff
    1104 
    1105 
    1106     INTEGER( KIND = SELECTED_INT_KIND(18) ), DIMENSION(:), ALLOCATABLE ::      &
     904    USE kinds
     905
     906    INTEGER(iwp) ::  i_left, i_right, j_north, j_south, nbgp = 3, ngp_sums, nnx,    &
     907                     nx = 0, nx_a, nx_o, nxl, nxlg, nxlu, nxr, nxrg, nx_on_file,    &
     908                     nny, ny = 0, ny_a, ny_o, nyn, nyng, nys, nysg, nysv,           &
     909                     ny_on_file, nnz, nz = 0, nzb, nzb_diff, nzb_max, nzt, nzt_diff
     910
     911
     912    INTEGER(idp), DIMENSION(:), ALLOCATABLE ::      &
    1107913                ngp_3d, ngp_3d_inner   ! need to have 64 bit for grids > 2E9
    1108914
    1109     INTEGER, DIMENSION(:), ALLOCATABLE ::                                      &
    1110                 ngp_2dh, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg
    1111 
    1112 
    1113     INTEGER, DIMENSION(:,:), ALLOCATABLE :: ngp_2dh_outer, ngp_2dh_s_inner,    &
    1114                 mg_loc_ind, nzb_diff_s_inner, nzb_diff_s_outer, nzb_diff_u,    &
    1115                 nzb_diff_v, nzb_inner, nzb_outer, nzb_s_inner, nzb_s_outer,    &
    1116                 nzb_u_inner, nzb_u_outer, nzb_v_inner, nzb_v_outer,            &
    1117                 nzb_w_inner, nzb_w_outer, nzb_2d
    1118 
    1119     INTEGER, DIMENSION(:,:,:), POINTER ::  flags
    1120 
    1121     INTEGER, DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_0, wall_flags_00
    1122 
    1123     INTEGER, DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::                         &
    1124                 wall_flags_1, wall_flags_2, wall_flags_3, wall_flags_4,        &
    1125                 wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,        &
    1126                 wall_flags_9, wall_flags_10
    1127 
    1128     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  rflags_s_inner, rflags_invers
     915    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::                                  &
     916                   ngp_2dh, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg
     917
     918
     919    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: ngp_2dh_outer, ngp_2dh_s_inner,  &
     920                   mg_loc_ind, nzb_diff_s_inner, nzb_diff_s_outer, nzb_diff_u,    &
     921                   nzb_diff_v, nzb_inner, nzb_outer, nzb_s_inner, nzb_s_outer,    &
     922                   nzb_u_inner, nzb_u_outer, nzb_v_inner, nzb_v_outer,            &
     923                   nzb_w_inner, nzb_w_outer, nzb_2d
     924
     925    INTEGER(iwp), DIMENSION(:,:,:), POINTER ::  flags
     926
     927    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  wall_flags_0, wall_flags_00
     928
     929    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE,  TARGET ::                       &
     930                   wall_flags_1, wall_flags_2, wall_flags_3, wall_flags_4,        &
     931                   wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,        &
     932                   wall_flags_9, wall_flags_10
     933
     934    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rflags_s_inner, rflags_invers
    1129935
    1130936    SAVE
    … …  
    1147953       SUBROUTINE global_min_max ( i1, i2, j1, j2, k1, k2, feld, mode, offset, &
    1148954                                   wert, wert_ijk, wert1, wert1_ijk )
    1149           CHARACTER (LEN=*), INTENT(IN) ::  mode
    1150           INTEGER, INTENT(IN)           ::  i1, i2, j1, j2, k1, k2
    1151           INTEGER                       ::  wert_ijk(3)
    1152           INTEGER, OPTIONAL             ::  wert1_ijk(3)
    1153           REAL                          ::  offset, wert
    1154           REAL, OPTIONAL                ::  wert1
    1155           REAL, INTENT(IN)              ::  feld(i1:i2,j1:j2,k1:k2)
     955
     956          USE kinds
     957
     958          CHARACTER (LEN=*), INTENT(IN)      ::  mode
     959          INTEGER(iwp), INTENT(IN)           ::  i1, i2, j1, j2, k1, k2
     960          INTEGER(iwp)                       ::  wert_ijk(3)
     961          INTEGER(iwp), OPTIONAL             ::  wert1_ijk(3)
     962          REAL(wp)                           ::  offset, wert
     963          REAL(wp), OPTIONAL                 ::  wert1
     964          REAL(wp), INTENT(IN)               ::  feld(i1:i2,j1:j2,k1:k2)
    1156965
    1157966       END SUBROUTINE global_min_max
    … …  
    1178987       SUBROUTINE advec_s_bc( sk, sk_char )
    1179988
     989          USE kinds
     990
    1180991          CHARACTER (LEN=*), INTENT(IN)   ::  sk_char
    1181992#if defined( __nopointer )
    1182           REAL, DIMENSION(:,:,:) ::  sk
     993          REAL(wp), DIMENSION(:,:,:) ::  sk
    1183994#else
    1184           REAL, DIMENSION(:,:,:), POINTER ::  sk
     995          REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
    1185996#endif
    1186997       END SUBROUTINE advec_s_bc
    … …  
    12041015!------------------------------------------------------------------------------!
    12051016
    1206     INTEGER ::  current_timestep_number_1d = 0, damp_level_ind_1d
     1017    USE kinds
     1018
     1019    INTEGER(iwp) ::  current_timestep_number_1d = 0, damp_level_ind_1d
    12071020
    12081021    LOGICAL ::  run_control_header_1d = .FALSE., stop_dt_1d = .FALSE.
    12091022
    1210     REAL ::     damp_level_1d = -1.0, dt_1d = 60.0, dt_max_1d = 300.0, &
    1211                 dt_pr_1d = 9999999.9, dt_run_control_1d = 60.0, &
    1212                 end_time_1d = 864000.0, old_dt_1d = 1.0E-10, &
    1213                 qs1d, simulated_time_1d = 0.0, time_pr_1d = 0.0, &
    1214                 time_run_control_1d = 0.0, ts1d, us1d, usws1d, &
    1215                 vsws1d, z01d, z0h1d
    1216 
    1217 
    1218     REAL, DIMENSION(:), ALLOCATABLE ::  e1d, e1d_p, kh1d, km1d, l_black, l1d,  &
    1219                                         rif1d, te_e, te_em, te_u, te_um, te_v, &
    1220                                         te_vm, u1d, u1d_p, v1d, v1d_p
     1023    REAL(wp) ::     damp_level_1d = -1.0, dt_1d = 60.0, dt_max_1d = 300.0, &
     1024                    dt_pr_1d = 9999999.9, dt_run_control_1d = 60.0, &
     1025                    end_time_1d = 864000.0, old_dt_1d = 1.0E-10, &
     1026                    qs1d, simulated_time_1d = 0.0, time_pr_1d = 0.0, &
     1027                    time_run_control_1d = 0.0, ts1d, us1d, usws1d, &
     1028                    vsws1d, z01d, z0h1d
     1029
     1030
     1031    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e1d, e1d_p, kh1d, km1d, l_black, l1d,  &
     1032                                            rif1d, te_e, te_em, te_u, te_um, te_v, &
     1033                                            te_vm, u1d, u1d_p, v1d, v1d_p
    12211034
    12221035    SAVE
    … …  
    12351048!------------------------------------------------------------------------------!
    12361049
    1237     USE control_parameters
     1050    USE control_parameters, ONLY: max_masks
     1051    USE kinds
    12381052#if defined( __netcdf )
    12391053    USE netcdf
    12401054#endif
    12411055
    1242     INTEGER, PARAMETER ::  dopr_norm_num = 7, dopts_num = 29, dots_max = 100
    1243 
    1244     INTEGER ::  dots_num = 23
     1056    INTEGER(iwp), PARAMETER ::  dopr_norm_num = 7, dopts_num = 29, dots_max = 100
     1057
     1058    INTEGER(iwp) ::  dots_num = 23
    12451059
    12461060    CHARACTER (LEN=6), DIMENSION(dopr_norm_num) ::  dopr_norm_names =   &
    … …  
    13061120             'not_used        ' /)
    13071121
    1308     INTEGER ::  id_dim_prtnum, id_dim_time_pr, id_dim_time_prt, &
    1309                 id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, &
    1310                 id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, id_set_pr, &
    1311                 id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_var_prtnum, &
    1312                 id_var_rnop_prt, id_var_time_pr, id_var_time_prt, &
    1313                 id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
    1314                 id_var_y_sp, id_var_zu_sp, id_var_zw_sp, nc_stat
    1315 
    1316     INTEGER, DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, &
    1317                 id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
    1318                 id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
    1319                 id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
    1320                 id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
    1321                 id_dim_y_3d, id_dim_yv_3d, id_dim_zu_xy, id_dim_zu1_xy, &
    1322                 id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
    1323                 id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
    1324                 id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
    1325                 id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
    1326                 id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
    1327                 id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
    1328                 id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
    1329                 id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
    1330                 id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zusi_xy, &
    1331                 id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &
    1332                 id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, &
    1333                 id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
    1334 
    1335     INTEGER, DIMENSION(10)  ::  id_var_dospx, id_var_dospy
    1336     INTEGER, DIMENSION(20)  ::  id_var_prt
    1337     INTEGER, DIMENSION(11)  ::  nc_precision
    1338     INTEGER, DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
    1339 
    1340     INTEGER, DIMENSION(dopts_num,0:10) ::  id_var_dopts
    1341     INTEGER, DIMENSION(0:1,100)        ::  id_var_do2d, id_var_do3d
    1342     INTEGER, DIMENSION(100,0:9)        ::  id_dim_z_pr, id_var_dopr, &
    1343                                            id_var_z_pr
    1344     INTEGER, DIMENSION(dots_max,0:9)   ::  id_var_dots
     1122    INTEGER(iwp) ::  id_dim_prtnum, id_dim_time_pr, id_dim_time_prt, &
     1123                     id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, &
     1124                     id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, id_set_pr, &
     1125                     id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_var_prtnum, &
     1126                     id_var_rnop_prt, id_var_time_pr, id_var_time_prt, &
     1127                     id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
     1128                     id_var_y_sp, id_var_zu_sp, id_var_zw_sp, nc_stat
     1129
     1130    INTEGER(iwp), DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, &
     1131                    id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
     1132                    id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
     1133                    id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
     1134                    id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
     1135                    id_dim_y_3d, id_dim_yv_3d, id_dim_zu_xy, id_dim_zu1_xy, &
     1136                    id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
     1137                    id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
     1138                    id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
     1139                    id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
     1140                    id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
     1141                    id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
     1142                    id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
     1143                    id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
     1144                    id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zusi_xy, &
     1145                    id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &
     1146                    id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, &
     1147                    id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
     1148
     1149    INTEGER(iwp), DIMENSION(10)  ::  id_var_dospx, id_var_dospy
     1150    INTEGER(iwp), DIMENSION(20)  ::  id_var_prt
     1151    INTEGER(iwp), DIMENSION(11)  ::  nc_precision
     1152    INTEGER(iwp), DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
     1153
     1154    INTEGER(iwp), DIMENSION(dopts_num,0:10) ::  id_var_dopts
     1155    INTEGER(iwp), DIMENSION(0:1,100)        ::  id_var_do2d, id_var_do3d
     1156    INTEGER(iwp), DIMENSION(100,0:9)        ::  id_dim_z_pr, id_var_dopr, &
     1157                                               id_var_z_pr
     1158    INTEGER(iwp), DIMENSION(dots_max,0:9)   ::  id_var_dots
    13451159
    13461160!
    … …  
    13501164    LOGICAL ::  output_for_t0 = .FALSE.
    13511165
    1352     INTEGER, DIMENSION(1:max_masks,0:1) ::  id_dim_time_mask, id_dim_x_mask, &
    1353                 id_dim_xu_mask, id_dim_y_mask, id_dim_yv_mask, id_dim_zu_mask, &
    1354                 id_dim_zw_mask, &
    1355                 id_set_mask, &
    1356                 id_var_time_mask, id_var_x_mask, id_var_xu_mask, &
    1357                 id_var_y_mask, id_var_yv_mask, id_var_zu_mask, id_var_zw_mask, &
    1358                 id_var_zusi_mask, id_var_zwwi_mask
    1359 
    1360     INTEGER, DIMENSION(1:max_masks,0:1,100)         ::  id_var_domask
     1166    INTEGER(iwp), DIMENSION(1:max_masks,0:1) ::  id_dim_time_mask, id_dim_x_mask, &
     1167                   id_dim_xu_mask, id_dim_y_mask, id_dim_yv_mask, id_dim_zu_mask, &
     1168                   id_dim_zw_mask, &
     1169                   id_set_mask, &
     1170                   id_var_time_mask, id_var_x_mask, id_var_xu_mask, &
     1171                   id_var_y_mask, id_var_yv_mask, id_var_zu_mask, id_var_zw_mask, &
     1172                   id_var_zusi_mask, id_var_zwwi_mask
     1173
     1174    INTEGER(iwp), DIMENSION(1:max_masks,0:1,100)         ::  id_var_domask
    13611175
    13621176    SAVE
    … …  
    13741188!------------------------------------------------------------------------------!
    13751189
    1376     USE precision_kind
     1190    USE kinds
    13771191
    13781192    CHARACTER (LEN=15)  ::  bc_par_lr = 'cyclic',  bc_par_ns = 'cyclic', &
    … …  
    13801194                            collision_kernel = 'none'
    13811195
    1382 #if defined( __parallel )
    1383     INTEGER ::  mpi_particle_type
    1384 #endif
    1385     INTEGER ::  deleted_particles = 0, deleted_tails = 0,                      &
    1386                 dissipation_classes = 10, ibc_par_lr,                          &
    1387                 ibc_par_ns, ibc_par_b, ibc_par_t, iran_part = -1234567,        &
    1388                 maximum_number_of_particles = 1000,                            &
    1389                 maximum_number_of_tailpoints = 100,                            &
    1390                 maximum_number_of_tails = 0,                                   &
    1391                 number_of_sublayers = 20,                                      &
    1392                 number_of_initial_particles = 0, number_of_particles = 0,      &
    1393                 number_of_particle_groups = 1, number_of_tails = 0,            &
    1394                 number_of_initial_tails = 0, offset_ocean_nzt = 0,             &
    1395                 offset_ocean_nzt_m1 = 0, particles_per_point = 1,              &
    1396                 particle_file_count = 0, radius_classes = 20,                  &
    1397                 skip_particles_for_tail = 100, sort_count = 0,                 &
    1398                 total_number_of_particles, total_number_of_tails = 0,          &
    1399                 trlp_count_sum, trlp_count_recv_sum, trrp_count_sum,           &
    1400                 trrp_count_recv_sum, trsp_count_sum, trsp_count_recv_sum,      &
    1401                 trnp_count_sum, trnp_count_recv_sum
    1402 
    1403     INTEGER, PARAMETER ::  max_number_of_particle_groups = 10
    1404 
    1405     INTEGER, DIMENSION(:), ALLOCATABLE     ::  new_tail_id
    1406     INTEGER, DIMENSION(:,:,:), ALLOCATABLE ::  prt_count, prt_start_index
     1196    INTEGER(iwp) ::  deleted_particles = 0, deleted_tails = 0,                      &
     1197                     dissipation_classes = 10, ibc_par_lr,                          &
     1198                     ibc_par_ns, ibc_par_b, ibc_par_t, iran_part = -1234567,        &
     1199                     maximum_number_of_particles = 1000,                            &
     1200                     maximum_number_of_tailpoints = 100,                            &
     1201                     maximum_number_of_tails = 0,                                   &
     1202                     mpi_particle_type,                                             &
     1203                     number_of_sublayers = 20,                                      &
     1204                     number_of_initial_particles = 0, number_of_particles = 0,      &
     1205                     number_of_particle_groups = 1, number_of_tails = 0,            &
     1206                     number_of_initial_tails = 0, offset_ocean_nzt = 0,             &
     1207                     offset_ocean_nzt_m1 = 0, particles_per_point = 1,              &
     1208                     particle_file_count = 0, radius_classes = 20,                  &
     1209                     skip_particles_for_tail = 100, sort_count = 0,                 &
     1210                     total_number_of_particles, total_number_of_tails = 0,          &
     1211                     trlp_count_sum, trlp_count_recv_sum, trrp_count_sum,           &
     1212                     trrp_count_recv_sum, trsp_count_sum, trsp_count_recv_sum,      &
     1213                     trnp_count_sum, trnp_count_recv_sum
     1214
     1215    INTEGER(iwp), PARAMETER ::  max_number_of_particle_groups = 10
     1216
     1217    INTEGER(iwp), DIMENSION(:), ALLOCATABLE     ::  new_tail_id
     1218    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  prt_count, prt_start_index
    14071219
    14081220    LOGICAL ::  hall_kernel = .FALSE., palm_kernel = .FALSE.,                  &
    … …  
    14181230    LOGICAL, DIMENSION(:), ALLOCATABLE ::  particle_mask, tail_mask
    14191231
    1420     REAL    ::  c_0 = 3.0, dt_min_part = 0.0002, dt_prel = 9999999.9,          &
    1421                 dt_sort_particles = 0.0, dt_write_particle_data = 9999999.9,   &
    1422                 dvrp_psize = 9999999.9, end_time_prel = 9999999.9,             &
    1423                 initial_weighting_factor = 1.0,                                &
    1424                 maximum_tailpoint_age = 100000.0,                              &
    1425                 minimum_tailpoint_distance = 0.0,                              &
    1426                 particle_advection_start = 0.0, sgs_wfu_part = 0.3333333,      &
    1427                 sgs_wfv_part = 0.3333333, sgs_wfw_part = 0.3333333,            &
    1428                 time_prel = 0.0, time_sort_particles = 0.0,                    &
    1429                 time_write_particle_data = 0.0, z0_av_global
    1430 
    1431     REAL, DIMENSION(max_number_of_particle_groups) ::  &
    1432                 density_ratio = 9999999.9, pdx = 9999999.9, pdy = 9999999.9, &
    1433                 pdz = 9999999.9, psb = 9999999.9, psl = 9999999.9,           &
    1434                 psn = 9999999.9, psr = 9999999.9, pss = 9999999.9,           &
    1435                 pst = 9999999.9, radius = 9999999.9
    1436 
    1437     REAL, DIMENSION(:), ALLOCATABLE     ::  log_z_z0
    1438 
    1439     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  particle_tail_coordinates
     1232    REAL(wp)    ::  c_0 = 3.0, dt_min_part = 0.0002, dt_prel = 9999999.9,          &
     1233                    dt_sort_particles = 0.0, dt_write_particle_data = 9999999.9,   &
     1234                    dvrp_psize = 9999999.9, end_time_prel = 9999999.9,             &
     1235                    initial_weighting_factor = 1.0,                                &
     1236                    maximum_tailpoint_age = 100000.0,                              &
     1237                    minimum_tailpoint_distance = 0.0,                              &
     1238                    particle_advection_start = 0.0, sgs_wfu_part = 0.3333333,      &
     1239                    sgs_wfv_part = 0.3333333, sgs_wfw_part = 0.3333333,            &
     1240                    time_prel = 0.0, time_sort_particles = 0.0,                    &
     1241                    time_write_particle_data = 0.0, z0_av_global
     1242
     1243    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  &
     1244                    density_ratio = 9999999.9, pdx = 9999999.9, pdy = 9999999.9, &
     1245                    pdz = 9999999.9, psb = 9999999.9, psl = 9999999.9,           &
     1246                    psn = 9999999.9, psr = 9999999.9, pss = 9999999.9,           &
     1247                    pst = 9999999.9, radius = 9999999.9
     1248
     1249    REAL(wp), DIMENSION(:), ALLOCATABLE     ::  log_z_z0
     1250
     1251    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  particle_tail_coordinates
    14401252
    14411253
    14421254    TYPE particle_type
    14431255       SEQUENCE
    1444        REAL    ::  age, age_m, dt_sum, dvrp_psize, e_m, origin_x, origin_y, &
    1445                    origin_z, radius, rvar1, rvar2, rvar3, speed_x, speed_y, &
    1446                    speed_z, weight_factor, x, y, z
    1447        INTEGER ::  class, group, tailpoints, tail_id
     1256       REAL(wp)    ::  age, age_m, dt_sum, dvrp_psize, e_m, origin_x, origin_y, &
     1257                       origin_z, radius, rvar1, rvar2, rvar3, speed_x, speed_y, &
     1258                       speed_z, weight_factor, x, y, z
     1259       INTEGER(iwp) ::  class, group, tailpoints, tail_id
    14481260    END TYPE particle_type
    14491261
    … …  
    14541266    TYPE particle_groups_type
    14551267       SEQUENCE
    1456        REAL    ::  density_ratio, radius, exp_arg, exp_term
     1268       REAL(wp)    ::  density_ratio, radius, exp_arg, exp_term
    14571269    END TYPE particle_groups_type
    14581270
    … …  
    14771289! MPI-calls.
    14781290!------------------------------------------------------------------------------!
     1291
     1292    USE kinds
    14791293
    14801294#if defined( __parallel ) && ! defined ( __check )
    … …  
    14871301    CHARACTER(LEN=2) ::  send_receive = 'al'
    14881302    CHARACTER(LEN=5) ::  myid_char = ''
    1489     INTEGER          ::  acc_rank, comm1dx, comm1dy, comm2d, comm_inter,       &
    1490                          comm_palm, id_inflow = 0, id_recycling = 0, ierr,     &
    1491                          myid = 0, myidx = 0, myidy = 0, ndim = 2, ngp_a,      &
    1492                          ngp_o, ngp_xy, ngp_y, npex = -1, npey = -1,           &
    1493                          numprocs = 1, numprocs_previous_run = -1,             &
    1494                          num_acc_per_node = 0, pleft, pnorth, pright, psouth,  &
    1495                          req_count = 0, sendrecvcount_xy, sendrecvcount_yz,    &
    1496                          sendrecvcount_zx, sendrecvcount_zyd,                  &
    1497                          sendrecvcount_yxd, target_id, tasks_per_node = -9999, &
    1498                          threads_per_task = 1, type_x, type_x_int, type_xy,    &
    1499                          type_y, type_y_int
    1500 
    1501     INTEGER          ::  pdims(2) = 1, req(100)
    1502 
    1503     INTEGER, DIMENSION(:,:), ALLOCATABLE ::  hor_index_bounds, &
    1504                                              hor_index_bounds_previous_run
     1303    INTEGER(iwp)          ::  acc_rank, comm1dx, comm1dy, comm2d, comm_inter,       &
     1304                              comm_palm, id_inflow = 0, id_recycling = 0, ierr,     &
     1305                              myid = 0, myidx = 0, myidy = 0, ndim = 2, ngp_a,      &
     1306                              ngp_o, ngp_xy, ngp_y, npex = -1, npey = -1,           &
     1307                              numprocs = 1, numprocs_previous_run = -1,             &
     1308                              num_acc_per_node = 0, pleft, pnorth, pright, psouth,  &
     1309                              req_count = 0, sendrecvcount_xy, sendrecvcount_yz,    &
     1310                              sendrecvcount_zx, sendrecvcount_zyd,                  &
     1311                              sendrecvcount_yxd, target_id, tasks_per_node = -9999, &
     1312                              threads_per_task = 1, type_x, type_x_int, type_xy,    &
     1313                              type_y, type_y_int
     1314
     1315    INTEGER(iwp)          ::  pdims(2) = 1, req(100)
     1316
     1317    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  hor_index_bounds, &
     1318                                                  hor_index_bounds_previous_run
    15051319
    15061320    LOGICAL ::  background_communication =.FALSE., collective_wait = .FALSE., &
    … …  
    15121326#endif
    15131327
    1514     INTEGER ::  ibuf(12), pcoord(2)
     1328    INTEGER(iwp) ::  ibuf(12), pcoord(2)
    15151329
    15161330#if ! defined ( __check )
    1517     INTEGER ::  status(MPI_STATUS_SIZE)
    1518     INTEGER, DIMENSION(MPI_STATUS_SIZE,100) ::  wait_stat
     1331    INTEGER(iwp) ::  status(MPI_STATUS_SIZE)
     1332    INTEGER(iwp), DIMENSION(MPI_STATUS_SIZE,100) ::  wait_stat
    15191333#endif
    15201334
    15211335
    1522     INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_yz, type_xz, type_yz
     1336    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ngp_yz, type_xz, type_yz
    15231337
    15241338    LOGICAL ::  left_border_pe  = .FALSE., north_border_pe = .FALSE., &
    … …  
    15451359!------------------------------------------------------------------------------!
    15461360
    1547     INTEGER, PARAMETER ::  crmax = 100
     1361    USE kinds
     1362
     1363    INTEGER(iwp), PARAMETER ::  crmax = 100
    15481364
    15491365    CHARACTER (LEN=20), DIMENSION(20) ::  cross_ts_profiles = &
    … …  
    15651381                         ( '                               ', i9 = 1, 94 ) /)
    15661382
    1567     INTEGER ::  profile_columns = 2, profile_rows = 3, profile_number = 0
    1568 
    1569     INTEGER ::  cross_ts_numbers(crmax,crmax) = 0, &
    1570                 cross_ts_number_count(crmax) = 0, &
    1571                 dopr_index(300) = 0, dopr_initial_index(300) = 0, &
    1572                 dots_crossindex(100) = 0, dots_index(100) = 0
     1383    INTEGER(iwp) ::  profile_columns = 2, profile_rows = 3, profile_number = 0
     1384
     1385    INTEGER(iwp) ::  cross_ts_numbers(crmax,crmax) = 0, &
     1386                     cross_ts_number_count(crmax) = 0, &
     1387                     dopr_index(300) = 0, dopr_initial_index(300) = 0, &
     1388                     dots_crossindex(100) = 0, dots_index(100) = 0
    15731389               
    15741390
    1575     REAL ::  cross_ts_uymax(20) = &
     1391    REAL(wp) ::  cross_ts_uymax(20) = &
    15761392                             (/ 999.999, 999.999, 999.999, 999.999, 999.999,   &
    15771393                                999.999, 999.999, 999.999, 999.999, 999.999,   &
    15781394                                999.999, 999.999, 999.999, 999.999, 999.999,   &
    15791395                                999.999, 999.999, 999.999, 999.999, 999.999 /),&
    1580              cross_ts_uymax_computed(20) = 999.999, &
    1581              cross_ts_uymin(20) = &
     1396                 cross_ts_uymax_computed(20) = 999.999, &
     1397                 cross_ts_uymin(20) = &
    15821398                             (/ 999.999, 999.999, 999.999,  -5.000, 999.999,   &
    15831399                                999.999,   0.000, 999.999, 999.999, 999.999,   &
    15841400                                999.999, 999.999, 999.999, 999.999, 999.999,   &
    15851401                                999.999, 999.999, 999.999, 999.999, 999.999 /),&
    1586              cross_ts_uymin_computed(20) = 999.999
     1402                 cross_ts_uymin_computed(20) = 999.999
    15871403
    15881404    SAVE
    … …  
    16001416! Definition of quantities used for computing spectra
    16011417!------------------------------------------------------------------------------!
     1418
     1419    USE kinds
    16021420
    16031421    CHARACTER (LEN=6),  DIMENSION(1:5) ::  header_char = (/ 'PS(u) ', 'PS(v) ',&
    … …  
    16181436                                    'k ^2236 ^2566^2569<q(k) in m>2s>->2    ' /)
    16191437
    1620     INTEGER ::  klist_x = 0, klist_y = 0, n_sp_x = 0, n_sp_y = 0
    1621 
    1622     INTEGER ::  comp_spectra_level(100) = 999999,                   &
    1623                 lstyles(100) = (/ 0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1624                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1625                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1626                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1627                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1628                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1629                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1630                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1631                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
    1632                                   0, 7, 3, 10, 1, 4, 9, 2, 6, 8 /), &
    1633                 plot_spectra_level(100) = 999999
    1634 
    1635     REAL    ::  time_to_start_sp = 0.0
     1438    INTEGER(iwp) ::  klist_x = 0, klist_y = 0, n_sp_x = 0, n_sp_y = 0
     1439
     1440    INTEGER(iwp) ::  comp_spectra_level(100) = 999999,                   &
     1441                     lstyles(100) = (/ 0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1442                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1443                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1444                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1445                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1446                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1447                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1448                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1449                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8,    &
     1450                                       0, 7, 3, 10, 1, 4, 9, 2, 6, 8 /), &
     1451                     plot_spectra_level(100) = 999999
     1452
     1453    REAL(wp)    ::  time_to_start_sp = 0.0
    16361454
    16371455    SAVE
    … …  
    16501468!------------------------------------------------------------------------------!
    16511469
     1470    USE kinds
     1471
    16521472    CHARACTER (LEN=40) ::  region(0:9)
    1653     INTEGER ::  pr_palm = 90, statistic_regions = 0
    1654     INTEGER ::  u_max_ijk(3) = -1, v_max_ijk(3) = -1, w_max_ijk(3) = -1
     1473    INTEGER(iwp) ::  pr_palm = 90, statistic_regions = 0
     1474    INTEGER(iwp) ::  u_max_ijk(3) = -1, v_max_ijk(3) = -1, w_max_ijk(3) = -1
    16551475    LOGICAL ::  flow_statistics_called = .FALSE.
    1656     REAL ::     u_max, v_max, w_max
    1657     REAL, DIMENSION(:), ALLOCATABLE       ::  sums_divnew_l, sums_divold_l,   &
    1658                                               weight_substep, weight_pres
    1659     REAL, DIMENSION(:,:), ALLOCATABLE     ::  sums, sums_wsts_bc_l, ts_value, &
    1660                                               sums_wsus_ws_l, sums_wsvs_ws_l, &
    1661                                               sums_us2_ws_l, sums_vs2_ws_l,   &
    1662                                               sums_ws2_ws_l,                  &
    1663                                               sums_wsnrs_ws_l,                &
    1664                                               sums_wspts_ws_l,                &
    1665                                               sums_wssas_ws_l,                &
    1666                                               sums_wsqs_ws_l,                 &
    1667                                               sums_wsqrs_ws_l
     1476    REAL(wp) ::     u_max, v_max, w_max
     1477    REAL(wp), DIMENSION(:), ALLOCATABLE       ::  sums_divnew_l, sums_divold_l,   &
     1478                                                  weight_substep, weight_pres
     1479    REAL(wp), DIMENSION(:,:), ALLOCATABLE     ::  sums, sums_wsts_bc_l, ts_value, &
     1480                                                  sums_wsus_ws_l, sums_wsvs_ws_l, &
     1481                                                  sums_us2_ws_l, sums_vs2_ws_l,   &
     1482                                                  sums_ws2_ws_l,                  &
     1483                                                  sums_wsnrs_ws_l,                &
     1484                                                  sums_wspts_ws_l,                &
     1485                                                  sums_wssas_ws_l,                &
     1486                                                  sums_wsqs_ws_l,                 &
     1487                                                  sums_wsqrs_ws_l
    16681488                                             
    1669     REAL, DIMENSION(:,:,:), ALLOCATABLE   ::  hom_sum, rmask, spectrum_x, &
    1670                                               spectrum_y, sums_l, sums_l_l, &
    1671                                               sums_up_fraction_l
    1672     REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom
     1489    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  hom_sum, rmask, spectrum_x, &
     1490                                                  spectrum_y, sums_l, sums_l_l, &
     1491                                                  sums_up_fraction_l
     1492    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  hom
    16731493
    16741494    SAVE
    … …  
    16871507!------------------------------------------------------------------------------!
    16881508
    1689     INTEGER ::  nxl_y, nxl_yd, nxl_z, nxr_y, nxr_yd, nxr_z, nyn_x, nyn_z,      &
    1690                 nys_x, nys_z, nzb_x, nzb_y, nzb_yd, nzt_x, nzt_y, nzt_yd
     1509    USE kinds
     1510
     1511    INTEGER(iwp) ::  nxl_y, nxl_yd, nxl_z, nxr_y, nxr_yd, nxr_z, nyn_x, nyn_z,      &
     1512                     nys_x, nys_z, nzb_x, nzb_y, nzb_yd, nzt_x, nzt_y, nzt_yd
    16911513               
    16921514

  • palm/trunk/SOURCE/netcdf.f90

    r1310 r1320  
    2323! Current revisions:
    2424! ------------------
    25 !
     25! ONLY-attribute added to USE-statements,
     26! kind-parameters added to all INTEGER and REAL declaration statements,
     27! kinds are defined in new module kinds,
     28! revision history before 2012 removed,
     29! comment fields (!:) to be used for variable explanations added to
     30! all variable declaration statements
    2631!
    2732! Former revisions:
    … …  
    7075! cross_profiles, profile_rows, profile_columns are written to netCDF header
    7176!
    72 ! 771 2011-10-27 10:56:21Z heinze
    73 ! +lpt
    74 !
    75 ! 600 2010-11-24 16:10:51Z raasch
    76 ! bugfix concerning check of cross-section levels on netcdf-files to be
    77 ! extended (xz,yz)
    78 !
    79 ! 564 2010-09-30 13:18:59Z helmke
    80 ! nc_precision changed from 40 masks to 1 mask, start number of mask output
    81 ! files changed to 201, netcdf message identifiers of masked output changed
    82 !
    83 ! 519 2010-03-19 05:30:02Z raasch
    84 ! particle number defined as unlimited dimension in case of netCDF4 output,
    85 ! special characters like * and " are now allowed for netCDF variable names,
    86 ! replacement of these characters removed, routine clean_netcdf_varname
    87 ! removed
    88 !
    89 ! 493 2010-03-01 08:30:24Z raasch
    90 ! Extensions for netCDF4 output
    91 !
    92 ! 410 2009-12-04 17:05:40Z letzel
    93 ! masked data output
    94 !
    95 ! 359 2009-08-19 16:56:44Z letzel
    96 ! for extended netCDF files, the updated title attribute includes an update of
    97 ! time_average_text where appropriate.
    98 ! Bugfix for extended netCDF files: In order to avoid 'data mode' errors if
    99 ! updated attributes are larger than their original size, NF90_PUT_ATT is called
    100 ! in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
    101 ! possible performance loss; an alternative strategy would be to ensure equal
    102 ! attribute size in a job chain.
    103 ! netCDF unit attribute in timeseries output in case of statistic
    104 ! regions added.
    105 ! Output of netCDF messages with aid of message handling routine.
    106 ! Output of messages replaced by message handling routine.
    107 ! Typographical errors fixed.
    108 !
    109 ! 216 2008-11-25 07:12:43Z raasch
    110 ! Origin of the xy-coordinate system shifted from the center of the first
    111 ! grid cell (indices i=0, j=0) to the south-left corner of this cell.
    112 !
    113 ! 189 2008-08-13 17:09:26Z letzel
    114 ! consistently allow 100 spectra levels instead of 10
    115 ! bug fix in the determination of the number of output heights for spectra,
    116 ! +user-defined spectra
    117 !
    118 ! 97 2007-06-21 08:23:15Z raasch
    119 ! Grids defined for rho and sa
    120 !
    121 ! 48 2007-03-06 12:28:36Z raasch
    122 ! Output topography height information (zu_s_inner, zw_s_inner) to 2d-xy and 3d
    123 ! datasets
    124 !
    125 ! RCS Log replace by Id keyword, revision history cleaned up
    126 !
    127 ! Revision 1.12  2006/09/26 19:35:16  raasch
    128 ! Bugfix yv coordinates for yz cross sections
    129 !
    13077! Revision 1.1  2005/05/18 15:37:16  raasch
    13178! Initial revision
    … …  
    14996#if defined( __netcdf )
    15097
    151     USE arrays_3d
    152     USE constants
    153     USE control_parameters
    154     USE grid_variables
    155     USE indices
     98    USE arrays_3d,                                                              &
     99        ONLY:  zu, zw
     100
     101    USE constants,                                                              &
     102        ONLY:  pi
     103
     104    USE control_parameters,                                                     &
     105        ONLY:  averaging_interval, averaging_interval_pr, averaging_interval_sp,&
     106        data_output_pr,  domask,  dopr_n,dopr_time_count, dopts_time_count,     &
     107        dots_time_count, dosp_time_count, do2d, do2d_xz_time_count, do3d,       &
     108        do2d_yz_time_count, mask_size, do2d_xy_time_count, do3d_time_count,     &
     109        domask_time_count, mask_i_global, mask_j_global,mask_k_global,          &
     110        message_string, mid, netcdf_data_format, netcdf_precision, ntdim_2d_xy, &
     111        ntdim_2d_xz, ntdim_2d_yz, ntdim_3d, nz_do3d, prt_time_count,            &
     112        run_description_header, section, simulated_time, topography
     113
     114    USE grid_variables,                                                         &
     115        ONLY:  dx, dy, zu_s_inner, zw_w_inner
     116
     117    USE indices,                                                                &
     118        ONLY:  nx, ny, nz ,nzb, nzt
     119
    156120    USE netcdf_control
     121
     122    USE kinds
     123
    157124    USE pegrid
    158     USE particle_attributes
    159     USE profil_parameter
    160     USE spectrum
    161     USE statistics
     125
     126    USE particle_attributes,                                                    &
     127        ONLY:  maximum_number_of_particles, number_of_particle_groups
     128
     129    USE profil_parameter,                                                       &
     130        ONLY:  crmax, cross_profiles, dopr_index,profile_columns, profile_rows
     131
     132    USE spectrum,                                                               &
     133        ONLY:  comp_spectra_level, data_output_sp, spectra_direction
     134
     135    USE statistics,                                                             &
     136        ONLY:  hom, statistic_regions
    162137
    163138
    164139    IMPLICIT NONE
    165140
    166     CHARACTER (LEN=2)              ::  suffix
    167     CHARACTER (LEN=2), INTENT (IN) ::  callmode
    168     CHARACTER (LEN=3)              ::  suffix1
    169     CHARACTER (LEN=4)              ::  grid_x, grid_y, grid_z
    170     CHARACTER (LEN=6)              ::  mode
    171     CHARACTER (LEN=10)             ::  netcdf_var_name, precision, var
    172     CHARACTER (LEN=80)             ::  time_average_text
    173     CHARACTER (LEN=2000)           ::  char_cross_profiles, var_list, var_list_old
    174 
    175     CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_adj,   &
    176                                                 cross_profiles_char
    177 
    178     INTEGER ::  av, cross_profiles_count, cross_profiles_maxi, delim, &
    179                 delim_old, file_id, i, id_last, id_x, id_y, id_z, j,  &
    180                 k, kk, ns, ns_old, ntime_count, nz_old
    181 
    182     INTEGER, SAVE ::  oldmode
    183 
    184     INTEGER, DIMENSION(1) ::  id_dim_time_old, id_dim_x_yz_old,  &
    185                               id_dim_y_xz_old, id_dim_zu_sp_old, &
    186                               id_dim_zu_xy_old, id_dim_zu_3d_old, &
    187                               id_dim_zu_mask_old
    188 
    189     INTEGER, DIMENSION(1:crmax) ::  cross_profiles_numb
    190 
    191     LOGICAL ::  found
    192 
    193     LOGICAL, INTENT (INOUT) ::  extend
    194 
    195     LOGICAL, SAVE ::  init_netcdf = .FALSE.
    196 
    197     REAL, DIMENSION(1) ::  last_time_coordinate
    198 
    199     REAL, DIMENSION(:), ALLOCATABLE   ::  netcdf_data
    200     REAL, DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d
     141    CHARACTER (LEN=2)              ::  suffix                !:
     142    CHARACTER (LEN=2), INTENT (IN) ::  callmode              !:
     143    CHARACTER (LEN=3)              ::  suffix1               !:
     144    CHARACTER (LEN=4)              ::  grid_x                !:
     145    CHARACTER (LEN=4)              ::  grid_y                !:
     146    CHARACTER (LEN=4)              ::  grid_z                !:
     147    CHARACTER (LEN=6)              ::  mode                  !:
     148    CHARACTER (LEN=10)             ::  netcdf_var_name       !:
     149    CHARACTER (LEN=10)             ::  precision             !:
     150    CHARACTER (LEN=10)             ::  var                   !:
     151    CHARACTER (LEN=80)             ::  time_average_text     !:
     152    CHARACTER (LEN=2000)           ::  char_cross_profiles   !:
     153    CHARACTER (LEN=2000)           ::  var_list              !:
     154    CHARACTER (LEN=2000)           ::  var_list_old          !:
     155
     156    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_adj   !:
     157    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_char  !:
     158
     159    INTEGER(iwp) ::  av                                      !:
     160    INTEGER(iwp) ::  cross_profiles_count                    !:
     161    INTEGER(iwp) ::  cross_profiles_maxi                     !:
     162    INTEGER(iwp) ::  delim                                   !:
     163    INTEGER(iwp) ::  delim_old                               !:
     164    INTEGER(iwp) ::  file_id                                 !:
     165    INTEGER(iwp) ::  i                                       !:
     166    INTEGER(iwp) ::  id_last                                 !:
     167    INTEGER(iwp) ::  id_x                                    !:
     168    INTEGER(iwp) ::  id_y                                    !:
     169    INTEGER(iwp) ::  id_z                                    !:
     170    INTEGER(iwp) ::  j                                       !:
     171    INTEGER(iwp) ::  k                                       !:
     172    INTEGER(iwp) ::  kk                                      !:
     173    INTEGER(iwp) ::  ns                                      !:
     174    INTEGER(iwp) ::  ns_old                                  !:
     175    INTEGER(iwp) ::  ntime_count                             !:
     176    INTEGER(iwp) ::  nz_old                                  !:
     177
     178    INTEGER(iwp), SAVE ::  oldmode                           !:
     179
     180    INTEGER(iwp), DIMENSION(1) ::  id_dim_time_old           !:
     181    INTEGER(iwp), DIMENSION(1) ::  id_dim_x_yz_old           !:
     182    INTEGER(iwp), DIMENSION(1) ::  id_dim_y_xz_old           !:
     183    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_sp_old          !:
     184    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_xy_old          !:
     185    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_3d_old          !:
     186    INTEGER(iwp), DIMENSION(1) ::  id_dim_zu_mask_old        !:
     187
     188
     189    INTEGER(iwp), DIMENSION(1:crmax) ::  cross_profiles_numb !:
     190
     191    LOGICAL ::  found                                        !:
     192
     193    LOGICAL, INTENT (INOUT) ::  extend                       !:
     194
     195    LOGICAL, SAVE ::  init_netcdf = .FALSE.                  !:
     196
     197    REAL(wp), DIMENSION(1) ::  last_time_coordinate          !:
     198
     199    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  netcdf_data    !:
     200    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d !:
    201201
    202202!
    … …  
    49694969    CHARACTER(LEN=*) ::  routine_name
    49704970
    4971     INTEGER ::  errno
     4971    INTEGER(iwp) ::  errno
    49724972
    49734973    IF ( nc_stat /= NF90_NOERR )  THEN

  • palm/trunk/SOURCE/nudging.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! 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:
    … …  
    6268    SUBROUTINE init_nudge
    6369
    64        USE arrays_3d
    65        USE control_parameters
    66        USE cpulog
    67        USE indices
    68        USE pegrid
     70       USE arrays_3d,                                                          &
     71           ONLY:  ptnudge, qnudge, timenudge, tnudge, unudge, vnudge, wnudge,  &
     72                  zu
     73
     74       USE control_parameters,                                                 &
     75           ONLY:  dt_3d, lptnudge, lqnudge, lunudge, lvnudge, lwnudge,         &
     76                   message_string, ntnudge
     77
     78       USE indices,                                                            &
     79           ONLY:  nzb, nzt
     80
     81       USE kinds
    6982
    7083       IMPLICIT NONE
    7184
    72        INTEGER :: finput = 90, ierrn, k, t
    73 
    74        CHARACTER(1) :: hash
    75        REAL :: highheight, highqnudge, highptnudge, highunudge, highvnudge, &
    76                highwnudge, hightnudge
    77        REAL :: lowheight, lowqnudge, lowptnudge, lowunudge, lowvnudge, &
    78                lowwnudge, lowtnudge
    79        REAL :: fac
     85
     86       INTEGER(iwp) ::  finput = 90  !:
     87       INTEGER(iwp) ::  ierrn        !:
     88       INTEGER(iwp) ::  k            !:
     89       INTEGER(iwp) ::  t            !:
     90
     91       CHARACTER(1) ::  hash     !:
     92
     93       REAL(wp) ::  highheight   !:
     94       REAL(wp) ::  highqnudge   !:
     95       REAL(wp) ::  highptnudge  !:
     96       REAL(wp) ::  highunudge   !:
     97       REAL(wp) ::  highvnudge   !:
     98       REAL(wp) ::  highwnudge   !:
     99       REAL(wp) ::  hightnudge   !:
     100
     101       REAL(wp) ::  lowheight    !:
     102       REAL(wp) ::  lowqnudge    !:
     103       REAL(wp) ::  lowptnudge   !:
     104       REAL(wp) ::  lowunudge    !:
     105       REAL(wp) ::  lowvnudge    !:
     106       REAL(wp) ::  lowwnudge    !:
     107       REAL(wp) ::  lowtnudge    !:
     108
     109       REAL(wp) ::  fac          !:
    80110
    81111       ALLOCATE( ptnudge(nzb:nzt+1,1:ntnudge), qnudge(nzb:nzt+1,1:ntnudge), &
    … …  
    103133          t = t + 1
    104134          hash = "#"
    105           ierrn = 1 ! not zero       
     135          ierrn = 1 ! not zero
    106136!
    107137!--       Search for the next line consisting of "# time",
    … …  
    160190             fac = ( highheight - zu(k) ) / ( highheight - lowheight )
    161191
    162              tnudge(k,t)  = fac * lowtnudge + ( 1 - fac ) * hightnudge
    163              unudge(k,t)  = fac * lowunudge + ( 1 - fac ) * highunudge
    164              vnudge(k,t)  = fac * lowvnudge + ( 1 - fac ) * highvnudge
    165              wnudge(k,t)  = fac * lowwnudge + ( 1 - fac ) * highwnudge
    166              ptnudge(k,t) = fac * lowptnudge + ( 1 - fac ) * highptnudge
    167              qnudge(k,t)  = fac * lowqnudge + ( 1 - fac ) * highqnudge
     192             tnudge(k,t)  = fac * lowtnudge + ( 1.0 - fac ) * hightnudge
     193             unudge(k,t)  = fac * lowunudge + ( 1.0 - fac ) * highunudge
     194             vnudge(k,t)  = fac * lowvnudge + ( 1.0 - fac ) * highvnudge
     195             wnudge(k,t)  = fac * lowwnudge + ( 1.0 - fac ) * highwnudge
     196             ptnudge(k,t) = fac * lowptnudge + ( 1.0 - fac ) * highptnudge
     197             qnudge(k,t)  = fac * lowqnudge + ( 1.0 - fac ) * highqnudge
    168198          ENDDO
    169199
    … …  
    188218    SUBROUTINE nudge ( time, prog_var )
    189219
    190        USE arrays_3d
    191        USE buoyancy_mod
    192        USE control_parameters
    193        USE cpulog
    194        USE indices
    195        USE pegrid
    196        USE statistics
     220       USE arrays_3d,                                                          &
     221           ONLY:  pt, ptnudge, q, qnudge, tend, timenudge, tnudge, u, unudge,  &
     222                  v, vnudge
     223
     224       USE buoyancy_mod,                                                       &
     225           ONLY:  calc_mean_profile
     226
     227       USE control_parameters,                                                 &
     228           ONLY:  dt_3d, message_string
     229
     230       USE indices,                                                            &
     231           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
     232
     233       USE kinds,                                                              &
     234           ONLY:  iwp, wp
     235
     236       USE statistics,                                                         &
     237           ONLY:  hom
    197238
    198239       IMPLICIT NONE
    199240
    200        CHARACTER (LEN=*) ::  prog_var
    201 
    202        REAL :: currtnudge, dtm, dtp, time
    203 
    204        INTEGER ::  i, j, k, t
     241       CHARACTER (LEN=*) ::  prog_var  !:
     242
     243       REAL(wp) ::  currtnudge  !:
     244       REAL(wp) ::  dtm         !:
     245       REAL(wp) ::  dtp         !:
     246       REAL(wp) ::  time        !:
     247
     248       INTEGER(iwp) ::  i  !:
     249       INTEGER(iwp) ::  j  !:
     250       INTEGER(iwp) ::  k  !:
     251       INTEGER(iwp) ::  t  !:
    205252
    206253
    … …  
    309356    SUBROUTINE nudge_ij( i, j, time, prog_var )
    310357
    311        USE arrays_3d
    312        USE buoyancy_mod
    313        USE control_parameters
    314        USE cpulog
    315        USE indices
    316        USE pegrid
    317        USE statistics
     358       USE arrays_3d,                                                          &
     359           ONLY:  pt, ptnudge, q, qnudge, tend, timenudge, tnudge, u, unudge,  &
     360                  v, vnudge
     361
     362       USE buoyancy_mod,                                                       &
     363           ONLY:  calc_mean_profile
     364
     365       USE control_parameters,                                                 &
     366           ONLY:  dt_3d, message_string
     367
     368       USE indices,                                                            &
     369           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_u_inner, nzt
     370
     371       USE kinds,                                                              &
     372           ONLY:  iwp, wp
     373
     374       USE statistics,                                                         &
     375           ONLY:  hom
    318376
    319377       IMPLICIT NONE
    320378
    321        CHARACTER (LEN=*) ::  prog_var
    322 
    323        REAL :: currtnudge, dtm, dtp, time
    324 
    325        INTEGER ::  i, j, k, t
     379
     380       CHARACTER (LEN=*) ::  prog_var  !:
     381
     382       REAL(wp) ::  currtnudge  !:
     383       REAL(wp) ::  dtm         !:
     384       REAL(wp) ::  dtp         !:
     385       REAL(wp) ::  time        !:
     386
     387       INTEGER(iwp) ::  i  !:
     388       INTEGER(iwp) ::  j  !:
     389       INTEGER(iwp) ::  k  !:
     390       INTEGER(iwp) ::  t  !:
    326391
    327392

  • palm/trunk/SOURCE/package_parin.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:
    … …  
    3642! replaced by collision_kernel
    3743!
    38 ! 790 2011-11-29 03:11:20Z raasch
    39 ! +turbulence_effects_on_collision, wang_collision_kernel in particles_par
    40 !
    41 ! 336 2009-06-10 11:19:35Z raasch
    42 ! +clip_dvrp_*, cluster_size, color_interval, dvrpsize_interval,
    43 ! groundplate_color, isosurface_color, particle_color, particle_dvrpsize
    44 ! topography_color, in dvrp_graphics_par,
    45 ! parameter dvrp_psize moved from particles_par to dvrp_graphics_par
    46 ! Variables for dvrp-mode pathlines added
    47 !
    48 ! 210 2008-11-06 08:54:02Z raasch
    49 ! Variables for dvrp-mode pathlines added
    50 !
    51 ! 116 2007-10-11 02:30:27Z raasch
    52 ! +dt_sort_particles in package_parin
    53 !
    54 ! 60 2007-03-11 11:50:04Z raasch
    55 ! Particles-package is now part of the default code
    56 !
    57 ! RCS Log replace by Id keyword, revision history cleaned up
    58 !
    59 ! Revision 1.18  2006/08/04 14:52:23  raasch
    60 ! +dt_dopts, dt_min_part, end_time_prel, particles_per_point,
    61 ! use_sgs_for_particles in particles_par
    62 !
    6344! Revision 1.1  2000/12/28 13:21:57  raasch
    6445! Initial revision
    … …  
    7152!------------------------------------------------------------------------------!
    7253
    73     USE control_parameters
    74     USE dvrp_variables
    75     USE particle_attributes
    76     USE spectrum
     54    USE control_parameters,                                                    &
     55        ONLY:  averaging_interval_sp, dt_dopts, dt_dosp, dt_dvrp,              &
     56                particle_maximum_age, skip_time_dosp, threshold
     57
     58    USE dvrp_variables,                                                        &
     59        ONLY:  clip_dvrp_l, clip_dvrp_n, clip_dvrp_r, clip_dvrp_s,             &
     60               cluster_size, color_interval, dvrpsize_interval,                &
     61               dvrp_directory, dvrp_file, dvrp_host, dvrp_output,              &
     62               dvrp_password, dvrp_username, groundplate_color,                &
     63               isosurface_color, mode_dvrp, particle_color,                    &
     64               particle_dvrpsize, pathlines_fadeintime,                        &
     65               pathlines_fadeouttime, pathlines_linecount,                     &
     66               pathlines_maxhistory, pathlines_wavecount,                      &
     67               pathlines_wavetime, slicer_range_limits_dvrp, superelevation,   &
     68               superelevation_x, superelevation_y, topography_color,           &
     69               vc_alpha, vc_gradient_normals, vc_mode, vc_size_x, vc_size_y,   &
     70               vc_size_z
     71
     72    USE particle_attributes,                                                   &
     73        ONLY:  bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, collision_kernel,     &
     74               density_ratio, dissipation_classes, dt_min_part, dt_prel,       &
     75               dt_sort_particles, dt_write_particle_data, dvrp_psize,          &
     76               end_time_prel, initial_weighting_factor,                        &
     77               maximum_number_of_particles, maximum_number_of_tailpoints,      &
     78               maximum_tailpoint_age, minimum_tailpoint_distance,              &
     79               number_of_particle_groups, particles_per_point,                 &
     80               particle_advection, particle_advection_start, pdx, pdy, pdz,    &
     81               psb, psl, psn, psr, pss, pst, radius, radius_classes,           &
     82               random_start_position, read_particles_from_restartfile,         &
     83               skip_particles_for_tail, use_particle_tails,                    &
     84               use_sgs_for_particles, vertical_particle_advection,             &
     85               write_particle_statistics
     86
     87    USE spectrum,                                                              &
     88        ONLY:  comp_spectra_level, data_output_sp, plot_spectra_level,         &
     89               spectra_direction
    7790
    7891    IMPLICIT NONE
    7992
    80     CHARACTER (LEN=80) ::  zeile
     93    CHARACTER (LEN=80) ::  line  !:
    8194
    8295    NAMELIST /dvrp_graphics_par/  clip_dvrp_l, clip_dvrp_n, clip_dvrp_r,       &
    … …  
    117130                                  vertical_particle_advection,                 &
    118131                                  write_particle_statistics
     132
    119133    NAMELIST /spectra_par/        averaging_interval_sp, comp_spectra_level,   &
    120134                                  data_output_sp, dt_dosp, plot_spectra_level, &
    … …  
    125139!-- parin), search for the namelist-group of the package and position the
    126140!-- file at this line. Do the same for each optionally used package.
    127     zeile = ' '
     141    line = ' '
    128142
    129143#if defined( __dvrp_graphics )
    130144    REWIND ( 11 )
    131     zeile = ' '
    132     DO   WHILE ( INDEX( zeile, '&dvrp_graphics_par' ) == 0 )
    133        READ ( 11, '(A)', END=10 )  zeile
     145    line = ' '
     146    DO   WHILE ( INDEX( line, '&dvrp_graphics_par' ) == 0 )
     147       READ ( 11, '(A)', END=10 )  line
    134148    ENDDO
    135149    BACKSPACE ( 11 )
    … …  
    145159!-- Try to find particles package
    146160    REWIND ( 11 )
    147     zeile = ' '
    148     DO   WHILE ( INDEX( zeile, '&particles_par' ) == 0 )
    149        READ ( 11, '(A)', END=20 )  zeile
     161    line = ' '
     162    DO   WHILE ( INDEX( line, '&particles_par' ) == 0 )
     163       READ ( 11, '(A)', END=20 )  line
    150164    ENDDO
    151165    BACKSPACE ( 11 )
    … …  
    164178#if defined( __spectra )
    165179    REWIND ( 11 )
    166     zeile = ' '
    167     DO   WHILE ( INDEX( zeile, '&spectra_par' ) == 0 )
    168        READ ( 11, '(A)', END=30 )  zeile
     180    line = ' '
     181    DO   WHILE ( INDEX( line, '&spectra_par' ) == 0 )
     182       READ ( 11, '(A)', END=30 )  line
    169183    ENDDO
    170184    BACKSPACE ( 11 )

  • palm/trunk/SOURCE/palm.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! 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:
    … …  
    5965! 849 2012-03-15 10:35:09Z raasch
    6066! write_particles renamed lpm_write_restart_file
    61 !
    62 ! 759 2011-09-15 13:58:31Z raasch
    63 ! Splitting of parallel I/O, cpu measurement for write_3d_binary and opening
    64 ! of unit 14 moved to here
    65 !
    66 ! 495 2010-03-02 00:40:15Z raasch
    67 ! Particle data for restart runs are only written if write_binary=.T..
    68 !
    69 ! 215 2008-11-18 09:54:31Z raasch
    70 ! Initialization of coupled runs modified for MPI-1 and moved to external
    71 ! subroutine init_coupling
    72 !
    73 ! 197 2008-09-16 15:29:03Z raasch
    74 ! Workaround for getting information about the coupling mode
    75 !
    76 ! 108 2007-08-24 15:10:38Z letzel
    77 ! Get coupling mode from environment variable, change location of debug output
    78 !
    79 ! 75 2007-03-22 09:54:05Z raasch
    80 ! __vtk directives removed, write_particles is called only in case of particle
    81 ! advection switched on, open unit 9 for debug output,
    82 ! setting of palm version moved from modules to here
    83 !
    84 ! RCS Log replace by Id keyword, revision history cleaned up
    85 !
    86 ! Revision 1.10  2006/08/04 14:53:12  raasch
    87 ! Distibution of run description header removed, call of header moved behind
    88 ! init_3d_model
    89 !
    90 ! Revision 1.2  2001/01/25 07:15:06  raasch
    91 ! Program name changed to PALM, module test_variables removed.
    92 ! Initialization of dvrp logging as well as exit of dvrp moved to new
    93 ! subroutines init_dvrp_logging and close_dvrp (file init_dvrp.f90)
    9467!
    9568! Revision 1.1  1997/07/24 11:23:35  raasch
    … …  
    10881
    10982
    110     USE arrays_3d
    111     USE constants
    112     USE control_parameters
    113     USE cpulog
    114     USE dvrp_variables
    115     USE grid_variables
    116     USE indices
    117     USE ls_forcing_mod
    118     USE model_1d
    119     USE nudge_mod
    120     USE particle_attributes
     83    USE control_parameters,                                                    &
     84        ONLY:  coupling_char, coupling_mode, do2d_at_begin, do3d_at_begin,     &
     85               io_blocks, io_group, large_scale_forcing, nudging,              &
     86               simulated_time, simulated_time_chr, version, write_binary
     87
     88    USE cpulog,                                                                &
     89        ONLY:  cpu_log, log_point, cpu_statistics
     90
     91    USE kinds
     92
     93    USE ls_forcing_mod,                                                        &
     94        ONLY:  init_ls_forcing
     95
     96    USE nudge_mod,                                                             &
     97        ONLY:  init_nudge
     98
     99    USE particle_attributes,                                                   &
     100        ONLY:  particle_advection
     101
    121102    USE pegrid
    122     USE spectrum
    123     USE statistics
    124103
    125104#if defined( __openacc )
    … …  
    131110!
    132111!-- Local variables
    133     CHARACTER (LEN=9) ::  time_to_string
    134     INTEGER           ::  i
     112    CHARACTER(LEN=9) ::  time_to_string  !:
     113    INTEGER(iwp)     ::  i               !:
    135114#if defined( __openacc )
    136     REAL, DIMENSION(100) ::  acc_dum
     115    REAL(wp), DIMENSION(100) ::  acc_dum     !:
    137116#endif
    138117

  • palm/trunk/SOURCE/parin.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! 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:
    … …  
    107113! New cpp directive "__check" implemented which is used by check_namelist_files
    108114!
    109 ! 785 2011-11-28 09:47:19Z raasch
    110 ! +scalar_rayleigh_damping in inipar
    111 !
    112 ! 767 2011-10-14 06:39:12Z raasch
    113 ! +u_profile, v_profile, uv_heights in inipar
    114 !
    115 ! 759 2011-09-15 13:58:31Z raasch
    116 ! +maximum_parallel_io_streams in envpar,
    117 ! splitting of parallel I/O in blocks of PEs
    118 !
    119 ! 683 2011-02-09 14:25:15Z raasch
    120 ! +synchronous_exchange in d3par
    121 !
    122 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    123 ! Steering parameter dissipation_control added in inipar. (commented out)
    124 !
    125 ! 622 2010-12-10 08:08:13Z raasch
    126 ! +collective_wait in inipar
    127 !
    128 ! 600 2010-11-24 16:10:51Z raasch
    129 ! parameters moved from d3par to inipar: call_psolver_at_all_substeps,
    130 ! cfl_factor, cycle_mg, mg_cycles, mg_switch_to_pe0_level, ngsrb, nsor,
    131 ! omega_sor, prandtl_number, psolver, rayleigh_damping_factor,
    132 ! rayleigh_damping_height, residual_limit
    133 !
    134 ! 580 2010-10-05 13:59:11Z heinze
    135 ! Renaming of ws_vertical_gradient to subs_vertical_gradient and
    136 ! ws_vertical_gradient_level to subs_vertical_gradient_level
    137 !
    138 ! 553 2010-09-01 14:09:06Z weinreis
    139 ! parameters for masked output are replaced by arrays
    140 !
    141 ! 493 2010-03-01 08:30:24Z raasch
    142 ! +netcdf_data_format in d3par, -netcdf_64bit, -netcdf_64bit_3d
    143 !
    144 ! 449 2010-02-02 11:23:59Z raasch
    145 ! +wall_humidityflux, wall_scalarflux
    146 ! +ws_vertical_gradient, ws_vertical_gradient_level
    147 !
    148 ! 410 2009-12-04 17:05:40Z letzel
    149 ! masked data output: + dt_domask, mask_01~20_x|y|z, mask_01~20_x|y|z_loop,
    150 ! mask_scale_x|y|z, masks, skip_time_domask
    151 !
    152 ! 291 2009-04-16 12:07:26Z raasch
    153 ! +local_dvrserver_running in envpar
    154 ! Output of messages replaced by message handling routine.
    155 ! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
    156 ! canyon_wall_south, conserve_volume_flow_mode, coupling_start_time,
    157 ! dp_external, dp_level_b, dp_smooth, dpdxy, u_bulk, v_bulk in inipar
    158 ! topography_grid_convention moved from userpar
    159 !
    160 ! 197 2008-09-16 15:29:03Z raasch
    161 ! +cthf,leaf_surface_concentration, scalar_exchange_coefficient
    162 ! +inflow_damping_height, inflow_damping_width, recycling_width,
    163 ! turbulent_inflow in inipar, -skip_time_dosp in d3par,
    164 ! allocation of hom_sum moved from init_3d_model to here,
    165 ! npex, npey moved from inipar to d3par, setting of myid_char_14 removed,
    166 ! lad is allways allocated
    167 !
    168 ! 138 2007-11-28 10:03:58Z letzel
    169 ! +canopy_mode, drag_coefficient, lad_surface, lad_vertical_gradient,
    170 ! lad_vertical_gradient_level, pch_index, plant_canopy,
    171 ! +allocation of leaf area density field
    172 !
    173 ! 108 2007-08-24 15:10:38Z letzel
    174 ! +e_init, top_momentumflux_u|v in inipar, +dt_coupling in d3par
    175 !
    176 ! 95 2007-06-02 16:48:38Z raasch
    177 ! +bc_sa_t, bottom_salinityflux, ocean, sa_surface, sa_vertical_gradient,
    178 ! sa_vertical_gradient_level, top_salinityflux in inipar,
    179 ! sa_init is allocated
    180 !
    181 ! 87 2007-05-22 15:46:47Z raasch
    182 ! Size of hom increased by the maximum number of user-defined profiles,
    183 ! var_hom renamed pr_palm
    184 !
    185 ! 82 2007-04-16 15:40:52Z raasch
    186 ! +return_addres, return_username in envpar
    187 !
    188 ! 75 2007-03-22 09:54:05Z raasch
    189 ! +dt_max, netcdf_64bit_3d, precipitation_amount_interval in d3par,
    190 ! +loop_optimization, pt_reference in inipar, -data_output_ts,
    191 ! moisture renamed humidity
    192 !
    193 ! 20 2007-02-26 00:12:32Z raasch
    194 ! +top_heatflux, use_top_fluxes in inipar
    195 !
    196 ! 3 2007-02-13 11:30:58Z raasch
    197 ! +netcdf_64bit_3d in d3par,
    198 ! RCS Log replace by Id keyword, revision history cleaned up
    199 !
    200 ! Revision 1.57  2007/02/11 13:11:22  raasch
    201 ! Values of environment variables are now read from file ENVPAR instead of
    202 ! reading them with a system call, + NAMELIST envpar
    203 !
    204115! Revision 1.1  1997/07/24 11:22:50  raasch
    205116! Initial revision
    … …  
    211122!------------------------------------------------------------------------------!
    212123
    213     USE arrays_3d
    214     USE averaging
    215     USE cloud_parameters
    216     USE control_parameters
    217     USE cpulog
    218     USE dvrp_variables
    219     USE grid_variables
    220     USE indices
    221     USE model_1d
     124    USE arrays_3d,                                                             &
     125        ONLY:  lad, pt_init, q_init, ref_state, sa_init, ug, u_init, v_init,   &
     126               vg
     127
     128    USE cloud_parameters,                                                      &
     129        ONLY:  c_sedimentation, curvature_solution_effects,                    &
     130               limiter_sedimentation, nc_const, ventilation_effect
     131
     132    USE control_parameters,                                                    &
     133        ONLY:  alpha_surface, averaging_interval, averaging_interval_pr,       &
     134               bc_e_b, bc_lr, bc_ns, bc_p_b, bc_p_t, bc_pt_b, bc_pt_t,         &
     135               bc_q_b, bc_q_t,bc_s_b, bc_s_t, bc_sa_t, bc_uv_b, bc_uv_t,       &
     136               bottom_salinityflux, building_height, building_length_x,        &
     137               building_length_y, building_wall_left, building_wall_south,     &
     138               call_psolver_at_all_substeps, canopy_mode, canyon_height,       &
     139               canyon_width_x, canyon_width_y, canyon_wall_left,               &
     140               canyon_wall_south, cfl_factor,                                  &
     141               cloud_droplets, cloud_physics, cloud_scheme,                    &
     142               conserve_volume_flow, conserve_volume_flow_mode,                &
     143               coupling_start_time, create_disturbances, cthf, cycle_mg,       &
     144               data_output, data_output_format, data_output_masks,             &
     145               data_output_pr, data_output_2d_on_each_pe,                      &
     146               disturbance_amplitude, disturbance_energy_limit,                &
     147               disturbance_level_b, disturbance_level_t, dissipation_1d,       &
     148               do2d_at_begin, do3d_at_begin, do3d_compress, do3d_comp_prec,    &
     149               dp_external, dp_level_b, dp_smooth, dpdxy, drag_coefficient,    &
     150               drizzle, dt, dz, dt_averaging_input, dt_averaging_input_pr,     &
     151               dt_coupling, dt_data_output, dt_data_output_av, dt_disturb,     &
     152               dt_domask, dt_dopr, dt_dopr_listing, dt_dots, dt_do2d_xy,       &
     153               dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_max, dt_restart,            &
     154               dt_run_control, dz_max, dz_stretch_factor, dz_stretch_level,    &
     155               end_time, e_init, e_min, fft_method, force_print_header,        &
     156               galilei_transformation, host, humidity, inflow_damping_height,  &
     157               inflow_damping_width, inflow_disturbance_begin,                 &
     158               inflow_disturbance_end,  initializing_actions, io_blocks,       &
     159               io_group, km_constant, lad_surface, lad_vertical_gradient,      &
     160               lad_vertical_gradient_level, large_scale_forcing,               &
     161               large_scale_subsidence, leaf_surface_concentration,             &
     162               loop_optimization, masking_method, mask_scale_x, mask_scale_y,  &
     163               mask_scale_z, mask_x, mask_y, mask_z, mask_x_loop,              &
     164               mask_y_loop, mask_z_loop, maximum_cpu_time_allowed,             &
     165               maximum_parallel_io_streams, max_pr_user, message_string,       &
     166               mg_cycles, mg_switch_to_pe0_level, mixing_length_1d,            &
     167               momentum_advec, netcdf_data_format, netcdf_precision, neutral,  &
     168               ngsrb, normalizing_region, nsor, nsor_ini, nudging, ocean,      &
     169               omega, omega_sor, passive_scalar, pch_index, phi, nz_do3d,      &
     170               plant_canopy, prandtl_layer, prandtl_number, precipitation,     &
     171               precipitation_amount_interval, psolver, pt_damping_factor,      &
     172               pt_damping_width, pt_reference, pt_surface,                     &
     173               pt_surface_initial_change, pt_vertical_gradient,                &
     174               pt_vertical_gradient_level, q_surface,                          &
     175               q_surface_initial_change, q_vertical_gradient,                  &
     176               q_vertical_gradient_level, radiation, random_generator,         &
     177               random_heatflux, rayleigh_damping_factor,                       &
     178               rayleigh_damping_height, recycling_width, reference_state,      &
     179               residual_limit, restart_time, return_addres, return_username,   &
     180               revision, rif_max, rif_min, roughness_length, runnr,            &
     181               run_identifier, sa_surface, sa_vertical_gradient,               &
     182               sa_vertical_gradient_level, scalar_advec,                       &
     183               scalar_exchange_coefficient, scalar_rayleigh_damping,           &
     184               section_xy, section_xz, section_yz, skip_time_data_output,      &
     185               skip_time_data_output_av, skip_time_dopr, skip_time_do2d_xy,    &
     186               skip_time_do2d_xz, skip_time_do2d_yz, skip_time_do3d,           &
     187               skip_time_domask, subs_vertical_gradient,                       &
     188               subs_vertical_gradient_level, surface_heatflux,                 &
     189               surface_pressure, surface_scalarflux, surface_waterflux,        &
     190               synchronous_exchange,s_surface, s_surface_initial_change,       &
     191               s_vertical_gradient, s_vertical_gradient_level,                 &
     192               termination_time_needed, timestep_scheme, topography,           &
     193               topography_grid_convention, top_heatflux,  top_momentumflux_u,  &
     194               top_momentumflux_v, top_salinityflux,                           &
     195               transpose_compute_overlap, turbulence, turbulent_inflow,        &
     196               ug_surface, ug_vertical_gradient, ug_vertical_gradient_level,   &
     197               use_surface_fluxes, use_cmax, use_top_fluxes,                   &
     198               use_ug_for_galilei_tr, use_upstream_for_tke, uv_heights,        &
     199               u_bulk, u_profile, vg_surface, vg_vertical_gradient,            &
     200               vg_vertical_gradient_level, v_bulk, v_profile,                  &
     201               wall_adjustment, wall_heatflux, wall_humidityflux,              &
     202               wall_scalarflux, write_binary, z0h_factor, z_max_do2d
     203
     204    USE cpulog,                                                                &
     205        ONLY:  cpu_log_barrierwait
     206
     207    USE dvrp_variables,                                                        &
     208        ONLY:  local_dvrserver_running
     209
     210    USE grid_variables,                                                        &
     211        ONLY:  dx, dy
     212
     213    USE indices,                                                               &
     214        ONLY:  nx, ny, nz
     215
     216    USE model_1d,                                                              &
     217        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
     218
    222219    USE pegrid
    223     USE profil_parameter
    224     USE statistics
     220
     221    USE profil_parameter,                                                      &
     222        ONLY:  cross_profiles, cross_ts_uymax, cross_ts_uymin,                 &
     223               profile_columns, profile_rows
     224
     225    USE statistics,                                                            &
     226        ONLY:  hom, hom_sum, pr_palm, region, statistic_regions
    225227
    226228    IMPLICIT NONE
    227229
    228     INTEGER ::  i
     230    INTEGER(iwp) ::  i   !:
    229231
    230232

  • palm/trunk/SOURCE/plant_canopy_model.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:
    … …  
    2834! 1036 2012-10-22 13:43:42Z raasch
    2935! code put under GPL (PALM 3.9)
    30 !
    31 ! 257 2009-03-11 15:17:42Z heinze
    32 ! Output of messages replaced by message handling routine.
    33 ! Bugfix: remove IF statement in plant_canopy_model_ij
    34 !
    35 ! 153 2008-03-19 09:41:30Z steinfeld
    36 ! heat sources within the forest canopy are added, which represent the
    37 ! rate of heat input into the air from the forest leaves, evaluation of sinks
    38 ! and sources for scalar concentration due to canopy elements
    3936!
    4037! 138 2007-11-28 10:03:58Z letzel
    … …  
    6360    SUBROUTINE plant_canopy_model( component )
    6461
    65        USE arrays_3d
    66        USE control_parameters
    67        USE indices
    68        USE pegrid
     62       USE arrays_3d,                                                          &
     63           ONLY:  canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w,   &
     64                  q, sec, sls, tend, u, v, w
     65
     66       USE control_parameters,                                                 &
     67           ONLY:  pch_index, message_string
     68
     69       USE indices,                                                            &
     70           ONLY:  nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner,    &
     71                  nzb_v_inner, nzb_w_inner
     72
     73       USE kinds
    6974
    7075       IMPLICIT NONE
    7176
    72        INTEGER ::  component, i, j, k
     77       INTEGER(iwp) ::  component  !:
     78       INTEGER(iwp) ::  i          !:
     79       INTEGER(iwp) ::  j          !:
     80       INTEGER(iwp) ::  k          !:
    7381 
    7482!
    … …  
    154162                DO  j = nys, nyn
    155163                   DO  k = nzb_s_inner(j,i)+1, pch_index
    156                       tend(k,j,i) = tend(k,j,i) +                     &
     164                      tend(k,j,i) = tend(k,j,i) +                   &
    157165                                    ( canopy_heat_flux(k,j,i) -     &
    158166                                      canopy_heat_flux(k-1,j,i) ) / &
    … …  
    221229    SUBROUTINE plant_canopy_model_ij( i, j, component )
    222230
    223        USE arrays_3d
    224        USE control_parameters
    225        USE indices
    226        USE pegrid
     231       USE arrays_3d,                                                          &
     232           ONLY:  canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w,   &
     233                  q, sec, sls, tend, u, v, w
     234
     235       USE control_parameters,                                                 &
     236           ONLY:  pch_index, message_string
     237
     238       USE indices,                                                            &
     239           ONLY:  nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner,    &
     240                  nzb_v_inner, nzb_w_inner
     241
     242       USE kinds
    227243
    228244       IMPLICIT NONE
    229245
    230        INTEGER ::  component, i, j, k
    231 
    232 !
    233 !--    Compute drag for the three velocity components
     246       INTEGER(iwp) ::  component  !:
     247       INTEGER(iwp) ::  i          !:
     248       INTEGER(iwp) ::  j          !:
     249       INTEGER(iwp) ::  k          !:
     250
     251!
     252!--    Compute drag for the three velocity components
    234253       SELECT CASE ( component )
    235254
    … …  
    238257       CASE ( 1 )
    239258          DO  k = nzb_u_inner(j,i)+1, pch_index
    240              tend(k,j,i) = tend(k,j,i) -                  &
     259             tend(k,j,i) = tend(k,j,i) -                     &
    241260                              cdc(k,j,i) * lad_u(k,j,i) *    &   
    242261                              SQRT(     u(k,j,i)**2 +        &
    … …  
    258277       CASE ( 2 )
    259278          DO  k = nzb_v_inner(j,i)+1, pch_index
    260              tend(k,j,i) = tend(k,j,i) -                  &
     279             tend(k,j,i) = tend(k,j,i) -                     &
    261280                              cdc(k,j,i) * lad_v(k,j,i) *    &
    262281                              SQRT( ( ( u(k,j-1,i)   +       &
    … …  
    278297       CASE ( 3 )
    279298          DO  k = nzb_w_inner(j,i)+1, pch_index
    280              tend(k,j,i) = tend(k,j,i) -                  &
     299             tend(k,j,i) = tend(k,j,i) -                     &
    281300                              cdc(k,j,i) * lad_w(k,j,i) *    &
    282301                              SQRT( ( ( u(k,j,i)    +        & 
    … …  
    299318          CASE ( 4 )
    300319             DO  k = nzb_s_inner(j,i)+1, pch_index
    301                 tend(k,j,i) = tend(k,j,i) +                     &
     320                tend(k,j,i) = tend(k,j,i) +                   &
    302321                              ( canopy_heat_flux(k,j,i) -     &
    303322                                canopy_heat_flux(k-1,j,i) ) / &
    … …  
    328347       CASE ( 6 )
    329348          DO  k = nzb_s_inner(j,i)+1, pch_index   
    330              tend(k,j,i) = tend(k,j,i) -                     &
     349             tend(k,j,i) = tend(k,j,i) -                        &
    331350                              2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
    332351                              SQRT( ( ( u(k,j,i)           +    &

  • palm/trunk/SOURCE/poisfft.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! 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:
    … …  
    95101! (most of the code is unneeded by check_namelist_files).
    96102!
    97 ! 763 2011-10-06 09:32:09Z suehring
    98 ! Comment added concerning the last change.
    99 !
    100 ! 761 2011-10-05 17:58:52Z suehring
    101 ! Bugfix: Avoid divisions by zero in case of using a 'neumann' bc for the
    102 ! pressure at the top of the model domain.
    103 !
    104 ! 696 2011-03-18 07:03:49Z raasch
    105 ! work_fftx removed from PRIVATE clauses in fftx_tr_xy and tr_yx_fftx
    106 !
    107 ! 683 2011-02-09 14:25:15Z raasch
    108 ! openMP parallelization for 2d-domain-decomposition
    109 !
    110 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    111 ! ddzu replaced by ddzu_pres due to changes in zu(0)
    112 !
    113 ! 622 2010-12-10 08:08:13Z raasch
    114 ! optional barriers included in order to speed up collective operations
    115 !
    116 ! 377 2009-09-04 11:09:00Z raasch
    117 ! __lcmuk changed to __lc to avoid problems with Intel compiler on sgi-ice
    118 !
    119 ! 164 2008-05-15 08:46:15Z raasch
    120 ! Arguments removed from transpose routines
    121 !
    122 ! 128 2007-10-26 13:11:14Z raasch
    123 ! Bugfix: wavenumber calculation for even nx in routines maketri
    124 !
    125 ! 85 2007-05-11 09:35:14Z raasch
    126 ! Bugfix: work_fft*_vec removed from some PRIVATE-declarations
    127 !
    128 ! 76 2007-03-29 00:58:32Z raasch
    129 ! Tridiagonal coefficients adjusted for Neumann boundary conditions both at
    130 ! the bottom and the top.
    131 !
    132 ! RCS Log replace by Id keyword, revision history cleaned up
    133 !
    134 ! Revision 1.24  2006/08/04 15:00:24  raasch
    135 ! Default setting of the thread number tn in case of not using OpenMP
    136 !
    137 ! Revision 1.23  2006/02/23 12:48:38  raasch
    138 ! Additional compiler directive in routine tridia_1dd for preventing loop
    139 ! exchange on NEC-SX6
    140 !
    141 ! Revision 1.20  2004/04/30 12:38:09  raasch
    142 ! Parts of former poisfft_hybrid moved to this subroutine,
    143 ! former subroutine changed to a module, renaming of FFT-subroutines and
    144 ! -module, FFTs completely substituted by calls of fft_x and fft_y,
    145 ! NAG fft used in the non-parallel case completely removed, l in maketri
    146 ! is now a 1d-array, variables passed by modules instead of using parameter
    147 ! lists, enlarged transposition arrays introduced
    148 !
    149103! Revision 1.1  1997/07/24 11:24:14  raasch
    150104! Initial revision
    … …  
    167121!------------------------------------------------------------------------------!
    168122
    169     USE fft_xy
    170     USE indices
    171     USE transpose_indices
    172     USE tridia_solver
     123    USE fft_xy,                                                                &
     124        ONLY:  fft_init, fft_y, fft_y_1d, fft_y_m, fft_x, fft_x_1d, fft_x_m
     125
     126    USE indices,                                                               &
     127        ONLY:  nnx, nny, nx, nxl, nxr, ny, nys, nyn, nz
     128
     129    USE transpose_indices,                                                     &
     130        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nys_x, nys_z, nyn_x, nyn_z, nzb_x,  &
     131               nzb_y, nzt_x, nzt_y
     132
     133    USE tridia_solver,                                                         &
     134        ONLY:  tridia_1dd, tridia_init, tridia_substi, tridia_substi_overlap
    173135
    174136    IMPLICIT NONE
    … …  
    200162    SUBROUTINE poisfft_init
    201163
    202        USE arrays_3d,  ONLY:  ddzu_pres, ddzw
     164       USE arrays_3d,                                                          &
     165           ONLY:  ddzu_pres, ddzw
     166
     167       USE kinds
    203168
    204169       IMPLICIT NONE
    205170
    206        INTEGER ::  k
     171       INTEGER(iwp) ::  k  !:
    207172
    208173
    … …  
    219184    SUBROUTINE poisfft( ar )
    220185
    221        USE control_parameters,  ONLY : fft_method, transpose_compute_overlap
    222        USE cpulog
     186       USE control_parameters,                                                 &
     187           ONLY:  fft_method, transpose_compute_overlap
     188
     189       USE cpulog,                                                             &
     190           ONLY:  cpu_log, cpu_log_nowait, log_point_s
     191
     192       USE kinds
     193
    223194       USE pegrid
    224195
    225196       IMPLICIT NONE
    226197
    227        INTEGER ::  ii, iind, inew, jj, jind, jnew, ki, kk, knew, n, nblk, &
    228                    nnx_y, nny_z, nnz_t, nnz_x, nxl_y_bound, nxr_y_bound
    229        INTEGER, DIMENSION(4) ::  isave
    230 
    231        REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar
     198       INTEGER(iwp) ::  ii           !:
     199       INTEGER(iwp) ::  iind         !:
     200       INTEGER(iwp) ::  inew         !:
     201       INTEGER(iwp) ::  jj           !:
     202       INTEGER(iwp) ::  jind         !:
     203       INTEGER(iwp) ::  jnew         !:
     204       INTEGER(iwp) ::  ki           !:
     205       INTEGER(iwp) ::  kk           !:
     206       INTEGER(iwp) ::  knew         !:
     207       INTEGER(iwp) ::  n            !:
     208       INTEGER(iwp) ::  nblk         !:
     209       INTEGER(iwp) ::  nnx_y        !:
     210       INTEGER(iwp) ::  nny_z        !:
     211       INTEGER(iwp) ::  nnz_t        !:
     212       INTEGER(iwp) ::  nnz_x        !:
     213       INTEGER(iwp) ::  nxl_y_bound  !:
     214       INTEGER(iwp) ::  nxr_y_bound  !:
     215
     216       INTEGER(iwp), DIMENSION(4) ::  isave  !:
     217
     218       REAL(wp), DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar      !:
    232219       !$acc declare create( ar_inv )
    233        REAL, DIMENSION(nys:nyn,nxl:nxr,1:nz) ::  ar_inv
    234 
    235        REAL, DIMENSION(:,:,:),   ALLOCATABLE ::  ar1, f_in, f_inv, f_out_y, &
    236                                                  f_out_z
     220       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nz) ::  ar_inv  !:
     221
     222       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  ar1      !:
     223       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_in     !:
     224       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_inv    !:
     225       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_out_y  !:
     226       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  f_out_z  !:
    237227
    238228
    … …  
    723713!------------------------------------------------------------------------------!
    724714
    725        USE control_parameters
    726        USE cpulog
    727        USE indices
     715       USE control_parameters,                                                 &
     716           ONLY:  host
     717
     718       USE cpulog,                                                             &
     719           ONLY:  cpu_log, log_point_s
     720
     721       USE kinds
     722
    728723       USE pegrid
    729        USE transpose_indices
    730724
    731725       IMPLICIT NONE
    732726
    733        INTEGER            ::  i, iend, iouter, ir, j, k
    734        INTEGER, PARAMETER ::  stridex = 4
    735 
    736        REAL, DIMENSION(0:ny,stridex)                    ::  work_ffty
     727       INTEGER(iwp)            ::  i            !:
     728       INTEGER(iwp)            ::  iend         !:
     729       INTEGER(iwp)            ::  iouter       !:
     730       INTEGER(iwp)            ::  ir           !:
     731       INTEGER(iwp)            ::  j            !:
     732       INTEGER(iwp)            ::  k            !:
     733
     734       INTEGER(iwp), PARAMETER ::  stridex = 4  !:
     735
     736       REAL(wp), DIMENSION(0:ny,stridex)        ::  work_ffty      !:
    737737#if defined( __nec )
    738        REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr)             ::  work_ffty_vec
     738       REAL(wp), DIMENSION(0:ny+1,1:nz,nxl:nxr) ::  work_ffty_vec  !:
    739739#endif
    740        REAL, DIMENSION(1:nz,0:ny,nxl:nxr)            ::  f_in
    741        REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  f_out
    742        REAL, DIMENSION(nxl:nxr,1:nz,0:ny)            ::  work
     740       REAL(wp), DIMENSION(1:nz,0:ny,nxl:nxr)             ::  f_in   !:
     741       REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  f_out  !:
     742       REAL(wp), DIMENSION(nxl:nxr,1:nz,0:ny)             ::  work   !:
    743743
    744744!
    … …  
    840840!------------------------------------------------------------------------------!
    841841
    842        USE control_parameters
    843        USE cpulog
    844        USE indices
     842       USE control_parameters,                                                 &
     843           ONLY:  host
     844
     845       USE cpulog,                                                             &
     846           ONLY:  cpu_log, log_point_s
     847
     848       USE kinds
     849
    845850       USE pegrid
    846        USE transpose_indices
    847851
    848852       IMPLICIT NONE
    849853
    850        INTEGER            ::  i, iend, iouter, ir, j, k
    851        INTEGER, PARAMETER ::  stridex = 4
    852 
    853        REAL, DIMENSION(0:ny,stridex)                    ::  work_ffty
     854       INTEGER(iwp)            ::  i            !:
     855       INTEGER(iwp)            ::  iend         !:
     856       INTEGER(iwp)            ::  iouter       !:
     857       INTEGER(iwp)            ::  ir           !:
     858       INTEGER(iwp)            ::  j            !:
     859       INTEGER(iwp)            ::  k            !:
     860
     861       INTEGER(iwp), PARAMETER ::  stridex = 4  !:
     862
     863       REAL(wp), DIMENSION(0:ny,stridex)        ::  work_ffty      !:
    854864#if defined( __nec )
    855        REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr)             ::  work_ffty_vec
     865       REAL(wp), DIMENSION(0:ny+1,1:nz,nxl:nxr) ::  work_ffty_vec  !:
    856866#endif
    857        REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  f_in
    858        REAL, DIMENSION(1:nz,0:ny,nxl:nxr)             ::  f_out
    859        REAL, DIMENSION(nxl:nxr,1:nz,0:ny)             ::  work
     867       REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  f_in   !:
     868       REAL(wp), DIMENSION(1:nz,0:ny,nxl:nxr)             ::  f_out  !:
     869       REAL(wp), DIMENSION(nxl:nxr,1:nz,0:ny)             ::  work   !:
    860870
    861871!
    … …  
    960970!------------------------------------------------------------------------------!
    961971
    962        USE control_parameters
    963        USE cpulog
    964        USE grid_variables
    965        USE indices
     972       USE control_parameters,                                                 &
     973           ONLY:  host
     974
     975       USE cpulog,                                                             &
     976           ONLY:  cpu_log, log_point_s
     977
     978       USE grid_variables,                                                     &
     979           ONLY:  ddx2, ddy2
     980
     981       USE kinds
     982
    966983       USE pegrid
    967        USE transpose_indices
    968984
    969985       IMPLICIT NONE
    970986
    971        INTEGER ::  i, j, k, m, n, omp_get_thread_num, tn
    972 
    973        REAL, DIMENSION(0:nx)                          ::  work_fftx
    974        REAL, DIMENSION(0:nx,1:nz)                     ::  work_trix
    975        REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  ar
    976        REAL, DIMENSION(:,:,:,:), ALLOCATABLE          ::  tri
     987       INTEGER(iwp) ::  i                   !:
     988       INTEGER(iwp) ::  j                   !:
     989       INTEGER(iwp) ::  k                   !:
     990       INTEGER(iwp) ::  m                   !:
     991       INTEGER(iwp) ::  n                   !:
     992       INTEGER(iwp) ::  omp_get_thread_num  !:
     993       INTEGER(iwp) ::  tn                  !:
     994
     995       REAL(wp), DIMENSION(0:nx)                          ::  work_fftx  !:
     996       REAL(wp), DIMENSION(0:nx,1:nz)                     ::  work_trix  !:
     997       REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) ::  ar         !:
     998       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE          ::  tri        !:
    977999
    9781000
    … …  
    10911113!------------------------------------------------------------------------------!
    10921114
    1093        USE control_parameters
    1094        USE cpulog
    1095        USE indices
     1115       USE control_parameters,                                                 &
     1116           ONLY:  host
     1117
     1118       USE cpulog,                                                             &
     1119           ONLY:  cpu_log, log_point_s
     1120
     1121       USE kinds
     1122
    10961123       USE pegrid
    1097        USE transpose_indices
    10981124
    10991125       IMPLICIT NONE
    11001126
    1101        INTEGER            ::  i, j, k
    1102 
    1103        REAL, DIMENSION(0:nx,1:nz,nys:nyn)             ::  work_fftx
    1104        REAL, DIMENSION(1:nz,nys:nyn,0:nx)             ::  f_in
    1105        REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  f_out
    1106        REAL, DIMENSION(nys:nyn,1:nz,0:nx)             ::  work
     1127       INTEGER(iwp) ::  i  !:
     1128       INTEGER(iwp) ::  j  !:
     1129       INTEGER(iwp) ::  k  !:
     1130
     1131       REAL(wp), DIMENSION(0:nx,1:nz,nys:nyn)             ::  work_fftx  !:
     1132       REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx)             ::  f_in       !:
     1133       REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  f_out      !:
     1134       REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx)             ::  work       !:
    11071135
    11081136!
    … …  
    11961224!------------------------------------------------------------------------------!
    11971225
    1198        USE control_parameters
    1199        USE cpulog
    1200        USE indices
     1226       USE control_parameters,                                                 &
     1227           ONLY:  host
     1228
     1229       USE cpulog,                                                             &
     1230           ONLY:  cpu_log, log_point_s
     1231
     1232       USE kinds
     1233
    12011234       USE pegrid
    1202        USE transpose_indices
    12031235
    12041236       IMPLICIT NONE
    12051237
    1206        INTEGER            ::  i, j, k
    1207 
    1208        REAL, DIMENSION(0:nx,1:nz,nys:nyn)             ::  work_fftx
    1209        REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  f_in
    1210        REAL, DIMENSION(1:nz,nys:nyn,0:nx)             ::  f_out
    1211        REAL, DIMENSION(nys:nyn,1:nz,0:nx)             ::  work
     1238       INTEGER(iwp) ::  i  !:
     1239       INTEGER(iwp) ::  j  !:
     1240       INTEGER(iwp) ::  k  !:
     1241
     1242       REAL(wp), DIMENSION(0:nx,1:nz,nys:nyn)             ::  work_fftx  !:
     1243       REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  f_in       !:
     1244       REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx)             ::  f_out      !:
     1245       REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx)             ::  work       !:
    12121246
    12131247!
    … …  
    13011335!------------------------------------------------------------------------------!
    13021336
    1303        USE control_parameters
    1304        USE cpulog
    1305        USE grid_variables
    1306        USE indices
     1337       USE control_parameters,                                                 &
     1338           ONLY:  host
     1339
     1340       USE cpulog,                                                             &
     1341           ONLY:  cpu_log, log_point_s
     1342
     1343       USE grid_variables,                                                     &
     1344           ONLY:  ddx2, ddy2
     1345
     1346       USE kinds
     1347
    13071348       USE pegrid
    1308        USE transpose_indices
    13091349
    13101350       IMPLICIT NONE
    13111351
    1312        INTEGER ::  i, j, k, m, n, omp_get_thread_num, tn
    1313 
    1314        REAL, DIMENSION(0:ny)                          ::  work_ffty
    1315        REAL, DIMENSION(0:ny,1:nz)                     ::  work_triy
    1316        REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  ar
    1317        REAL, DIMENSION(:,:,:,:), ALLOCATABLE          ::  tri
     1352       INTEGER(iwp) ::  i                   !:
     1353       INTEGER(iwp) ::  j                   !:
     1354       INTEGER(iwp) ::  k                   !:
     1355       INTEGER(iwp) ::  m                   !:
     1356       INTEGER(iwp) ::  n                   !:
     1357       INTEGER(iwp) ::  omp_get_thread_num  !:
     1358       INTEGER(iwp) ::  tn                  !:
     1359
     1360       REAL(wp), DIMENSION(0:ny)                          ::  work_ffty  !:
     1361       REAL(wp), DIMENSION(0:ny,1:nz)                     ::  work_triy  !:
     1362       REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) ::  ar         !:
     1363       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE          ::  tri        !:
    13181364
    13191365

  • palm/trunk/SOURCE/poismg.f90

    r1319 r1320  
    2323! Current revisions:
    2424! -----------------
    25 !
     25! ONLY-attribute added to USE-statements,
     26! kind-parameters added to all INTEGER and REAL declaration statements,
     27! kinds are defined in new module kinds,
     28! old module precision_kind is removed,
     29! revision history before 2012 removed,
     30! comment fields (!:) to be used for variable explanations added to
     31! all variable declaration statements
    2632!
    2733! Former revisions:
    … …  
    108114!------------------------------------------------------------------------------!
    109115
    110     USE arrays_3d
    111     USE control_parameters
    112     USE cpulog   
    113     USE grid_variables
    114     USE indices
     116    USE arrays_3d,                                                             &
     117        ONLY:  d, p_loc
     118
     119    USE control_parameters,                                                    &
     120        ONLY:  gathered_size, grid_level, grid_level_count,                    &
     121               maximum_grid_level, message_string, mgcycles, mg_cycles,        &
     122               mg_switch_to_pe0_level, residual_limit, subdomain_size
     123
     124    USE cpulog,                                                                &
     125        ONLY:  cpu_log, log_point_s
     126
     127    USE indices,                                                               &
     128        ONLY:  nxl, nxlg, nxl_mg, nxr, nxrg, nxr_mg, nys, nysg, nys_mg, nyn,   &
     129               nyng, nyn_mg, nzb, nzt, nzt_mg
     130
     131    USE kinds
     132
    115133    USE pegrid
    116134
    117135    IMPLICIT NONE
    118136
    119     REAL    ::  maxerror, maximum_mgcycles, residual_norm
    120 
    121     REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r
    122 
    123     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  p3
     137    REAL(wp) ::  maxerror          !:
     138    REAL(wp) ::  maximum_mgcycles  !:
     139    REAL(wp) ::  residual_norm     !:
     140
     141    REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r  !:
     142
     143    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p3  !:
    124144
    125145
    … …  
    220240!------------------------------------------------------------------------------!
    221241
    222     USE arrays_3d
    223     USE control_parameters
    224     USE grid_variables
    225     USE indices
    226     USE pegrid
     242    USE arrays_3d,                                                             &
     243        ONLY:  f1_mg, f2_mg, f3_mg
     244
     245    USE control_parameters,                                                    &
     246        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
     247               inflow_n, inflow_r, inflow_s, outflow_l, outflow_n, outflow_r,  &
     248               outflow_s
     249
     250    USE grid_variables,                                                        &
     251        ONLY:  ddx2_mg, ddy2_mg
     252
     253    USE indices,                                                               &
     254        ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3, wall_flags_4,  &
     255               wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,         &
     256               wall_flags_9, wall_flags_10, nxl_mg, nxr_mg, nys_mg, nyn_mg,    &
     257               nzb, nzt_mg
     258
     259    USE kinds
    227260
    228261    IMPLICIT NONE
    229262
    230     INTEGER ::  i, j, k, l
    231 
    232     REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                                  &
     263    INTEGER(iwp) ::  i
     264    INTEGER(iwp) ::  j
     265    INTEGER(iwp) ::  k
     266    INTEGER(iwp) ::  l
     267
     268    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
    233269                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                 &
    234                     nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg, p_mg, r
     270                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !:
     271    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     272                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                 &
     273                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !:
     274    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     275                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                 &
     276                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  r     !:
    235277
    236278!
    … …  
    336378!------------------------------------------------------------------------------!
    337379
    338     USE control_parameters
    339     USE grid_variables
    340     USE indices
    341     USE pegrid
     380    USE control_parameters,                                                    &
     381        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
     382               inflow_n, inflow_r, inflow_s, outflow_l, outflow_n, outflow_r,  &
     383               outflow_s
     384
     385    USE indices,                                                               &
     386        ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3, wall_flags_4,  &
     387               wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,         &
     388               wall_flags_9, wall_flags_10, nxl_mg, nxr_mg, nys_mg, nyn_mg,    &
     389               nzb, nzt_mg
     390
     391    USE kinds
    342392
    343393    IMPLICIT NONE
    344394
    345     INTEGER ::  i, ic, j, jc, k, kc, l
    346 
    347     REAL ::  rkjim, rkjip, rkjmi, rkjmim, rkjmip, rkjpi, rkjpim, rkjpip,       &
    348              rkmji, rkmjim, rkmjip, rkmjmi, rkmjmim, rkmjmip, rkmjpi, rkmjpim, &
    349              rkmjpip
    350 
    351     REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                            &
    352                     nys_mg(grid_level)-1:nyn_mg(grid_level)+1,           &
    353                     nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg
    354 
    355     REAL, DIMENSION(nzb:nzt_mg(grid_level+1)+1,                          &
    356                     nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1,       &
    357                     nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::  r
     395    INTEGER(iwp) ::  i    !:
     396    INTEGER(iwp) ::  ic   !:
     397    INTEGER(iwp) ::  j    !:
     398    INTEGER(iwp) ::  jc   !:
     399    INTEGER(iwp) ::  k    !:
     400    INTEGER(iwp) ::  kc   !:
     401    INTEGER(iwp) ::  l    !:
     402
     403    REAL(wp) ::  rkjim    !:
     404    REAL(wp) ::  rkjip    !:
     405    REAL(wp) ::  rkjmi    !:
     406    REAL(wp) ::  rkjmim   !:
     407    REAL(wp) ::  rkjmip   !:
     408    REAL(wp) ::  rkjpi    !:
     409    REAL(wp) ::  rkjpim   !:
     410    REAL(wp) ::  rkjpip   !:
     411    REAL(wp) ::  rkmji    !:
     412    REAL(wp) ::  rkmjim   !:
     413    REAL(wp) ::  rkmjip   !:
     414    REAL(wp) ::  rkmjmi   !:
     415    REAL(wp) ::  rkmjmim  !:
     416    REAL(wp) ::  rkmjmip  !:
     417    REAL(wp) ::  rkmjpi   !:
     418    REAL(wp) ::  rkmjpim  !:
     419    REAL(wp) ::  rkmjpip  !:
     420
     421    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                            &
     422                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,           &
     423                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !:
     424
     425    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level+1)+1,                          &
     426                        nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1,       &
     427                        nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::  r !:
    358428
    359429!
    … …  
    516586!------------------------------------------------------------------------------!
    517587
    518     USE control_parameters
    519     USE pegrid
    520     USE indices
     588    USE control_parameters,                                                    &
     589        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
     590               inflow_n, inflow_r, inflow_s, outflow_l, outflow_n, outflow_r,  &
     591               outflow_s
     592
     593    USE indices,                                                               &
     594        ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
     595
     596    USE kinds
    521597
    522598    IMPLICIT NONE
    523599
    524     INTEGER ::  i, j, k, l
    525 
    526     REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1,                           &
    527                     nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,        &
    528                     nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  p
    529 
    530     REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    531                     nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
    532                     nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  temp
     600    INTEGER(iwp) ::  i  !:
     601    INTEGER(iwp) ::  j  !:
     602    INTEGER(iwp) ::  k  !:
     603    INTEGER(iwp) ::  l  !:
     604
     605    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,                           &
     606                        nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,        &
     607                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  p  !:
     608
     609    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
     610                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
     611                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  temp  !:
    533612
    534613
    … …  
    613692!------------------------------------------------------------------------------!
    614693
    615     USE arrays_3d
    616     USE control_parameters
    617     USE cpulog
    618     USE grid_variables
    619     USE indices
    620     USE pegrid
     694    USE arrays_3d,                                                             &
     695        ONLY:  f1_mg, f2_mg, f3_mg
     696
     697    USE control_parameters,                                                    &
     698        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
     699               inflow_n, inflow_r, inflow_s, ngsrb, outflow_l, outflow_n,      &
     700               outflow_r, outflow_s
     701
     702    USE cpulog,                                                                &
     703        ONLY:  cpu_log, log_point_s
     704
     705    USE grid_variables,                                                        &
     706        ONLY:  ddx2_mg, ddy2_mg
     707
     708    USE indices,                                                               &
     709        ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3, wall_flags_4,  &
     710               wall_flags_5, wall_flags_6, wall_flags_7, wall_flags_8,         &
     711               wall_flags_9, wall_flags_10, nxl_mg, nxr_mg, nys_mg, nyn_mg,    &
     712               nzb, nzt_mg
     713
     714    USE kinds
    621715
    622716    IMPLICIT NONE
    623717
    624     INTEGER :: colour, i, ic, j, jc, jj, k, l, n
    625 
    626     LOGICAL :: unroll
    627 
    628     REAL ::  wall_left, wall_north, wall_right, wall_south, wall_total, wall_top
    629 
    630     REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                                 &
    631                     nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                &
    632                     nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg, p_mg
     718    INTEGER(iwp) :: color    !:
     719    INTEGER(iwp) :: i        !:
     720    INTEGER(iwp) :: ic       !:
     721    INTEGER(iwp) :: j        !:
     722    INTEGER(iwp) :: jc       !:
     723    INTEGER(iwp) :: jj       !:
     724    INTEGER(iwp) :: k        !:
     725    INTEGER(iwp) :: l        !:
     726    INTEGER(iwp) :: n        !:
     727
     728    LOGICAL :: unroll        !:
     729
     730    REAL(wp) ::  wall_left   !:
     731    REAL(wp) ::  wall_north  !:
     732    REAL(wp) ::  wall_right  !:
     733    REAL(wp) ::  wall_south  !:
     734    REAL(wp) ::  wall_total  !:
     735    REAL(wp) ::  wall_top    !:
     736
     737    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     738                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,             &
     739                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !:
     740    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     741                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,             &
     742                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !:
    633743
    634744    l = grid_level
    … …  
    664774    DO  n = 1, ngsrb
    665775       
    666        DO  colour = 1, 2
     776       DO  color = 1, 2
    667777
    668778          IF ( .NOT. unroll )  THEN
    … …  
    673783!--          Without unrolling of loops, no cache optimization
    674784             DO  i = nxl_mg(l), nxr_mg(l), 2
    675                 DO  j = nys_mg(l) + 2 - colour, nyn_mg(l), 2
     785                DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
    676786                   DO  k = nzb+1, nzt_mg(l), 2
    677787!                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
    … …  
    703813   
    704814             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
    705                 DO  j = nys_mg(l) + (colour-1), nyn_mg(l), 2
     815                DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
    706816                   DO  k = nzb+1, nzt_mg(l), 2
    707817                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
    … …  
    726836 
    727837             DO  i = nxl_mg(l), nxr_mg(l), 2
    728                 DO  j = nys_mg(l) + (colour-1), nyn_mg(l), 2
     838                DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
    729839                   DO  k = nzb+2, nzt_mg(l), 2
    730840                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
    … …  
    749859
    750860             DO  i = nxl_mg(l)+1, nxr_mg(l), 2
    751                 DO  j = nys_mg(l) + 2 - colour, nyn_mg(l), 2
     861                DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
    752862                   DO  k = nzb+2, nzt_mg(l), 2
    753863                      p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                       &
    … …  
    780890                DO  jc = nys_mg(l), nyn_mg(l), 4
    781891                   i  = ic
    782                    jj = jc+2-colour
     892                   jj = jc+2-color
    783893                   DO  k = nzb+1, nzt_mg(l), 2
    784894                      j = jj
    … …  
    819929   
    820930                   i  = ic+1
    821                    jj = jc+colour-1
     931                   jj = jc+color-1
    822932                   DO  k = nzb+1, nzt_mg(l), 2
    823933                      j =jj
    … …  
    858968
    859969                   i  = ic
    860                    jj = jc+colour-1
     970                   jj = jc+color-1
    861971                   DO  k = nzb+2, nzt_mg(l), 2
    862972                      j =jj
    … …  
    8971007
    8981008                   i  = ic+1
    899                    jj = jc+2-colour
     1009                   jj = jc+2-color
    9001010                   DO  k = nzb+2, nzt_mg(l), 2
    9011011                      j =jj
    … …  
    10271137 SUBROUTINE mg_gather( f2, f2_sub )
    10281138
    1029     USE control_parameters
    1030     USE cpulog
    1031     USE indices
     1139    USE control_parameters,                                                    &
     1140        ONLY:  grid_level
     1141
     1142    USE cpulog,                                                                &
     1143        ONLY:  cpu_log, log_point_s
     1144
     1145    USE indices,                                                               &
     1146        ONLY:  mg_loc_ind, nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
     1147
     1148    USE kinds
     1149
    10321150    USE pegrid
    10331151
    10341152    IMPLICIT NONE
    10351153
    1036     INTEGER ::  i, il, ir, j, jn, js, k, nwords
    1037 
    1038     REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                            &
    1039                     nys_mg(grid_level)-1:nyn_mg(grid_level)+1,           &
    1040                     nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2, f2_l
    1041 
    1042     REAL, DIMENSION(nzb:mg_loc_ind(5,myid)+1,                            &
    1043                     mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,           &
    1044                     mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  f2_sub
     1154    INTEGER(iwp) ::  i       !:
     1155    INTEGER(iwp) ::  il      !:
     1156    INTEGER(iwp) ::  ir      !:
     1157    INTEGER(iwp) ::  j       !:
     1158    INTEGER(iwp) ::  jn      !:
     1159    INTEGER(iwp) ::  js      !:
     1160    INTEGER(iwp) ::  k       !:
     1161    INTEGER(iwp) ::  nwords  !:
     1162
     1163    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     1164                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                 &
     1165                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2    !:
     1166    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     1167                    nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                 &
     1168                    nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f2_l  !:
     1169
     1170    REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1,                              &
     1171                        mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,             &
     1172                        mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  f2_sub  !:
    10451173
    10461174
    … …  
    10911219!-- non-blocking communication
    10921220
    1093     USE control_parameters
    1094     USE cpulog
    1095     USE indices
     1221    USE control_parameters,                                                    &
     1222        ONLY:  grid_level
     1223
     1224    USE cpulog,                                                                &
     1225        ONLY:  cpu_log, log_point_s
     1226
     1227    USE indices,                                                               &
     1228        ONLY:  mg_loc_ind, nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
     1229
     1230    USE kinds
     1231
    10961232    USE pegrid
    10971233
    10981234    IMPLICIT NONE
    10991235
    1100     INTEGER ::  nwords
    1101 
    1102     REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1,                            &
    1103                     nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,         &
    1104                     nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2
    1105 
    1106     REAL, DIMENSION(nzb:mg_loc_ind(5,myid)+1,                              &
    1107                     mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,             &
    1108                     mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  p2_sub
     1236    INTEGER(iwp) ::  nwords  !:
     1237
     1238    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,                            &
     1239                        nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,         &
     1240                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2  !:
     1241
     1242    REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1,                              &
     1243                        mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1,             &
     1244                        mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  p2_sub  !:
    11091245
    11101246!
    … …  
    11381274!------------------------------------------------------------------------------!
    11391275
    1140     USE arrays_3d
    1141     USE control_parameters
    1142     USE grid_variables
    1143     USE indices
     1276    USE control_parameters,                                                    &
     1277        ONLY:  bc_lr_dirrad, bc_lr_raddir, bc_ns_dirrad, bc_ns_raddir,         &
     1278               gamma_mg, grid_level, grid_level_count, ibc_p_b, ibc_p_t,       &
     1279               inflow_l, inflow_n, inflow_r, inflow_s, maximum_grid_level,     &
     1280               mg_switch_to_pe0_level, mg_switch_to_pe0, ngsrb, outflow_l,     &
     1281               outflow_n, outflow_r, outflow_s
     1282
     1283
     1284    USE indices,                                                               &
     1285        ONLY:  mg_loc_ind, nxl, nxl_mg, nxr, nxr_mg, nys, nys_mg, nyn,         &
     1286               nyn_mg, nzb, nzt, nzt_mg
     1287
     1288    USE kinds
     1289
    11441290    USE pegrid
    11451291
    11461292    IMPLICIT NONE
    11471293
    1148     INTEGER ::  i, j, k, nxl_mg_save, nxr_mg_save, nyn_mg_save, nys_mg_save, &
    1149                 nzt_mg_save
    1150 
    1151     REAL, DIMENSION(nzb:nzt_mg(grid_level)+1,                                  &
    1152                  nys_mg(grid_level)-1:nyn_mg(grid_level)+1,                    &
    1153                  nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg, p_mg, p3, r
    1154 
    1155     REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1,                                &
    1156                     nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,             &
    1157                     nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  f2, p2
    1158 
    1159     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  f2_sub, p2_sub
     1294    INTEGER(iwp) ::  i            !:
     1295    INTEGER(iwp) ::  j            !:
     1296    INTEGER(iwp) ::  k            !:
     1297    INTEGER(iwp) ::  nxl_mg_save  !:
     1298    INTEGER(iwp) ::  nxr_mg_save  !:
     1299    INTEGER(iwp) ::  nyn_mg_save  !:
     1300    INTEGER(iwp) ::  nys_mg_save  !:
     1301    INTEGER(iwp) ::  nzt_mg_save  !:
     1302
     1303    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     1304                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,             &
     1305                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg  !:
     1306    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     1307                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,             &
     1308                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg  !:
     1309    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     1310                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,             &
     1311                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3    !:
     1312    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                              &
     1313                        nys_mg(grid_level)-1:nyn_mg(grid_level)+1,             &
     1314                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r     !:
     1315
     1316    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,                            &
     1317                        nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,         &
     1318                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  f2  !:
     1319    REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,                            &
     1320                        nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,         &
     1321                        nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) ::  p2  !:
     1322
     1323    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  f2_sub  !:
     1324    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p2_sub  !:
    11601325
    11611326!

  • palm/trunk/SOURCE/prandtl_fluxes.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:
    … …  
    4046! 978 2012-08-09 08:28:32Z fricke
    4147! roughness length for scalar quantities z0h added
    42 !
    43 ! 759 2011-09-15 13:58:31Z raasch
    44 ! Bugfix for ts limitation
    45 !
    46 ! 709 2011-03-30 09:31:40Z raasch
    47 ! formatting adjustments
    48 !
    49 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    50 ! Changed surface boundary conditions for u and v from mirror to Dirichlet.
    51 ! Therefore u(uzb,:,:) and v(nzb,:,:) are now representative for height z0.
    52 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    53 !
    54 ! 315 2009-05-13 10:57:59Z raasch
    55 ! Saturation condition at (sea) surface is not used in precursor runs (only
    56 ! in the following coupled runs)
    57 ! Bugfix: qsws was calculated in case of constant heatflux = .FALSE.
    58 !
    59 ! 187 2008-08-06 16:25:09Z letzel
    60 ! Bugfix: modification of the calculation of the vertical turbulent momentum
    61 ! fluxes u'w' and v'w'
    62 ! Bugfix: change definition of us_wall from 1D to 2D
    63 ! Change: modification of the integrated version of the profile function for
    64 ! momentum for unstable stratification (does not effect results)
    65 !
    66 ! 108 2007-08-24 15:10:38Z letzel
    67 ! assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean
    68 !
    69 ! 75 2007-03-22 09:54:05Z raasch
    70 ! moisture renamed humidity
    71 !
    72 ! RCS Log replace by Id keyword, revision history cleaned up
    73 !
    74 ! Revision 1.19  2006/04/26 12:24:35  raasch
    75 ! +OpenMP directives and optimization (array assignments replaced by DO loops)
    7648!
    7749! Revision 1.1  1998/01/23 10:06:06  raasch
    … …  
    8557!------------------------------------------------------------------------------!
    8658
    87     USE arrays_3d
    88     USE control_parameters
    89     USE grid_variables
    90     USE indices
     59    USE arrays_3d,                                                             &
     60        ONLY:  e, pt, q, qs, qsws, rif, shf, ts, u, us, usws, v, vpt, vsws,    &
     61               zu, zw, z0, z0h
     62
     63    USE control_parameters,                                                    &
     64        ONLY:  constant_heatflux, constant_waterflux, coupling_mode, g,        &
     65               humidity, ibc_e_b, kappa, large_scale_forcing, lsf_surf,        &
     66               passive_scalar, pt_surface, q_surface, rif_max, rif_min,        &
     67               run_coupled, surface_pressure
     68
     69    USE indices,                                                               &
     70        ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb_s_inner,        &
     71               nzb_u_inner, nzb_v_inner
     72
     73    USE kinds
    9174
    9275    IMPLICIT NONE
    9376
    94     INTEGER ::  i, j, k
    95     LOGICAL ::  coupled_run
    96     REAL    ::  a, b, e_q, rifm, uv_total, z_p
     77    INTEGER(iwp) ::  i            !:
     78    INTEGER(iwp) ::  j            !:
     79    INTEGER(iwp) ::  k            !:
     80
     81    LOGICAL      ::  coupled_run  !:
     82
     83    REAL(wp)     ::  a            !:
     84    REAL(wp)     ::  b            !:
     85    REAL(wp)     ::  e_q          !:
     86    REAL(wp)     ::  rifm         !:
     87    REAL(wp)     ::  uv_total     !:
     88    REAL(wp)     ::  z_p          !:
    9789
    9890!

  • palm/trunk/SOURCE/pres.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! 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:
    … …  
    6167! 1003 2012-09-14 14:35:53Z raasch
    6268! adjustment of array tend for cases with unequal subdomain sizes removed
    63 !
    64 ! 778 2011-11-07 14:18:25Z fricke
    65 ! New allocation of tend when multigrid is used and the collected field on PE0
    66 ! has more grid points than the subdomain of an PE.
    67 !
    68 ! 719 2011-04-06 13:05:23Z gryschka
    69 ! Bugfix in volume flow control for double cyclic boundary conditions
    70 !
    71 ! 709 2011-03-30 09:31:40Z raasch
    72 ! formatting adjustments
    73 !
    74 ! 707 2011-03-29 11:39:40Z raasch
    75 ! Calculation of weighted average of p is now handled in the same way
    76 ! regardless of the number of ghost layers (advection scheme),
    77 ! multigrid and sor method are using p_loc for iterative advancements of
    78 ! pressure,
    79 ! localsum calculation modified for proper OpenMP reduction,
    80 ! bc_lr/ns replaced by bc_lr/ns_cyc
    81 !
    82 ! 693 2011-03-08 09:..:..Z raasch
    83 ! bugfix: weighting coefficient added to ibm branch
    84 !
    85 ! 680 2011-02-04 23:16:06Z gryschka
    86 ! bugfix: collective_wait
    87 !
    88 ! 675 2011-01-19 10:56:55Z suehring
    89 ! Removed bugfix while copying tend.
    90 !
    91 ! 673 2011-01-18 16:19:48Z suehring
    92 ! Weighting coefficients added for right computation of the pressure during
    93 ! Runge-Kutta substeps.
    94 !
    95 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    96 ! New allocation of tend when ws-scheme and multigrid is used. This is due to
    97 ! reasons of perforance of the data_exchange. The same is done with p after
    98 ! poismg is called.
    99 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng when no
    100 ! multigrid is used. Calls of exchange_horiz are modified.
    101 ! bugfix: After pressure correction no volume flow correction in case of
    102 ! non-cyclic boundary conditions
    103 ! (has to be done only before pressure correction)
    104 ! Call of SOR routine is referenced with ddzu_pres.
    105 !
    106 ! 622 2010-12-10 08:08:13Z raasch
    107 ! optional barriers included in order to speed up collective operations
    108 !
    109 ! 151 2008-03-07 13:42:18Z raasch
    110 ! Bugfix in volume flow control for non-cyclic boundary conditions
    111 !
    112 ! 106 2007-08-16 14:30:26Z raasch
    113 ! Volume flow conservation added for the remaining three outflow boundaries
    114 !
    115 ! 85 2007-05-11 09:35:14Z raasch
    116 ! Division through dt_3d replaced by multiplication of the inverse.
    117 ! For performance optimisation, this is done in the loop calculating the
    118 ! divergence instead of using a seperate loop.
    119 !
    120 ! 75 2007-03-22 09:54:05Z raasch
    121 ! Volume flow control for non-cyclic boundary conditions added (currently only
    122 ! for the north boundary!!), 2nd+3rd argument removed from exchange horiz,
    123 ! mean vertical velocity is removed in case of Neumann boundary conditions
    124 ! both at the bottom and the top
    125 !
    126 ! RCS Log replace by Id keyword, revision history cleaned up
    127 !
    128 ! Revision 1.25  2006/04/26 13:26:12  raasch
    129 ! OpenMP optimization (+localsum, threadsum)
    13069!
    13170! Revision 1.1  1997/07/24 11:24:44  raasch
    … …  
    14079!------------------------------------------------------------------------------!
    14180
    142     USE arrays_3d
    143     USE constants
    144     USE control_parameters
    145     USE cpulog
    146     USE grid_variables
    147     USE indices
     81    USE arrays_3d,                                                             &
     82        ONLY:  d, ddzu, ddzu_pres, ddzw, dzw, p, p_loc, tend, u, v, w
     83
     84    USE control_parameters,                                                    &
     85        ONLY:  bc_lr_cyc, bc_ns_cyc, conserve_volume_flow, dt_3d,              &
     86               gathered_size, ibc_p_b, ibc_p_t, intermediate_timestep_count,   &
     87               mg_switch_to_pe0_level, on_device, outflow_l, outflow_n,        &
     88               outflow_r, outflow_s, psolver, simulated_time, subdomain_size,  &
     89               topography, volume_flow, volume_flow_area, volume_flow_initial
     90
     91    USE cpulog,                                                                &
     92        ONLY:  cpu_log, log_point, log_point_s
     93
     94    USE grid_variables,                                                        &
     95        ONLY:  ddx, ddy
     96
     97    USE indices,                                                               &
     98        ONLY:  nbgp, ngp_2dh_outer, nx, nxl, nxlg, nxl_mg, nxr, nxrg, nxr_mg,  &
     99               ny, nys, nysg, nys_mg, nyn, nyng, nyn_mg, nzb, nzb_s_inner,     &
     100               nzb_u_inner, nzb_v_inner, nzb_w_inner, nzb_2d, nzt, nzt_mg,     &
     101               rflags_s_inner
     102
     103    USE kinds
     104
    148105    USE pegrid
    149     USE poisfft_mod
    150     USE statistics
     106
     107    USE poisfft_mod,                                                           &
     108        ONLY:  poisfft
     109
     110    USE statistics,                                                            &
     111        ONLY:  statistic_regions, sums_divnew_l, sums_divold_l, weight_pres,   &
     112               weight_substep
    151113
    152114    IMPLICIT NONE
    153115
    154     INTEGER ::  i, j, k
    155 
    156     REAL    ::  ddt_3d, localsum, threadsum, d_weight_pres
    157 
    158     REAL, DIMENSION(1:2) ::  volume_flow_l, volume_flow_offset
    159     REAL, DIMENSION(1:nzt) ::  w_l, w_l_l
     116    INTEGER(iwp) ::  i              !:
     117    INTEGER(iwp) ::  j              !:
     118    INTEGER(iwp) ::  k              !:
     119
     120    REAL(wp)     ::  ddt_3d         !:
     121    REAL(wp)     ::  localsum       !:
     122    REAL(wp)     ::  threadsum      !:
     123    REAL(wp)     ::  d_weight_pres  !:
     124
     125    REAL(wp), DIMENSION(1:2)   ::  volume_flow_l       !:
     126    REAL(wp), DIMENSION(1:2)   ::  volume_flow_offset  !:
     127    REAL(wp), DIMENSION(1:nzt) ::  w_l                 !:
     128    REAL(wp), DIMENSION(1:nzt) ::  w_l_l               !:
    160129
    161130

  • palm/trunk/SOURCE/print_1d.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! 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:
    … …  
    3541! RCS Log replace by Id keyword, revision history cleaned up
    3642!
    37 ! Revision 1.11  2006/02/23 12:50:43  raasch
    38 ! Preliminary no output of time-averaged data
    39 !
    4043! Revision 1.1  1997/09/19 07:45:22  raasch
    4144! Initial revision
    … …  
    4750!------------------------------------------------------------------------------!
    4851
    49     USE arrays_3d
    50     USE control_parameters
    51     USE cpulog
    52     USE indices
     52    USE arrays_3d,                                                             &
     53        ONLY:  zu, zw
     54
     55    USE control_parameters,                                                    &
     56        ONLY:  run_description_header, simulated_time_chr
     57
     58    USE cpulog,                                                                &
     59        ONLY:  cpu_log, log_point
     60
     61    USE indices,                                                               &
     62        ONLY:  nzb, nzt
     63
     64    USE kinds
     65
    5366    USE pegrid
    54     USE statistics
     67
     68    USE statistics,                                                            &
     69        ONLY:  flow_statistics_called, hom, region, statistic_regions
    5570
    5671    IMPLICIT NONE
    5772
    5873
    59     CHARACTER (LEN=20) ::  period_chr
    60     INTEGER ::  k, sr
     74    CHARACTER (LEN=20) ::  period_chr  !:
     75
     76    INTEGER(iwp) ::  k   !:
     77    INTEGER(iwp) ::  sr  !:
    6178
    6279

  • palm/trunk/SOURCE/production_e.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:
    … …  
    5056! TKE production by buoyancy can be switched off in case of runs with pure
    5157! neutral stratification
    52 !
    53 ! 759 2011-09-15 13:58:31Z raasch
    54 ! initialization of u_0, v_0
    55 !
    56 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    57 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    58 !
    59 ! 449 2010-02-02 11:23:59Z raasch
    60 ! test output from rev 410 removed
    61 !
    62 ! 388 2009-09-23 09:40:33Z raasch
    63 ! Bugfix: wrong sign in buoyancy production of ocean part in case of not using
    64 !         the reference density (only in 3D routine production_e)
    65 ! Bugfix to avoid zero division by km_neutral
    66 !
    67 ! 208 2008-10-20 06:02:59Z raasch
    68 ! Bugfix concerning the calculation of velocity gradients at vertical walls
    69 ! in case of diabatic conditions
    70 !
    71 ! 187 2008-08-06 16:25:09Z letzel
    72 ! Change: add 'minus' sign to fluxes obtained from subroutine wall_fluxes_e for
    73 ! consistency with subroutine wall_fluxes
    74 !
    75 ! 124 2007-10-19 15:47:46Z raasch
    76 ! Bugfix: calculation of density flux in the ocean now starts from nzb+1
    77 !
    78 ! 108 2007-08-24 15:10:38Z letzel
    79 ! Bugfix: wrong sign removed from the buoyancy production term in the case
    80 ! use_reference = .T.,
    81 ! u_0 and v_0 are calculated for nxr+1, nyn+1 also (otherwise these values are
    82 ! not available in case of non-cyclic boundary conditions)
    83 ! Bugfix for ocean density flux at bottom
    84 !
    85 ! 97 2007-06-21 08:23:15Z raasch
    86 ! Energy production by density flux (in ocean) added
    87 ! use_pt_reference renamed use_reference
    88 !
    89 ! 75 2007-03-22 09:54:05Z raasch
    90 ! Wall functions now include diabatic conditions, call of routine wall_fluxes_e,
    91 ! reference temperature pt_reference can be used in buoyancy term,
    92 ! moisture renamed humidity
    93 !
    94 ! 37 2007-03-01 08:33:54Z raasch
    95 ! Calculation extended for gridpoint nzt, extended for given temperature /
    96 ! humidity fluxes at the top, wall-part is now executed in case that a
    97 ! Prandtl-layer is switched on (instead of surfaces fluxes switched on)
    98 !
    99 ! RCS Log replace by Id keyword, revision history cleaned up
    100 !
    101 ! Revision 1.21  2006/04/26 12:45:35  raasch
    102 ! OpenMP parallelization of production_e_init
    10358!
    10459! Revision 1.1  1997/09/19 07:45:35  raasch
    … …  
    11368!------------------------------------------------------------------------------!
    11469
    115     USE wall_fluxes_mod
     70    USE wall_fluxes_mod,                                                       &
     71        ONLY:  wall_fluxes_e, wall_fluxes_e_acc
     72
     73    USE kinds
    11674
    11775    PRIVATE
    11876    PUBLIC production_e, production_e_acc, production_e_init
    11977
    120     LOGICAL, SAVE ::  first_call = .TRUE.
    121 
    122     REAL, DIMENSION(:,:), ALLOCATABLE, SAVE ::  u_0, v_0
     78    LOGICAL, SAVE ::  first_call = .TRUE.  !:
     79
     80    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  u_0  !:
     81    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  v_0  !:
    12382
    12483    INTERFACE production_e
    … …  
    143102    SUBROUTINE production_e
    144103
    145        USE arrays_3d
    146        USE cloud_parameters
    147        USE control_parameters
    148        USE grid_variables
    149        USE indices
    150        USE statistics
     104       USE arrays_3d,                                                          &
     105           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
     106                  tend, tswst, u, v, vpt, w
     107
     108       USE cloud_parameters,                                                   &
     109           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
     110
     111       USE control_parameters,                                                 &
     112           ONLY:  cloud_droplets, cloud_physics, g, humidity, kappa, neutral,  &
     113                  ocean, prandtl_layer, pt_reference, rho_reference,           &
     114                  use_single_reference_value, use_surface_fluxes,              &
     115                  use_top_fluxes
     116
     117       USE grid_variables,                                                     &
     118           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
     119
     120       USE indices,                                                            &
     121           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
     122                   nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
    151123
    152124       IMPLICIT NONE
    153125
    154        INTEGER ::  i, j, k
    155 
    156        REAL    ::  def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
    157                    k1, k2, km_neutral, theta, temp
    158 
    159 !       REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs, vsus, wsus, wsvs
    160        REAL, DIMENSION(nzb:nzt+1) ::   usvs, vsus, wsus, wsvs
     126       INTEGER(iwp) ::  i           !:
     127       INTEGER(iwp) ::  j           !:
     128       INTEGER(iwp) ::  k           !:
     129
     130       REAL(wp)     ::  def         !:
     131       REAL(wp)     ::  dudx        !:
     132       REAL(wp)     ::  dudy        !:
     133       REAL(wp)     ::  dudz        !:
     134       REAL(wp)     ::  dvdx        !:
     135       REAL(wp)     ::  dvdy        !:
     136       REAL(wp)     ::  dvdz        !:
     137       REAL(wp)     ::  dwdx        !:
     138       REAL(wp)     ::  dwdy        !:
     139       REAL(wp)     ::  dwdz        !:
     140       REAL(wp)     ::  k1          !:
     141       REAL(wp)     ::  k2          !:
     142       REAL(wp)     ::  km_neutral  !:
     143       REAL(wp)     ::  theta       !:
     144       REAL(wp)     ::  temp        !:
     145
     146!       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs, vsus, wsus, wsvs
     147       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !:
     148       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !:
     149       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !:
     150       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !:
    161151
    162152!
    … …  
    166156!--    Therefore, ij-Version is called further below within the ij-loops.
    167157!       IF ( topography /= 'flat' )  THEN
    168 !          CALL wall_fluxes_e( usvs, 1.0, 0.0, 0.0, 0.0, wall_e_y )
    169 !          CALL wall_fluxes_e( wsvs, 0.0, 0.0, 1.0, 0.0, wall_e_y )
    170 !          CALL wall_fluxes_e( vsus, 0.0, 1.0, 0.0, 0.0, wall_e_x )
    171 !          CALL wall_fluxes_e( wsus, 0.0, 0.0, 0.0, 1.0, wall_e_x )
     158!          CALL wall_fluxes_e( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
     159!          CALL wall_fluxes_e( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
     160!          CALL wall_fluxes_e( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
     161!          CALL wall_fluxes_e( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
    172162!       ENDIF
    173163
    … …  
    240230!--                         has been available
    241231                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    242                                           usvs, 1.0, 0.0, 0.0, 0.0 )
     232                                          usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
    243233                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    244                                           wsvs, 0.0, 0.0, 1.0, 0.0 )
     234                                          wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
    245235                      km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * &
    246236                                   0.5 * dy
    … …  
    270260!--                         has been available
    271261                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    272                                           vsus, 0.0, 1.0, 0.0, 0.0 )
     262                                          vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
    273263                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    274                                           wsus, 0.0, 0.0, 0.0, 1.0 )
     264                                          wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
    275265                      km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * &
    276266                                   0.5 * dx
    … …  
    716706    SUBROUTINE production_e_acc
    717707
    718        USE arrays_3d
    719        USE cloud_parameters
    720        USE control_parameters
    721        USE grid_variables
    722        USE indices
    723        USE statistics
     708       USE arrays_3d,                                                          &
     709           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
     710                  tend, tswst, u, v, vpt, w
     711
     712       USE cloud_parameters,                                                   &
     713           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
     714
     715       USE control_parameters,                                                 &
     716           ONLY:  cloud_droplets, cloud_physics, g, humidity, kappa, neutral,  &
     717                  ocean, prandtl_layer, pt_reference, rho_reference,           &
     718                  topography, use_single_reference_value, use_surface_fluxes,  &
     719                  use_top_fluxes
     720
     721       USE grid_variables,                                                     &
     722           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
     723
     724       USE indices,                                                            &
     725           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nys, nyn, nzb,  &
     726                  nzb_diff_s_inner, nzb_diff_s_outer, nzb_s_inner, nzt,        &
     727                  nzt_diff
    724728
    725729       IMPLICIT NONE
    726730
    727        INTEGER ::  i, j, k
    728 
    729        REAL    ::  def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
    730                    k1, k2, km_neutral, theta, temp
    731 
    732        REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs, vsus, wsus, wsvs
     731       INTEGER(iwp) ::  i           !:
     732       INTEGER(iwp) ::  j           !:
     733       INTEGER(iwp) ::  k           !:
     734
     735       REAL(wp)     ::  def         !:
     736       REAL(wp)     ::  dudx        !:
     737       REAL(wp)     ::  dudy        !:
     738       REAL(wp)     ::  dudz        !:
     739       REAL(wp)     ::  dvdx        !:
     740       REAL(wp)     ::  dvdy        !:
     741       REAL(wp)     ::  dvdz        !:
     742       REAL(wp)     ::  dwdx        !:
     743       REAL(wp)     ::  dwdy        !:
     744       REAL(wp)     ::  dwdz        !:
     745       REAL(wp)     ::  k1          !:
     746       REAL(wp)     ::  k2          !:
     747       REAL(wp)     ::  km_neutral  !:
     748       REAL(wp)     ::  theta       !:
     749       REAL(wp)     ::  temp        !:
     750
     751       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !:
     752       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !:
     753       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !:
     754       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !:
    733755       !$acc declare create ( usvs, vsus, wsus, wsvs )
    734756
    … …  
    739761!--    ij-version should be called further below within the ij-loops!!
    740762       IF ( topography /= 'flat' )  THEN
    741           CALL wall_fluxes_e_acc( usvs, 1.0, 0.0, 0.0, 0.0, wall_e_y )
    742           CALL wall_fluxes_e_acc( wsvs, 0.0, 0.0, 1.0, 0.0, wall_e_y )
    743           CALL wall_fluxes_e_acc( vsus, 0.0, 1.0, 0.0, 0.0, wall_e_x )
    744           CALL wall_fluxes_e_acc( wsus, 0.0, 0.0, 0.0, 1.0, wall_e_x )
     763          CALL wall_fluxes_e_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
     764          CALL wall_fluxes_e_acc( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
     765          CALL wall_fluxes_e_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
     766          CALL wall_fluxes_e_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
    745767       ENDIF
    746768
    … …  
    823845!--                               has been available
    824846!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    825 !                                                usvs, 1.0, 0.0, 0.0, 0.0 )
     847!                                                usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
    826848!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    827 !                                                wsvs, 0.0, 0.0, 1.0, 0.0 )
     849!                                                wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
    828850                            km_neutral = kappa *                                    &
    829851                                        ( usvs(k,j,i)**2 + wsvs(k,j,i)**2 )**0.25 * &
    … …  
    854876!--                               has been available
    855877!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    856 !                                                vsus, 0.0, 1.0, 0.0, 0.0 )
     878!                                                vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
    857879!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    858 !                                                wsus, 0.0, 0.0, 0.0, 1.0 )
     880!                                                wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
    859881                            km_neutral = kappa *                                     &
    860882                                         ( vsus(k,j,i)**2 + wsus(k,j,i)**2 )**0.25 * &
    … …  
    13501372    SUBROUTINE production_e_ij( i, j )
    13511373
    1352        USE arrays_3d
    1353        USE cloud_parameters
    1354        USE control_parameters
    1355        USE grid_variables
    1356        USE indices
    1357        USE statistics
     1374       USE arrays_3d,                                                          &
     1375           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
     1376                  tend, tswst, u, v, vpt, w
     1377
     1378       USE cloud_parameters,                                                   &
     1379           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
     1380
     1381       USE control_parameters,                                                 &
     1382           ONLY:  cloud_droplets, cloud_physics, g, humidity, kappa, neutral,  &
     1383                  ocean, prandtl_layer, pt_reference, rho_reference,           &
     1384                  use_single_reference_value, use_surface_fluxes,              &
     1385                  use_top_fluxes
     1386
     1387       USE grid_variables,                                                     &
     1388           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
     1389
     1390       USE indices,                                                            &
     1391           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
     1392                  nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
    13581393
    13591394       IMPLICIT NONE
    13601395
    1361        INTEGER ::  i, j, k
    1362 
    1363        REAL    ::  def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
    1364                    k1, k2, km_neutral, theta, temp
    1365 
    1366        REAL, DIMENSION(nzb:nzt+1) ::  usvs, vsus, wsus, wsvs
     1396       INTEGER(iwp) ::  i           !:
     1397       INTEGER(iwp) ::  j           !:
     1398       INTEGER(iwp) ::  k           !:
     1399
     1400       REAL(wp)     ::  def         !:
     1401       REAL(wp)     ::  dudx        !:
     1402       REAL(wp)     ::  dudy        !:
     1403       REAL(wp)     ::  dudz        !:
     1404       REAL(wp)     ::  dvdx        !:
     1405       REAL(wp)     ::  dvdy        !:
     1406       REAL(wp)     ::  dvdz        !:
     1407       REAL(wp)     ::  dwdx        !:
     1408       REAL(wp)     ::  dwdy        !:
     1409       REAL(wp)     ::  dwdz        !:
     1410       REAL(wp)     ::  k1          !:
     1411       REAL(wp)     ::  k2          !:
     1412       REAL(wp)     ::  km_neutral  !:
     1413       REAL(wp)     ::  theta       !:
     1414       REAL(wp)     ::  temp        !:
     1415
     1416       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !:
     1417       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !:
     1418       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !:
     1419       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !:
    13671420
    13681421!
    … …  
    14271480!--                   validation has been available
    14281481                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    1429                                     usvs, 1.0, 0.0, 0.0, 0.0 )
     1482                                    usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
    14301483                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    1431                                     wsvs, 0.0, 0.0, 1.0, 0.0 )
     1484                                    wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
    14321485                km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * &
    14331486                             0.5 * dy
    … …  
    14571510!--                   validation has been available
    14581511                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    1459                                     vsus, 0.0, 1.0, 0.0, 0.0 )
     1512                                    vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
    14601513                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
    1461                                     wsus, 0.0, 0.0, 0.0, 1.0 )
     1514                                    wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
    14621515                km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * &
    14631516                             0.5 * dx
    … …  
    18401893    SUBROUTINE production_e_init
    18411894
    1842        USE arrays_3d
    1843        USE control_parameters
    1844        USE grid_variables
    1845        USE indices
     1895       USE arrays_3d,                                                          &
     1896           ONLY:  kh, km, u, us, usws, v, vsws, zu
     1897
     1898       USE control_parameters,                                                 &
     1899           ONLY:  kappa, prandtl_layer
     1900
     1901       USE indices,                                                            &
     1902           ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb_u_inner,     &
     1903                  nzb_v_inner
    18461904
    18471905       IMPLICIT NONE
    18481906
    1849        INTEGER ::  i, j, ku, kv
     1907       INTEGER(iwp) ::  i   !:
     1908       INTEGER(iwp) ::  j   !:
     1909       INTEGER(iwp) ::  ku  !:
     1910       INTEGER(iwp) ::  kv  !:
    18501911
    18511912       IF ( prandtl_layer )  THEN

  • palm/trunk/SOURCE/prognostic_equations.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! 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:
    … …  
    8793! temperature equation can be switched off
    8894!
    89 ! 785 2011-11-28 09:47:19Z raasch
    90 ! new factor rdf_sc allows separate Rayleigh damping of scalars
    91 !
    92 ! 736 2011-08-17 14:13:26Z suehring
    93 ! Bugfix: determination of first thread index i for WS-scheme
    94 !
    95 ! 709 2011-03-30 09:31:40Z raasch
    96 ! formatting adjustments
    97 !
    98 ! 673 2011-01-18 16:19:48Z suehring
    99 ! Consideration of the pressure gradient (steered by tsc(4)) during the time
    100 ! integration removed.
    101 !
    102 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    103 ! Calls of the advection routines with WS5 added.
    104 ! Calls of ws_statistics added to set the statistical arrays to zero after each
    105 ! time step.
    106 !
    107 ! 531 2010-04-21 06:47:21Z heinze
    108 ! add call of subsidence in the equation for humidity / passive scalar
    109 !
    110 ! 411 2009-12-11 14:15:58Z heinze
    111 ! add call of subsidence in the equation for potential temperature
    112 !
    113 ! 388 2009-09-23 09:40:33Z raasch
    114 ! prho is used instead of rho in diffusion_e,
    115 ! external pressure gradient
    116 !
    117 ! 153 2008-03-19 09:41:30Z steinfeld
    118 ! add call of plant_canopy_model in the prognostic equation for
    119 ! the potential temperature and for the passive scalar
    120 !
    121 ! 138 2007-11-28 10:03:58Z letzel
    122 ! add call of subroutines that evaluate the canopy drag terms,
    123 ! add wall_*flux to parameter list of calls of diffusion_s
    124 !
    125 ! 106 2007-08-16 14:30:26Z raasch
    126 ! +uswst, vswst as arguments in calls of diffusion_u|v,
    127 ! loops for u and v are starting from index nxlu, nysv, respectively (needed
    128 ! for non-cyclic boundary conditions)
    129 !
    130 ! 97 2007-06-21 08:23:15Z raasch
    131 ! prognostic equation for salinity, density is calculated from equation of
    132 ! state for seawater and is used for calculation of buoyancy,
    133 ! +eqn_state_seawater_mod
    134 ! diffusion_e is called with argument rho in case of ocean runs,
    135 ! new argument zw in calls of diffusion_e, new argument pt_/prho_reference
    136 ! in calls of buoyancy and diffusion_e, calc_mean_pt_profile renamed
    137 ! calc_mean_profile
    138 !
    139 ! 75 2007-03-22 09:54:05Z raasch
    140 ! checking for negative q and limiting for positive values,
    141 ! z0 removed from arguments in calls of diffusion_u/v/w, uxrp, vynp eliminated,
    142 ! subroutine names changed to .._noopt, .._cache, and .._vector,
    143 ! moisture renamed humidity, Bott-Chlond-scheme can be used in the
    144 ! _vector-version
    145 !
    146 ! 19 2007-02-23 04:53:48Z raasch
    147 ! Calculation of e, q, and pt extended for gridpoint nzt,
    148 ! handling of given temperature/humidity/scalar fluxes at top surface
    149 !
    150 ! RCS Log replace by Id keyword, revision history cleaned up
    151 !
    152 ! Revision 1.21  2006/08/04 15:01:07  raasch
    153 ! upstream scheme can be forced to be used for tke (use_upstream_for_tke)
    154 ! regardless of the timestep scheme used for the other quantities,
    155 ! new argument diss in call of diffusion_e
    156 !
    15795! Revision 1.1  2000/04/13 14:56:27  schroeter
    15896! Initial revision
    … …  
    164102!------------------------------------------------------------------------------!
    165103
    166     USE arrays_3d
    167     USE control_parameters
    168     USE cpulog
    169     USE eqn_state_seawater_mod
    170     USE grid_variables
    171     USE indices
    172     USE pegrid
    173     USE pointer_interfaces
    174     USE statistics
    175     USE advec_ws
    176     USE advec_s_pw_mod
    177     USE advec_s_up_mod
    178     USE advec_u_pw_mod
    179     USE advec_u_up_mod
    180     USE advec_v_pw_mod
    181     USE advec_v_up_mod
    182     USE advec_w_pw_mod
    183     USE advec_w_up_mod
    184     USE buoyancy_mod
    185     USE calc_precipitation_mod
    186     USE calc_radiation_mod
    187     USE coriolis_mod
    188     USE diffusion_e_mod
    189     USE diffusion_s_mod
    190     USE diffusion_u_mod
    191     USE diffusion_v_mod
    192     USE diffusion_w_mod
    193     USE impact_of_latent_heat_mod
    194     USE microphysics_mod
    195     USE nudge_mod
    196     USE plant_canopy_model_mod
    197     USE production_e_mod
    198     USE subsidence_mod
    199     USE user_actions_mod
     104    USE arrays_3d,                                                             &
     105        ONLY:  diss_l_e, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr,            &
     106               diss_l_sa, diss_s_e, diss_s_nr, diss_s_pt, diss_s_q,            &
     107               diss_s_qr, diss_s_sa, e, e_p, flux_s_e, flux_s_nr, flux_s_pt,   &
     108               flux_s_q, flux_s_qr, flux_s_sa, flux_l_e, flux_l_nr,            &
     109               flux_l_pt, flux_l_q, flux_l_qr, flux_l_sa, nr, nr_p, nrsws,     &
     110               nrswst, pt, ptdf_x, ptdf_y, pt_init, pt_p, prho, q, q_init,     &
     111               q_p, qsws, qswst, qr, qr_p, qrsws, qrswst, rdf, rdf_sc, rho,    &
     112               sa, sa_init, sa_p, saswsb, saswst, shf, tend, tend_nr,          &
     113               tend_pt, tend_q, tend_qr, te_m, tnr_m, tpt_m, tq_m, tqr_m,      &
     114               tsa_m, tswst, tu_m, tv_m, tw_m, u, ug, u_p, v, vg, vpt, v_p,    &
     115               w, w_p
     116       
     117    USE control_parameters,                                                    &
     118        ONLY:  cloud_physics, constant_diffusion, cthf, dp_external,           &
     119               dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d, humidity,       &
     120               icloud_scheme, inflow_l, intermediate_timestep_count,           &
     121               intermediate_timestep_count_max, large_scale_subsidence,        &
     122               neutral, nudging, ocean, outflow_l, outflow_s, passive_scalar,  &
     123               plant_canopy, precipitation, prho_reference, prho_reference,    &
     124               prho_reference, pt_reference, pt_reference, pt_reference,       &
     125               radiation, scalar_advec, scalar_advec, simulated_time,          &
     126               sloping_surface, timestep_scheme, tsc, use_upstream_for_tke,    &
     127               use_upstream_for_tke, use_upstream_for_tke, wall_heatflux,      &
     128               wall_nrflux, wall_qflux, wall_qflux, wall_qflux, wall_qrflux,   &
     129               wall_salinityflux, ws_scheme_mom, ws_scheme_sca
     130
     131    USE cpulog,                                                                &
     132        ONLY:  cpu_log, log_point
     133
     134    USE eqn_state_seawater_mod,                                                &
     135        ONLY:  eqn_state_seawater
     136
     137    USE indices,                                                               &
     138        ONLY:  i_left, i_right, j_north, j_south, nxl, nxlu, nxr, nyn, nys,    &
     139               nysv, nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
     140
     141    USE advec_ws,                                                              &
     142        ONLY:  advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc,         &
     143               advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc
     144
     145    USE advec_s_pw_mod,                                                        &
     146        ONLY:  advec_s_pw
     147
     148    USE advec_s_up_mod,                                                        &
     149        ONLY:  advec_s_up
     150
     151    USE advec_u_pw_mod,                                                        &
     152        ONLY:  advec_u_pw
     153
     154    USE advec_u_up_mod,                                                        &
     155        ONLY:  advec_u_up
     156
     157    USE advec_v_pw_mod,                                                        &
     158        ONLY:  advec_v_pw
     159
     160    USE advec_v_up_mod,                                                        &
     161        ONLY:  advec_v_up
     162
     163    USE advec_w_pw_mod,                                                        &
     164        ONLY:  advec_w_pw
     165
     166    USE advec_w_up_mod,                                                        &
     167        ONLY:  advec_w_up
     168
     169    USE buoyancy_mod,                                                          &
     170        ONLY:  buoyancy, buoyancy_acc
     171
     172    USE calc_precipitation_mod,                                                &
     173        ONLY:  calc_precipitation
     174
     175    USE calc_radiation_mod,                                                    &
     176        ONLY:  calc_radiation
     177 
     178    USE coriolis_mod,                                                          &
     179        ONLY:  coriolis, coriolis_acc
     180
     181    USE diffusion_e_mod,                                                       &
     182        ONLY:  diffusion_e, diffusion_e_acc
     183
     184    USE diffusion_s_mod,                                                       &
     185        ONLY:  diffusion_s, diffusion_s_acc
     186
     187    USE diffusion_u_mod,                                                       &
     188        ONLY:  diffusion_u, diffusion_u_acc
     189
     190    USE diffusion_v_mod,                                                       &
     191        ONLY:  diffusion_v, diffusion_v_acc
     192
     193    USE diffusion_w_mod,                                                       &
     194        ONLY:  diffusion_w, diffusion_w_acc
     195
     196    USE impact_of_latent_heat_mod,                                             &
     197        ONLY:  impact_of_latent_heat
     198
     199    USE kinds
     200
     201    USE microphysics_mod,                                                      &
     202        ONLY:  microphysics_control
     203
     204    USE nudge_mod,                                                             &
     205        ONLY:  nudge
     206
     207    USE plant_canopy_model_mod,                                                &
     208        ONLY:  plant_canopy_model
     209
     210    USE production_e_mod,                                                      &
     211        ONLY:  production_e, production_e_acc
     212
     213    USE subsidence_mod,                                                        &
     214        ONLY:  subsidence
     215
     216    USE user_actions_mod,                                                      &
     217        ONLY:  user_actions
    200218
    201219
    … …  
    235253    IMPLICIT NONE
    236254
    237     INTEGER ::  i, i_omp_start, j, k, omp_get_thread_num, tn = 0
    238     LOGICAL ::  loop_start
     255    INTEGER(iwp) ::  i                   !:
     256    INTEGER(iwp) ::  i_omp_start         !:
     257    INTEGER(iwp) ::  j                   !:
     258    INTEGER(iwp) ::  k                   !:
     259    INTEGER(iwp) ::  omp_get_thread_num  !:
     260    INTEGER(iwp) ::  tn = 0              !:
     261   
     262    LOGICAL      ::  loop_start          !:
    239263
    240264
    … …  
    835859    IMPLICIT NONE
    836860
    837     INTEGER ::  i, j, k
    838     REAL    ::  sbt
     861    INTEGER(iwp) ::  i    !:
     862    INTEGER(iwp) ::  j    !:
     863    INTEGER(iwp) ::  k    !:
     864
     865    REAL(wp)     ::  sbt  !:
    839866
    840867
    … …  
    14791506    IMPLICIT NONE
    14801507
    1481     INTEGER ::  i, j, k, runge_step
    1482     REAL    ::  sbt
     1508    INTEGER(iwp) ::  i           !:
     1509    INTEGER(iwp) ::  j           !:
     1510    INTEGER(iwp) ::  k           !:
     1511    INTEGER(iwp) ::  runge_step  !:
     1512
     1513    REAL(wp)     ::  sbt         !:
    14831514
    14841515!

  • palm/trunk/SOURCE/random_function.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:
    … …  
    3440! RCS Log replace by Id keyword, revision history cleaned up
    3541!
    36 ! Revision 1.3  2003/10/29 09:06:57  raasch
    37 ! Former function changed to a module.
    38 !
    3942! Revision 1.1  1998/02/04 16:09:45  raasch
    4043! Initial revision
    … …  
    4750!------------------------------------------------------------------------------!
    4851
     52    USE kinds
     53
    4954    IMPLICIT NONE
    5055
    … …  
    5358    PUBLIC random_function, random_function_ini
    5459
    55     INTEGER, PUBLIC, SAVE ::  random_iv(32), random_iy
     60    INTEGER(iwp), PUBLIC, SAVE ::  random_iv(32)  !:
     61    INTEGER(iwp), PUBLIC, SAVE ::  random_iy      !:
    5662
    5763    INTERFACE random_function_ini
    … …  
    7985       IMPLICIT NONE
    8086
    81        INTEGER ::  ia, idum, im, iq, ir, ndiv, ntab
    82        REAL    ::  am, eps, random_function, rnmx
     87       INTEGER(iwp) ::  ia               !:
     88       INTEGER(iwp) ::  idum             !:
     89       INTEGER(iwp) ::  im               !:
     90       INTEGER(iwp) ::  iq               !:
     91       INTEGER(iwp) ::  ir               !:
     92       INTEGER(iwp) ::  ndiv             !:
     93       INTEGER(iwp) ::  ntab             !:
     94
     95       INTEGER(iwp) ::  j                !:
     96       INTEGER(iwp) ::  k                !:
     97
     98       REAL(wp)     ::  am               !:
     99       REAL(wp)     ::  eps              !:
     100       REAL(wp)     ::  random_function  !:
     101       REAL(wp)     ::  rnmx             !:
    83102
    84103       PARAMETER ( ia=16807, im=2147483647, am=1.0/im, iq=127773, ir=2836, &
    85104                   ntab=32, ndiv=1+(im-1)/ntab, eps=1.2e-7, rnmx=1.0-eps )
    86 
    87        INTEGER ::  j, k
    88 
    89105
    90106       IF ( idum .le. 0  .or.  random_iy .eq. 0 )  THEN

  • palm/trunk/SOURCE/random_gauss.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
     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
    2229!
    23 !
    2430! Former revisions:
    2531! -----------------
    … …  
    3036!
    3137! RCS Log replace by Id keyword, revision history cleaned up
    32 !
    33 ! Revision 1.4  2006/08/04 15:01:48  raasch
    34 ! Range of random number is limited by an upper limit (new second parameter)
    3538!
    3639! Revision 1.1  1998/03/25 20:09:47  raasch
    … …  
    4447!------------------------------------------------------------------------------!
    4548
    46     USE random_function_mod
     49    USE kinds
     50
     51    USE random_function_mod,                                                   &
     52        ONLY:  random_function
    4753
    4854    IMPLICIT NONE
    4955
    50     INTEGER :: idum, iset
    51     REAL    :: fac, gset, random_gauss, rsq, upper_limit, v1, v2
     56    INTEGER(iwp) ::  idum          !:
     57    INTEGER(iwp) ::  iset          !:
     58
     59    REAL(wp)     ::  fac           !:
     60    REAL(wp)     ::  gset          !:
     61    REAL(wp)     ::  random_gauss  !:
     62    REAL(wp)     ::  rsq           !:
     63    REAL(wp)     ::  upper_limit   !:
     64    REAL(wp)     ::  v1            !:
     65    REAL(wp)     ::  v2            !:
    5266
    5367    SAVE  iset, gset

  • palm/trunk/SOURCE/read_3d_binary.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! 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:
    … …  
    4652! +z0h, z0h_av
    4753!
    48 ! 776 2011-10-31 08:02:51Z heinze
    49 ! bugfix: increase binary_version due to last commit
    50 !
    51 ! 771 2011-10-27 10:56:21Z heinze
    52 ! +lpt_av
    53 !
    54 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    55 ! +/- 1 replaced with +/- nbgp when swapping and allocating variables.
    56 ! Bugfix: When using initializing_actions = 'cyclic_fill' in some cases
    57 ! not the whole model domain was filled with data of the prerun.
    58 !
    59 ! 410 2009-12-04 17:05:40Z letzel
    60 ! format changed in test output from I2 to I4
    61 !
    62 ! 367 2009-08-25 08:35:52Z maronga
    63 ! Output of messages replaced by message handling routine.
    64 ! +shf_av, qsws_av
    65 !
    66 ! 220 2008-12-18 07:00:36Z raasch
    67 ! reading mechanism completely revised (subdomain/total domain size can vary
    68 ! arbitrarily between current and previous run)
    69 ! Bugfix: reading of spectrum_x|y from restart files ignored if total numbers
    70 ! of grid points do not match
    71 !
    72 ! 150 2008-02-29 08:19:58Z raasch
    73 ! Files from which restart data are to be read are determined and subsequently
    74 ! opened. The total domain on the restart file is allowed to be smaller than
    75 ! the current total domain. In this case it will be periodically mapped on the
    76 ! current domain (needed for recycling method).
    77 ! +call of user_read_restart_data, -dopr_time_count,
    78 ! hom_sum, volume_flow_area, volume_flow_initial moved to read_var_list,
    79 ! reading of old profil parameters (cross_..., dopr_crossindex, profile_***)
    80 ! removed, initialization of spectrum_x|y removed
    81 !
    82 ! 102 2007-07-27 09:09:17Z raasch
    83 ! +uswst, uswst_m, vswst, vswst_m
    84 !
    85 ! 96 2007-06-04 08:07:41Z raasch
    86 ! +rho_av, sa, sa_av, saswsb, saswst
    87 !
    88 ! 73 2007-03-20 08:33:14Z raasch
    89 ! +precipitation_amount, precipitation_rate_av, rif_wall, u_m_l, u_m_r, etc.,
    90 ! z0_av
    91 !
    92 ! 19 2007-02-23 04:53:48Z raasch
    93 ! +qswst, qswst_m, tswst, tswst_m
    94 !
    95 ! RCS Log replace by Id keyword, revision history cleaned up
    96 !
    97 ! Revision 1.4  2006/08/04 15:02:32  raasch
    98 ! +iran, iran_part
    99 !
    10054! Revision 1.1  2004/04/30 12:47:27  raasch
    10155! Initial revision
    … …  
    10761!------------------------------------------------------------------------------!
    10862
    109     USE arrays_3d
     63    USE arrays_3d,                                                             &
     64        ONLY:  e, kh, km, p, pt, q, ql, qc, nr, nrs, nrsws, nrswst, qr, qrs,   &
     65               qrsws, qrswst, qs, qsws, qswst, sa, saswsb, saswst, rif,        &
     66               rif_wall, shf, ts, tswst, u, u_m_l, u_m_n, u_m_r, u_m_s, us,    &
     67               usws, uswst, v, v_m_l, v_m_n, v_m_r, v_m_s, vpt, vsws, vswst,   &
     68               w, w_m_l, w_m_n, w_m_r, w_m_s, z0, z0h
     69
    11070    USE averaging
    111     USE cloud_parameters
    112     USE control_parameters
    113     USE cpulog
    114     USE indices
    115     USE particle_attributes
     71
     72    USE cloud_parameters,                                                      &
     73        ONLY:  prr, precipitation_amount
     74
     75    USE control_parameters,                                                    &
     76        ONLY:  iran, humidity, passive_scalar, cloud_physics, cloud_droplets,  &
     77               icloud_scheme, message_string, outflow_l, outflow_n, outflow_r, &
     78               outflow_s, precipitation, ocean, topography
     79
     80    USE cpulog,                                                                &
     81        ONLY:  cpu_log, log_point_s
     82
     83    USE indices,                                                               &
     84        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nx_on_file, ny, nys, nysg, nyn, &
     85               nyng, ny_on_file, nzb, nzt
     86
     87    USE kinds
     88
     89    USE particle_attributes,                                                   &
     90        ONLY:  iran_part
     91
    11692    USE pegrid
    117     USE profil_parameter
    118     USE random_function_mod
    119     USE statistics
     93
     94    USE random_function_mod,                                                   &
     95        ONLY:  random_iv, random_iy
     96
     97    USE statistics,                                                            &
     98        ONLY:  spectrum_x, spectrum_y
     99
    120100
    121101    IMPLICIT NONE
    122102
    123103    CHARACTER (LEN=5)  ::  myid_char_save
    124     CHARACTER (LEN=10) ::  binary_version, version_on_file
     104    CHARACTER (LEN=10) ::  binary_version
     105    CHARACTER (LEN=10) ::  version_on_file
    125106    CHARACTER (LEN=20) ::  field_chr
    126107
    127     INTEGER ::  files_to_be_opened, i, j, k, myid_on_file,                    &
    128                 numprocs_on_file, nxlc, nxlf, nxlpr, nxl_on_file, nxrc, nxrf, &
    129                 nxrpr, nxr_on_file, nync, nynf, nynpr, nyn_on_file, nysc,     &
    130                 nysf, nyspr, nys_on_file, nzb_on_file, nzt_on_file, offset_x, &
    131                 offset_y, shift_x, shift_y
    132 
    133     INTEGER, DIMENSION(numprocs_previous_run) ::  file_list, overlap_count
    134 
    135     INTEGER, DIMENSION(numprocs_previous_run,1000) ::  nxlfa, nxrfa, nynfa, &
    136                                                        nysfa, offset_xa, &
    137                                                        offset_ya
    138     REAL ::  rdummy
    139 
    140     REAL, DIMENSION(:,:), ALLOCATABLE     ::  tmp_2d
    141     REAL, DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d, tmp_3dwul, tmp_3dwun,    &
    142                                               tmp_3dwur, tmp_3dwus, tmp_3dwvl, &
    143                                               tmp_3dwvn, tmp_3dwvr, tmp_3dwvs, &
    144                                               tmp_3dwwl, tmp_3dwwn, tmp_3dwwr, &
    145                                               tmp_3dwws
    146     REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  tmp_4d
     108    INTEGER(iwp) ::  files_to_be_opened  !:
     109    INTEGER(iwp) ::  i                   !:
     110    INTEGER(iwp) ::  j                   !:
     111    INTEGER(iwp) ::  k                   !:
     112    INTEGER(iwp) ::  myid_on_file        !:
     113    INTEGER(iwp) ::  numprocs_on_file    !:
     114    INTEGER(iwp) ::  nxlc                !:
     115    INTEGER(iwp) ::  nxlf                !:
     116    INTEGER(iwp) ::  nxlpr               !:
     117    INTEGER(iwp) ::  nxl_on_file         !:
     118    INTEGER(iwp) ::  nxrc                !:
     119    INTEGER(iwp) ::  nxrf                !:
     120    INTEGER(iwp) ::  nxrpr               !:
     121    INTEGER(iwp) ::  nxr_on_file         !:
     122    INTEGER(iwp) ::  nync                !:
     123    INTEGER(iwp) ::  nynf                !:
     124    INTEGER(iwp) ::  nynpr               !:
     125    INTEGER(iwp) ::  nyn_on_file         !:
     126    INTEGER(iwp) ::  nysc                !:
     127    INTEGER(iwp) ::  nysf                !:
     128    INTEGER(iwp) ::  nyspr               !:
     129    INTEGER(iwp) ::  nys_on_file         !:
     130    INTEGER(iwp) ::  nzb_on_file         !:
     131    INTEGER(iwp) ::  nzt_on_file         !:
     132    INTEGER(iwp) ::  offset_x            !:
     133    INTEGER(iwp) ::  offset_y            !:
     134    INTEGER(iwp) ::  shift_x             !:
     135    INTEGER(iwp) ::  shift_y             !:
     136
     137    INTEGER(iwp), DIMENSION(numprocs_previous_run) ::  file_list       !:
     138    INTEGER(iwp), DIMENSION(numprocs_previous_run) ::  overlap_count   !:
     139
     140    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa      !:
     141    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxrfa      !:
     142    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nynfa      !:
     143    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nysfa      !:
     144    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_xa  !:
     145    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya  !:
     146
     147    REAL(wp) ::  rdummy
     148
     149    REAL(wp), DIMENSION(:,:), ALLOCATABLE     ::  tmp_2d     !:
     150    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d     !:
     151    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwul  !:
     152    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwun  !:
     153    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwur  !:
     154    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwus  !:
     155    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwvl  !:
     156    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwvn  !:
     157    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwvr  !:
     158    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwvs  !:
     159    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwwl  !:
     160    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwwn  !:
     161    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwwr  !:
     162    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3dwws  !:
     163
     164    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  tmp_4d     !:
    147165
    148166

  • palm/trunk/SOURCE/read_var_list.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:
    … …  
    95101! +curvature_solution_effects
    96102!
    97 ! 626 2010-12-10 13:04:12Z suehring
    98 ! idum replaced by cdum in read_parts_of_var_list
    99 !
    100 ! 622 2010-12-10 08:08:13Z raasch
    101 ! +collective_wait
    102 !
    103 ! 600 2010-11-24 16:10:51Z raasch
    104 ! +call_psolver_at_all_substeps, cfl_factor, cycle_mg, mg_cycles,
    105 ! mg_switch_to_pe0_level, ngsrb, nsor, omega_sor, psolver,
    106 ! rayleigh_damping_factor, rayleigh_damping_height, residual_limit
    107 ! in routine skip_var_list (end of this file), variable ldum is replaced
    108 ! by cdum(LEN=1), because otherwise read errors (too few data on file)
    109 ! appear due to one of the additional parameters (cycle_mg) which are now
    110 ! stored on the restart file
    111 !
    112 ! 591 2010-10-28 06:35:52Z helmke
    113 ! remove print command
    114 !
    115 ! 587 2010-10-27 08:36:51Z helmke
    116 ! +time_domask
    117 !
    118 ! 580 2010-10-05 13:59:11Z heinze
    119 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,
    120 ! ws_vertical_gradient_level to subs_vertical_gradient_level and
    121 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i
    122 !
    123 ! 411 2009-12-11 14:15:58Z heinze
    124 ! +large_scale_subsidence, ws_vertical_gradient, ws_vertical_gradient_level,
    125 ! ws_vertical_gradient_level_ind
    126 !
    127 ! 345 2009-07-01 14:37:56Z heinze
    128 ! +output_for_t0
    129 ! dt_fixed is read into a dummy variable.
    130 ! Output of messages replaced by message handling routine.
    131 ! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left,
    132 ! canyon_wall_south, conserve_volume_flow_mode, coupling_start_time,
    133 ! dp_external, dp_level_b, dp_smooth, dpdxy, run_coupled,
    134 ! time_since_reference_point, topography_grid_convention, u_bulk, v_bulk
    135 !
    136 ! 216 2008-11-25 07:12:43Z raasch
    137 ! limitations for nx_on_file, ny_on_file removed (read_parts_of_var_list)
    138 !
    139 ! 173 2008-05-23 20:39:38Z raasch
    140 ! +cthf, leaf_surface_concentration, scalar_exchange_coefficient
    141 ! +numprocs_previous_run, hor_index_bounds_previous_run, inflow_damping_factor,
    142 ! inflow_damping_height, inflow_damping_width, mean_inflow_profiles,
    143 ! recycling_width, turbulent_inflow,
    144 ! -cross_ts_*, npex, npey,
    145 ! hom_sum, volume_flow_area, volume_flow_initial moved from
    146 ! read_3d_binary to here,
    147 ! routines read_parts_of_var_list and skip_var_list added at the end
    148 !
    149 ! 138 2007-11-28 10:03:58Z letzel
    150 ! +canopy_mode, drag_coefficient, lad, lad_surface, lad_vertical_gradient,
    151 ! lad_vertical_gradient_level, lad_vertical_gradient_level_ind, pch_index,
    152 ! plant_canopy, time_sort_particles
    153 !
    154 ! 102 2007-07-27 09:09:17Z raasch
    155 ! +time_coupling, top_momentumflux_u|v
    156 !
    157 ! 95 2007-06-02 16:48:38Z raasch
    158 ! +bc_sa_t, ocean, sa_init, sa_surface, sa_vertical_gradient,
    159 ! sa_vertical_gradient_level, bottom/top_salinity_flux
    160 !
    161 ! 87 2007-05-22 15:46:47Z raasch
    162 ! +max_pr_user (version 3.1), var_hom renamed pr_palm
    163 !
    164 ! 75 2007-03-22 09:54:05Z raasch
    165 ! +loop_optimization, pt_reference, moisture renamed humidity
    166 !
    167 ! 20 2007-02-26 00:12:32Z raasch
    168 ! +top_heatflux, use_top_fluxes
    169 !
    170 ! RCS Log replace by Id keyword, revision history cleaned up
    171 !
    172 ! Revision 1.34  2006/08/22 14:14:27  raasch
    173 ! +dz_max
    174 !
    175103! Revision 1.1  1998/03/18 20:18:48  raasch
    176104! Initial revision
    … …  
    182110!------------------------------------------------------------------------------!
    183111
    184     USE arrays_3d
    185     USE averaging
    186     USE cloud_parameters
     112    USE arrays_3d,                                                             &
     113        ONLY:  inflow_damping_factor, lad, mean_inflow_profiles, pt_init,      &
     114               q_init, ref_state, sa_init, u_init, ug, v_init, vg
     115
     116    USE cloud_parameters,                                                      &
     117        ONLY:  c_sedimentation, curvature_solution_effects,                    &
     118               limiter_sedimentation, nc_const, ventilation_effect
     119
    187120    USE control_parameters
    188     USE grid_variables
    189     USE indices
    190     USE model_1d
     121
     122    USE grid_variables,                                                        &
     123        ONLY:  dx, dy
     124
     125    USE indices,                                                               &
     126        ONLY:  nz, nx, nx_on_file, ny, ny_on_file
     127
     128    USE model_1d,                                                              &
     129        ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
     130
    191131    USE netcdf_control
    192     USE particle_attributes
     132
     133    USE particle_attributes,                                                   &
     134        ONLY:  time_sort_particles
     135
    193136    USE pegrid
    194     USE profil_parameter
    195     USE statistics
     137
     138    USE statistics,                                                            &
     139        ONLY:  statistic_regions, hom, hom_sum, pr_palm, u_max, u_max_ijk,     &
     140               v_max, v_max_ijk, w_max, w_max_ijk
    196141
    197142    IMPLICIT NONE
    … …  
    779724!------------------------------------------------------------------------------!
    780725
    781     USE arrays_3d
     726    USE arrays_3d,                                                             &
     727        ONLY:  inflow_damping_factor, lad, mean_inflow_profiles, pt_init,      &
     728               q_init, ref_state, sa_init, u_init, ug, v_init, vg
     729
    782730    USE control_parameters
    783     USE indices
     731
     732    USE indices,                                                               &
     733        ONLY:  nz, nx, nx_on_file, ny, ny_on_file
     734
     735    USE kinds
     736
    784737    USE pegrid
    785     USE statistics
     738
     739    USE statistics,                                                            &
     740        ONLY:  statistic_regions, hom, hom_sum, pr_palm, u_max, u_max_ijk,     &
     741               v_max, v_max_ijk, w_max, w_max_ijk
    786742
    787743    IMPLICIT NONE
    … …  
    791747    CHARACTER (LEN=1)  ::  cdum
    792748
    793     INTEGER ::  max_pr_user_on_file, nz_on_file, &
    794                 statistic_regions_on_file, tmp_mpru, tmp_sr
    795 
    796     REAL, DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
    797     REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
     749    INTEGER(iwp) ::  max_pr_user_on_file
     750    INTEGER(iwp) ::  nz_on_file
     751    INTEGER(iwp) ::  statistic_regions_on_file
     752    INTEGER(iwp) ::  tmp_mpru
     753    INTEGER(iwp) ::  tmp_sr
     754
     755    REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
     756    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
    798757
    799758

  • palm/trunk/SOURCE/run_control.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! 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:
    … …  
    3844! all actions concerning leapfrog scheme removed
    3945!
    40 ! 97 2007-06-21 08:23:15Z raasch
    41 ! Timestep and z_i format changed
    42 !
    43 ! 87 2007-05-22 15:46:47Z raasch
    44 ! var_hom renamed pr_palm
    45 !
    46 ! 82 2007-04-16 15:40:52Z raasch
    47 ! Preprocessor strings for different linux clusters changed to "lc",
    48 ! routine local_flush is used for buffer flushing
    49 !
    50 ! RCS Log replace by Id keyword, revision history cleaned up
    51 !
    52 ! Revision 1.20  2006/06/02 15:23:47  raasch
    53 ! cpp-directives extended for lctit
    54 !
    5546! Revision 1.1  1997/08/11 06:25:38  raasch
    5647! Initial revision
    … …  
    6253!------------------------------------------------------------------------------!
    6354
    64     USE cpulog
    65     USE indices
     55    USE cpulog,                                                                &
     56        ONLY:  cpu_log, log_point
     57
     58    USE control_parameters,                                                    &
     59        ONLY:  advected_distance_x, advected_distance_y,                       &
     60               current_timestep_number, disturbance_created, dt_3d, mgcycles,  &
     61               run_control_header, runnr, simulated_time, simulated_time_chr,  &
     62               timestep_reason
     63
     64    USE indices,                                                               &
     65        ONLY:  nzb
     66
    6667    USE pegrid
    67     USE statistics
    68     USE control_parameters
     68
     69    USE statistics,                                                            &
     70        ONLY:  flow_statistics_called, hom, pr_palm, u_max, u_max_ijk, v_max,  &
     71               v_max_ijk, w_max, w_max_ijk
    6972
    7073    IMPLICIT NONE

  • palm/trunk/SOURCE/set_slicer_attributes_dvrp.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:
    … …  
    3945#if defined( __dvrp_graphics )
    4046
    41     USE control_parameters
    42     USE dvrp_variables
     47    USE dvrp_variables,                                                        &
     48        ONLY:  dvrp_colortable_entries, interval_h_dvrp, interval_values_dvrp, &
     49               slicer_range_limits_dvrp
     50
     51    USE kinds
    4352
    4453    IMPLICIT NONE
    4554
    46     INTEGER ::  j, n_slicer
    47     REAL    ::  maxv, meav, minv
     55    INTEGER(iwp) ::  j         !:
     56    INTEGER(iwp) ::  n_slicer  !:
     57
     58    REAL(wp)     ::  maxv      !:
     59    REAL(wp)     ::  meav      !:
     60    REAL(wp)     ::  minv      !:
    4861
    4962

  • palm/trunk/SOURCE/singleton.f90

    r484 r1320  
    44! Current revisions:
    55! -----------------
    6 !
     6! kind-parameters added to all INTEGER and REAL declaration statements,
     7! kinds are defined in new module kinds,
     8! revision history before 2012 removed,
    79!
    810! Former revisions:
    911! -----------------
    10 ! $Id$
    11 ! RCS Log replace by Id keyword, revision history cleaned up
    12 !
    13 ! Revision 1.2  2004/04/30 12:52:09  raasch
    14 ! Shape of arrays is explicitly stored in ishape and handled to the
    15 ! fft-routines instead of the shape-function (due to a compiler error on
    16 ! decalpha)
    17 !
    1812! Revision 1.1  2002/05/02 18:56:59  raasch
    1913! Initial revision
    … …  
    158152!-----------------------------------------------------------------------------
    159153
     154    USE kinds
     155
    160156    IMPLICIT NONE
    161157
    162158    PRIVATE
    163     PUBLIC:: fft, fftn, fftkind
    164 
    165     INTEGER, PARAMETER:: fftkind = KIND(0.0) ! adjust here for other precisions
    166 
    167     REAL(fftkind), PARAMETER:: sin60 = 0.86602540378443865_fftkind
    168     REAL(fftkind), PARAMETER:: cos72 = 0.30901699437494742_fftkind
    169     REAL(fftkind), PARAMETER:: sin72 = 0.95105651629515357_fftkind
    170     REAL(fftkind), PARAMETER:: pi    = 3.14159265358979323_fftkind
     159    PUBLIC:: fft, fftn
     160
     161    REAL(wp), PARAMETER:: sin60 = 0.86602540378443865_wp
     162    REAL(wp), PARAMETER:: cos72 = 0.30901699437494742_wp
     163    REAL(wp), PARAMETER:: sin72 = 0.95105651629515357_wp
     164    REAL(wp), PARAMETER:: pi    = 3.14159265358979323_wp
    171165
    172166    INTERFACE fft
    … …  
    187181!
    188182!-- Formal parameters
    189     COMPLEX(fftkind), DIMENSION(:), INTENT(IN)           :: array
    190     INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
    191     LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
    192     INTEGER,                        INTENT(OUT), OPTIONAL:: stat
     183    COMPLEX(wp), DIMENSION(:), INTENT(IN)           :: array
     184    INTEGER(iwp), DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
     185    INTEGER(iwp),               INTENT(OUT), OPTIONAL:: stat
     186    LOGICAL,                    INTENT(IN),  OPTIONAL:: inv
    193187!
    194188!-- Function result
    195     COMPLEX(fftkind), DIMENSION(SIZE(array, 1)):: ft
    196 
    197     INTEGER ::  ishape(1)
     189    COMPLEX(wp), DIMENSION(SIZE(array, 1)):: ft
     190
     191    INTEGER(iwp)::  ishape(1)
    198192
    199193!
    … …  
    211205!
    212206!-- Formal parameters
    213     COMPLEX(fftkind), DIMENSION(:,:), INTENT(IN)           :: array
    214     INTEGER,          DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
    215     LOGICAL,                          INTENT(IN),  OPTIONAL:: inv
    216     INTEGER,                          INTENT(OUT), OPTIONAL:: stat
     207    COMPLEX(wp), DIMENSION(:,:), INTENT(IN)           :: array
     208    INTEGER(iwp), DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
     209    INTEGER(iwp),                 INTENT(OUT), OPTIONAL:: stat
     210    LOGICAL,                      INTENT(IN),  OPTIONAL:: inv
    217211!
    218212!-- Function result
    219     COMPLEX(fftkind), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft
    220 
    221     INTEGER ::  ishape(2)
     213    COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft
     214
     215    INTEGER(iwp) ::  ishape(2)
    222216!
    223217!-- Intrinsics used
    … …  
    234228!
    235229!-- Formal parameters
    236     COMPLEX(fftkind), DIMENSION(:,:,:), INTENT(IN)           :: array
    237     INTEGER,          DIMENSION(:),     INTENT(IN),  OPTIONAL:: dim
    238     LOGICAL,                            INTENT(IN),  OPTIONAL:: inv
    239     INTEGER,                            INTENT(OUT), OPTIONAL:: stat
     230    COMPLEX(wp), DIMENSION(:,:,:), INTENT(IN)           :: array
     231    INTEGER(iwp), DIMENSION(:),     INTENT(IN),  OPTIONAL:: dim
     232    INTEGER(iwp),                   INTENT(OUT), OPTIONAL:: stat
     233    LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
    240234!
    241235!-- Function result
    242     COMPLEX(fftkind), &
     236    COMPLEX(wp), &
    243237         DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3)):: ft
    244238
    245     INTEGER ::  ishape(3)
     239    INTEGER(iwp) ::  ishape(3)
    246240
    247241!
    … …  
    259253!
    260254!-- Formal parameters
    261     COMPLEX(fftkind), DIMENSION(:,:,:,:), INTENT(IN)           :: array
    262     INTEGER,          DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
    263     LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
    264     INTEGER,                              INTENT(OUT), OPTIONAL:: stat
     255    COMPLEX(wp), DIMENSION(:,:,:,:), INTENT(IN)           :: array
     256    INTEGER(iwp), DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
     257    INTEGER(iwp),                     INTENT(OUT), OPTIONAL:: stat
     258    LOGICAL,                          INTENT(IN),  OPTIONAL:: inv
    265259!
    266260!-- Function result
    267     COMPLEX(fftkind), DIMENSION( &
     261    COMPLEX(wp), DIMENSION( &
    268262         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4)):: ft
    269263
    270     INTEGER ::  ishape(4)
     264    INTEGER(iwp) ::  ishape(4)
    271265!
    272266!-- Intrinsics used
    … …  
    283277!
    284278!-- Formal parameters
    285     COMPLEX(fftkind), DIMENSION(:,:,:,:,:), INTENT(IN)           :: array
    286     INTEGER,          DIMENSION(:),         INTENT(IN),  OPTIONAL:: dim
    287     LOGICAL,                                INTENT(IN),  OPTIONAL:: inv
    288     INTEGER,                                INTENT(OUT), OPTIONAL:: stat
     279    COMPLEX(wp), DIMENSION(:,:,:,:,:), INTENT(IN)           :: array
     280    INTEGER(iwp), DIMENSION(:),         INTENT(IN),  OPTIONAL:: dim
     281    INTEGER(iwp),                       INTENT(OUT), OPTIONAL:: stat
     282    LOGICAL,                            INTENT(IN),  OPTIONAL:: inv
    289283!
    290284!-- Function result
    291     COMPLEX(fftkind), DIMENSION( &
     285    COMPLEX(wp), DIMENSION( &
    292286         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
    293287         SIZE(array, 5)):: ft
    294288
    295     INTEGER ::  ishape(5)
     289    INTEGER(iwp) ::  ishape(5)
    296290
    297291!
    … …  
    309303!
    310304!-- Formal parameters
    311     COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:), INTENT(IN)           :: array
    312     INTEGER,          DIMENSION(:),           INTENT(IN),  OPTIONAL:: dim
    313     LOGICAL,                                  INTENT(IN),  OPTIONAL:: inv
    314     INTEGER,                                  INTENT(OUT), OPTIONAL:: stat
     305    COMPLEX(wp), DIMENSION(:,:,:,:,:,:), INTENT(IN)           :: array
     306    INTEGER(iwp), DIMENSION(:),           INTENT(IN),  OPTIONAL:: dim
     307    INTEGER(iwp),                         INTENT(OUT), OPTIONAL:: stat
     308    LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
    315309!
    316310!-- Function result
    317     COMPLEX(fftkind), DIMENSION( &
     311    COMPLEX(wp), DIMENSION( &
    318312         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
    319313         SIZE(array, 5), SIZE(array, 6)):: ft
    320314
    321     INTEGER ::  ishape(6)
     315    INTEGER(iwp) ::  ishape(6)
    322316
    323317!
    … …  
    335329!
    336330!-- Formal parameters
    337     COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:,:), INTENT(IN)           :: array
    338     INTEGER,          DIMENSION(:),             INTENT(IN),  OPTIONAL:: dim
    339     LOGICAL,                                    INTENT(IN),  OPTIONAL:: inv
    340     INTEGER,                                    INTENT(OUT), OPTIONAL:: stat
     331    COMPLEX(wp), DIMENSION(:,:,:,:,:,:,:), INTENT(IN)           :: array
     332    INTEGER(iwp),          DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
     333    INTEGER(iwp),                          INTENT(OUT), OPTIONAL:: stat
     334    LOGICAL,                               INTENT(IN),  OPTIONAL:: inv
    341335!
    342336!-- Function result
    343     COMPLEX(fftkind), DIMENSION( &
     337    COMPLEX(wp), DIMENSION( &
    344338         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
    345339         SIZE(array, 5), SIZE(array, 6), SIZE(array, 7)):: ft
    346340
    347     INTEGER ::  ishape(7)
     341    INTEGER(iwp) ::  ishape(7)
    348342
    349343!
    … …  
    361355!
    362356!-- Formal parameters
    363     COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
    364     INTEGER,          DIMENSION(:), INTENT(IN)           :: shape
    365     INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
    366     LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
    367     INTEGER,                        INTENT(OUT), OPTIONAL:: stat
     357    COMPLEX(wp), DIMENSION(*), INTENT(INOUT)        :: array
     358    INTEGER(iwp), DIMENSION(:), INTENT(IN)           :: shape
     359    INTEGER(iwp), DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
     360    INTEGER(iwp),               INTENT(OUT), OPTIONAL:: stat
     361    LOGICAL,                    INTENT(IN),  OPTIONAL:: inv
    368362!
    369363!-- Local arrays
    370     INTEGER, DIMENSION(SIZE(shape)):: d
     364    INTEGER(iwp), DIMENSION(SIZE(shape)):: d
    371365!
    372366!-- Local scalars
    373367    LOGICAL      :: inverse
    374     INTEGER      :: i, ndim, ntotal
    375     REAL(fftkind):: scale
     368    INTEGER(iwp) :: i, ndim, ntotal
     369    REAL(wp):: scale
    376370!
    377371!-- Intrinsics used
    … …  
    394388
    395389    ntotal = PRODUCT(shape)
    396     scale = SQRT(1.0_fftkind / PRODUCT(shape(d(1:ndim))))
     390    scale = SQRT(1.0_wp / PRODUCT(shape(d(1:ndim))))
    397391    DO i = 1, ntotal
    398392       array(i) = CMPLX(REAL(array(i)) * scale, AIMAG(array(i)) * scale, &
    399             KIND=fftkind)
     393            KIND=wp)
    400394    END DO
    401395
    … …  
    414408!
    415409!-- Formal parameters
    416     COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
    417     INTEGER,                        INTENT(IN)           :: ntotal, npass, nspan
    418     LOGICAL,                        INTENT(IN)           :: inv
    419     INTEGER,                        INTENT(OUT), OPTIONAL:: stat
     410    COMPLEX(wp), DIMENSION(*), INTENT(INOUT)        :: array
     411    INTEGER(iwp),               INTENT(IN)           :: ntotal, npass, nspan
     412    INTEGER(iwp),               INTENT(OUT), OPTIONAL:: stat
     413    LOGICAL,                    INTENT(IN)           :: inv
    420414!
    421415!-- Local arrays
    422     INTEGER,          DIMENSION(BIT_SIZE(0))     :: factor
    423     COMPLEX(fftkind), DIMENSION(:), ALLOCATABLE  :: ctmp
    424     REAL(fftkind),    DIMENSION(:), ALLOCATABLE  :: sine, cosine
    425     INTEGER,          DIMENSION(:), ALLOCATABLE  :: perm
     416    COMPLEX(wp),  DIMENSION(:), ALLOCATABLE  :: ctmp
     417    INTEGER(iwp), DIMENSION(BIT_SIZE(0))     :: factor
     418    INTEGER(iwp), DIMENSION(:), ALLOCATABLE  :: perm
     419    REAL(wp),     DIMENSION(:), ALLOCATABLE  :: sine, cosine
    426420!
    427421!-- Local scalars
    428     INTEGER         :: maxfactor, nfactor, nsquare, nperm
     422    INTEGER(iwp)         :: maxfactor, nfactor, nsquare, nperm
    429423!
    430424!-- Intrinsics used
    … …  
    476470!
    477471!--   Formal parameters
    478       INTEGER,               INTENT(IN) :: npass
    479       INTEGER, DIMENSION(*), INTENT(OUT):: factor
    480       INTEGER,               INTENT(OUT):: nfactor, nsquare
     472      INTEGER(iwp),               INTENT(IN) :: npass
     473      INTEGER(iwp), DIMENSION(*), INTENT(OUT):: factor
     474      INTEGER(iwp),               INTENT(OUT):: nfactor, nsquare
    481475!
    482476!--   Local scalars
    483       INTEGER:: j, jj, k
     477      INTEGER(iwp):: j, jj, k
    484478
    485479      nfactor = 0
    … …  
    541535!
    542536!--   Formal parameters
    543       COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
    544       INTEGER,                        INTENT(IN)    :: ntotal, npass, nspan
    545       INTEGER,          DIMENSION(*), INTENT(IN)    :: factor
    546       INTEGER,                        INTENT(IN)    :: nfactor
    547       COMPLEX(fftkind), DIMENSION(*), INTENT(OUT)   :: ctmp
    548       REAL(fftkind),    DIMENSION(*), INTENT(OUT)   :: sine, cosine
    549       LOGICAL,                        INTENT(IN)    :: inv
     537      COMPLEX(wp), DIMENSION(*), INTENT(IN OUT):: array
     538      COMPLEX(wp),  DIMENSION(*), INTENT(OUT)   :: ctmp
     539      INTEGER(iwp),               INTENT(IN)    :: ntotal, npass, nspan
     540      INTEGER(iwp), DIMENSION(*), INTENT(IN)    :: factor
     541      INTEGER(iwp),               INTENT(IN)    :: nfactor
     542      LOGICAL,                    INTENT(IN)    :: inv
     543      REAL(wp),     DIMENSION(*), INTENT(OUT)   :: sine, cosine
    550544!
    551545!--   Local scalars
    552       INTEGER         :: ii, ispan
    553       INTEGER         :: j, jc, jf, jj
    554       INTEGER         :: k, kk, kspan, k1, k2, k3, k4
    555       INTEGER         :: nn, nt
    556       REAL(fftkind)   :: s60, c72, s72, pi2, radf
    557       REAL(fftkind)   :: c1, s1, c2, s2, c3, s3, cd, sd, ak
    558       COMPLEX(fftkind):: cc, cj, ck, cjp, cjm, ckp, ckm
     546      INTEGER(iwp):: ii, ispan
     547      INTEGER(iwp):: j, jc, jf, jj
     548      INTEGER(iwp):: k, kk, kspan, k1, k2, k3, k4
     549      INTEGER(iwp):: nn, nt
     550      REAL(wp)    :: s60, c72, s72, pi2, radf
     551      REAL(wp)    :: c1, s1, c2, s2, c3, s3, cd, sd, ak
     552      COMPLEX(wp) :: cc, cj, ck, cjp, cjm, ckp, ckm
    559553
    560554      c72 = cos72
    … …  
    574568      jc = nspan / npass
    575569      radf = pi2 * jc
    576       pi2 = pi2 * 2.0_fftkind !-- use 2 PI from here on
     570      pi2 = pi2 * 2.0_wp !-- use 2 PI from here on
    577571
    578572      ii = 0
    … …  
    581575         sd = radf / kspan
    582576         cd = SIN(sd)
    583          cd = 2.0_fftkind * cd * cd
     577         cd = 2.0_wp * cd * cd
    584578         sd = SIN(sd + sd)
    585579         kk = 1
    … …  
    606600            IF (kk > kspan) RETURN
    607601            DO
    608                c1 = 1.0_fftkind - cd
     602               c1 = 1.0_wp - cd
    609603               s1 = sd
    610604               DO
    … …  
    614608                        ck = array(kk) - array(k2)
    615609                        array(kk) = array(kk) + array(k2)
    616                         array(k2) = ck * CMPLX(c1, s1, KIND=fftkind)
     610                        array(k2) = ck * CMPLX(c1, s1, KIND=wp)
    617611                        kk = k2 + kspan
    618612                        IF (kk >= nt) EXIT
    … …  
    625619                  ak = c1 - (cd * c1 + sd * s1)
    626620                  s1 = sd * c1 - cd * s1 + s1
    627                   c1 = 2.0_fftkind - (ak * ak + s1 * s1)
     621                  c1 = 2.0_wp - (ak * ak + s1 * s1)
    628622                  s1 = s1 * c1
    629623                  c1 = c1 * ak
    … …  
    641635
    642636            DO
    643                c1 = 1.0_fftkind
    644                s1 = 0.0_fftkind
     637               c1 = 1.0_wp
     638               s1 = 0.0_wp
    645639               DO
    646640                  DO
    … …  
    655649                     cjp = ckp - cjp
    656650                     IF (inv) THEN
    657                         ckp = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
    658                         ckm = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
     651                        ckp = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=wp)
     652                        ckm = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=wp)
    659653                     ELSE
    660                         ckp = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
    661                         ckm = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
     654                        ckp = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=wp)
     655                        ckm = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=wp)
    662656                     END IF
    663657!
    664658!--                  Avoid useless multiplies
    665                      IF (s1 == 0.0_fftkind) THEN
     659                     IF (s1 == 0.0_wp) THEN
    666660                        array(k1) = ckp
    667661                        array(k2) = cjp
    668662                        array(k3) = ckm
    669663                     ELSE
    670                         array(k1) = ckp * CMPLX(c1, s1, KIND=fftkind)
    671                         array(k2) = cjp * CMPLX(c2, s2, KIND=fftkind)
    672                         array(k3) = ckm * CMPLX(c3, s3, KIND=fftkind)
     664                        array(k1) = ckp * CMPLX(c1, s1, KIND=wp)
     665                        array(k2) = cjp * CMPLX(c2, s2, KIND=wp)
     666                        array(k3) = ckm * CMPLX(c3, s3, KIND=wp)
    673667                     END IF
    674668                     kk = k3 + kspan
    … …  
    678672                  c2 = c1 - (cd * c1 + sd * s1)
    679673                  s1 = sd * c1 - cd * s1 + s1
    680                   c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
     674                  c1 = 2.0_wp - (c2 * c2 + s1 * s1)
    681675                  s1 = s1 * c1
    682676                  c1 = c1 * c2
    … …  
    684678!--               Values of c2, c3, s2, s3 that will get used next time
    685679                  c2 = c1 * c1 - s1 * s1
    686                   s2 = 2.0_fftkind * c1 * s1
     680                  s2 = 2.0_wp * c1 * s1
    687681                  c3 = c2 * c1 - s2 * s1
    688682                  s3 = c2 * s1 + s2 * c1
    … …  
    712706                     array(kk) = ck + cj
    713707                     ck = ck - CMPLX( &
    714                           0.5_fftkind * REAL (cj), &
    715                           0.5_fftkind * AIMAG(cj), &
    716                           KIND=fftkind)
     708                          0.5_wp * REAL (cj), &
     709                          0.5_wp * AIMAG(cj), &
     710                          KIND=wp)
    717711                     cj = CMPLX( &
    718712                          (REAL (array(k1)) - REAL (array(k2))) * s60, &
    719713                          (AIMAG(array(k1)) - AIMAG(array(k2))) * s60, &
    720                           KIND=fftkind)
    721                      array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
    722                      array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
     714                          KIND=wp)
     715                     array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=wp)
     716                     array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=wp)
    723717                     kk = k2 + kspan
    724718                     IF (kk >= nn) EXIT
    … …  
    730724            CASE (5) !-- transform for factor of 5 (optional code)
    731725               c2 = c72 * c72 - s72 * s72
    732                s2 = 2.0_fftkind * c72 * s72
     726               s2 = 2.0_wp * c72 * s72
    733727               DO
    734728                  DO
    … …  
    744738                     array(kk) = cc + ckp + cjp
    745739                     ck = CMPLX(REAL(ckp) * c72, AIMAG(ckp) * c72, &
    746                           KIND=fftkind) + &
     740                          KIND=wp) + &
    747741                          CMPLX(REAL(cjp) * c2,  AIMAG(cjp) * c2,  &
    748                           KIND=fftkind) + cc
     742                          KIND=wp) + cc
    749743                     cj = CMPLX(REAL(ckm) * s72, AIMAG(ckm) * s72, &
    750                           KIND=fftkind) + &
     744                          KIND=wp) + &
    751745                          CMPLX(REAL(cjm) * s2,  AIMAG(cjm) * s2,  &
    752                           KIND=fftkind)
    753                      array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
    754                      array(k4) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
     746                          KIND=wp)
     747                     array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=wp)
     748                     array(k4) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=wp)
    755749                     ck = CMPLX(REAL(ckp) * c2,  AIMAG(ckp) * c2,  &
    756                           KIND=fftkind) + &
     750                          KIND=wp) + &
    757751                          CMPLX(REAL(cjp) * c72, AIMAG(cjp) * c72, &
    758                           KIND=fftkind) + cc
     752                          KIND=wp) + cc
    759753                     cj = CMPLX(REAL(ckm) * s2,  AIMAG(ckm) * s2,  &
    760                           KIND=fftkind) - &
     754                          KIND=wp) - &
    761755                          CMPLX(REAL(cjm) * s72, AIMAG(cjm) * s72, &
    762                           KIND=fftkind)
    763                      array(k2) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
    764                      array(k3) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
     756                          KIND=wp)
     757                     array(k2) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=wp)
     758                     array(k3) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=wp)
    765759                     kk = k4 + kspan
    766760                     IF (kk >= nn) EXIT
    … …  
    776770                  c1 = COS(s1)
    777771                  s1 = SIN(s1)
    778                   cosine (jf) = 1.0_fftkind
    779                   sine (jf) = 0.0_fftkind
     772                  cosine (jf) = 1.0_wp
     773                  sine (jf) = 0.0_wp
    780774                  j = 1
    781775                  DO
    … …  
    816810                        jj = j
    817811                        ck = cc
    818                         cj = (0.0_fftkind, 0.0_fftkind)
     812                        cj = (0.0_wp, 0.0_wp)
    819813                        k = 1
    820814                        DO
    … …  
    822816                           ck = ck + CMPLX( &
    823817                                REAL (ctmp(k)) * cosine(jj), &
    824                                 AIMAG(ctmp(k)) * cosine(jj), KIND=fftkind)
     818                                AIMAG(ctmp(k)) * cosine(jj), KIND=wp)
    825819                           k = k + 1
    826820                           cj = cj + CMPLX( &
    827821                                REAL (ctmp(k)) * sine(jj), &
    828                                 AIMAG(ctmp(k)) * sine(jj), KIND=fftkind)
     822                                AIMAG(ctmp(k)) * sine(jj), KIND=wp)
    829823                           jj = jj + j
    830824                           IF (jj > jf) jj = jj - jf
    … …  
    833827                        k = jf - j
    834828                        array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), &
    835                              KIND=fftkind)
     829                             KIND=wp)
    836830                        array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), &
    837                              KIND=fftkind)
     831                             KIND=wp)
    838832                        j = j + 1
    839833                        IF (j >= k) EXIT
    … …  
    852846            kk = jc + 1
    853847            DO
    854                c2 = 1.0_fftkind - cd
     848               c2 = 1.0_wp - cd
    855849               s1 = sd
    856850               DO
    … …  
    860854                  DO
    861855                     DO
    862                         array(kk) = CMPLX(c2, s2, KIND=fftkind) * array(kk)
     856                        array(kk) = CMPLX(c2, s2, KIND=wp) * array(kk)
    863857                        kk = kk + ispan
    864858                        IF (kk > nt) EXIT
    … …  
    872866                  c2 = c1 - (cd * c1 + sd * s1)
    873867                  s1 = s1 + sd * c1 - cd * s1
    874                   c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
     868                  c1 = 2.0_wp - (c2 * c2 + s1 * s1)
    875869                  s1 = s1 * c1
    876870                  c2 = c2 * c1
    … …  
    892886!
    893887!--   Formal parameters
    894       COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
    895       INTEGER,                        INTENT(IN)    :: ntotal, npass, nspan
    896       INTEGER,          DIMENSION(*), INTENT(IN OUT):: factor
    897       INTEGER,                        INTENT(IN)    :: nfactor, nsquare
    898       INTEGER,                        INTENT(IN)    :: maxfactor
    899       COMPLEX(fftkind), DIMENSION(*), INTENT(OUT)   :: ctmp
    900       INTEGER,          DIMENSION(*), INTENT(OUT)   :: perm
     888      COMPLEX(wp), DIMENSION(*), INTENT(IN OUT):: array
     889      COMPLEX(wp),  DIMENSION(*), INTENT(OUT)   :: ctmp
     890      INTEGER(iwp),               INTENT(IN)    :: ntotal, npass, nspan
     891      INTEGER(iwp), DIMENSION(*), INTENT(IN OUT):: factor
     892      INTEGER(iwp),               INTENT(IN)    :: nfactor, nsquare
     893      INTEGER(iwp),               INTENT(IN)    :: maxfactor
     894      INTEGER(iwp), DIMENSION(*), INTENT(OUT)   :: perm
    901895!
    902896!--   Local scalars
    903       INTEGER         :: ii, ispan
    904       INTEGER         :: j, jc, jj
    905       INTEGER         :: k, kk, kspan, kt, k1, k2, k3
    906       INTEGER         :: nn, nt
    907       COMPLEX(fftkind):: ck
    908 
     897      COMPLEX(wp) :: ck
     898      INTEGER(iwp):: ii, ispan
     899      INTEGER(iwp):: j, jc, jj
     900      INTEGER(iwp):: k, kk, kspan, kt, k1, k2, k3
     901      INTEGER(iwp):: nn, nt
    909902!
    910903!--   Permute the results to normal order---done in two stages

  • palm/trunk/SOURCE/sor.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:
    … …  
    2834! 1036 2012-10-22 13:43:42Z raasch
    2935! code put under GPL (PALM 3.9)
    30 !
    31 ! 707 2011-03-29 11:39:40Z raasch
    32 ! bc_lr/ns replaced by bc_lr/ns_cyc
    33 !
    34 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    35 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.
    36 ! Call of exchange_horiz are modified.
    37 ! bug removed in declaration of ddzw(), nz replaced by nzt+1
    38 !
    39 ! 75 2007-03-22 09:54:05Z raasch
    40 ! 2nd+3rd argument removed from exchange horiz
    41 !
    42 ! RCS Log replace by Id keyword, revision history cleaned up
    43 !
    44 ! Revision 1.9  2005/03/26 21:02:23  raasch
    45 ! Implementation of non-cyclic (Neumann) horizontal boundary conditions,
    46 ! dx2,dy2 replaced by ddx2,ddy2
    4736!
    4837! Revision 1.1  1997/08/11 06:25:56  raasch
    … …  
    5544!------------------------------------------------------------------------------!
    5645
    57     USE grid_variables
    58     USE indices
    59     USE pegrid
    60     USE control_parameters
     46    USE grid_variables,                                                        &
     47        ONLY:  ddx2, ddy2
     48
     49    USE indices,                                                               &
     50        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nz, nzb, nzt
     51
     52    USE kinds
     53
     54    USE control_parameters,                                                    &
     55        ONLY:  bc_lr_cyc, bc_ns_cyc, ibc_p_b, ibc_p_t, inflow_l, inflow_n,     &
     56               inflow_r, inflow_s, n_sor, omega_sor, outflow_l, outflow_n,     &
     57               outflow_r, outflow_s
    6158
    6259    IMPLICIT NONE
    6360
    64     INTEGER ::  i, j, k, n, nxl1, nxl2, nys1, nys2
    65     REAL    ::  ddzu(1:nz+1), ddzw(1:nzt+1)
    66     REAL    ::  d(nzb+1:nzt,nys:nyn,nxl:nxr),         &
    67                 p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
    68     REAL, DIMENSION(:), ALLOCATABLE ::  f1, f2, f3
     61    INTEGER(iwp) ::  i              !:
     62    INTEGER(iwp) ::  j              !:
     63    INTEGER(iwp) ::  k              !:
     64    INTEGER(iwp) ::  n              !:
     65    INTEGER(iwp) ::  nxl1           !:
     66    INTEGER(iwp) ::  nxl2           !:
     67    INTEGER(iwp) ::  nys1           !:
     68    INTEGER(iwp) ::  nys2           !:
     69
     70    REAL(wp)     ::  ddzu(1:nz+1)   !:
     71    REAL(wp)     ::  ddzw(1:nzt+1)  !:
     72
     73    REAL(wp)     ::  d(nzb+1:nzt,nys:nyn,nxl:nxr)      !:
     74    REAL(wp)     ::  p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !:
     75
     76    REAL(wp), DIMENSION(:), ALLOCATABLE ::  f1         !:
     77    REAL(wp), DIMENSION(:), ALLOCATABLE ::  f2         !:
     78    REAL(wp), DIMENSION(:), ALLOCATABLE ::  f3         !:
    6979
    7080    ALLOCATE( f1(1:nz), f2(1:nz), f3(1:nz) )

  • palm/trunk/SOURCE/subsidence.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
     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
    2229!
    2330! Former revisions:
    … …  
    2734! 1036 2012-10-22 13:43:42Z raasch
    2835! code put under GPL (PALM 3.9)
    29 !
    30 ! 671 2011-01-11 12:04:00Z heinze $
    31 ! bugfix: access to ddzu(nzt+2) which is not defined
    32 !
    33 ! 667 2010-12-23 12:06:00Z suehring
    34 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    35 !
    36 ! 580 2010-10-05 13:59:11Z heinze
    37 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,
    38 ! ws_vertical_gradient_level to subs_vertical_gradient_level and
    39 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i
    4036!
    4137! Revision 3.7 2009-12-11 14:15:58Z heinze
    … …  
    6864    SUBROUTINE init_w_subsidence
    6965
    70        USE arrays_3d
    71        USE control_parameters
    72        USE grid_variables
    73        USE indices
    74        USE pegrid
    75        USE statistics
     66       USE arrays_3d,                                                          &
     67           ONLY:  dzu, w_subs, zu
     68
     69       USE control_parameters,                                                 &
     70           ONLY:  message_string, ocean, subs_vertical_gradient,               &
     71                  subs_vertical_gradient_level, subs_vertical_gradient_level_i
     72
     73       USE indices,                                                            &
     74           ONLY:  nzb, nzt
     75
     76       USE kinds
    7677
    7778       IMPLICIT NONE
    7879
    79        INTEGER :: i, k
    80        REAL    :: gradient, ws_surface
     80       INTEGER(iwp) ::  i !:
     81       INTEGER(iwp) ::  k !:
     82
     83       REAL(wp)     ::  gradient   !:
     84       REAL(wp)     ::  ws_surface !:
    8185
    8286       IF ( .NOT. ALLOCATED( w_subs )) THEN
    … …  
    132136    SUBROUTINE subsidence( tendency, var, var_init )
    133137
    134        USE arrays_3d
    135        USE control_parameters
    136        USE grid_variables
    137        USE indices
    138        USE pegrid
    139        USE statistics
     138       USE arrays_3d,                                                          &
     139           ONLY:  ddzu, w_subs
     140
     141       USE control_parameters,                                                 &
     142           ONLY:  dt_3d
     143
     144       USE indices,                                                            &
     145           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
     146                  nzt
     147
     148       USE kinds
    140149
    141150       IMPLICIT NONE
    142151 
    143        INTEGER :: i, j, k
    144 
    145        REAL :: tmp_grad
     152       INTEGER(iwp) ::  i !:
     153       INTEGER(iwp) ::  j !:
     154       INTEGER(iwp) ::  k !:
     155
     156       REAL(wp)     ::  tmp_grad !:
    146157   
    147        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var, tendency
    148        REAL, DIMENSION(nzb:nzt+1) :: var_init, var_mod
     158       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
     159       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
     160       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
     161       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
    149162
    150163       var_mod = var_init
    … …  
    208221 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init )
    209222
    210        USE arrays_3d
    211        USE control_parameters
    212        USE grid_variables
    213        USE indices
    214        USE pegrid
    215        USE statistics
     223       USE arrays_3d,                                                          &
     224           ONLY:  ddzu, w_subs
     225
     226       USE control_parameters,                                                 &
     227           ONLY:  dt_3d
     228
     229       USE indices,                                                            &
     230           ONLY:  nxl, nxlg, nxrg, nyng, nys, nysg, nzb_s_inner, nzb, nzt
     231
     232       USE kinds
    216233
    217234       IMPLICIT NONE
    218235 
    219        INTEGER :: i, j, k
    220 
    221        REAL :: tmp_grad
     236       INTEGER(iwp) ::  i !:
     237       INTEGER(iwp) ::  j !:
     238       INTEGER(iwp) ::  k !:
     239
     240       REAL(wp)     ::  tmp_grad !:
    222241   
    223        REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var, tendency
    224        REAL, DIMENSION(nzb:nzt+1) :: var_init, var_mod
     242       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
     243       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
     244       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
     245       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
    225246
    226247       var_mod = var_init

  • palm/trunk/SOURCE/sum_up_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! 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:
    … …  
    4450! 978 2012-08-09 08:28:32Z fricke
    4551! +z0h*
    46 !
    47 ! 790 2011-11-29 03:11:20Z raasch
    48 ! bugfix: calculation of 'pr' must depend on the particle weighting factor
    49 !
    50 ! 771 2011-10-27 10:56:21Z heinze
    51 ! +lpt_av
    52 !
    53 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    54 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    55 !
    56 ! 402 2009-10-21 11:59:41Z maronga
    57 ! Bugfix in calculation of shf*_av, qsws*_av
    58 !
    59 ! 2009-08-25 08:35:52Z maronga
    60 ! +shf*, qsws*
    61 !
    62 ! 96 2007-06-04 08:07:41Z raasch
    63 ! +sum-up of density and salinity
    64 !
    65 ! 72 2007-03-19 08:20:46Z raasch
    66 ! +sum-up of precipitation rate and roughness length (prr*, z0*)
    67 !
    68 ! RCS Log replace by Id keyword, revision history cleaned up
    6952!
    7053! Revision 1.1  2006/02/23 12:55:23  raasch
    … …  
    7861!------------------------------------------------------------------------------!
    7962
    80     USE arrays_3d
    81     USE averaging
    82     USE cloud_parameters
    83     USE control_parameters
    84     USE cpulog
    85     USE indices
    86     USE particle_attributes
     63    USE arrays_3d,                                                             &
     64        ONLY:  dzw, e, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, qsws, rho, sa,    &
     65               shf, ts, u, us, v, vpt, w, z0, z0h
     66
     67    USE averaging,                                                             &
     68        ONLY:  e_av, lpt_av, lwp_av, nr_av, p_av, pc_av, pr_av, prr_av,        &
     69               precipitation_rate_av, pt_av, q_av, qc_av, ql_av, ql_c_av,      &
     70               ql_v_av, ql_vp_av, qr_av, qsws_av, qv_av, rho_av, s_av, sa_av,  &
     71               shf_av, ts_av, u_av, us_av, v_av, vpt_av, w_av, z0_av, z0h_av
     72
     73    USE cloud_parameters,                                                      &
     74        ONLY:  l_d_cp, precipitation_rate, pt_d_t
     75
     76    USE control_parameters,                                                    &
     77        ONLY:  average_count_3d, cloud_physics, doav, doav_n
     78
     79    USE cpulog,                                                                &
     80        ONLY:  cpu_log, log_point
     81
     82    USE indices,                                                               &
     83        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     84
     85    USE kinds
     86
     87    USE particle_attributes,                                                   &
     88        ONLY:  particles, prt_count, prt_start_index
    8789
    8890    IMPLICIT NONE
    8991
    90     INTEGER ::  i, ii, j, k, n, psi
    91 
    92     REAL    ::  mean_r, s_r3, s_r4
    93 
     92    INTEGER(iwp) ::  i   !:
     93    INTEGER(iwp) ::  ii  !:
     94    INTEGER(iwp) ::  j   !:
     95    INTEGER(iwp) ::  k   !:
     96    INTEGER(iwp) ::  n   !:
     97    INTEGER(iwp) ::  psi !:
     98
     99    REAL(wp)     ::  mean_r !:
     100    REAL(wp)     ::  s_r3   !:
     101    REAL(wp)     ::  s_r4   !:
    94102
    95103    CALL cpu_log (log_point(34),'sum_up_3d_data','start')

  • palm/trunk/SOURCE/surface_coupler.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! 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:
    … …  
    3743! 880 2012-04-13 06:28:59Z raasch
    3844! Bugfix: preprocessor statements for parallel execution added
    39 !
    40 ! 709 2011-03-30 09:31:40Z raasch
    41 ! formatting adjustments
    42 !
    43 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    44 ! Additional case for nonequivalent processor and grid topopolgy in ocean and
    45 ! atmosphere added (coupling_topology = 1).
    46 ! Added exchange of u and v from Ocean to Atmosphere
    47 !
    48 ! 291 2009-04-16 12:07:26Z raasch
    49 ! Coupling with independent precursor runs.
    50 ! Output of messages replaced by message handling routine.
    51 !
    52 ! 206 2008-10-13 14:59:11Z raasch
    53 ! Implementation of a MPI-1 Coupling: replaced myid with target_id,
    54 ! deleted __mpi2 directives
    5545!
    5646! 109 2007-08-28 15:26:47Z letzel
    … …  
    6252!------------------------------------------------------------------------------!
    6353
    64     USE arrays_3d
    65     USE control_parameters
    66     USE cpulog
    67     USE grid_variables
    68     USE indices
     54    USE arrays_3d,                                                             &
     55        ONLY:  pt, shf, qsws, qswst_remote, rho, sa, saswst, total_2d_a,       &
     56               total_2d_o, tswst, u, usws, uswst, v, vsws, vswst
     57
     58    USE control_parameters,                                                    &
     59        ONLY:  coupling_mode, coupling_mode_remote, coupling_topology,         &
     60               humidity, humidity_remote, message_string, terminate_coupled,   &
     61               terminate_coupled_remote, time_since_reference_point
     62
     63    USE cpulog,                                                                &
     64        ONLY:  cpu_log, log_point
     65
     66    USE indices,                                                               &
     67        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nx_a, nx_o, ny, nyn, nyng, nys, &
     68               nysg, ny_a, ny_o, nzt
     69
     70    USE kinds
     71
    6972    USE pegrid
    7073
    7174    IMPLICIT NONE
    7275
    73     REAL    ::  time_since_reference_point_rem
    74     REAL    ::  total_2d(-nbgp:ny+nbgp,-nbgp:nx+nbgp)
     76    REAL(wp)    ::  time_since_reference_point_rem        !:
     77    REAL(wp)    ::  total_2d(-nbgp:ny+nbgp,-nbgp:nx+nbgp) !:
    7578
    7679#if defined( __parallel )
    … …  
    418421#if defined( __parallel )
    419422
    420     USE arrays_3d
    421     USE control_parameters
    422     USE grid_variables
    423     USE indices
    424     USE pegrid
     423    USE arrays_3d,                                                             &
     424        ONLY:  total_2d_a, total_2d_o
     425
     426    USE indices,                                                               &
     427        ONLY:  nbgp, nx, nx_a, nx_o, ny, ny_a, ny_o
     428
     429    USE kinds
     430
     431    USE pegrid,                                                                &
     432        ONLY:  comm2d, comm_inter, ierr, MPI_DOUBLE_PRECISION, myid, ngp_a,    &
     433               target_id
    425434
    426435    IMPLICIT NONE
    427436
    428     INTEGER             ::  dnx, dnx2, dny, dny2, i, ii, j, jj
    429     INTEGER, intent(in) ::  tag
     437    INTEGER(iwp) ::  dnx  !:
     438    INTEGER(iwp) ::  dnx2 !:
     439    INTEGER(iwp) ::  dny  !:
     440    INTEGER(iwp) ::  dny2 !:
     441    INTEGER(iwp) ::  i    !:
     442    INTEGER(iwp) ::  ii   !:
     443    INTEGER(iwp) ::  j    !:
     444    INTEGER(iwp) ::  jj   !:
     445
     446    INTEGER(iwp), intent(in) ::  tag !:
    430447
    431448    CALL MPI_BARRIER( comm2d, ierr )
    … …  
    490507#if defined( __parallel )
    491508
    492     USE arrays_3d
    493     USE control_parameters
    494     USE grid_variables
    495     USE indices
    496     USE pegrid
     509    USE arrays_3d,                                                             &
     510        ONLY:  total_2d_a, total_2d_o
     511
     512    USE indices,                                                               &
     513        ONLY:  nbgp, nx, nx_a, nx_o, ny, ny_a, ny_o
     514
     515    USE kinds
     516
     517    USE pegrid,                                                                &
     518        ONLY:  comm2d, comm_inter, ierr, MPI_DOUBLE_PRECISION, myid, ngp_o,    &
     519               target_id
    497520
    498521    IMPLICIT NONE
    499522
    500     INTEGER             ::  dnx, dny, i, ii, j, jj
    501     INTEGER, intent(in) ::  tag
    502     REAL                ::  fl, fr, myl, myr
    503 
     523    INTEGER(iwp)             ::  dnx !:
     524    INTEGER(iwp)             ::  dny !:
     525    INTEGER(iwp)             ::  i   !:
     526    INTEGER(iwp)             ::  ii  !:
     527    INTEGER(iwp)             ::  j   !:
     528    INTEGER(iwp)             ::  jj  !:
     529    INTEGER(iwp), intent(in) ::  tag !:
     530
     531    REAL(wp)                 ::  fl  !:
     532    REAL(wp)                 ::  fr  !:
     533    REAL(wp)                 ::  myl !:
     534    REAL(wp)                 ::  myr !:
    504535
    505536    CALL MPI_BARRIER( comm2d, ierr )

  • palm/trunk/SOURCE/swap_timelevel.f90

    r1319 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! ONLY-attribute added to USE-statements,
     23! revision history before 2012 removed,
    2324!
    2425! Former revisions:
    … …  
    5051! all actions concerning leapfrog scheme removed
    5152!
    52 ! 102 2007-07-27 09:09:17Z raasch
    53 ! swaping of uswst, vswst included
    54 !
    55 ! 95 2007-06-02 16:48:38Z raasch
    56 ! Swaping of salinity
    57 !
    58 ! 75 2007-03-22 09:54:05Z raasch
    59 ! moisture renamed humidity
    60 !
    61 ! 19 2007-02-23 04:53:48Z raasch
    62 ! Swaping of top fluxes
    63 !
    64 ! RCS Log replace by Id keyword, revision history cleaned up
    65 !
    66 ! Revision 1.8  2004/01/28 15:28:18  raasch
    67 ! Swaping for Runge-Kutta schemes implemented
    68 !
    6953! Revision 1.1  2000/01/10  10:08:58  10:08:58  raasch (Siegfried Raasch)
    7054! Initial revision
    … …  
    7660!------------------------------------------------------------------------------!
    7761
    78     USE arrays_3d
    79     USE cpulog
    80     USE control_parameters
     62    USE arrays_3d,                                                             &
     63        ONLY:  e, e_1, e_2, e_p, nr, nr_1, nr_2, nr_p, pt, pt_1, pt_2, pt_p, q,&
     64               q_1, q_2, q_p, qr, qr_1, qr_2, qr_p, sa, sa_1, sa_2, sa_p, u,   &
     65               u_1, u_2, u_p, v, v_1, v_2, v_p, w, w_1, w_2, w_p
     66
     67    USE cpulog,                                                                &
     68        ONLY: cpu_log, log_point
     69
     70    USE control_parameters,                                                    &
     71        ONLY:  cloud_physics, constant_diffusion, humidity, icloud_scheme,     &
     72               neutral, ocean, passive_scalar, precipitation, timestep_count
    8173
    8274    IMPLICIT NONE

  • palm/trunk/SOURCE/temperton_fft.f90

    r392 r1320  
    44! Current revisions:
    55! -----------------
    6 !
     6! ONLY-attribute added to USE-statements,
     7! kind-parameters added to all INTEGER and REAL declaration statements,
     8! kinds are defined in new module kinds,
     9! old module precision_kind is removed,
     10! revision history before 2012 removed,
     11! comment fields (!:) to be used for variable explanations added to
     12! all variable declaration statements
    713!
    814! Former revisions:
    915! -----------------
    1016! $Id$
    11 !
    12 ! 258 2009-03-13 12:36:03Z heinze
    13 ! Output of messages replaced by message handling routine.
    14 !
    15 ! Feb. 2007
    16 ! RCS Log replace by Id keyword, revision history cleaned up
    17 !
    18 ! Revision 1.2  2003/04/16 12:49:25  raasch
    19 ! Abort in case of illegal factors
    2017!
    2118! Revision 1.1  2003/03/12 16:41:59  raasch
    … …  
    2825!------------------------------------------------------------------------------!
    2926
     27    USE kinds
     28
    3029    IMPLICIT NONE
    3130
    … …  
    3534
    3635
    37     INTEGER           ::  nfax(10)   ! array used by *fft991*.
    38     REAL, ALLOCATABLE ::  trig(:)    ! array used by *fft991*.
     36    INTEGER(iwp)          ::  nfax(10)   !: array used by *fft991*.
     37    REAL(wp), ALLOCATABLE ::  trig(:)    !: array used by *fft991*.
    3938
    4039!
    4140!-- nfft: maximum length of calls to *fft.
    4241#if defined( __nec )
    43     INTEGER, PARAMETER ::  nfft = 256
     42    INTEGER(iwp), PARAMETER ::  nfft = 256  !:
    4443#else
    45     INTEGER, PARAMETER ::  nfft =  32
     44    INTEGER(iwp), PARAMETER ::  nfft =  32  !:
    4645#endif
    4746
    48     INTEGER, PARAMETER ::  nout =   6  ! standard output stream
     47    INTEGER(iwp), PARAMETER ::  nout =   6  !: standard output stream
    4948
    5049CONTAINS
    … …  
    9998    ! dimension a(n),work(n),trigs(n),ifax(1)
    10099
     100    USE kinds
    101101
    102102    IMPLICIT NONE
    103103
    104104    !  Scalar arguments
    105     INTEGER :: inc, isign, jump, lot, n
     105    INTEGER(iwp) ::  inc   !:
     106    INTEGER(iwp) ::  isign !:
     107    INTEGER(iwp) ::  jump  !:
     108    INTEGER(iwp) ::  lot   !:
     109    INTEGER(iwp) ::  n     !:
    106110
    107111    !  Array arguments
    108     REAL :: a(*), trigs(*), work(*)
    109     INTEGER :: ifax(*)
     112    REAL(wp)     ::  a(*)     !:
     113    REAL(wp)     ::  trigs(*) !:
     114    REAL(wp)     ::  work(*)  !:
     115    INTEGER(iwp) ::  ifax(*)  !:
    110116
    111117    !  Local scalars:
    112     INTEGER :: i, ia, ibase, ierr, ifac, igo, ii, istart, ix, iz, j, jbase, jj, &
    113          &      k, la, nb, nblox, nfax, nvex, nx
     118    INTEGER(iwp) ::  i      !:
     119    INTEGER(iwp) ::  ia     !:
     120    INTEGER(iwp) ::  ibase  !:
     121    INTEGER(iwp) ::  ierr   !:
     122    INTEGER(iwp) ::  ifac   !:
     123    INTEGER(iwp) ::  igo    !:
     124    INTEGER(iwp) ::  ii     !:
     125    INTEGER(iwp) ::  istart !:
     126    INTEGER(iwp) ::  ix     !:
     127    INTEGER(iwp) ::  iz     !:
     128    INTEGER(iwp) ::  j      !:
     129    INTEGER(iwp) ::  jbase  !:
     130    INTEGER(iwp) ::  jj     !:
     131    INTEGER(iwp) ::  k      !:
     132    INTEGER(iwp) ::  la     !:
     133    INTEGER(iwp) ::  nb     !:
     134    INTEGER(iwp) ::  nblox  !:
     135    INTEGER(iwp) ::  nfax   !:
     136    INTEGER(iwp) ::  nvex   !:
     137    INTEGER(iwp) ::  nx     !:
    114138
    115139    !  Intrinsic functions
    116     INTRINSIC MOD
     140!    INTRINSIC MOD
    117141
    118142
    … …  
    316340    !
    317341
    318     IMPLICIT NONE
     342    USE kinds
     343
     344    IMPLICIT NONE
    319345
    320346    !  Scalar arguments
    321     INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
     347    INTEGER(iwp) ::  ierr !:
     348    INTEGER(iwp) ::  ifac !:
     349    INTEGER(iwp) ::  inc1 !:
     350    INTEGER(iwp) ::  inc2 !:
     351    INTEGER(iwp) ::  inc3 !:
     352    INTEGER(iwp) ::  inc4 !:
     353    INTEGER(iwp) ::  la   !:
     354    INTEGER(iwp) ::  lot  !:
     355    INTEGER(iwp) ::  n    !:
    322356
    323357    !  Array arguments
    324358    ! REAL :: a(n),b(n),c(n),d(n),trigs(n)
    325     REAL :: a(*), b(*), c(*), d(*), trigs(*)
    326 
     359    REAL(wp) ::  a(*)     !:
     360    REAL(wp) ::  b(*)     !:
     361    REAL(wp) ::  c(*)     !:
     362    REAL(wp) ::  d(*)     !:
     363    REAL(wp) ::  trigs(*) !:
     364 
    327365    !  Local scalars:
    328     REAL :: a0, a1, a10, a11, a2, a20, a21, a3, a4, a5, a6, b0, b1, b10, b11, &
    329          &      b2, b20, b21, b3, b4, b5, b6, c1, c2, c3, c4, c5, qrt5, s1, s2, s3, s4, &
    330          &      s5, sin36, sin45, sin60, sin72, z, zqrt5, zsin36, zsin45, zsin60, &
    331          &      zsin72
    332     INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, ig, igo, ih, iink, ijk, &
    333          &      ijump, j, ja, jb, jbase, jc, jd, je, jf, jink, k, kb, kc, kd, ke, kf, &
    334          &      kstop, l, m
     366    REAL(wp) ::  a0     !:
     367    REAL(wp) ::  a1     !:
     368    REAL(wp) ::  a10    !:
     369    REAL(wp) ::  a11    !:
     370    REAL(wp) ::  a2     !:
     371    REAL(wp) ::  a20    !:
     372    REAL(wp) ::  a21    !:
     373    REAL(wp) ::  a3     !:
     374    REAL(wp) ::  a4     !:
     375    REAL(wp) ::  a5     !:
     376    REAL(wp) ::  a6     !:
     377    REAL(wp) ::  b0     !:
     378    REAL(wp) ::  b1     !:
     379    REAL(wp) ::  b10    !:
     380    REAL(wp) ::  b11    !:
     381    REAL(wp) ::  b2     !:
     382    REAL(wp) ::  b20    !:
     383    REAL(wp) ::  b21    !:
     384    REAL(wp) ::  b3     !:
     385    REAL(wp) ::  b4     !:
     386    REAL(wp) ::  b5     !:
     387    REAL(wp) ::  b6     !:
     388    REAL(wp) ::  c1     !:
     389    REAL(wp) ::  c2     !:
     390    REAL(wp) ::  c3     !:
     391    REAL(wp) ::  c4     !:
     392    REAL(wp) ::  c5     !:
     393    REAL(wp) ::  qrt5   !:
     394    REAL(wp) ::  s1     !:
     395    REAL(wp) ::  s2     !:
     396    REAL(wp) ::  s3     !:
     397    REAL(wp) ::  s4     !:
     398    REAL(wp) ::  s5     !:
     399    REAL(wp) ::  sin36  !:
     400    REAL(wp) ::  sin45  !:
     401    REAL(wp) ::  sin60  !:
     402    REAL(wp) ::  sin72  !:
     403    REAL(wp) ::  z      !:
     404    REAL(wp) ::  zqrt5  !:
     405    REAL(wp) ::  zsin36 !:
     406    REAL(wp) ::  zsin45 !:
     407    REAL(wp) ::  zsin60 !:
     408    REAL(wp) ::  zsin72 !:
     409
     410    INTEGER(iwp) ::  i     !:
     411    INTEGER(iwp) ::  ia    !:
     412    INTEGER(iwp) ::  ib    !:
     413    INTEGER(iwp) ::  ibad  !:
     414    INTEGER(iwp) ::  ibase !:
     415    INTEGER(iwp) ::  ic    !:
     416    INTEGER(iwp) ::  id    !:
     417    INTEGER(iwp) ::  ie    !:
     418    INTEGER(iwp) ::  if    !:
     419    INTEGER(iwp) ::  ig    !:
     420    INTEGER(iwp) ::  igo   !:
     421    INTEGER(iwp) ::  ih    !:
     422    INTEGER(iwp) ::  iink  !:
     423    INTEGER(iwp) ::  ijk   !:
     424    INTEGER(iwp) ::  ijump !:
     425    INTEGER(iwp) ::  j     !:
     426    INTEGER(iwp) ::  ja    !:
     427    INTEGER(iwp) ::  jb    !:
     428    INTEGER(iwp) ::  jbase !:
     429    INTEGER(iwp) ::  jc    !:
     430    INTEGER(iwp) ::  jd    !:
     431    INTEGER(iwp) ::  je    !:
     432    INTEGER(iwp) ::  jf    !:
     433    INTEGER(iwp) ::  jink  !:
     434    INTEGER(iwp) ::  k     !:
     435    INTEGER(iwp) ::  kb    !:
     436    INTEGER(iwp) ::  kc    !:
     437    INTEGER(iwp) ::  kd    !:
     438    INTEGER(iwp) ::  ke    !:
     439    INTEGER(iwp) ::  kf    !:
     440    INTEGER(iwp) ::  kstop !:
     441    INTEGER(iwp) ::  l     !:
     442    INTEGER(iwp) ::  m     !:
    335443
    336444    !  Intrinsic functions
    337     INTRINSIC REAL, SQRT
     445!    INTRINSIC REAL, SQRT
    338446
    339447    !  Data statements
    340     DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
    341          &      qrt5/0.559016994374947/, sin60/0.866025403784437/
     448    DATA sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/, &
     449         &      qrt5/0.559016994374947_wp/, sin60/0.866025403784437_wp/
    342450
    343451
    … …  
    438546    GO TO 170
    43954730  CONTINUE
    440     z = 1.0/REAL(n)
     548    z = 1.0_wp/REAL(n)
    441549    DO l = 1, la
    442550       i = ibase
    … …  
    551659    GO TO 170
    55266060  CONTINUE
    553     z = 1.0/REAL(n)
     661    z = 1.0_wp/REAL(n)
    554662    zsin60 = z*sin60
    555663    DO l = 1, la
    … …  
    658766    IF (jb>jc) GO TO 170
    65976780  CONTINUE
    660     sin45 = SQRT(0.5)
     768    sin45 = SQRT(0.5_wp)
    661769    jbase = 0
    662770    DO l = 1, la
    … …  
    680788    GO TO 170
    68178990  CONTINUE
    682     z = 1.0/REAL(n)
     790    z = 1.0_wp/REAL(n)
    683791    DO l = 1, la
    684792       i = ibase
    … …  
    843951    GO TO 170
    844952120 CONTINUE
    845     z = 1.0/REAL(n)
     953    z = 1.0_wp/REAL(n)
    846954    zqrt5 = z*qrt5
    847955    zsin36 = z*sin36
    … …  
    10191127    GO TO 170
    10201128150 CONTINUE
    1021     z = 1.0/REAL(n)
     1129    z = 1.0_wp/REAL(n)
    10221130    zsin60 = z*sin60
    10231131    DO l = 1, la
    … …  
    10621170    jd = jc + 2*m*inc2
    10631171    je = jd + 2*m*inc2
    1064     z = 1.0/REAL(n)
     1172    z = 1.0_wp/REAL(n)
    10651173    zsin45 = z*SQRT(0.5)
    10661174
    … …  
    11051213    ! Dimension a(n),b(n),c(n),d(n),trigs(n)
    11061214
     1215    USE kinds
     1216
    11071217    IMPLICIT NONE
    11081218
    11091219    !  Scalar arguments
    1110     INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
     1220    INTEGER(iwp) ::  ierr !:
     1221    INTEGER(iwp) ::  ifac !:
     1222    INTEGER(iwp) ::  inc1 !:
     1223    INTEGER(iwp) ::  inc2 !:
     1224    INTEGER(iwp) ::  inc3 !:
     1225    INTEGER(iwp) ::  inc4 !:
     1226    INTEGER(iwp) ::  la   !:
     1227    INTEGER(iwp) ::  lot  !:
     1228    INTEGER(iwp) ::  n    !:
    11111229
    11121230    !  Array arguments
    1113     REAL :: a(*), b(*), c(*), d(*), trigs(*)
     1231    REAL(wp) ::  a(*)     !:
     1232    REAL(wp) ::  b(*)     !:
     1233    REAL(wp) ::  c(*)     !:
     1234    REAL(wp) ::  d(*)     !:
     1235    REAL(wp) ::  trigs(*) !:
    11141236
    11151237    !  Local scalars:
    1116     REAL :: c1, c2, c3, c4, c5, qqrt5, qrt5, s1, s2, s3, s4, s5, sin36, sin45, &
    1117          &      sin60, sin72, ssin36, ssin45, ssin60, ssin72
    1118     INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, igo, iink, ijk, j, ja, &
    1119          &      jb, jbase, jc, jd, je, jf, jg, jh, jink, jump, k, kb, kc, kd, ke, kf, &
    1120          &      kstop, l, m
     1238    REAL(wp) ::  c1     !:
     1239    REAL(wp) ::  c2     !:
     1240    REAL(wp) ::  c3     !:
     1241    REAL(wp) ::  c4     !:
     1242    REAL(wp) ::  c5     !:
     1243    REAL(wp) ::  qqrt5  !:
     1244    REAL(wp) ::  qrt5   !:
     1245    REAL(wp) ::  s1     !:
     1246    REAL(wp) ::  s2     !:
     1247    REAL(wp) ::  s3     !:
     1248    REAL(wp) ::  s4     !:
     1249    REAL(wp) ::  s5     !:
     1250    REAL(wp) ::  sin36  !:
     1251    REAL(wp) ::  sin45  !:
     1252    REAL(wp) ::  sin60  !:
     1253    REAL(wp) ::  sin72  !:
     1254    REAL(wp) ::  ssin36 !:
     1255    REAL(wp) ::  ssin45 !:
     1256    REAL(wp) ::  ssin60 !:
     1257    REAL(wp) ::  ssin72 !:
     1258
     1259    INTEGER(iwp) ::  i     !:
     1260    INTEGER(iwp) ::  ia    !:
     1261    INTEGER(iwp) ::  ib    !:
     1262    INTEGER(iwp) ::  ibad  !:
     1263    INTEGER(iwp) ::  ibase !:
     1264    INTEGER(iwp) ::  ic    !:
     1265    INTEGER(iwp) ::  id    !:
     1266    INTEGER(iwp) ::  ie    !:
     1267    INTEGER(iwp) ::  if    !:
     1268    INTEGER(iwp) ::  igo   !:
     1269    INTEGER(iwp) ::  iink  !:
     1270    INTEGER(iwp) ::  ijk   !:
     1271    INTEGER(iwp) ::  j     !:
     1272    INTEGER(iwp) ::  ja    !:
     1273    INTEGER(iwp) ::  jb    !:
     1274    INTEGER(iwp) ::  jbase !:
     1275    INTEGER(iwp) ::  jc    !:
     1276    INTEGER(iwp) ::  jd    !:
     1277    INTEGER(iwp) ::  je    !:
     1278    INTEGER(iwp) ::  jf    !:
     1279    INTEGER(iwp) ::  jg    !:
     1280    INTEGER(iwp) ::  jh    !:
     1281    INTEGER(iwp) ::  jink  !:
     1282    INTEGER(iwp) ::  jump  !:
     1283    INTEGER(iwp) ::  k     !:
     1284    INTEGER(iwp) ::  kb    !:
     1285    INTEGER(iwp) ::  kc    !:
     1286    INTEGER(iwp) ::  kd    !:
     1287    INTEGER(iwp) ::  ke    !:
     1288    INTEGER(iwp) ::  kf    !:
     1289    INTEGER(iwp) ::  kstop !:
     1290    INTEGER(iwp) ::  l     !:
     1291    INTEGER(iwp) ::  m     !:
    11211292
    11221293    !  Local arrays:
    1123     REAL :: a10(nfft), a11(nfft), a20(nfft), a21(nfft), b10(nfft), b11(nfft), b20(nfft), &
    1124          &      b21(nfft)
     1294    REAL(wp) ::  a10(nfft) !:
     1295    REAL(wp) ::  a11(nfft) !:
     1296    REAL(wp) ::  a20(nfft) !:
     1297    REAL(wp) ::  a21(nfft) !:
     1298    REAL(wp) ::  b10(nfft) !:
     1299    REAL(wp) ::  b11(nfft) !:
     1300    REAL(wp) ::  b20(nfft) !:
     1301    REAL(wp) ::  b21(nfft) !:
    11251302
    11261303    !  Intrinsic functions
    1127     INTRINSIC SQRT
     1304!    INTRINSIC SQRT
    11281305
    11291306    !  Data statements
    1130     DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
    1131          &      qrt5/0.559016994374947/, sin60/0.866025403784437/
     1307    DATA sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/, &
     1308         &      qrt5/0.559016994374947_wp/, sin60/0.866025403784437_wp/
    11321309
    11331310
    … …  
    16221799    GO TO 170
    16231800120 CONTINUE
    1624     qqrt5 = 2.0*qrt5
    1625     ssin36 = 2.0*sin36
    1626     ssin72 = 2.0*sin72
     1801    qqrt5 = 2.0_wp*qrt5
     1802    ssin36 = 2.0_wp*sin36
     1803    ssin72 = 2.0_wp*sin72
    16271804    DO l = 1, la
    16281805       i = ibase
    … …  
    18382015    jg = jf + jink
    18392016    jh = jg + jink
    1840     ssin45 = SQRT(2.0)
     2017    ssin45 = SQRT(2.0_wp)
    18412018
    18422019    DO l = 1, la
    … …  
    18892066
    18902067
    1891     USE control_parameters
    1892     USE pegrid
     2068    USE control_parameters,                                                    &
     2069        ONLY:  message_string
     2070
     2071    USE kinds
    18932072
    18942073    IMPLICIT NONE
    18952074
    18962075    !  Scalar arguments
    1897     INTEGER :: n
     2076    INTEGER(iwp) ::  n !:
    18982077
    18992078    !  Array arguments
    1900     REAL :: trigs(*)
    1901     INTEGER :: ifax(*)
     2079    INTEGER(iwp) ::  ifax(*)  !:
     2080    REAL(wp)     ::  trigs(*) !:
     2081
    19022082
    19032083    !  Local scalars:
    1904     REAL :: angle, del
    1905     INTEGER :: i, ifac, ixxx, k, l, nfax, nhl, nil, nu
     2084    REAL(wp) ::  angle    !:
     2085    REAL(wp) ::  del      !:
     2086    INTEGER(iwp) ::  i    !:
     2087    INTEGER(iwp) ::  ifac !:
     2088    INTEGER(iwp) ::  ixxx !:
     2089    INTEGER(iwp) ::  k    !:
     2090    INTEGER(iwp) ::  l    !:
     2091    INTEGER(iwp) ::  nfax !:
     2092    INTEGER(iwp) ::  nhl  !:
     2093    INTEGER(iwp) ::  nil  !:
     2094    INTEGER(iwp) ::  nu   !:
    19062095
    19072096    !  Local arrays:
    1908     INTEGER :: jfax(10), lfax(7)
     2097    INTEGER(iwp) ::  jfax(10) !:
     2098    INTEGER(iwp) ::  lfax(7)  !:
    19092099
    19102100    !  Intrinsic functions
    1911     INTRINSIC ASIN, COS, MOD, REAL, SIN
     2101!    INTRINSIC ASIN, COS, MOD, REAL, SIN
    19122102
    19132103    !  Data statements
    … …  
    19182108    ixxx = 1
    19192109
    1920     del = 4.0*ASIN(1.0)/REAL(n)
     2110    del = 4.0_wp*ASIN(1.0_wp)/REAL(n)
    19212111    nil = 0
    19222112    nhl = (n/2) - 1

  • palm/trunk/SOURCE/time_integration.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! 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:
    … …  
    101107! wang_collision_kernel renamed wang_kernel
    102108!
    103 ! 790 2011-11-29 03:11:20Z raasch
    104 ! exchange of ghostpoints for array diss
    105 !
    106 ! 707 2011-03-29 11:39:40Z raasch
    107 ! bc_lr/ns replaced by bc_lr/ns_cyc, calls of exchange_horiz are modified,
    108 ! adaption to sloping surface
    109 !
    110 ! 667  2010-12-23 12:06:00Z suehring/gryschka
    111 ! Calls of exchange_horiz are modified.
    112 ! Adaption to slooping surface.
    113 !
    114 ! 449 2010-02-02 11:23:59Z raasch
    115 ! Bugfix: exchange of ghost points for prho included
    116 !
    117 ! 410 2009-12-04 17:05:40Z letzel
    118 ! masked data output
    119 !
    120 ! 388 2009-09-23 09:40:33Z raasch
    121 ! Using prho instead of rho in diffusvities.
    122 ! Coupling with independent precursor runs.
    123 ! Bugfix: output of particle time series only if particle advection is switched
    124 !         on
    125 !
    126 ! 151 2008-03-07 13:42:18Z raasch
    127 ! inflow turbulence is imposed by calling new routine inflow_turbulence
    128 !
    129 ! 108 2007-08-24 15:10:38Z letzel
    130 ! Call of new routine surface_coupler,
    131 ! presure solver is called after the first Runge-Kutta substep instead of the
    132 ! last in case that call_psolver_at_all_substeps = .F.; for this case, the
    133 ! random perturbation has to be added to the velocity fields also after the
    134 ! first substep
    135 !
    136 ! 97 2007-06-21 08:23:15Z raasch
    137 ! diffusivities is called with argument rho in case of ocean runs,
    138 ! new argument pt_/prho_reference in calls of diffusivities,
    139 ! ghostpoint exchange for salinity and density
    140 !
    141 ! 87 2007-05-22 15:46:47Z raasch
    142 ! var_hom renamed pr_palm
    143 !
    144 ! 75 2007-03-22 09:54:05Z raasch
    145 ! Move call of user_actions( 'after_integration' ) below increment of times
    146 ! and counters,
    147 ! calls of prognostic_equations_.. changed to .._noopt, .._cache, and
    148 ! .._vector, these calls are now controlled by switch loop_optimization,
    149 ! uxrp, vynp eliminated, 2nd+3rd argument removed from exchange horiz,
    150 ! moisture renamed humidity
    151 !
    152 ! RCS Log replace by Id keyword, revision history cleaned up
    153 !
    154 ! Revision 1.8  2006/08/22 14:16:05  raasch
    155 ! Disturbances are imposed only for the last Runge-Kutta-substep
    156 !
    157 ! Revision 1.2  2004/04/30 13:03:40  raasch
    158 ! decalpha-specific warning removed, routine name changed to time_integration,
    159 ! particle advection is carried out only once during the intermediate steps,
    160 ! impulse_advec renamed momentum_advec
    161 !
    162109! Revision 1.1  1997/08/11 06:19:04  raasch
    163110! Initial revision
    … …  
    170117!------------------------------------------------------------------------------!
    171118
    172     USE advec_ws
    173     USE arrays_3d
    174     USE averaging
    175     USE buoyancy_mod
    176     USE control_parameters
    177     USE cpulog
    178 #if defined( __dvrp_graphics )
    179     USE DVRP
    180 #endif
    181     USE grid_variables
    182     USE indices
    183     USE interaction_droplets_ptq_mod
    184     USE ls_forcing_mod
    185     USE particle_attributes
     119    USE advec_ws,                                                              &
     120        ONLY:  ws_statistics
     121
     122    USE arrays_3d,                                                             &
     123        ONLY:  diss, e_p, nr_p, prho, pt, pt_p, ql, ql_c, ql_v, ql_vp, qr_p,   &
     124               q_p, rho, sa_p, tend, u, u_p, v, vpt, v_p, w_p
     125
     126    USE buoyancy_mod,                                                          &
     127        ONLY:  calc_mean_profile
     128
     129    USE control_parameters,                                                    &
     130        ONLY:  advected_distance_x, advected_distance_y, average_count_3d,     &
     131               average_count_sp, averaging_interval, averaging_interval_pr,    &
     132               averaging_interval_sp, bc_lr_cyc, bc_ns_cyc,                    &
     133               call_psolver_at_all_substeps, cloud_droplets, cloud_physics,    &
     134               constant_heatflux, create_disturbances, dopr_n,                 &
     135               constant_diffusion, coupling_mode, coupling_start_time,         &
     136               current_timestep_number, disturbance_created,                   &
     137               disturbance_energy_limit, dist_range, do_sum, dt_3d,            &
     138               dt_averaging_input, dt_averaging_input_pr, dt_coupling,         &
     139               dt_data_output_av, dt_disturb, dt_do2d_xy, dt_do2d_xz,          &
     140               dt_do2d_yz, dt_do3d, dt_domask,dt_dopts, dt_dopr,               &
     141               dt_dopr_listing, dt_dosp, dt_dots, dt_dvrp, dt_run_control,     &
     142               end_time, first_call_lpm, galilei_transformation, humidity,     &
     143               icloud_scheme, intermediate_timestep_count,                     &
     144               intermediate_timestep_count_max, large_scale_forcing,           &
     145               loop_optimization, lsf_surf, lsf_vert, masks, mid,              &
     146               netcdf_data_format, neutral, nr_timesteps_this_run, ocean,      &
     147               on_device, passive_scalar, prandtl_layer, precipitation,        &
     148               prho_reference, pt_reference, pt_slope_offset, random_heatflux, &
     149               run_coupled, simulated_time, simulated_time_chr,                &
     150               skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz,        &
     151               skip_time_do3d, skip_time_domask, skip_time_dopr,               &
     152               skip_time_dosp, skip_time_data_output_av, sloping_surface,      &
     153               stop_dt, terminate_coupled, terminate_run, timestep_scheme,     &
     154               time_coupling, time_do2d_xy, time_do2d_xz, time_do2d_yz,        &
     155               time_do3d, time_domask, time_dopr, time_dopr_av,                &
     156               time_dopr_listing, time_dopts, time_dosp, time_dosp_av,         &
     157               time_dots, time_do_av, time_do_sla, time_disturb, time_dvrp,    &
     158               time_run_control, time_since_reference_point, turbulence,       &
     159               turbulent_inflow, use_initial_profile_as_reference,             &
     160               use_single_reference_value, u_gtrans, v_gtrans, ws_scheme_mom,  &
     161               ws_scheme_sca
     162
     163    USE cpulog,                                                                &
     164        ONLY:  cpu_log, log_point, log_point_s
     165
     166    USE indices,                                                               &
     167        ONLY:  i_left, i_right, j_north, j_south, nbgp, nx, nxl, nxlg, nxr,    &
     168               nxrg, nyn, nys, nzb, nzb_u_inner, nzb_v_inner
     169
     170    USE interaction_droplets_ptq_mod,                                          &
     171        ONLY:  interaction_droplets_ptq
     172
     173    USE kinds
     174
     175    USE ls_forcing_mod,                                                        &
     176        ONLY:  ls_forcing_surf, ls_forcing_vert
     177
     178    USE particle_attributes,                                                   &
     179        ONLY:  particle_advection, particle_advection_start, wang_kernel
     180
    186181    USE pegrid
    187     USE production_e_mod
    188     USE prognostic_equations_mod
    189     USE statistics
    190     USE user_actions_mod
     182
     183    USE production_e_mod,                                                      &
     184        ONLY:  production_e_init
     185
     186    USE prognostic_equations_mod,                                              &
     187        ONLY:  prognostic_equations_acc, prognostic_equations_cache,           &
     188               prognostic_equations_vector
     189
     190    USE statistics,                                                            &
     191        ONLY:  flow_statistics_called, hom, pr_palm
     192
     193    USE user_actions_mod,                                                      &
     194        ONLY:  user_actions
    191195
    192196    IMPLICIT NONE
    193197
    194     CHARACTER (LEN=9) ::  time_to_string
    195     INTEGER           ::  netcdf_data_format_save
     198    CHARACTER (LEN=9) ::  time_to_string          !:
     199
     200    INTEGER(iwp)      ::  netcdf_data_format_save !:
    196201
    197202!

  • palm/trunk/SOURCE/time_to_string.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! kind-parameters added to all INTEGER and REAL declaration statements,
     23! kinds are defined in new module kinds,
     24! old module precision_kind is removed,
     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.3  2001/01/22 08:16:04  raasch
    34 ! Comments translated into English
    3535!
    3636! Revision 1.1  1997/08/11 06:26:08  raasch
    … …  
    4343!------------------------------------------------------------------------------!
    4444
     45    USE kinds
     46
    4547    IMPLICIT NONE
    4648
    47     CHARACTER (LEN=9) ::  time_to_string
    48     INTEGER           ::  hours, minutes, seconds
    49     REAL              ::  rest_time, time
     49    CHARACTER (LEN=9) ::  time_to_string !:
     50
     51    INTEGER(iwp)      ::  hours   !:
     52    INTEGER(iwp)      ::  minutes !:
     53    INTEGER(iwp)      ::  seconds !:
     54
     55    REAL(wp)          ::  rest_time !:
     56    REAL(wp)          ::  time      !:
    5057
    5158!

  • palm/trunk/SOURCE/timestep.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:
    … …  
    5157! special treatment in case of mirror velocity boundary condition removed
    5258!
    53 ! 707 2011-03-29 11:39:40Z raasch
    54 ! bc_lr/ns replaced by bc_lr/ns_cyc
    55 !
    56 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    57 ! Exchange of terminate_coupled between ocean and atmosphere via PE0
    58 ! Minimum grid spacing dxyz2_min(k) is now calculated using dzw instead of dzu
    59 !
    60 ! 622 2010-12-10 08:08:13Z raasch
    61 ! optional barriers included in order to speed up collective operations
    62 !
    63 ! 343 2009-06-24 12:59:09Z maronga
    64 ! Additional timestep criterion in case of simulations with plant canopy
    65 ! Output of messages replaced by message handling routine.
    66 !
    67 ! 222 2009-01-12 16:04:16Z letzel
    68 ! Implementation of a MPI-1 Coupling: replaced myid with target_id
    69 ! Bugfix for nonparallel execution
    70 !
    71 ! 108 2007-08-24 15:10:38Z letzel
    72 ! modifications to terminate coupled runs
    73 !
    74 ! RCS Log replace by Id keyword, revision history cleaned up
    75 !
    76 ! Revision 1.21  2006/02/23 12:59:44  raasch
    77 ! nt_anz renamed current_timestep_number
    78 !
    7959! Revision 1.1  1997/08/11 06:26:19  raasch
    8060! Initial revision
    … …  
    8666!------------------------------------------------------------------------------!
    8767
    88     USE arrays_3d
    89     USE cloud_parameters
    90     USE control_parameters
    91     USE cpulog
    92     USE grid_variables
    93     USE indices
     68    USE arrays_3d,                                                             &
     69        ONLY:  cdc, dzu, dzw, kh, km, lad_u, lad_v, lad_w, u, v, w
     70
     71    USE cloud_parameters,                                                      &
     72        ONLY:  dt_precipitation
     73
     74    USE control_parameters,                                                    &
     75        ONLY:  cfl_factor, coupling_mode, dt_3d, dt_fixed, dt_max,             &
     76               galilei_transformation, old_dt, plant_canopy, message_string,   &
     77               stop_dt, terminate_coupled, terminate_coupled_remote,           &
     78               timestep_reason, u_gtrans, use_ug_for_galilei_tr, v_gtrans
     79
     80    USE cpulog,                                                                &
     81        ONLY:  cpu_log, log_point
     82
     83    USE grid_variables,                                                        &
     84        ONLY:  dx, dx2, dy, dy2
     85
     86    USE indices,                                                               &
     87        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
     88
    9489    USE interfaces
     90
     91    USE kinds
     92
    9593    USE pegrid
    96     USE statistics
     94
     95    USE statistics,                                                            &
     96        ONLY:  flow_statistics_called, hom, u_max, u_max_ijk, v_max, v_max_ijk,&
     97               w_max, w_max_ijk
    9798
    9899    IMPLICIT NONE
    99100
    100     INTEGER ::  i, j, k
    101 
    102     REAL ::  div, dt_diff, dt_diff_l, dt_plant_canopy, dt_plant_canopy_l,     &
    103              dt_plant_canopy_u, dt_plant_canopy_v, dt_plant_canopy_w,         &
    104              dt_u, dt_u_l, dt_v, dt_v_l, dt_w, dt_w_l, u_gtrans_l, u_max_l,   &
    105              u_min_l, value, v_gtrans_l, v_max_l, v_min_l, w_max_l, w_min_l
    106 
    107     REAL, DIMENSION(2)         ::  uv_gtrans, uv_gtrans_l
    108     REAL, DIMENSION(3)         ::  reduce, reduce_l
    109     REAL, DIMENSION(nzb+1:nzt) ::  dxyz2_min
     101    INTEGER(iwp) ::  i !:
     102    INTEGER(iwp) ::  j !:
     103    INTEGER(iwp) ::  k !:
     104
     105    REAL(wp) ::  div               !:
     106    REAL(wp) ::  dt_diff           !:
     107    REAL(wp) ::  dt_diff_l         !:
     108    REAL(wp) ::  dt_plant_canopy   !:
     109    REAL(wp) ::  dt_plant_canopy_l !:
     110    REAL(wp) ::  dt_plant_canopy_u !:
     111    REAL(wp) ::  dt_plant_canopy_v !:
     112    REAL(wp) ::  dt_plant_canopy_w !:
     113    REAL(wp) ::  dt_u              !:
     114    REAL(wp) ::  dt_u_l            !:
     115    REAL(wp) ::  dt_v              !:
     116    REAL(wp) ::  dt_v_l            !:
     117    REAL(wp) ::  dt_w              !:
     118    REAL(wp) ::  dt_w_l            !:
     119    REAL(wp) ::  u_gtrans_l        !:
     120    REAL(wp) ::  u_max_l           !:
     121    REAL(wp) ::  u_min_l           !:
     122    REAL(wp) ::  value             !:
     123    REAL(wp) ::  v_gtrans_l        !:
     124    REAL(wp) ::  v_max_l           !:
     125    REAL(wp) ::  v_min_l           !:
     126    REAL(wp) ::  w_max_l           !:
     127    REAL(wp) ::  w_min_l           !:
     128 
     129    REAL(wp), DIMENSION(2)         ::  uv_gtrans   !:
     130    REAL(wp), DIMENSION(2)         ::  uv_gtrans_l !:
     131    REAL(wp), DIMENSION(3)         ::  reduce      !:
     132    REAL(wp), DIMENSION(3)         ::  reduce_l    !:
     133    REAL(wp), DIMENSION(nzb+1:nzt) ::  dxyz2_min   !: 
    110134
    111135
    … …  
    222246    ENDIF
    223247#else
    224     CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0, &
     248    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0_wp, &
    225249                         u_max, u_max_ijk )
    226     CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0, &
     250    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0_wp, &
    227251                         v_max, v_max_ijk )
    228     CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', 0.0, &
     252    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', 0.0_wp, &
    229253                         w_max, w_max_ijk )
    230254#endif

  • palm/trunk/SOURCE/timestep_scheme_steering.f90

    r1310 r1320  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! ONLY-attribute added to USE-statements,
    2323!
    2424! Former revisions:
    … …  
    3232! all actions concerning leapfrog scheme removed
    3333!
    34 ! 673 2011-01-18 16:19:48Z suehring
    35 ! No pressure term during time integration (tsc(4)=0.0).
    36 !
    37 ! RCS Log replace by Id keyword, revision history cleaned up
    38 !
    39 ! Revision 1.2  2005/03/26 21:17:06  raasch
    40 ! No pressure term for Runge-Kutta-schemes (tsc(4)=0.0)
    41 !
    4234! Revision 1.1  2004/01/28 15:34:47  raasch
    4335! Initial revision
    … …  
    5042!------------------------------------------------------------------------------!
    5143
    52     USE control_parameters
     44    USE control_parameters,                                                    &
     45        ONLY:  intermediate_timestep_count, timestep_scheme, tsc
    5346
    5447    IMPLICIT NONE

  • palm/trunk/SOURCE/transpose.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! 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:
    … …  
    5561! indices nxa, nya, etc. replaced by nx, ny, etc.
    5662!
    57 ! 683 2011-02-09 14:25:15Z raasch
    58 ! openMP parallelization of transpositions for 2d-domain-decomposition
    59 !
    60 ! 622 2010-12-10 08:08:13Z raasch
    61 ! optional barriers included in order to speed up collective operations
    62 !
    63 ! 164 2008-05-15 08:46:15Z raasch
    64 ! f_inv changed from subroutine argument to automatic array in order to do
    65 ! re-ordering from f_in to f_inv in one step, one array work is needed instead
    66 ! of work1 and work2
    67 !
    68 ! February 2007
    69 ! RCS Log replace by Id keyword, revision history cleaned up
    70 !
    71 ! Revision 1.2  2004/04/30 13:12:17  raasch
    72 ! Switched from mpi_alltoallv to the simpler mpi_alltoall,
    73 ! all former transpose-routine files collected in this file, enlarged
    74 ! transposition arrays introduced
    75 !
    76 ! Revision 1.1  2004/04/30 13:08:16  raasch
    77 ! Initial revision (collection of former routines transpose_xy, transpose_xz,
    78 !                   transpose_yx, transpose_yz, transpose_zx, transpose_zy)
    79 !
    8063! Revision 1.1  1997/07/24 11:25:18  raasch
    8164! Initial revision
    … …  
    8871!------------------------------------------------------------------------------!
    8972
    90      USE indices
    91      USE transpose_indices
     73     USE indices,                                                              &
     74         ONLY:  nx
     75
     76     USE kinds
     77
     78     USE transpose_indices,                                                    &
     79         ONLY:  nxl_z, nxr_z, nyn_x, nyn_z, nys_x, nys_z, nzb_x, nzt_x
    9280
    9381     IMPLICIT NONE
    9482
    95      REAL ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)
    96      REAL ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)
    97 
    98 
    99      INTEGER ::  i, j, k
    100 
     83     REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !:
     84     REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
     85
     86
     87     INTEGER(iwp) ::  i !:
     88     INTEGER(iwp) ::  j !:
     89     INTEGER(iwp) ::  k !:
    10190!
    10291!-- Rearrange indices of input array in order to make data to be send
    … …  
    128117!------------------------------------------------------------------------------!
    129118
    130     USE cpulog
    131     USE indices
     119    USE cpulog,                                                                &
     120        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     121
     122    USE indices,                                                               &
     123        ONLY:  nx, ny
     124       
     125    USE kinds
     126
    132127    USE pegrid
    133     USE transpose_indices
     128
     129    USE transpose_indices,                                                     &
     130        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
    134131
    135132    IMPLICIT NONE
    136133
    137     INTEGER ::  i, j, k, l, ys
    138    
    139     REAL ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx), f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)
    140 
    141     REAL, DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work
     134    INTEGER(iwp) ::  i  !:
     135    INTEGER(iwp) ::  j  !:
     136    INTEGER(iwp) ::  k  !:
     137    INTEGER(iwp) ::  l  !:
     138    INTEGER(iwp) ::  ys !:
     139 
     140    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
     141    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !:
     142
     143    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work !:
    142144
    143145
    … …  
    207209!------------------------------------------------------------------------------!
    208210
    209      USE indices
    210      USE transpose_indices
     211     USE indices,                                                              &
     212         ONLY:  nxl, nxr, nyn, nys, nz
     213
     214     USE kinds
    211215
    212216     IMPLICIT NONE
    213217
    214      REAL ::  f_inv(nys:nyn,nxl:nxr,1:nz)
    215      REAL ::  f_out(1:nz,nys:nyn,nxl:nxr)
    216 
    217 
    218      INTEGER ::  i, j, k
    219 
     218     REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !:
     219     REAL(wp) ::  f_out(1:nz,nys:nyn,nxl:nxr) !:
     220
     221     INTEGER(iwp) ::  i !:
     222     INTEGER(iwp) ::  j !:
     223     INTEGER(iwp) ::  k !:
    220224!
    221225!-- Rearrange indices of input array in order to make data to be send
    … …  
    249253!------------------------------------------------------------------------------!
    250254
    251     USE cpulog
    252     USE indices
    253     USE pegrid
    254     USE transpose_indices
     255    USE cpulog,                                                                &
     256        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     257
     258    USE indices,                                                               &
     259        ONLY:  nnx, nx, nxl, nxr, ny, nyn, nys, nz
     260
     261    USE kinds
     262
     263    USE pegrid,                                                                &
     264        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     265               pdims, sendrecvcount_zx
     266
     267    USE transpose_indices,                                                     &
     268        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
    255269
    256270    IMPLICIT NONE
    257271
    258     INTEGER ::  i, j, k, l, xs
    259    
    260     REAL ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x), f_inv(nys:nyn,nxl:nxr,1:nz)
    261 
    262     REAL, DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work
     272    INTEGER(iwp) ::  i  !:
     273    INTEGER(iwp) ::  j  !:
     274    INTEGER(iwp) ::  k  !:
     275    INTEGER(iwp) ::  l  !:
     276    INTEGER(iwp) ::  xs !:
     277
     278    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
     279    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !:
     280
     281    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !:
    263282
    264283
    … …  
    331350!------------------------------------------------------------------------------!
    332351
    333      USE indices
    334      USE transpose_indices
     352     USE indices,                                                              &
     353         ONLY:  nx
     354
     355     USE kinds
     356
     357     USE transpose_indices,                                                    &
     358         ONLY:  nyn_x, nys_x, nzb_x, nzt_x
    335359
    336360     IMPLICIT NONE
    337361
    338      REAL ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)
    339      REAL ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)
    340 
    341 
    342      INTEGER ::  i, j, k
    343 
     362     REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
     363     REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
     364
     365
     366     INTEGER(iwp) ::  i !:
     367     INTEGER(iwp) ::  j !:
     368     INTEGER(iwp) ::  k !:
    344369!
    345370!-- Rearrange indices of input array in order to make data to be send
    … …  
    371396!------------------------------------------------------------------------------!
    372397
    373     USE cpulog
    374     USE indices
    375     USE pegrid
    376     USE transpose_indices
     398    USE cpulog,                                                                &
     399        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     400
     401    USE indices,                                                               &
     402        ONLY:  nx, ny
     403
     404    USE kinds
     405
     406    USE pegrid,                                                                &
     407        ONLY:  collective_wait, comm1dy, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     408               numprocs, pdims, sendrecvcount_xy
     409
     410    USE transpose_indices,                                                     &
     411        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
    377412
    378413    IMPLICIT NONE
    379414
    380     INTEGER ::  i, j, k, l, ys
    381    
    382     REAL ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)
    383 
    384     REAL, DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work
     415    INTEGER(iwp) ::  i  !:
     416    INTEGER(iwp) ::  j  !:
     417    INTEGER(iwp) ::  k  !:
     418    INTEGER(iwp) ::  l  !:
     419    INTEGER(iwp) ::  ys !:
     420
     421    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !:
     422    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !:
     423
     424    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work !:
    385425
    386426
    … …  
    453493!------------------------------------------------------------------------------!
    454494
    455     USE cpulog
    456     USE indices
    457     USE pegrid
    458     USE transpose_indices
     495    USE cpulog,                                                                &
     496        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     497
     498    USE indices,                                                               &
     499        ONLY:  nnx, nny, nnz, nx, nxl, nxr, nyn, nys, nz
     500
     501    USE kinds
     502
     503    USE pegrid,                                                                &
     504        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     505               pdims, sendrecvcount_xy
     506
     507    USE transpose_indices,                                                     &
     508        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
    459509
    460510    IMPLICIT NONE
    461511
    462     INTEGER ::  i, j, k, l, m, xs
    463 
    464     REAL ::  f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nxl:nxr,1:nz,nys:nyn), &
    465              f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x),                     &
    466              work(nnx*nny*nnz)
    467 
     512    INTEGER(iwp) ::  i  !:
     513    INTEGER(iwp) ::  j  !:
     514    INTEGER(iwp) ::  k  !:
     515    INTEGER(iwp) ::  l  !:
     516    INTEGER(iwp) ::  m  !:
     517    INTEGER(iwp) ::  xs !:
     518
     519    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)          !:
     520    REAL(wp) ::  f_inv(nxl:nxr,1:nz,nys:nyn)         !:
     521    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
     522    REAL(wp) ::  work(nnx*nny*nnz)                   !:
    468523#if defined( __parallel )
    469524
    … …  
    517572!------------------------------------------------------------------------------!
    518573
    519      USE indices
    520      USE transpose_indices
     574     USE indices,                                                              &
     575         ONLY:  ny
     576
     577     USE kinds
     578
     579     USE transpose_indices,                                                    &
     580         ONLY:  nxl_y, nxr_y, nzb_y, nzt_y
    521581
    522582     IMPLICIT NONE
    523583
    524      REAL ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)
    525      REAL ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)
    526 
    527 
    528      INTEGER ::  i, j, k
     584     REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !:
     585     REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
     586
     587     INTEGER(iwp) ::  i !:
     588     INTEGER(iwp) ::  j !:
     589     INTEGER(iwp) ::  k !:
    529590
    530591!
    … …  
    557618!------------------------------------------------------------------------------!
    558619
    559     USE cpulog
    560     USE indices
    561     USE pegrid
    562     USE transpose_indices
     620    USE cpulog,                                                                &
     621        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     622
     623    USE indices,                                                               &
     624        ONLY:  ny, nz
     625
     626    USE kinds
     627
     628    USE pegrid,                                                                &
     629        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     630               pdims, sendrecvcount_yz
     631
     632    USE transpose_indices,                                                     &
     633        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_z, nys_z, nzb_y, nzt_y
    563634
    564635    IMPLICIT NONE
    565636
    566     INTEGER ::  i, j, k, l, zs
    567    
    568     REAL ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny), f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz)
    569 
    570     REAL, DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work
     637    INTEGER(iwp) ::  i  !:
     638    INTEGER(iwp) ::  j  !:
     639    INTEGER(iwp) ::  k  !:
     640    INTEGER(iwp) ::  l  !:
     641    INTEGER(iwp) ::  zs !:
     642
     643    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
     644    REAL(wp) ::  f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !:
     645
     646    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work !:
    571647
    572648
    … …  
    637713!------------------------------------------------------------------------------!
    638714
    639      USE indices
    640      USE transpose_indices
     715     USE indices,                                                              &
     716         ONLY:  nxl, nxr, nyn, nys, nz
     717
     718     USE kinds
    641719
    642720     IMPLICIT NONE
    643721
    644      REAL ::  f_in(1:nz,nys:nyn,nxl:nxr)
    645      REAL ::  f_inv(nys:nyn,nxl:nxr,1:nz)
    646 
    647 
    648      INTEGER ::  i, j, k
     722     REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)  !:
     723     REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !:
     724
     725     INTEGER(iwp) ::  i !:
     726     INTEGER(iwp) ::  j !:
     727     INTEGER(iwp) ::  k !:
    649728
    650729!
    … …  
    677756!------------------------------------------------------------------------------!
    678757
    679     USE cpulog
    680     USE indices
    681     USE pegrid
    682     USE transpose_indices
     758    USE cpulog,                                                                &
     759        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     760
     761    USE indices,                                                               &
     762        ONLY:  nnx, nx, nxl, nxr, nyn, nys, nz
     763
     764    USE kinds
     765
     766    USE pegrid,                                                                &
     767        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     768               pdims, sendrecvcount_zx
     769
     770    USE transpose_indices,                                                     &
     771        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
    683772
    684773    IMPLICIT NONE
    685774
    686     INTEGER ::  i, j, k, l, xs
    687    
    688     REAL ::  f_inv(nys:nyn,nxl:nxr,1:nz), f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)
    689 
    690     REAL, DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work
     775    INTEGER(iwp) ::  i  !:
     776    INTEGER(iwp) ::  j  !:
     777    INTEGER(iwp) ::  k  !:
     778    INTEGER(iwp) ::  l  !:
     779    INTEGER(iwp) ::  xs !:
     780
     781    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)         !:
     782    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !:
     783
     784    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !:
    691785
    692786
    … …  
    757851!------------------------------------------------------------------------------!
    758852
    759      USE indices
    760      USE transpose_indices
     853     USE indices,                                                              &
     854         ONLY:  ny
     855
     856     USE kinds
     857
     858     USE transpose_indices,                                                    &
     859         ONLY:  nxl_y, nxr_y, nzb_y, nzt_y
    761860
    762861     IMPLICIT NONE
    763862
    764      REAL ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)
    765      REAL ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)
    766 
    767 
    768      INTEGER ::  i, j, k
     863     REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
     864     REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !:
     865
     866
     867     INTEGER(iwp) ::  i !:
     868     INTEGER(iwp) ::  j !:
     869     INTEGER(iwp) ::  k !:
    769870
    770871!
    … …  
    797898!------------------------------------------------------------------------------!
    798899
    799     USE cpulog
    800     USE indices
    801     USE pegrid
    802     USE transpose_indices
     900    USE cpulog,                                                                &
     901        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     902
     903    USE indices,                                                               &
     904        ONLY:  ny, nz
     905
     906    USE kinds
     907
     908    USE pegrid,                                                                &
     909        ONLY:  collective_wait, comm1dx, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     910               pdims, sendrecvcount_yz
     911
     912    USE transpose_indices,                                                     &
     913        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_z, nys_z, nzb_y, nzt_y
    803914
    804915    IMPLICIT NONE
    805916
    806     INTEGER ::  i, j, k, l, zs
    807    
    808     REAL ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz), f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)
    809 
    810     REAL, DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work
    811 
     917    INTEGER(iwp) ::  i  !:
     918    INTEGER(iwp) ::  j  !:
     919    INTEGER(iwp) ::  k  !:
     920    INTEGER(iwp) ::  l  !:
     921    INTEGER(iwp) ::  zs !:
     922
     923    REAL(wp) ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !:
     924    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !:
     925
     926    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work !:
    812927
    813928!
    … …  
    881996!------------------------------------------------------------------------------!
    882997
    883     USE cpulog
    884     USE indices
    885     USE pegrid
    886     USE transpose_indices
     998    USE cpulog,                                                                &
     999        ONLY:  cpu_log, cpu_log_nowait, log_point_s
     1000
     1001    USE indices,                                                               &
     1002        ONLY:  nnx, nny, nnz, nxl, nxr, nyn, nys, ny, nz
     1003
     1004    USE kinds
     1005
     1006    USE pegrid,                                                                &
     1007        ONLY:  collective_wait, comm1dy, comm2d, ierr, MPI_DOUBLE_PRECISION,   &
     1008               pdims, sendrecvcount_zyd
     1009
     1010    USE transpose_indices,                                                     &
     1011        ONLY:  nxl_y, nxl_yd, nxr_y, nxr_yd, nzb_y, nzb_yd, nzt_y, nzt_yd
    8871012
    8881013    IMPLICIT NONE
    8891014
    890     INTEGER ::  i, j, k, l, m, ys
    891    
    892     REAL ::  f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nys:nyn,nxl:nxr,1:nz), &
    893              f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd),                 &
    894              work(nnx*nny*nnz)
     1015    INTEGER(iwp) ::  i  !:
     1016    INTEGER(iwp) ::  j  !:
     1017    INTEGER(iwp) ::  k  !:
     1018    INTEGER(iwp) ::  l  !:
     1019    INTEGER(iwp) ::  m  !:
     1020    INTEGER(iwp) ::  ys !:
     1021
     1022    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)              !:
     1023    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)             !:
     1024    REAL(wp) ::  f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) !:
     1025    REAL(wp) ::  work(nnx*nny*nnz)                       !:
    8951026
    8961027#if defined( __parallel )

  • palm/trunk/SOURCE/tridia_solver.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:
    … …  
    5561!------------------------------------------------------------------------------!
    5662
    57     USE indices
    58     USE transpose_indices
     63    USE indices,                                                               &
     64        ONLY:  nx, ny, nz
     65
     66    USE kinds
     67
     68    USE transpose_indices,                                                     &
     69        ONLY:  nxl_z, nyn_z, nxr_z, nys_z
    5970
    6071    IMPLICIT NONE
    6172
    62     REAL, DIMENSION(:,:), ALLOCATABLE ::  ddzuw
     73    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddzuw !:
    6374
    6475    PRIVATE
    … …  
    7990    SUBROUTINE tridia_init
    8091
    81        USE arrays_3d,  ONLY:  ddzu_pres, ddzw
     92       USE arrays_3d,                                                          &
     93           ONLY:  ddzu_pres, ddzw
     94
     95       USE kinds
    8296
    8397       IMPLICIT NONE
    8498
    85        INTEGER ::  k
     99       INTEGER(iwp) ::  k !:
    86100
    87101       ALLOCATE( ddzuw(0:nz-1,3) )
    … …  
    109123!------------------------------------------------------------------------------!
    110124
    111           USE arrays_3d,  ONLY: tric
    112           USE constants
    113           USE control_parameters
    114           USE grid_variables
     125          USE arrays_3d,                                                       &
     126              ONLY:  tric
     127
     128          USE constants,                                                       &
     129              ONLY:  pi
     130
     131          USE control_parameters,                                              &
     132              ONLY:  ibc_p_b, ibc_p_t
     133
     134          USE grid_variables,                                                  &
     135              ONLY:  dx, dy
     136
     137
     138          USE kinds
    115139
    116140          IMPLICIT NONE
    117141
    118           INTEGER ::  i, j, k, nnxh, nnyh
    119 
    120           REAL    ::  ll(nxl_z:nxr_z,nys_z:nyn_z)
     142          INTEGER(iwp) ::  i    !:
     143          INTEGER(iwp) ::  j    !:
     144          INTEGER(iwp) ::  k    !:
     145          INTEGER(iwp) ::  nnxh !:
     146          INTEGER(iwp) ::  nnyh !:
     147
     148          REAL(wp)    ::  ll(nxl_z:nxr_z,nys_z:nyn_z) !:
    121149          !$acc declare create( ll )
    122150
    … …  
    201229!------------------------------------------------------------------------------!
    202230
    203           USE arrays_3d,  ONLY: tri
    204           USE control_parameters
     231          USE arrays_3d,                                                       &
     232              ONLY:  tri
     233
     234          USE control_parameters,                                              &
     235              ONLY:  ibc_p_b, ibc_p_t
     236
     237          USE kinds
    205238
    206239          IMPLICIT NONE
    207240
    208           INTEGER ::  i, j, k
    209 
    210           REAL    ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz)
    211 
    212           REAL, DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1)   ::  ar1
     241          INTEGER(iwp) ::  i !:
     242          INTEGER(iwp) ::  j !:
     243          INTEGER(iwp) ::  k !:
     244
     245          REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !:
     246
     247          REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1)   ::  ar1 !:
    213248          !$acc declare create( ar1 )
    214249
    … …  
    275310!------------------------------------------------------------------------------!
    276311
    277           USE arrays_3d,  ONLY: tri
    278           USE control_parameters
     312          USE arrays_3d,                                                       &
     313              ONLY:  tri
     314
     315          USE control_parameters,                                              &
     316              ONLY:  ibc_p_b, ibc_p_t
     317
     318          USE kinds
    279319
    280320          IMPLICIT NONE
    281321
    282           INTEGER ::  i, j, jj, k
    283 
    284           REAL    ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz)
     322          INTEGER(iwp) ::  i  !:
     323          INTEGER(iwp) ::  j  !:
     324          INTEGER(iwp) ::  jj !:
     325          INTEGER(iwp) ::  k  !:
     326
     327          REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !:
    285328
    286329          !$acc declare create( ar1 )
    287           REAL, DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1)   ::  ar1
     330          REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) ::  ar1 !:
    288331
    289332!
    … …  
    350393!------------------------------------------------------------------------------!
    351394
    352           USE arrays_3d,  ONLY: tri, tric
     395          USE arrays_3d,                                                       &
     396              ONLY:  tri, tric
     397
     398          USE kinds
    353399
    354400          IMPLICIT NONE
    355401
    356           INTEGER ::  i, j, k
    357 
     402          INTEGER(iwp) ::  i !:
     403          INTEGER(iwp) ::  j !:
     404          INTEGER(iwp) ::  k !:
    358405!
    359406!--       Splitting
    … …  
    398445!------------------------------------------------------------------------------!
    399446
    400        USE arrays_3d
    401        USE control_parameters
    402 
    403        USE pegrid
     447       USE arrays_3d,                                                          &
     448           ONLY:  ddzu_pres, ddzw
     449
     450       USE control_parameters,                                                 &
     451           ONLY:  ibc_p_b, ibc_p_t
     452
     453       USE kinds
    404454
    405455       IMPLICIT NONE
    406456
    407        INTEGER ::  i, j, k, nnyh, nx, ny, omp_get_thread_num, tn
    408 
    409        REAL    ::  ddx2, ddy2
    410 
    411        REAL, DIMENSION(0:nx,1:nz)     ::  ar
    412        REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d
     457       INTEGER(iwp) ::  i                  !:
     458       INTEGER(iwp) ::  j                  !:
     459       INTEGER(iwp) ::  k                  !:
     460       INTEGER(iwp) ::  nnyh               !:
     461       INTEGER(iwp) ::  nx                 !:
     462       INTEGER(iwp) ::  ny                 !:
     463       INTEGER(iwp) ::  omp_get_thread_num !:
     464       INTEGER(iwp) ::  tn                 !:
     465
     466       REAL(wp)     ::  ddx2 !:
     467       REAL(wp)     ::  ddy2 !:
     468
     469       REAL(wp), DIMENSION(0:nx,1:nz)     ::  ar         !:
     470       REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d !:
    413471
    414472
    … …  
    465523!------------------------------------------------------------------------------!
    466524
    467           USE constants
     525          USE constants,                                                       &
     526              ONLY:  pi
     527
     528          USE kinds
    468529
    469530          IMPLICIT NONE
    470531
    471           INTEGER ::  i, j, k, nnxh
    472           REAL    ::  a, c
    473 
    474           REAL, DIMENSION(0:nx) ::  l
     532          INTEGER(iwp) ::  i    !:
     533          INTEGER(iwp) ::  j    !:
     534          INTEGER(iwp) ::  k    !:
     535          INTEGER(iwp) ::  nnxh !:
     536
     537          REAL(wp)     ::  a !:
     538          REAL(wp)     ::  c !:
     539
     540          REAL(wp), DIMENSION(0:nx) ::  l !:
    475541
    476542#if defined( __intel11 )
    477           REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d
     543          REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d !:
    478544#endif
    479545
    … …  
    533599          IMPLICIT NONE
    534600
    535           INTEGER ::  i, k
     601          INTEGER(iwp) ::  i !:
     602          INTEGER(iwp) ::  k !:
    536603
    537604#if defined( __intel11 )
    538           REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d
     605          REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d !:
    539606#endif
    540607
    … …  
    563630          IMPLICIT NONE
    564631
    565           INTEGER ::  i, k
    566 
    567           REAL, DIMENSION(0:nx,nz)       ::  ar
    568           REAL, DIMENSION(0:nx,0:nz-1)   ::  ar1
    569           REAL, DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d
     632          INTEGER(iwp) ::  i !:
     633          INTEGER(iwp) ::  k !:
     634
     635          REAL(wp), DIMENSION(0:nx,nz)       ::  ar         !:
     636          REAL(wp), DIMENSION(0:nx,0:nz-1)   ::  ar1        !:
     637          REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d !:
    570638
    571639!

  • palm/trunk/SOURCE/user_3d_data_averaging.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! kind-parameters added to all INTEGER and REAL declaration statements,
     23! kinds are defined in new module kinds,
     24! revision history before 2012 removed,
     25! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3943
    4044    USE control_parameters
     45
    4146    USE indices
     47
     48    USE kinds
     49
    4250    USE user
    4351
    4452    IMPLICIT NONE
    4553
    46     CHARACTER (LEN=*) ::  mode, variable
     54    CHARACTER (LEN=*) ::  mode    !:
     55    CHARACTER (LEN=*) :: variable !:
    4756
    48     INTEGER ::  i, j, k
    49 
     57    INTEGER(iwp) ::  i !:
     58    INTEGER(iwp) ::  j !:
     59    INTEGER(iwp) ::  k !:
    5060
    5161    IF ( mode == 'allocate' )  THEN

  • palm/trunk/SOURCE/user_actions.f90

    r1319 r1320  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! kind-parameters added to all INTEGER and REAL declaration statements,
     23! kinds are defined in new module kinds,
     24! revision history before 2012 removed,
     25! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3438! 1036 2012-10-22 13:43:42Z raasch
    3539! code put under GPL (PALM 3.9)
    36 !
    37 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    38 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    39 !
    40 ! 258 2009-03-13 12:36:03Z heinze
    41 ! Output of messages replaced by message handling routine.
    4240!
    4341! 211 2008-11-11 04:46:24Z raasch
    … …  
    6664
    6765       USE control_parameters
     66
    6867       USE cpulog
     68
    6969       USE indices
     70
     71       USE kinds
     72
    7073       USE pegrid
     74
    7175       USE user
     76
    7277       USE arrays_3d
    7378
    7479       IMPLICIT NONE
    7580
    76        CHARACTER (LEN=*) ::  location
    77 
    78        INTEGER ::  i, j, k
     81       CHARACTER (LEN=*) ::  location !:
     82
     83       INTEGER(iwp) ::  i !:
     84       INTEGER(iwp) ::  j !:
     85       INTEGER(iwp) ::  k !:
    7986
    8087       CALL cpu_log( log_point(24), 'user_actions', 'start' )
    … …  
    165172
    166173       USE control_parameters
     174       USE kinds
    167175       USE pegrid
    168176       USE user
    … …  
    172180       CHARACTER (LEN=*) ::  location
    173181
    174        INTEGER ::  i, idum, j
    175 
     182       INTEGER(iwp) ::  i
     183       INTEGER(iwp) ::  idum
     184       INTEGER(iwp) ::  j
    176185
    177186!

  • palm/trunk/SOURCE/user_additional_routines.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! kind-parameters added to all INTEGER and REAL declaration statements,
     23! kinds are defined in new module kinds,
     24! revision history before 2012 removed,
     25! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
    … …  
    3741!------------------------------------------------------------------------------!
    3842
     43    USE kinds
     44
    3945    USE user
    4046

  • palm/trunk/SOURCE/user_check_data_output.f90

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