Changeset 1320 for palm/trunk
- Timestamp:
- Mar 20, 2014 8:40:49 AM (11 years ago)
- Location:
- palm/trunk
- Files:
-
- 163 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SCRIPTS/mrun
r1310 r1320 22 22 # Current revisions: 23 23 # ------------------ 24 # 24 # check namelist file set false by default 25 25 # 26 26 # Former revisions: … … 166 166 archive_save=true 167 167 archive_system=none 168 check_namelist_files= true168 check_namelist_files=false 169 169 combine_plot_fields=true 170 170 compiler_name="" -
palm/trunk/SOURCE/Makefile
r1319 r1320 20 20 # Current revisions: 21 21 # ------------------ 22 # 22 # +mod_kinds in dependency list 23 23 # 24 24 # Former revisions: … … 170 170 lpm_set_attributes.f90 lpm_sort_arrays.f90 \ 171 171 lpm_write_exchange_statistics.f90 lpm_write_restart_file.f90 \ 172 173 174 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 \ 175 175 poismg.f90 prandtl_fluxes.f90 pres.f90 print_1d.f90 \ 176 176 production_e.f90 prognostic_equations.f90 random_function.f90 \ … … 224 224 225 225 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 226 advec_s_bc.o: modules.o cpulog.o mod_kinds.o 227 advec_s_pw.o: modules.o mod_kinds.o 228 advec_s_up.o: modules.o mod_kinds.o 229 advec_u_pw.o: modules.o mod_kinds.o 230 advec_u_up.o: modules.o mod_kinds.o 231 advec_v_pw.o: modules.o mod_kinds.o 232 advec_v_up.o: modules.o mod_kinds.o 233 advec_ws.o: modules.o mod_kinds.o 234 advec_w_pw.o: modules.o mod_kinds.o 235 advec_w_up.o: modules.o mod_kinds.o 236 average_3d_data.o: modules.o cpulog.o mod_kinds.o 237 boundary_conds.o: modules.o mod_kinds.o 238 buoyancy.o: modules.o mod_kinds.o 239 calc_liquid_water_content.o: modules.o mod_kinds.o 240 calc_precipitation.o: modules.o mod_kinds.o 241 calc_radiation.o: modules.o mod_kinds.o 242 calc_spectra.o: modules.o cpulog.o fft_xy.o mod_kinds.o 243 check_for_restart.o: modules.o mod_kinds.o 244 check_open.o: modules.o mod_kinds.o 245 check_parameters.o: modules.o mod_kinds.o subsidence.o 246 close_file.o: modules.o mod_kinds.o 247 compute_vpt.o: modules.o mod_kinds.o 248 coriolis.o: modules.o mod_kinds.o 249 cpulog.o: modules.o mod_kinds.o 250 cpu_statistics.o: modules.o mod_kinds.o 251 cuda_fft_interfaces.o: cuda_fft_interfaces.f90 modules.o mod_kinds.o 252 data_log.o: modules.o mod_kinds.o 253 data_output_dvrp.o: modules.o cpulog.o mod_kinds.o 254 data_output_mask.o: modules.o cpulog.o mod_kinds.o 255 data_output_profiles.o: modules.o cpulog.o mod_kinds.o 256 data_output_ptseries.o: modules.o cpulog.o mod_kinds.o 257 data_output_spectra.o: modules.o cpulog.o mod_kinds.o 258 data_output_tseries.o: modules.o cpulog.o mod_kinds.o 259 data_output_2d.o: modules.o cpulog.o mod_kinds.o 260 data_output_3d.o: modules.o cpulog.o mod_kinds.o 261 diffusion_e.o: modules.o mod_kinds.o 262 diffusion_s.o: modules.o mod_kinds.o 263 diffusion_u.o: modules.o mod_kinds.o wall_fluxes.o 264 diffusion_v.o: modules.o mod_kinds.o wall_fluxes.o 265 diffusion_w.o: modules.o mod_kinds.o wall_fluxes.o 266 diffusivities.o: modules.o mod_kinds.o 267 disturb_field.o: modules.o cpulog.o mod_kinds.o random_function.o 268 disturb_heatflux.o: modules.o mod_kinds.o 269 eqn_state_seawater.o: modules.o mod_kinds.o 270 exchange_horiz.o: modules.o cpulog.o mod_kinds.o 271 exchange_horiz_2d.o: modules.o cpulog.o mod_kinds.o 272 fft_xy.o: cuda_fft_interfaces.o modules.o mod_kinds.o singleton.o temperton_fft.o 273 flow_statistics.o: modules.o cpulog.o mod_kinds.o 274 global_min_max.o: modules.o mod_kinds.o 275 header.o: modules.o cpulog.o mod_kinds.o subsidence.o 276 impact_of_latent_heat.o: modules.o mod_kinds.o 277 inflow_turbulence.o: modules.o cpulog.o mod_kinds.o 278 init_1d_model.o: modules.o mod_kinds.o 279 init_3d_model.o: modules.o cpulog.o mod_kinds.o random_function.o advec_ws.o ls_forcing.o 280 init_advec.o: modules.o mod_kinds.o 281 init_cloud_physics.o: modules.o mod_kinds.o 282 init_coupling.o: modules.o mod_kinds.o 283 init_dvrp.o: modules.o mod_kinds.o 284 init_grid.o: modules.o mod_kinds.o 285 init_masks.o: modules.o mod_kinds.o 286 init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o 287 init_pegrid.o: modules.o mod_kinds.o 288 init_pt_anomaly.o: modules.o mod_kinds.o 289 init_rankine.o: modules.o mod_kinds.o 290 init_slope.o: modules.o mod_kinds.o 291 interaction_droplets_ptq.o: modules.o mod_kinds.o 292 local_flush.o: mod_kinds.o 293 local_getenv.o: modules.o mod_kinds.o 294 local_stop.o: modules.o mod_kinds.o 295 local_tremain.o: modules.o cpulog.o mod_kinds.o 296 local_tremain_ini.o: modules.o cpulog.o mod_kinds.o 297 lpm.o: modules.o cpulog.o mod_kinds.o 298 lpm_advec.o: modules.o mod_kinds.o 299 lpm_boundary_conds.o: modules.o cpulog.o mod_kinds.o 300 lpm_calc_liquid_water_content.o: modules.o cpulog.o mod_kinds.o 301 lpm_collision_kernels.o: modules.o cpulog.o user_module.o mod_kinds.o 302 lpm_data_output_particles.o: modules.o cpulog.o mod_kinds.o 303 lpm_droplet_collision.o: modules.o cpulog.o lpm_collision_kernels.o mod_kinds.o 304 lpm_droplet_condensation.o: modules.o cpulog.o lpm_collision_kernels.o mod_kinds.o 305 lpm_exchange_horiz.o: modules.o cpulog.o mod_kinds.o 306 lpm_extend_particle_array.o: modules.o mod_kinds.o 307 lpm_extend_tails.o: modules.o mod_kinds.o 308 lpm_extend_tail_array.o: modules.o mod_kinds.o 309 lpm_init.o: modules.o lpm_collision_kernels.o mod_kinds.o random_function.o 310 lpm_init_sgs_tke.o: modules.o mod_kinds.o 311 lpm_pack_arrays.o: modules.o mod_kinds.o 312 lpm_read_restart_file.o: modules.o mod_kinds.o 313 lpm_release_set.o: modules.o mod_kinds.o random_function.o 314 lpm_set_attributes.o: modules.o cpulog.o mod_kinds.o 315 lpm_sort_arrays.o: modules.o cpulog.o mod_kinds.o 316 lpm_write_exchange_statistics.o: modules.o mod_kinds.o 317 lpm_write_restart_file.o: modules.o mod_kinds.o 318 ls_forcing.o: modules.o cpulog.o mod_kinds.o 319 message.o: modules.o mod_kinds.o 320 microphysics.o: modules.o mod_kinds.o 321 modules.o: modules.f90 mod_kinds.o 322 mod_kinds.o: mod_kinds.f90 323 netcdf.o: modules.o mod_kinds.o 324 nudging.o: modules.o buoyancy.o cpulog.o mod_kinds.o 325 package_parin.o: modules.o mod_kinds.o 326 palm.o: modules.o cpulog.o ls_forcing.o mod_kinds.o nudging.o 327 parin.o: modules.o cpulog.o mod_kinds.o 328 plant_canopy_model.o: modules.o mod_kinds.o 329 poisfft.o: modules.o cpulog.o fft_xy.o mod_kinds.o tridia_solver.o 330 poismg.o: modules.o cpulog.o mod_kinds.o 331 prandtl_fluxes.o: modules.o mod_kinds.o 332 pres.o: modules.o cpulog.o mod_kinds.o poisfft.o 333 print_1d.o: modules.o cpulog.o mod_kinds.o 334 production_e.o: modules.o mod_kinds.o wall_fluxes.o 333 335 prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_u_pw.o \ 334 336 advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o \ 335 337 advec_ws.o buoyancy.o calc_precipitation.o calc_radiation.o coriolis.o \ 336 338 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 m icrophysics.o \339 eqn_state_seawater.o impact_of_latent_heat.o mod_kinds.o microphysics.o \ 338 340 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 341 random_function.o: mod_kinds.o 342 random_gauss.o: mod_kinds.o random_function.o 343 read_3d_binary.o: modules.o cpulog.o mod_kinds.o random_function.o 344 read_var_list.o: modules.o mod_kinds.o 345 run_control.o: modules.o cpulog.o mod_kinds.o 346 set_slicer_attributes_dvrp.o: modules.o mod_kinds.o 347 singleton.o: mod_kinds.o singleton.f90 348 sor.o: modules.o mod_kinds.o 349 subsidence.o: modules.o mod_kinds.o 350 sum_up_3d_data.o: modules.o cpulog.o mod_kinds.o 351 surface_coupler.o: modules.o cpulog.o mod_kinds.o 352 swap_timelevel.o: modules.o cpulog.o mod_kinds.o 353 temperton_fft.o: modules.o mod_kinds.o 351 354 time_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 356 time_to_string.o: mod_kinds.o 357 timestep.o: modules.o cpulog.o mod_kinds.o 358 timestep_scheme_steering.o: modules.o mod_kinds.o 359 transpose.o: modules.o cpulog.o mod_kinds.o 360 tridia_solver.o: modules.o mod_kinds.o 361 user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o 362 user_actions.o: modules.o cpulog.o mod_kinds.o user_module.o 363 user_additional_routines.o: modules.o mod_kinds.o user_module.o 364 user_check_data_output.o: modules.o mod_kinds.o user_module.o 365 user_check_data_output_pr.o: modules.o mod_kinds.o user_module.o 366 user_check_parameters.o: modules.o mod_kinds.o user_module.o 367 user_data_output_2d.o: modules.o mod_kinds.o user_module.o 368 user_data_output_3d.o: modules.o mod_kinds.o user_module.o 369 user_data_output_mask.o: modules.o mod_kinds.o user_module.o 370 user_data_output_dvrp.o: modules.o mod_kinds.o user_module.o 371 user_define_netcdf_grid.o: modules.o mod_kinds.o user_module.o 372 user_dvrp_coltab.o: modules.o mod_kinds.o user_module.o 373 user_header.o: modules.o mod_kinds.o user_module.o 374 user_init.o: modules.o mod_kinds.o user_module.o 375 user_init_3d_model.o: modules.o mod_kinds.o user_module.o 376 user_init_grid.o: modules.o mod_kinds.o user_module.o 377 user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o 378 user_last_actions.o: modules.o mod_kinds.o user_module.o 379 user_lpm_advec.o: modules.o mod_kinds.o user_module.o 380 user_lpm_init.o: modules.o mod_kinds.o user_module.o 381 user_lpm_set_attributes.o: modules.o mod_kinds.o user_module.o 382 user_module.o: mod_kinds.o user_module.f90 383 user_parin.o: modules.o mod_kinds.o user_module.o 384 user_read_restart_data.o: modules.o mod_kinds.o user_module.o 385 user_spectra.o: modules.o mod_kinds.o user_module.o 386 user_statistics.o: modules.o mod_kinds.o user_module.o 387 wall_fluxes.o: modules.o mod_kinds.o 388 write_3d_binary.o: modules.o cpulog.o mod_kinds.o random_function.o 389 write_compressed.o: modules.o mod_kinds.o 390 write_var_list.o: modules.o mod_kinds.o -
palm/trunk/SOURCE/Makefile_check
r1310 r1320 20 20 # Current revisions: 21 21 # ------------------ 22 # 22 # cpu_log renamed cpulog, + mod_kinds in dependency list 23 23 # 24 24 # Former revisions: … … 69 69 70 70 SOURCES = 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 \ 72 72 exchange_horiz_2d.f90 fft_xy.f90 init_grid.f90 init_masks.f90 \ 73 73 init_cloud_physics.f90 init_pegrid.f90 local_flush.f90 local_stop.f90 \ 74 local_system.f90 message.f90 modules.f90 package_parin.f90parin.f90 \75 p oisfft.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 \ 76 76 subsidence.f90 temperton_fft.f90 tridia_solver.f90 \ 77 77 user_3d_data_averaging.f90 user_actions.f90 \ … … 115 115 116 116 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 117 check_open.o: modules.o mod_kinds.o 118 check_namelist_files.o: modules.o mod_kinds.o 119 check_parameters.o: modules.o mod_kinds.o subsidence.o 120 close_file.o: modules.o mod_kinds.o 121 cpulog.o: modules.o mod_kinds.o 122 cuda_fft_interfaces.o: cuda_fft_interfaces.f90 modules.o mod_kinds.o 123 exchange_horiz.o: modules.o cpulog.o mod_kinds.o 124 exchange_horiz_2d.o: modules.o cpulog.o mod_kinds.o 125 fft_xy.o: cuda_fft_interfaces.o modules.o mod_kinds.o singleton.o temperton_fft.o 126 init_cloud_physics.o: modules.o mod_kinds.o 127 init_grid.o: modules.o mod_kinds.o 128 init_masks.o: modules.o mod_kinds.o 129 init_pegrid.o: modules.o mod_kinds.o 130 local_flush.o: mod_kinds.o 131 local_stop.o: modules.o mod_kinds.o 132 message.o: modules.o mod_kinds.o 133 modules.o: modules.f90 mod_kinds.o 134 mod_kinds.o: mod_kinds.f90 135 package_parin.o: modules.o mod_kinds.o 136 parin.o: modules.o cpulog.o mod_kinds.o 137 poisfft.o: cpulog.o modules.o mod_kinds.o fft_xy.o tridia_solver.o 138 singleton.o: mod_kinds.o singleton.f90 139 subsidence.o: modules.o mod_kinds.o 140 temperton_fft.o: modules.o mod_kinds.o 141 tridia_solver.o: modules.o mod_kinds.o 142 user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o 143 user_actions.o: cpulog.o modules.o mod_kinds.o user_module.o 144 user_additional_routines.o: modules.o mod_kinds.o user_module.o 145 user_check_data_output.o: modules.o mod_kinds.o user_module.o 146 user_check_data_output_pr.o: modules.o mod_kinds.o user_module.o 147 user_check_parameters.o: modules.o mod_kinds.o user_module.o 148 user_data_output_2d.o: modules.o mod_kinds.o user_module.o 149 user_data_output_3d.o: modules.o mod_kinds.o user_module.o 150 user_data_output_mask.o: modules.o mod_kinds.o user_module.o 151 user_data_output_dvrp.o: modules.o mod_kinds.o user_module.o 152 user_define_netcdf_grid.o: modules.o mod_kinds.o user_module.o 153 user_dvrp_coltab.o: modules.o mod_kinds.o user_module.o 154 user_header.o: modules.o mod_kinds.o user_module.o 155 user_init.o: modules.o mod_kinds.o user_module.o 156 user_init_3d_model.o: modules.o mod_kinds.o user_module.o 157 user_init_grid.o: modules.o mod_kinds.o user_module.o 158 user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o 159 user_last_actions.o: modules.o mod_kinds.o user_module.o 160 user_lpm_advec.o: modules.o mod_kinds.o user_module.o 161 user_lpm_init.o: modules.o mod_kinds.o user_module.o 162 user_lpm_set_attributes.o: modules.o mod_kinds.o user_module.o 163 user_module.o: mod_kinds.o user_module.f90 164 user_parin.o: modules.o mod_kinds.o user_module.o 165 user_read_restart_data.o: modules.o mod_kinds.o user_module.o 166 user_spectra.o: modules.o mod_kinds.o user_module.o 167 user_statistics.o: modules.o mod_kinds.o user_module.o -
palm/trunk/SOURCE/advec_s_bc.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 37 42 ! 1010 2012-09-20 07:59:54Z raasch 38 43 ! cpp switch __nopointer added for pointer free version 39 !40 ! 622 2010-12-10 08:08:13Z raasch41 ! optional barriers included in order to speed up collective operations42 !43 ! 247 2009-02-27 14:01:30Z heinze44 ! Output of messages replaced by message handling routine45 !46 ! 216 2008-11-25 07:12:43Z raasch47 ! Neumann boundary condition at k=nzb is explicitly set for better reading,48 ! although this has been already done in boundary_conds49 !50 ! 97 2007-06-21 08:23:15Z raasch51 ! Advection of salinity included52 ! Bugfix: Error in boundary condition for TKE removed53 !54 ! 63 2007-03-13 03:52:49Z raasch55 ! Calculation extended for gridpoint nzt56 !57 ! RCS Log replace by Id keyword, revision history cleaned up58 !59 ! Revision 1.22 2006/02/23 09:42:08 raasch60 ! anz renamed ngp61 44 ! 62 45 ! Revision 1.1 1997/08/29 08:53:46 raasch … … 77 60 !------------------------------------------------------------------------------! 78 61 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 85 84 USE pegrid 86 USE statistics 85 86 USE statistics, & 87 ONLY: rmask, statistic_regions, sums_wsts_bc_l 88 87 89 88 90 IMPLICIT NONE 89 91 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 98 131 #if defined( __nopointer ) 99 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk132 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 100 133 #else 101 REAL , DIMENSION(:,:,:), POINTER :: sk134 REAL(wp), DIMENSION(:,:,:), POINTER :: sk 102 135 #endif 103 136 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 !: 107 152 108 153 #if defined( __nec ) 109 REAL (kind=4) :: m1n, m1z !Wichtig: Division110 REAL (kind=4), DIMENSION(:,:), ALLOCATABLE :: m1, sw154 REAL(sp) :: m1n, m1z !Wichtig: Division !: 155 REAL(sp), DIMENSION(:,:), ALLOCATABLE :: m1, sw !: 111 156 #else 112 REAL :: m1n, m1z113 REAL , DIMENSION(:,:), ALLOCATABLE :: m1, sw157 REAL(wp) :: m1n, m1z 158 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m1, sw 114 159 #endif 115 160 … … 148 193 ! 149 194 !-- 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, & 152 197 comm2d, status, ierr ) 153 198 ! 154 199 !-- 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, & 157 202 comm2d, status, ierr ) 158 203 CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' ) … … 192 237 DO j = nys, nyn 193 238 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 ) 198 243 ENDDO 199 244 ENDDO … … 210 255 ! 211 256 !-- 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) & 220 265 ) 221 266 imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0 … … 236 281 DO k = nzb+1, nzt 237 282 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) & 239 284 + 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) & 242 287 + 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) & 245 290 ) * 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) & 248 293 - 3.0 * sk_p(k,j,i-2) ) * f48 249 294 ENDDO … … 259 304 cipf = 1.0 - 2.0 * cip 260 305 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 ) & 263 308 + 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 ) & 266 311 + a2(k,i+1) * f24 * ( 1.0 - cimf*cimf*cimf ) 267 312 ip = MAX( ip, 0.0 ) … … 274 319 cipf = 1.0 - 2.0 * cip 275 320 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 ) & 278 323 + 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 ) & 281 326 + a2(k,i) * f24 * ( 1.0 - cimf*cimf*cimf ) 282 327 ip = MAX( ip, 0.0 ) … … 309 354 DO i = nxl-1, nxr+1 310 355 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) ) / & 312 357 MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35 ) 313 358 IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) ) m2 = 0.0 314 359 315 m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) / &360 m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) / & 316 361 MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35 ) 317 362 IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) ) m3 = 0.0 … … 322 367 323 368 !-- *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 ) & 328 373 ) sw(k,i) = 1.0 329 374 ENDDO … … 425 470 DO i = nxl, nxr 426 471 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) & 428 473 - ( 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) & 430 475 - ( 1.0 - sw(k,i) ) * immb(k,i) - sw(k,i) * imme(k,i) 431 tend enz= fplus - fminus476 tendcy = fplus - fminus 432 477 ! 433 478 !-- Removed in order to optimize speed 434 479 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 ) 435 ! IF ( ( ABS( tend enz ) / ffmax ) < 1E-7 ) tendenz= 0.0480 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 ) tendcy = 0.0 436 481 ! 437 482 !-- Density correction because of possible remaining divergences 438 483 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) - tend enz ) /&484 sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) / & 440 485 ( 1.0 + d_new ) 441 486 d(k,j,i) = d_new … … 447 492 ! 448 493 !-- 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, & 450 495 ippb, ippe, m1, sw ) 451 496 … … 455 500 #if defined( __parallel ) 456 501 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, & 458 503 type_xz_2, ierr ) 459 504 CALL MPI_TYPE_COMMIT( type_xz_2, ierr ) … … 461 506 !-- Send front boundary, receive rear boundary 462 507 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, & 465 510 comm2d, status, ierr ) 466 511 ! 467 512 !-- 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, & 470 515 comm2d, status, ierr ) 471 516 CALL MPI_TYPE_FREE( type_xz_2, ierr ) … … 490 535 DO j = nys, nyn 491 536 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 ) 496 541 ENDDO 497 542 ENDDO … … 508 553 ! 509 554 !-- 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) & 518 563 ) 519 564 imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0 … … 528 573 DO k = nzb+1, nzt 529 574 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) & 531 576 + 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) & 534 579 + 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) & 537 582 ) * 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) & 540 585 - 3.0 * sk_p(k,j-2,i) ) * f48 541 586 ENDDO … … 551 596 cipf = 1.0 - 2.0 * cip 552 597 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 ) & 555 600 + 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 ) & 558 603 + a2(k,j+1) * f24 * ( 1.0 - cimf*cimf*cimf ) 559 604 ip = MAX( ip, 0.0 ) … … 566 611 cipf = 1.0 - 2.0 * cip 567 612 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 ) & 570 615 + 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 ) & 573 618 + a2(k,j) * f24 * ( 1.0 - cimf*cimf*cimf ) 574 619 ip = MAX( ip, 0.0 ) … … 601 646 DO j = nys-1, nyn+1 602 647 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) ) / & 604 649 MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 ) 605 650 IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) ) m2 = 0.0 606 651 607 m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &652 m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / & 608 653 MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 ) 609 654 IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) ) m3 = 0.0 … … 614 659 615 660 !-- *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 ) & 620 665 ) sw(k,j) = 1.0 621 666 ENDDO … … 717 762 DO j = nys, nyn 718 763 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) & 720 765 - ( 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) & 722 767 - ( 1.0 - sw(k,j) ) * immb(k,j) - sw(k,j) * imme(k,j) 723 tend enz= fplus - fminus768 tendcy = fplus - fminus 724 769 ! 725 770 !-- Removed in order to optimise speed 726 771 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 ) 727 ! IF ( ( ABS( tend enz ) / ffmax ) < 1E-7 ) tendenz= 0.0772 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 ) tendcy = 0.0 728 773 ! 729 774 !-- Density correction because of possible remaining divergences 730 775 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) - tend enz ) /&776 sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) / & 732 777 ( 1.0 + d_new ) 733 778 d(k,j,i) = d_new … … 741 786 ! 742 787 !-- 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, & 744 789 ippb, ippe, m1, sw ) 745 790 … … 879 924 ELSE 880 925 881 WRITE( message_string, * ) 'no vertical boundary condi', &926 WRITE( message_string, * ) 'no vertical boundary condi', & 882 927 'tion for variable "', sk_char, '"' 883 928 CALL message( 'advec_s_bc', 'PA0158', 1, 2, 0, 6, 0 ) … … 891 936 DO j = nys, nyn 892 937 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 ) 897 942 ENDDO 898 943 ENDDO … … 909 954 ! 910 955 !-- 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) & 919 964 ) 920 965 imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0 … … 929 974 DO k = nzb, nzt+1 930 975 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) & 932 977 + 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) & 935 980 + 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) & 938 983 ) * 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) & 941 986 - 3.0 * sk_p(k-2,j,i) ) * f48 942 987 ENDDO … … 952 997 cipf = 1.0 - 2.0 * cip 953 998 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 ) & 956 1001 + 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 ) & 959 1004 + a2(k+1,j) * f24 * ( 1.0 - cimf*cimf*cimf ) 960 1005 ip = MAX( ip, 0.0 ) … … 967 1012 cipf = 1.0 - 2.0 * cip 968 1013 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 ) & 971 1016 + 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 ) & 974 1019 + a2(k,j) * f24 * ( 1.0 - cimf*cimf*cimf ) 975 1020 ip = MAX( ip, 0.0 ) … … 1002 1047 DO j = nys, nyn 1003 1048 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) ) / & 1005 1050 MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 ) 1006 1051 IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) ) m2 = 0.0 1007 1052 1008 m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &1053 m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / & 1009 1054 MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 ) 1010 1055 IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) ) m3 = 0.0 … … 1015 1060 1016 1061 !-- *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 ) & 1021 1066 ) sw(k,j) = 1.0 1022 1067 ENDDO … … 1118 1163 DO j = nys, nyn 1119 1164 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) & 1121 1166 - ( 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) & 1123 1168 - ( 1.0 - sw(k,j) ) * immb(k,j) - sw(k,j) * imme(k,j) 1124 tend enz= fplus - fminus1169 tendcy = fplus - fminus 1125 1170 ! 1126 1171 !-- Removed in order to optimise speed 1127 1172 ! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 ) 1128 ! IF ( ( ABS( tend enz ) / ffmax ) < 1E-7 ) tendenz= 0.01173 ! IF ( ( ABS( tendcy ) / ffmax ) < 1E-7 ) tendcy = 0.0 1129 1174 ! 1130 1175 !-- Density correction because of possible remaining divergences 1131 1176 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) - tend enz ) /&1177 sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) / & 1133 1178 ( 1.0 + d_new ) 1134 1179 ! … … 1145 1190 DO j = nys, nyn 1146 1191 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) + & 1148 1193 m1(k,j) * rmask(j,i,sr) 1149 1194 ENDDO … … 1158 1203 ! 1159 1204 !-- 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, & 1161 1206 ippb, ippe, m1, sw ) 1162 1207 -
palm/trunk/SOURCE/advec_s_pw.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 31 36 ! 1010 2012-09-20 07:59:54Z raasch 32 37 ! cpp switch __nopointer added for pointer free version 33 !34 ! 19 2007-02-23 04:53:48Z raasch35 ! Calculation extended for gridpoint nzt36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.12 2006/02/23 09:42:55 raasch40 ! nzb_2d replaced by nzb_s_inner41 38 ! 42 39 ! Revision 1.1 1997/08/29 08:54:20 raasch … … 70 67 SUBROUTINE advec_s_pw( sk ) 71 68 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 76 83 77 84 IMPLICIT NONE 78 85 79 INTEGER :: i, j, k 86 INTEGER(iwp) :: i !: 87 INTEGER(iwp) :: j !: 88 INTEGER(iwp) :: k !: 80 89 81 90 #if defined( __nopointer ) 82 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk91 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 83 92 #else 84 REAL , DIMENSION(:,:,:), POINTER :: sk93 REAL(wp), DIMENSION(:,:,:), POINTER :: sk 85 94 #endif 86 95 … … 111 120 SUBROUTINE advec_s_pw_ij( i, j, sk ) 112 121 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 117 136 118 137 IMPLICIT NONE 119 138 120 INTEGER :: i, j, k 139 INTEGER(iwp) :: i !: 140 INTEGER(iwp) :: j !: 141 INTEGER(iwp) :: k !: 121 142 122 143 #if defined( __nopointer ) 123 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk144 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 124 145 #else 125 REAL , DIMENSION(:,:,:), POINTER :: sk146 REAL(wp), DIMENSION(:,:,:), POINTER :: sk 126 147 #endif 127 148 -
palm/trunk/SOURCE/advec_s_up.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 34 39 ! 981 2012-08-09 14:57:44Z maronga 35 40 ! Typo removed 36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.11 2006/02/23 09:43:44 raasch40 ! nzb_2d replaced by nzb_s_inner41 41 ! 42 42 ! Revision 1.1 1997/08/29 08:54:33 raasch … … 67 67 SUBROUTINE advec_s_up( sk ) 68 68 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 73 83 74 84 IMPLICIT NONE 75 85 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 !: 79 93 #if defined( __nopointer ) 80 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk94 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 81 95 #else 82 REAL , DIMENSION(:,:,:), POINTER :: sk96 REAL(wp), DIMENSION(:,:,:), POINTER :: sk 83 97 #endif 84 98 … … 91 105 ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans 92 106 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 * & 94 108 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 95 109 ELSE 96 tend(k,j,i) = tend(k,j,i) - ukomp * &110 tend(k,j,i) = tend(k,j,i) - ukomp * & 97 111 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 98 112 ENDIF … … 101 115 vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans 102 116 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 * & 104 118 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 105 119 ELSE 106 tend(k,j,i) = tend(k,j,i) - vkomp * &120 tend(k,j,i) = tend(k,j,i) - vkomp * & 107 121 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 108 122 ENDIF … … 111 125 wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) ) 112 126 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 * & 114 128 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 115 129 ELSE 116 tend(k,j,i) = tend(k,j,i) - wkomp * &130 tend(k,j,i) = tend(k,j,i) - wkomp * & 117 131 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 118 132 ENDIF … … 130 144 SUBROUTINE advec_s_up_ij( i, j, sk ) 131 145 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 136 160 137 161 IMPLICIT NONE 138 162 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 142 171 #if defined( __nopointer ) 143 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk172 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 144 173 #else 145 REAL , DIMENSION(:,:,:), POINTER :: sk174 REAL(wp), DIMENSION(:,:,:), POINTER :: sk 146 175 #endif 147 176 … … 152 181 ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans 153 182 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 * & 155 184 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 156 185 ELSE 157 tend(k,j,i) = tend(k,j,i) - ukomp * &186 tend(k,j,i) = tend(k,j,i) - ukomp * & 158 187 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 159 188 ENDIF … … 162 191 vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans 163 192 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 * & 165 194 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 166 195 ELSE 167 tend(k,j,i) = tend(k,j,i) - vkomp * &196 tend(k,j,i) = tend(k,j,i) - vkomp * & 168 197 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 169 198 ENDIF … … 172 201 wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) ) 173 202 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 * & 175 204 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 176 205 ELSE 177 tend(k,j,i) = tend(k,j,i) - wkomp * &206 tend(k,j,i) = tend(k,j,i) - wkomp * & 178 207 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 179 208 ENDIF -
palm/trunk/SOURCE/advec_u_pw.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 106 2007-08-16 14:30:26Z raasch32 ! i loop is starting from nxlu (needed for non-cyclic boundary conditions)33 !34 ! 75 2007-03-22 09:54:05Z raasch35 ! uxrp eliminated36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.15 2006/02/23 09:44:21 raasch40 ! nzb_2d replaced by nzb_u_inner41 35 ! 42 36 ! Revision 1.1 1997/08/11 06:09:21 raasch … … 68 62 SUBROUTINE advec_u_pw 69 63 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 74 78 75 79 IMPLICIT NONE 76 80 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 !: 79 87 80 88 gu = 2.0 * u_gtrans … … 104 112 SUBROUTINE advec_u_pw_ij( i, j ) 105 113 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 110 128 111 129 IMPLICIT NONE 112 130 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 !: 115 137 116 138 gu = 2.0 * u_gtrans -
palm/trunk/SOURCE/advec_u_up.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 106 2007-08-16 14:30:26Z raasch32 ! i loop is starting from nxlu (needed for non-cyclic boundary conditions)33 !34 ! 75 2007-03-22 09:54:05Z raasch35 ! uxrp eliminated36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.12 2006/02/23 09:45:04 raasch40 ! nzb_2d replaced by nzb_u_inner41 35 ! 42 36 ! Revision 1.1 1997/08/29 08:55:25 raasch … … 67 61 SUBROUTINE advec_u_up 68 62 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 73 77 74 78 IMPLICIT NONE 75 79 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 81 89 DO i = nxlu, nxr 82 90 DO j = nys, nyn … … 86 94 ukomp = u(k,j,i) - u_gtrans 87 95 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 * & 89 97 ( u(k,j,i) - u(k,j,i-1) ) * ddx 90 98 ELSE 91 tend(k,j,i) = tend(k,j,i) - ukomp * &99 tend(k,j,i) = tend(k,j,i) - ukomp * & 92 100 ( u(k,j,i+1) - u(k,j,i) ) * ddx 93 101 ENDIF 94 102 ! 95 103 !-- 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) + & 97 105 v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans 98 106 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 * & 100 108 ( u(k,j,i) - u(k,j-1,i) ) * ddy 101 109 ELSE 102 tend(k,j,i) = tend(k,j,i) - vkomp * &110 tend(k,j,i) = tend(k,j,i) - vkomp * & 103 111 ( u(k,j+1,i) - u(k,j,i) ) * ddy 104 112 ENDIF 105 113 ! 106 114 !-- 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) + & 108 116 w(k,j,i-1) + w(k-1,j,i-1) ) 109 117 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 * & 111 119 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) 112 120 ELSE 113 tend(k,j,i) = tend(k,j,i) - wkomp * &121 tend(k,j,i) = tend(k,j,i) - wkomp * & 114 122 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) 115 123 ENDIF … … 127 135 SUBROUTINE advec_u_up_ij( i, j ) 128 136 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 133 151 134 152 IMPLICIT NONE 135 153 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 !: 139 161 140 162 … … 144 166 ukomp = u(k,j,i) - u_gtrans 145 167 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 * & 147 169 ( u(k,j,i) - u(k,j,i-1) ) * ddx 148 170 ELSE 149 tend(k,j,i) = tend(k,j,i) - ukomp * &171 tend(k,j,i) = tend(k,j,i) - ukomp * & 150 172 ( u(k,j,i+1) - u(k,j,i) ) * ddx 151 173 ENDIF 152 174 ! 153 175 !-- 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) & 155 177 ) - v_gtrans 156 178 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 * & 158 180 ( u(k,j,i) - u(k,j-1,i) ) * ddy 159 181 ELSE 160 tend(k,j,i) = tend(k,j,i) - vkomp * &182 tend(k,j,i) = tend(k,j,i) - vkomp * & 161 183 ( u(k,j+1,i) - u(k,j,i) ) * ddy 162 184 ENDIF … … 165 187 wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) ) 166 188 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 * & 168 190 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) 169 191 ELSE 170 tend(k,j,i) = tend(k,j,i) - wkomp * &192 tend(k,j,i) = tend(k,j,i) - wkomp * & 171 193 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) 172 194 ENDIF -
palm/trunk/SOURCE/advec_v_pw.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 106 2007-08-16 14:30:26Z raasch32 ! j loop is starting from nysv (needed for non-cyclic boundary conditions)33 !34 ! 75 2007-03-22 09:54:05Z raasch35 ! vynp eliminated36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.15 2006/02/23 09:46:08 raasch40 ! nzb_2d replaced by nzb_v_inner41 35 ! 42 36 ! Revision 1.1 1997/08/11 06:09:57 raasch … … 68 62 SUBROUTINE advec_v_pw 69 63 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 74 78 75 79 IMPLICIT NONE 76 80 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 !: 79 87 80 88 … … 105 113 SUBROUTINE advec_v_pw_ij( i, j ) 106 114 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 111 129 112 130 IMPLICIT NONE 113 131 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 !: 116 138 117 139 … … 119 141 gv = 2.0 * v_gtrans 120 142 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 * ( & 122 144 ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu ) & 123 145 - 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 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 106 2007-08-16 14:30:26Z raasch32 ! j loop is starting from nysv (needed for non-cyclic boundary conditions)33 !34 ! 75 2007-03-22 09:54:05Z raasch35 ! vynp eliminated36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.12 2006/02/23 09:46:37 raasch40 ! nzb_2d replaced by nzb_v_inner41 35 ! 42 36 ! Revision 1.1 1997/08/29 08:56:05 raasch … … 67 61 SUBROUTINE advec_v_up 68 62 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 73 77 74 78 IMPLICIT NONE 75 79 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 !: 78 87 79 88 … … 83 92 ! 84 93 !-- 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) + & 86 95 u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans 87 96 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 * & 89 98 ( v(k,j,i) - v(k,j,i-1) ) * ddx 90 99 ELSE 91 tend(k,j,i) = tend(k,j,i) - ukomp * &100 tend(k,j,i) = tend(k,j,i) - ukomp * & 92 101 ( v(k,j,i+1) - v(k,j,i) ) * ddx 93 102 ENDIF … … 96 105 vkomp = v(k,j,i) - v_gtrans 97 106 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 * & 99 108 ( v(k,j,i) - v(k,j-1,i) ) * ddy 100 109 ELSE 101 tend(k,j,i) = tend(k,j,i) - vkomp * &110 tend(k,j,i) = tend(k,j,i) - vkomp * & 102 111 ( v(k,j+1,i) - v(k,j,i) ) * ddy 103 112 ENDIF 104 113 ! 105 114 !-- 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) + & 107 116 w(k,j-1,i) + w(k-1,j-1,i) ) 108 117 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 * & 110 119 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) 111 120 ELSE 112 tend(k,j,i) = tend(k,j,i) - wkomp * &121 tend(k,j,i) = tend(k,j,i) - wkomp * & 113 122 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) 114 123 ENDIF … … 126 135 SUBROUTINE advec_v_up_ij( i, j ) 127 136 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 132 151 133 152 IMPLICIT NONE 134 153 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 !: 138 161 139 162 … … 141 164 ! 142 165 !-- 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) & 144 167 ) - u_gtrans 145 168 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 * & 147 170 ( v(k,j,i) - v(k,j,i-1) ) * ddx 148 171 ELSE 149 tend(k,j,i) = tend(k,j,i) - ukomp * &172 tend(k,j,i) = tend(k,j,i) - ukomp * & 150 173 ( v(k,j,i+1) - v(k,j,i) ) * ddx 151 174 ENDIF … … 154 177 vkomp = v(k,j,i) - v_gtrans 155 178 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 * & 157 180 ( v(k,j,i) - v(k,j-1,i) ) * ddy 158 181 ELSE 159 tend(k,j,i) = tend(k,j,i) - vkomp * &182 tend(k,j,i) = tend(k,j,i) - vkomp * & 160 183 ( v(k,j+1,i) - v(k,j,i) ) * ddy 161 184 ENDIF … … 164 187 wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) ) 165 188 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 * & 167 190 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) 168 191 ELSE 169 tend(k,j,i) = tend(k,j,i) - wkomp * &192 tend(k,j,i) = tend(k,j,i) - wkomp * & 170 193 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) 171 194 ENDIF -
palm/trunk/SOURCE/advec_w_pw.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! RCS Log replace by Id keyword, revision history cleaned up32 !33 ! Revision 1.15 2006/02/23 09:47:01 raasch34 ! nzb_2d replaced by nzb_w_inner35 35 ! 36 36 ! Revision 1.1 1997/08/11 06:10:29 raasch … … 62 62 SUBROUTINE advec_w_pw 63 63 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 68 78 69 79 IMPLICIT NONE 70 80 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 !: 73 87 74 88 … … 99 113 SUBROUTINE advec_w_pw_ij( i, j ) 100 114 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 105 129 106 130 IMPLICIT NONE 107 131 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 !: 110 138 111 139 gu = 2.0 * u_gtrans 112 140 gv = 2.0 * v_gtrans 113 141 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 * ( & 115 143 ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu ) & 116 144 - 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 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! RCS Log replace by Id keyword, revision history cleaned up32 !33 ! Revision 1.11 2006/02/23 09:47:23 raasch34 ! *** empty log message ***35 35 ! 36 36 ! Revision 1.1 1997/08/29 08:56:33 raasch … … 61 61 SUBROUTINE advec_w_up 62 62 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 67 77 68 78 IMPLICIT NONE 69 79 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 !: 72 86 73 87 … … 77 91 ! 78 92 !-- 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) + & 80 94 u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans 81 95 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 * & 83 97 ( w(k,j,i) - w(k,j,i-1) ) * ddx 84 98 ELSE 85 tend(k,j,i) = tend(k,j,i) - ukomp * &99 tend(k,j,i) = tend(k,j,i) - ukomp * & 86 100 ( w(k,j,i+1) - w(k,j,i) ) * ddx 87 101 ENDIF 88 102 ! 89 103 !-- 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) + & 91 105 v(k+1,j,i) + v(k+1,j+1,i) ) - v_gtrans 92 106 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 * & 94 108 ( w(k,j,i) - w(k,j-1,i) ) * ddy 95 109 ELSE 96 tend(k,j,i) = tend(k,j,i) - vkomp * &110 tend(k,j,i) = tend(k,j,i) - vkomp * & 97 111 ( w(k,j+1,i) - w(k,j,i) ) * ddy 98 112 ENDIF … … 100 114 !-- z-direction 101 115 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) * & 103 117 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) 104 118 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) * & 106 120 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) 107 121 ENDIF … … 119 133 SUBROUTINE advec_w_up_ij( i, j ) 120 134 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 125 149 126 150 IMPLICIT NONE 127 151 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 !: 130 158 131 159 … … 133 161 ! 134 162 !-- 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) & 136 164 ) - u_gtrans 137 165 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 * & 139 167 ( w(k,j,i) - w(k,j,i-1) ) * ddx 140 168 ELSE 141 tend(k,j,i) = tend(k,j,i) - ukomp * &169 tend(k,j,i) = tend(k,j,i) - ukomp * & 142 170 ( w(k,j,i+1) - w(k,j,i) ) * ddx 143 171 ENDIF 144 172 ! 145 173 !-- 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) & 147 175 ) - v_gtrans 148 176 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 * & 150 178 ( w(k,j,i) - w(k,j-1,i) ) * ddy 151 179 ELSE 152 tend(k,j,i) = tend(k,j,i) - vkomp * &180 tend(k,j,i) = tend(k,j,i) - vkomp * & 153 181 ( w(k,j+1,i) - w(k,j,i) ) * ddy 154 182 ENDIF … … 156 184 !-- z-direction 157 185 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) * & 159 187 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) 160 188 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) * & 162 190 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) 163 191 ENDIF -
palm/trunk/SOURCE/advec_ws.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 85 91 ! dimension. 86 92 ! 87 ! 743 2011-08-18 16:10:16Z suehring88 ! Evaluation of turbulent fluxes with WS-scheme only for the whole model89 ! domain. Therefor dimension of arrays needed for statistical evaluation90 ! decreased.91 !92 ! 736 2011-08-17 14:13:26Z suehring93 ! Bugfix concerning OpenMP parallelization. i_omp introduced, because first94 ! index where fluxes on left side have to be calculated explicitly is95 ! different on each thread. Furthermore the swapping of fluxes is now96 ! thread-safe by adding an additional dimension.97 !98 ! 713 2011-03-30 14:21:21Z suehring99 ! File reformatted.100 ! Bugfix in vertical advection of w concerning the optimized version for101 ! vector architecture.102 ! Constants adv_mom_3, adv_mom_5, adv_sca_5, adv_sca_3 reformulated as103 ! broken numbers.104 !105 ! 709 2011-03-30 09:31:40Z raasch106 ! formatting adjustments107 !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 suehring112 ! 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 from115 ! flow_statistics).116 !117 93 ! Initial revision 118 94 ! … … 186 162 SUBROUTINE ws_init 187 163 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 192 185 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 194 191 195 192 ! … … 205 202 IF ( ws_scheme_mom ) THEN 206 203 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), & 211 208 sums_ws2_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 212 209 … … 229 226 ENDIF 230 227 231 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. &228 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. & 232 229 precipitation ) THEN 233 230 ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) … … 253 250 IF ( ws_scheme_mom ) THEN 254 251 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), & 260 257 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), & 266 263 diss_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 267 264 … … 270 267 IF ( ws_scheme_sca ) THEN 271 268 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), & 275 272 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), & 279 276 diss_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 280 277 281 278 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), & 283 280 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), & 285 282 diss_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 286 283 ENDIF 287 284 288 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. &285 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. & 289 286 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), & 293 290 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), & 297 294 diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 298 295 ENDIF 299 296 300 297 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), & 302 299 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), & 304 301 diss_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 305 302 ENDIF … … 317 314 SUBROUTINE ws_statistics 318 315 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 321 324 322 325 IMPLICIT NONE … … 336 339 sums_wspts_ws_l = 0.0 337 340 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. & 339 342 precipitation ) THEN 340 343 sums_wsqrs_ws_l = 0.0 … … 351 354 ! Scalar advection - Call for grid point i,j 352 355 !------------------------------------------------------------------------------! 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, & 355 358 swap_diss_x_local, i_omp, tn ) 356 359 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 362 377 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 364 382 365 383 IMPLICIT NONE 366 384 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 370 411 #if defined( __nopointer ) 371 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk412 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 372 413 #else 373 REAL , DIMENSION(:,:,:), POINTER :: sk414 REAL(wp), DIMENSION(:,:,:), POINTER :: sk !: 374 415 #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 383 429 384 430 ! … … 800 846 SUBROUTINE advec_u_ws_ij( i, j, i_omp, tn ) 801 847 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 808 867 809 868 IMPLICIT NONE 810 869 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 !: 816 904 817 905 gu = 2.0 * u_gtrans … … 1212 1300 SUBROUTINE advec_v_ws_ij( i, j, i_omp, tn ) 1213 1301 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 1220 1321 1221 1322 IMPLICIT NONE 1222 1323 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 !: 1228 1358 1229 1359 gu = 2.0 * u_gtrans … … 1631 1761 SUBROUTINE advec_w_ws_ij( i, j, i_omp, tn ) 1632 1762 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 1639 1783 1640 1784 IMPLICIT NONE 1641 1785 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 !: 1647 1819 1648 1820 gu = 2.0 * u_gtrans … … 2027 2199 SUBROUTINE advec_s_ws( sk, sk_char ) 2028 2200 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 2035 2221 2036 2222 IMPLICIT NONE 2037 2223 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 2040 2243 #if defined( __nopointer ) 2041 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk2244 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !: 2042 2245 #else 2043 REAL , DIMENSION(:,:,:), POINTER :: sk2246 REAL(wp), DIMENSION(:,:,:), POINTER :: sk !: 2044 2247 #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 2052 2268 2053 2269 ! … … 2439 2655 SUBROUTINE advec_s_ws_acc ( sk, sk_char ) 2440 2656 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 2447 2678 2448 2679 IMPLICIT NONE 2449 2680 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 !: 2459 2718 2460 2719 ! … … 2719 2978 SUBROUTINE advec_u_ws 2720 2979 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 2727 2999 2728 3000 IMPLICIT NONE 2729 3001 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 !: 2738 3040 2739 3041 gu = 2.0 * u_gtrans … … 3137 3439 SUBROUTINE advec_u_ws_acc 3138 3440 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 3145 3461 3146 3462 IMPLICIT NONE 3147 3463 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 !: 3154 3502 3155 3503 … … 3424 3772 SUBROUTINE advec_v_ws 3425 3773 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 3432 3793 3433 3794 IMPLICIT NONE 3434 3795 3435 3796 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 !: 3444 3835 3445 3836 gu = 2.0 * u_gtrans … … 3852 4243 SUBROUTINE advec_v_ws_acc 3853 4244 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 3860 4265 3861 4266 IMPLICIT NONE 3862 4267 3863 4268 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 !: 3870 4307 3871 4308 gu = 2.0 * u_gtrans … … 4141 4578 SUBROUTINE advec_w_ws 4142 4579 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 4149 4600 4150 4601 IMPLICIT NONE 4151 4602 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 !: 4161 4641 4162 4642 gu = 2.0 * u_gtrans … … 4546 5026 SUBROUTINE advec_w_ws_acc 4547 5027 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 4554 5048 4555 5049 IMPLICIT NONE 4556 5050 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 !: 4563 5089 4564 5090 gu = 2.0 * u_gtrans -
palm/trunk/SOURCE/average_3d_data.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 41 46 ! 978 2012-08-09 08:28:32Z fricke 42 47 ! +z0h_av 43 !44 ! 771 2011-10-27 10:56:21Z heinze45 ! +lpt_av46 !47 ! 667 2010-12-23 12:06:00Z suehring/gryschka48 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng49 !50 ! 367 2009-08-25 08:35:52Z maronga51 ! Added calculation of shf* and qsws*52 !53 ! 96 2007-06-04 08:07:41Z raasch54 ! Averaging of density and salinity55 !56 ! 72 2007-03-19 08:20:46Z raasch57 ! Averaging the precipitation rate and roughness length (prr*, z0*)58 !59 ! RCS Log replace by Id keyword, revision history cleaned up60 48 ! 61 49 ! Revision 1.1 2006/02/23 09:48:58 raasch … … 68 56 !------------------------------------------------------------------------------! 69 57 70 USE arrays_3d71 58 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 76 71 77 72 IMPLICIT NONE 78 73 79 INTEGER :: i, ii, j, k 74 INTEGER(iwp) :: i !: 75 INTEGER(iwp) :: ii !: 76 INTEGER(iwp) :: j !: 77 INTEGER(iwp) :: k !: 80 78 81 79 … … 165 163 DO i = nxlg, nxrg 166 164 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) / & 168 166 REAL( average_count_3d ) 169 167 ENDDO … … 228 226 DO j = nysg, nyng 229 227 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) / & 231 229 REAL( average_count_3d ) 232 230 ENDDO -
palm/trunk/SOURCE/boundary_conds.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 67 72 ! 875 2012-04-02 15:35:15Z gryschka 68 73 ! Bugfix in case of dirichlet inflow bc at the right or north boundary 69 !70 ! 767 2011-10-14 06:39:12Z raasch71 ! ug,vg replaced by u_init,v_init as the Dirichlet top boundary condition72 !73 ! 667 2010-12-23 12:06:00Z suehring/gryschka74 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng75 ! Removed mirror boundary conditions for u and v at the bottom in case of76 ! ibc_uv_b == 0. Instead, dirichelt boundary conditions (u=v=0) are set77 ! in init_3d_model78 !79 ! 107 2007-08-17 13:54:45Z raasch80 ! Boundary conditions for temperature adjusted for coupled runs,81 ! bugfixes for the radiation boundary conditions at the outflow: radiation82 ! conditions are used for every substep, phase speeds are calculated for the83 ! first Runge-Kutta substep only and then reused, several index values changed84 !85 ! 95 2007-06-02 16:48:38Z raasch86 ! Boundary conditions for salinity added87 !88 ! 75 2007-03-22 09:54:05Z raasch89 ! 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 humidity92 !93 ! 19 2007-02-23 04:53:48Z raasch94 ! Boundary conditions for e(nzt), pt(nzt), and q(nzt) removed because these95 ! gridpoints are now calculated by the prognostic equation,96 ! Dirichlet and zero gradient condition for pt established at top boundary97 !98 ! RCS Log replace by Id keyword, revision history cleaned up99 !100 ! Revision 1.15 2006/02/23 09:54:55 raasch101 ! Surface boundary conditions in case of topography: nzb replaced by102 ! 2d-k-index-arrays (nzb_w_inner, etc.). Conditions for u and v remain103 ! unchanged (still using nzb) because a non-flat topography must use a104 ! Prandtl-layer, which don't requires explicit setting of the surface values.105 74 ! 106 75 ! Revision 1.1 1997/09/12 06:21:34 raasch … … 117 86 !------------------------------------------------------------------------------! 118 87 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 123 113 USE pegrid 124 114 115 125 116 IMPLICIT NONE 126 117 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 !: 130 124 131 125 … … 271 265 q_p(nzt+1,:,:) = q_p(nzt,:,:) + bc_q_t_val * dzu(nzt+1) 272 266 273 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. &267 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. & 274 268 precipitation ) THEN 275 269 ! … … 312 306 IF ( humidity .OR. passive_scalar ) THEN 313 307 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. & 315 309 precipitation) THEN 316 310 qr_p(:,nys-1,:) = qr_p(:,nys,:) … … 323 317 IF ( humidity .OR. passive_scalar ) THEN 324 318 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. & 326 320 precipitation ) THEN 327 321 qr_p(:,nyn+1,:) = qr_p(:,nyn,:) … … 334 328 IF ( humidity .OR. passive_scalar ) THEN 335 329 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. & 337 331 precipitation ) THEN 338 332 qr_p(:,:,nxl-1) = qr_p(:,:,nxl) -
palm/trunk/SOURCE/buoyancy.f90
r1310 r1320 20 20 ! Currrent revisions: 21 21 ! ------------------ 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 23 28 ! 24 29 ! Former revisions: … … 55 60 ! 1010 2012-09-20 07:59:54Z raasch 56 61 ! cpp switch __nopointer added for pointer free version 57 !58 ! 622 2010-12-10 08:08:13Z raasch59 ! optional barriers included in order to speed up collective operations60 !61 ! 515 2010-03-18 02:30:38Z raasch62 ! 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 heinze66 ! Output of messages replaced by message handling routine67 !68 ! 132 2007-11-20 09:46:11Z letzel69 ! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.70 !71 ! 106 2007-08-16 14:30:26Z raasch72 ! i loop for u-component (sloping surface) is starting from nxlu (needed for73 ! non-cyclic boundary conditions)74 !75 ! 97 2007-06-21 08:23:15Z raasch76 ! 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_profile80 !81 ! 57 2007-03-09 12:05:41Z raasch82 ! Reference temperature pt_reference can be used.83 !84 ! RCS Log replace by Id keyword, revision history cleaned up85 !86 ! Revision 1.19 2006/04/26 12:09:56 raasch87 ! OpenMP optimization (one dimension added to sums_l)88 62 ! 89 63 ! Revision 1.1 1997/08/29 08:56:48 raasch … … 121 95 SUBROUTINE buoyancy( var, wind_component ) 122 96 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 126 109 USE pegrid 127 110 111 128 112 IMPLICIT NONE 129 113 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 131 119 #if defined( __nopointer ) 132 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var120 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 133 121 #else 134 REAL , DIMENSION(:,:,:), POINTER :: var122 REAL(wp), DIMENSION(:,:,:), POINTER :: var 135 123 #endif 136 124 … … 185 173 ELSE 186 174 187 WRITE( message_string, * ) 'no term for component "', &175 WRITE( message_string, * ) 'no term for component "', & 188 176 wind_component,'"' 189 177 CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 ) … … 201 189 SUBROUTINE buoyancy_acc( var, wind_component ) 202 190 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 206 204 USE pegrid 207 205 206 208 207 IMPLICIT NONE 209 208 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 211 214 #if defined( __nopointer ) 212 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var215 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 213 216 #else 214 REAL , DIMENSION(:,:,:), POINTER :: var217 REAL(wp), DIMENSION(:,:,:), POINTER :: var 215 218 #endif 216 219 … … 269 272 ELSE 270 273 271 WRITE( message_string, * ) 'no term for component "', &274 WRITE( message_string, * ) 'no term for component "', & 272 275 wind_component,'"' 273 276 CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 ) … … 288 291 SUBROUTINE buoyancy_ij( i, j, var, wind_component ) 289 292 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 293 305 USE pegrid 294 306 307 295 308 IMPLICIT NONE 296 309 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 298 316 #if defined( __nopointer ) 299 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var317 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 300 318 #else 301 REAL , DIMENSION(:,:,:), POINTER :: var319 REAL(wp), DIMENSION(:,:,:), POINTER :: var 302 320 #endif 303 321 … … 307 325 !-- Normal case: horizontal surface 308 326 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) & 312 330 ) 313 331 ENDDO … … 340 358 ELSE 341 359 342 WRITE( message_string, * ) 'no term for component "', &360 WRITE( message_string, * ) 'no term for component "', & 343 361 wind_component,'"' 344 362 CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 ) … … 361 379 !------------------------------------------------------------------------------! 362 380 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 366 392 USE pegrid 367 USE statistics 393 394 USE statistics, & 395 ONLY: flow_statistics_called, hom, sums, sums_l 396 368 397 369 398 IMPLICIT NONE 370 399 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 373 409 #if defined( __nopointer ) 374 REAL , DIMENSION(:,:,:) :: var410 REAL(wp), DIMENSION(:,:,:) :: var !: 375 411 #else 376 REAL , DIMENSION(:,:,:), POINTER :: var412 REAL(wp), DIMENSION(:,:,:), POINTER :: var 377 413 #endif 378 414 … … 383 419 !-- spare communication time and to produce identical model results with jobs 384 420 !-- which are calling flow_statistics at different time intervals. 385 IF ( .NOT. flow_statistics_called .AND. &421 IF ( .NOT. flow_statistics_called .AND. & 386 422 intermediate_timestep_count == 1 ) THEN 387 423 … … 409 445 410 446 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, & 412 448 MPI_REAL, MPI_SUM, comm2d, ierr ) 413 449 -
palm/trunk/SOURCE/calc_liquid_water_content.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 38 43 ! code put under GPL (PALM 3.9) 39 44 ! 40 ! 667 2010-12-23 12:06:00Z suehring/gyschka41 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng42 !43 ! 95 2007-06-02 16:48:38Z raasch44 ! hydro_press renamed hyp45 !46 ! 19 2007-02-23 04:53:48Z raasch47 ! Old comment removed48 !49 ! RCS Log replace by Id keyword, revision history cleaned up50 !51 ! Revision 1.5 2005/03/26 15:22:06 raasch52 ! Arguments for non-cyclic boundary conditions added to argument list of53 ! routine exchange_horiz,54 ! ql calculated for the ghost points, exchange of ghost points removed55 !56 45 ! Revision 1.1 2000/04/13 14:50:45 schroeter 57 46 ! Initial revision … … 67 56 68 57 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 75 72 USE pegrid 73 76 74 77 75 IMPLICIT NONE 78 76 79 INTEGER :: i, j, k 77 INTEGER(iwp) :: i !: 78 INTEGER(iwp) :: j !: 79 INTEGER(iwp) :: k !: 80 80 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 !: 82 85 83 86 DO i = nxlg, nxrg … … 91 94 ! 92 95 !-- 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 ) / & 94 97 ( t_l - 35.86 ) ) 95 98 -
palm/trunk/SOURCE/calc_precipitation.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 403 2009-10-22 13:57:16Z franke32 ! Bugfix in calculation of precipitation_rate(j,i)33 !34 ! 73 2007-03-20 08:33:14Z raasch35 ! Precipitation rate and amount are calculated/stored,36 ! + module control_parameters37 !38 ! 19 2007-02-23 04:53:48Z raasch39 ! Calculation extended for gridpoint nzt40 !41 ! RCS Log replace by Id keyword, revision history cleaned up42 !43 ! Revision 1.5 2004/01/30 10:15:57 raasch44 ! Scalar lower k index nzb replaced by 2d-array nzb_2d45 35 ! 46 36 ! Revision 1.1 2000/04/13 14:45:22 schroeter … … 71 61 SUBROUTINE calc_precipitation 72 62 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 78 80 79 81 IMPLICIT NONE 80 82 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 !: 83 88 84 89 precipitation_rate = 0.0 … … 96 101 ! 97 102 !-- 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) + & 99 104 dqdt_precip * dzw(k) 100 105 … … 102 107 ! 103 108 !-- 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. & 106 111 ( dt_do2d_xy-time_do2d_xy ) < precipitation_amount_interval )& 107 112 THEN 108 precipitation_amount(j,i) = precipitation_amount(j,i) + &113 precipitation_amount(j,i) = precipitation_amount(j,i) + & 109 114 precipitation_rate(j,i) * dt_3d 110 115 ENDIF … … 120 125 SUBROUTINE calc_precipitation_ij( i, j ) 121 126 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 127 144 128 145 IMPLICIT NONE 129 146 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 !: 132 152 133 153 precipitation_rate(j,i) = 0.0 … … 147 167 ! 148 168 !-- 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 * & 150 170 dzw(k) 151 171 … … 157 177 .AND. ( dt_do2d_xy-time_do2d_xy ) < precipitation_amount_interval )& 158 178 THEN 159 precipitation_amount(j,i) = precipitation_amount(j,i) + &179 precipitation_amount(j,i) = precipitation_amount(j,i) + & 160 180 precipitation_rate(j,i) * dt_3d 161 181 ENDIF -
palm/trunk/SOURCE/calc_radiation.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! RCS Log replace by Id keyword, revision history cleaned up32 !33 ! Revision 1.6 2004/01/30 10:17:03 raasch34 ! Scalar lower k index nzb replaced by 2d-array nzb_2d35 35 ! 36 36 ! Revision 1.1 2000/04/13 14:42:45 schroeter … … 43 43 ! based on the parameterization of the cloud effective emissivity 44 44 !------------------------------------------------------------------------------! 45 45 USE kinds 46 46 47 PRIVATE 47 48 PUBLIC calc_radiation 48 49 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 !: 54 56 55 57 INTERFACE calc_radiation … … 66 68 SUBROUTINE calc_radiation 67 69 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 72 84 USE pegrid 73 85 86 74 87 IMPLICIT NONE 75 88 76 INTEGER :: i, j, k, k_help 89 INTEGER(iwp) :: i !: 90 INTEGER(iwp) :: j !: 91 INTEGER(iwp) :: k !: 92 INTEGER(iwp) :: k_help !: 77 93 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 !: 82 106 83 107 … … 85 109 !-- On first call, allocate temporary arrays 86 110 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), & 88 112 lwp_top(nzb:nzt+1) ) 89 113 first_call = .FALSE. … … 105 129 106 130 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) * & 108 132 dzw(k) 109 133 110 lwp_top(k_help) = lwp_top(k_help+1) + &134 lwp_top(k_help) = lwp_top(k_help+1) + & 111 135 rho_surface * ql(k_help,j,i) * dzw(k_help) 112 136 … … 116 140 ENDDO 117 141 118 lwp_ground(nzt+1) = lwp_ground(nzt) + &142 lwp_ground(nzt+1) = lwp_ground(nzt) + & 119 143 rho_surface * ql(nzt+1,j,i) * dzw(nzt+1) 120 144 lwp_top(nzb) = lwp_top(nzb+1) 121 145 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 * & 123 147 ql(nzt+1,j,i) 124 148 blackbody_emission(nzt+1) = sigma * temperature**4.0 … … 135 159 ! 136 160 !-- Compute effective emissivities 137 effective_emission_up_p = 1.0 - &161 effective_emission_up_p = 1.0 - & 138 162 EXP( -130.0 * lwp_ground(k+1) ) 139 effective_emission_up_m = 1.0 - &163 effective_emission_up_m = 1.0 - & 140 164 EXP( -130.0 * lwp_ground(k-1) ) 141 effective_emission_down_p = 1.0 - &165 effective_emission_down_p = 1.0 - & 142 166 EXP( -158.0 * lwp_top(k+1) ) 143 effective_emission_down_m = 1.0 - &167 effective_emission_down_m = 1.0 - & 144 168 EXP( -158.0 * lwp_top(k-1) ) 145 169 146 170 ! 147 171 !-- 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 * & 150 174 ( blackbody_emission(k) - blackbody_emission(nzb) ) 151 175 152 f_up_m = blackbody_emission(nzb) + &153 effective_emission_up_m * &176 f_up_m = blackbody_emission(nzb) + & 177 effective_emission_up_m * & 154 178 ( blackbody_emission(k-1) - blackbody_emission(nzb) ) 155 179 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 * & 158 182 ( blackbody_emission(k) - impinging_flux_at_top ) 159 183 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 * & 162 186 ( blackbody_emission(k-1) - impinging_flux_at_top ) 163 187 … … 169 193 ! 170 194 !-- 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 ) * & 173 197 ( df_p - df_m ) / dzw(k) ) 174 198 … … 187 211 SUBROUTINE calc_radiation_ij( i, j ) 188 212 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 193 227 USE pegrid 228 194 229 195 230 IMPLICIT NONE 196 231 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 204 251 ! 205 252 !-- On first call, allocate temporary arrays 206 253 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), & 208 255 lwp_top(nzb:nzt+1) ) 209 256 first_call = .FALSE. … … 223 270 lwp_ground(k) = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k) 224 271 225 lwp_top(k_help) = lwp_top(k_help+1) + &272 lwp_top(k_help) = lwp_top(k_help+1) + & 226 273 rho_surface * ql(k_help,j,i) * dzw(k_help) 227 274 … … 230 277 231 278 ENDDO 232 lwp_ground(nzt+1) = lwp_ground(nzt) + &279 lwp_ground(nzt+1) = lwp_ground(nzt) + & 233 280 rho_surface * ql(nzt+1,j,i) * dzw(nzt+1) 234 281 lwp_top(nzb) = lwp_top(nzb+1) 235 282 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 * & 237 284 ql(nzt+1,j,i) 238 285 blackbody_emission(nzt+1) = sigma * temperature**4.0 … … 249 296 ! 250 297 !-- Compute effective emissivities 251 effective_emission_up_p = 1.0 - &298 effective_emission_up_p = 1.0 - & 252 299 EXP( -130.0 * lwp_ground(k+1) ) 253 effective_emission_up_m = 1.0 - &300 effective_emission_up_m = 1.0 - & 254 301 EXP( -130.0 * lwp_ground(k-1) ) 255 effective_emission_down_p = 1.0 - &302 effective_emission_down_p = 1.0 - & 256 303 EXP( -158.0 * lwp_top(k+1) ) 257 effective_emission_down_m = 1.0 - &304 effective_emission_down_m = 1.0 - & 258 305 EXP( -158.0 * lwp_top(k-1) ) 259 306 260 307 ! 261 308 !-- 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 * & 263 310 ( blackbody_emission(k) - blackbody_emission(nzb) ) 264 311 265 f_up_m = blackbody_emission(nzb) + effective_emission_up_m * &312 f_up_m = blackbody_emission(nzb) + effective_emission_up_m * & 266 313 ( blackbody_emission(k-1) - blackbody_emission(nzb) ) 267 314 268 f_down_p = impinging_flux_at_top + effective_emission_down_p * &315 f_down_p = impinging_flux_at_top + effective_emission_down_p * & 269 316 ( blackbody_emission(k) - impinging_flux_at_top ) 270 317 271 f_down_m = impinging_flux_at_top + effective_emission_down_m * &318 f_down_m = impinging_flux_at_top + effective_emission_down_m * & 272 319 ( blackbody_emission(k-1) - impinging_flux_at_top ) 273 320 … … 279 326 ! 280 327 !-- 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 ) * & 282 329 ( df_p - df_m ) / dzw(k) ) 283 330 -
palm/trunk/SOURCE/calc_spectra.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 41 46 ! 1003 2012-09-14 14:35:53Z raasch 42 47 ! adjustment of array tend for cases with unequal subdomain sizes removed 43 !44 ! 707 2011-03-29 11:39:40Z raasch45 ! bc_lr/ns replaced by bc_lr/ns_cyc46 !47 ! 667 2010-12-23 12:06:00Z suehring/gryschka48 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation49 ! of tend50 !51 ! 274 2009-03-26 15:11:21Z heinze52 ! Output of messages replaced by message handling routine53 !54 ! 225 2009-01-26 14:44:20Z raasch55 ! Bugfix: array d is reallocated in case that multigrid is used56 !57 ! 192 2008-08-27 16:51:49Z letzel58 ! bugfix in calc_spectra_x: exponent = 1.0 / ( ny + 1.0 )59 ! allow 100 spectra levels instead of 10 for consistency with60 ! define_netcdf_header61 ! user-defined spectra, arguments removed from transpose routines62 !63 ! February 200764 ! RCS Log replace by Id keyword, revision history cleaned up65 !66 ! Revision 1.9 2006/04/11 14:56:00 raasch67 ! pl_spectra renamed data_output_sp68 48 ! 69 49 ! Revision 1.1 2001/01/05 15:08:07 raasch … … 81 61 82 62 #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 88 80 USE pegrid 89 USE spectrum 81 82 USE spectrum, & 83 ONLY: data_output_sp, spectra_direction 84 90 85 91 86 IMPLICIT NONE 92 87 93 INTEGER :: m, pr 88 INTEGER(iwp) :: m !: 89 INTEGER(iwp) :: pr !: 94 90 95 91 … … 163 159 CALL calc_spectra_y( d, pr, m ) 164 160 #else 165 message_string = 'sorry, calculation of spectra in non parallel' // &161 message_string = 'sorry, calculation of spectra in non parallel' // & 166 162 'mode& is still not realized' 167 163 CALL message( 'calc_spectra', 'PA0161', 1, 2, 0, 6, 0 ) … … 189 185 SUBROUTINE preprocess_spectra( m, pr ) 190 186 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 193 195 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 196 203 197 204 IMPLICIT NONE 198 205 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 !: 200 211 201 212 SELECT CASE ( TRIM( data_output_sp(m) ) ) … … 247 258 SUBROUTINE calc_spectra_x( ddd, pr, m ) 248 259 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 255 277 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 258 285 USE transpose_indices 259 286 287 260 288 IMPLICIT NONE 261 289 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 !: 270 308 271 309 ! … … 320 358 #if defined( __parallel ) 321 359 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, & 323 361 MPI_REAL, MPI_PROD, 0, comm2d, ierr ) 324 362 #else … … 357 395 SUBROUTINE calc_spectra_y( ddd, pr, m ) 358 396 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 365 414 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 368 422 USE transpose_indices 369 423 424 370 425 IMPLICIT NONE 371 426 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 !: 380 445 381 446 … … 431 496 #if defined( __parallel ) 432 497 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, & 434 499 MPI_REAL, MPI_PROD, 0, comm2d, ierr ) 435 500 #else -
palm/trunk/SOURCE/check_for_restart.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 32 37 ! minor reformatting 33 38 ! 34 ! 667 2010-12-23 12:06:00Z suehring/gryschka35 ! Exchange of terminate_coupled between ocean and atmosphere by PE036 !37 ! 622 2010-12-10 08:08:13Z raasch38 ! optional barriers included in order to speed up collective operations39 !40 ! 291 2009-04-16 12:07:26Z raasch41 ! Coupling with independent precursor runs.42 ! Output of messages replaced by message handling routine43 !44 ! 222 2009-01-12 16:04:16Z letzel45 ! Implementation of an MPI-1 coupling: replaced myid with target_id46 ! Bugfix for nonparallel execution47 !48 ! 108 2007-08-24 15:10:38Z letzel49 ! modifications to terminate coupled runs50 !51 ! RCS Log replace by Id keyword, revision history cleaned up52 !53 ! Revision 1.11 2007/02/11 12:55:13 raasch54 ! Informative output to the job protocol55 !56 39 ! Revision 1.1 1998/03/18 20:06:51 raasch 57 40 ! Initial revision … … 64 47 !------------------------------------------------------------------------------! 65 48 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 66 56 USE pegrid 67 USE control_parameters68 57 69 58 IMPLICIT NONE 70 59 71 60 72 LOGICAL :: terminate_run_l 73 REAL :: remaining_time 61 LOGICAL :: terminate_run_l !: 62 63 REAL(wp) :: remaining_time !: 74 64 75 65 … … 81 71 !-- If necessary set a flag to stop the model run 82 72 terminate_run_l = .FALSE. 83 IF ( remaining_time <= termination_time_needed .AND. &73 IF ( remaining_time <= termination_time_needed .AND. & 84 74 write_binary(1:4) == 'true' ) THEN 85 75 … … 92 82 !-- one processor has reached the time limit. 93 83 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, & 95 85 MPI_LOR, comm2d, ierr ) 96 86 #else … … 101 91 !-- Output that job will be terminated 102 92 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', & 106 96 'termination time needed:', termination_time_needed, ' s' 107 97 CALL message( 'check_for_restart', 'PA0163', 0, 1, 0, 6, 0 ) … … 113 103 !-- informed of another termination reason (terminate_coupled > 0) before, 114 104 !-- 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. & 116 106 terminate_coupled == 0 .AND. terminate_coupled_remote == 0 ) THEN 117 107 … … 125 115 comm_inter, status, ierr ) 126 116 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, & 128 118 ierr ) 129 119 #endif … … 132 122 ! 133 123 !-- 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. & 135 125 time_restart < time_since_reference_point ) THEN 136 126 … … 149 139 ENDIF 150 140 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', & 154 144 '&new restart time is: ', time_restart, ' s' 155 145 CALL message( 'check_for_restart', 'PA0164', 0, 0, 0, 6, 0 ) … … 160 150 !-- informed of another termination reason (terminate_coupled > 0) before, 161 151 !-- 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 & 163 153 .AND. terminate_coupled_remote == 0 ) THEN 164 154 … … 176 166 comm_inter, status, ierr ) 177 167 ENDIF 178 CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, &168 CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, & 179 169 comm2d, ierr ) 180 170 #endif -
palm/trunk/SOURCE/check_namelist_files.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! ONLY-attribute added to USE-statements 23 23 ! 24 24 ! Former revisions: … … 51 51 52 52 53 USE control_parameters, & 54 ONLY: check_restart, max_pr_user 55 53 56 USE pegrid 54 USE control_parameters 57 55 58 56 59 IMPLICIT NONE -
palm/trunk/SOURCE/check_open.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 52 58 ! 807 2012-01-25 11:53:51Z maronga 53 59 ! 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 netCDF456 !57 ! 667 2010-12-23 12:06:00Z suehring/gryschka58 ! Output of total array size was adapted to nbgp.59 !60 ! 600 2010-11-24 16:10:51Z raasch61 ! bugfix in opening of cross section netcdf-files (parallel opening with62 ! netcdf4 only works for netcdf_data_format > 2)63 !64 ! 564 2010-09-30 13:18:59Z helmke65 ! start number of mask output files changed to 201, netcdf message identifiers66 ! of masked output changed67 !68 ! 519 2010-03-19 05:30:02Z raasch69 ! netCDF4 support for particle data70 !71 ! 493 2010-03-01 08:30:24Z raasch72 ! netCDF4 support (parallel output)73 !74 ! 410 2009-12-04 17:05:40Z letzel75 ! masked data output76 !77 ! 277 2009-03-31 09:13:47Z heinze78 ! Output of netCDF messages with aid of message handling routine.79 ! Output of messages replaced by message handling routine80 !81 ! 146 2008-01-17 13:08:34Z raasch82 ! 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 removed85 !86 ! 120 2007-10-17 11:54:43Z raasch87 ! Status of 3D-volume netCDF data file only depends on switch netcdf_64bit_3d88 !89 ! 105 2007-08-08 07:12:55Z raasch90 ! Different filenames are used in case of a coupled simulation,91 ! coupling_char added to all relevant filenames92 !93 ! 82 2007-04-16 15:40:52Z raasch94 ! Call of local_getenv removed, preprocessor directives for old systems removed95 !96 ! 46 2007-03-05 06:00:47Z raasch97 ! +netcdf_64bit_3d to switch on 64bit offset only for 3D files98 !99 ! RCS Log replace by Id keyword, revision history cleaned up100 !101 ! Revision 1.44 2006/08/22 13:48:34 raasch102 ! xz and yz cross sections now up to nzt+1103 60 ! 104 61 ! Revision 1.1 1997/08/11 06:10:55 raasch … … 112 69 !------------------------------------------------------------------------------! 113 70 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 118 88 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 120 94 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 124 102 125 103 IMPLICIT NONE 126 104 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, & 155 164 timodex, twoxa, twoya, xtext 156 165 … … 169 178 CASE ( 13, 14, 21, 22, 23, 80:85 ) 170 179 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 ' // & 172 181 '14 is not verified. Please check results!' 173 182 CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 ) … … 175 184 176 185 CASE DEFAULT 177 WRITE( message_string, * ) 're-opening of file-id ', file_id, &186 WRITE( message_string, * ) 're-opening of file-id ', file_id, & 178 187 ' is not allowed' 179 188 CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 ) … … 192 201 193 202 IF ( myid /= 0 ) THEN 194 WRITE( message_string, * ) 'opening file-id ',file_id, &203 WRITE( message_string, * ) 'opening file-id ',file_id, & 195 204 ' not allowed for PE ',myid 196 205 CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 ) … … 202 211 203 212 IF ( myid /= 0 ) THEN 204 WRITE( message_string, * ) 'opening file-id ',file_id, &213 WRITE( message_string, * ) 'opening file-id ',file_id, & 205 214 ' not allowed for PE ',myid 206 215 CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 ) … … 213 222 IF ( .NOT. data_output_2d_on_each_pe ) THEN 214 223 IF ( myid /= 0 ) THEN 215 WRITE( message_string, * ) 'opening file-id ',file_id, &224 WRITE( message_string, * ) 'opening file-id ',file_id, & 216 225 ' not allowed for PE ',myid 217 226 CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 ) … … 223 232 ! 224 233 !-- 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, & 226 235 ' is not allowed since it is used otherwise' 227 236 CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 ) … … 241 250 !-- check_namelist_files! 242 251 IF ( check_restart == 2 ) THEN 243 OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED', &252 OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED', & 244 253 STATUS='OLD' ) 245 254 ELSE 246 OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &255 OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', & 247 256 STATUS='OLD' ) 248 257 END IF 249 258 #else 250 259 251 OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &260 OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', & 252 261 STATUS='OLD' ) 253 262 #endif … … 256 265 257 266 IF ( myid_char == '' ) THEN 258 OPEN ( 13, FILE='BININ'//coupling_char//myid_char, &267 OPEN ( 13, FILE='BININ'//coupling_char//myid_char, & 259 268 FORM='UNFORMATTED', STATUS='OLD' ) 260 269 ELSE … … 263 272 !-- this file contains the global variables 264 273 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', & 266 275 FORM='UNFORMATTED', STATUS='OLD' ) 267 276 ELSE … … 274 283 275 284 IF ( myid_char == '' ) THEN 276 OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, &285 OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, & 277 286 FORM='UNFORMATTED', POSITION='APPEND' ) 278 287 ELSE … … 286 295 CALL MPI_BARRIER( comm2d, ierr ) 287 296 #endif 288 OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &297 OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, & 289 298 FORM='UNFORMATTED' ) 290 299 ENDIF … … 316 325 ENDIF 317 326 IF ( myid_char == '' ) THEN 318 OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', &327 OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', & 319 328 FORM='UNFORMATTED', POSITION='APPEND' ) 320 329 ELSE … … 332 341 333 342 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, & 335 344 FORM='UNFORMATTED', POSITION='APPEND' ) 336 345 ELSE 337 OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, &346 OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, & 338 347 FORM='UNFORMATTED', POSITION='APPEND' ) 339 348 ENDIF … … 363 372 !-- Create output file for local parameters 364 373 IF ( iso2d_output ) THEN 365 OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, &374 OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, & 366 375 FORM='FORMATTED', DELIM='APOSTROPHE' ) 367 376 openfile(27)%opened = .TRUE. … … 373 382 374 383 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, & 376 385 FORM='UNFORMATTED', POSITION='APPEND' ) 377 386 ELSE 378 OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', &387 OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', & 379 388 POSITION='APPEND' ) 380 389 ENDIF … … 402 411 ! 403 412 !-- Create output file for local parameters 404 OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, &413 OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, & 405 414 FORM='FORMATTED', DELIM='APOSTROPHE' ) 406 415 openfile(28)%opened = .TRUE. … … 411 420 412 421 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, & 414 423 FORM='UNFORMATTED', POSITION='APPEND' ) 415 424 ELSE 416 OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', &425 OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', & 417 426 POSITION='APPEND' ) 418 427 ENDIF … … 440 449 ! 441 450 !-- Create output file for local parameters 442 OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, &451 OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, & 443 452 FORM='FORMATTED', DELIM='APOSTROPHE' ) 444 453 openfile(29)%opened = .TRUE. … … 448 457 CASE ( 30 ) 449 458 450 OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &459 OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, & 451 460 FORM='UNFORMATTED' ) 452 461 ! … … 471 480 472 481 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. & 474 483 .NOT. avs_data_file_found ) 475 484 476 READ ( 3, '(A)', END=1 ) zeile477 478 SELECT CASE ( zeile(1:11) )485 READ ( 3, '(A)', END=1 ) line 486 487 SELECT CASE ( line(1:11) ) 479 488 480 489 CASE ( 'PLOT3D_COOR' ) 481 READ ( 3, '(A/A)' ) avs_coor_file_catalog, &490 READ ( 3, '(A/A)' ) avs_coor_file_catalog, & 482 491 avs_coor_file_localname 483 492 avs_coor_file_found = .TRUE. 484 493 485 494 CASE ( 'PLOT3D_DATA' ) 486 READ ( 3, '(A/A)' ) avs_data_file_catalog, &495 READ ( 3, '(A/A)' ) avs_data_file_catalog, & 487 496 avs_data_file_localname 488 497 avs_data_file_found = .TRUE. 489 498 490 499 CASE DEFAULT 491 READ ( 3, '(A/A)' ) zeile, zeile500 READ ( 3, '(A/A)' ) line, line 492 501 493 502 END SELECT … … 498 507 !-- using batch_scp 499 508 1 CLOSE ( 3 ) 500 IF ( .NOT. avs_coor_file_found .OR. &509 IF ( .NOT. avs_coor_file_found .OR. & 501 510 .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' // & 504 513 ' &filename in FLD-file set to "unknown"' 505 514 CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 ) … … 509 518 ELSE 510 519 get_filenames = .TRUE. 511 IF ( TRIM( host ) == 'hpmuk' .OR. &520 IF ( TRIM( host ) == 'hpmuk' .OR. & 512 521 TRIM( host ) == 'lcmuk' ) THEN 513 522 batch_scp = '/home/raasch/pub/batch_scp' 514 523 ELSEIF ( TRIM( host ) == 'nech' ) THEN 515 524 batch_scp = '/ipf/b/b323011/pub/batch_scp' 516 ELSEIF ( TRIM( host ) == 'ibmh' .OR. &525 ELSEIF ( TRIM( host ) == 'ibmh' .OR. & 517 526 TRIM( host ) == 'ibmb' ) THEN 518 527 batch_scp = '/home/h/niksiraa/pub/batch_scp' … … 520 529 batch_scp = '/home/nhbksira/pub/batch_scp' 521 530 ELSE 522 message_string= 'no path for batch_scp on host "' // &531 message_string= 'no path for batch_scp on host "' // & 523 532 TRIM( host ) // '"' 524 533 CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 ) … … 531 540 !-- /etc/passwd serves as Dummy-Datei, because it is not 532 541 !-- 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 ) // '" ' // & 537 546 TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME' 538 547 … … 543 552 ! 544 553 !-- 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 ) // '" ' // & 549 558 TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME' 550 559 … … 567 576 OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' ) 568 577 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, & 571 580 TRIM( avs_coor_file ), (nx+2*nbgp)*4+(ny+2*nbgp)*4 572 581 … … 623 632 WRITE ( suffix, '(''_'',I1)' ) file_id - 50 624 633 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 ), & 627 636 FORM='FORMATTED', RECL=496 ) 628 637 ! … … 638 647 IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1 639 648 ENDDO 640 rtext = '\1.0 ' // TRIM( run_description_header ) // ' ' // &649 rtext = '\1.0 ' // TRIM( run_description_header ) // ' ' // & 641 650 TRIM( region( file_id - 50 ) ) 642 651 ! 643 652 !-- 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 ), & 646 655 FORM='FORMATTED', DELIM='APOSTROPHE' ) 647 656 WRITE ( 90, RAHMEN ) … … 669 678 !-- series data to the bottom of that file. 670 679 IF ( runnr == 0 ) THEN 671 WRITE ( file_id, 5000 ) TRIM( run_description_header ) // &680 WRITE ( file_id, 5000 ) TRIM( run_description_header ) // & 672 681 ' ' // TRIM( region( file_id - 50 ) ) 673 682 ENDIF … … 694 703 ENDIF 695 704 #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, & 698 707 FORM='FORMATTED', POSITION='APPEND' ) 699 708 ENDIF … … 705 714 CASE ( 81 ) 706 715 707 OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', &716 OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', & 708 717 DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' ) 709 718 … … 715 724 CASE ( 83 ) 716 725 717 OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', &726 OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', & 718 727 DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' ) 719 728 … … 726 735 727 736 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, & 729 738 FORM='UNFORMATTED', POSITION='APPEND' ) 730 739 ELSE … … 738 747 CALL MPI_BARRIER( comm2d, ierr ) 739 748 #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, & 742 751 FORM='UNFORMATTED', POSITION='APPEND' ) 743 752 ENDIF … … 751 760 rtext = 'data format version 3.0' 752 761 WRITE ( 85 ) rtext 753 WRITE ( 85 ) number_of_particle_groups, &762 WRITE ( 85 ) number_of_particle_groups, & 754 763 max_number_of_particle_groups 755 764 WRITE ( 85 ) particle_groups … … 1110 1119 filename = 'DATA_PRT_NETCDF' // coupling_char 1111 1120 ELSE 1112 filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &1121 filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // & 1113 1122 myid_char 1114 1123 ENDIF … … 1143 1152 !-- For runs on multiple processors create the subdirectory 1144 1153 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 ) & 1146 1155 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' // & 1148 1157 TRIM( coupling_char ) // '/' ) 1149 1158 ENDIF … … 1217 1226 mid = file_id - (200+max_masks) 1218 1227 WRITE ( mask_char,'(I2.2)') mid 1219 filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // &1228 filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // & 1220 1229 coupling_char 1221 1230 av = 1 … … 1230 1239 ! 1231 1240 !-- 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), & 1233 1242 .TRUE., 456 ) 1234 1243 ! … … 1282 1291 ! 1283 1292 !-- 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/ &1293 3300 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/ & 1288 1297 '#') 1289 1298 4000 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)'/ &1299 5000 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)'/ & 1294 1303 '#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'/ &1304 8000 FORMAT (A/ & 1305 ' step time # of parts lPE sent/recv rPE sent/recv ', & 1306 'sPE sent/recv nPE sent/recv max # of parts'/ & 1298 1307 103('-')) 1299 1308 -
palm/trunk/SOURCE/check_parameters.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 167 173 ! New cpp directive "__check" implemented which is used by check_namelist_files 168 174 ! 169 ! 774 2011-10-27 13:34:16Z letzel170 ! bugfix for prescribed u,v-profiles171 !172 ! 767 2011-10-14 06:39:12Z raasch173 ! Calculating u,v-profiles from given profiles by linear interpolation.174 ! bugfix: dirichlet_0 conditions for ug/vg moved from init_3d_model to here175 !176 ! 707 2011-03-29 11:39:40Z raasch177 ! setting of bc_lr/ns_dirrad/raddir178 !179 ! 689 2011-02-20 19:31:12z gryschka180 ! Bugfix for some logical expressions181 ! (syntax was not compatible with all compilers)182 !183 ! 680 2011-02-04 23:16:06Z gryschka184 ! init_vortex is not allowed with volume_flow_control185 !186 ! 673 2011-01-18 16:19:48Z suehring187 ! Declaration of ws_scheme_sca and ws_scheme_mom added (moved from advec_ws).188 !189 ! 667 2010-12-23 12:06:00Z suehring/gryschka190 ! Exchange of parameters between ocean and atmosphere via PE0191 ! 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 and194 ! 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_mode198 ! 600 2010-11-24 16:10:51Z raasch199 ! change due to new default value of surface_waterflux200 ! 580 2010-10-05 13:59:11Z heinze201 ! renaming of ws_vertical_gradient_level to subs_vertical_gradient_level202 !203 ! 567 2010-10-01 10:46:30Z helmke204 ! calculating masks changed205 !206 ! 564 2010-09-30 13:18:59Z helmke207 ! palm message identifiers of masked output changed, 20 replaced by max_masks208 !209 ! 553 2010-09-01 14:09:06Z weinreis210 ! masks is calculated and removed from inipar211 !212 ! 531 2010-04-21 06:47:21Z heinze213 ! Bugfix: unit of hyp changed to dbar214 !215 ! 524 2010-03-30 02:04:51Z raasch216 ! Bugfix: "/" in netcdf profile variable names replaced by ":"217 !218 ! 493 2010-03-01 08:30:24Z raasch219 ! netcdf_data_format is checked220 !221 ! 411 2009-12-11 14:15:58Z heinze222 ! Enabled passive scalar/humidity wall fluxes for non-flat topography223 ! Initialization of large scale vertical motion (subsidence/ascent)224 !225 ! 410 2009-12-04 17:05:40Z letzel226 ! masked data output227 !228 ! 388 2009-09-23 09:40:33Z raasch229 ! Check profiles fpr prho and hyp.230 ! Bugfix: output of averaged 2d/3d quantities requires that an avaraging231 ! interval has been set, respective error message is included232 ! 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+1235 ! Coupling with independent precursor runs.236 ! Check particle_color, particle_dvrpsize, color_interval, dvrpsize_interval237 ! Bugfix: pressure included for profile output238 ! Check pressure gradient conditions239 ! topography_grid_convention moved from user_check_parameters240 ! 'single_street_canyon'241 ! Added shf* and qsws* to the list of available output data242 !243 ! 222 2009-01-12 16:04:16Z letzel244 ! +user_check_parameters245 ! Output of messages replaced by message handling routine.246 ! Implementation of an MPI-1 coupling: replaced myid with target_id,247 ! deleted __mpi2 directives248 ! Check that PALM is called with mrun -K parallel for coupling249 !250 ! 197 2008-09-16 15:29:03Z raasch251 ! Bug fix: Construction of vertical profiles when 10 gradients have been252 ! 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=0256 ! Case of reading data for recycling included in initializing_actions,257 ! check of turbulent_inflow and calculation of recycling_plane.258 ! q*2 profile added259 !260 ! 138 2007-11-28 10:03:58Z letzel261 ! Plant canopy added262 ! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.263 ! Multigrid solver allows topography, checking of dt_sort_particles264 ! Bugfix: initializing u_init and v_init in case of ocean runs265 !266 ! 109 2007-08-28 15:26:47Z letzel267 ! Check coupling_mode and set default (obligatory) values (like boundary268 ! conditions for temperature and fluxes) in case of coupled runs.269 ! +profiles for w*p* and w"e270 ! Bugfix: Error message concerning output of particle concentration (pc)271 ! modified272 ! More checks and more default values for coupled runs273 ! allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of274 ! cloud_physics = .T.)275 ! Rayleigh damping for ocean fixed.276 ! Check and, if necessary, set default value for dt_coupling277 !278 ! 97 2007-06-21 08:23:15Z raasch279 ! Initial salinity profile is calculated, salinity boundary conditions are280 ! 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_reference284 !285 ! 89 2007-05-25 12:08:31Z raasch286 ! Check for user-defined profiles287 !288 ! 75 2007-03-22 09:54:05Z raasch289 ! "by_user" allowed as initializing action, -data_output_ts,290 ! leapfrog with non-flat topography not allowed any more, loop_optimization291 ! and pt_reference are checked, moisture renamed humidity,292 ! output of precipitation amount/rate and roughnes length + check293 ! possible negative humidities are avoided in initial profile,294 ! dirichlet/neumann changed to dirichlet/radiation, etc.,295 ! revision added to run_description_header296 !297 ! 20 2007-02-26 00:12:32Z raasch298 ! Temperature and humidity gradients at top are now calculated for nzt+1,299 ! top_heatflux and respective boundary condition bc_pt_t is checked300 !301 ! RCS Log replace by Id keyword, revision history cleaned up302 !303 ! Revision 1.61 2006/08/04 14:20:25 raasch304 ! do2d_unit and do3d_unit now defined as 2d-arrays, check of305 ! use_upstream_for_tke, default value for dt_dopts,306 ! generation of file header moved from routines palm and header to here307 !308 175 ! Revision 1.1 1997/08/26 06:29:23 raasch 309 176 ! Initial revision … … 322 189 USE grid_variables 323 190 USE indices 191 USE kinds 324 192 USE model_1d 325 193 USE netcdf_control … … 335 203 IMPLICIT NONE 336 204 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 !: 349 229 350 230 ! -
palm/trunk/SOURCE/close_file.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 37 43 ! 964 2012-07-26 09:14:24Z raasch 38 44 ! old profil-units (40:49) and respective code removed 39 !40 ! 564 2010-09-30 13:18:59Z helmke41 ! start number of mask output files changed to 201, netcdf message identifiers42 ! of masked output changed43 !44 ! 493 2010-03-01 08:30:24Z raasch45 ! Adjustments for NetCDF parallel data output46 !47 ! 410 2009-12-04 17:05:40Z letzel48 ! masked data output49 !50 ! 263 2009-03-18 12:26:04Z heinze51 ! Output of NetCDF messages with aid of message handling routine.52 !53 ! Feb. 200754 ! RCS Log replace by Id keyword, revision history cleaned up55 !56 ! Revision 1.10 2006/08/22 13:50:01 raasch57 ! xz and yz cross sections now up to nzt+158 !59 ! Revision 1.1 2001/01/02 17:23:41 raasch60 ! Initial revision61 !62 ! Last revision before renaming subroutine 2001/01/01 raasch63 ! Subroutine name changed from close_files to close_file. Closing of a single64 ! file is allowed by passing its file-id as an argument. Variable openfile now65 ! is of type file_status and contains a flag which indicates if a file has66 ! been opened before. Old revision remarks deleted.67 !68 ! Revision 1.13 (close_files) 2000/12/20 09:10:24 letzel69 ! All comments translated into English.70 !71 ! Revision 1.12 (close_files) 1999/03/02 09:22:46 raasch72 ! FLD-Header fuer komprimierte 3D-Daten73 45 ! 74 46 ! Revision 1.1 (close_files) 1997/08/11 06:11:18 raasch … … 83 55 !------------------------------------------------------------------------------! 84 56 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 88 71 USE netcdf_control 89 USE pegrid 90 USE profil_parameter 91 USE statistics 72 73 USE pegrid 92 74 93 75 IMPLICIT NONE 94 76 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, & 106 96 title 107 97 NAMELIST /RAHMEN/ datleg … … 140 130 yright = ( ny + 1.0 ) * dy 141 131 IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN 142 checkuf = .FALSE.; d p = .TRUE.132 checkuf = .FALSE.; dbp = .TRUE. 143 133 ENDIF 144 134 IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN 145 135 datform = 'big_endian' 146 136 ENDIF 147 OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &137 OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', & 148 138 DELIM='APOSTROPHE' ) 149 139 WRITE ( 90, GLOBAL ) … … 163 153 yright = z_max_do2d 164 154 IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN 165 checkuf = .FALSE.; d p = .TRUE.155 checkuf = .FALSE.; dbp = .TRUE. 166 156 ENDIF 167 157 IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN 168 158 datform = 'big_endian' 169 159 ENDIF 170 OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &160 OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', & 171 161 DELIM='APOSTROPHE' ) 172 162 WRITE ( 90, GLOBAL ) … … 186 176 yright = z_max_do2d 187 177 IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN 188 checkuf = .FALSE.; d p = .TRUE.178 checkuf = .FALSE.; dbp = .TRUE. 189 179 ENDIF 190 180 IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN 191 181 datform = 'big_endian' 192 182 ENDIF 193 OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &183 OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', & 194 184 DELIM='APOSTROPHE' ) 195 185 WRITE ( 90, GLOBAL ) … … 201 191 !-- Write header for FLD-file 202 192 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, & 205 195 ny+2, nz_do3d+1, do3d_avs_n 206 196 ELSE 207 WRITE ( 32, 3200) ' ', TRIM( run_description_header ), &197 WRITE ( 32, 3200) ' ', TRIM( run_description_header ), & 208 198 nx+2, ny+2, nz_do3d+1, do3d_avs_n 209 199 ENDIF … … 212 202 CASE ( 101 ) 213 203 214 IF ( netcdf_output .AND. &204 IF ( netcdf_output .AND. & 215 205 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 216 206 nc_stat = NF90_CLOSE( id_set_xy(0) ) … … 220 210 CASE ( 102 ) 221 211 222 IF ( netcdf_output .AND. &212 IF ( netcdf_output .AND. & 223 213 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 224 214 nc_stat = NF90_CLOSE( id_set_xz(0) ) … … 228 218 CASE ( 103 ) 229 219 230 IF ( netcdf_output .AND. &220 IF ( netcdf_output .AND. & 231 221 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 232 222 nc_stat = NF90_CLOSE( id_set_yz(0) ) … … 279 269 CASE ( 111 ) 280 270 281 IF ( netcdf_output .AND. &271 IF ( netcdf_output .AND. & 282 272 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 283 273 nc_stat = NF90_CLOSE( id_set_xy(1) ) … … 287 277 CASE ( 112 ) 288 278 289 IF ( netcdf_output .AND. &279 IF ( netcdf_output .AND. & 290 280 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 291 281 nc_stat = NF90_CLOSE( id_set_xz(1) ) … … 295 285 CASE ( 113 ) 296 286 297 IF ( netcdf_output .AND. &287 IF ( netcdf_output .AND. & 298 288 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 299 289 nc_stat = NF90_CLOSE( id_set_yz(1) ) … … 303 293 CASE ( 116 ) 304 294 305 IF ( netcdf_output .AND. &295 IF ( netcdf_output .AND. & 306 296 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 307 297 nc_stat = NF90_CLOSE( id_set_3d(1) ) … … 311 301 CASE ( 201:200+2*max_masks ) 312 302 313 IF ( netcdf_output .AND. &303 IF ( netcdf_output .AND. & 314 304 ( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN 315 305 ! … … 340 330 ! 341 331 !-- 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'/ &332 3200 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'/ & 352 342 'field=rectilinear') 353 343 4000 FORMAT ('time averaged over',F7.1,' s') -
palm/trunk/SOURCE/compute_vpt.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 32 38 ! Bugfix: wrong factor in calculation of vpt in case of cloud droplets 33 39 ! 34 ! 799 2011-12-21 17:48:03Z franke35 ! Bugfix: ql is now included in calculation of vpt in case of36 ! cloud droplets37 !38 ! RCS Log replace by Id keyword, revision history cleaned up39 !40 ! Revision 1.5 2001/03/30 06:58:52 raasch41 ! Translation of remaining German identifiers (variables, subroutines, etc.)42 !43 40 ! Revision 1.1 2000/04/13 14:40:53 schroeter 44 41 ! Initial revision … … 48 45 ! ------------- 49 46 ! Computation of the virtual potential temperature 50 !------------------------------------------------------------------------------ -!47 !------------------------------------------------------------------------------! 51 48 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 56 62 57 63 IMPLICIT NONE 58 64 59 INTEGER :: k65 INTEGER(iwp) :: k !: 60 66 61 IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )THEN67 IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN 62 68 vpt = pt * ( 1.0 + 0.61 * q ) 63 ELSE IF (cloud_physics) THEN69 ELSE IF (cloud_physics) THEN 64 70 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,:,:) ) * & 66 72 ( 1.0 + 0.61 * q(k,:,:) - 1.61 * ql(k,:,:) ) 67 73 ENDDO -
palm/trunk/SOURCE/coriolis.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 38 44 ! 1015 2012-09-27 09:23:24Z raasch 39 45 ! accelerator version (*_acc) added 40 !41 ! 254 2009-03-05 15:33:42Z heinze42 ! Output of messages replaced by message handling routine.43 !44 ! 106 2007-08-16 14:30:26Z raasch45 ! loops for u and v are starting from index nxlu, nysv, respectively (needed46 ! for non-cyclic boundary conditions)47 !48 ! 75 2007-03-22 09:54:05Z raasch49 ! uxrp, vynp eliminated50 !51 ! RCS Log replace by Id keyword, revision history cleaned up52 !53 ! Revision 1.12 2006/02/23 10:08:57 raasch54 ! nzb_2d replaced by nzb_u/v/w_inner55 46 ! 56 47 ! Revision 1.1 1997/08/29 08:57:38 raasch … … 83 74 SUBROUTINE coriolis( component ) 84 75 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 89 87 90 88 IMPLICIT NONE 91 89 92 INTEGER :: component, i, j, k 90 INTEGER(iwp) :: component !: 91 INTEGER(iwp) :: i !: 92 INTEGER(iwp) :: j !: 93 INTEGER(iwp) :: k !: 93 94 94 95 … … 103 104 DO j = nys, nyn 104 105 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) + & 110 111 w(k,j,i) ) & 111 112 ) … … 120 121 DO j = nysv, nyn 121 122 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) + & 124 125 u(k,j,i+1) ) - ug(k) ) 125 126 ENDDO … … 133 134 DO j = nys, nyn 134 135 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) + & 137 138 u(k+1,j,i+1) ) 138 139 ENDDO … … 155 156 SUBROUTINE coriolis_acc( component ) 156 157 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 161 169 162 170 IMPLICIT NONE 163 171 164 INTEGER :: component, i, j, k 172 INTEGER(iwp) :: component !: 173 INTEGER(iwp) :: i !: 174 INTEGER(iwp) :: j !: 175 INTEGER(iwp) :: k !: 165 176 166 177 … … 215 226 DO k = 1, nzt 216 227 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) + & 219 230 u(k+1,j,i+1) ) 220 231 ENDIF … … 239 250 SUBROUTINE coriolis_ij( i, j, component ) 240 251 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 246 263 IMPLICIT NONE 247 264 248 INTEGER :: component, i, j, k 265 INTEGER(iwp) :: component !: 266 INTEGER(iwp) :: i !: 267 INTEGER(iwp) :: j !: 268 INTEGER(iwp) :: k !: 249 269 250 270 ! … … 256 276 CASE ( 1 ) 257 277 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) ) ) 265 284 ENDDO 266 285 … … 269 288 CASE ( 2 ) 270 289 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) + & 273 292 u(k,j,i+1) ) - ug(k) ) 274 293 ENDDO … … 278 297 CASE ( 3 ) 279 298 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) + & 282 301 u(k+1,j,i+1) ) 283 302 ENDDO -
palm/trunk/SOURCE/cpulog.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 32 38 ! 1036 2012-10-22 13:43:42Z raasch 33 39 ! code put under GPL (PALM 3.9) 34 !35 ! 274 2009-03-26 15:11:21Z heinze36 ! Output of messages replaced by message handling routine.37 ! Type of count and count_rate changed to default INTEGER on NEC machines38 !39 ! 225 2009-01-26 14:44:20Z raasch40 ! Type of count and count_rate changed to INTEGER(8)41 !42 ! 82 2007-04-16 15:40:52Z raasch43 ! Preprocessor strings for different linux clusters changed to "lc",44 ! preprocessor directives for old systems removed45 !46 ! RCS Log replace by Id keyword, revision history cleaned up47 !48 ! Revision 1.24 2006/06/02 15:12:17 raasch49 ! cpp-directives extended for lctit50 40 ! 51 41 ! Revision 1.1 1997/07/24 11:12:29 raasch … … 58 48 !------------------------------------------------------------------------------! 59 49 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 62 59 USE pegrid 63 60 … … 65 62 66 63 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, & 68 65 initial_wallclock_time, log_point, log_point_s 69 66 … … 76 73 END INTERFACE cpu_statistics 77 74 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 !: 85 84 86 85 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 !: 90 95 END TYPE logpoint 91 96 … … 103 108 IMPLICIT NONE 104 109 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 !: 111 120 112 121 #if defined( __lc ) || defined( __decalpha ) 113 INTEGER(8) :: count, count_rate 122 INTEGER(idp) :: count !: 123 INTEGER(idp) :: count_rate !: 114 124 #elif defined( __nec ) 115 INTEGER :: count, count_rate 125 INTEGER(iwp) :: count !: 126 INTEGER(iwp) :: count_rate !: 116 127 #elif defined( __ibm ) 117 INTEGER( 8) :: IRTC128 INTEGER(idp) :: IRTC !: 118 129 #endif 119 130 … … 124 135 log_event%place = place 125 136 ELSEIF ( log_event%place /= place ) THEN 126 WRITE( message_string, * ) 'wrong argument & expected: ', &137 WRITE( message_string, * ) 'wrong argument & expected: ', & 127 138 TRIM(log_event%place), ' given: ', TRIM( place ) 128 139 CALL message( 'cpu_log', 'PA0174', 1, 2, 0, 6, 0 ) … … 142 153 !-- PEs that have not yet finished 143 154 #if defined( __parallel ) 144 IF ( cpu_log_barrierwait .AND. wait_allowed .AND. &155 IF ( cpu_log_barrierwait .AND. wait_allowed .AND. & 145 156 ( modus == 'start' .OR. modus == 'continue' ) ) THEN 146 157 CALL MPI_BARRIER( comm2d, ierr ) … … 167 178 ELSEIF ( modus == 'pause' ) THEN 168 179 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%mtime180 WRITE( message_string, * ) 'negative time interval occured', & 181 ' &PE',myid,' L=PAUSE "',TRIM(log_event%place), & 182 '" new=', mtime,' last=',log_event%mtime 172 183 CALL message( 'cpu_log', 'PA0176', 0, 1, -1, 6, 0 ) 173 184 first = .FALSE. … … 176 187 log_event%ivect = log_event%ivect + mtimevec - log_event%mtimevec 177 188 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. & 179 190 first ) THEN 180 WRITE( message_string, * ) 'negative time interval occured', 191 WRITE( message_string, * ) 'negative time interval occured', & 181 192 ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', & 182 193 mtime,' last=',log_event%mtime,' isum=',log_event%isum … … 188 199 log_event%sum = log_event%sum + log_event%mtime 189 200 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', & 191 202 ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', & 192 203 log_event%sum,' mtime=',log_event%mtime … … 218 229 IMPLICIT NONE 219 230 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 !: 225 242 226 243 … … 240 257 ! 241 258 !-- 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 ) ), & 244 261 pe_log_points( SIZE( log_point ), 0:numprocs-1 ) ) 245 262 pe_min = log_point%sum … … 251 268 !-- Receive data from all PEs 252 269 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, & 254 271 i, i, comm2d, status, ierr ) 255 272 sender = status(MPI_SOURCE) … … 270 287 !-- Calculate rms 271 288 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 & 274 291 )**2 275 292 ENDDO -
palm/trunk/SOURCE/cuda_fft_interfaces.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 50 56 #if defined ( __cuda_fft ) 51 57 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 Real56 CUFFT_C2C = Z'29', & !Complex to Complex, interleaved57 CUFFT_D2Z = Z'6a', & !Double to Double-Complex58 CUFFT_Z2D = Z'6c', & !Double-Complex to Double59 CUFFT_Z2Z = Z'69' !Double-Complex to Double-Complex58 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 60 66 61 67 PUBLIC … … 70 76 USE ISO_C_BINDING 71 77 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 !: 75 82 END SUBROUTINE CUFFTPLAN1D 76 83 … … 97 104 98 105 USE ISO_C_BINDING 99 USE precision_kind106 USE kinds 100 107 101 INTEGER(C_INT), VALUE :: plan 102 COMPLEX(dp k), DEVICE :: idata(:,:,:)103 REAL(dp k), DEVICE :: odata(:,:,:)108 INTEGER(C_INT), VALUE :: plan !: 109 COMPLEX(dp), DEVICE :: idata(:,:,:) !: 110 REAL(dp), DEVICE :: odata(:,:,:) !: 104 111 105 112 END SUBROUTINE CUFFTEXECZ2D … … 113 120 114 121 USE ISO_C_BINDING 115 USE precision_kind 122 123 USE kinds 116 124 117 INTEGER(C_INT), VALUE :: plan 118 REAL(dp k), DEVICE :: idata(:,:,:)119 COMPLEX(dp k), DEVICE :: odata(:,:,:)125 INTEGER(C_INT), VALUE :: plan !: 126 REAL(dp), DEVICE :: idata(:,:,:) !: 127 COMPLEX(dp), DEVICE :: odata(:,:,:) !: 120 128 121 129 END SUBROUTINE CUFFTEXECD2Z … … 131 139 132 140 SUBROUTINE CUFFTdummy( dummy ) 141 142 USE kinds 133 143 134 REAL :: dummy144 REAL(wp) :: dummy !: 135 145 136 146 END SUBROUTINE CUFFTdummy -
palm/trunk/SOURCE/data_log.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 41 47 #if defined( __logging ) 42 48 43 USE control_parameters 49 USE control_parameters, & 50 ONLY: log_message, simulated_time 51 52 USE kinds 53 44 54 USE pegrid 45 55 46 56 IMPLICIT NONE 47 57 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 !: 49 64 50 REAL , DIMENSION(i1:i2,j1:j2,k1:k2) :: array65 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: array !: 51 66 52 67 … … 81 96 #if defined( __logging ) 82 97 83 USE control_parameters 98 USE control_parameters, & 99 ONLY: log_message, simulated_time 100 101 USE kinds 102 84 103 USE pegrid 85 104 86 105 IMPLICIT NONE 87 106 88 INTEGER :: i1, i2, j1, j2 107 INTEGER(iwp) :: i1 !: 108 INTEGER(iwp) :: i2 !: 109 INTEGER(iwp) :: j1 !: 110 INTEGER(iwp) :: j2 !: 89 111 90 REAL , DIMENSION(i1:i2,j1:j2) :: array112 REAL(wp), DIMENSION(i1:i2,j1:j2) :: array !: 91 113 92 114 … … 121 143 #if defined( __logging ) 122 144 123 USE control_parameters 145 USE control_parameters, & 146 ONLY: log_message, simulated_time 147 148 USE kinds 149 124 150 USE pegrid 125 151 126 152 IMPLICIT NONE 127 153 128 INTEGER :: i1, i2, j1, j2 154 INTEGER(iwp) :: i1 !: 155 INTEGER(iwp) :: i2 !: 156 INTEGER(iwp) :: j1 !: 157 INTEGER(iwp) :: j2 !: 129 158 130 INTEGER , DIMENSION(i1:i2,j1:j2) :: array159 INTEGER(iwp), DIMENSION(i1:i2,j1:j2) :: array !: 131 160 132 161 -
palm/trunk/SOURCE/data_output_2d.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 65 71 ! +z0h 66 72 ! 67 ! 790 2011-11-29 03:11:20Z raasch68 ! bugfix: calculation of 'pr' must depend on the particle weighting factor69 !70 ! 771 2011-10-27 10:56:21Z heinze71 ! +lpt72 !73 ! 759 2011-09-15 13:58:31Z raasch74 ! Splitting of parallel I/O75 !76 ! 729 2011-05-26 10:33:34Z heinze77 ! Exchange ghost layers for p regardless of used pressure solver (except SOR).78 !79 ! 691 2011-03-04 08:45:30Z maronga80 ! Replaced simulated_time by time_since_reference_point81 !82 ! 673 2011-01-18 16:19:48Z suehring83 ! When using Multigrid or SOR solver an additional CALL exchange_horiz is84 ! is needed for pressure output.85 !86 ! 667 2010-12-23 12:06:00Z suehring/gryschka87 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and88 ! allocation of arrays local_2d and total_2d.89 ! Calls of exchange_horiz are modiefied.90 !91 ! 622 2010-12-10 08:08:13Z raasch92 ! optional barriers included in order to speed up collective operations93 !94 ! 493 2010-03-01 08:30:24Z raasch95 ! netCDF4 support (parallel output)96 !97 ! 367 2009-08-25 08:35:52Z maronga98 ! 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 possible103 ! Bugfix: to_be_resorted => s_av for time-averaged scalars104 ! Calculation of shf* and qsws* added.105 !106 ! 215 2008-11-18 09:54:31Z raasch107 ! Bugfix: no output of particle concentration and radius unless particles108 ! have been started109 !110 ! 96 2007-06-04 08:07:41Z raasch111 ! Output of density and salinity112 !113 ! 75 2007-03-22 09:54:05Z raasch114 ! Output of precipitation amount/rate and roughness length,115 ! 2nd+3rd argument removed from exchange horiz116 !117 ! RCS Log replace by Id keyword, revision history cleaned up118 !119 ! Revision 1.5 2006/08/22 13:50:29 raasch120 ! xz and yz cross sections now up to nzt+1121 !122 ! Revision 1.2 2006/02/23 10:19:22 raasch123 ! 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_.._n129 !130 73 ! Revision 1.1 1997/08/11 06:24:09 raasch 131 74 ! Initial revision … … 140 83 !------------------------------------------------------------------------------! 141 84 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 143 89 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 149 118 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 151 124 USE pegrid 152 125 153 126 IMPLICIT NONE 154 127 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 !: 168 166 #if defined( __parallel ) 169 REAL , DIMENSION(:,:), ALLOCATABLE :: total_2d170 #endif 171 REAL , DIMENSION(:,:,:), POINTER :: to_be_resorted167 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !: 168 #endif 169 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !: 172 170 173 171 NAMELIST /LOCAL/ rtext … … 184 182 !-- the given end time by the length of the given output interval. 185 183 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 > & 187 185 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', & 190 188 ' maximum number of output time levels is exceeded.' 191 189 CALL message( 'data_output_2d', 'PA0384', 0, 1, 0, 6, 0 ) 192 190 RETURN 193 191 ENDIF 194 IF ( mode == 'xz' .AND. do2d_xz_time_count(av) + 1 > &192 IF ( mode == 'xz' .AND. do2d_xz_time_count(av) + 1 > & 195 193 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', & 198 196 ' maximum number of output time levels is exceeded.' 199 197 CALL message( 'data_output_2d', 'PA0385', 0, 1, 0, 6, 0 ) 200 198 RETURN 201 199 ENDIF 202 IF ( mode == 'yz' .AND. do2d_yz_time_count(av) + 1 > &200 IF ( mode == 'yz' .AND. do2d_yz_time_count(av) + 1 > & 203 201 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', & 206 204 ' maximum number of output time levels is exceeded.' 207 205 CALL message( 'data_output_2d', 'PA0386', 0, 1, 0, 6, 0 ) … … 363 361 DO i = nxlg, nxrg 364 362 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) * & 366 364 dzw(1:nzt+1) ) 367 365 ENDDO … … 427 425 s_r4 = 0.0 428 426 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 * & 430 428 particles(n)%weight_factor 431 s_r4 = s_r4 + particles(n)%radius**4 * &429 s_r4 = s_r4 + particles(n)%radius**4 * & 432 430 particles(n)%weight_factor 433 431 ENDDO … … 499 497 DO i = nxlg, nxrg 500 498 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) 502 501 ENDDO 503 502 ENDDO … … 539 538 DO j = nysg, nyng 540 539 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) * & 543 542 ql(k,j,i) 544 543 ENDDO … … 600 599 psi = prt_start_index(k,j,i) 601 600 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 / & 604 603 prt_count(k,j,i) 605 604 ENDDO … … 824 823 ! 825 824 !-- 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, & 827 826 local_pf, two_d ) 828 827 resorted = .TRUE. … … 837 836 838 837 IF ( .NOT. found ) THEN 839 message_string = 'no output provided for: ' // &838 message_string = 'no output provided for: ' // & 840 839 TRIM( do2d(av,if) ) 841 840 CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 ) … … 881 880 do2d_xy_last_time(av) = simulated_time 882 881 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 ) & 885 884 THEN 886 885 #if defined( __netcdf ) … … 947 946 #if defined( __netcdf ) 948 947 IF ( netcdf_output .AND. myid == 0 ) THEN 949 WRITE ( 21 ) time_since_reference_point, &948 WRITE ( 21 ) time_since_reference_point, & 950 949 do2d_xy_time_count(av), av 951 950 ENDIF … … 981 980 !-- Index limits are received in arbitrary order from 982 981 !-- 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, & 985 984 status, ierr ) 986 985 sender = status(MPI_SOURCE) 987 986 DEALLOCATE( local_2d ) 988 987 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, & 991 990 status, ierr ) 992 991 total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d … … 1026 1025 ind(1) = nxlg; ind(2) = nxrg 1027 1026 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, & 1029 1028 comm2d, ierr ) 1030 1029 ! 1031 1030 !-- Send data to PE0 1032 CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &1031 CALL MPI_SEND( local_2d(nxlg,nysg), ngp, & 1033 1032 MPI_REAL, 0, 1, comm2d, ierr ) 1034 1033 ENDIF … … 1076 1075 ENDIF 1077 1076 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 ) // ' ' // & 1080 1079 TRIM( section_chr ) 1081 1080 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 ) // ' ' // & 1084 1083 TRIM( section_chr ) 1085 1084 ENDIF … … 1103 1102 do2d_xz_last_time(av) = simulated_time 1104 1103 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 ) & 1107 1106 THEN 1108 1107 #if defined( __netcdf ) … … 1130 1129 DO j = nys, nyn 1131 1130 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) + & 1133 1132 local_pf(i,j,k) 1134 1133 ENDDO … … 1139 1138 !-- Now do the averaging over all PEs along y 1140 1139 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, & 1143 1142 MPI_SUM, comm1dy, ierr ) 1144 1143 #else … … 1167 1166 !-- sections reside. Cross sections averaged along y are 1168 1167 !-- 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. & 1171 1170 ( section(is,s) == -1 .AND. myidy == 0 ) ) THEN 1172 1171 #if defined( __netcdf ) … … 1192 1191 #if defined( __netcdf ) 1193 1192 IF ( netcdf_output .AND. myid == 0 ) THEN 1194 WRITE ( 22 ) time_since_reference_point, &1193 WRITE ( 22 ) time_since_reference_point, & 1195 1194 do2d_xz_time_count(av), av 1196 1195 ENDIF … … 1198 1197 DO i = 0, io_blocks-1 1199 1198 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 ) ) & 1204 1203 THEN 1205 1204 WRITE (22) nxlg, nxrg, nzb, nzt+1 … … 1239 1238 !-- Index limits are received in arbitrary order from 1240 1239 !-- 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, & 1243 1242 status, ierr ) 1244 1243 ! … … 1247 1246 sender = status(MPI_SOURCE) 1248 1247 DEALLOCATE( local_2d ) 1249 ALLOCATE( local_2d(ind(1):ind(2), &1248 ALLOCATE( local_2d(ind(1):ind(2), & 1250 1249 ind(3):ind(4)) ) 1251 1250 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 1252 1251 MPI_REAL, sender, 1, comm2d, & 1253 1252 status, ierr ) 1254 total_2d(ind(1):ind(2),ind(3):ind(4)) = &1253 total_2d(ind(1):ind(2),ind(3):ind(4)) = & 1255 1254 local_2d 1256 1255 ENDIF … … 1291 1290 ind(3) = -9999; ind(4) = -9999 1292 1291 ENDIF 1293 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &1292 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, & 1294 1293 comm2d, ierr ) 1295 1294 ! 1296 1295 !-- If applicable, send data to PE0. 1297 1296 IF ( ind(1) /= -9999 ) THEN 1298 CALL MPI_SEND( local_2d(nxlg,nzb), ngp, &1297 CALL MPI_SEND( local_2d(nxlg,nzb), ngp, & 1299 1298 MPI_REAL, 0, 1, comm2d, ierr ) 1300 1299 ENDIF … … 1335 1334 ENDIF 1336 1335 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 ) // ' ' // & 1339 1338 TRIM( section_chr ) 1340 1339 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 ) // ' ' // & 1343 1342 TRIM( section_chr ) 1344 1343 ENDIF … … 1355 1354 do2d_yz_last_time(av) = simulated_time 1356 1355 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 ) & 1359 1358 THEN 1360 1359 #if defined( __netcdf ) … … 1382 1381 DO j = nysg, nyng 1383 1382 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) + & 1385 1384 local_pf(i,j,k) 1386 1385 ENDDO … … 1391 1390 !-- Now do the averaging over all PEs along x 1392 1391 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, & 1395 1394 MPI_SUM, comm1dx, ierr ) 1396 1395 #else … … 1419 1418 !-- sections reside. Cross sections averaged along x are 1420 1419 !-- 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. & 1423 1422 ( section(is,s) == -1 .AND. myidx == 0 ) ) THEN 1424 1423 #if defined( __netcdf ) … … 1444 1443 #if defined( __netcdf ) 1445 1444 IF ( netcdf_output .AND. myid == 0 ) THEN 1446 WRITE ( 23 ) time_since_reference_point, &1445 WRITE ( 23 ) time_since_reference_point, & 1447 1446 do2d_yz_time_count(av), av 1448 1447 ENDIF … … 1450 1449 DO i = 0, io_blocks-1 1451 1450 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 ) ) & 1456 1455 THEN 1457 1456 WRITE (23) nysg, nyng, nzb, nzt+1 … … 1491 1490 !-- Index limits are received in arbitrary order from 1492 1491 !-- 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, & 1495 1494 status, ierr ) 1496 1495 ! … … 1499 1498 sender = status(MPI_SOURCE) 1500 1499 DEALLOCATE( local_2d ) 1501 ALLOCATE( local_2d(ind(1):ind(2), &1500 ALLOCATE( local_2d(ind(1):ind(2), & 1502 1501 ind(3):ind(4)) ) 1503 1502 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 1504 1503 MPI_REAL, sender, 1, comm2d, & 1505 1504 status, ierr ) 1506 total_2d(ind(1):ind(2),ind(3):ind(4)) = &1505 total_2d(ind(1):ind(2),ind(3):ind(4)) = & 1507 1506 local_2d 1508 1507 ENDIF … … 1543 1542 ind(3) = -9999; ind(4) = -9999 1544 1543 ENDIF 1545 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &1544 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, & 1546 1545 comm2d, ierr ) 1547 1546 ! 1548 1547 !-- If applicable, send data to PE0. 1549 1548 IF ( ind(1) /= -9999 ) THEN 1550 CALL MPI_SEND( local_2d(nysg,nzb), ngp, &1549 CALL MPI_SEND( local_2d(nysg,nzb), ngp, & 1551 1550 MPI_REAL, 0, 1, comm2d, ierr ) 1552 1551 ENDIF … … 1587 1586 ENDIF 1588 1587 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 ) // ' ' // & 1591 1590 TRIM( section_chr ) 1592 1591 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 ) // ' ' // & 1595 1594 TRIM( section_chr ) 1596 1595 ENDIF -
palm/trunk/SOURCE/data_output_3d.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 59 65 ! Bugfix: missing calculation of ql_vp added 60 66 ! 61 ! 790 2011-11-29 03:11:20Z raasch62 ! 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 heinze66 ! +lpt67 !68 ! 759 2011-09-15 13:58:31Z raasch69 ! Splitting of parallel I/O70 !71 ! 727 2011-04-20 20:05:25Z suehring72 ! Exchange ghost layers also for p_av.73 !74 ! 725 2011-04-11 09:37:01Z suehring75 ! Exchange ghost layers for p regardless of used pressure solver (except SOR).76 !77 ! 691 2011-03-04 08:45:30Z maronga78 ! Replaced simulated_time by time_since_reference_point79 !80 ! 673 2011-01-18 16:19:48Z suehring81 ! When using Multigrid or SOR solver an additional CALL exchange_horiz is82 ! is needed for pressure output.83 !84 ! 667 2010-12-23 12:06:00Z suehring/gryschka85 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and86 ! 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 raasch90 ! bugfix: missing define statements for netcdf added91 !92 ! 493 2010-03-01 08:30:24Z raasch93 ! netCDF4 support (parallel output)94 !95 ! 355 2009-07-17 01:03:01Z letzel96 ! 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 scalars100 !101 ! 96 2007-06-04 08:07:41Z raasch102 ! Output of density and salinity103 !104 ! 75 2007-03-22 09:54:05Z raasch105 ! 2nd+3rd argument removed from exchange horiz106 !107 ! RCS Log replace by Id keyword, revision history cleaned up108 !109 ! Revision 1.3 2006/06/02 15:18:59 raasch110 ! +argument "found", -argument grid in call of routine user_data_output_3d111 !112 ! Revision 1.2 2006/02/23 10:23:07 raasch113 ! 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 quantities116 !117 67 ! Revision 1.1 1997/09/03 06:29:36 raasch 118 68 ! Initial revision … … 124 74 !------------------------------------------------------------------------------! 125 75 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 127 80 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 132 101 USE netcdf_control 133 USE particle_attributes 102 103 USE particle_attributes, & 104 ONLY: particles, prt_count, prt_start_index 105 134 106 USE pegrid 135 USE precision_kind136 107 137 108 IMPLICIT NONE 138 109 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 !: 150 132 151 133 ! … … 202 184 IF ( myid == 0 ) THEN 203 185 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) /), & 207 189 count = (/ 1 /) ) 208 190 CALL handle_netcdf_error( 'data_output_3d', 376 ) … … 288 270 s_r4 = 0.0 289 271 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 * & 291 273 particles(n)%weight_factor 292 s_r4 = s_r4 + particles(n)%radius**4 * &274 s_r4 = s_r4 + particles(n)%radius**4 * & 293 275 particles(n)%weight_factor 294 276 ENDDO … … 346 328 DO j = nysg, nyng 347 329 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) * & 350 332 ql(k,j,i) 351 333 ENDDO … … 400 382 psi = prt_start_index(k,j,i) 401 383 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 / & 404 386 prt_count(k,j,i) 405 387 ENDDO … … 494 476 ! 495 477 !-- 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, & 497 479 nz_do3d ) 498 480 resorted = .TRUE. 499 481 500 482 IF ( .NOT. found ) THEN 501 message_string = 'no output available for: ' // &483 message_string = 'no output available for: ' // & 502 484 TRIM( do3d(av,if) ) 503 485 CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 ) … … 532 514 533 515 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) ), & 536 518 TRIM( simulated_time_mod ) 537 519 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) ) // & 540 522 ' averaged', TRIM( simulated_time_mod ) 541 523 ENDIF … … 543 525 !-- Determine the Skip-value for the next array. Record end and start 544 526 !-- 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 ) * & 546 528 ( nz_do3d+1 ) ) * 4 + 8 ) 547 529 ENDIF … … 553 535 !-- Compression, output of compression information on FLD-file and output 554 536 !-- 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, & 556 538 nzb, nz_do3d, prec, nbgp ) 557 539 ELSE … … 586 568 !-- boundaries of the total domain. 587 569 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) /), & 591 573 count = (/ nxr-nxl+2, nyn-nys+1, nz_do3d-nzb+1, 1 /) ) 592 574 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) /), & 596 578 count = (/ nxr-nxl+1, nyn-nys+2, nz_do3d-nzb+1, 1 /) ) 597 579 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) /), & 601 583 count = (/ nxr-nxl+2, nyn-nys+2, nz_do3d-nzb+1, 1 /) ) 602 584 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) /), & 606 588 count = (/ nxr-nxl+1, nyn-nys+1, nz_do3d-nzb+1, 1 /) ) 607 589 ENDIF … … 617 599 IF ( netcdf_output ) THEN 618 600 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) /), & 622 604 count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) ) 623 605 CALL handle_netcdf_error( 'data_output_3d', 446 ) … … 641 623 ! 642 624 !-- Formats. 643 3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &625 3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ & 644 626 'label = ',A,A) 645 627 -
palm/trunk/SOURCE/data_output_dvrp.f90
r1319 r1320 1 MODULE dvrp_color 2 1 3 !--------------------------------------------------------------------------------! 2 4 ! This file is part of PALM. … … 18 20 ! Current revisions: 19 21 ! ----------------- 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 21 29 ! 22 30 ! Former revisions: … … 32 40 ! 828 2012-02-21 12:00:36Z raasch 33 41 ! particle feature color renamed class 34 !35 ! 287 2009-04-09 08:59:36Z raasch36 ! Clipping of dvr-output implemented, using a default colourtable for37 ! particles,38 ! output of messages replaced by message handling routine.39 !40 ! 210 2008-11-06 08:54:02Z raasch41 ! DVRP arguments changed to single precision, mode pathlines added42 !43 ! 130 2007-11-13 14:08:40Z letzel44 ! allow two instead of one digit to specify isosurface and slicer variables45 ! for unknown variables (CASE DEFAULT) call new subroutine46 ! user_data_output_dvrp47 !48 ! 82 2007-04-16 15:40:52Z raasch49 ! Preprocessor strings for different linux clusters changed to "lc",50 ! routine local_flush is used for buffer flushing51 !52 ! 75 2007-03-22 09:54:05Z raasch53 ! Particles-package is now part of the default code,54 ! moisture renamed humidity55 !56 ! RCS Log replace by Id keyword, revision history cleaned up57 !58 ! Revision 1.13 2006/02/23 10:25:12 raasch59 ! 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_psize62 42 ! 63 43 ! Revision 1.1 2000/04/27 06:27:17 raasch … … 70 50 !------------------------------------------------------------------------------! 71 51 72 MODULE dvrp_color73 74 52 USE dvrp_variables 53 54 USE kinds 75 55 76 56 IMPLICIT NONE … … 80 60 SUBROUTINE color_dvrp( value, color ) 81 61 82 REAL , INTENT(IN) :: value83 REAL , INTENT(OUT) :: color(4)84 85 REAL :: scale86 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) - & 89 69 slicer_range_limits_dvrp(1,islice_dvrp) ) 90 70 91 71 scale = MODULO( 180.0 + 180.0 * scale, 360.0 ) 92 72 93 color = (/ scale, 0.5 , 1.0, 0.0/)73 color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /) 94 74 95 75 END SUBROUTINE color_dvrp … … 102 82 #if defined( __dvrp_graphics ) 103 83 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 109 101 USE DVRP 102 110 103 USE dvrp_color 104 111 105 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 115 121 USE pegrid 116 122 117 123 IMPLICIT NONE 118 124 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 !: 133 170 134 171 -
palm/trunk/SOURCE/data_output_mask.f90
r1319 r1320 42 42 ! Bugfix: calculation of pr must depend on the particle weighting factor, 43 43 ! missing calculation of ql_vp added 44 !45 ! 771 2011-10-27 10:56:21Z heinze46 ! +lpt47 !48 ! 667 2010-12-23 12:06:00Z suehring/gryschka49 ! Calls of exchange_horiz are modified.50 !51 ! 564 2010-09-30 13:18:59Z helmke52 ! start number of mask output files changed to 201, netcdf message identifiers53 ! of masked output changed, palm message identifiers of masked output changed54 !55 ! 493 2010-03-01 08:30:24Z raasch56 ! netcdf_format_mask* and format_parallel_io replaced by netcdf_data_format57 !58 ! 475 2010-02-04 02:26:16Z raasch59 ! Bugfix in serial branch: arguments from array local_pf removed in N90_PUT_VAR60 44 ! 61 45 ! 410 2009-12-04 17:05:40Z letzel … … 68 52 69 53 #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 77 79 USE netcdf 80 78 81 USE netcdf_control 79 USE particle_attributes 82 83 USE particle_attributes, & 84 ONLY: particles, prt_count, prt_start_index 85 80 86 USE pegrid 81 87 82 88 IMPLICIT NONE 83 89 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 !: 89 109 #if defined( __parallel ) 90 REAL , DIMENSION(:,:,:), ALLOCATABLE :: total_pf91 #endif 92 REAL , DIMENSION(:,:,:), POINTER :: to_be_resorted110 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: total_pf !: 111 #endif 112 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !: 93 113 94 114 ! -
palm/trunk/SOURCE/data_output_profiles.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 42 47 ! 964 2012-07-26 09:14:24Z raasch 43 48 ! code for profil-output removed 44 !45 ! 345 2009-07-01 14:37:56Z heinze46 ! In case of restart runs without extension, initial profiles are not written47 ! 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 raasch53 ! Time coordinate t=0 stored on netcdf-file only if an output is required for54 ! this time for at least one of the profiles55 !56 ! February 200757 ! RCS Log replace by Id keyword, revision history cleaned up58 !59 ! 87 2007-05-22 15:46:47Z raasch60 ! var_hom renamed pr_palm61 !62 ! Revision 1.18 2006/08/16 14:27:04 raasch63 ! PRINT* statements for testing removed64 49 ! 65 50 ! Revision 1.1 1997/09/12 06:28:48 raasch … … 72 57 !------------------------------------------------------------------------------! 73 58 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 77 72 USE netcdf_control 73 78 74 USE pegrid 75 79 76 USE profil_parameter 80 USE statistics 77 78 USE statistics, & 79 ONLY: flow_statistics_called, hom, hom_sum, pr_palm, statistic_regions 81 80 82 81 IMPLICIT NONE 83 82 84 83 85 INTEGER :: i, sr 84 INTEGER(iwp) :: i !: 85 INTEGER(iwp) :: sr !: 86 86 87 87 ! -
palm/trunk/SOURCE/data_output_ptseries.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 36 41 ! mean/minimum/maximum particle radius added as output quantity, 37 42 ! particle attributes speed_x|y|z_sgs renamed rvar1|2|3 38 !39 ! 622 2010-12-10 08:08:13Z raasch40 ! optional barriers included in order to speed up collective operations41 !42 ! 291 2009-04-16 12:07:26Z raasch43 ! 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 raasch47 ! Particles-package is now part of the default code.48 !49 ! RCS Log replace by Id keyword, revision history cleaned up50 !51 ! Revision 1.2 2006/08/22 13:51:13 raasch52 ! Seperate output for particle groups53 43 ! 54 44 ! Revision 1.1 2006/08/04 14:24:18 raasch … … 61 51 !------------------------------------------------------------------------------! 62 52 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 67 67 USE netcdf_control 68 USE particle_attributes 68 69 USE particle_attributes, & 70 ONLY: number_of_particles, number_of_particle_groups, particles 71 69 72 USE pegrid 70 73 … … 72 75 73 76 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 !: 77 84 78 85 -
palm/trunk/SOURCE/data_output_spectra.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 34 39 ! 964 2012-07-26 09:14:24Z raasch 35 40 ! code for profil-output removed 36 !37 ! 291 2009-04-16 12:07:26Z raasch38 ! 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 letzel43 ! allow 100 spectra levels instead of 10 for consistency with44 ! define_netcdf_header, +user-defined spectra45 !46 ! February 200747 ! RCS Log replace by Id keyword, revision history cleaned up48 !49 ! Revision 1.7 2006/04/11 14:56:38 raasch50 ! pl_spectra renamed data_output_sp51 41 ! 52 42 ! Revision 1.1 2001/01/05 15:14:20 raasch … … 61 51 #if defined( __spectra ) 62 52 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 66 61 USE netcdf_control 62 67 63 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 70 70 71 71 72 72 IMPLICIT NONE 73 73 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 !: 76 81 77 82 CALL cpu_log( log_point(31), 'data_output_spectra', 'start' ) … … 183 188 #if defined( __netcdf ) 184 189 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 189 204 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 192 211 193 212 IMPLICIT NONE 194 213 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 !: 205 225 206 226 … … 248 268 SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written ) 249 269 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 255 284 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 260 288 261 289 IMPLICIT NONE 262 290 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 !: 268 302 ! 269 303 !-- 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 !: 282 338 283 339 NAMELIST /RAHMEN/ cranz, datleg, rtext, swap … … 407 463 SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written ) 408 464 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 414 479 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 419 482 420 483 IMPLICIT NONE 421 484 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 !: 426 497 427 498 ! 428 499 !-- 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 !: 441 535 442 536 NAMELIST /RAHMEN/ cranz, datleg, rtext, swap -
palm/trunk/SOURCE/data_output_tseries.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 36 41 ! code put under GPL (PALM 3.9) 37 42 ! 38 ! 291 2009-04-16 12:07:26Z raasch39 ! 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 raasch43 ! Collection of time series quantities moved to routine flow_statistics,44 ! output for "profil" removed45 !46 ! RCS Log replace by Id keyword, revision history cleaned up47 !48 ! Revision 1.13 2006/03/14 12:42:51 raasch49 ! Error removed: NetCDF output only if switched on50 !51 43 ! Revision 1.1 1998/03/03 08:00:13 raasch 52 44 ! Initial revision … … 59 51 !------------------------------------------------------------------------------! 60 52 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 64 61 USE netcdf_control 62 65 63 USE pegrid 64 66 65 USE profil_parameter 67 USE statistics 66 67 USE statistics, & 68 ONLY: flow_statistics_called, statistic_regions, ts_value 68 69 69 70 IMPLICIT NONE 70 71 71 72 72 INTEGER :: i, sr 73 INTEGER(iwp) :: i !: 74 INTEGER(iwp) :: sr !: 73 75 74 76 -
palm/trunk/SOURCE/diffusion_e.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 60 66 ! 825 2012-02-19 03:03:44Z raasch 61 67 ! wang_collision_kernel renamed wang_kernel 62 !63 ! 790 2011-11-29 03:11:20Z raasch64 ! diss is also calculated in case that the Wang kernel is used65 !66 ! 667 2010-12-23 12:06:00Z suehring/gryschka67 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng68 !69 ! 97 2007-06-21 08:23:15Z raasch70 ! Adjustment of mixing length calculation for the ocean version. zw added to71 ! argument list.72 ! This is also a bugfix, because the height above the topography is now73 ! used instead of the height above level k=0.74 ! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference75 ! use_pt_reference renamed use_reference76 !77 ! 65 2007-03-13 12:11:43Z raasch78 ! Reference temperature pt_reference can be used in buoyancy term79 !80 ! 20 2007-02-26 00:12:32Z raasch81 ! Bugfix: ddzw dimensioned 1:nzt"+1"82 ! Calculation extended for gridpoint nzt83 !84 ! RCS Log replace by Id keyword, revision history cleaned up85 !86 ! Revision 1.18 2006/08/04 14:29:43 raasch87 ! dissipation is stored in extra array diss if needed later on for calculating88 ! the sgs particle velocities89 68 ! 90 69 ! Revision 1.1 1997/09/19 07:40:24 raasch … … 118 97 SUBROUTINE diffusion_e( var, var_reference ) 119 98 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 125 116 126 117 IMPLICIT NONE 127 118 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 !: 130 125 131 126 #if defined( __nopointer ) 132 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var127 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 133 128 #else 134 REAL , DIMENSION(:,:,:), POINTER :: var129 REAL(wp), DIMENSION(:,:,:), POINTER :: var !: 135 130 #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 !: 137 134 138 135 … … 304 301 SUBROUTINE diffusion_e_acc( var, var_reference ) 305 302 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 311 320 312 321 IMPLICIT NONE 313 322 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 !: 316 332 317 333 #if defined( __nopointer ) 318 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var334 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 319 335 #else 320 REAL , DIMENSION(:,:,:), POINTER :: var336 REAL(wp), DIMENSION(:,:,:), POINTER :: var !: 321 337 #endif 322 338 … … 481 497 SUBROUTINE diffusion_e_ij( i, j, var, var_reference ) 482 498 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 488 516 489 517 IMPLICIT NONE 490 518 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 !: 493 525 494 526 #if defined( __nopointer ) 495 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var527 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 496 528 #else 497 REAL , DIMENSION(:,:,:), POINTER :: var529 REAL(wp), DIMENSION(:,:,:), POINTER :: var !: 498 530 #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 !: 500 534 501 535 -
palm/trunk/SOURCE/diffusion_s.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 47 53 ! 1001 2012-09-13 14:08:46Z raasch 48 54 ! some arrays comunicated by module instead of parameter list 49 !50 ! 667 2010-12-23 12:06:00Z suehring/gryschka51 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng52 !53 ! 183 2008-08-04 15:39:12Z letzel54 ! bugfix: calculation of fluxes at vertical surfaces55 !56 ! 129 2007-10-30 12:12:24Z letzel57 ! replace wall_heatflux by wall_s_flux that is now included in the parameter58 ! list, bugfix for assignment of fluxes at walls59 !60 ! 20 2007-02-26 00:12:32Z raasch61 ! 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_b64 !65 ! RCS Log replace by Id keyword, revision history cleaned up66 !67 ! Revision 1.8 2006/02/23 10:34:17 raasch68 ! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner69 ! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface70 ! fluxes at vertically oriented topography71 55 ! 72 56 ! Revision 1.1 2000/04/13 14:54:02 schroeter … … 99 83 SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux ) 100 84 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 105 99 106 100 IMPLICIT NONE 107 101 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 !: 111 107 #if defined( __nopointer ) 112 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s108 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s !: 113 109 #else 114 REAL , DIMENSION(:,:,:), POINTER :: s110 REAL(wp), DIMENSION(:,:,:), POINTER :: s !: 115 111 #endif 116 112 … … 121 117 DO k = nzb_s_outer(j,i)+1, nzt 122 118 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) ) & 131 127 ) * ddy2 132 128 ENDDO … … 138 134 DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i) 139 135 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) & 154 150 ) * ddy2 155 151 ENDDO … … 162 158 DO k = nzb_diff_s_inner(j,i), nzt_diff 163 159 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) & 168 164 ) * ddzw(k) 169 165 ENDDO … … 176 172 k = nzb_s_inner(j,i)+1 177 173 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) & 183 179 ) * ddzw(k) 184 180 … … 192 188 k = nzt 193 189 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) & 199 195 ) * ddzw(k) 200 196 … … 212 208 SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux ) 213 209 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 218 224 219 225 IMPLICIT NONE 220 226 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 !: 224 233 #if defined( __nopointer ) 225 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s234 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s !: 226 235 #else 227 REAL , DIMENSION(:,:,:), POINTER :: s236 REAL(wp), DIMENSION(:,:,:), POINTER :: s !: 228 237 #endif 229 238 … … 239 248 IF ( k > nzb_s_outer(j,i) ) THEN 240 249 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) ) & 249 258 ) * ddy2 250 259 ENDIF … … 257 266 ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) ) & 258 267 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) & 273 282 ) * ddy2 274 283 ENDIF … … 281 290 DO k = 1, nzt_diff 282 291 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) & 287 296 ) * ddzw(k) 288 297 ENDIF … … 294 303 DO k = 1, nzt 295 304 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) & 301 310 ) * ddzw(k) 302 311 ENDIF … … 327 336 SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux ) 328 337 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 333 352 334 353 IMPLICIT NONE 335 354 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 !: 339 361 #if defined( __nopointer ) 340 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s362 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s !: 341 363 #else 342 REAL , DIMENSION(:,:,:), POINTER :: s364 REAL(wp), DIMENSION(:,:,:), POINTER :: s !: 343 365 #endif 344 366 … … 347 369 DO k = nzb_s_outer(j,i)+1, nzt 348 370 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) ) & 357 379 ) * ddy2 358 380 ENDDO … … 360 382 ! 361 383 !-- 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 ) ) & 363 385 THEN 364 386 DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i) 365 387 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) & 380 402 ) * ddy2 381 403 ENDDO … … 388 410 DO k = nzb_diff_s_inner(j,i), nzt_diff 389 411 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) & 394 416 ) * ddzw(k) 395 417 ENDDO … … 401 423 k = nzb_s_inner(j,i)+1 402 424 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) & 407 429 ) * ddzw(k) 408 430 … … 415 437 k = nzt 416 438 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) & 421 443 ) * ddzw(k) 422 444 -
palm/trunk/SOURCE/diffusion_u.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 46 52 ! outflow damping layer removed 47 53 ! kmym_x/_y and kmyp_x/_y change to kmym and kmyp 48 !49 ! 667 2010-12-23 12:06:00Z suehring/gryschka50 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng51 !52 ! 366 2009-08-25 08:06:27Z raasch53 ! bc_ns replaced by bc_ns_cyc54 !55 ! 106 2007-08-16 14:30:26Z raasch56 ! 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 raasch60 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,61 ! z0 removed from argument list, uxrp eliminated62 !63 ! 20 2007-02-26 00:12:32Z raasch64 ! Bugfix: ddzw dimensioned 1:nzt"+1"65 !66 ! RCS Log replace by Id keyword, revision history cleaned up67 !68 ! Revision 1.15 2006/02/23 10:35:35 raasch69 ! nzb_2d replaced by nzb_u_outer in horizontal diffusion and by nzb_u_inner70 ! 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 equation73 ! because they cause errors at the edges of topography74 ! WARNING: loops containing the MAX function are still not properly vectorized!75 54 ! 76 55 ! Revision 1.1 1997/09/12 06:23:51 raasch … … 107 86 SUBROUTINE diffusion_u 108 87 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 113 103 114 104 IMPLICIT NONE 115 105 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 !: 120 115 121 116 ! … … 123 118 !-- if neccessary 124 119 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, & 126 121 nzb_u_outer, wall_u ) 127 122 ENDIF … … 134 129 ! 135 130 !-- Interpolate eddy diffusivities on staggered gridpoints 136 kmyp = 0.25 * &131 kmyp = 0.25 * & 137 132 ( 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 * & 139 134 ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) ) 140 135 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 & 150 145 & ) * ddy 151 146 ENDDO … … 156 151 157 152 DO k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i) 158 kmyp = 0.25 * &153 kmyp = 0.25 * & 159 154 ( 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 * & 161 156 ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) ) 162 157 … … 185 180 ! 186 181 !-- Interpolate eddy diffusivities on staggered gridpoints 187 kmzp = 0.25 * &182 kmzp = 0.25 * & 188 183 ( 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 * & 190 185 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 191 186 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 & ) & 199 194 & ) * ddzw(k) 200 195 ENDDO … … 206 201 !-- Difference quotient of the momentum flux is not formed over half 207 202 !-- of the grid spacing (2.0*ddzw(k)) any more, since the comparison 208 !-- with other (LES) model lshowed that the values of the momentum203 !-- with other (LES) models showed that the values of the momentum 209 204 !-- flux becomes too large in this case. 210 205 !-- The term containing w(k-1,..) (see above equation) is removed here … … 214 209 ! 215 210 !-- Interpolate eddy diffusivities on staggered gridpoints 216 kmzp = 0.25 * &211 kmzp = 0.25 * & 217 212 ( 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 * & 219 214 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 220 215 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) & 226 221 & ) * ddzw(k) 227 222 ENDIF … … 234 229 ! 235 230 !-- Interpolate eddy diffusivities on staggered gridpoints 236 kmzp = 0.25 * &231 kmzp = 0.25 * & 237 232 ( 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 * & 239 234 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 240 235 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) & 246 241 & ) * ddzw(k) 247 242 ENDIF … … 258 253 SUBROUTINE diffusion_u_acc 259 254 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 264 270 265 271 IMPLICIT NONE 266 272 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 !: 271 282 !$acc declare create ( usvs ) 272 283 … … 275 286 !-- if neccessary 276 287 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 ) & 283 294 !$acc present ( nzb_u_inner, nzb_u_outer, nzb_diff_u ) 284 295 DO i = i_left, i_right … … 290 301 ! 291 302 !-- Interpolate eddy diffusivities on staggered gridpoints 292 kmyp = 0.25 * &303 kmyp = 0.25 * & 293 304 ( 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 * & 295 306 ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) ) 296 307 … … 311 322 !-- Wall functions at the north and south walls, respectively 312 323 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. & 314 325 wall_u(j,i) /= 0.0 ) THEN 315 326 316 kmyp = 0.25 * &327 kmyp = 0.25 * & 317 328 ( 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 * & 319 330 ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) ) 320 331 … … 344 355 ! 345 356 !-- Interpolate eddy diffusivities on staggered gridpoints 346 kmzp = 0.25 * &357 kmzp = 0.25 * & 347 358 ( 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 * & 349 360 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 350 361 … … 369 380 !-- Difference quotient of the momentum flux is not formed over half 370 381 !-- of the grid spacing (2.0*ddzw(k)) any more, since the comparison 371 !-- with other (LES) model lshowed that the values of the momentum382 !-- with other (LES) models showed that the values of the momentum 372 383 !-- flux becomes too large in this case. 373 384 !-- The term containing w(k-1,..) (see above equation) is removed here … … 381 392 ! 382 393 !-- Interpolate eddy diffusivities on staggered gridpoints 383 kmzp = 0.25 * &394 kmzp = 0.25 * & 384 395 ( 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 * & 386 397 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 387 398 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) & 393 404 & ) * ddzw(k) 394 405 ENDDO … … 409 420 ! 410 421 !-- Interpolate eddy diffusivities on staggered gridpoints 411 kmzp = 0.25 * &422 kmzp = 0.25 * & 412 423 ( 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 * & 414 425 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 415 426 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) & 421 432 & ) * ddzw(k) 422 433 ENDDO … … 434 445 SUBROUTINE diffusion_u_ij( i, j ) 435 446 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 440 460 441 461 IMPLICIT NONE 442 462 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 !: 447 472 448 473 ! … … 454 479 kmym = 0.25 * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) ) 455 480 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 & 465 490 & ) * ddy 466 491 ENDDO … … 472 497 ! 473 498 !-- 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 ) 476 501 477 502 DO k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i) … … 506 531 kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 507 532 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 & ) & 515 540 & ) * ddzw(k) 516 541 ENDDO … … 522 547 !-- Difference quotient of the momentum flux is not formed over half of 523 548 !-- the grid spacing (2.0*ddzw(k)) any more, since the comparison with 524 !-- other (LES) model lshowed that the values of the momentum flux becomes549 !-- other (LES) models showed that the values of the momentum flux becomes 525 550 !-- too large in this case. 526 551 !-- The term containing w(k-1,..) (see above equation) is removed here … … 533 558 kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 534 559 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) & 540 565 & ) * ddzw(k) 541 566 ENDIF … … 548 573 ! 549 574 !-- Interpolate eddy diffusivities on staggered gridpoints 550 kmzp = 0.25 * &575 kmzp = 0.25 * & 551 576 ( 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 * & 553 578 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) ) 554 579 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) & 560 585 & ) * ddzw(k) 561 586 ENDIF -
palm/trunk/SOURCE/diffusion_v.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 46 52 ! outflow damping layer removed 47 53 ! kmxm_x/_y and kmxp_x/_y change to kmxm and kmxp 48 !49 ! 667 2010-12-23 12:06:00Z suehring/gryschka50 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng51 !52 ! 366 2009-08-25 08:06:27Z raasch53 ! bc_lr replaced by bc_lr_cyc54 !55 ! 106 2007-08-16 14:30:26Z raasch56 ! 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 raasch60 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,61 ! z0 removed from argument list, vynp eliminated62 !63 ! 20 2007-02-26 00:12:32Z raasch64 ! Bugfix: ddzw dimensioned 1:nzt"+1"65 !66 ! RCS Log replace by Id keyword, revision history cleaned up67 !68 ! Revision 1.15 2006/02/23 10:36:00 raasch69 ! nzb_2d replaced by nzb_v_outer in horizontal diffusion and by nzb_v_inner70 ! 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 equation73 ! because they cause errors at the edges of topography74 ! WARNING: loops containing the MAX function are still not properly vectorized!75 54 ! 76 55 ! Revision 1.1 1997/09/12 06:24:01 raasch … … 105 84 SUBROUTINE diffusion_v 106 85 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 111 101 112 102 IMPLICIT NONE 113 103 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 !: 118 113 119 114 ! … … 121 116 !-- if neccessary 122 117 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, & 124 119 nzb_v_outer, wall_v ) 125 120 ENDIF … … 137 132 ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) ) 138 133 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) ) & 148 143 & ) * ddy2 149 144 ENDDO … … 154 149 155 150 DO k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i) 156 kmxp = 0.25 * &151 kmxp = 0.25 * & 157 152 ( 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 * & 159 154 ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) ) 160 155 … … 188 183 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 189 184 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 & ) & 197 192 & ) * ddzw(k) 198 193 ENDDO … … 204 199 !-- Difference quotient of the momentum flux is not formed over 205 200 !-- half of the grid spacing (2.0*ddzw(k)) any more, since the 206 !-- comparison with other (LES) model lshowed that the values of201 !-- comparison with other (LES) models showed that the values of 207 202 !-- the momentum flux becomes too large in this case. 208 203 !-- The term containing w(k-1,..) (see above equation) is removed here … … 212 207 ! 213 208 !-- Interpolate eddy diffusivities on staggered gridpoints 214 kmzp = 0.25 * &209 kmzp = 0.25 * & 215 210 ( 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 * & 217 212 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 218 213 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) & 224 219 & ) * ddzw(k) 225 220 ENDIF … … 232 227 ! 233 228 !-- Interpolate eddy diffusivities on staggered gridpoints 234 kmzp = 0.25 * &229 kmzp = 0.25 * & 235 230 ( 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 * & 237 232 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 238 233 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) & 244 239 & ) * ddzw(k) 245 240 ENDIF … … 256 251 SUBROUTINE diffusion_v_acc 257 252 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 262 268 263 269 IMPLICIT NONE 264 270 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 !: 269 280 !$acc declare create ( vsus ) 270 281 … … 273 284 !-- if neccessary 274 285 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 ) & 281 292 !$acc present ( nzb_v_inner, nzb_v_outer, nzb_diff_v ) 282 293 DO i = i_left, i_right … … 288 299 ! 289 300 !-- Interpolate eddy diffusivities on staggered gridpoints 290 kmxp = 0.25 * &301 kmxp = 0.25 * & 291 302 ( 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 * & 293 304 ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) ) 294 305 … … 309 320 !-- Wall functions at the left and right walls, respectively 310 321 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. & 312 323 wall_v(j,i) /= 0.0 ) THEN 313 324 314 kmxp = 0.25 * &325 kmxp = 0.25 * & 315 326 ( 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 * & 317 328 ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) ) 318 329 … … 342 353 ! 343 354 !-- Interpolate eddy diffusivities on staggered gridpoints 344 kmzp = 0.25 * &355 kmzp = 0.25 * & 345 356 ( 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 * & 347 358 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 348 359 … … 367 378 !-- Difference quotient of the momentum flux is not formed over 368 379 !-- half of the grid spacing (2.0*ddzw(k)) any more, since the 369 !-- comparison with other (LES) model lshowed that the values of380 !-- comparison with other (LES) models showed that the values of 370 381 !-- the momentum flux becomes too large in this case. 371 382 !-- The term containing w(k-1,..) (see above equation) is removed here … … 379 390 ! 380 391 !-- Interpolate eddy diffusivities on staggered gridpoints 381 kmzp = 0.25 * &392 kmzp = 0.25 * & 382 393 ( 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 * & 384 395 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 385 396 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) & 391 402 & ) * ddzw(k) 392 403 ENDDO … … 407 418 ! 408 419 !-- Interpolate eddy diffusivities on staggered gridpoints 409 kmzp = 0.25 * &420 kmzp = 0.25 * & 410 421 ( 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 * & 412 423 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 413 424 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) & 419 430 & ) * ddzw(k) 420 431 ENDDO … … 432 443 SUBROUTINE diffusion_v_ij( i, j ) 433 444 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 438 458 439 459 IMPLICIT NONE 440 460 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 !: 445 470 446 471 ! … … 452 477 kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) ) 453 478 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) ) & 463 488 & ) * ddy2 464 489 ENDDO … … 470 495 ! 471 496 !-- 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 ) 474 499 475 500 DO k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i) 476 kmxp = 0.25 * &501 kmxp = 0.25 * & 477 502 ( 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 * & 479 504 ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) ) 480 505 … … 506 531 kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 507 532 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 & ) & 515 540 & ) * ddzw(k) 516 541 ENDDO … … 522 547 !-- Difference quotient of the momentum flux is not formed over half of 523 548 !-- the grid spacing (2.0*ddzw(k)) any more, since the comparison with 524 !-- other (LES) model lshowed that the values of the momentum flux becomes549 !-- other (LES) models showed that the values of the momentum flux becomes 525 550 !-- too large in this case. 526 551 !-- The term containing w(k-1,..) (see above equation) is removed here … … 533 558 kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 534 559 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) & 540 565 & ) * ddzw(k) 541 566 ENDIF … … 553 578 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) ) 554 579 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) & 560 585 & ) * ddzw(k) 561 586 ENDIF -
palm/trunk/SOURCE/diffusion_w.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 48 54 ! kmym_y/_z and kmyp_y/_z change to kmym and kmyp 49 55 ! 50 ! 667 2010-12-23 12:06:00Z suehring/gryschka51 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng52 !53 ! 366 2009-08-25 08:06:27Z raasch54 ! bc_lr/bc_ns replaced by bc_lr_cyc/bc_ns_cyc55 !56 ! 75 2007-03-22 09:54:05Z raasch57 ! Wall functions now include diabatic conditions, call of routine wall_fluxes,58 ! z0 removed from argument list59 !60 ! 20 2007-02-26 00:12:32Z raasch61 ! Bugfix: ddzw dimensioned 1:nzt"+1"62 !63 ! RCS Log replace by Id keyword, revision history cleaned up64 !65 ! Revision 1.12 2006/02/23 10:38:03 raasch66 ! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,67 ! +z0 in argument list68 ! WARNING: loops containing the MAX function are still not properly vectorized!69 !70 56 ! Revision 1.1 1997/09/12 06:24:11 raasch 71 57 ! Initial revision … … 77 63 !------------------------------------------------------------------------------! 78 64 79 USE wall_fluxes_mod 65 USE wall_fluxes_mod, & 66 ONLY : wall_fluxes, wall_fluxes_acc 80 67 81 68 PRIVATE … … 99 86 SUBROUTINE diffusion_w 100 87 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 105 101 106 102 IMPLICIT NONE 107 103 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 !: 112 115 113 116 … … 116 119 !-- walls, if neccessary 117 120 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, & 119 122 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, & 121 124 nzb_w_outer, wall_w_y ) 122 125 ENDIF … … 208 211 SUBROUTINE diffusion_w_acc 209 212 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 214 227 215 228 IMPLICIT NONE 216 229 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 !: 221 241 !$acc declare create ( wsus, wsvs ) 222 242 … … 225 245 !-- walls, if neccessary 226 246 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 ) 231 251 ENDIF 232 252 … … 324 344 SUBROUTINE diffusion_w_ij( i, j ) 325 345 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 330 359 331 360 IMPLICIT NONE 332 361 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 337 373 338 374 … … 369 405 !-- Calculate the horizontal momentum fluxes w'u' and/or w'v' 370 406 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 ) 373 409 ELSE 374 410 wsus = 0.0 … … 376 412 377 413 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 ) 380 416 ELSE 381 417 wsvs = 0.0 -
palm/trunk/SOURCE/diffusivities.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 36 42 ! adjustment of mixing length to the Prandtl mixing length at first grid point 37 43 ! above ground removed 38 !39 ! 667 2010-12-23 12:06:00Z suehring/gryschka40 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng41 !42 ! 137 2007-11-28 08:50:10Z letzel43 ! Bugfix for summation of sums_l_l for flow_statistics44 ! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.45 !46 ! 97 2007-06-21 08:23:15Z raasch47 ! Adjustment of mixing length calculation for the ocean version.48 ! This is also a bugfix, because the height above the topography is now49 ! used instead of the height above level k=0.50 ! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference51 ! use_pt_reference renamed use_reference52 !53 ! 57 2007-03-09 12:05:41Z raasch54 ! Reference temperature pt_reference can be used in buoyancy term55 !56 ! RCS Log replace by Id keyword, revision history cleaned up57 !58 ! Revision 1.24 2006/04/26 12:16:26 raasch59 ! OpenMP optimization (+sums_l_l_t), sqrt_e must be private60 44 ! 61 45 ! Revision 1.1 1997/09/19 07:41:10 raasch … … 69 53 !------------------------------------------------------------------------------! 70 54 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 75 66 USE pegrid 76 USE statistics 67 68 USE statistics, & 69 ONLY : rmask, statistic_regions, sums_l_l 77 70 78 71 IMPLICIT NONE 79 72 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) !: 85 88 86 89 … … 136 139 IF ( dvar_dz > 0.0 ) THEN 137 140 IF ( use_single_reference_value ) THEN 138 l_stable = 0.76 * sqrt_e / &141 l_stable = 0.76 * sqrt_e / & 139 142 SQRT( g / var_reference * dvar_dz ) + 1E-5 140 143 ELSE 141 l_stable = 0.76 * sqrt_e / &144 l_stable = 0.76 * sqrt_e / & 142 145 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5 143 146 ENDIF -
palm/trunk/SOURCE/disturb_field.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 26 32 ! $Id$ 27 33 ! 28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 !31 34 ! 1036 2012-10-22 13:43:42Z raasch 32 35 ! code put under GPL (PALM 3.9) 33 !34 ! 667 2010-12-23 12:06:00Z suehring/gryschka35 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng36 ! Calls of exchange_horiz are modified.37 !38 ! 420 2010-01-13 15:10:53Z franke39 ! Loop was split to make runs reproducible when using ifort compiler40 !41 ! 75 2007-03-22 09:54:05Z raasch42 ! xrp, ynp eliminated, 2nd+3rd argument removed from exchange horiz43 !44 ! RCS Log replace by Id keyword, revision history cleaned up45 !46 ! Revision 1.11 2006/08/04 14:31:59 raasch47 ! izuf renamed iran48 36 ! 49 37 ! Revision 1.1 1998/02/04 15:40:45 raasch … … 60 48 !------------------------------------------------------------------------------! 61 49 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 67 66 68 67 IMPLICIT NONE 69 68 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 !: 77 81 78 82 … … 92 96 DO j = dist_nys(dist_range), dist_nyn(dist_range) 93 97 DO k = disturbance_level_ind_b, disturbance_level_ind_t 94 randomnumber = 3.0 * disturbance_amplitude * &98 randomnumber = 3.0 * disturbance_amplitude * & 95 99 ( 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 ) & 98 102 THEN 99 103 dist1(k,j,i) = randomnumber … … 107 111 DO k = disturbance_level_ind_b, disturbance_level_ind_t 108 112 #if defined( __nec ) 109 randomnumber = 3.0 * disturbance_amplitude * &113 randomnumber = 3.0 * disturbance_amplitude * & 110 114 ( RANDOM( 0 ) - 0.5 ) 111 115 #else 112 116 CALL RANDOM_NUMBER( randomnumber ) 113 randomnumber = 3.0 * disturbance_amplitude * &117 randomnumber = 3.0 * disturbance_amplitude * & 114 118 ( randomnumber - 0.5 ) 115 119 #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 ) & 117 121 THEN 118 122 dist1(k,j,i) = randomnumber … … 137 141 DO j = nys, nyn 138 142 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) & 141 145 ) / 12.0 142 146 ENDDO -
palm/trunk/SOURCE/disturb_heatflux.f90
r1319 r1320 16 16 ! 17 17 ! Copyright 1997-2014 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ --!18 !------------------------------------------------------------------------------! 19 19 ! 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 26 32 ! $Id$ 27 33 ! 28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 !31 34 ! 1036 2012-10-22 13:43:42Z raasch 32 35 ! code put under GPL (PALM 3.9) 33 !34 ! 555 2010-09-07 07:32:53Z raasch35 ! Bugfix in if statement36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.7 2006/08/04 14:35:07 raasch40 ! Additional parameter in function random_gauss which limits the range of the41 ! created random numbers, izuf renamed iran42 36 ! 43 37 ! Revision 1.1 1998/03/25 20:03:47 raasch … … 54 48 !------------------------------------------------------------------------------! 55 49 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 61 63 62 64 IMPLICIT NONE 63 65 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 !: 66 71 67 72 … … 73 78 DO j = 0, ny 74 79 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 ) & 76 81 THEN 77 82 IF ( nzb_s_inner(j,i) == 0 ) THEN -
palm/trunk/SOURCE/eqn_state_seawater.f90
r1310 r1320 1 1 MODULE eqn_state_seawater_mod 2 2 3 !------------------------------------------------------------------------------ --!3 !------------------------------------------------------------------------------! 4 4 ! This file is part of PALM. 5 5 ! … … 16 16 ! 17 17 ! Copyright 1997-2014 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ --!18 !------------------------------------------------------------------------------! 19 19 ! 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 28 34 ! 1036 2012-10-22 13:43:42Z raasch 29 35 ! code put under GPL (PALM 3.9) 30 !31 ! 388 2009-09-23 09:40:33Z raasch32 ! Potential density is additionally calculated in eqn_state_seawater,33 ! first constant in array den also defined as type double.34 36 ! 35 37 ! 97 2007-06-21 08:23:15Z raasch … … 45 47 ! eqn_state_seawater_func calculates density. 46 48 !------------------------------------------------------------------------------! 49 50 USE kinds 47 51 48 52 IMPLICIT NONE … … 51 55 PUBLIC eqn_state_seawater, eqn_state_seawater_func 52 56 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 !: 69 75 70 76 INTERFACE eqn_state_seawater … … 85 91 SUBROUTINE eqn_state_seawater 86 92 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 89 97 90 98 IMPLICIT NONE 91 99 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 95 118 96 119 DO i = nxl, nxr … … 114 137 sa2 = sa1 * sa1 115 138 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 + & 118 141 nom(7)*sa2 119 142 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 + & 123 146 den(10)*sa15*pt2 124 147 … … 127 150 prho(k,j,i) = pnom / pden 128 151 129 pnom = pnom + nom(8)*p1 + nom(9)*p1*pt2 + &152 pnom = pnom + nom(8)*p1 + nom(9)*p1*pt2 + & 130 153 nom(10)*p1*sa1 + nom(11)*p2 + nom(12)*p2*pt2 131 154 132 pden = pden + den(11)*p1 + den(12)*p2*pt3 + &155 pden = pden + den(11)*p1 + den(12)*p2*pt3 + & 133 156 den(13)*p3*pt1 134 157 … … 156 179 SUBROUTINE eqn_state_seawater_ij( i, j ) 157 180 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 160 186 161 187 IMPLICIT NONE 162 188 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 166 193 167 194 DO k = nzb_s_inner(j,i)+1, nzt … … 183 210 sa2 = sa1 * sa1 184 211 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 + & 187 214 nom(7)*sa2 188 215 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 + & 192 219 den(10)*sa15*pt2 193 220 … … 196 223 prho(k,j,i) = pnom / pden 197 224 198 pnom = pnom + nom(8)*p1 + nom(9)*p1*pt2 + &225 pnom = pnom + nom(8)*p1 + nom(9)*p1*pt2 + & 199 226 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 + & 201 228 den(13)*p3*pt1 202 229 … … 221 248 ! Equation of state as a function 222 249 !------------------------------------------------------------------------------! 223 REAL FUNCTION eqn_state_seawater_func( p, pt, sa )250 REAL(wp) FUNCTION eqn_state_seawater_func( p, pt, sa ) 224 251 225 252 IMPLICIT NONE 226 253 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 !: 228 266 229 267 ! -
palm/trunk/SOURCE/exchange_horiz.f90
r1319 r1320 1 1 SUBROUTINE exchange_horiz( ar, nbgp_local) 2 2 3 !------------------------------------------------------------------------------ --!3 !------------------------------------------------------------------------------! 4 4 ! This file is part of PALM. 5 5 ! … … 16 16 ! 17 17 ! Copyright 1997-2014 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ --!18 !------------------------------------------------------------------------------! 19 19 ! 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: 25 31 ! ----------------- 26 32 ! $Id$ 27 !28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 33 ! 31 34 ! 1257 2013-11-08 15:18:40Z raasch … … 45 48 ! 841 2012-02-28 12:29:49Z maronga 46 49 ! Excluded routine from compilation of namelist_file_check 47 !48 ! 709 2011-03-30 09:31:40Z raasch49 ! formatting adjustments50 !51 ! 707 2011-03-29 11:39:40Z raasch52 ! grid_level directly used as index for MPI data type arrays,53 ! bc_lr/ns replaced by bc_lr/ns_cyc54 !55 ! 689 2011-02-20 19:31:12z gryschka56 ! Bugfix for some logical expressions57 ! (syntax was not compatible with all compilers)58 !59 ! 683 2011-02-09 14:25:15Z raasch60 ! optional synchronous exchange (sendrecv) implemented, code partly reformatted61 !62 ! 667 2010-12-23 12:06:00Z suehring/gryschka63 ! Dynamic exchange of ghost points with nbgp_local to ensure that no useless64 ! 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 which67 ! depend on the advection scheme. Exchange of left and right PEs is 10% faster68 ! with MPI-Vectors than without.69 !70 ! 75 2007-03-22 09:54:05Z raasch71 ! Special cases for additional gridpoints along x or y in case of non-cyclic72 ! boundary conditions are not regarded any more73 !74 ! RCS Log replace by Id keyword, revision history cleaned up75 !76 ! Revision 1.16 2006/02/23 12:19:08 raasch77 ! anz_yz renamed ngp_yz78 50 ! 79 51 ! Revision 1.1 1997/07/24 11:13:29 raasch … … 87 59 !------------------------------------------------------------------------------! 88 60 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 92 73 USE pegrid 93 74 … … 95 76 96 77 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 100 86 101 87 #if ! defined( __check ) … … 127 113 ! 128 114 !-- 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, & 133 119 comm2d, status, ierr ) 134 120 … … 152 138 ! 153 139 !-- 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, & 156 142 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, & 159 145 req(req_count+4), ierr ) 160 146 … … 192 178 ! 193 179 !-- 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, & 198 184 comm2d, status, ierr ) 199 185 … … 218 204 ! 219 205 !-- 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, & 222 208 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, & 225 211 req(req_count+4), ierr ) 226 212 -
palm/trunk/SOURCE/exchange_horiz_2d.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 26 32 ! $Id$ 27 33 ! 28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 !31 34 ! 1092 2013-02-02 11:24:22Z raasch 32 35 ! unused variables removed … … 37 40 ! 841 2012-02-28 12:29:49Z maronga 38 41 ! Excluded routine from compilation of namelist_file_check 39 !40 ! 707 2011-03-29 11:39:40Z raasch41 ! bc_lr/ns replaced by bc_lr/ns_cyc42 !43 ! 702 2011-03-24 19:33:15Z suehring44 ! Bugfix in declaration of ar in exchange_horiz_2d_int and number of MPI-blocks45 ! in MPI_SENDRECV().46 !47 ! 667 2010-12-23 12:06:00Z suehring/gryschka48 ! Dynamic exchange of ghost points with nbgp, which depends on the advection49 ! scheme. Exchange between left and right PEs is now done with MPI-vectors.50 !51 ! 73 2007-03-20 08:33:14Z raasch52 ! Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary53 ! conditions54 !55 ! RCS Log replace by Id keyword, revision history cleaned up56 !57 ! Revision 1.9 2006/05/12 19:15:52 letzel58 ! MPI_REAL replaced by MPI_INTEGER in exchange_horiz_2d_int59 42 ! 60 43 ! Revision 1.1 1998/01/23 09:58:21 raasch … … 68 51 !------------------------------------------------------------------------------! 69 52 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 73 65 USE pegrid 74 66 … … 76 68 77 69 78 REAL :: ar(nysg:nyng,nxlg:nxrg) 79 INTEGER :: i 70 INTEGER(iwp) :: i !: 71 72 REAL(wp) :: ar(nysg:nyng,nxlg:nxrg) !: 73 80 74 81 75 #if ! defined( __check ) … … 188 182 !------------------------------------------------------------------------------! 189 183 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 193 195 USE pegrid 194 196 195 197 IMPLICIT NONE 196 198 197 INTEGER :: ar(nysg:nyng,nxlg:nxrg)199 INTEGER(iwp) :: ar(nysg:nyng,nxlg:nxrg) !: 198 200 199 201 #if ! defined( __check ) -
palm/trunk/SOURCE/fft_xy.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 65 71 ! 1036 2012-10-22 13:43:42Z raasch 66 72 ! code put under GPL (PALM 3.9) 67 !68 ! 274 2009-03-26 15:11:21Z heinze69 ! Output of messages replaced by message handling routine.70 !71 ! Feb. 200772 ! RCS Log replace by Id keyword, revision history cleaned up73 !74 ! Revision 1.4 2006/03/28 12:27:09 raasch75 ! Stop when system-specific fft is selected on NEC. For unknown reasons this76 ! causes a program abort during first allocation in init_grid.77 !78 ! Revision 1.2 2004/04/30 11:44:27 raasch79 ! Module renamed from fft_for_1d_decomp to fft_xy, 1d-routines renamed to80 ! fft_x and fft_y,81 ! function FFT replaced by subroutine FFTN due to problems with 64-bit82 ! mode on ibm,83 ! shape of array cwork is explicitly stored in ishape/jshape and handled84 ! to routine FFTN instead of shape-function (due to compiler error on85 ! decalpha),86 ! non vectorized FFT for nec included87 73 ! 88 74 ! Revision 1.1 2002/06/11 13:00:49 raasch … … 96 82 !------------------------------------------------------------------------------! 97 83 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 100 90 #if defined( __cuda_fft ) 101 91 USE ISO_C_BINDING … … 103 93 USE, INTRINSIC :: ISO_C_BINDING 104 94 #endif 105 USE precision_kind 106 USE singleton 95 96 USE kinds 97 98 USE singleton, & 99 ONLY: fftn 100 107 101 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 109 105 110 106 IMPLICIT NONE … … 113 109 PUBLIC fft_x, fft_x_1d, fft_y, fft_y_1d, fft_init, fft_x_m, fft_y_m 114 110 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 !: 121 123 122 124 #if defined( __ibm ) 123 INTEGER, PARAMETER :: nau1 = 20000, nau2 = 22000 125 INTEGER(iwp), PARAMETER :: nau1 = 20000 !: 126 INTEGER(iwp), PARAMETER :: nau2 = 22000 !: 124 127 ! 125 128 !-- The following working arrays contain tables and have to be "save" and 126 129 !-- 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 128 135 #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 132 143 #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 !: 135 151 #endif 136 152 137 153 #if defined( __fftw ) 138 154 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 142 169 TYPE(C_PTR), SAVE :: plan_xf, plan_xi, plan_yf, plan_yi 143 170 #endif … … 186 213 !-- in OpenMP sense 187 214 #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 !: 191 221 #elif defined( __nec ) 192 REAL , DIMENSION(0:nx+3,nz+1) :: work_x193 REAL , DIMENSION(0:ny+3,nz+1) :: work_y194 REAL , DIMENSION(6*(nx+3),nz+1) :: workx195 REAL , DIMENSION(6*(ny+3),nz+1) :: worky222 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 !: 196 226 #endif 197 227 … … 228 258 CALL message( 'fft_init', 'PA0187', 1, 2, 0, 6, 0 ) 229 259 230 ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), &260 ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), & 231 261 trig_yb(2*(ny+1)), trig_yf(2*(ny+1)) ) 232 262 … … 240 270 CALL DZFFT( 0, nx+1, sqr_dnx, work_x, work_x, trig_xf, workx, 0 ) 241 271 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, & 243 273 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, & 245 275 trig_xb, workx, 0 ) 246 276 ! … … 248 278 CALL DZFFT( 0, ny+1, sqr_dny, work_y, work_y, trig_yf, worky, 0 ) 249 279 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, & 251 281 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, & 253 283 trig_yb, worky, 0 ) 254 284 #elif defined( __cuda_fft ) … … 278 308 nx_c = nx+1 279 309 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), & 281 311 y_out(0:(ny+1)/2) ) 282 312 plan_xf = FFTW_PLAN_DFT_R2C_1D( nx_c, x_in, x_out, FFTW_ESTIMATE ) … … 322 352 IMPLICIT NONE 323 353 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 332 368 #if defined( __ibm ) 333 REAL, DIMENSION(nau2) :: aux2, aux4 369 REAL(wp), DIMENSION(nau2) :: aux2 !: 370 REAL(wp), DIMENSION(nau2) :: aux4 !: 334 371 #elif defined( __nec ) 335 REAL , DIMENSION(6*(nx+1)) :: work2372 REAL(wp), DIMENSION(6*(nx+1)) :: work2 !: 336 373 #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 !: 338 376 !$acc declare create( ar_tmp ) 339 377 #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 !: 342 383 343 384 IF ( direction == 'forward' ) THEN … … 540 581 DO j = nys_x, nyn_x 541 582 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 ) 544 585 545 586 DO i = 0, (nx+1)/2 … … 570 611 work(nx+2) = 0.0 571 612 572 CALL DCRFT( 0, work, 1, work, 1, nx+1, 1, -1, sqr_dnx, aux3, nau1, &573 aux 4, nau2 )613 CALL DCRFT( 0, work, 1, work, 1, nx+1, 1, -1, sqr_dnx, & 614 aux3, nau1, aux4, nau2 ) 574 615 575 616 DO i = 0, nx … … 709 750 IMPLICIT NONE 710 751 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 720 765 #if defined( __ibm ) 721 REAL, DIMENSION(nau2) :: aux2, aux4 766 REAL(wp), DIMENSION(nau2) :: aux2 !: 767 REAL(wp), DIMENSION(nau2) :: aux4 !: 722 768 #elif defined( __nec ) 723 REAL , DIMENSION(6*(nx+1)) :: work2769 REAL(wp), DIMENSION(6*(nx+1)) :: work2 !: 724 770 #endif 725 771 … … 838 884 IF ( forward_fft ) THEN 839 885 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, & 841 887 aux2, nau2 ) 842 888 … … 945 991 IMPLICIT NONE 946 992 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 956 1011 #if defined( __ibm ) 957 REAL, DIMENSION(nau2) :: auy2, auy4 1012 REAL(wp), DIMENSION(nau2) :: auy2 !: 1013 REAL(wp), DIMENSION(nau2) :: auy4 !: 958 1014 #elif defined( __nec ) 959 REAL , DIMENSION(6*(ny+1)) :: work21015 REAL(wp), DIMENSION(6*(ny+1)) :: work2 !: 960 1016 #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 !: 962 1019 !$acc declare create( ar_tmp ) 963 1020 #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 !: 966 1026 967 1027 IF ( direction == 'forward' ) THEN … … 1140 1200 DO i = nxl_y_l, nxr_y_l 1141 1201 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 ) 1144 1204 1145 1205 DO j = 0, (ny+1)/2 … … 1170 1230 work(ny+2) = 0.0 1171 1231 1172 CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_dny, auy3, nau1,&1173 auy 4, nau2 )1232 CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_dny, & 1233 auy3, nau1, auy4, nau2 ) 1174 1234 1175 1235 DO j = 0, ny … … 1307 1367 1308 1368 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 1317 1381 #if defined( __ibm ) 1318 REAL, DIMENSION(nau2) :: auy2, auy4 1382 REAL(wp), DIMENSION(nau2) :: auy2 !: 1383 REAL(wp), DIMENSION(nau2) :: auy4 !: 1319 1384 #elif defined( __nec ) 1320 REAL , DIMENSION(6*(ny+1)) :: work21385 REAL(wp), DIMENSION(6*(ny+1)) :: work2 !: 1321 1386 #endif 1322 1387 … … 1437 1502 IF ( forward_fft ) THEN 1438 1503 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, & 1440 1505 auy2, nau2 ) 1441 1506 … … 1458 1523 work(ny+2) = 0.0 1459 1524 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 ) 1462 1527 1463 1528 DO j = 0, ny … … 1527 1592 IMPLICIT NONE 1528 1593 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 1535 1604 #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 !: 1538 1608 #endif 1539 1609 … … 1588 1658 !-- Tables are initialized once more. This call should not be 1589 1659 !-- 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, & 1591 1661 trig_xf, work1, 0 ) 1592 1662 … … 1596 1666 ENDIF 1597 1667 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, & 1599 1669 trig_xf, work1, 0 ) 1600 1670 … … 1613 1683 !-- Tables are initialized once more. This call should not be 1614 1684 !-- 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, & 1616 1686 trig_xb, work1, 0 ) 1617 1687 … … 1664 1734 IMPLICIT NONE 1665 1735 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 1672 1747 #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 !: 1675 1751 #endif 1676 1752 -
palm/trunk/SOURCE/flow_statistics.f90
r1319 r1320 21 21 ! Current revisions: 22 22 ! ----------------- 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 24 30 ! 25 31 ! Former revisions: 26 32 ! ----------------- 27 33 ! $Id$ 28 !29 ! 1318 2014-03-17 13:35:16Z raasch30 ! module interfaces removed31 34 ! 32 35 ! 1299 2014-03-06 13:15:21Z heinze … … 66 69 ! 801 2012-01-10 17:30:36Z suehring 67 70 ! Calculation of turbulent fluxes in advec_ws is now thread-safe. 68 !69 ! 743 2011-08-18 16:10:16Z suehring70 ! Calculation of turbulent fluxes with WS-scheme only for the whole model71 ! domain, not for user-defined subregions.72 !73 ! 709 2011-03-30 09:31:40Z raasch74 ! formatting adjustments75 !76 ! 699 2011-03-22 17:52:22Z suehring77 ! Bugfix in calculation of vertical velocity skewness. The added absolute value78 ! avoid negative values in the root. Negative values of w'w' can occur at the79 ! top or bottom of the model domain due to degrading the order of advection80 ! scheme. Furthermore the calculation will be the same for all advection81 ! schemes.82 !, tend83 ! 696 2011-03-18 07:03:49Z raasch84 ! Bugfix: Summation of Wicker-Skamarock scheme fluxes and variances for all85 ! threads86 !87 ! 678 2011-02-02 14:31:56Z raasch88 ! Bugfix in calculation of the divergence of vertical flux of resolved scale89 ! energy, pressure fluctuations, and flux of pressure fluctuation itself90 !91 ! 673 2011-01-18 16:19:48Z suehring92 ! 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/gryschka96 ! When advection is computed with ws-scheme, turbulent fluxes are already97 ! computed in the respective advection routines and buffered in arrays98 ! sums_xx_ws_l(). This is due to a consistent treatment of statistics with the99 ! numerics and to avoid unphysical kinks near the surface.100 ! So some if requests has to be done to dicern between fluxes from ws-scheme101 ! other advection schemes.102 ! Furthermore the computation of z_i is only done if the heat flux exceeds a103 ! minimum value. This affects only simulations of a neutral boundary layer and104 ! is due to reasons of computations in the advection scheme.105 !106 ! 624 2010-12-10 11:46:30Z heinze107 ! Calculation of q*2 added108 !109 ! 622 2010-12-10 08:08:13Z raasch110 ! optional barriers included in order to speed up collective operations111 !112 ! 388 2009-09-23 09:40:33Z raasch113 ! Vertical profiles of potential density and hydrostatic pressure are114 ! calculated.115 ! Added missing timeseries calculation of w"q"(0), moved timeseries q* to the116 ! end.117 ! Temperature gradient criterion for estimating the boundary layer height118 ! 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 raasch122 ! 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 letzel128 ! Vertical profiles now based on nzb_s_inner; they are divided by129 ! ngp_2dh_s_inner (scalars, procucts of scalars) and ngp_2dh (staggered130 ! velocity components and their products, procucts of scalars and velocity131 ! components), respectively.132 !133 ! 106 2007-08-16 14:30:26Z raasch134 ! Prescribed momentum fluxes at the top surface are used,135 ! profiles for w*p* and w"e are calculated136 !137 ! 97 2007-06-21 08:23:15Z raasch138 ! Statistics for ocean version (salinity, density) added,139 ! calculation of z_i and Deardorff velocity scale adjusted to be used with140 ! the ocean version141 !142 ! 87 2007-05-22 15:46:47Z raasch143 ! Two more arguments added to user_statistics, which is now also called for144 ! user-defined profiles,145 ! var_hom and var_sum renamed pr_palm146 !147 ! 82 2007-04-16 15:40:52Z raasch148 ! Cpp-directive lcmuk changed to intel_openmp_bug149 !150 ! 75 2007-03-22 09:54:05Z raasch151 ! Collection of time series quantities moved from routine flow_statistics to152 ! here, routine user_statistics is called for each statistic region,153 ! moisture renamed humidity154 !155 ! 19 2007-02-23 04:53:48Z raasch156 ! fluxes at top modified (tswst, qswst)157 !158 ! RCS Log replace by Id keyword, revision history cleaned up159 !160 ! Revision 1.41 2006/08/04 14:37:50 raasch161 ! Error removed in non-parallel part (sums_l)162 71 ! 163 72 ! Revision 1.1 1997/08/11 06:15:17 raasch … … 177 86 !------------------------------------------------------------------------------! 178 87 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 185 114 USE pegrid 115 186 116 USE statistics 187 117 188 118 IMPLICIT NONE 189 119 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) !: 196 145 197 146 CALL cpu_log( log_point(10), 'flow_statistics', 'start' ) … … 248 197 sums_l(:,31,i) = sums_vs2_ws_l(:,i) ! v*2 249 198 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) + & 252 201 sums_ws2_ws_l(:,i) ) ! e* 253 202 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) + & 257 206 sums_ws2_ws_l(k,i) ) 258 207 ENDDO … … 382 331 !-- Compute total sum from local sums 383 332 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, & 385 334 MPI_SUM, comm2d, ierr ) 386 335 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, & 388 337 MPI_SUM, comm2d, ierr ) 389 338 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, & 391 340 MPI_SUM, comm2d, ierr ) 392 341 IF ( ocean ) THEN 393 342 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, & 395 344 MPI_REAL, MPI_SUM, comm2d, ierr ) 396 345 ENDIF 397 346 IF ( humidity ) THEN 398 347 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, & 400 349 MPI_REAL, MPI_SUM, comm2d, ierr ) 401 350 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, & 403 352 MPI_REAL, MPI_SUM, comm2d, ierr ) 404 353 IF ( cloud_physics ) THEN 405 354 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, & 407 356 MPI_REAL, MPI_SUM, comm2d, ierr ) 408 357 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, & 410 359 MPI_REAL, MPI_SUM, comm2d, ierr ) 411 360 ENDIF … … 414 363 IF ( passive_scalar ) THEN 415 364 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, & 417 366 MPI_REAL, MPI_SUM, comm2d, ierr ) 418 367 ENDIF … … 468 417 ! 469 418 !-- Passive scalar 470 IF ( passive_scalar ) hom(:,1,41,sr) = sums(:,41) / &419 IF ( passive_scalar ) hom(:,1,41,sr) = sums(:,41) / & 471 420 ngp_2dh_s_inner(:,sr) ! s (q) 472 421 … … 527 476 ! 528 477 !-- 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) + & 530 479 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) + & 532 481 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) + & 534 483 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) + & 536 485 ts(j,i) * rmask(j,i,sr) 537 486 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) + & 539 488 qs(j,i) * rmask(j,i,sr) 540 489 ENDIF … … 1349 1298 SUBROUTINE flow_statistics 1350 1299 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 1357 1326 USE pegrid 1327 1358 1328 USE statistics 1359 1329 1360 1330 IMPLICIT NONE 1361 1331 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) !: 1369 1364 1370 1365 CALL cpu_log( log_point(10), 'flow_statistics', 'start' ) -
palm/trunk/SOURCE/global_min_max.f90
r1310 r1320 21 21 ! Current revisions: 22 22 ! ------------------ 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 24 30 ! 25 31 ! Former revisions: … … 35 41 ! 866 2012-03-28 06:44:41Z raasch 36 42 ! new mode "absoff" accounts for an offset in the respective array 37 !38 ! 667 2010-12-23 12:06:00Z suehring/gryschka39 ! Adapting of the index arrays, because MINLOC assumes lowerbound at 1 and not40 ! at nbgp.41 !42 ! 622 2010-12-10 08:08:13Z raasch43 ! optional barriers included in order to speed up collective operations44 !45 ! Feb. 200746 ! RCS Log replace by Id keyword, revision history cleaned up47 !48 ! Revision 1.11 2003/04/16 12:56:58 raasch49 ! Index values of the extrema are limited to the range 0..nx, 0..ny50 43 ! 51 44 ! Revision 1.1 1997/07/24 11:14:03 raasch … … 58 51 !------------------------------------------------------------------------------! 59 52 60 USE indices 53 USE indices, & 54 ONLY: nbgp, ny, nx 55 56 USE kinds 57 61 58 USE pegrid 62 59 63 60 IMPLICIT NONE 64 61 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 73 87 #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 !: 81 101 82 102 -
palm/trunk/SOURCE/header.f90
r1313 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 108 114 ! 825 2012-02-19 03:03:44Z raasch 109 115 ! Output of cloud physics parameters/quantities complemented and restructured 110 !111 ! 767 2011-10-14 06:39:12Z raasch112 ! Output of given initial u,v-profiles113 !114 ! 759 2011-09-15 13:58:31Z raasch115 ! output of maximum number of parallel io streams116 !117 ! 707 2011-03-29 11:39:40Z raasch118 ! bc_lr/ns replaced by bc_lr/ns_cyc119 !120 ! 667 2010-12-23 12:06:00Z suehring/gryschka121 ! Output of advection scheme.122 ! Modified output of Prandtl-layer height.123 !124 ! 580 2010-10-05 13:59:11Z heinze125 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,126 ! ws_vertical_gradient_level to subs_vertical_gradient_level and127 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i128 !129 ! 493 2010-03-01 08:30:24Z raasch130 ! NetCDF data output format extendend for NetCDF4/HDF5131 !132 ! 449 2010-02-02 11:23:59Z raasch133 ! +large scale vertical motion (subsidence/ascent)134 ! Bugfix: index problem concerning gradient_level indices removed135 !136 ! 410 2009-12-04 17:05:40Z letzel137 ! 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_domask139 !140 ! 346 2009-07-06 10:13:41Z raasch141 ! 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 parameters145 ! +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_bulk148 ! topography_grid_convention moved from user_header149 ! small bugfix concerning 3d 64bit netcdf output format150 !151 ! 206 2008-10-13 14:59:11Z raasch152 ! Bugfix: error in zu index in case of section_xy = -1153 !154 ! 198 2008-09-17 08:55:28Z raasch155 ! Format adjustments allowing output of larger revision numbers156 !157 ! 197 2008-09-16 15:29:03Z raasch158 ! allow 100 spectra levels instead of 10 for consistency with159 ! 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 informations163 !164 ! 138 2007-11-28 10:03:58Z letzel165 ! 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 particles168 !169 ! 108 2007-08-24 15:10:38Z letzel170 ! Output of informations for coupled model runs (boundary conditions etc.)171 ! + output of momentumfluxes at the top boundary172 ! Rayleigh damping for ocean, e_init173 !174 ! 97 2007-06-21 08:23:15Z raasch175 ! Adjustments for the ocean version.176 ! use_pt_reference renamed use_reference177 !178 ! 87 2007-05-22 15:46:47Z raasch179 ! Bugfix: output of use_upstream_for_tke180 !181 ! 82 2007-04-16 15:40:52Z raasch182 ! Preprocessor strings for different linux clusters changed to "lc",183 ! routine local_flush is used for buffer flushing184 !185 ! 76 2007-03-29 00:58:32Z raasch186 ! 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 number189 !190 ! 19 2007-02-23 04:53:48Z raasch191 ! Output of scalar flux applied at top boundary192 !193 ! RCS Log replace by Id keyword, revision history cleaned up194 !195 ! Revision 1.63 2006/08/22 13:53:13 raasch196 ! Output of dz_max197 116 ! 198 117 ! Revision 1.1 1997/08/11 06:17:20 raasch … … 209 128 !-----------------------------------------------------------------------------! 210 129 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 212 133 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 220 170 USE pegrid 221 USE subsidence_mod222 USE spectrum223 171 224 172 IMPLICIT NONE 225 173 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 !: 245 237 246 238 ! -
palm/trunk/SOURCE/impact_of_latent_heat.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 28 34 ! 1036 2012-10-22 13:43:42Z raasch 29 35 ! code put under GPL (PALM 3.9) 30 !31 ! 72 2007-03-19 08:20:46Z32 ! precipitation_rate renamed dqdt_precip33 !34 ! 19 2007-02-23 04:53:48Z raasch35 ! Calculation extended for gridpoint nzt36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.5 2004/01/30 10:25:59 raasch40 ! Scalar lower k index nzb replaced by 2d-array nzb_2d41 36 ! 42 37 ! Revision 1.1 2000/04/13 14:48:40 schroeter … … 66 61 SUBROUTINE impact_of_latent_heat 67 62 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 72 73 73 74 IMPLICIT NONE 74 75 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 !: 77 81 78 82 … … 100 104 SUBROUTINE impact_of_latent_heat_ij( i, j ) 101 105 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 106 116 107 117 IMPLICIT NONE 108 118 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 !: 111 124 112 125 -
palm/trunk/SOURCE/inflow_turbulence.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 31 ! 24 32 ! Former revisions: … … 26 34 ! $Id$ 27 35 ! 28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 !31 36 ! 1092 2013-02-02 11:24:22Z raasch 32 37 ! unused variables removed … … 34 39 ! 1036 2012-10-22 13:43:42Z raasch 35 40 ! code put under GPL (PALM 3.9) 36 !37 ! 709 2011-03-30 09:31:40Z raasch38 ! formatting adjustments39 !40 ! 667 2010-12-23 12:06:00Z suehring/gryschka41 ! Using nbgp recycling planes for a better resolution of the turbulent flow42 ! near the inflow.43 !44 ! 622 2010-12-10 08:08:13Z raasch45 ! optional barriers included in order to speed up collective operations46 !47 ! 222 2009-01-12 16:04:16Z letzel48 ! Bugfix for nonparallel execution49 41 ! 50 42 ! Initial version (2008/03/07) … … 56 48 !------------------------------------------------------------------------------! 57 49 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 63 67 USE pegrid 64 68 … … 66 70 IMPLICIT NONE 67 71 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 !: 72 83 73 84 CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' ) -
palm/trunk/SOURCE/init_1d_model.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 41 47 ! 978 2012-08-09 08:28:32Z fricke 42 48 ! roughness length for scalar quantities z0h1d added 43 !44 ! 667 2010-12-23 12:06:00Z suehring/gryschka45 ! replaced mirror boundary conditions for u and v at the ground46 ! by dirichlet boundary conditions47 !48 ! 254 2009-03-05 15:33:42Z heinze49 ! Output of messages replaced by message handling routine.50 !51 ! 184 2008-08-04 15:53:39Z letzel52 ! provisional solution for run_control_1d output: add 'CALL check_open( 15 )'53 !54 ! 135 2007-11-22 12:24:23Z raasch55 ! Bugfix: absolute value of f must be used when calculating the Blackadar56 ! mixing length57 !58 ! 82 2007-04-16 15:40:52Z raasch59 ! Preprocessor strings for different linux clusters changed to "lc",60 ! routine local_flush is used for buffer flushing61 !62 ! 75 2007-03-22 09:54:05Z raasch63 ! Bugfix: preset of tendencies te_em, te_um, te_vm,64 ! moisture renamed humidity65 !66 ! RCS Log replace by Id keyword, revision history cleaned up67 !68 ! Revision 1.21 2006/06/02 15:19:57 raasch69 ! cpp-directives extended for lctit70 49 ! 71 50 ! Revision 1.1 1998/03/09 16:22:10 raasch … … 81 60 !------------------------------------------------------------------------------! 82 61 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 87 80 88 81 IMPLICIT NONE 89 82 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 !: 93 88 94 89 ! 95 90 !-- 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), & 103 98 v1d_p(nzb:nzt+1) ) 104 99 … … 120 115 !-- Blackadar mixing length 121 116 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 ) / & 123 118 ABS( f ) + 1E-10 124 119 ELSE … … 197 192 !------------------------------------------------------------------------------! 198 193 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 203 217 USE pegrid 204 218 205 219 IMPLICIT NONE 206 220 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 !: 211 235 212 236 ! … … 704 728 !------------------------------------------------------------------------------! 705 729 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 709 742 USE pegrid 710 USE control_parameters 743 744 USE control_parameters, & 745 ONLY: simulated_time_chr 711 746 712 747 IMPLICIT NONE 713 748 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 716 756 717 757 ! … … 775 815 !------------------------------------------------------------------------------! 776 816 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 780 828 USE pegrid 781 USE control_parameters 829 830 USE control_parameters, & 831 ONLY: message_string 782 832 783 833 IMPLICIT NONE 784 834 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 !: 787 841 788 842 … … 834 888 !------------------------------------------------------------------------------! 835 889 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 839 901 USE pegrid 840 USE control_parameters 902 903 USE control_parameters, & 904 ONLY: run_description_header, simulated_time_chr 841 905 842 906 IMPLICIT NONE 843 907 844 908 845 INTEGER :: k909 INTEGER(iwp) :: k !: 846 910 847 911 -
palm/trunk/SOURCE/init_3d_model.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 31 ! 24 32 ! Former revisions: 25 33 ! ----------------- 26 34 ! $Id$ 27 !28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 35 ! 31 36 ! 1316 2014-03-17 07:44:59Z heinze … … 122 127 ! 825 2012-02-19 03:03:44Z raasch 123 128 ! wang_collision_kernel renamed wang_kernel 124 !125 ! 790 2011-11-29 03:11:20Z raasch126 ! diss is also allocated in case that the Wang kernel is used127 !128 ! 787 2011-11-28 12:49:05Z heinze $129 ! bugfix: call init_advec in every case - not only for inital runs130 !131 ! 785 2011-11-28 09:47:19Z raasch132 ! initialization of rdf_sc133 !134 ! 767 2011-10-14 06:39:12Z raasch135 ! adjustments concerning implementation of prescribed u,v-profiles136 ! bugfix: dirichlet_0 conditions for ug/vg moved to check_parameters137 !138 ! 759 2011-09-15 13:58:31Z raasch139 ! Splitting of parallel I/O in blocks of PEs140 ! Bugfix: No zero assignments to volume_flow_initial and volume_flow_area in141 ! case of normal restart runs.142 !143 ! 713 2011-03-30 14:21:21Z suehring144 ! weight_substep and weight_pres are given as fractions.145 !146 ! 709 2011-03-30 09:31:40Z raasch147 ! formatting adjustments148 !149 ! 707 2011-03-29 11:39:40Z raasch150 ! 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/raddir153 !154 ! 680 2011-02-04 23:16:06Z gryschka155 ! bugfix: volume_flow_control156 !157 ! 673 2011-01-18 16:19:48Z suehring158 ! 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/gryschka163 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and164 ! allocation of arrays. Calls of exchange_horiz are modified.165 ! Call ws_init to initialize arrays needed for calculating statisticas and for166 ! 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 topography169 ! 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 from171 ! mirror to Dirichlet boundary conditions (u=v=0), so that k=nzb is172 ! 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 raasch176 ! optional barriers included in order to speed up collective operations177 !178 ! 560 2010-09-09 10:06:09Z weinreis179 ! bugfix: correction of calculating ngp_3d for 64 bit180 !181 ! 485 2010-02-05 10:57:51Z raasch182 ! calculation of ngp_3d + ngp_3d_inner changed because they have now 64 bit183 !184 ! 407 2009-12-01 15:01:15Z maronga185 ! var_ts is replaced by dots_max186 ! Enabled passive scalar/humidity wall fluxes for non-flat topography187 !188 ! 388 2009-09-23 09:40:33Z raasch189 ! Initialization of prho added.190 ! bugfix: correction of initial volume flow for non-flat topography191 ! bugfix: zero initialization of arrays within buildings for 'cyclic_fill'192 ! bugfix: avoid that ngp_2dh_s_inner becomes zero193 ! initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now194 ! independent of turbulent_inflow195 ! Output of messages replaced by message handling routine.196 ! Set the starting level and the vertical smoothing factor used for197 ! the external pressure gradient198 ! +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 raasch204 ! bugfix: zero assignments to tendency arrays in case of restarts,205 ! further extensions and modifications in the initialisation of the plant206 ! canopy model,207 ! allocation of hom_sum moved to parin, initialization of spectrum_x|y directly208 ! after allocating theses arrays,209 ! read data for recycling added as new initialization option,210 ! dummy allocation for diss211 !212 ! 138 2007-11-28 10:03:58Z letzel213 ! 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' and216 ! 'set_constant_profiles' in case of buildings in the reference cross-sections.217 !218 ! 108 2007-08-24 15:10:38Z letzel219 ! 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 changed221 ! +qswst_remote in case of atmosphere model with humidity coupled to ocean222 ! Rayleigh damping for ocean, optionally calculate km and kh from initial223 ! TKE e_init224 !225 ! 97 2007-06-21 08:23:15Z raasch226 ! Initialization of salinity, call of init_ocean227 !228 ! 87 2007-05-22 15:46:47Z raasch229 ! var_hom and var_sum renamed pr_palm230 !231 ! 75 2007-03-22 09:54:05Z raasch232 ! 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 one234 ! 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 volume238 ! flow control in case they have been set zero before (to avoid small timesteps)239 ! -uvmean_outflow, uxrp, vynp eliminated240 !241 ! 19 2007-02-23 04:53:48Z raasch242 ! +handling of top fluxes243 !244 ! RCS Log replace by Id keyword, revision history cleaned up245 !246 ! Revision 1.49 2006/08/22 15:59:07 raasch247 ! No optimization of this file on the ibmy (Yonsei Univ.)248 129 ! 249 130 ! Revision 1.1 1998/03/09 16:22:22 raasch … … 262 143 263 144 USE advec_ws 145 264 146 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 268 154 USE control_parameters 269 USE cpulog 270 USE grid_variables 155 156 USE grid_variables, & 157 ONLY: dx, dy 158 271 159 USE indices 160 161 USE kinds 162 272 163 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 274 168 USE netcdf_control 275 USE particle_attributes 169 170 USE particle_attributes, & 171 ONLY: particle_advection, use_sgs_for_particles, wang_kernel 172 276 173 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 281 184 282 185 IMPLICIT NONE 283 186 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 !: 294 203 295 204 -
palm/trunk/SOURCE/init_advec.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 35 41 ! all actions concerning upstream-spline-method removed 36 42 ! 37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.6 2004/04/30 11:59:31 raasch40 ! impulse_advec renamed momentum_advec41 !42 43 ! Revision 1.1 1999/02/05 09:07:38 raasch 43 44 ! Initial revision … … 49 50 !------------------------------------------------------------------------------! 50 51 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 55 59 56 60 IMPLICIT NONE 57 61 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 !: 60 76 61 77 -
palm/trunk/SOURCE/init_cloud_physics.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 22 29 ! 23 30 ! Former revisions: … … 41 48 ! calculation of b_cond replaced by calculation of bfactor 42 49 ! 43 ! 221 2009-01-12 15:32:23Z raasch44 ! Bugfix: abort in case that absolute temperature is below zero45 !46 ! 95 2007-06-02 16:48:38Z raasch47 ! hydro_press renamed hyp48 !49 ! February 200750 ! RCS Log replace by Id keyword, revision history cleaned up51 !52 ! Revision 1.5 2005/06/26 19:55:58 raasch53 ! Initialization of cloud droplet constants, gas_constant renamed r_d,54 ! latent_heat renamed l_v55 !56 50 ! Revision 1.1 2000/04/13 14:37:22 schroeter 57 51 ! Initial revision … … 63 57 !------------------------------------------------------------------------------! 64 58 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 71 80 72 81 IMPLICIT NONE 73 82 74 INTEGER :: k 75 REAL :: t_surface 83 INTEGER(iwp) :: k !: 84 85 REAL(wp) :: t_surface !: 76 86 77 87 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 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 28 34 ! 1036 2012-10-22 13:43:42Z raasch 29 35 ! code put under GPL (PALM 3.9) 30 !31 ! 709 2011-03-30 09:31:40Z raasch32 ! formatting adjustments33 !34 ! 691 2011-03-04 08:45:30Z maronga35 ! Bugfix: combine_plot_fields did not work with data_output_2d_on_each_pe = .T.36 ! for precursor ocean runs37 !38 ! 667 2010-12-23 12:06:00Z suehring/gryschka39 ! determination of target_id's moved to init_pegrid40 !41 ! 291 2009-04-16 12:07:26Z raasch42 ! Coupling with independent precursor runs.43 36 ! 44 37 ! 222 2009-01-12 16:04:16Z letzel … … 51 44 !------------------------------------------------------------------------------! 52 45 46 USE control_parameters, & 47 ONLY: coupling_char, coupling_mode 48 49 USE kinds 50 53 51 USE pegrid 54 USE control_parameters55 USE indices56 52 57 53 IMPLICIT NONE … … 59 55 ! 60 56 !-- 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 !: 63 61 64 62 ! -
palm/trunk/SOURCE/init_dvrp.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 28 34 ! 1036 2012-10-22 13:43:42Z raasch 29 35 ! code put under GPL (PALM 3.9) 30 !31 ! 284 2009-04-06 06:36:10Z raasch32 ! Definition of a colortable to be used for particles.33 ! Output names are changed: surface=groundplate, buildings=topography34 ! Output of messages replaced by message handling routine.35 ! Clipping implemented.36 ! Polygon reduction for building and ground plate isosurface. Reduction level37 ! 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 correct40 ! Implementation of a MPI-1 coupling: __mpi2 adjustments for MPI_COMM_WORLD41 !42 ! 210 2008-11-06 08:54:02Z raasch43 ! DVRP arguments changed to single precision, mode pathlines added44 !45 ! 155 2008-03-28 10:56:30Z letzel46 ! introduce prefix_chr to ensure unique dvrp_file path47 !48 ! 130 2007-11-13 14:08:40Z letzel49 ! allow two instead of one digit to specify isosurface and slicer variables50 ! Test output of isosurface on camera file51 !52 ! 82 2007-04-16 15:40:52Z raasch53 ! Preprocessor strings for different linux clusters changed to "lc",54 ! routine local_flush is used for buffer flushing55 !56 ! 17 2007-02-19 01:57:39Z raasch57 ! dvrp_output_local activated for all streams58 !59 ! 13 2007-02-14 12:15:07Z raasch60 ! RCS Log replace by Id keyword, revision history cleaned up61 !62 ! Revision 1.12 2006/02/23 12:30:22 raasch63 ! ebene renamed section, pl.. replaced by do..,64 36 ! 65 37 ! Revision 1.1 2000/04/27 06:24:39 raasch … … 73 45 #if defined( __dvrp_graphics ) 74 46 75 USE arrays_3d 47 USE arrays_3d, & 48 ONLY: zu 49 76 50 USE DVRP 51 77 52 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 80 62 USE pegrid 81 USE control_parameters 63 64 USE control_parameters, & 65 ONLY: message_string, nz_do3d, run_identifier, topography 82 66 83 67 IMPLICIT NONE 84 68 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 !: 101 125 102 126 ! … … 718 742 #if defined( __dvrp_graphics ) 719 743 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 722 749 USE pegrid 723 750 724 751 IMPLICIT NONE 725 752 726 CHARACTER (LEN=4) :: chr 727 INTEGER :: idummy 753 CHARACTER (LEN=4) :: chr !: 754 755 INTEGER(iwp) :: idummy !: 728 756 729 757 ! … … 778 806 !------------------------------------------------------------------------------! 779 807 #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 !: 786 817 787 818 ! -
palm/trunk/SOURCE/init_grid.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 81 87 ! New cpp directive "__check" implemented which is used by check_namelist_files 82 88 ! 83 ! 759 2011-09-15 13:58:31Z raasch84 ! Splitting of parallel I/O in blocks of PEs85 !86 ! 722 2011-04-11 06:21:09Z raasch87 ! Bugfix: bc_lr/ns_cyc replaced by bc_lr/ns, because variables are not yet set88 ! here89 !90 ! 709 2011-03-30 09:31:40Z raasch91 ! formatting adjustments92 !93 ! 707 2011-03-29 11:39:40Z raasch94 ! bc_lr/ns replaced by bc_lr/ns_cyc95 !96 ! 667 2010-12-23 12:06:00Z suehring/gryschka97 ! 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 these99 ! parameters. Call of exchange_horiz are modified.100 ! In case of dirichlet bounday condition at the bottom zu(0)=0.0101 ! 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 raasch105 ! Bugfix: default setting of nzb_local for flat topography106 !107 ! 274 2009-03-26 15:11:21Z heinze108 ! Output of messages replaced by message handling routine.109 ! new topography case 'single_street_canyon'110 !111 ! 217 2008-12-09 18:00:48Z letzel112 ! +topography_grid_convention113 !114 ! 134 2007-11-21 07:28:38Z letzel115 ! Redefine initial nzb_local as the actual total size of topography (later the116 ! extent of topography in nzb_local is reduced by 1dx at the E topography walls117 ! 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 arrays120 !121 ! 94 2007-06-01 15:25:22Z raasch122 ! Grid definition for ocean version123 !124 ! 75 2007-03-22 09:54:05Z raasch125 ! storage of topography height arrays zu_s_inner and zw_s_inner,126 ! 2nd+3rd argument removed from exchange horiz127 !128 ! 19 2007-02-23 04:53:48Z raasch129 ! Setting of nzt_diff130 !131 ! RCS Log replace by Id keyword, revision history cleaned up132 !133 ! Revision 1.17 2006/08/22 14:00:05 raasch134 ! +dz_max to limit vertical stretching,135 ! bugfix in index array initialization for line- or point-like topography136 ! structures137 !138 89 ! Revision 1.1 1997/08/11 06:17:45 raasch 139 90 ! Initial revision (Testversion) … … 145 96 !------------------------------------------------------------------------------! 146 97 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 151 134 USE pegrid 152 135 153 136 IMPLICIT NONE 154 137 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 !: 170 187 171 188 -
palm/trunk/SOURCE/init_masks.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 50 55 ! 807 2012-01-25 11:53:51Z maronga 51 56 ! New cpp directive "__check" implemented which is used by check_namelist_files 52 !53 ! 771 2011-10-27 10:56:21Z heinze54 ! +lpt55 !56 ! 595 2010-11-12 09:52:10Z helmke57 ! Calculation of z locations for masked output changed58 !59 ! 564 2010-09-30 13:18:59Z helmke60 ! assignment of mask_xyz_loop added, palm message identifiers of masked output61 ! changed62 !/localdata/raasch.1429963 ! 557 2010-09-07 14:50:07Z weinreis64 ! bugfix message string in set_mask_locations65 !66 ! 553 2010-09-01 14:09:06Z weinreis67 ! parameters for masked output are replaced by arrays68 !69 ! 493 2010-03-01 08:30:24Z raasch70 ! netcdf_format_mask* and format_parallel_io replaced by netcdf_data_format71 57 ! 72 58 ! 410 2009-12-04 17:05:40Z letzel … … 79 65 !------------------------------------------------------------------------------! 80 66 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 87 95 USE pegrid 88 96 89 97 IMPLICIT NONE 90 98 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 !: 99 117 ! 100 118 !-- Allocation and initialization … … 480 498 IMPLICIT NONE 481 499 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 !: 486 518 487 519 count = 0; count_l = 0; ddxyz = 1.0 / dxyz; tmp1 = 0.0; tmp2 = 0.0 -
palm/trunk/SOURCE/init_ocean.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 32 37 ! code put under GPL (PALM 3.9) 33 38 ! 34 ! 388 2009-09-23 09:40:33Z raasch35 ! Bugfix: Initial profiles of hydrostatic pressure and density are calculated36 ! iteratively. First calculation of hyp(0) changed.37 !38 ! 124 2007-10-19 15:47:46Z raasch39 ! Bugfix: Initial density rho is calculated40 !41 39 ! 97 2007-06-21 08:23:15Z raasch 42 40 ! Initial revision … … 47 45 !------------------------------------------------------------------------------! 48 46 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 54 62 USE pegrid 55 USE statistics 63 64 USE statistics, & 65 ONLY: hom, statistic_regions 56 66 57 67 IMPLICIT NONE 58 68 59 INTEGER :: k, n 69 INTEGER(iwp) :: k !: 70 INTEGER(iwp) :: n !: 60 71 61 REAL :: sa_l, pt_l 72 REAL(wp) :: pt_l !: 73 REAL(wp) :: sa_l !: 62 74 63 REAL , DIMENSION(nzb:nzt+1) :: rho_init75 REAL(wp), DIMENSION(nzb:nzt+1) :: rho_init !: 64 76 65 77 ALLOCATE( hyp(nzb:nzt+1) ) … … 119 131 120 132 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 ) 122 134 123 135 ENDDO -
palm/trunk/SOURCE/init_pegrid.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 69 74 ! 807 2012-01-25 11:53:51Z maronga 70 75 ! New cpp directive "__check" implemented which is used by check_namelist_files 71 !72 ! 780 2011-11-10 07:16:47Z raasch73 ! Bugfix for rev 778: Misplaced error message moved to the rigth place74 !75 ! 778 2011-11-07 14:18:25Z fricke76 ! Calculation of subdomain_size now considers the number of ghost points.77 ! Further coarsening on PE0 is now possible for multigrid solver if the78 ! collected field has more grid points than the subdomain of an PE.79 !80 ! 759 2011-09-15 13:58:31Z raasch81 ! calculation of number of io_blocks and the io_group to which the respective82 ! PE belongs83 !84 ! 755 2011-08-29 09:55:16Z witha85 ! 2d-decomposition is default for lcflow (ForWind cluster in Oldenburg)86 !87 ! 722 2011-04-11 06:21:09Z raasch88 ! Bugfix: bc_lr/ns_cyc/dirrad/raddir replaced by bc_lr/ns, because variables89 ! are not yet set here; grid_level set to 090 !91 ! 709 2011-03-30 09:31:40Z raasch92 ! formatting adjustments93 !94 ! 707 2011-03-29 11:39:40Z raasch95 ! bc_lr/ns replaced by bc_lr/ns_cyc/dirrad/raddir96 !97 ! 667 2010-12-23 12:06:00Z suehring/gryschka98 ! Moved determination of target_id's from init_coupling99 ! Determination of parameters needed for coupling (coupling_topology, ngp_a,100 ! ngp_o) with different grid/processor-topology in ocean and atmosphere101 ! 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 to103 ! 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 the105 ! 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 raasch111 ! lctit is now using a 2d decomposition by default112 !113 ! 622 2010-12-10 08:08:13Z raasch114 ! optional barriers included in order to speed up collective operations115 !116 ! 438 2010-02-01 04:32:43Z raasch117 ! 2d-decomposition is default for Cray-XT machines118 !119 ! 274 2009-03-26 15:11:21Z heinze120 ! Output of messages replaced by message handling routine.121 !122 ! 206 2008-10-13 14:59:11Z raasch123 ! Implementation of a MPI-1 coupling: added __parallel within the __mpi2 part124 ! 2d-decomposition is default on SGI-ICE systems125 !126 ! 197 2008-09-16 15:29:03Z raasch127 ! multigrid levels are limited by subdomains if mg_switch_to_pe0_level = -1,128 ! nz is used instead nnz for calculating mg-levels129 ! 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 raasch133 ! Allocation of wall flag arrays for multigrid solver134 !135 ! 108 2007-08-24 15:10:38Z letzel136 ! Intercommunicator (comm_inter) and derived data type (type_xy) for137 ! coupled model runs created, assign coupling_mode_remote,138 ! indices nxlu and nysv are calculated (needed for non-cyclic boundary139 ! conditions)140 !141 ! 82 2007-04-16 15:40:52Z raasch142 ! Cpp-directive lcmuk changed to intel_openmp_bug, setting of host on lcmuk by143 ! cpp-directive removed144 !145 ! 75 2007-03-22 09:54:05Z raasch146 ! uxrp, vynp eliminated,147 ! dirichlet/neumann changed to dirichlet/radiation, etc.,148 ! poisfft_init is only called if fft-solver is switched on149 !150 ! RCS Log replace by Id keyword, revision history cleaned up151 !152 ! Revision 1.28 2006/04/26 13:23:32 raasch153 ! lcmuk does not understand the !$ comment so a cpp-directive is required154 76 ! 155 77 ! Revision 1.1 1997/07/24 11:15:09 raasch … … 164 86 !------------------------------------------------------------------------------! 165 87 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 169 109 USE pegrid 170 USE statistics171 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 174 114 175 115 IMPLICIT NONE 176 116 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 !: 186 150 187 151 #if defined( __mpi2 ) 188 LOGICAL :: found 152 LOGICAL :: found !: 189 153 #endif 190 154 -
palm/trunk/SOURCE/init_pt_anomaly.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 32 37 ! Modification of the amplitude to obtain a visible temperature perturbation. 33 38 ! 34 ! 667 2010-12-23 12:06:00Z suehring/gryschka35 ! Call of exchange_horiz are modified.36 !37 ! 75 2007-03-22 09:54:05Z raasch38 ! 2nd+3rd argument removed from exchange horiz39 !40 ! 19 2007-02-23 04:53:48Z raasch41 ! Calculation extended for gridpoint nzt42 !43 ! RCS Log replace by Id keyword, revision history cleaned up44 !45 ! Revision 1.7 2005/03/26 20:36:55 raasch46 ! Arguments for non-cyclic boundary conditions added to argument list of47 ! routine exchange_horiz48 !49 39 ! Revision 1.1 1997/08/29 08:58:56 raasch 50 40 ! Initial revision … … 56 46 !------------------------------------------------------------------------------! 57 47 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 63 58 64 59 IMPLICIT NONE 65 60 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 69 75 ! 70 76 !-- Defaults: radius rc, strength z, -
palm/trunk/SOURCE/init_rankine.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 22 28 ! 23 29 ! Former revisions: … … 27 33 ! 1036 2012-10-22 13:43:42Z raasch 28 34 ! code put under GPL (PALM 3.9) 29 !30 ! 667 2010-12-23 12:06:00Z suehring/gryschka31 ! 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 raasch35 ! Initial profiles are reset to constant profiles36 !37 ! 75 2007-03-22 09:54:05Z raasch38 ! uxrp, vynp eliminated, 2nd+3rd argument removed from exchange horiz39 !40 ! RCS Log replace by Id keyword, revision history cleaned up41 !42 ! Revision 1.11 2005/03/26 20:38:49 raasch43 ! Arguments for non-cyclic boundary conditions added to argument list of44 ! routine exchange_horiz45 35 ! 46 36 ! Revision 1.1 1997/08/11 06:18:43 raasch … … 54 44 !------------------------------------------------------------------------------! 55 45 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 61 62 62 63 IMPLICIT NONE 63 64 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 !: 66 81 67 82 ! -
palm/trunk/SOURCE/init_slope.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 22 28 ! 23 29 ! Former revisions: … … 27 33 ! 1036 2012-10-22 13:43:42Z raasch 28 34 ! code put under GPL (PALM 3.9) 29 !30 ! 667 2010-12-23 12:06:00Z suehring/gryschka31 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng.32 !33 ! 622 2010-12-10 08:08:13Z raasch34 ! optional barriers included in order to speed up collective operations35 !36 ! Feb. 200737 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.5 2006/02/23 12:35:34 raasch40 ! nanz_2dh renamed ngp_2dh41 35 ! 42 36 ! Revision 1.1 2000/04/27 07:06:24 raasch … … 52 46 !------------------------------------------------------------------------------! 53 47 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 58 66 USE pegrid 59 USE control_parameters 67 60 68 61 69 IMPLICIT NONE 62 70 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 !: 66 81 67 82 ! -
palm/trunk/SOURCE/interaction_droplets_ptq.f90
r1310 r1320 60 60 SUBROUTINE interaction_droplets_ptq 61 61 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 66 72 67 73 USE pegrid … … 69 75 IMPLICIT NONE 70 76 71 INTEGER :: i, j, k 77 INTEGER(iwp) :: i !: 78 INTEGER(iwp) :: j !: 79 INTEGER(iwp) :: k !: 72 80 73 81 … … 89 97 SUBROUTINE interaction_droplets_ptq_ij( i, j ) 90 98 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 95 110 96 111 USE pegrid … … 98 113 IMPLICIT NONE 99 114 100 INTEGER :: i, j, k 115 INTEGER(iwp) :: i !: 116 INTEGER(iwp) :: j !: 117 INTEGER(iwp) :: k !: 101 118 102 119 -
palm/trunk/SOURCE/local_flush.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 26 ! 24 27 ! Former revisions: … … 37 40 !------------------------------------------------------------------------------! 38 41 39 INTEGER :: file_id 42 USE kinds 43 44 INTEGER(iwp) :: file_id !: 40 45 41 46 #if defined( __ibm ) -
palm/trunk/SOURCE/local_getenv.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 82 2007-04-16 15:40:52Z raasch32 ! Preprocessor directives for old systems removed33 !34 ! RCS Log replace by Id keyword, revision history cleaned up35 !36 ! Revision 1.5 2003/05/09 14:37:07 raasch37 ! 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.39 35 ! 40 36 ! Revision 1.1 1997/08/11 06:21:01 raasch … … 47 43 !------------------------------------------------------------------------------! 48 44 45 USE kinds 46 49 47 #if defined( __lcmuk ) 50 48 USE pegrid 51 49 #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 !: 54 55 #if defined( __lcmuk ) 55 INTEGER :: i, ia(20) 56 INTEGER(iwp) :: i !: 57 INTEGER(iwp) :: ia(20) !: 56 58 #endif 57 59 -
palm/trunk/SOURCE/local_stop.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! revision history before 2012 removed, 23 24 ! 24 25 ! Former revisions: … … 35 36 ! New cpp directive "__check" implemented which is used by check_namelist_files 36 37 ! 37 ! 667 2010-12-23 12:06:00Z suehring/gryschka38 ! Exchange of terminate_coupled between ocean and atmosphere via PE039 !40 ! 213 2008-11-13 10:26:18Z raasch41 ! Implementation of a MPI-1 coupling: replaced myid with target_id.42 ! The uncoupled case allows stop or mpi_abort depending on new steering43 ! parameter abort_mode, which is set in routine message.44 !45 ! 147 2008-02-01 12:41:46Z raasch46 ! Bugfix: a stop command was missing in some cases of the parallel branch47 !48 ! 108 2007-08-24 15:10:38Z letzel49 ! modifications to terminate coupled runs50 !51 ! RCS Log replace by Id keyword, revision history cleaned up52 !53 ! Revision 1.2 2003/03/16 09:40:28 raasch54 ! Two underscores (_) are placed in front of all define-strings55 !56 38 ! Revision 1.1 2002/12/19 15:46:23 raasch 57 39 ! Initial revision … … 64 46 65 47 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 67 53 68 54 -
palm/trunk/SOURCE/local_system.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! revision history before 2012 removed, 23 ! comment fields (!:) to be used for variable explanations added to 24 ! all variable declaration statements 23 25 ! 24 26 ! Former revisions: … … 28 30 ! 1036 2012-10-22 13:43:42Z raasch 29 31 ! code put under GPL (PALM 3.9) 30 !31 ! 82 2007-04-16 15:40:52Z raasch32 ! Preprocessor directives for old systems removed33 !34 ! RCS Log replace by Id keyword, revision history cleaned up35 !36 ! Revision 1.4 2003/03/16 09:40:33 raasch37 ! Two underscores (_) are placed in front of all define-strings38 32 ! 39 33 ! Revision 1.1 1997/09/03 06:27:27 raasch … … 46 40 !------------------------------------------------------------------------------! 47 41 48 CHARACTER (LEN=*) :: command 42 CHARACTER (LEN=*) :: command !: 49 43 50 44 CALL SYSTEM( command ) -
palm/trunk/SOURCE/local_tremain.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! 225 2009-01-26 14:44:20Z raasch32 ! Type of count and count_rate changed to INTEGER(8) in order to avoid out of33 ! range problems (which result in measured negative time intervals)34 !35 ! 82 2007-04-16 15:40:52Z raasch36 ! Preprocessor strings for different linux clusters changed to "lc",37 ! preprocessor directives for old systems removed38 !39 ! RCS Log replace by Id keyword, revision history cleaned up40 !41 ! Revision 1.14 2006/06/02 15:20:33 raasch42 ! Extended to TIT Sun Fire X4600 System (lctit)43 35 ! 44 36 ! Revision 1.1 1998/03/18 20:14:47 raasch … … 51 43 !------------------------------------------------------------------------------! 52 44 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 55 53 USE pegrid 56 54 57 55 IMPLICIT NONE 58 56 59 REAL :: remaining_time57 REAL(wp) :: remaining_time !: 60 58 #if defined( __ibm ) 61 INTEGER( 8) :: IRTC62 REAL :: actual_wallclock_time59 INTEGER(idp) :: IRTC !: 60 REAL(wp) :: actual_wallclock_time !: 63 61 #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 !: 66 65 #endif 67 66 -
palm/trunk/SOURCE/local_tremain_ini.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 32 37 ! code put under GPL (PALM 3.9) 33 38 ! 34 ! 225 2009-01-26 14:44:20Z raasch35 ! Type of count and count_rate changed to INTEGER(8) in order to avoid out of36 ! range problems (which result in measured negative time intervals)37 !38 ! 82 2007-04-16 15:40:52Z raasch39 ! Cpp-directive lctit renamed lc40 !41 ! RCS Log replace by Id keyword, revision history cleaned up42 !43 ! Revision 1.13 2007/02/11 13:07:03 raasch44 ! Allowed cpu limit is now read from file instead of reading the value from45 ! environment variable (see routine parin)46 !47 39 ! Revision 1.1 1998/03/18 20:15:05 raasch 48 40 ! Initial revision … … 53 45 ! Initialization of CPU-time measurements for different operating systems 54 46 !------------------------------------------------------------------------------! 55 56 USE control_parameters 57 USE cpulog 47 48 USE cpulog, & 49 ONLY: initial_wallclock_time 50 51 USE kinds 58 52 59 53 IMPLICIT NONE 60 54 61 55 #if defined( __ibm ) 62 INTEGER( 8) :: IRTC56 INTEGER(idp) :: IRTC !: 63 57 #elif defined( __lc ) 64 INTEGER(8) :: count, count_rate 58 INTEGER(idp) :: count !: 59 INTEGER(idp) :: count_rate !: 65 60 #endif 66 61 -
palm/trunk/SOURCE/lpm.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 28 ! 24 29 ! Former revisions: … … 59 64 ! wang_collision_kernel renamed wang_kernel 60 65 ! 61 ! 799 2011-12-21 17:48:03Z franke62 ! Implementation of Wang collision kernel and corresponding new parameter63 ! wang_collision_kernel64 !65 ! 792 2011-12-01 raasch66 ! particle arrays (particles, particles_temp) implemented as pointers in67 ! order to speed up sorting (see routine sort_particles)68 !69 ! 759 2011-09-15 13:58:31Z raasch70 ! Splitting of parallel I/O (routine write_particles)71 66 ! 72 67 ! Revision 1.1 1999/11/25 16:16:06 raasch … … 79 74 !------------------------------------------------------------------------------! 80 75 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 85 99 USE pegrid 86 USE statistics87 100 88 101 IMPLICIT NONE 89 102 90 INTEGER :: m103 INTEGER(iwp) :: m !: 91 104 92 105 -
palm/trunk/SOURCE/lpm_advec.f90
r1315 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 28 ! 24 29 ! Former revisions: … … 44 49 !------------------------------------------------------------------------------! 45 50 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 52 77 53 78 IMPLICIT NONE 54 79 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 !: 75 148 76 149 ! -
palm/trunk/SOURCE/lpm_boundary_conds.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 26 31 ! $Id$ 27 32 ! 28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 !31 33 ! 1036 2012-10-22 13:43:42Z raasch 32 34 ! code put under GPL (PALM 3.9) … … 38 40 ! 824 2012-02-17 09:09:57Z raasch 39 41 ! particle attributes speed_x|y|z_sgs renamed rvar1|2|3 40 !41 ! 150 2008-02-29 08:19:58Z raasch42 ! Vertical index calculations adjusted for ocean runs.43 42 ! 44 43 ! Initial version (2007/03/09) … … 61 60 !------------------------------------------------------------------------------! 62 61 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 69 85 USE pegrid 70 86 71 87 IMPLICIT NONE 72 88 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 !: 86 133 87 134 IF ( range == 'bottom/top' ) THEN -
palm/trunk/SOURCE/lpm_calc_liquid_water_content.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: 25 29 ! ----------------- 26 30 ! $Id$ 27 !28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 31 ! 31 32 ! 1036 2012-10-22 13:43:42Z raasch … … 41 42 !------------------------------------------------------------------------------! 42 43 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 51 69 52 70 IMPLICIT NONE 53 71 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 !: 55 77 56 78 -
palm/trunk/SOURCE/lpm_collision_kernels.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: 25 30 ! ----------------- 26 31 ! $Id$ 27 !28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 32 ! 31 33 ! 1092 2013-02-02 11:24:22Z raasch … … 62 64 ! routine renamed from wang_kernel to lpm_collision_kernels, 63 65 ! turbulence_effects on collision replaced by wang_kernel 64 !65 ! 799 2011-12-21 17:48:03Z franke66 ! speed optimizations and formatting67 ! Bugfix: iq=1 is not allowed (routine effic)68 ! Bugfix: replaced stop by ec=0.0 in case of very small ec (routine effic)69 66 ! 70 67 ! 790 2011-11-29 03:11:20Z raasch … … 86 83 !------------------------------------------------------------------------------! 87 84 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 92 93 USE pegrid 93 94 … … 100 101 rclass_lbound, rclass_ubound, recalculate_kernel 101 102 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 !: 107 121 108 122 SAVE … … 134 148 IMPLICIT NONE 135 149 136 INTEGER :: i, j, k 150 INTEGER(iwp) :: i !: 151 INTEGER(iwp) :: j !: 152 INTEGER(iwp) :: k !: 137 153 138 154 … … 262 278 SUBROUTINE recalculate_kernel( i1, j1, k1 ) 263 279 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 270 285 271 286 IMPLICIT NONE 272 287 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 !: 274 295 275 296 … … 340 361 SUBROUTINE turbsd 341 362 342 USE con stants343 USE cloud_parameters344 USE particle_attributes345 USE arrays_3d346 USE control_parameters363 USE control_parameters, & 364 ONLY: g, molecular_viscosity 365 366 USE particle_attributes, & 367 ONLY: radius_classes 347 368 348 369 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 362 423 ! 363 424 !-- Initial assignment of constants … … 478 539 ! phi_w as a function 479 540 !------------------------------------------------------------------------------! 480 REAL FUNCTION phi_w( a, b, vsett, tau0 )541 REAL(wp) FUNCTION phi_w( a, b, vsett, tau0 ) 481 542 482 543 IMPLICIT NONE 483 544 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 !: 485 550 486 551 aa1 = 1.0 / tau0 + 1.0 / a + vsett / b … … 493 558 ! zhi as a function 494 559 !------------------------------------------------------------------------------! 495 REAL FUNCTION zhi( a, b, vsett1, tau1, vsett2, tau2 )560 REAL(wp) FUNCTION zhi( a, b, vsett1, tau1, vsett2, tau2 ) 496 561 497 562 IMPLICIT NONE 498 563 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 !: 500 576 501 577 aa1 = vsett2 / b - 1.0 / tau2 - 1.0 / a … … 518 594 !------------------------------------------------------------------------------! 519 595 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 526 606 527 607 IMPLICIT NONE 528 608 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 !: 539 631 540 632 ! … … 617 709 !------------------------------------------------------------------------------! 618 710 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 624 714 625 715 IMPLICIT NONE 626 716 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 !: 638 738 639 739 ! … … 754 854 SUBROUTINE turb_enhance_eff 755 855 756 USE constants 757 USE cloud_parameters 758 USE particle_attributes 759 USE arrays_3d 856 USE particle_attributes, & 857 ONLY: radius_classes 760 858 761 859 IMPLICIT NONE 762 860 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 !: 774 886 775 887 ! … … 898 1010 IMPLICIT NONE 899 1011 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 !: 910 1038 911 1039 mean_rm = mean_r * 1.0E06 -
palm/trunk/SOURCE/lpm_data_output_particles.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! revision history before 2012 removed, 23 24 ! 24 25 ! Former revisions: 25 26 ! ----------------- 26 27 ! $Id$ 27 !28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 !31 28 ! 32 29 ! 1036 2012-10-22 13:43:42Z raasch … … 43 40 !------------------------------------------------------------------------------! 44 41 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 47 48 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 49 54 50 55 IMPLICIT NONE … … 64 69 number_of_tails 65 70 IF ( maximum_number_of_tails > 0 ) THEN 66 WRITE ( 85 ) particle_tail_coordinates 71 WRITE ( 85 ) particle_tail_coordinates, prt_time_count 67 72 ENDIF 68 73 -
palm/trunk/SOURCE/lpm_droplet_collision.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 28 ! 24 29 ! Former revisions: 25 30 ! ----------------- 26 31 ! $Id$ 27 !28 ! 1318 2014-03-17 13:35:16Z raasch29 ! module interfaces removed30 32 ! 31 33 ! 1092 2013-02-02 11:24:22Z raasch … … 67 69 !------------------------------------------------------------------------------! 68 70 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 78 101 79 102 IMPLICIT NONE 80 103 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 91 157 92 158 -
palm/trunk/SOURCE/lpm_droplet_condensation.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 61 65 !------------------------------------------------------------------------------! 62 66 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 71 96 72 97 IMPLICIT NONE 73 98 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 87 151 !-- 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 96 176 97 177 -
palm/trunk/SOURCE/lpm_exchange_horiz.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 45 49 !------------------------------------------------------------------------------! 46 50 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 52 75 USE pegrid 53 76 54 77 IMPLICIT NONE 55 78 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 !: 66 111 67 112 #if defined( __parallel ) -
palm/trunk/SOURCE/lpm_extend_particle_array.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 38 42 !------------------------------------------------------------------------------! 39 43 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 41 50 42 51 IMPLICIT NONE 43 52 44 INTEGER :: new_maximum_number, number_of_new_particles 53 INTEGER(iwp) :: new_maximum_number !: 54 INTEGER(iwp) :: number_of_new_particles !: 45 55 46 LOGICAL, DIMENSION(:), ALLOCATABLE :: tmp_particle_mask47 56 48 TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles 57 LOGICAL, DIMENSION(:), ALLOCATABLE :: tmp_particle_mask !: 58 59 TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles !: 49 60 50 61 -
palm/trunk/SOURCE/lpm_extend_tail_array.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 38 42 !------------------------------------------------------------------------------! 39 43 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 41 50 42 51 IMPLICIT NONE 43 52 44 INTEGER :: new_maximum_number, number_of_new_tails 53 INTEGER(iwp) :: new_maximum_number !: 54 INTEGER(iwp) :: number_of_new_tails !: 45 55 46 LOGICAL, DIMENSION(maximum_number_of_tails) :: tmp_tail_mask 56 LOGICAL, DIMENSION(maximum_number_of_tails) :: tmp_tail_mask !: 47 57 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 !: 50 60 51 61 -
palm/trunk/SOURCE/lpm_extend_tails.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 38 42 !------------------------------------------------------------------------------! 39 43 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 42 53 43 54 IMPLICIT NONE 44 55 45 INTEGER :: i, n, nn 56 INTEGER(iwp) :: i !: 57 INTEGER(iwp) :: n !: 58 INTEGER(iwp) :: nn !: 46 59 47 REAL :: distance60 REAL(wp) :: distance !: 48 61 49 62 -
palm/trunk/SOURCE/lpm_init.f90
r1315 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 22 29 ! 23 30 ! Former revisions: … … 52 59 ! of arrays. 53 60 ! 54 ! 622 2010-12-10 08:08:13Z raasch55 ! optional barriers included in order to speed up collective operations56 !57 ! 336 2009-06-10 11:19:35Z raasch58 ! Maximum number of tails is calculated from maximum number of particles and59 ! skip_particles_for_tail,60 ! output of messages replaced by message handling routine61 ! Bugfix: arrays for tails are allocated with a minimum size of 10 tails if62 ! there is no tail initially63 !64 ! 150 2008-02-29 08:19:58Z raasch65 ! Setting offset_ocean_* needed for calculating vertical indices within ocean66 ! runs67 !68 ! 117 2007-10-11 03:27:59Z raasch69 ! Sorting of particles only in case of cloud droplets70 !71 ! 106 2007-08-16 14:30:26Z raasch72 ! variable iran replaced by iran_part73 !74 ! 82 2007-04-16 15:40:52Z raasch75 ! Preprocessor directives for old systems removed76 !77 ! 70 2007-03-18 23:46:30Z raasch78 ! displacements for mpi_particle_type changed, age_m initialized,79 ! particles-package is now part of the default code80 !81 ! 16 2007-02-15 13:16:47Z raasch82 ! Bugfix: MPI_REAL in MPI_ALLREDUCE replaced by MPI_INTEGER83 !84 ! r4 | raasch | 2007-02-13 12:33:16 +0100 (Tue, 13 Feb 2007)85 ! RCS Log replace by Id keyword, revision history cleaned up86 !87 ! Revision 1.24 2007/02/11 13:00:17 raasch88 ! Bugfix: allocation of tail_mask and new_tail_id in case of restart-runs89 ! Bugfix: __ was missing in a cpp-directive90 !91 61 ! Revision 1.1 1999/11/25 16:22:38 raasch 92 62 ! Initial revision … … 99 69 !------------------------------------------------------------------------------! 100 70 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 109 117 USE pegrid 110 USE random_function_mod 118 119 USE random_function_mod, & 120 ONLY: random_function 111 121 112 122 113 123 IMPLICIT NONE 114 124 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 116 131 #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 !: 118 135 #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 122 147 123 148 … … 211 236 z0_av_global = 0.0 212 237 238 #if defined( __parallel ) 213 239 CALL MPI_ALLREDUCE(z0_av_local, z0_av_global, 1, MPI_REAL, MPI_SUM, & 214 240 comm2d, ierr ) 241 #else 242 z0_av_global = z0_av_local 243 #endif 215 244 216 245 z0_av_global = z0_av_global / ( ( ny + 1 ) * ( nx + 1 ) ) -
palm/trunk/SOURCE/lpm_init_sgs_tke.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 41 45 !------------------------------------------------------------------------------! 42 46 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 48 62 USE pegrid 49 USE statistics 63 64 USE statistics, & 65 ONLY: flow_statistics_called, hom, sums, sums_l 50 66 51 67 IMPLICIT NONE 52 68 53 INTEGER :: i, j, k 69 INTEGER(iwp) :: i !: 70 INTEGER(iwp) :: j !: 71 INTEGER(iwp) :: k !: 54 72 55 73 -
palm/trunk/SOURCE/lpm_pack_arrays.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 40 44 !------------------------------------------------------------------------------! 41 45 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 43 53 44 54 IMPLICIT NONE 45 55 46 INTEGER :: n, nd, nn47 48 56 INTEGER(iwp) :: n !: 57 INTEGER(iwp) :: nd !: 58 INTEGER(iwp) :: nn !: 49 59 ! 50 60 !-- Find out elements marked for deletion and move data with higher index -
palm/trunk/SOURCE/lpm_read_restart_file.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! comment fields (!:) to be used for variable explanations added to 24 ! all variable declaration statements 23 25 ! 24 26 ! Former revisions: … … 38 40 !------------------------------------------------------------------------------! 39 41 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 43 59 USE pegrid 44 60 45 61 IMPLICIT NONE 46 62 47 CHARACTER (LEN=10) :: particle_binary_version, version_on_file 63 CHARACTER (LEN=10) :: particle_binary_version !: 64 CHARACTER (LEN=10) :: version_on_file !: 48 65 49 66 ! -
palm/trunk/SOURCE/lpm_release_set.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 40 44 !------------------------------------------------------------------------------! 41 45 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 47 67 48 68 IMPLICIT NONE 49 69 50 INTEGER :: ie, is, n, nn 70 INTEGER(iwp) :: ie !: 71 INTEGER(iwp) :: is !: 72 INTEGER(iwp) :: n !: 73 INTEGER(iwp) :: nn !: 51 74 52 75 -
palm/trunk/SOURCE/lpm_set_attributes.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 37 42 ! 828 2012-02-21 12:00:36Z raasch 38 43 ! particle feature color renamed class 39 !40 ! 622 2010-12-10 08:08:13Z raasch41 ! optional barriers included in order to speed up collective operations42 44 ! 43 45 ! 271 2009-03-26 00:47:14Z raasch … … 50 52 !------------------------------------------------------------------------------! 51 53 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 59 78 USE pegrid 60 USE statistics 79 80 USE statistics, & 81 ONLY: sums, sums_l 61 82 62 83 IMPLICIT NONE 63 84 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 !: 69 111 70 112 CALL cpu_log( log_point_s(49), 'lpm_set_attributes', 'start' ) -
palm/trunk/SOURCE/lpm_sort_arrays.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 41 45 !------------------------------------------------------------------------------! 42 46 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 49 64 50 65 IMPLICIT NONE 51 66 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 !: 53 72 54 TYPE(particle_type), DIMENSION(:), POINTER :: particles_temp 73 TYPE(particle_type), DIMENSION(:), POINTER :: particles_temp !: 55 74 56 75 -
palm/trunk/SOURCE/lpm_write_exchange_statistics.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! comment fields (!:) to be used for variable explanations added to 24 ! all variable declaration statements 23 25 ! 24 26 ! Former revisions: … … 42 44 !------------------------------------------------------------------------------! 43 45 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 46 55 USE pegrid 47 56 -
palm/trunk/SOURCE/lpm_write_restart_file.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 38 42 !------------------------------------------------------------------------------! 39 43 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 42 58 USE pegrid 43 59 44 60 IMPLICIT NONE 45 61 46 CHARACTER (LEN=10) :: particle_binary_version 47 INTEGER :: i62 CHARACTER (LEN=10) :: particle_binary_version !: 63 INTEGER(iwp) :: i !: 48 64 49 65 ! -
palm/trunk/SOURCE/ls_forcing.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 59 63 SUBROUTINE init_ls_forcing 60 64 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 66 77 67 78 IMPLICIT NONE 68 79 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 !: 75 98 76 99 ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf), & … … 226 249 SUBROUTINE ls_forcing_surf ( time ) 227 250 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 233 261 234 262 IMPLICIT NONE 235 263 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 !: 239 268 240 269 ! … … 284 313 SUBROUTINE ls_forcing_vert ( time ) 285 314 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 291 323 292 324 IMPLICIT NONE 293 325 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 !: 297 330 298 331 ! -
palm/trunk/SOURCE/message.f90
r1310 r1320 21 21 ! Current revisions: 22 22 ! ----------------- 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 24 28 ! 25 29 ! Former revisions: … … 29 33 ! 1036 2012-10-22 13:43:42Z raasch 30 34 ! code put under GPL (PALM 3.9) 31 !32 ! 746 2011-08-18 21:14:48Z letzel33 ! 'wiki' inserted into weblink path to error message database34 !35 ! 563 2010-09-30 13:08:44Z raasch36 ! Weblink to error message database changed to new trac server37 35 ! 38 36 ! 213 2008-11-13 10:26:18Z raasch … … 50 48 !------------------------------------------------------------------------------! 51 49 50 USE control_parameters, & 51 ONLY: abort_mode, message_string 52 53 USE kinds 54 52 55 USE pegrid 53 USE control_parameters54 56 55 57 IMPLICIT NONE 56 58 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 !: 64 74 65 75 -
palm/trunk/SOURCE/microphysics.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 111 115 USE grid_variables 112 116 USE indices 117 USE kinds 113 118 USE statistics 114 119 115 120 IMPLICIT NONE 116 121 117 INTEGER :: i, j, k 118 122 INTEGER(iwp) :: i !: 123 INTEGER(iwp) :: j !: 124 INTEGER(iwp) :: k !: 119 125 120 126 DO i = nxl, nxr … … 133 139 USE cloud_parameters 134 140 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 !: 139 148 140 149 … … 157 166 USE grid_variables 158 167 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 165 176 DO i = nxl, nxr 166 177 DO j = nys, nyn … … 180 191 USE control_parameters 181 192 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 188 201 DO i = nxl, nxr 189 202 DO j = nys, nyn … … 203 216 USE control_parameters 204 217 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 !: 209 225 210 226 … … 227 243 USE control_parameters 228 244 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 !: 234 252 235 253 DO i = nxl, nxr … … 251 269 USE control_parameters 252 270 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 !: 258 278 259 279 DO i = nxl, nxr … … 275 295 USE control_parameters 276 296 USE indices 297 USE kinds 277 298 USE statistics 278 299 279 300 IMPLICIT NONE 280 301 281 INTEGER :: i, j, k 282 302 INTEGER(iwp) :: i !: 303 INTEGER(iwp) :: j !: 304 INTEGER(iwp) :: k !: 283 305 284 306 DO i = nxl, nxr … … 299 321 SUBROUTINE microphysics_control_ij( i, j ) 300 322 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 !: 312 350 313 351 IF ( large_scale_forcing .AND. lsf_surf ) THEN … … 369 407 SUBROUTINE adjust_cloud_ij( i, j ) 370 408 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 !: 378 425 ! 379 426 !-- Adjust number of raindrops to avoid nonlinear effects in … … 407 454 SUBROUTINE autoconversion_ij( i, j ) 408 455 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 !: 421 494 422 495 k_au = k_cc / ( 20.0 * x0 ) … … 491 564 SUBROUTINE accretion_ij( i, j ) 492 565 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 !: 502 591 503 592 DO k = nzb_s_inner(j,i)+1, nzt … … 539 628 SUBROUTINE selfcollection_breakup_ij( i, j ) 540 629 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 545 643 546 644 IMPLICIT NONE 547 645 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 !: 550 654 551 655 DO k = nzb_s_inner(j,i)+1, nzt … … 581 685 !-- precipitable water. 582 686 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 !: 594 730 595 731 DO k = nzb_s_inner(j,i)+1, nzt … … 680 816 SUBROUTINE sedimentation_cloud_ij( i, j ) 681 817 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 687 834 688 835 IMPLICIT NONE 689 836 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 694 845 695 846 ! … … 725 876 SUBROUTINE sedimentation_rain_ij( i, j ) 726 877 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 733 898 734 899 IMPLICIT NONE 735 900 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 742 929 ! 743 930 !-- Computation of sedimentation flux. Implementation according to Stevens … … 896 1083 FUNCTION gamm( xx ) 897 1084 898 USE cloud_parameters 899 1085 USE cloud_parameters, & 1086 ONLY: cof, stp 1087 1088 USE kinds 1089 900 1090 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 906 1101 x_gamm = xx 907 1102 y_gamm = x_gamm -
palm/trunk/SOURCE/mod_kinds.f90
r1319 r1320 26 26 ! $Id$ 27 27 ! 28 ! 1318 2014-03-17 13:35:16Z raasch29 ! bugfix: default integer kind changed to single precision30 !31 28 ! 1306 2014-03-13 14:30:59Z raasch 32 29 ! Initial revision … … 46 43 ! 47 44 !-- 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) 50 47 51 48 ! 52 49 !-- 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) 55 52 56 53 ! 57 54 !-- Set kinds to be used as defaults 58 INTEGER, PARAMETER :: wp = dp ! default real kind59 INTEGER, PARAMETER :: iwp = isp ! default integer kind55 INTEGER, PARAMETER :: wp = dp !: default real kind 56 INTEGER, PARAMETER :: iwp = isp !: default integer kind 60 57 61 58 SAVE -
palm/trunk/SOURCE/modules.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 210 216 ! for thread-safe summation in advec_ws. 211 217 ! 212 ! 792 2011-12-01 01:23:23Z raasch213 ! particle arrays (particles, parrticles_temp) implemented as pointers,214 ! +particles_1, particles_2, sort_count215 !216 ! 790 2011-11-29 03:11:20Z raasch217 ! +turbulence_effects_on_collision, wang_collision_kernel218 !219 ! 785 2011-11-28 09:47:19Z raasch220 ! +scalar_rayleigh_damping, rdf_sc221 !222 ! 778 2011-11-07 14:18:25Z fricke223 ! +gathered_size, subdomain_size224 !225 ! 771 2011-10-27 10:56:21Z heinze226 ! +lpt_av227 !228 ! 767 2011-10-14 06:39:12Z raasch229 ! +u_profile, v_profile, uv_heights, use_prescribed_profile_data230 !231 ! 759 2011-09-15 13:58:31Z raasch232 ! +io_blocks, io_group, maximum_parallel_io_streams,233 ! synchronous_exchange moved to control_parameters234 !235 ! 743 2011-08-18 16:10:16Z suehring236 ! 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 for238 ! statistical evaluation of turbulent fluxes in WS-scheme decreased.239 ! 736 2011-08-17 14:13:26Z suehring240 ! Dimension of fluxes needed for WS-scheme increased.241 !242 ! 722 2011-04-11 06:21:09Z raasch243 ! Bugfix: default value for south_border_pe changed to .F.244 !245 ! 707 2011-03-29 11:39:40Z raasch246 ! +bc_lr_dirrad, bc_lr_raddir, bc_ns_dirrad, bc_ns_raddir, left_border_pe,247 ! north_border_pe, right_border_pe, south_border_pe248 ! p_sub renamed p_loc249 !250 ! 683 2011-02-09 14:25:15Z raasch251 ! +synchronous_exchange252 !253 ! 673 2011-01-18 16:19:48Z suehring254 ! +weight_pres to weight the respective contribution of the Runge-Kutta255 ! substeps. +p_sub to buffer the intermediate contributions for Multigrid and256 ! SOR.257 !258 ! 667 2010-12-23 12:06:00Z suehring/gryschka259 ! Removed u_nzb_p1_for_vfc and v_nzb_p1_for_vfc260 ! 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_topology263 ! 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_sa267 ! 3d arrays for dissipation control added. (only necessary for vector arch.)268 ! +var_x, +var_y, +var_z, +gamma_x, +gamma_y, +gamma_z269 ! 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 order273 ! 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 in275 ! 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_l278 ! and +weight_substep added in statistics to steer the statistical evaluation279 ! of turbulent fluxes in the advection routines.280 ! LOGICALS +ws_scheme_sca and +ws_scheme_mom added to get a better performance281 ! in prognostic_equations.282 ! LOGICAL +dissipation_control control added to steer numerical dissipation283 ! in ws-scheme.284 ! Changed length of string run_description_header285 !286 ! 622 2010-12-10 08:08:13Z raasch287 ! +collective_wait in pegrid288 !289 ! 600 2010-11-24 16:10:51Z raasch290 ! default values of surface_scalarflux and surface_waterflux changed291 ! to 9999999.9292 !293 ! 580 2010-10-05 13:59:11Z heinze294 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,295 ! ws_vertical_gradient_level to subs_vertical_gradient_level and296 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i297 !298 ! 564 2010-09-30 13:18:59Z helmke299 ! nc_precision and netcdf_precision dimension changed to 11, all default300 ! values of mask_xyz_loop changed to -1.0, dimension of openfile changed to301 ! 200+2*max_masks, max_masks changed to 50302 !303 ! 553 2010-09-01 14:09:06Z weinreis304 ! parameters for masked output are replaced by arrays305 !306 ! 531 2010-04-21 06:47:21Z heinze307 ! character length of dopr_unit enlarged308 !309 ! 519 2010-03-19 05:30:02Z raasch310 ! -replace_char, replace_by311 !312 ! 493 2010-03-01 08:30:24Z raasch313 ! +netcdf_data_format, -netcdf_64bit, -netcdf_64bit_3d, -netcdf_format_mask*,314 ! -nc_format_mask, -format_parallel_io315 !316 ! 485 2010-02-05 10:57:51Z raasch317 ! ngp_3d, ngp_3d_inner changed to 64 bit318 !319 ! 449 2010-02-02 11:23:59Z raasch320 ! -var_ts: replaced by dots_max,321 ! initial data assignments to some dvrp arrays changed due to error messages322 ! from gfortran compiler323 ! +large_scale_subsidence, ws_vertical_gradient, ws_vertical_gradient_level,324 ! ws_vertical_gradient_level_ind, w_subs325 !326 ! 388 2009-09-23 09:40:33Z raasch327 ! +prho, prho_1328 ! +bc_lr_cyc, bc_ns_cyc329 ! +output_for_t0330 ! translation error of actual -> current revisions fixed331 ! +q* in dots_label, dots_unit. increased dots_num respectively332 ! typographical error in dots_unit fixed333 ! +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 strict343 ! +shf_av, qsws_av344 !345 ! 217 2008-12-09 18:00:48Z letzel346 ! +topography_grid_convention347 ! some dvrp-variables changed to single precision, variables for dvrp-mode348 ! pathlines added, +target_id, abort_mode, message_string349 !350 ! 197 2008-09-16 15:29:03Z raasch351 ! allow 100 spectra levels instead of 10 for consistency with352 ! define_netcdf_header, +canopy_heat_flux, cthf, lai,353 ! +leaf_surface_concentration, scalar_exchange_coefficient, sec, sls354 ! +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_inflow357 ! -myid_char_14358 !359 ! 138 2007-11-28 10:03:58Z letzel360 ! +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_mode363 ! +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 letzel368 ! +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 raasch375 ! +atmos_ocean_sign, ocean, r, + salinity variables376 ! defaults of .._vertical_gradient_levels changed from -1.0 to -9999999.9377 ! hydro_press renamed hyp, use_pt_reference renamed use_reference378 !379 ! 89 2007-05-25 12:08:31Z raasch380 ! +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_palm383 !384 ! 82 2007-04-16 15:40:52Z raasch385 ! +return_addres, return_username386 ! Cpp-directive lcmuk renamed lc387 !388 ! 75 2007-03-22 09:54:05Z raasch389 ! +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, revision394 ! +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 program398 !399 ! 37 2007-03-01 08:33:54Z raasch400 ! +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 pointer403 !404 218 ! RCS Log replace by Id keyword, revision history cleaned up 405 219 ! … … 415 229 ! Definition of variables for special advection schemes 416 230 !------------------------------------------------------------------------------! 417 418 REAL, DIMENSION(:), ALLOCATABLE :: aex, bex, dex, eex 231 USE kinds 232 233 REAL(wp), DIMENSION(:), ALLOCATABLE :: aex, bex, dex, eex 419 234 420 235 SAVE … … 425 240 426 241 427 MODULE precision_kind428 429 !------------------------------------------------------------------------------!430 ! Description:431 ! ------------432 ! Definition of type parameters (used for the definition of single or double433 ! precision variables)434 !------------------------------------------------------------------------------!435 436 INTEGER, PARAMETER :: dpk = SELECTED_REAL_KIND( 12 ), &437 spk = SELECTED_REAL_KIND( 6 )438 439 SAVE440 441 END MODULE precision_kind442 443 444 445 446 242 MODULE arrays_3d 447 243 … … 452 248 !------------------------------------------------------------------------------! 453 249 454 USE precision_kind455 456 REAL , DIMENSION(:), ALLOCATABLE ::&250 USE kinds 251 252 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 457 253 c_u_m, c_u_m_l, c_v_m, c_v_m_l, c_w_m, c_w_m_l, ddzu, ddzu_pres, & 458 254 dd2zu, dzu, ddzw, dzw, hyp, inflow_damping_factor, lad, l_grid, & … … 462 258 u_init, u_nzb_p1_for_vfc, vg, v_init, v_nzb_p1_for_vfc, w_subs, zu, zw 463 259 464 REAL , DIMENSION(:,:), ALLOCATABLE ::&260 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 465 261 c_u, c_v, c_w, diss_s_e, diss_s_nr, diss_s_pt, diss_s_q, & 466 262 diss_s_qr, diss_s_sa, diss_s_u, diss_s_v, diss_s_w, dzu_mg, dzw_mg, & … … 473 269 wnudge, wsubs_vert, z0, z0h 474 270 475 REAL , DIMENSION(:,:,:), ALLOCATABLE ::&271 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 476 272 canopy_heat_flux, cdc, d, de_dx, de_dy, de_dz, diss, diss_l_e, & 477 273 diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr, diss_l_sa, diss_l_u, & … … 483 279 484 280 #if defined( __nopointer ) 485 REAL , DIMENSION(:,:,:), ALLOCATABLE, TARGET ::&281 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: & 486 282 e, e_p, nr, nr_p, p, prho, pt, pt_p, q, q_p, qc, ql, ql_c, ql_v, & 487 283 ql_vp, qr, qr_p, rho, sa, sa_p, te_m, tnr_m, tpt_m, tq_m, tqr_m, & 488 284 tsa_m, tu_m, tv_m, tw_m, u, u_p, v, v_p, vpt, w, w_p 489 285 #else 490 REAL , DIMENSION(:,:,:), ALLOCATABLE, TARGET ::&286 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: & 491 287 e_1, e_2, e_3, p, prho_1, nr_1, nr_2, nr_3, pt_1, pt_2, pt_3, q_1, & 492 288 q_2, q_3, qc_1, ql_v, ql_vp, ql_1, ql_2, qr_1, qr_2, qr_3, rho_1, & 493 289 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 494 290 495 REAL , DIMENSION(:,:,:), POINTER ::&291 REAL(wp), DIMENSION(:,:,:), POINTER :: & 496 292 e, e_p, nr, nr_p, prho, pt, pt_p, q, q_p, qc, ql, ql_c, qr, qr_p, & 497 293 rho, sa, sa_p, te_m, tnr_m, tpt_m, tq_m, tqr_m, tsa_m, tu_m, tv_m, & … … 499 295 #endif 500 296 501 REAL , DIMENSION(:,:,:,:), ALLOCATABLE :: rif_wall, tri502 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, & 504 300 gamma_y, gamma_z 505 301 … … 519 315 ! Definition of variables needed for time-averaging of 2d/3d data 520 316 !------------------------------------------------------------------------------! 521 522 REAL, DIMENSION(:,:), ALLOCATABLE :: lwp_av, precipitation_rate_av, & 317 USE kinds 318 319 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lwp_av, precipitation_rate_av, & 523 320 qsws_av, shf_av,ts_av, us_av, z0_av, & 524 321 z0h_av 525 322 526 REAL , DIMENSION(:,:,:), ALLOCATABLE, TARGET ::&323 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: & 527 324 e_av, lpt_av, nr_av, p_av, pc_av, pr_av, prr_av, pt_av, q_av, qc_av, & 528 325 ql_av, ql_c_av, ql_v_av, ql_vp_av, qr_av, qv_av, rho_av, s_av, sa_av,& … … 540 337 ! Definition of variables and constants for cloud physics 541 338 !------------------------------------------------------------------------------! 339 USE kinds 542 340 543 341 LOGICAL :: curvature_solution_effects = .FALSE., & … … 546 344 547 345 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. parametrization551 a_term = 9.65, & !coef. for terminal velocity (m s-1)552 a_vent = 0.78, & !coef. for ventilation effect553 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. parametrization556 b_term = 9.8, & !coef. for terminal velocity (m s-1)557 b_vent = 0.308, & !coef. for ventilation effect558 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. parametrization563 c_const = 0.93, & !const. in Taylor-microscale Reynolds number564 c_evap = 0.7, & !constant in evaporation565 c_sedimentation = 2.0, & !Courant number of sedimentation process566 c_term = 600.0, & !coef. for terminal velocity (m-1)567 cof(6) = (/ 76.18009172947146, & !coefficients in the568 -86.50532032941677, & !numerical569 24.01409824083091, & !calculation of the570 -1.231739572450155, & !gamma function571 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 method577 eps_sb = 1.0E-20, & !threshold in two-moments scheme578 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_v587 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 concentration591 prec_time_const = 0.001, & !coef. in Kessler scheme592 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 scheme595 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 number598 schmidt_p_1d3, & !schmidt**( 1.0 / 3.0 )599 sigma_gc = 1.3, & !log-normal geometric standard deviation600 stp = 2.5066282746310005, & !parameter in gamma function601 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 NaCl603 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_pt610 611 REAL , DIMENSION(:,:), ALLOCATABLE :: precipitation_amount, &612 precipitation_rate346 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 613 411 ! 614 412 !-- 3D array of precipitation rate 615 REAL , DIMENSION(:,:,:), ALLOCATABLE :: prr413 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: prr 616 414 617 415 SAVE … … 629 427 ! Definition of general constants 630 428 !------------------------------------------------------------------------------! 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 634 433 635 434 … … 648 447 ! Definition of parameters for program control 649 448 !------------------------------------------------------------------------------! 449 USE kinds 650 450 651 451 TYPE plot_precision 652 452 CHARACTER (LEN=8) :: variable 653 INTEGER 453 INTEGER(iwp) :: precision 654 454 END TYPE plot_precision 655 455 … … 722 522 CHARACTER (LEN=10), DIMENSION(0:1,100) :: do2d = ' ', do3d = ' ' 723 523 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 = 0750 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) = -9999524 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 767 567 768 568 #if defined ( __check ) 769 INTEGER :: check_restart = 0569 INTEGER(iwp) :: check_restart = 0 770 570 #endif 771 571 772 INTEGER , DIMENSION(0:1) :: ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, ntdim_3d773 774 INTEGER , DIMENSION(:), ALLOCATABLE :: grid_level_count775 776 INTEGER , DIMENSION(:,:), ALLOCATABLE :: mask_i, mask_j, mask_k777 INTEGER , DIMENSION(:,:), ALLOCATABLE :: &778 mask_i_global, mask_j_global, mask_k_global572 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 779 579 780 580 LOGICAL :: avs_output = .FALSE., & … … 829 629 data_output_yz(0:1) = .FALSE. 830 630 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.0901 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.9931 932 REAL , DIMENSION(:), ALLOCATABLE :: dp_smooth_factor933 934 REAL , DIMENSION(max_masks,mask_xyz_dimension) :: &935 mask_x = -1.0, mask_y = -1.0, mask_z = -1.0936 REAL , DIMENSION(max_masks,3) :: &937 mask_x_loop = -1.0, mask_y_loop = -1.0, mask_z_loop = -1.0631 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 938 738 939 739 ! 940 740 !-- internal mask arrays ("mask,dimension,selection") 941 REAL , DIMENSION(:,:,:), ALLOCATABLE :: mask, mask_loop741 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: mask, mask_loop 942 742 943 743 SAVE … … 954 754 ! Definition of variables used with dvrp-software 955 755 !------------------------------------------------------------------------------! 756 757 USE kinds 956 758 957 759 CHARACTER (LEN=10) :: dvrp_output = 'rtsp', particle_color = 'none', & … … 967 769 dvrp_username = ' ' 968 770 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 = 2977 978 INTEGER , DIMENSION(10) :: slicer_position_dvrp771 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 979 781 980 782 LOGICAL :: cyclic_dvrp = .FALSE., dvrp_overlap, dvrp_total_overlap, & … … 982 784 use_seperate_pe_for_dvrp_output = .FALSE. 983 785 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.0988 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 /) 994 796 995 797 #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.0798 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 1022 824 #else 1023 REAL , DIMENSION(2,10) :: slicer_range_limits_dvrp1024 1025 REAL , DIMENSION(3,10) :: isosurface_color1026 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.0825 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 1033 835 1034 836 DATA slicer_range_limits_dvrp / -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, & … … 1049 851 #endif 1050 852 1051 REAL( 4), DIMENSION(:), ALLOCATABLE :: xcoor_dvrp, ycoor_dvrp, zcoor_dvrp853 REAL(sp), DIMENSION(:), ALLOCATABLE :: xcoor_dvrp, ycoor_dvrp, zcoor_dvrp 1052 854 1053 855 TYPE steering 1054 856 CHARACTER (LEN=24) :: name 1055 REAL( 4):: min, max1056 INTEGER 857 REAL(sp) :: min, max 858 INTEGER(iwp) :: imin, imax 1057 859 END TYPE steering 1058 860 … … 1074 876 !------------------------------------------------------------------------------! 1075 877 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 1084 888 1085 889 SAVE … … 1098 902 !------------------------------------------------------------------------------! 1099 903 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 :: & 1107 913 ngp_3d, ngp_3d_inner ! need to have 64 bit for grids > 2E9 1108 914 1109 INTEGER , DIMENSION(:), ALLOCATABLE ::&1110 ngp_2dh, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg1111 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_2d1118 1119 INTEGER , DIMENSION(:,:,:), POINTER :: flags1120 1121 INTEGER , DIMENSION(:,:,:), ALLOCATABLE :: wall_flags_0, wall_flags_001122 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_101127 1128 REAL , DIMENSION(:,:,:), ALLOCATABLE :: rflags_s_inner, rflags_invers915 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 1129 935 1130 936 SAVE … … 1147 953 SUBROUTINE global_min_max ( i1, i2, j1, j2, k1, k2, feld, mode, offset, & 1148 954 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) 1156 965 1157 966 END SUBROUTINE global_min_max … … 1178 987 SUBROUTINE advec_s_bc( sk, sk_char ) 1179 988 989 USE kinds 990 1180 991 CHARACTER (LEN=*), INTENT(IN) :: sk_char 1181 992 #if defined( __nopointer ) 1182 REAL , DIMENSION(:,:,:) :: sk993 REAL(wp), DIMENSION(:,:,:) :: sk 1183 994 #else 1184 REAL , DIMENSION(:,:,:), POINTER :: sk995 REAL(wp), DIMENSION(:,:,:), POINTER :: sk 1185 996 #endif 1186 997 END SUBROUTINE advec_s_bc … … 1204 1015 !------------------------------------------------------------------------------! 1205 1016 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 1207 1020 1208 1021 LOGICAL :: run_control_header_1d = .FALSE., stop_dt_1d = .FALSE. 1209 1022 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, z0h1d1216 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_p1023 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 1221 1034 1222 1035 SAVE … … 1235 1048 !------------------------------------------------------------------------------! 1236 1049 1237 USE control_parameters 1050 USE control_parameters, ONLY: max_masks 1051 USE kinds 1238 1052 #if defined( __netcdf ) 1239 1053 USE netcdf 1240 1054 #endif 1241 1055 1242 INTEGER , PARAMETER :: dopr_norm_num = 7, dopts_num = 29, dots_max = 1001243 1244 INTEGER :: dots_num = 231056 INTEGER(iwp), PARAMETER :: dopr_norm_num = 7, dopts_num = 29, dots_max = 100 1057 1058 INTEGER(iwp) :: dots_num = 23 1245 1059 1246 1060 CHARACTER (LEN=6), DIMENSION(dopr_norm_num) :: dopr_norm_names = & … … 1306 1120 'not_used ' /) 1307 1121 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_stat1315 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_3d1334 1335 INTEGER , DIMENSION(10) :: id_var_dospx, id_var_dospy1336 INTEGER , DIMENSION(20) :: id_var_prt1337 INTEGER , DIMENSION(11) :: nc_precision1338 INTEGER , DIMENSION(dopr_norm_num) :: id_var_norm_dopr1339 1340 INTEGER , DIMENSION(dopts_num,0:10) :: id_var_dopts1341 INTEGER , DIMENSION(0:1,100) :: id_var_do2d, id_var_do3d1342 INTEGER , DIMENSION(100,0:9) :: id_dim_z_pr, id_var_dopr, &1343 id_var_z_pr1344 INTEGER , DIMENSION(dots_max,0:9) :: id_var_dots1122 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 1345 1159 1346 1160 ! … … 1350 1164 LOGICAL :: output_for_t0 = .FALSE. 1351 1165 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_mask1359 1360 INTEGER , DIMENSION(1:max_masks,0:1,100) :: id_var_domask1166 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 1361 1175 1362 1176 SAVE … … 1374 1188 !------------------------------------------------------------------------------! 1375 1189 1376 USE precision_kind1190 USE kinds 1377 1191 1378 1192 CHARACTER (LEN=15) :: bc_par_lr = 'cyclic', bc_par_ns = 'cyclic', & … … 1380 1194 collision_kernel = 'none' 1381 1195 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 1407 1219 1408 1220 LOGICAL :: hall_kernel = .FALSE., palm_kernel = .FALSE., & … … 1418 1230 LOGICAL, DIMENSION(:), ALLOCATABLE :: particle_mask, tail_mask 1419 1231 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_global1430 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.91436 1437 REAL , DIMENSION(:), ALLOCATABLE :: log_z_z01438 1439 REAL , DIMENSION(:,:,:), ALLOCATABLE :: particle_tail_coordinates1232 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 1440 1252 1441 1253 1442 1254 TYPE particle_type 1443 1255 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, z1447 INTEGER :: class, group, tailpoints, tail_id1256 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 1448 1260 END TYPE particle_type 1449 1261 … … 1454 1266 TYPE particle_groups_type 1455 1267 SEQUENCE 1456 REAL :: density_ratio, radius, exp_arg, exp_term1268 REAL(wp) :: density_ratio, radius, exp_arg, exp_term 1457 1269 END TYPE particle_groups_type 1458 1270 … … 1477 1289 ! MPI-calls. 1478 1290 !------------------------------------------------------------------------------! 1291 1292 USE kinds 1479 1293 1480 1294 #if defined( __parallel ) && ! defined ( __check ) … … 1487 1301 CHARACTER(LEN=2) :: send_receive = 'al' 1488 1302 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_int1500 1501 INTEGER :: pdims(2) = 1, req(100)1502 1503 INTEGER , DIMENSION(:,:), ALLOCATABLE :: hor_index_bounds, &1504 hor_index_bounds_previous_run1303 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 1505 1319 1506 1320 LOGICAL :: background_communication =.FALSE., collective_wait = .FALSE., & … … 1512 1326 #endif 1513 1327 1514 INTEGER :: ibuf(12), pcoord(2)1328 INTEGER(iwp) :: ibuf(12), pcoord(2) 1515 1329 1516 1330 #if ! defined ( __check ) 1517 INTEGER :: status(MPI_STATUS_SIZE)1518 INTEGER , DIMENSION(MPI_STATUS_SIZE,100) :: wait_stat1331 INTEGER(iwp) :: status(MPI_STATUS_SIZE) 1332 INTEGER(iwp), DIMENSION(MPI_STATUS_SIZE,100) :: wait_stat 1519 1333 #endif 1520 1334 1521 1335 1522 INTEGER , DIMENSION(:), ALLOCATABLE :: ngp_yz, type_xz, type_yz1336 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ngp_yz, type_xz, type_yz 1523 1337 1524 1338 LOGICAL :: left_border_pe = .FALSE., north_border_pe = .FALSE., & … … 1545 1359 !------------------------------------------------------------------------------! 1546 1360 1547 INTEGER, PARAMETER :: crmax = 100 1361 USE kinds 1362 1363 INTEGER(iwp), PARAMETER :: crmax = 100 1548 1364 1549 1365 CHARACTER (LEN=20), DIMENSION(20) :: cross_ts_profiles = & … … 1565 1381 ( ' ', i9 = 1, 94 ) /) 1566 1382 1567 INTEGER :: profile_columns = 2, profile_rows = 3, profile_number = 01568 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) = 01383 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 1573 1389 1574 1390 1575 REAL :: cross_ts_uymax(20) = &1391 REAL(wp) :: cross_ts_uymax(20) = & 1576 1392 (/ 999.999, 999.999, 999.999, 999.999, 999.999, & 1577 1393 999.999, 999.999, 999.999, 999.999, 999.999, & 1578 1394 999.999, 999.999, 999.999, 999.999, 999.999, & 1579 1395 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) = & 1582 1398 (/ 999.999, 999.999, 999.999, -5.000, 999.999, & 1583 1399 999.999, 0.000, 999.999, 999.999, 999.999, & 1584 1400 999.999, 999.999, 999.999, 999.999, 999.999, & 1585 1401 999.999, 999.999, 999.999, 999.999, 999.999 /),& 1586 cross_ts_uymin_computed(20) = 999.9991402 cross_ts_uymin_computed(20) = 999.999 1587 1403 1588 1404 SAVE … … 1600 1416 ! Definition of quantities used for computing spectra 1601 1417 !------------------------------------------------------------------------------! 1418 1419 USE kinds 1602 1420 1603 1421 CHARACTER (LEN=6), DIMENSION(1:5) :: header_char = (/ 'PS(u) ', 'PS(v) ',& … … 1618 1436 'k ^2236 ^2566^2569<q(k) in m>2s>->2 ' /) 1619 1437 1620 INTEGER :: klist_x = 0, klist_y = 0, n_sp_x = 0, n_sp_y = 01621 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) = 9999991634 1635 REAL :: time_to_start_sp = 0.01438 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 1636 1454 1637 1455 SAVE … … 1650 1468 !------------------------------------------------------------------------------! 1651 1469 1470 USE kinds 1471 1652 1472 CHARACTER (LEN=40) :: region(0:9) 1653 INTEGER :: pr_palm = 90, statistic_regions = 01654 INTEGER :: u_max_ijk(3) = -1, v_max_ijk(3) = -1, w_max_ijk(3) = -11473 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 1655 1475 LOGICAL :: flow_statistics_called = .FALSE. 1656 REAL :: u_max, v_max, w_max1657 REAL , DIMENSION(:), ALLOCATABLE :: sums_divnew_l, sums_divold_l, &1658 weight_substep, weight_pres1659 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_l1476 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 1668 1488 1669 REAL , DIMENSION(:,:,:), ALLOCATABLE :: hom_sum, rmask, spectrum_x, &1670 spectrum_y, sums_l, sums_l_l, &1671 sums_up_fraction_l1672 REAL , DIMENSION(:,:,:,:), ALLOCATABLE :: hom1489 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 1673 1493 1674 1494 SAVE … … 1687 1507 !------------------------------------------------------------------------------! 1688 1508 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 1691 1513 1692 1514 -
palm/trunk/SOURCE/netcdf.f90
r1310 r1320 23 23 ! Current revisions: 24 24 ! ------------------ 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 26 31 ! 27 32 ! Former revisions: … … 70 75 ! cross_profiles, profile_rows, profile_columns are written to netCDF header 71 76 ! 72 ! 771 2011-10-27 10:56:21Z heinze73 ! +lpt74 !75 ! 600 2010-11-24 16:10:51Z raasch76 ! bugfix concerning check of cross-section levels on netcdf-files to be77 ! extended (xz,yz)78 !79 ! 564 2010-09-30 13:18:59Z helmke80 ! nc_precision changed from 40 masks to 1 mask, start number of mask output81 ! files changed to 201, netcdf message identifiers of masked output changed82 !83 ! 519 2010-03-19 05:30:02Z raasch84 ! 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_varname87 ! removed88 !89 ! 493 2010-03-01 08:30:24Z raasch90 ! Extensions for netCDF4 output91 !92 ! 410 2009-12-04 17:05:40Z letzel93 ! masked data output94 !95 ! 359 2009-08-19 16:56:44Z letzel96 ! for extended netCDF files, the updated title attribute includes an update of97 ! time_average_text where appropriate.98 ! Bugfix for extended netCDF files: In order to avoid 'data mode' errors if99 ! updated attributes are larger than their original size, NF90_PUT_ATT is called100 ! in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a101 ! possible performance loss; an alternative strategy would be to ensure equal102 ! attribute size in a job chain.103 ! netCDF unit attribute in timeseries output in case of statistic104 ! 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 raasch110 ! Origin of the xy-coordinate system shifted from the center of the first111 ! grid cell (indices i=0, j=0) to the south-left corner of this cell.112 !113 ! 189 2008-08-13 17:09:26Z letzel114 ! consistently allow 100 spectra levels instead of 10115 ! bug fix in the determination of the number of output heights for spectra,116 ! +user-defined spectra117 !118 ! 97 2007-06-21 08:23:15Z raasch119 ! Grids defined for rho and sa120 !121 ! 48 2007-03-06 12:28:36Z raasch122 ! Output topography height information (zu_s_inner, zw_s_inner) to 2d-xy and 3d123 ! datasets124 !125 ! RCS Log replace by Id keyword, revision history cleaned up126 !127 ! Revision 1.12 2006/09/26 19:35:16 raasch128 ! Bugfix yv coordinates for yz cross sections129 !130 77 ! Revision 1.1 2005/05/18 15:37:16 raasch 131 78 ! Initial revision … … 149 96 #if defined( __netcdf ) 150 97 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 156 120 USE netcdf_control 121 122 USE kinds 123 157 124 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 162 137 163 138 164 139 IMPLICIT NONE 165 140 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 !: 201 201 202 202 ! … … 4969 4969 CHARACTER(LEN=*) :: routine_name 4970 4970 4971 INTEGER :: errno4971 INTEGER(iwp) :: errno 4972 4972 4973 4973 IF ( nc_stat /= NF90_NOERR ) THEN -
palm/trunk/SOURCE/nudging.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 62 68 SUBROUTINE init_nudge 63 69 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 69 82 70 83 IMPLICIT NONE 71 84 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 !: 80 110 81 111 ALLOCATE( ptnudge(nzb:nzt+1,1:ntnudge), qnudge(nzb:nzt+1,1:ntnudge), & … … 103 133 t = t + 1 104 134 hash = "#" 105 ierrn = 1 ! not zero 135 ierrn = 1 ! not zero 106 136 ! 107 137 !-- Search for the next line consisting of "# time", … … 160 190 fac = ( highheight - zu(k) ) / ( highheight - lowheight ) 161 191 162 tnudge(k,t) = fac * lowtnudge + ( 1 - fac ) * hightnudge163 unudge(k,t) = fac * lowunudge + ( 1 - fac ) * highunudge164 vnudge(k,t) = fac * lowvnudge + ( 1 - fac ) * highvnudge165 wnudge(k,t) = fac * lowwnudge + ( 1 - fac ) * highwnudge166 ptnudge(k,t) = fac * lowptnudge + ( 1 - fac ) * highptnudge167 qnudge(k,t) = fac * lowqnudge + ( 1 - fac ) * highqnudge192 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 168 198 ENDDO 169 199 … … 188 218 SUBROUTINE nudge ( time, prog_var ) 189 219 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 197 238 198 239 IMPLICIT NONE 199 240 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 !: 205 252 206 253 … … 309 356 SUBROUTINE nudge_ij( i, j, time, prog_var ) 310 357 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 318 376 319 377 IMPLICIT NONE 320 378 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 !: 326 391 327 392 -
palm/trunk/SOURCE/package_parin.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 36 42 ! replaced by collision_kernel 37 43 ! 38 ! 790 2011-11-29 03:11:20Z raasch39 ! +turbulence_effects_on_collision, wang_collision_kernel in particles_par40 !41 ! 336 2009-06-10 11:19:35Z raasch42 ! +clip_dvrp_*, cluster_size, color_interval, dvrpsize_interval,43 ! groundplate_color, isosurface_color, particle_color, particle_dvrpsize44 ! topography_color, in dvrp_graphics_par,45 ! parameter dvrp_psize moved from particles_par to dvrp_graphics_par46 ! Variables for dvrp-mode pathlines added47 !48 ! 210 2008-11-06 08:54:02Z raasch49 ! Variables for dvrp-mode pathlines added50 !51 ! 116 2007-10-11 02:30:27Z raasch52 ! +dt_sort_particles in package_parin53 !54 ! 60 2007-03-11 11:50:04Z raasch55 ! Particles-package is now part of the default code56 !57 ! RCS Log replace by Id keyword, revision history cleaned up58 !59 ! Revision 1.18 2006/08/04 14:52:23 raasch60 ! +dt_dopts, dt_min_part, end_time_prel, particles_per_point,61 ! use_sgs_for_particles in particles_par62 !63 44 ! Revision 1.1 2000/12/28 13:21:57 raasch 64 45 ! Initial revision … … 71 52 !------------------------------------------------------------------------------! 72 53 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 77 90 78 91 IMPLICIT NONE 79 92 80 CHARACTER (LEN=80) :: zeile93 CHARACTER (LEN=80) :: line !: 81 94 82 95 NAMELIST /dvrp_graphics_par/ clip_dvrp_l, clip_dvrp_n, clip_dvrp_r, & … … 117 130 vertical_particle_advection, & 118 131 write_particle_statistics 132 119 133 NAMELIST /spectra_par/ averaging_interval_sp, comp_spectra_level, & 120 134 data_output_sp, dt_dosp, plot_spectra_level, & … … 125 139 !-- parin), search for the namelist-group of the package and position the 126 140 !-- file at this line. Do the same for each optionally used package. 127 zeile = ' '141 line = ' ' 128 142 129 143 #if defined( __dvrp_graphics ) 130 144 REWIND ( 11 ) 131 zeile = ' '132 DO WHILE ( INDEX( zeile, '&dvrp_graphics_par' ) == 0 )133 READ ( 11, '(A)', END=10 ) zeile145 line = ' ' 146 DO WHILE ( INDEX( line, '&dvrp_graphics_par' ) == 0 ) 147 READ ( 11, '(A)', END=10 ) line 134 148 ENDDO 135 149 BACKSPACE ( 11 ) … … 145 159 !-- Try to find particles package 146 160 REWIND ( 11 ) 147 zeile = ' '148 DO WHILE ( INDEX( zeile, '&particles_par' ) == 0 )149 READ ( 11, '(A)', END=20 ) zeile161 line = ' ' 162 DO WHILE ( INDEX( line, '&particles_par' ) == 0 ) 163 READ ( 11, '(A)', END=20 ) line 150 164 ENDDO 151 165 BACKSPACE ( 11 ) … … 164 178 #if defined( __spectra ) 165 179 REWIND ( 11 ) 166 zeile = ' '167 DO WHILE ( INDEX( zeile, '&spectra_par' ) == 0 )168 READ ( 11, '(A)', END=30 ) zeile180 line = ' ' 181 DO WHILE ( INDEX( line, '&spectra_par' ) == 0 ) 182 READ ( 11, '(A)', END=30 ) line 169 183 ENDDO 170 184 BACKSPACE ( 11 ) -
palm/trunk/SOURCE/palm.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 59 65 ! 849 2012-03-15 10:35:09Z raasch 60 66 ! write_particles renamed lpm_write_restart_file 61 !62 ! 759 2011-09-15 13:58:31Z raasch63 ! Splitting of parallel I/O, cpu measurement for write_3d_binary and opening64 ! of unit 14 moved to here65 !66 ! 495 2010-03-02 00:40:15Z raasch67 ! Particle data for restart runs are only written if write_binary=.T..68 !69 ! 215 2008-11-18 09:54:31Z raasch70 ! Initialization of coupled runs modified for MPI-1 and moved to external71 ! subroutine init_coupling72 !73 ! 197 2008-09-16 15:29:03Z raasch74 ! Workaround for getting information about the coupling mode75 !76 ! 108 2007-08-24 15:10:38Z letzel77 ! Get coupling mode from environment variable, change location of debug output78 !79 ! 75 2007-03-22 09:54:05Z raasch80 ! __vtk directives removed, write_particles is called only in case of particle81 ! advection switched on, open unit 9 for debug output,82 ! setting of palm version moved from modules to here83 !84 ! RCS Log replace by Id keyword, revision history cleaned up85 !86 ! Revision 1.10 2006/08/04 14:53:12 raasch87 ! Distibution of run description header removed, call of header moved behind88 ! init_3d_model89 !90 ! Revision 1.2 2001/01/25 07:15:06 raasch91 ! Program name changed to PALM, module test_variables removed.92 ! Initialization of dvrp logging as well as exit of dvrp moved to new93 ! subroutines init_dvrp_logging and close_dvrp (file init_dvrp.f90)94 67 ! 95 68 ! Revision 1.1 1997/07/24 11:23:35 raasch … … 108 81 109 82 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 121 102 USE pegrid 122 USE spectrum123 USE statistics124 103 125 104 #if defined( __openacc ) … … 131 110 ! 132 111 !-- Local variables 133 CHARACTER (LEN=9) :: time_to_string134 INTEGER :: i112 CHARACTER(LEN=9) :: time_to_string !: 113 INTEGER(iwp) :: i !: 135 114 #if defined( __openacc ) 136 REAL , DIMENSION(100) :: acc_dum115 REAL(wp), DIMENSION(100) :: acc_dum !: 137 116 #endif 138 117 -
palm/trunk/SOURCE/parin.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 107 113 ! New cpp directive "__check" implemented which is used by check_namelist_files 108 114 ! 109 ! 785 2011-11-28 09:47:19Z raasch110 ! +scalar_rayleigh_damping in inipar111 !112 ! 767 2011-10-14 06:39:12Z raasch113 ! +u_profile, v_profile, uv_heights in inipar114 !115 ! 759 2011-09-15 13:58:31Z raasch116 ! +maximum_parallel_io_streams in envpar,117 ! splitting of parallel I/O in blocks of PEs118 !119 ! 683 2011-02-09 14:25:15Z raasch120 ! +synchronous_exchange in d3par121 !122 ! 667 2010-12-23 12:06:00Z suehring/gryschka123 ! Steering parameter dissipation_control added in inipar. (commented out)124 !125 ! 622 2010-12-10 08:08:13Z raasch126 ! +collective_wait in inipar127 !128 ! 600 2010-11-24 16:10:51Z raasch129 ! 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_limit133 !134 ! 580 2010-10-05 13:59:11Z heinze135 ! Renaming of ws_vertical_gradient to subs_vertical_gradient and136 ! ws_vertical_gradient_level to subs_vertical_gradient_level137 !138 ! 553 2010-09-01 14:09:06Z weinreis139 ! parameters for masked output are replaced by arrays140 !141 ! 493 2010-03-01 08:30:24Z raasch142 ! +netcdf_data_format in d3par, -netcdf_64bit, -netcdf_64bit_3d143 !144 ! 449 2010-02-02 11:23:59Z raasch145 ! +wall_humidityflux, wall_scalarflux146 ! +ws_vertical_gradient, ws_vertical_gradient_level147 !148 ! 410 2009-12-04 17:05:40Z letzel149 ! 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_domask151 !152 ! 291 2009-04-16 12:07:26Z raasch153 ! +local_dvrserver_running in envpar154 ! 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 inipar158 ! topography_grid_convention moved from userpar159 !160 ! 197 2008-09-16 15:29:03Z raasch161 ! +cthf,leaf_surface_concentration, scalar_exchange_coefficient162 ! +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 allocated167 !168 ! 138 2007-11-28 10:03:58Z letzel169 ! +canopy_mode, drag_coefficient, lad_surface, lad_vertical_gradient,170 ! lad_vertical_gradient_level, pch_index, plant_canopy,171 ! +allocation of leaf area density field172 !173 ! 108 2007-08-24 15:10:38Z letzel174 ! +e_init, top_momentumflux_u|v in inipar, +dt_coupling in d3par175 !176 ! 95 2007-06-02 16:48:38Z raasch177 ! +bc_sa_t, bottom_salinityflux, ocean, sa_surface, sa_vertical_gradient,178 ! sa_vertical_gradient_level, top_salinityflux in inipar,179 ! sa_init is allocated180 !181 ! 87 2007-05-22 15:46:47Z raasch182 ! Size of hom increased by the maximum number of user-defined profiles,183 ! var_hom renamed pr_palm184 !185 ! 82 2007-04-16 15:40:52Z raasch186 ! +return_addres, return_username in envpar187 !188 ! 75 2007-03-22 09:54:05Z raasch189 ! +dt_max, netcdf_64bit_3d, precipitation_amount_interval in d3par,190 ! +loop_optimization, pt_reference in inipar, -data_output_ts,191 ! moisture renamed humidity192 !193 ! 20 2007-02-26 00:12:32Z raasch194 ! +top_heatflux, use_top_fluxes in inipar195 !196 ! 3 2007-02-13 11:30:58Z raasch197 ! +netcdf_64bit_3d in d3par,198 ! RCS Log replace by Id keyword, revision history cleaned up199 !200 ! Revision 1.57 2007/02/11 13:11:22 raasch201 ! Values of environment variables are now read from file ENVPAR instead of202 ! reading them with a system call, + NAMELIST envpar203 !204 115 ! Revision 1.1 1997/07/24 11:22:50 raasch 205 116 ! Initial revision … … 211 122 !------------------------------------------------------------------------------! 212 123 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 222 219 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 225 227 226 228 IMPLICIT NONE 227 229 228 INTEGER :: i230 INTEGER(iwp) :: i !: 229 231 230 232 -
palm/trunk/SOURCE/plant_canopy_model.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 28 34 ! 1036 2012-10-22 13:43:42Z raasch 29 35 ! code put under GPL (PALM 3.9) 30 !31 ! 257 2009-03-11 15:17:42Z heinze32 ! Output of messages replaced by message handling routine.33 ! Bugfix: remove IF statement in plant_canopy_model_ij34 !35 ! 153 2008-03-19 09:41:30Z steinfeld36 ! heat sources within the forest canopy are added, which represent the37 ! rate of heat input into the air from the forest leaves, evaluation of sinks38 ! and sources for scalar concentration due to canopy elements39 36 ! 40 37 ! 138 2007-11-28 10:03:58Z letzel … … 63 60 SUBROUTINE plant_canopy_model( component ) 64 61 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 69 74 70 75 IMPLICIT NONE 71 76 72 INTEGER :: component, i, j, k 77 INTEGER(iwp) :: component !: 78 INTEGER(iwp) :: i !: 79 INTEGER(iwp) :: j !: 80 INTEGER(iwp) :: k !: 73 81 74 82 ! … … 154 162 DO j = nys, nyn 155 163 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) + & 157 165 ( canopy_heat_flux(k,j,i) - & 158 166 canopy_heat_flux(k-1,j,i) ) / & … … 221 229 SUBROUTINE plant_canopy_model_ij( i, j, component ) 222 230 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 227 243 228 244 IMPLICIT NONE 229 245 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 234 253 SELECT CASE ( component ) 235 254 … … 238 257 CASE ( 1 ) 239 258 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) - & 241 260 cdc(k,j,i) * lad_u(k,j,i) * & 242 261 SQRT( u(k,j,i)**2 + & … … 258 277 CASE ( 2 ) 259 278 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) - & 261 280 cdc(k,j,i) * lad_v(k,j,i) * & 262 281 SQRT( ( ( u(k,j-1,i) + & … … 278 297 CASE ( 3 ) 279 298 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) - & 281 300 cdc(k,j,i) * lad_w(k,j,i) * & 282 301 SQRT( ( ( u(k,j,i) + & … … 299 318 CASE ( 4 ) 300 319 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) + & 302 321 ( canopy_heat_flux(k,j,i) - & 303 322 canopy_heat_flux(k-1,j,i) ) / & … … 328 347 CASE ( 6 ) 329 348 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) - & 331 350 2.0 * cdc(k,j,i) * lad_s(k,j,i) * & 332 351 SQRT( ( ( u(k,j,i) + & -
palm/trunk/SOURCE/poisfft.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 95 101 ! (most of the code is unneeded by check_namelist_files). 96 102 ! 97 ! 763 2011-10-06 09:32:09Z suehring98 ! Comment added concerning the last change.99 !100 ! 761 2011-10-05 17:58:52Z suehring101 ! Bugfix: Avoid divisions by zero in case of using a 'neumann' bc for the102 ! pressure at the top of the model domain.103 !104 ! 696 2011-03-18 07:03:49Z raasch105 ! work_fftx removed from PRIVATE clauses in fftx_tr_xy and tr_yx_fftx106 !107 ! 683 2011-02-09 14:25:15Z raasch108 ! openMP parallelization for 2d-domain-decomposition109 !110 ! 667 2010-12-23 12:06:00Z suehring/gryschka111 ! ddzu replaced by ddzu_pres due to changes in zu(0)112 !113 ! 622 2010-12-10 08:08:13Z raasch114 ! optional barriers included in order to speed up collective operations115 !116 ! 377 2009-09-04 11:09:00Z raasch117 ! __lcmuk changed to __lc to avoid problems with Intel compiler on sgi-ice118 !119 ! 164 2008-05-15 08:46:15Z raasch120 ! Arguments removed from transpose routines121 !122 ! 128 2007-10-26 13:11:14Z raasch123 ! Bugfix: wavenumber calculation for even nx in routines maketri124 !125 ! 85 2007-05-11 09:35:14Z raasch126 ! Bugfix: work_fft*_vec removed from some PRIVATE-declarations127 !128 ! 76 2007-03-29 00:58:32Z raasch129 ! Tridiagonal coefficients adjusted for Neumann boundary conditions both at130 ! the bottom and the top.131 !132 ! RCS Log replace by Id keyword, revision history cleaned up133 !134 ! Revision 1.24 2006/08/04 15:00:24 raasch135 ! Default setting of the thread number tn in case of not using OpenMP136 !137 ! Revision 1.23 2006/02/23 12:48:38 raasch138 ! Additional compiler directive in routine tridia_1dd for preventing loop139 ! exchange on NEC-SX6140 !141 ! Revision 1.20 2004/04/30 12:38:09 raasch142 ! Parts of former poisfft_hybrid moved to this subroutine,143 ! former subroutine changed to a module, renaming of FFT-subroutines and144 ! -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 maketri146 ! is now a 1d-array, variables passed by modules instead of using parameter147 ! lists, enlarged transposition arrays introduced148 !149 103 ! Revision 1.1 1997/07/24 11:24:14 raasch 150 104 ! Initial revision … … 167 121 !------------------------------------------------------------------------------! 168 122 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 173 135 174 136 IMPLICIT NONE … … 200 162 SUBROUTINE poisfft_init 201 163 202 USE arrays_3d, ONLY: ddzu_pres, ddzw 164 USE arrays_3d, & 165 ONLY: ddzu_pres, ddzw 166 167 USE kinds 203 168 204 169 IMPLICIT NONE 205 170 206 INTEGER :: k171 INTEGER(iwp) :: k !: 207 172 208 173 … … 219 184 SUBROUTINE poisfft( ar ) 220 185 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 223 194 USE pegrid 224 195 225 196 IMPLICIT NONE 226 197 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 !: 232 219 !$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 !: 237 227 238 228 … … 723 713 !------------------------------------------------------------------------------! 724 714 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 728 723 USE pegrid 729 USE transpose_indices730 724 731 725 IMPLICIT NONE 732 726 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 !: 737 737 #if defined( __nec ) 738 REAL , DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec738 REAL(wp), DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec !: 739 739 #endif 740 REAL , DIMENSION(1:nz,0:ny,nxl:nxr) :: f_in741 REAL , DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_out742 REAL , DIMENSION(nxl:nxr,1:nz,0:ny) :: work740 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 !: 743 743 744 744 ! … … 840 840 !------------------------------------------------------------------------------! 841 841 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 845 850 USE pegrid 846 USE transpose_indices847 851 848 852 IMPLICIT NONE 849 853 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 !: 854 864 #if defined( __nec ) 855 REAL , DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec865 REAL(wp), DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec !: 856 866 #endif 857 REAL , DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_in858 REAL , DIMENSION(1:nz,0:ny,nxl:nxr) :: f_out859 REAL , DIMENSION(nxl:nxr,1:nz,0:ny) :: work867 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 !: 860 870 861 871 ! … … 960 970 !------------------------------------------------------------------------------! 961 971 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 966 983 USE pegrid 967 USE transpose_indices968 984 969 985 IMPLICIT NONE 970 986 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 !: 977 999 978 1000 … … 1091 1113 !------------------------------------------------------------------------------! 1092 1114 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 1096 1123 USE pegrid 1097 USE transpose_indices1098 1124 1099 1125 IMPLICIT NONE 1100 1126 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 !: 1107 1135 1108 1136 ! … … 1196 1224 !------------------------------------------------------------------------------! 1197 1225 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 1201 1234 USE pegrid 1202 USE transpose_indices1203 1235 1204 1236 IMPLICIT NONE 1205 1237 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 !: 1212 1246 1213 1247 ! … … 1301 1335 !------------------------------------------------------------------------------! 1302 1336 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 1307 1348 USE pegrid 1308 USE transpose_indices1309 1349 1310 1350 IMPLICIT NONE 1311 1351 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 !: 1318 1364 1319 1365 -
palm/trunk/SOURCE/poismg.f90
r1319 r1320 23 23 ! Current revisions: 24 24 ! ----------------- 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 26 32 ! 27 33 ! Former revisions: … … 108 114 !------------------------------------------------------------------------------! 109 115 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 115 133 USE pegrid 116 134 117 135 IMPLICIT NONE 118 136 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 !: 124 144 125 145 … … 220 240 !------------------------------------------------------------------------------! 221 241 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 227 260 228 261 IMPLICIT NONE 229 262 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, & 233 269 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 !: 235 277 236 278 ! … … 336 378 !------------------------------------------------------------------------------! 337 379 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 342 392 343 393 IMPLICIT NONE 344 394 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 !: 358 428 359 429 ! … … 516 586 !------------------------------------------------------------------------------! 517 587 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 521 597 522 598 IMPLICIT NONE 523 599 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 !: 533 612 534 613 … … 613 692 !------------------------------------------------------------------------------! 614 693 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 621 715 622 716 IMPLICIT NONE 623 717 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 !: 633 743 634 744 l = grid_level … … 664 774 DO n = 1, ngsrb 665 775 666 DO colo ur = 1, 2776 DO color = 1, 2 667 777 668 778 IF ( .NOT. unroll ) THEN … … 673 783 !-- Without unrolling of loops, no cache optimization 674 784 DO i = nxl_mg(l), nxr_mg(l), 2 675 DO j = nys_mg(l) + 2 - colo ur, nyn_mg(l), 2785 DO j = nys_mg(l) + 2 - color, nyn_mg(l), 2 676 786 DO k = nzb+1, nzt_mg(l), 2 677 787 ! p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( & … … 703 813 704 814 DO i = nxl_mg(l)+1, nxr_mg(l), 2 705 DO j = nys_mg(l) + (colo ur-1), nyn_mg(l), 2815 DO j = nys_mg(l) + (color-1), nyn_mg(l), 2 706 816 DO k = nzb+1, nzt_mg(l), 2 707 817 p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( & … … 726 836 727 837 DO i = nxl_mg(l), nxr_mg(l), 2 728 DO j = nys_mg(l) + (colo ur-1), nyn_mg(l), 2838 DO j = nys_mg(l) + (color-1), nyn_mg(l), 2 729 839 DO k = nzb+2, nzt_mg(l), 2 730 840 p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( & … … 749 859 750 860 DO i = nxl_mg(l)+1, nxr_mg(l), 2 751 DO j = nys_mg(l) + 2 - colo ur, nyn_mg(l), 2861 DO j = nys_mg(l) + 2 - color, nyn_mg(l), 2 752 862 DO k = nzb+2, nzt_mg(l), 2 753 863 p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( & … … 780 890 DO jc = nys_mg(l), nyn_mg(l), 4 781 891 i = ic 782 jj = jc+2-colo ur892 jj = jc+2-color 783 893 DO k = nzb+1, nzt_mg(l), 2 784 894 j = jj … … 819 929 820 930 i = ic+1 821 jj = jc+colo ur-1931 jj = jc+color-1 822 932 DO k = nzb+1, nzt_mg(l), 2 823 933 j =jj … … 858 968 859 969 i = ic 860 jj = jc+colo ur-1970 jj = jc+color-1 861 971 DO k = nzb+2, nzt_mg(l), 2 862 972 j =jj … … 897 1007 898 1008 i = ic+1 899 jj = jc+2-colo ur1009 jj = jc+2-color 900 1010 DO k = nzb+2, nzt_mg(l), 2 901 1011 j =jj … … 1027 1137 SUBROUTINE mg_gather( f2, f2_sub ) 1028 1138 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 1032 1150 USE pegrid 1033 1151 1034 1152 IMPLICIT NONE 1035 1153 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 !: 1045 1173 1046 1174 … … 1091 1219 !-- non-blocking communication 1092 1220 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 1096 1232 USE pegrid 1097 1233 1098 1234 IMPLICIT NONE 1099 1235 1100 INTEGER :: nwords1101 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) :: p21105 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_sub1236 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 !: 1109 1245 1110 1246 ! … … 1138 1274 !------------------------------------------------------------------------------! 1139 1275 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 1144 1290 USE pegrid 1145 1291 1146 1292 IMPLICIT NONE 1147 1293 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 !: 1160 1325 1161 1326 ! -
palm/trunk/SOURCE/prandtl_fluxes.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 40 46 ! 978 2012-08-09 08:28:32Z fricke 41 47 ! roughness length for scalar quantities z0h added 42 !43 ! 759 2011-09-15 13:58:31Z raasch44 ! Bugfix for ts limitation45 !46 ! 709 2011-03-30 09:31:40Z raasch47 ! formatting adjustments48 !49 ! 667 2010-12-23 12:06:00Z suehring/gryschka50 ! 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, nyng53 !54 ! 315 2009-05-13 10:57:59Z raasch55 ! Saturation condition at (sea) surface is not used in precursor runs (only56 ! 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 letzel60 ! Bugfix: modification of the calculation of the vertical turbulent momentum61 ! fluxes u'w' and v'w'62 ! Bugfix: change definition of us_wall from 1D to 2D63 ! Change: modification of the integrated version of the profile function for64 ! momentum for unstable stratification (does not effect results)65 !66 ! 108 2007-08-24 15:10:38Z letzel67 ! assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean68 !69 ! 75 2007-03-22 09:54:05Z raasch70 ! moisture renamed humidity71 !72 ! RCS Log replace by Id keyword, revision history cleaned up73 !74 ! Revision 1.19 2006/04/26 12:24:35 raasch75 ! +OpenMP directives and optimization (array assignments replaced by DO loops)76 48 ! 77 49 ! Revision 1.1 1998/01/23 10:06:06 raasch … … 85 57 !------------------------------------------------------------------------------! 86 58 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 91 74 92 75 IMPLICIT NONE 93 76 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 !: 97 89 98 90 ! -
palm/trunk/SOURCE/pres.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 61 67 ! 1003 2012-09-14 14:35:53Z raasch 62 68 ! adjustment of array tend for cases with unequal subdomain sizes removed 63 !64 ! 778 2011-11-07 14:18:25Z fricke65 ! New allocation of tend when multigrid is used and the collected field on PE066 ! has more grid points than the subdomain of an PE.67 !68 ! 719 2011-04-06 13:05:23Z gryschka69 ! Bugfix in volume flow control for double cyclic boundary conditions70 !71 ! 709 2011-03-30 09:31:40Z raasch72 ! formatting adjustments73 !74 ! 707 2011-03-29 11:39:40Z raasch75 ! Calculation of weighted average of p is now handled in the same way76 ! regardless of the number of ghost layers (advection scheme),77 ! multigrid and sor method are using p_loc for iterative advancements of78 ! pressure,79 ! localsum calculation modified for proper OpenMP reduction,80 ! bc_lr/ns replaced by bc_lr/ns_cyc81 !82 ! 693 2011-03-08 09:..:..Z raasch83 ! bugfix: weighting coefficient added to ibm branch84 !85 ! 680 2011-02-04 23:16:06Z gryschka86 ! bugfix: collective_wait87 !88 ! 675 2011-01-19 10:56:55Z suehring89 ! Removed bugfix while copying tend.90 !91 ! 673 2011-01-18 16:19:48Z suehring92 ! Weighting coefficients added for right computation of the pressure during93 ! Runge-Kutta substeps.94 !95 ! 667 2010-12-23 12:06:00Z suehring/gryschka96 ! New allocation of tend when ws-scheme and multigrid is used. This is due to97 ! reasons of perforance of the data_exchange. The same is done with p after98 ! poismg is called.99 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng when no100 ! multigrid is used. Calls of exchange_horiz are modified.101 ! bugfix: After pressure correction no volume flow correction in case of102 ! non-cyclic boundary conditions103 ! (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 raasch107 ! optional barriers included in order to speed up collective operations108 !109 ! 151 2008-03-07 13:42:18Z raasch110 ! Bugfix in volume flow control for non-cyclic boundary conditions111 !112 ! 106 2007-08-16 14:30:26Z raasch113 ! Volume flow conservation added for the remaining three outflow boundaries114 !115 ! 85 2007-05-11 09:35:14Z raasch116 ! Division through dt_3d replaced by multiplication of the inverse.117 ! For performance optimisation, this is done in the loop calculating the118 ! divergence instead of using a seperate loop.119 !120 ! 75 2007-03-22 09:54:05Z raasch121 ! Volume flow control for non-cyclic boundary conditions added (currently only122 ! for the north boundary!!), 2nd+3rd argument removed from exchange horiz,123 ! mean vertical velocity is removed in case of Neumann boundary conditions124 ! both at the bottom and the top125 !126 ! RCS Log replace by Id keyword, revision history cleaned up127 !128 ! Revision 1.25 2006/04/26 13:26:12 raasch129 ! OpenMP optimization (+localsum, threadsum)130 69 ! 131 70 ! Revision 1.1 1997/07/24 11:24:44 raasch … … 140 79 !------------------------------------------------------------------------------! 141 80 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 148 105 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 151 113 152 114 IMPLICIT NONE 153 115 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 !: 160 129 161 130 -
palm/trunk/SOURCE/print_1d.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 35 41 ! RCS Log replace by Id keyword, revision history cleaned up 36 42 ! 37 ! Revision 1.11 2006/02/23 12:50:43 raasch38 ! Preliminary no output of time-averaged data39 !40 43 ! Revision 1.1 1997/09/19 07:45:22 raasch 41 44 ! Initial revision … … 47 50 !------------------------------------------------------------------------------! 48 51 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 53 66 USE pegrid 54 USE statistics 67 68 USE statistics, & 69 ONLY: flow_statistics_called, hom, region, statistic_regions 55 70 56 71 IMPLICIT NONE 57 72 58 73 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 !: 61 78 62 79 -
palm/trunk/SOURCE/production_e.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 50 56 ! TKE production by buoyancy can be switched off in case of runs with pure 51 57 ! neutral stratification 52 !53 ! 759 2011-09-15 13:58:31Z raasch54 ! initialization of u_0, v_055 !56 ! 667 2010-12-23 12:06:00Z suehring/gryschka57 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng58 !59 ! 449 2010-02-02 11:23:59Z raasch60 ! test output from rev 410 removed61 !62 ! 388 2009-09-23 09:40:33Z raasch63 ! Bugfix: wrong sign in buoyancy production of ocean part in case of not using64 ! the reference density (only in 3D routine production_e)65 ! Bugfix to avoid zero division by km_neutral66 !67 ! 208 2008-10-20 06:02:59Z raasch68 ! Bugfix concerning the calculation of velocity gradients at vertical walls69 ! in case of diabatic conditions70 !71 ! 187 2008-08-06 16:25:09Z letzel72 ! Change: add 'minus' sign to fluxes obtained from subroutine wall_fluxes_e for73 ! consistency with subroutine wall_fluxes74 !75 ! 124 2007-10-19 15:47:46Z raasch76 ! Bugfix: calculation of density flux in the ocean now starts from nzb+177 !78 ! 108 2007-08-24 15:10:38Z letzel79 ! Bugfix: wrong sign removed from the buoyancy production term in the case80 ! use_reference = .T.,81 ! u_0 and v_0 are calculated for nxr+1, nyn+1 also (otherwise these values are82 ! not available in case of non-cyclic boundary conditions)83 ! Bugfix for ocean density flux at bottom84 !85 ! 97 2007-06-21 08:23:15Z raasch86 ! Energy production by density flux (in ocean) added87 ! use_pt_reference renamed use_reference88 !89 ! 75 2007-03-22 09:54:05Z raasch90 ! 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 humidity93 !94 ! 37 2007-03-01 08:33:54Z raasch95 ! Calculation extended for gridpoint nzt, extended for given temperature /96 ! humidity fluxes at the top, wall-part is now executed in case that a97 ! Prandtl-layer is switched on (instead of surfaces fluxes switched on)98 !99 ! RCS Log replace by Id keyword, revision history cleaned up100 !101 ! Revision 1.21 2006/04/26 12:45:35 raasch102 ! OpenMP parallelization of production_e_init103 58 ! 104 59 ! Revision 1.1 1997/09/19 07:45:35 raasch … … 113 68 !------------------------------------------------------------------------------! 114 69 115 USE wall_fluxes_mod 70 USE wall_fluxes_mod, & 71 ONLY: wall_fluxes_e, wall_fluxes_e_acc 72 73 USE kinds 116 74 117 75 PRIVATE 118 76 PUBLIC production_e, production_e_acc, production_e_init 119 77 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 !: 123 82 124 83 INTERFACE production_e … … 143 102 SUBROUTINE production_e 144 103 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 151 123 152 124 IMPLICIT NONE 153 125 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 !: 161 151 162 152 ! … … 166 156 !-- Therefore, ij-Version is called further below within the ij-loops. 167 157 ! 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 ) 172 162 ! ENDIF 173 163 … … 240 230 !-- has been available 241 231 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 ) 243 233 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 ) 245 235 km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * & 246 236 0.5 * dy … … 270 260 !-- has been available 271 261 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 ) 273 263 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 ) 275 265 km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * & 276 266 0.5 * dx … … 716 706 SUBROUTINE production_e_acc 717 707 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 724 728 725 729 IMPLICIT NONE 726 730 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 !: 733 755 !$acc declare create ( usvs, vsus, wsus, wsvs ) 734 756 … … 739 761 !-- ij-version should be called further below within the ij-loops!! 740 762 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 ) 745 767 ENDIF 746 768 … … 823 845 !-- has been available 824 846 ! 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 ) 826 848 ! 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 ) 828 850 km_neutral = kappa * & 829 851 ( usvs(k,j,i)**2 + wsvs(k,j,i)**2 )**0.25 * & … … 854 876 !-- has been available 855 877 ! 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 ) 857 879 ! 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 ) 859 881 km_neutral = kappa * & 860 882 ( vsus(k,j,i)**2 + wsus(k,j,i)**2 )**0.25 * & … … 1350 1372 SUBROUTINE production_e_ij( i, j ) 1351 1373 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 1358 1393 1359 1394 IMPLICIT NONE 1360 1395 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 !: 1367 1420 1368 1421 ! … … 1427 1480 !-- validation has been available 1428 1481 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 ) 1430 1483 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 ) 1432 1485 km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * & 1433 1486 0.5 * dy … … 1457 1510 !-- validation has been available 1458 1511 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 ) 1460 1513 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 ) 1462 1515 km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * & 1463 1516 0.5 * dx … … 1840 1893 SUBROUTINE production_e_init 1841 1894 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 1846 1904 1847 1905 IMPLICIT NONE 1848 1906 1849 INTEGER :: i, j, ku, kv 1907 INTEGER(iwp) :: i !: 1908 INTEGER(iwp) :: j !: 1909 INTEGER(iwp) :: ku !: 1910 INTEGER(iwp) :: kv !: 1850 1911 1851 1912 IF ( prandtl_layer ) THEN -
palm/trunk/SOURCE/prognostic_equations.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 87 93 ! temperature equation can be switched off 88 94 ! 89 ! 785 2011-11-28 09:47:19Z raasch90 ! new factor rdf_sc allows separate Rayleigh damping of scalars91 !92 ! 736 2011-08-17 14:13:26Z suehring93 ! Bugfix: determination of first thread index i for WS-scheme94 !95 ! 709 2011-03-30 09:31:40Z raasch96 ! formatting adjustments97 !98 ! 673 2011-01-18 16:19:48Z suehring99 ! Consideration of the pressure gradient (steered by tsc(4)) during the time100 ! integration removed.101 !102 ! 667 2010-12-23 12:06:00Z suehring/gryschka103 ! Calls of the advection routines with WS5 added.104 ! Calls of ws_statistics added to set the statistical arrays to zero after each105 ! time step.106 !107 ! 531 2010-04-21 06:47:21Z heinze108 ! add call of subsidence in the equation for humidity / passive scalar109 !110 ! 411 2009-12-11 14:15:58Z heinze111 ! add call of subsidence in the equation for potential temperature112 !113 ! 388 2009-09-23 09:40:33Z raasch114 ! prho is used instead of rho in diffusion_e,115 ! external pressure gradient116 !117 ! 153 2008-03-19 09:41:30Z steinfeld118 ! add call of plant_canopy_model in the prognostic equation for119 ! the potential temperature and for the passive scalar120 !121 ! 138 2007-11-28 10:03:58Z letzel122 ! add call of subroutines that evaluate the canopy drag terms,123 ! add wall_*flux to parameter list of calls of diffusion_s124 !125 ! 106 2007-08-16 14:30:26Z raasch126 ! +uswst, vswst as arguments in calls of diffusion_u|v,127 ! loops for u and v are starting from index nxlu, nysv, respectively (needed128 ! for non-cyclic boundary conditions)129 !130 ! 97 2007-06-21 08:23:15Z raasch131 ! prognostic equation for salinity, density is calculated from equation of132 ! state for seawater and is used for calculation of buoyancy,133 ! +eqn_state_seawater_mod134 ! 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_reference136 ! in calls of buoyancy and diffusion_e, calc_mean_pt_profile renamed137 ! calc_mean_profile138 !139 ! 75 2007-03-22 09:54:05Z raasch140 ! 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 the144 ! _vector-version145 !146 ! 19 2007-02-23 04:53:48Z raasch147 ! Calculation of e, q, and pt extended for gridpoint nzt,148 ! handling of given temperature/humidity/scalar fluxes at top surface149 !150 ! RCS Log replace by Id keyword, revision history cleaned up151 !152 ! Revision 1.21 2006/08/04 15:01:07 raasch153 ! 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_e156 !157 95 ! Revision 1.1 2000/04/13 14:56:27 schroeter 158 96 ! Initial revision … … 164 102 !------------------------------------------------------------------------------! 165 103 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 200 218 201 219 … … 235 253 IMPLICIT NONE 236 254 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 !: 239 263 240 264 … … 835 859 IMPLICIT NONE 836 860 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 !: 839 866 840 867 … … 1479 1506 IMPLICIT NONE 1480 1507 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 !: 1483 1514 1484 1515 ! -
palm/trunk/SOURCE/random_function.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 34 40 ! RCS Log replace by Id keyword, revision history cleaned up 35 41 ! 36 ! Revision 1.3 2003/10/29 09:06:57 raasch37 ! Former function changed to a module.38 !39 42 ! Revision 1.1 1998/02/04 16:09:45 raasch 40 43 ! Initial revision … … 47 50 !------------------------------------------------------------------------------! 48 51 52 USE kinds 53 49 54 IMPLICIT NONE 50 55 … … 53 58 PUBLIC random_function, random_function_ini 54 59 55 INTEGER, PUBLIC, SAVE :: random_iv(32), random_iy 60 INTEGER(iwp), PUBLIC, SAVE :: random_iv(32) !: 61 INTEGER(iwp), PUBLIC, SAVE :: random_iy !: 56 62 57 63 INTERFACE random_function_ini … … 79 85 IMPLICIT NONE 80 86 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 !: 83 102 84 103 PARAMETER ( ia=16807, im=2147483647, am=1.0/im, iq=127773, ir=2836, & 85 104 ntab=32, ndiv=1+(im-1)/ntab, eps=1.2e-7, rnmx=1.0-eps ) 86 87 INTEGER :: j, k88 89 105 90 106 IF ( idum .le. 0 .or. random_iy .eq. 0 ) THEN -
palm/trunk/SOURCE/random_gauss.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 22 29 ! 23 !24 30 ! Former revisions: 25 31 ! ----------------- … … 30 36 ! 31 37 ! RCS Log replace by Id keyword, revision history cleaned up 32 !33 ! Revision 1.4 2006/08/04 15:01:48 raasch34 ! Range of random number is limited by an upper limit (new second parameter)35 38 ! 36 39 ! Revision 1.1 1998/03/25 20:09:47 raasch … … 44 47 !------------------------------------------------------------------------------! 45 48 46 USE random_function_mod 49 USE kinds 50 51 USE random_function_mod, & 52 ONLY: random_function 47 53 48 54 IMPLICIT NONE 49 55 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 !: 52 66 53 67 SAVE iset, gset -
palm/trunk/SOURCE/read_3d_binary.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 46 52 ! +z0h, z0h_av 47 53 ! 48 ! 776 2011-10-31 08:02:51Z heinze49 ! bugfix: increase binary_version due to last commit50 !51 ! 771 2011-10-27 10:56:21Z heinze52 ! +lpt_av53 !54 ! 667 2010-12-23 12:06:00Z suehring/gryschka55 ! +/- 1 replaced with +/- nbgp when swapping and allocating variables.56 ! Bugfix: When using initializing_actions = 'cyclic_fill' in some cases57 ! not the whole model domain was filled with data of the prerun.58 !59 ! 410 2009-12-04 17:05:40Z letzel60 ! format changed in test output from I2 to I461 !62 ! 367 2009-08-25 08:35:52Z maronga63 ! Output of messages replaced by message handling routine.64 ! +shf_av, qsws_av65 !66 ! 220 2008-12-18 07:00:36Z raasch67 ! reading mechanism completely revised (subdomain/total domain size can vary68 ! arbitrarily between current and previous run)69 ! Bugfix: reading of spectrum_x|y from restart files ignored if total numbers70 ! of grid points do not match71 !72 ! 150 2008-02-29 08:19:58Z raasch73 ! Files from which restart data are to be read are determined and subsequently74 ! opened. The total domain on the restart file is allowed to be smaller than75 ! the current total domain. In this case it will be periodically mapped on the76 ! 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 removed81 !82 ! 102 2007-07-27 09:09:17Z raasch83 ! +uswst, uswst_m, vswst, vswst_m84 !85 ! 96 2007-06-04 08:07:41Z raasch86 ! +rho_av, sa, sa_av, saswsb, saswst87 !88 ! 73 2007-03-20 08:33:14Z raasch89 ! +precipitation_amount, precipitation_rate_av, rif_wall, u_m_l, u_m_r, etc.,90 ! z0_av91 !92 ! 19 2007-02-23 04:53:48Z raasch93 ! +qswst, qswst_m, tswst, tswst_m94 !95 ! RCS Log replace by Id keyword, revision history cleaned up96 !97 ! Revision 1.4 2006/08/04 15:02:32 raasch98 ! +iran, iran_part99 !100 54 ! Revision 1.1 2004/04/30 12:47:27 raasch 101 55 ! Initial revision … … 107 61 !------------------------------------------------------------------------------! 108 62 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 110 70 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 116 92 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 120 100 121 101 IMPLICIT NONE 122 102 123 103 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 125 106 CHARACTER (LEN=20) :: field_chr 126 107 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 !: 147 165 148 166 -
palm/trunk/SOURCE/read_var_list.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 95 101 ! +curvature_solution_effects 96 102 ! 97 ! 626 2010-12-10 13:04:12Z suehring98 ! idum replaced by cdum in read_parts_of_var_list99 !100 ! 622 2010-12-10 08:08:13Z raasch101 ! +collective_wait102 !103 ! 600 2010-11-24 16:10:51Z raasch104 ! +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_limit107 ! in routine skip_var_list (end of this file), variable ldum is replaced108 ! 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 now110 ! stored on the restart file111 !112 ! 591 2010-10-28 06:35:52Z helmke113 ! remove print command114 !115 ! 587 2010-10-27 08:36:51Z helmke116 ! +time_domask117 !118 ! 580 2010-10-05 13:59:11Z heinze119 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,120 ! ws_vertical_gradient_level to subs_vertical_gradient_level and121 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i122 !123 ! 411 2009-12-11 14:15:58Z heinze124 ! +large_scale_subsidence, ws_vertical_gradient, ws_vertical_gradient_level,125 ! ws_vertical_gradient_level_ind126 !127 ! 345 2009-07-01 14:37:56Z heinze128 ! +output_for_t0129 ! 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_bulk135 !136 ! 216 2008-11-25 07:12:43Z raasch137 ! limitations for nx_on_file, ny_on_file removed (read_parts_of_var_list)138 !139 ! 173 2008-05-23 20:39:38Z raasch140 ! +cthf, leaf_surface_concentration, scalar_exchange_coefficient141 ! +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 from146 ! read_3d_binary to here,147 ! routines read_parts_of_var_list and skip_var_list added at the end148 !149 ! 138 2007-11-28 10:03:58Z letzel150 ! +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_particles153 !154 ! 102 2007-07-27 09:09:17Z raasch155 ! +time_coupling, top_momentumflux_u|v156 !157 ! 95 2007-06-02 16:48:38Z raasch158 ! +bc_sa_t, ocean, sa_init, sa_surface, sa_vertical_gradient,159 ! sa_vertical_gradient_level, bottom/top_salinity_flux160 !161 ! 87 2007-05-22 15:46:47Z raasch162 ! +max_pr_user (version 3.1), var_hom renamed pr_palm163 !164 ! 75 2007-03-22 09:54:05Z raasch165 ! +loop_optimization, pt_reference, moisture renamed humidity166 !167 ! 20 2007-02-26 00:12:32Z raasch168 ! +top_heatflux, use_top_fluxes169 !170 ! RCS Log replace by Id keyword, revision history cleaned up171 !172 ! Revision 1.34 2006/08/22 14:14:27 raasch173 ! +dz_max174 !175 103 ! Revision 1.1 1998/03/18 20:18:48 raasch 176 104 ! Initial revision … … 182 110 !------------------------------------------------------------------------------! 183 111 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 187 120 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 191 131 USE netcdf_control 192 USE particle_attributes 132 133 USE particle_attributes, & 134 ONLY: time_sort_particles 135 193 136 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 196 141 197 142 IMPLICIT NONE … … 779 724 !------------------------------------------------------------------------------! 780 725 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 782 730 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 784 737 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 786 742 787 743 IMPLICIT NONE … … 791 747 CHARACTER (LEN=1) :: cdum 792 748 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 798 757 799 758 -
palm/trunk/SOURCE/run_control.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 38 44 ! all actions concerning leapfrog scheme removed 39 45 ! 40 ! 97 2007-06-21 08:23:15Z raasch41 ! Timestep and z_i format changed42 !43 ! 87 2007-05-22 15:46:47Z raasch44 ! var_hom renamed pr_palm45 !46 ! 82 2007-04-16 15:40:52Z raasch47 ! Preprocessor strings for different linux clusters changed to "lc",48 ! routine local_flush is used for buffer flushing49 !50 ! RCS Log replace by Id keyword, revision history cleaned up51 !52 ! Revision 1.20 2006/06/02 15:23:47 raasch53 ! cpp-directives extended for lctit54 !55 46 ! Revision 1.1 1997/08/11 06:25:38 raasch 56 47 ! Initial revision … … 62 53 !------------------------------------------------------------------------------! 63 54 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 66 67 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 69 72 70 73 IMPLICIT NONE -
palm/trunk/SOURCE/set_slicer_attributes_dvrp.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 39 45 #if defined( __dvrp_graphics ) 40 46 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 43 52 44 53 IMPLICIT NONE 45 54 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 !: 48 61 49 62 -
palm/trunk/SOURCE/singleton.f90
r484 r1320 4 4 ! Current revisions: 5 5 ! ----------------- 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, 7 9 ! 8 10 ! Former revisions: 9 11 ! ----------------- 10 ! $Id$11 ! RCS Log replace by Id keyword, revision history cleaned up12 !13 ! Revision 1.2 2004/04/30 12:52:09 raasch14 ! Shape of arrays is explicitly stored in ishape and handled to the15 ! fft-routines instead of the shape-function (due to a compiler error on16 ! decalpha)17 !18 12 ! Revision 1.1 2002/05/02 18:56:59 raasch 19 13 ! Initial revision … … 158 152 !----------------------------------------------------------------------------- 159 153 154 USE kinds 155 160 156 IMPLICIT NONE 161 157 162 158 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 171 165 172 166 INTERFACE fft … … 187 181 ! 188 182 !-- Formal parameters 189 COMPLEX( fftkind),DIMENSION(:), INTENT(IN) :: array190 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim191 LOGICAL, INTENT(IN), OPTIONAL:: inv192 INTEGER, INTENT(OUT), OPTIONAL:: stat183 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 193 187 ! 194 188 !-- Function result 195 COMPLEX( fftkind), DIMENSION(SIZE(array, 1)):: ft196 197 INTEGER 189 COMPLEX(wp), DIMENSION(SIZE(array, 1)):: ft 190 191 INTEGER(iwp):: ishape(1) 198 192 199 193 ! … … 211 205 ! 212 206 !-- Formal parameters 213 COMPLEX( fftkind),DIMENSION(:,:), INTENT(IN) :: array214 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim215 LOGICAL, INTENT(IN), OPTIONAL:: inv216 INTEGER, INTENT(OUT), OPTIONAL:: stat207 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 217 211 ! 218 212 !-- Function result 219 COMPLEX( fftkind), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft220 221 INTEGER :: ishape(2)213 COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft 214 215 INTEGER(iwp) :: ishape(2) 222 216 ! 223 217 !-- Intrinsics used … … 234 228 ! 235 229 !-- Formal parameters 236 COMPLEX( fftkind),DIMENSION(:,:,:), INTENT(IN) :: array237 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim238 LOGICAL, INTENT(IN), OPTIONAL:: inv239 INTEGER, INTENT(OUT), OPTIONAL:: stat230 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 240 234 ! 241 235 !-- Function result 242 COMPLEX( fftkind), &236 COMPLEX(wp), & 243 237 DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3)):: ft 244 238 245 INTEGER :: ishape(3)239 INTEGER(iwp) :: ishape(3) 246 240 247 241 ! … … 259 253 ! 260 254 !-- Formal parameters 261 COMPLEX( fftkind),DIMENSION(:,:,:,:), INTENT(IN) :: array262 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim263 LOGICAL, INTENT(IN), OPTIONAL:: inv264 INTEGER, INTENT(OUT), OPTIONAL:: stat255 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 265 259 ! 266 260 !-- Function result 267 COMPLEX( fftkind), DIMENSION( &261 COMPLEX(wp), DIMENSION( & 268 262 SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4)):: ft 269 263 270 INTEGER :: ishape(4)264 INTEGER(iwp) :: ishape(4) 271 265 ! 272 266 !-- Intrinsics used … … 283 277 ! 284 278 !-- Formal parameters 285 COMPLEX( fftkind),DIMENSION(:,:,:,:,:), INTENT(IN) :: array286 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim287 LOGICAL, INTENT(IN), OPTIONAL:: inv288 INTEGER, INTENT(OUT), OPTIONAL:: stat279 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 289 283 ! 290 284 !-- Function result 291 COMPLEX( fftkind), DIMENSION( &285 COMPLEX(wp), DIMENSION( & 292 286 SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), & 293 287 SIZE(array, 5)):: ft 294 288 295 INTEGER :: ishape(5)289 INTEGER(iwp) :: ishape(5) 296 290 297 291 ! … … 309 303 ! 310 304 !-- Formal parameters 311 COMPLEX( fftkind),DIMENSION(:,:,:,:,:,:), INTENT(IN) :: array312 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim313 LOGICAL, INTENT(IN), OPTIONAL:: inv314 INTEGER, INTENT(OUT), OPTIONAL:: stat305 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 315 309 ! 316 310 !-- Function result 317 COMPLEX( fftkind), DIMENSION( &311 COMPLEX(wp), DIMENSION( & 318 312 SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), & 319 313 SIZE(array, 5), SIZE(array, 6)):: ft 320 314 321 INTEGER :: ishape(6)315 INTEGER(iwp) :: ishape(6) 322 316 323 317 ! … … 335 329 ! 336 330 !-- Formal parameters 337 COMPLEX( fftkind), DIMENSION(:,:,:,:,:,:,:), INTENT(IN) :: array338 INTEGER , DIMENSION(:),INTENT(IN), OPTIONAL:: dim339 LOGICAL, INTENT(IN), OPTIONAL:: inv340 INTEGER, INTENT(OUT), OPTIONAL:: stat331 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 341 335 ! 342 336 !-- Function result 343 COMPLEX( fftkind), DIMENSION( &337 COMPLEX(wp), DIMENSION( & 344 338 SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), & 345 339 SIZE(array, 5), SIZE(array, 6), SIZE(array, 7)):: ft 346 340 347 INTEGER :: ishape(7)341 INTEGER(iwp) :: ishape(7) 348 342 349 343 ! … … 361 355 ! 362 356 !-- Formal parameters 363 COMPLEX( fftkind),DIMENSION(*), INTENT(INOUT) :: array364 INTEGER ,DIMENSION(:), INTENT(IN) :: shape365 INTEGER ,DIMENSION(:), INTENT(IN), OPTIONAL:: dim366 LOGICAL, INTENT(IN), OPTIONAL:: inv367 INTEGER, INTENT(OUT), OPTIONAL:: stat357 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 368 362 ! 369 363 !-- Local arrays 370 INTEGER , DIMENSION(SIZE(shape)):: d364 INTEGER(iwp), DIMENSION(SIZE(shape)):: d 371 365 ! 372 366 !-- Local scalars 373 367 LOGICAL :: inverse 374 INTEGER 375 REAL( fftkind):: scale368 INTEGER(iwp) :: i, ndim, ntotal 369 REAL(wp):: scale 376 370 ! 377 371 !-- Intrinsics used … … 394 388 395 389 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)))) 397 391 DO i = 1, ntotal 398 392 array(i) = CMPLX(REAL(array(i)) * scale, AIMAG(array(i)) * scale, & 399 KIND= fftkind)393 KIND=wp) 400 394 END DO 401 395 … … 414 408 ! 415 409 !-- Formal parameters 416 COMPLEX( fftkind),DIMENSION(*), INTENT(INOUT) :: array417 INTEGER ,INTENT(IN) :: ntotal, npass, nspan418 LOGICAL, INTENT(IN) :: inv419 INTEGER, INTENT(OUT), OPTIONAL:: stat410 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 420 414 ! 421 415 !-- Local arrays 422 INTEGER, DIMENSION(BIT_SIZE(0)) :: factor423 COMPLEX(fftkind), DIMENSION(:), ALLOCATABLE :: ctmp424 REAL(fftkind), DIMENSION(:), ALLOCATABLE :: sine, cosine425 INTEGER, DIMENSION(:), ALLOCATABLE :: perm416 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 426 420 ! 427 421 !-- Local scalars 428 INTEGER :: maxfactor, nfactor, nsquare, nperm422 INTEGER(iwp) :: maxfactor, nfactor, nsquare, nperm 429 423 ! 430 424 !-- Intrinsics used … … 476 470 ! 477 471 !-- Formal parameters 478 INTEGER , INTENT(IN) :: npass479 INTEGER , DIMENSION(*), INTENT(OUT):: factor480 INTEGER , INTENT(OUT):: nfactor, nsquare472 INTEGER(iwp), INTENT(IN) :: npass 473 INTEGER(iwp), DIMENSION(*), INTENT(OUT):: factor 474 INTEGER(iwp), INTENT(OUT):: nfactor, nsquare 481 475 ! 482 476 !-- Local scalars 483 INTEGER :: j, jj, k477 INTEGER(iwp):: j, jj, k 484 478 485 479 nfactor = 0 … … 541 535 ! 542 536 !-- Formal parameters 543 COMPLEX( fftkind),DIMENSION(*), INTENT(IN OUT):: array544 INTEGER, INTENT(IN) :: ntotal, npass, nspan545 INTEGER , DIMENSION(*), INTENT(IN) :: factor546 INTEGER , INTENT(IN) :: nfactor547 COMPLEX(fftkind), DIMENSION(*), INTENT(OUT) :: ctmp548 REAL(fftkind), DIMENSION(*), INTENT(OUT) :: sine, cosine549 LOGICAL, INTENT(IN) :: inv537 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 550 544 ! 551 545 !-- Local scalars 552 INTEGER 553 INTEGER 554 INTEGER 555 INTEGER 556 REAL( fftkind):: s60, c72, s72, pi2, radf557 REAL( fftkind):: c1, s1, c2, s2, c3, s3, cd, sd, ak558 COMPLEX( fftkind):: cc, cj, ck, cjp, cjm, ckp, ckm546 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 559 553 560 554 c72 = cos72 … … 574 568 jc = nspan / npass 575 569 radf = pi2 * jc 576 pi2 = pi2 * 2.0_ fftkind!-- use 2 PI from here on570 pi2 = pi2 * 2.0_wp !-- use 2 PI from here on 577 571 578 572 ii = 0 … … 581 575 sd = radf / kspan 582 576 cd = SIN(sd) 583 cd = 2.0_ fftkind* cd * cd577 cd = 2.0_wp * cd * cd 584 578 sd = SIN(sd + sd) 585 579 kk = 1 … … 606 600 IF (kk > kspan) RETURN 607 601 DO 608 c1 = 1.0_ fftkind- cd602 c1 = 1.0_wp - cd 609 603 s1 = sd 610 604 DO … … 614 608 ck = array(kk) - array(k2) 615 609 array(kk) = array(kk) + array(k2) 616 array(k2) = ck * CMPLX(c1, s1, KIND= fftkind)610 array(k2) = ck * CMPLX(c1, s1, KIND=wp) 617 611 kk = k2 + kspan 618 612 IF (kk >= nt) EXIT … … 625 619 ak = c1 - (cd * c1 + sd * s1) 626 620 s1 = sd * c1 - cd * s1 + s1 627 c1 = 2.0_ fftkind- (ak * ak + s1 * s1)621 c1 = 2.0_wp - (ak * ak + s1 * s1) 628 622 s1 = s1 * c1 629 623 c1 = c1 * ak … … 641 635 642 636 DO 643 c1 = 1.0_ fftkind644 s1 = 0.0_ fftkind637 c1 = 1.0_wp 638 s1 = 0.0_wp 645 639 DO 646 640 DO … … 655 649 cjp = ckp - cjp 656 650 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) 659 653 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) 662 656 END IF 663 657 ! 664 658 !-- Avoid useless multiplies 665 IF (s1 == 0.0_ fftkind) THEN659 IF (s1 == 0.0_wp) THEN 666 660 array(k1) = ckp 667 661 array(k2) = cjp 668 662 array(k3) = ckm 669 663 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) 673 667 END IF 674 668 kk = k3 + kspan … … 678 672 c2 = c1 - (cd * c1 + sd * s1) 679 673 s1 = sd * c1 - cd * s1 + s1 680 c1 = 2.0_ fftkind- (c2 * c2 + s1 * s1)674 c1 = 2.0_wp - (c2 * c2 + s1 * s1) 681 675 s1 = s1 * c1 682 676 c1 = c1 * c2 … … 684 678 !-- Values of c2, c3, s2, s3 that will get used next time 685 679 c2 = c1 * c1 - s1 * s1 686 s2 = 2.0_ fftkind* c1 * s1680 s2 = 2.0_wp * c1 * s1 687 681 c3 = c2 * c1 - s2 * s1 688 682 s3 = c2 * s1 + s2 * c1 … … 712 706 array(kk) = ck + cj 713 707 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) 717 711 cj = CMPLX( & 718 712 (REAL (array(k1)) - REAL (array(k2))) * s60, & 719 713 (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) 723 717 kk = k2 + kspan 724 718 IF (kk >= nn) EXIT … … 730 724 CASE (5) !-- transform for factor of 5 (optional code) 731 725 c2 = c72 * c72 - s72 * s72 732 s2 = 2.0_ fftkind* c72 * s72726 s2 = 2.0_wp * c72 * s72 733 727 DO 734 728 DO … … 744 738 array(kk) = cc + ckp + cjp 745 739 ck = CMPLX(REAL(ckp) * c72, AIMAG(ckp) * c72, & 746 KIND= fftkind) + &740 KIND=wp) + & 747 741 CMPLX(REAL(cjp) * c2, AIMAG(cjp) * c2, & 748 KIND= fftkind) + cc742 KIND=wp) + cc 749 743 cj = CMPLX(REAL(ckm) * s72, AIMAG(ckm) * s72, & 750 KIND= fftkind) + &744 KIND=wp) + & 751 745 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) 755 749 ck = CMPLX(REAL(ckp) * c2, AIMAG(ckp) * c2, & 756 KIND= fftkind) + &750 KIND=wp) + & 757 751 CMPLX(REAL(cjp) * c72, AIMAG(cjp) * c72, & 758 KIND= fftkind) + cc752 KIND=wp) + cc 759 753 cj = CMPLX(REAL(ckm) * s2, AIMAG(ckm) * s2, & 760 KIND= fftkind) - &754 KIND=wp) - & 761 755 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) 765 759 kk = k4 + kspan 766 760 IF (kk >= nn) EXIT … … 776 770 c1 = COS(s1) 777 771 s1 = SIN(s1) 778 cosine (jf) = 1.0_ fftkind779 sine (jf) = 0.0_ fftkind772 cosine (jf) = 1.0_wp 773 sine (jf) = 0.0_wp 780 774 j = 1 781 775 DO … … 816 810 jj = j 817 811 ck = cc 818 cj = (0.0_ fftkind, 0.0_fftkind)812 cj = (0.0_wp, 0.0_wp) 819 813 k = 1 820 814 DO … … 822 816 ck = ck + CMPLX( & 823 817 REAL (ctmp(k)) * cosine(jj), & 824 AIMAG(ctmp(k)) * cosine(jj), KIND= fftkind)818 AIMAG(ctmp(k)) * cosine(jj), KIND=wp) 825 819 k = k + 1 826 820 cj = cj + CMPLX( & 827 821 REAL (ctmp(k)) * sine(jj), & 828 AIMAG(ctmp(k)) * sine(jj), KIND= fftkind)822 AIMAG(ctmp(k)) * sine(jj), KIND=wp) 829 823 jj = jj + j 830 824 IF (jj > jf) jj = jj - jf … … 833 827 k = jf - j 834 828 array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), & 835 KIND= fftkind)829 KIND=wp) 836 830 array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), & 837 KIND= fftkind)831 KIND=wp) 838 832 j = j + 1 839 833 IF (j >= k) EXIT … … 852 846 kk = jc + 1 853 847 DO 854 c2 = 1.0_ fftkind- cd848 c2 = 1.0_wp - cd 855 849 s1 = sd 856 850 DO … … 860 854 DO 861 855 DO 862 array(kk) = CMPLX(c2, s2, KIND= fftkind) * array(kk)856 array(kk) = CMPLX(c2, s2, KIND=wp) * array(kk) 863 857 kk = kk + ispan 864 858 IF (kk > nt) EXIT … … 872 866 c2 = c1 - (cd * c1 + sd * s1) 873 867 s1 = s1 + sd * c1 - cd * s1 874 c1 = 2.0_ fftkind- (c2 * c2 + s1 * s1)868 c1 = 2.0_wp - (c2 * c2 + s1 * s1) 875 869 s1 = s1 * c1 876 870 c2 = c2 * c1 … … 892 886 ! 893 887 !-- Formal parameters 894 COMPLEX( fftkind),DIMENSION(*), INTENT(IN OUT):: array895 INTEGER, INTENT(IN) :: ntotal, npass, nspan896 INTEGER , DIMENSION(*), INTENT(IN OUT):: factor897 INTEGER , INTENT(IN) :: nfactor, nsquare898 INTEGER , INTENT(IN) :: maxfactor899 COMPLEX(fftkind), DIMENSION(*), INTENT(OUT) :: ctmp900 INTEGER ,DIMENSION(*), INTENT(OUT) :: perm888 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 901 895 ! 902 896 !-- 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 909 902 ! 910 903 !-- Permute the results to normal order---done in two stages -
palm/trunk/SOURCE/sor.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 28 34 ! 1036 2012-10-22 13:43:42Z raasch 29 35 ! code put under GPL (PALM 3.9) 30 !31 ! 707 2011-03-29 11:39:40Z raasch32 ! bc_lr/ns replaced by bc_lr/ns_cyc33 !34 ! 667 2010-12-23 12:06:00Z suehring/gryschka35 ! 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+138 !39 ! 75 2007-03-22 09:54:05Z raasch40 ! 2nd+3rd argument removed from exchange horiz41 !42 ! RCS Log replace by Id keyword, revision history cleaned up43 !44 ! Revision 1.9 2005/03/26 21:02:23 raasch45 ! Implementation of non-cyclic (Neumann) horizontal boundary conditions,46 ! dx2,dy2 replaced by ddx2,ddy247 36 ! 48 37 ! Revision 1.1 1997/08/11 06:25:56 raasch … … 55 44 !------------------------------------------------------------------------------! 56 45 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 61 58 62 59 IMPLICIT NONE 63 60 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 !: 69 79 70 80 ALLOCATE( f1(1:nz), f2(1:nz), f3(1:nz) ) -
palm/trunk/SOURCE/subsidence.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 22 29 ! 23 30 ! Former revisions: … … 27 34 ! 1036 2012-10-22 13:43:42Z raasch 28 35 ! 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 defined32 !33 ! 667 2010-12-23 12:06:00Z suehring34 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng35 !36 ! 580 2010-10-05 13:59:11Z heinze37 ! Renaming of ws_vertical_gradient to subs_vertical_gradient,38 ! ws_vertical_gradient_level to subs_vertical_gradient_level and39 ! ws_vertical_gradient_level_ind to subs_vertical_gradient_level_i40 36 ! 41 37 ! Revision 3.7 2009-12-11 14:15:58Z heinze … … 68 64 SUBROUTINE init_w_subsidence 69 65 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 76 77 77 78 IMPLICIT NONE 78 79 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 !: 81 85 82 86 IF ( .NOT. ALLOCATED( w_subs )) THEN … … 132 136 SUBROUTINE subsidence( tendency, var, var_init ) 133 137 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 140 149 141 150 IMPLICIT NONE 142 151 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 !: 146 157 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 !: 149 162 150 163 var_mod = var_init … … 208 221 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init ) 209 222 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 216 233 217 234 IMPLICIT NONE 218 235 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 !: 222 241 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 !: 225 246 226 247 var_mod = var_init -
palm/trunk/SOURCE/sum_up_3d_data.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 44 50 ! 978 2012-08-09 08:28:32Z fricke 45 51 ! +z0h* 46 !47 ! 790 2011-11-29 03:11:20Z raasch48 ! bugfix: calculation of 'pr' must depend on the particle weighting factor49 !50 ! 771 2011-10-27 10:56:21Z heinze51 ! +lpt_av52 !53 ! 667 2010-12-23 12:06:00Z suehring/gryschka54 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng55 !56 ! 402 2009-10-21 11:59:41Z maronga57 ! Bugfix in calculation of shf*_av, qsws*_av58 !59 ! 2009-08-25 08:35:52Z maronga60 ! +shf*, qsws*61 !62 ! 96 2007-06-04 08:07:41Z raasch63 ! +sum-up of density and salinity64 !65 ! 72 2007-03-19 08:20:46Z raasch66 ! +sum-up of precipitation rate and roughness length (prr*, z0*)67 !68 ! RCS Log replace by Id keyword, revision history cleaned up69 52 ! 70 53 ! Revision 1.1 2006/02/23 12:55:23 raasch … … 78 61 !------------------------------------------------------------------------------! 79 62 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 87 89 88 90 IMPLICIT NONE 89 91 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 !: 94 102 95 103 CALL cpu_log (log_point(34),'sum_up_3d_data','start') -
palm/trunk/SOURCE/surface_coupler.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 37 43 ! 880 2012-04-13 06:28:59Z raasch 38 44 ! Bugfix: preprocessor statements for parallel execution added 39 !40 ! 709 2011-03-30 09:31:40Z raasch41 ! formatting adjustments42 !43 ! 667 2010-12-23 12:06:00Z suehring/gryschka44 ! Additional case for nonequivalent processor and grid topopolgy in ocean and45 ! atmosphere added (coupling_topology = 1).46 ! Added exchange of u and v from Ocean to Atmosphere47 !48 ! 291 2009-04-16 12:07:26Z raasch49 ! Coupling with independent precursor runs.50 ! Output of messages replaced by message handling routine.51 !52 ! 206 2008-10-13 14:59:11Z raasch53 ! Implementation of a MPI-1 Coupling: replaced myid with target_id,54 ! deleted __mpi2 directives55 45 ! 56 46 ! 109 2007-08-28 15:26:47Z letzel … … 62 52 !------------------------------------------------------------------------------! 63 53 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 69 72 USE pegrid 70 73 71 74 IMPLICIT NONE 72 75 73 REAL :: time_since_reference_point_rem74 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) !: 75 78 76 79 #if defined( __parallel ) … … 418 421 #if defined( __parallel ) 419 422 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 425 434 426 435 IMPLICIT NONE 427 436 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 !: 430 447 431 448 CALL MPI_BARRIER( comm2d, ierr ) … … 490 507 #if defined( __parallel ) 491 508 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 497 520 498 521 IMPLICIT NONE 499 522 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 !: 504 535 505 536 CALL MPI_BARRIER( comm2d, ierr ) -
palm/trunk/SOURCE/swap_timelevel.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! revision history before 2012 removed, 23 24 ! 24 25 ! Former revisions: … … 50 51 ! all actions concerning leapfrog scheme removed 51 52 ! 52 ! 102 2007-07-27 09:09:17Z raasch53 ! swaping of uswst, vswst included54 !55 ! 95 2007-06-02 16:48:38Z raasch56 ! Swaping of salinity57 !58 ! 75 2007-03-22 09:54:05Z raasch59 ! moisture renamed humidity60 !61 ! 19 2007-02-23 04:53:48Z raasch62 ! Swaping of top fluxes63 !64 ! RCS Log replace by Id keyword, revision history cleaned up65 !66 ! Revision 1.8 2004/01/28 15:28:18 raasch67 ! Swaping for Runge-Kutta schemes implemented68 !69 53 ! Revision 1.1 2000/01/10 10:08:58 10:08:58 raasch (Siegfried Raasch) 70 54 ! Initial revision … … 76 60 !------------------------------------------------------------------------------! 77 61 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 81 73 82 74 IMPLICIT NONE -
palm/trunk/SOURCE/temperton_fft.f90
r392 r1320 4 4 ! Current revisions: 5 5 ! ----------------- 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 7 13 ! 8 14 ! Former revisions: 9 15 ! ----------------- 10 16 ! $Id$ 11 !12 ! 258 2009-03-13 12:36:03Z heinze13 ! Output of messages replaced by message handling routine.14 !15 ! Feb. 200716 ! RCS Log replace by Id keyword, revision history cleaned up17 !18 ! Revision 1.2 2003/04/16 12:49:25 raasch19 ! Abort in case of illegal factors20 17 ! 21 18 ! Revision 1.1 2003/03/12 16:41:59 raasch … … 28 25 !------------------------------------------------------------------------------! 29 26 27 USE kinds 28 30 29 IMPLICIT NONE 31 30 … … 35 34 36 35 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*. 39 38 40 39 ! 41 40 !-- nfft: maximum length of calls to *fft. 42 41 #if defined( __nec ) 43 INTEGER , PARAMETER :: nfft = 25642 INTEGER(iwp), PARAMETER :: nfft = 256 !: 44 43 #else 45 INTEGER , PARAMETER :: nfft = 3244 INTEGER(iwp), PARAMETER :: nfft = 32 !: 46 45 #endif 47 46 48 INTEGER , PARAMETER :: nout = 6 !standard output stream47 INTEGER(iwp), PARAMETER :: nout = 6 !: standard output stream 49 48 50 49 CONTAINS … … 99 98 ! dimension a(n),work(n),trigs(n),ifax(1) 100 99 100 USE kinds 101 101 102 102 IMPLICIT NONE 103 103 104 104 ! 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 !: 106 110 107 111 ! 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(*) !: 110 116 111 117 ! 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 !: 114 138 115 139 ! Intrinsic functions 116 INTRINSIC MOD140 ! INTRINSIC MOD 117 141 118 142 … … 316 340 ! 317 341 318 IMPLICIT NONE 342 USE kinds 343 344 IMPLICIT NONE 319 345 320 346 ! 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 !: 322 356 323 357 ! Array arguments 324 358 ! 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 327 365 ! 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 !: 335 443 336 444 ! Intrinsic functions 337 INTRINSIC REAL, SQRT445 ! INTRINSIC REAL, SQRT 338 446 339 447 ! 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/ 342 450 343 451 … … 438 546 GO TO 170 439 547 30 CONTINUE 440 z = 1.0 /REAL(n)548 z = 1.0_wp/REAL(n) 441 549 DO l = 1, la 442 550 i = ibase … … 551 659 GO TO 170 552 660 60 CONTINUE 553 z = 1.0 /REAL(n)661 z = 1.0_wp/REAL(n) 554 662 zsin60 = z*sin60 555 663 DO l = 1, la … … 658 766 IF (jb>jc) GO TO 170 659 767 80 CONTINUE 660 sin45 = SQRT(0.5 )768 sin45 = SQRT(0.5_wp) 661 769 jbase = 0 662 770 DO l = 1, la … … 680 788 GO TO 170 681 789 90 CONTINUE 682 z = 1.0 /REAL(n)790 z = 1.0_wp/REAL(n) 683 791 DO l = 1, la 684 792 i = ibase … … 843 951 GO TO 170 844 952 120 CONTINUE 845 z = 1.0 /REAL(n)953 z = 1.0_wp/REAL(n) 846 954 zqrt5 = z*qrt5 847 955 zsin36 = z*sin36 … … 1019 1127 GO TO 170 1020 1128 150 CONTINUE 1021 z = 1.0 /REAL(n)1129 z = 1.0_wp/REAL(n) 1022 1130 zsin60 = z*sin60 1023 1131 DO l = 1, la … … 1062 1170 jd = jc + 2*m*inc2 1063 1171 je = jd + 2*m*inc2 1064 z = 1.0 /REAL(n)1172 z = 1.0_wp/REAL(n) 1065 1173 zsin45 = z*SQRT(0.5) 1066 1174 … … 1105 1213 ! Dimension a(n),b(n),c(n),d(n),trigs(n) 1106 1214 1215 USE kinds 1216 1107 1217 IMPLICIT NONE 1108 1218 1109 1219 ! 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 !: 1111 1229 1112 1230 ! 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(*) !: 1114 1236 1115 1237 ! 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 !: 1121 1292 1122 1293 ! 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) !: 1125 1302 1126 1303 ! Intrinsic functions 1127 INTRINSIC SQRT1304 ! INTRINSIC SQRT 1128 1305 1129 1306 ! 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/ 1132 1309 1133 1310 … … 1622 1799 GO TO 170 1623 1800 120 CONTINUE 1624 qqrt5 = 2.0 *qrt51625 ssin36 = 2.0 *sin361626 ssin72 = 2.0 *sin721801 qqrt5 = 2.0_wp*qrt5 1802 ssin36 = 2.0_wp*sin36 1803 ssin72 = 2.0_wp*sin72 1627 1804 DO l = 1, la 1628 1805 i = ibase … … 1838 2015 jg = jf + jink 1839 2016 jh = jg + jink 1840 ssin45 = SQRT(2.0 )2017 ssin45 = SQRT(2.0_wp) 1841 2018 1842 2019 DO l = 1, la … … 1889 2066 1890 2067 1891 USE control_parameters 1892 USE pegrid 2068 USE control_parameters, & 2069 ONLY: message_string 2070 2071 USE kinds 1893 2072 1894 2073 IMPLICIT NONE 1895 2074 1896 2075 ! Scalar arguments 1897 INTEGER :: n2076 INTEGER(iwp) :: n !: 1898 2077 1899 2078 ! Array arguments 1900 REAL :: trigs(*) 1901 INTEGER :: ifax(*) 2079 INTEGER(iwp) :: ifax(*) !: 2080 REAL(wp) :: trigs(*) !: 2081 1902 2082 1903 2083 ! 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 !: 1906 2095 1907 2096 ! Local arrays: 1908 INTEGER :: jfax(10), lfax(7) 2097 INTEGER(iwp) :: jfax(10) !: 2098 INTEGER(iwp) :: lfax(7) !: 1909 2099 1910 2100 ! Intrinsic functions 1911 INTRINSIC ASIN, COS, MOD, REAL, SIN2101 ! INTRINSIC ASIN, COS, MOD, REAL, SIN 1912 2102 1913 2103 ! Data statements … … 1918 2108 ixxx = 1 1919 2109 1920 del = 4.0 *ASIN(1.0)/REAL(n)2110 del = 4.0_wp*ASIN(1.0_wp)/REAL(n) 1921 2111 nil = 0 1922 2112 nhl = (n/2) - 1 -
palm/trunk/SOURCE/time_integration.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 101 107 ! wang_collision_kernel renamed wang_kernel 102 108 ! 103 ! 790 2011-11-29 03:11:20Z raasch104 ! exchange of ghostpoints for array diss105 !106 ! 707 2011-03-29 11:39:40Z raasch107 ! bc_lr/ns replaced by bc_lr/ns_cyc, calls of exchange_horiz are modified,108 ! adaption to sloping surface109 !110 ! 667 2010-12-23 12:06:00Z suehring/gryschka111 ! Calls of exchange_horiz are modified.112 ! Adaption to slooping surface.113 !114 ! 449 2010-02-02 11:23:59Z raasch115 ! Bugfix: exchange of ghost points for prho included116 !117 ! 410 2009-12-04 17:05:40Z letzel118 ! masked data output119 !120 ! 388 2009-09-23 09:40:33Z raasch121 ! 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 switched124 ! on125 !126 ! 151 2008-03-07 13:42:18Z raasch127 ! inflow turbulence is imposed by calling new routine inflow_turbulence128 !129 ! 108 2007-08-24 15:10:38Z letzel130 ! Call of new routine surface_coupler,131 ! presure solver is called after the first Runge-Kutta substep instead of the132 ! last in case that call_psolver_at_all_substeps = .F.; for this case, the133 ! random perturbation has to be added to the velocity fields also after the134 ! first substep135 !136 ! 97 2007-06-21 08:23:15Z raasch137 ! 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 density140 !141 ! 87 2007-05-22 15:46:47Z raasch142 ! var_hom renamed pr_palm143 !144 ! 75 2007-03-22 09:54:05Z raasch145 ! Move call of user_actions( 'after_integration' ) below increment of times146 ! and counters,147 ! calls of prognostic_equations_.. changed to .._noopt, .._cache, and148 ! .._vector, these calls are now controlled by switch loop_optimization,149 ! uxrp, vynp eliminated, 2nd+3rd argument removed from exchange horiz,150 ! moisture renamed humidity151 !152 ! RCS Log replace by Id keyword, revision history cleaned up153 !154 ! Revision 1.8 2006/08/22 14:16:05 raasch155 ! Disturbances are imposed only for the last Runge-Kutta-substep156 !157 ! Revision 1.2 2004/04/30 13:03:40 raasch158 ! 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_advec161 !162 109 ! Revision 1.1 1997/08/11 06:19:04 raasch 163 110 ! Initial revision … … 170 117 !------------------------------------------------------------------------------! 171 118 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 186 181 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 191 195 192 196 IMPLICIT NONE 193 197 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 !: 196 201 197 202 ! -
palm/trunk/SOURCE/time_to_string.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 28 ! 24 29 ! Former revisions: … … 28 33 ! 1036 2012-10-22 13:43:42Z raasch 29 34 ! code put under GPL (PALM 3.9) 30 !31 ! RCS Log replace by Id keyword, revision history cleaned up32 !33 ! Revision 1.3 2001/01/22 08:16:04 raasch34 ! Comments translated into English35 35 ! 36 36 ! Revision 1.1 1997/08/11 06:26:08 raasch … … 43 43 !------------------------------------------------------------------------------! 44 44 45 USE kinds 46 45 47 IMPLICIT NONE 46 48 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 !: 50 57 51 58 ! -
palm/trunk/SOURCE/timestep.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 51 57 ! special treatment in case of mirror velocity boundary condition removed 52 58 ! 53 ! 707 2011-03-29 11:39:40Z raasch54 ! bc_lr/ns replaced by bc_lr/ns_cyc55 !56 ! 667 2010-12-23 12:06:00Z suehring/gryschka57 ! Exchange of terminate_coupled between ocean and atmosphere via PE058 ! Minimum grid spacing dxyz2_min(k) is now calculated using dzw instead of dzu59 !60 ! 622 2010-12-10 08:08:13Z raasch61 ! optional barriers included in order to speed up collective operations62 !63 ! 343 2009-06-24 12:59:09Z maronga64 ! Additional timestep criterion in case of simulations with plant canopy65 ! Output of messages replaced by message handling routine.66 !67 ! 222 2009-01-12 16:04:16Z letzel68 ! Implementation of a MPI-1 Coupling: replaced myid with target_id69 ! Bugfix for nonparallel execution70 !71 ! 108 2007-08-24 15:10:38Z letzel72 ! modifications to terminate coupled runs73 !74 ! RCS Log replace by Id keyword, revision history cleaned up75 !76 ! Revision 1.21 2006/02/23 12:59:44 raasch77 ! nt_anz renamed current_timestep_number78 !79 59 ! Revision 1.1 1997/08/11 06:26:19 raasch 80 60 ! Initial revision … … 86 66 !------------------------------------------------------------------------------! 87 67 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 94 89 USE interfaces 90 91 USE kinds 92 95 93 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 97 98 98 99 IMPLICIT NONE 99 100 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 !: 110 134 111 135 … … 222 246 ENDIF 223 247 #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, & 225 249 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, & 227 251 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, & 229 253 w_max, w_max_ijk ) 230 254 #endif -
palm/trunk/SOURCE/timestep_scheme_steering.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! ONLY-attribute added to USE-statements, 23 23 ! 24 24 ! Former revisions: … … 32 32 ! all actions concerning leapfrog scheme removed 33 33 ! 34 ! 673 2011-01-18 16:19:48Z suehring35 ! No pressure term during time integration (tsc(4)=0.0).36 !37 ! RCS Log replace by Id keyword, revision history cleaned up38 !39 ! Revision 1.2 2005/03/26 21:17:06 raasch40 ! No pressure term for Runge-Kutta-schemes (tsc(4)=0.0)41 !42 34 ! Revision 1.1 2004/01/28 15:34:47 raasch 43 35 ! Initial revision … … 50 42 !------------------------------------------------------------------------------! 51 43 52 USE control_parameters 44 USE control_parameters, & 45 ONLY: intermediate_timestep_count, timestep_scheme, tsc 53 46 54 47 IMPLICIT NONE -
palm/trunk/SOURCE/transpose.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 29 ! 24 30 ! Former revisions: … … 55 61 ! indices nxa, nya, etc. replaced by nx, ny, etc. 56 62 ! 57 ! 683 2011-02-09 14:25:15Z raasch58 ! openMP parallelization of transpositions for 2d-domain-decomposition59 !60 ! 622 2010-12-10 08:08:13Z raasch61 ! optional barriers included in order to speed up collective operations62 !63 ! 164 2008-05-15 08:46:15Z raasch64 ! f_inv changed from subroutine argument to automatic array in order to do65 ! re-ordering from f_in to f_inv in one step, one array work is needed instead66 ! of work1 and work267 !68 ! February 200769 ! RCS Log replace by Id keyword, revision history cleaned up70 !71 ! Revision 1.2 2004/04/30 13:12:17 raasch72 ! Switched from mpi_alltoallv to the simpler mpi_alltoall,73 ! all former transpose-routine files collected in this file, enlarged74 ! transposition arrays introduced75 !76 ! Revision 1.1 2004/04/30 13:08:16 raasch77 ! Initial revision (collection of former routines transpose_xy, transpose_xz,78 ! transpose_yx, transpose_yz, transpose_zx, transpose_zy)79 !80 63 ! Revision 1.1 1997/07/24 11:25:18 raasch 81 64 ! Initial revision … … 88 71 !------------------------------------------------------------------------------! 89 72 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 92 80 93 81 IMPLICIT NONE 94 82 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 !: 101 90 ! 102 91 !-- Rearrange indices of input array in order to make data to be send … … 128 117 !------------------------------------------------------------------------------! 129 118 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 132 127 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 134 131 135 132 IMPLICIT NONE 136 133 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 !: 142 144 143 145 … … 207 209 !------------------------------------------------------------------------------! 208 210 209 USE indices 210 USE transpose_indices 211 USE indices, & 212 ONLY: nxl, nxr, nyn, nys, nz 213 214 USE kinds 211 215 212 216 IMPLICIT NONE 213 217 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, k219 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 !: 220 224 ! 221 225 !-- Rearrange indices of input array in order to make data to be send … … 249 253 !------------------------------------------------------------------------------! 250 254 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 255 269 256 270 IMPLICIT NONE 257 271 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 !: 263 282 264 283 … … 331 350 !------------------------------------------------------------------------------! 332 351 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 335 359 336 360 IMPLICIT NONE 337 361 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 !: 344 369 ! 345 370 !-- Rearrange indices of input array in order to make data to be send … … 371 396 !------------------------------------------------------------------------------! 372 397 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 377 412 378 413 IMPLICIT NONE 379 414 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 !: 385 425 386 426 … … 453 493 !------------------------------------------------------------------------------! 454 494 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 459 509 460 510 IMPLICIT NONE 461 511 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) !: 468 523 #if defined( __parallel ) 469 524 … … 517 572 !------------------------------------------------------------------------------! 518 573 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 521 581 522 582 IMPLICIT NONE 523 583 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 !: 529 590 530 591 ! … … 557 618 !------------------------------------------------------------------------------! 558 619 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 563 634 564 635 IMPLICIT NONE 565 636 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 !: 571 647 572 648 … … 637 713 !------------------------------------------------------------------------------! 638 714 639 USE indices 640 USE transpose_indices 715 USE indices, & 716 ONLY: nxl, nxr, nyn, nys, nz 717 718 USE kinds 641 719 642 720 IMPLICIT NONE 643 721 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 !: 649 728 650 729 ! … … 677 756 !------------------------------------------------------------------------------! 678 757 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 683 772 684 773 IMPLICIT NONE 685 774 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 !: 691 785 692 786 … … 757 851 !------------------------------------------------------------------------------! 758 852 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 761 860 762 861 IMPLICIT NONE 763 862 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 !: 769 870 770 871 ! … … 797 898 !------------------------------------------------------------------------------! 798 899 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 803 914 804 915 IMPLICIT NONE 805 916 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 !: 812 927 813 928 ! … … 881 996 !------------------------------------------------------------------------------! 882 997 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 887 1012 888 1013 IMPLICIT NONE 889 1014 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) !: 895 1026 896 1027 #if defined( __parallel ) -
palm/trunk/SOURCE/tridia_solver.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 29 ! 24 30 ! Former revisions: … … 55 61 !------------------------------------------------------------------------------! 56 62 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 59 70 60 71 IMPLICIT NONE 61 72 62 REAL , DIMENSION(:,:), ALLOCATABLE :: ddzuw73 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddzuw !: 63 74 64 75 PRIVATE … … 79 90 SUBROUTINE tridia_init 80 91 81 USE arrays_3d, ONLY: ddzu_pres, ddzw 92 USE arrays_3d, & 93 ONLY: ddzu_pres, ddzw 94 95 USE kinds 82 96 83 97 IMPLICIT NONE 84 98 85 INTEGER :: k99 INTEGER(iwp) :: k !: 86 100 87 101 ALLOCATE( ddzuw(0:nz-1,3) ) … … 109 123 !------------------------------------------------------------------------------! 110 124 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 115 139 116 140 IMPLICIT NONE 117 141 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) !: 121 149 !$acc declare create( ll ) 122 150 … … 201 229 !------------------------------------------------------------------------------! 202 230 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 205 238 206 239 IMPLICIT NONE 207 240 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 !: 213 248 !$acc declare create( ar1 ) 214 249 … … 275 310 !------------------------------------------------------------------------------! 276 311 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 279 319 280 320 IMPLICIT NONE 281 321 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) !: 285 328 286 329 !$acc declare create( ar1 ) 287 REAL , DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) :: ar1330 REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) :: ar1 !: 288 331 289 332 ! … … 350 393 !------------------------------------------------------------------------------! 351 394 352 USE arrays_3d, ONLY: tri, tric 395 USE arrays_3d, & 396 ONLY: tri, tric 397 398 USE kinds 353 399 354 400 IMPLICIT NONE 355 401 356 INTEGER :: i, j, k 357 402 INTEGER(iwp) :: i !: 403 INTEGER(iwp) :: j !: 404 INTEGER(iwp) :: k !: 358 405 ! 359 406 !-- Splitting … … 398 445 !------------------------------------------------------------------------------! 399 446 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 404 454 405 455 IMPLICIT NONE 406 456 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 !: 413 471 414 472 … … 465 523 !------------------------------------------------------------------------------! 466 524 467 USE constants 525 USE constants, & 526 ONLY: pi 527 528 USE kinds 468 529 469 530 IMPLICIT NONE 470 531 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 !: 475 541 476 542 #if defined( __intel11 ) 477 REAL , DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d543 REAL(wp), DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d !: 478 544 #endif 479 545 … … 533 599 IMPLICIT NONE 534 600 535 INTEGER :: i, k 601 INTEGER(iwp) :: i !: 602 INTEGER(iwp) :: k !: 536 603 537 604 #if defined( __intel11 ) 538 REAL , DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d605 REAL(wp), DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d !: 539 606 #endif 540 607 … … 563 630 IMPLICIT NONE 564 631 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 !: 570 638 571 639 ! -
palm/trunk/SOURCE/user_3d_data_averaging.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 27 ! 24 28 ! Former revisions: … … 39 43 40 44 USE control_parameters 45 41 46 USE indices 47 48 USE kinds 49 42 50 USE user 43 51 44 52 IMPLICIT NONE 45 53 46 CHARACTER (LEN=*) :: mode, variable 54 CHARACTER (LEN=*) :: mode !: 55 CHARACTER (LEN=*) :: variable !: 47 56 48 INTEGER :: i, j, k 49 57 INTEGER(iwp) :: i !: 58 INTEGER(iwp) :: j !: 59 INTEGER(iwp) :: k !: 50 60 51 61 IF ( mode == 'allocate' ) THEN -
palm/trunk/SOURCE/user_actions.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ------------------ 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 23 27 ! 24 28 ! Former revisions: … … 34 38 ! 1036 2012-10-22 13:43:42Z raasch 35 39 ! code put under GPL (PALM 3.9) 36 !37 ! 667 2010-12-23 12:06:00Z suehring/gryschka38 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng39 !40 ! 258 2009-03-13 12:36:03Z heinze41 ! Output of messages replaced by message handling routine.42 40 ! 43 41 ! 211 2008-11-11 04:46:24Z raasch … … 66 64 67 65 USE control_parameters 66 68 67 USE cpulog 68 69 69 USE indices 70 71 USE kinds 72 70 73 USE pegrid 74 71 75 USE user 76 72 77 USE arrays_3d 73 78 74 79 IMPLICIT NONE 75 80 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 !: 79 86 80 87 CALL cpu_log( log_point(24), 'user_actions', 'start' ) … … 165 172 166 173 USE control_parameters 174 USE kinds 167 175 USE pegrid 168 176 USE user … … 172 180 CHARACTER (LEN=*) :: location 173 181 174 INTEGER :: i, idum, j 175 182 INTEGER(iwp) :: i 183 INTEGER(iwp) :: idum 184 INTEGER(iwp) :: j 176 185 177 186 ! -
palm/trunk/SOURCE/user_additional_routines.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 27 ! 24 28 ! Former revisions: … … 37 41 !------------------------------------------------------------------------------! 38 42 43 USE kinds 44 39 45 USE user 40 46 -
palm/trunk/SOURCE/user_check_data_output.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 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 23 27 ! 24 28 ! Former revisions: