Changeset 2232 for palm/trunk
- Timestamp:
- May 30, 2017 5:47:52 PM (8 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 1 added
- 1 deleted
- 73 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r2176 r2232 20 20 # Current revisions: 21 21 # ------------------ 22 # 22 # +dependencies for surface_mod 23 # -wall_fluxes 23 24 # 24 25 # Former revisions: … … 351 352 read_3d_binary.f90 read_var_list.f90 run_control.f90 \ 352 353 set_slicer_attributes_dvrp.f90 singleton_mod.f90 sor.f90 spectra_mod.f90 \ 353 subsidence_mod.f90 sum_up_3d_data.f90 \354 subsidence_mod.f90 sum_up_3d_data.f90 surface_mod.f90 \ 354 355 surface_coupler.f90 surface_layer_fluxes_mod.f90 swap_timelevel.f90 temperton_fft_mod.f90 \ 355 356 time_integration.f90 time_to_string.f90 timestep.f90 \ … … 369 370 user_lpm_init.f90 user_lpm_set_attributes.f90 user_module.f90 \ 370 371 user_parin.f90 user_read_restart_data.f90 \ 371 user_spectra.f90 user_statistics.f90 virtual_flight_mod.f90 wall_fluxes.f90\372 user_spectra.f90 user_statistics.f90 virtual_flight_mod.f90 \ 372 373 wind_turbine_model_mod.f90 write_3d_binary.f90 write_var_list.f90 373 374 … … 413 414 advec_w_pw.o: modules.o mod_kinds.o 414 415 advec_w_up.o: modules.o mod_kinds.o 415 average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \416 average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o exchange_horiz_2d.o land_surface_model_mod.o \ 416 417 radiation_model_mod.o urban_surface_mod.o 417 boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o 418 boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o surface_mod.o 418 419 buoyancy.o: modules.o mod_kinds.o 419 420 calc_mean_profile.o: modules.o mod_kinds.o … … 445 446 data_output_2d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \ 446 447 netcdf_interface_mod.o land_surface_model_mod.o radiation_model_mod.o \ 447 urban_surface_mod.o448 surface_mod.o urban_surface_mod.o 448 449 data_output_3d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \ 449 450 netcdf_interface_mod.o land_surface_model_mod.o urban_surface_mod.o 450 451 diffusion_e.o: modules.o mod_kinds.o microphysics_mod.o \ 451 mod_particle_attributes.o 452 diffusion_s.o: modules.o mod_kinds.o 453 diffusion_u.o: modules.o mod_kinds.o wall_fluxes.o454 diffusion_v.o: modules.o mod_kinds.o wall_fluxes.o455 diffusion_w.o: modules.o mod_kinds.o wall_fluxes.o456 diffusivities.o: modules.o mod_kinds.o 452 mod_particle_attributes.o surface_mod.o 453 diffusion_s.o: modules.o mod_kinds.o surface_mod.o 454 diffusion_u.o: modules.o mod_kinds.o surface_mod.o 455 diffusion_v.o: modules.o mod_kinds.o surface_mod.o 456 diffusion_w.o: modules.o mod_kinds.o surface_mod.o 457 diffusivities.o: modules.o mod_kinds.o surface_mod.o 457 458 disturb_field.o: modules.o cpulog_mod.o mod_kinds.o random_function_mod.o \ 458 459 random_generator_parallel_mod.o 459 disturb_heatflux.o: modules.o cpulog_mod.o mod_kinds.o 460 eqn_state_seawater.o: modules.o mod_kinds.o 460 disturb_heatflux.o: modules.o cpulog_mod.o mod_kinds.o random_generator_parallel_mod.o surface_mod.o 461 eqn_state_seawater.o: modules.o mod_kinds.o surface_mod.o 461 462 exchange_horiz.o: modules.o cpulog_mod.o mod_kinds.o 462 463 exchange_horiz_2d.o: modules.o cpulog_mod.o mod_kinds.o pmc_interface_mod.o 463 464 fft_xy_mod.o: modules.o mod_kinds.o singleton_mod.o temperton_fft_mod.o 464 465 flow_statistics.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \ 465 netcdf_interface_mod.o radiation_model_mod.o 466 netcdf_interface_mod.o radiation_model_mod.o surface_mod.o 466 467 global_min_max.o: modules.o mod_kinds.o 467 468 header.o: modules.o cpulog_mod.o mod_kinds.o netcdf_interface_mod.o land_surface_model_mod.o\ … … 470 471 inflow_turbulence.o: modules.o cpulog_mod.o mod_kinds.o 471 472 init_1d_model.o: modules.o mod_kinds.o 472 init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o land_surface_model_mod.o \473 init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o disturb_heatflux.o land_surface_model_mod.o \ 473 474 lpm_init.o ls_forcing_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o \ 474 475 radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \ 475 surface_layer_fluxes_mod.o microphysics_mod.o mod_particle_attributes.o \476 urban_surface_mod.o virtual_flight_mod.o wind_turbine_model_mod.o476 microphysics_mod.o mod_particle_attributes.o surface_layer_fluxes_mod.o \ 477 urban_surface_mod.o virtual_flight_mod.o surface_mod.o wind_turbine_model_mod.o 477 478 init_advec.o: modules.o mod_kinds.o 478 479 init_cloud_physics.o: modules.o mod_kinds.o 479 480 init_coupling.o: modules.o mod_kinds.o 480 481 init_dvrp.o: modules.o mod_kinds.o 481 init_grid.o: modules.o mod_kinds.o advec_ws.o 482 init_grid.o: modules.o mod_kinds.o advec_ws.o netcdf_interface_mod.o surface_mod.o 482 483 init_masks.o: modules.o mod_kinds.o netcdf_interface_mod.o 483 484 init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o … … 487 488 init_slope.o: modules.o mod_kinds.o 488 489 interaction_droplets_ptq.o: modules.o mod_kinds.o 489 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o 490 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o surface_mod.o 490 491 local_stop.o: modules.o mod_kinds.o pmc_interface_mod.o 491 492 local_tremain.o: modules.o cpulog_mod.o mod_kinds.o … … 519 520 ls_forcing_mod.o: modules.o cpulog_mod.o mod_kinds.o 520 521 message.o: modules.o mod_kinds.o pmc_interface_mod.o 521 microphysics_mod.o: modules.o cpulog_mod.o mod_kinds.o 522 microphysics_mod.o: modules.o cpulog_mod.o mod_kinds.o surface_mod.o 522 523 modules.o: modules.f90 mod_kinds.o 523 524 mod_kinds.o: mod_kinds.f90 … … 546 547 poismg_noopt.o: modules.o cpulog_mod.o mod_kinds.o 547 548 posix_calls_from_fortran.o: posix_calls_from_fortran.f90 548 pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o pmc_interface_mod.o 549 pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o pmc_interface_mod.o \ 550 surface_mod.o 549 551 print_1d.o: modules.o cpulog_mod.o mod_kinds.o 550 production_e.o: modules.o mod_kinds.o wall_fluxes.o552 production_e.o: modules.o mod_kinds.o surface_mod.o 551 553 prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_s_bc.o advec_u_pw.o \ 552 554 advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o \ … … 555 557 eqn_state_seawater.o mod_kinds.o microphysics_mod.o \ 556 558 nudging_mod.o plant_canopy_model_mod.o production_e.o radiation_model_mod.o \ 557 subsidence_mod.o urban_surface_mod.o user_actions.o wind_turbine_model_mod.o559 subsidence_mod.o surface_mod.o user_actions.o wind_turbine_model_mod.o 558 560 progress_bar_mod.o: modules.o mod_kinds.o 559 561 radiation_model_mod.o : modules.o mod_particle_attributes.o microphysics_mod.o … … 563 565 read_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o \ 564 566 land_surface_model_mod.o radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \ 565 spectra_mod.o 567 spectra_mod.o surface_mod.o 566 568 read_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o \ 567 569 spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o … … 573 575 subsidence_mod.o: modules.o mod_kinds.o 574 576 sum_up_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \ 575 radiation_model_mod.o urban_surface_mod.o577 radiation_model_mod.o surface_mod.o urban_surface_mod.o 576 578 surface_coupler.o: modules.o cpulog_mod.o mod_kinds.o 577 surface_layer_fluxes_mod.o: modules.o mod_kinds.o land_surface_model_mod.o \ 578 urban_surface_mod.o 579 surface_layer_fluxes_mod.o: modules.o mod_kinds.o exchange_horiz_2d.o land_surface_model_mod.o \ 580 urban_surface_mod.o surface_mod.o 581 surface_mod.o: modules.o mod_kinds.o init_pegrid.o 579 582 swap_timelevel.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \ 580 583 pmc_interface_mod.o urban_surface_mod.o 581 584 temperton_fft_mod.o: modules.o mod_kinds.o 582 585 time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \ 583 cpulog_mod.o data_output_flight.o interaction_droplets_ptq.o land_surface_model_mod.o \586 cpulog_mod.o data_output_flight.o disturb_heatflux.o interaction_droplets_ptq.o land_surface_model_mod.o \ 584 587 ls_forcing_mod.o mod_kinds.o nudging_mod.o pmc_interface_mod.o production_e.o \ 585 588 prognostic_equations.o progress_bar_mod.o radiation_model_mod.o \ 586 spectra_mod.o user_actions.o surface_layer_fluxes_mod.o microphysics_mod.o \589 spectra_mod.o user_actions.o microphysics_mod.o surface_layer_fluxes_mod.o surface_mod.o \ 587 590 urban_surface_mod.o virtual_flight_mod.o wind_turbine_model_mod.o 588 591 time_to_string.o: mod_kinds.o … … 600 603 netcdf_interface_mod.o 601 604 user_check_parameters.o: modules.o mod_kinds.o user_module.o 602 user_data_output_2d.o: modules.o mod_kinds.o user_module.o605 user_data_output_2d.o: modules.o mod_kinds.o surface_mod.o user_module.o 603 606 user_data_output_3d.o: modules.o mod_kinds.o user_module.o 604 607 user_data_output_mask.o: modules.o mod_kinds.o user_module.o … … 609 612 user_header.o: modules.o mod_kinds.o user_module.o 610 613 user_init.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o 611 user_init_3d_model.o: modules.o mod_kinds.o user_module.o614 user_init_3d_model.o: modules.o mod_kinds.o surface_mod.o user_module.o 612 615 user_init_flight.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o 613 616 user_init_grid.o: modules.o mod_kinds.o user_module.o 614 user_init_land_surface.o: modules.o mod_kinds.o user_module.o land_surface_model_mod.o netcdf_interface_mod.o617 user_init_land_surface.o: modules.o mod_kinds.o surface_mod.o user_module.o land_surface_model_mod.o netcdf_interface_mod.o 615 618 user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model_mod.o 616 619 user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model_mod.o 617 user_init_urban_surface.o: modules.o mod_kinds.o user_module.o urban_surface_mod.o620 user_init_urban_surface.o: modules.o mod_kinds.o surface_mod.o user_module.o urban_surface_mod.o 618 621 user_last_actions.o: modules.o mod_kinds.o user_module.o 619 622 user_lpm_advec.o: modules.o mod_kinds.o user_module.o … … 626 629 user_statistics.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o 627 630 virtual_flight_mod.o: modules.o cpulog_mod.o mod_kinds.o netcdf_interface_mod.o user_init_flight.o user_flight.o 628 wall_fluxes.o: modules.o mod_kinds.o629 631 wind_turbine_model_mod.o: modules.o cpulog_mod.o mod_kinds.o 630 632 write_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o \ 631 633 radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \ 632 spectra_mod.o 634 spectra_mod.o surface_mod.o 633 635 write_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o\ 634 636 spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o -
palm/trunk/SOURCE/advec_s_pw.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 104 104 105 105 USE indices, & 106 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&107 nzt 106 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, & 107 nzt, wall_flags_0 108 108 109 109 USE kinds … … 125 125 DO i = nxl, nxr 126 126 DO j = nys, nyn 127 DO k = nzb _s_inner(j,i)+1, nzt128 tend(k,j,i) = tend(k,j,i) &129 127 DO k = nzb+1, nzt 128 tend(k,j,i) = tend(k,j,i) + & 129 ( -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) & 130 130 - ( u(k,j,i) - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) & 131 131 ) * ddx & … … 135 135 - ( w(k,j,i) * ( sk(k+1,j,i) - sk(k,j,i) ) & 136 136 - w(k-1,j,i) * ( sk(k-1,j,i) - sk(k,j,i) ) & 137 ) * dd2zu(k) 137 ) * dd2zu(k) & 138 ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 138 139 ENDDO 139 140 ENDDO … … 160 161 161 162 USE indices, & 162 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_s_inner, nzt163 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 163 164 164 165 USE kinds … … 178 179 179 180 180 DO k = nzb _s_inner(j,i)+1, nzt181 tend(k,j,i) = tend(k,j,i) &182 181 DO k = nzb+1, nzt 182 tend(k,j,i) = tend(k,j,i) + & 183 ( -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) & 183 184 - ( u(k,j,i) - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) & 184 185 ) * ddx & … … 188 189 - ( w(k,j,i) * ( sk(k+1,j,i) - sk(k,j,i) ) & 189 190 - w(k-1,j,i) * ( sk(k-1,j,i) - sk(k,j,i) ) & 190 ) * dd2zu(k) 191 ) * dd2zu(k) & 192 ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 191 193 ENDDO 192 194 -
palm/trunk/SOURCE/advec_s_up.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 104 104 105 105 USE indices, & 106 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nz b_s_inner,&107 nzt106 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 107 wall_flags_0 108 108 109 109 USE kinds … … 128 128 DO i = nxl, nxr 129 129 DO j = nys, nyn 130 DO k = nzb _s_inner(j,i)+1, nzt130 DO k = nzb+1, nzt 131 131 ! 132 132 !-- x-direction … … 134 134 IF ( ukomp > 0.0_wp ) THEN 135 135 tend(k,j,i) = tend(k,j,i) - ukomp * & 136 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 136 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 0 ) ) 137 139 ELSE 138 140 tend(k,j,i) = tend(k,j,i) - ukomp * & 139 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 141 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx & 142 * MERGE( 1.0_wp, 0.0_wp, & 143 BTEST( wall_flags_0(k,j,i), 0 ) ) 140 144 ENDIF 141 145 ! … … 144 148 IF ( vkomp > 0.0_wp ) THEN 145 149 tend(k,j,i) = tend(k,j,i) - vkomp * & 146 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 150 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy & 151 * MERGE( 1.0_wp, 0.0_wp, & 152 BTEST( wall_flags_0(k,j,i), 0 ) ) 147 153 ELSE 148 154 tend(k,j,i) = tend(k,j,i) - vkomp * & 149 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 155 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy & 156 * MERGE( 1.0_wp, 0.0_wp, & 157 BTEST( wall_flags_0(k,j,i), 0 ) ) 150 158 ENDIF 151 159 ! … … 154 162 IF ( wkomp > 0.0_wp ) THEN 155 163 tend(k,j,i) = tend(k,j,i) - wkomp * & 156 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 164 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) & 165 * MERGE( 1.0_wp, 0.0_wp, & 166 BTEST( wall_flags_0(k,j,i), 0 ) ) 157 167 ELSE 158 168 tend(k,j,i) = tend(k,j,i) - wkomp * & 159 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 169 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) & 170 * MERGE( 1.0_wp, 0.0_wp, & 171 BTEST( wall_flags_0(k,j,i), 0 ) ) 160 172 ENDIF 161 173 … … 184 196 185 197 USE indices, & 186 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_s_inner, nzt198 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 187 199 188 200 USE kinds … … 206 218 207 219 208 DO k = nzb _s_inner(j,i)+1, nzt220 DO k = nzb+1, nzt 209 221 ! 210 222 !-- x-direction … … 212 224 IF ( ukomp > 0.0_wp ) THEN 213 225 tend(k,j,i) = tend(k,j,i) - ukomp * & 214 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx 226 ( sk(k,j,i) - sk(k,j,i-1) ) * ddx & 227 * MERGE( 1.0_wp, 0.0_wp, & 228 BTEST( wall_flags_0(k,j,i), 0 ) ) 215 229 ELSE 216 230 tend(k,j,i) = tend(k,j,i) - ukomp * & 217 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx 231 ( sk(k,j,i+1) - sk(k,j,i) ) * ddx & 232 * MERGE( 1.0_wp, 0.0_wp, & 233 BTEST( wall_flags_0(k,j,i), 0 ) ) 218 234 ENDIF 219 235 ! … … 222 238 IF ( vkomp > 0.0_wp ) THEN 223 239 tend(k,j,i) = tend(k,j,i) - vkomp * & 224 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy 240 ( sk(k,j,i) - sk(k,j-1,i) ) * ddy & 241 * MERGE( 1.0_wp, 0.0_wp, & 242 BTEST( wall_flags_0(k,j,i), 0 ) ) 225 243 ELSE 226 244 tend(k,j,i) = tend(k,j,i) - vkomp * & 227 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy 245 ( sk(k,j+1,i) - sk(k,j,i) ) * ddy & 246 * MERGE( 1.0_wp, 0.0_wp, & 247 BTEST( wall_flags_0(k,j,i), 0 ) ) 228 248 ENDIF 229 249 ! … … 232 252 IF ( wkomp > 0.0_wp ) THEN 233 253 tend(k,j,i) = tend(k,j,i) - wkomp * & 234 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) 254 ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k) & 255 * MERGE( 1.0_wp, 0.0_wp, & 256 BTEST( wall_flags_0(k,j,i), 0 ) ) 235 257 ELSE 236 258 tend(k,j,i) = tend(k,j,i) - wkomp * & 237 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) 259 ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1) & 260 * MERGE( 1.0_wp, 0.0_wp, & 261 BTEST( wall_flags_0(k,j,i), 0 ) ) 238 262 ENDIF 239 263 -
palm/trunk/SOURCE/advec_u_pw.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 96 96 97 97 USE indices, & 98 ONLY: nxlu, nxr, nyn, nys, nzb _u_inner, nzt98 ONLY: nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0 99 99 100 100 USE kinds … … 114 114 DO i = nxlu, nxr 115 115 DO j = nys, nyn 116 DO k = nzb _u_inner(j,i)+1, nzt116 DO k = nzb+1, nzt 117 117 tend(k,j,i) = tend(k,j,i) - 0.25_wp * ( & 118 118 ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu ) & … … 123 123 - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 124 124 * ddzw(k) & 125 ) 125 ) & 126 * MERGE( 1.0_wp, 0.0_wp, & 127 BTEST( wall_flags_0(k,j,i), 1 ) ) 126 128 ENDDO 127 129 ENDDO … … 148 150 149 151 USE indices, & 150 ONLY: nzb _u_inner, nzt152 ONLY: nzb, nzt, wall_flags_0 151 153 152 154 USE kinds … … 164 166 gu = 2.0_wp * u_gtrans 165 167 gv = 2.0_wp * v_gtrans 166 DO k = nzb _u_inner(j,i)+1, nzt168 DO k = nzb+1, nzt 167 169 tend(k,j,i) = tend(k,j,i) - 0.25_wp * ( & 168 170 ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu ) & … … 173 175 - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 174 176 * ddzw(k) & 175 ) 177 ) & 178 * MERGE( 1.0_wp, 0.0_wp, & 179 BTEST( wall_flags_0(k,j,i), 1 ) ) 176 180 ENDDO 177 181 -
palm/trunk/SOURCE/advec_u_up.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 95 95 96 96 USE indices, & 97 ONLY: nxlu, nxr, nyn, nys, nzb _u_inner, nzt97 ONLY: nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0 98 98 99 99 USE kinds … … 113 113 DO i = nxlu, nxr 114 114 DO j = nys, nyn 115 DO k = nzb _u_inner(j,i)+1, nzt115 DO k = nzb+1, nzt 116 116 ! 117 117 !-- x-direction … … 119 119 IF ( ukomp > 0.0_wp ) THEN 120 120 tend(k,j,i) = tend(k,j,i) - ukomp * & 121 ( u(k,j,i) - u(k,j,i-1) ) * ddx 121 ( u(k,j,i) - u(k,j,i-1) ) * ddx & 122 * MERGE( 1.0_wp, 0.0_wp, & 123 BTEST( wall_flags_0(k,j,i), 1 ) ) 122 124 ELSE 123 125 tend(k,j,i) = tend(k,j,i) - ukomp * & 124 ( u(k,j,i+1) - u(k,j,i) ) * ddx 126 ( u(k,j,i+1) - u(k,j,i) ) * ddx & 127 * MERGE( 1.0_wp, 0.0_wp, & 128 BTEST( wall_flags_0(k,j,i), 1 ) ) 125 129 ENDIF 126 130 ! … … 130 134 IF ( vkomp > 0.0_wp ) THEN 131 135 tend(k,j,i) = tend(k,j,i) - vkomp * & 132 ( u(k,j,i) - u(k,j-1,i) ) * ddy 136 ( u(k,j,i) - u(k,j-1,i) ) * ddy & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 1 ) ) 133 139 ELSE 134 140 tend(k,j,i) = tend(k,j,i) - vkomp * & 135 ( u(k,j+1,i) - u(k,j,i) ) * ddy 141 ( u(k,j+1,i) - u(k,j,i) ) * ddy & 142 * MERGE( 1.0_wp, 0.0_wp, & 143 BTEST( wall_flags_0(k,j,i), 1 ) ) 136 144 ENDIF 137 145 ! … … 141 149 IF ( wkomp > 0.0_wp ) THEN 142 150 tend(k,j,i) = tend(k,j,i) - wkomp * & 143 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) 151 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) & 152 * MERGE( 1.0_wp, 0.0_wp, & 153 BTEST( wall_flags_0(k,j,i), 1 ) ) 144 154 ELSE 145 155 tend(k,j,i) = tend(k,j,i) - wkomp * & 146 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) 156 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) & 157 * MERGE( 1.0_wp, 0.0_wp, & 158 BTEST( wall_flags_0(k,j,i), 1 ) ) 147 159 ENDIF 148 160 … … 171 183 172 184 USE indices, & 173 ONLY: nzb _u_inner, nzt185 ONLY: nzb, nzt, wall_flags_0 174 186 175 187 USE kinds … … 187 199 188 200 189 DO k = nzb _u_inner(j,i)+1, nzt201 DO k = nzb+1, nzt 190 202 ! 191 203 !-- x-direction … … 193 205 IF ( ukomp > 0.0_wp ) THEN 194 206 tend(k,j,i) = tend(k,j,i) - ukomp * & 195 ( u(k,j,i) - u(k,j,i-1) ) * ddx 207 ( u(k,j,i) - u(k,j,i-1) ) * ddx & 208 * MERGE( 1.0_wp, 0.0_wp, & 209 BTEST( wall_flags_0(k,j,i), 1 ) ) 196 210 ELSE 197 211 tend(k,j,i) = tend(k,j,i) - ukomp * & 198 ( u(k,j,i+1) - u(k,j,i) ) * ddx 212 ( u(k,j,i+1) - u(k,j,i) ) * ddx & 213 * MERGE( 1.0_wp, 0.0_wp, & 214 BTEST( wall_flags_0(k,j,i), 1 ) ) 199 215 ENDIF 200 216 ! … … 204 220 IF ( vkomp > 0.0_wp ) THEN 205 221 tend(k,j,i) = tend(k,j,i) - vkomp * & 206 ( u(k,j,i) - u(k,j-1,i) ) * ddy 222 ( u(k,j,i) - u(k,j-1,i) ) * ddy & 223 * MERGE( 1.0_wp, 0.0_wp, & 224 BTEST( wall_flags_0(k,j,i), 1 ) ) 207 225 ELSE 208 226 tend(k,j,i) = tend(k,j,i) - vkomp * & 209 ( u(k,j+1,i) - u(k,j,i) ) * ddy 227 ( u(k,j+1,i) - u(k,j,i) ) * ddy & 228 * MERGE( 1.0_wp, 0.0_wp, & 229 BTEST( wall_flags_0(k,j,i), 1 ) ) 210 230 ENDIF 211 231 ! … … 214 234 IF ( wkomp > 0.0_wp ) THEN 215 235 tend(k,j,i) = tend(k,j,i) - wkomp * & 216 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) 236 ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) & 237 * MERGE( 1.0_wp, 0.0_wp, & 238 BTEST( wall_flags_0(k,j,i), 1 ) ) 217 239 ELSE 218 240 tend(k,j,i) = tend(k,j,i) - wkomp * & 219 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) 241 ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) & 242 * MERGE( 1.0_wp, 0.0_wp, & 243 BTEST( wall_flags_0(k,j,i), 1 ) ) 220 244 ENDIF 221 245 -
palm/trunk/SOURCE/advec_v_pw.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 96 96 97 97 USE indices, & 98 ONLY: nxl, nxr, nyn, nysv, nzb _v_inner, nzt98 ONLY: nxl, nxr, nyn, nysv, nzb, nzt, wall_flags_0 99 99 100 100 USE kinds … … 115 115 DO i = nxl, nxr 116 116 DO j = nysv, nyn 117 DO k = nzb _v_inner(j,i)+1, nzt117 DO k = nzb+1, nzt 118 118 tend(k,j,i) = tend(k,j,i) - 0.25_wp * ( & 119 119 ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu ) & … … 124 124 - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) ) & 125 125 * ddzw(k) & 126 ) 126 ) & 127 * MERGE( 1.0_wp, 0.0_wp, & 128 BTEST( wall_flags_0(k,j,i), 2 ) ) 127 129 ENDDO 128 130 ENDDO … … 149 151 150 152 USE indices, & 151 ONLY: nzb _v_inner, nzt153 ONLY: nzb, nzt, wall_flags_0 152 154 153 155 USE kinds … … 166 168 gu = 2.0_wp * u_gtrans 167 169 gv = 2.0_wp * v_gtrans 168 DO k = nzb _v_inner(j,i)+1, nzt170 DO k = nzb+1, nzt 169 171 tend(k,j,i) = tend(k,j,i) - 0.25_wp * ( & 170 172 ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu ) & … … 175 177 - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) ) & 176 178 * ddzw(k) & 177 ) 179 ) & 180 * MERGE( 1.0_wp, 0.0_wp, & 181 BTEST( wall_flags_0(k,j,i), 2 ) ) 178 182 ENDDO 179 183 -
palm/trunk/SOURCE/advec_v_up.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 95 95 96 96 USE indices, & 97 ONLY: nxl, nxr, nyn, nysv, nzb _v_inner, nzt97 ONLY: nxl, nxr, nyn, nysv, nzb, nzt, wall_flags_0 98 98 99 99 USE kinds … … 113 113 DO i = nxl, nxr 114 114 DO j = nysv, nyn 115 DO k = nzb _v_inner(j,i)+1, nzt115 DO k = nzb+1, nzt 116 116 ! 117 117 !-- x-direction … … 120 120 IF ( ukomp > 0.0_wp ) THEN 121 121 tend(k,j,i) = tend(k,j,i) - ukomp * & 122 ( v(k,j,i) - v(k,j,i-1) ) * ddx 122 ( v(k,j,i) - v(k,j,i-1) ) * ddx & 123 * MERGE( 1.0_wp, 0.0_wp, & 124 BTEST( wall_flags_0(k,j,i), 2 ) ) 123 125 ELSE 124 126 tend(k,j,i) = tend(k,j,i) - ukomp * & 125 ( v(k,j,i+1) - v(k,j,i) ) * ddx 127 ( v(k,j,i+1) - v(k,j,i) ) * ddx & 128 * MERGE( 1.0_wp, 0.0_wp, & 129 BTEST( wall_flags_0(k,j,i), 2 ) ) 126 130 ENDIF 127 131 ! … … 130 134 IF ( vkomp > 0.0_wp ) THEN 131 135 tend(k,j,i) = tend(k,j,i) - vkomp * & 132 ( v(k,j,i) - v(k,j-1,i) ) * ddy 136 ( v(k,j,i) - v(k,j-1,i) ) * ddy & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 2 ) ) 133 139 ELSE 134 140 tend(k,j,i) = tend(k,j,i) - vkomp * & 135 ( v(k,j+1,i) - v(k,j,i) ) * ddy 141 ( v(k,j+1,i) - v(k,j,i) ) * ddy & 142 * MERGE( 1.0_wp, 0.0_wp, & 143 BTEST( wall_flags_0(k,j,i), 2 ) ) 136 144 ENDIF 137 145 ! … … 141 149 IF ( wkomp > 0.0_wp ) THEN 142 150 tend(k,j,i) = tend(k,j,i) - wkomp * & 143 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) 151 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) & 152 * MERGE( 1.0_wp, 0.0_wp, & 153 BTEST( wall_flags_0(k,j,i), 2 ) ) 144 154 ELSE 145 155 tend(k,j,i) = tend(k,j,i) - wkomp * & 146 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) 156 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 157 * MERGE( 1.0_wp, 0.0_wp, & 158 BTEST( wall_flags_0(k,j,i), 2 ) ) 147 159 ENDIF 148 160 … … 171 183 172 184 USE indices, & 173 ONLY: nzb _v_inner, nzt185 ONLY: nzb, nzt, wall_flags_0 174 186 175 187 USE kinds … … 187 199 188 200 189 DO k = nzb _v_inner(j,i)+1, nzt201 DO k = nzb+1, nzt 190 202 ! 191 203 !-- x-direction … … 194 206 IF ( ukomp > 0.0_wp ) THEN 195 207 tend(k,j,i) = tend(k,j,i) - ukomp * & 196 ( v(k,j,i) - v(k,j,i-1) ) * ddx 208 ( v(k,j,i) - v(k,j,i-1) ) * ddx & 209 * MERGE( 1.0_wp, 0.0_wp, & 210 BTEST( wall_flags_0(k,j,i), 2 ) ) 197 211 ELSE 198 212 tend(k,j,i) = tend(k,j,i) - ukomp * & 199 ( v(k,j,i+1) - v(k,j,i) ) * ddx 213 ( v(k,j,i+1) - v(k,j,i) ) * ddx & 214 * MERGE( 1.0_wp, 0.0_wp, & 215 BTEST( wall_flags_0(k,j,i), 2 ) ) 200 216 ENDIF 201 217 ! … … 204 220 IF ( vkomp > 0.0_wp ) THEN 205 221 tend(k,j,i) = tend(k,j,i) - vkomp * & 206 ( v(k,j,i) - v(k,j-1,i) ) * ddy 222 ( v(k,j,i) - v(k,j-1,i) ) * ddy & 223 * MERGE( 1.0_wp, 0.0_wp, & 224 BTEST( wall_flags_0(k,j,i), 2 ) ) 207 225 ELSE 208 226 tend(k,j,i) = tend(k,j,i) - vkomp * & 209 ( v(k,j+1,i) - v(k,j,i) ) * ddy 227 ( v(k,j+1,i) - v(k,j,i) ) * ddy & 228 * MERGE( 1.0_wp, 0.0_wp, & 229 BTEST( wall_flags_0(k,j,i), 2 ) ) 210 230 ENDIF 211 231 ! … … 214 234 IF ( wkomp > 0.0_wp ) THEN 215 235 tend(k,j,i) = tend(k,j,i) - wkomp * & 216 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) 236 ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) & 237 * MERGE( 1.0_wp, 0.0_wp, & 238 BTEST( wall_flags_0(k,j,i), 2 ) ) 217 239 ELSE 218 240 tend(k,j,i) = tend(k,j,i) - wkomp * & 219 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) 241 ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 242 * MERGE( 1.0_wp, 0.0_wp, & 243 BTEST( wall_flags_0(k,j,i), 2 ) ) 220 244 ENDIF 221 245 -
palm/trunk/SOURCE/advec_w_pw.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 96 96 97 97 USE indices, & 98 ONLY: nxl, nxr, nyn, nys, nzb _w_inner, nzt98 ONLY: nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0 99 99 100 100 USE kinds … … 115 115 DO i = nxl, nxr 116 116 DO j = nys, nyn 117 DO k = nzb _w_inner(j,i)+1, nzt117 DO k = nzb+1, nzt 118 118 tend(k,j,i) = tend(k,j,i) - 0.25_wp * ( & 119 119 ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu ) & … … 124 124 - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) ) & 125 125 * ddzu(k+1) & 126 ) 126 ) & 127 * MERGE( 1.0_wp, 0.0_wp, & 128 BTEST( wall_flags_0(k,j,i), 3 ) ) 127 129 ENDDO 128 130 ENDDO … … 149 151 150 152 USE indices, & 151 ONLY: nzb _w_inner, nzt153 ONLY: nzb, nzt, wall_flags_0 152 154 153 155 USE kinds … … 165 167 gu = 2.0_wp * u_gtrans 166 168 gv = 2.0_wp * v_gtrans 167 DO k = nzb _w_inner(j,i)+1, nzt169 DO k = nzb+1, nzt 168 170 tend(k,j,i) = tend(k,j,i) - 0.25_wp * ( & 169 171 ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu ) & … … 174 176 - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) ) & 175 177 * ddzu(k+1) & 176 ) 178 ) & 179 * MERGE( 1.0_wp, 0.0_wp, & 180 BTEST( wall_flags_0(k,j,i), 3 ) ) 177 181 ENDDO 178 182 END SUBROUTINE advec_w_pw_ij -
palm/trunk/SOURCE/advec_w_up.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! topography representation via flags 23 23 ! 24 24 ! Former revisions: … … 95 95 96 96 USE indices, & 97 ONLY: nxl, nxr, nyn, nys, nzb _w_inner, nzt97 ONLY: nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0 98 98 99 99 USE kinds … … 112 112 DO i = nxl, nxr 113 113 DO j = nys, nyn 114 DO k = nzb _w_inner(j,i)+1, nzt-1114 DO k = nzb+1, nzt-1 115 115 ! 116 116 !-- x-direction … … 119 119 IF ( ukomp > 0.0_wp ) THEN 120 120 tend(k,j,i) = tend(k,j,i) - ukomp * & 121 ( w(k,j,i) - w(k,j,i-1) ) * ddx 121 ( w(k,j,i) - w(k,j,i-1) ) * ddx & 122 * MERGE( 1.0_wp, 0.0_wp, & 123 BTEST( wall_flags_0(k,j,i), 3 ) ) 122 124 ELSE 123 125 tend(k,j,i) = tend(k,j,i) - ukomp * & 124 ( w(k,j,i+1) - w(k,j,i) ) * ddx 126 ( w(k,j,i+1) - w(k,j,i) ) * ddx & 127 * MERGE( 1.0_wp, 0.0_wp, & 128 BTEST( wall_flags_0(k,j,i), 3 ) ) 125 129 ENDIF 126 130 ! … … 130 134 IF ( vkomp > 0.0_wp ) THEN 131 135 tend(k,j,i) = tend(k,j,i) - vkomp * & 132 ( w(k,j,i) - w(k,j-1,i) ) * ddy 136 ( w(k,j,i) - w(k,j-1,i) ) * ddy & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 3 ) ) 133 139 ELSE 134 140 tend(k,j,i) = tend(k,j,i) - vkomp * & 135 ( w(k,j+1,i) - w(k,j,i) ) * ddy 141 ( w(k,j+1,i) - w(k,j,i) ) * ddy & 142 * MERGE( 1.0_wp, 0.0_wp, & 143 BTEST( wall_flags_0(k,j,i), 3 ) ) 136 144 ENDIF 137 145 ! … … 139 147 IF ( w(k,j,i) > 0.0_wp ) THEN 140 148 tend(k,j,i) = tend(k,j,i) - w(k,j,i) * & 141 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) 149 ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) & 150 * MERGE( 1.0_wp, 0.0_wp, & 151 BTEST( wall_flags_0(k,j,i), 3 ) ) 142 152 ELSE 143 153 tend(k,j,i) = tend(k,j,i) - w(k,j,i) * & 144 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) 154 ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) & 155 * MERGE( 1.0_wp, 0.0_wp, & 156 BTEST( wall_flags_0(k,j,i), 3 ) ) 145 157 ENDIF 146 158 … … 169 181 170 182 USE indices, & 171 ONLY: nzb _w_inner, nzt183 ONLY: nzb, nzt, wall_flags_0 172 184 173 185 USE kinds … … 184 196 185 197 186 DO k = nzb _w_inner(j,i)+1, nzt-1198 DO k = nzb+1, nzt-1 187 199 ! 188 200 !-- x-direction -
palm/trunk/SOURCE/advec_ws.f90
r2201 r2232 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Rename wall_flags_0 and wall_flags_00 into advc_flags_1 and advc_flags_2, 23 ! respectively. 24 ! Set advc_flags_1/2 on basis of wall_flags_0/00 instead of nzb_s/u/v/w_inner. 25 ! Setting advc_flags_1/2 also for downward-facing walls 23 26 ! 24 27 ! Former revisions: … … 147 150 ! vector version. 148 151 ! Degradation of the applied order of scheme is now steered by multiplying with 149 ! Integer wall_flags_0. 2nd order scheme, WS3 and WS5 are calculated on each152 ! Integer advc_flags_1. 2nd order scheme, WS3 and WS5 are calculated on each 150 153 ! grid point and mulitplied with the appropriate flag. 151 154 ! 2nd order numerical dissipation term changed. Now the appropriate 2nd order … … 406 409 407 410 USE indices, & 408 ONLY: nbgp, nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzb_s_inner, & 409 nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt, wall_flags_0, & 410 wall_flags_00 411 ONLY: advc_flags_1, advc_flags_2, nbgp, nxl, nxlu, nxr, nyn, nys, & 412 nysv, nzb, nzt, wall_flags_0 411 413 412 414 USE kinds … … 414 416 IMPLICIT NONE 415 417 416 INTEGER(iwp) :: i !< index variable along x 417 INTEGER(iwp) :: j !< index variable along y 418 INTEGER(iwp) :: k !< index variable along z 419 418 INTEGER(iwp) :: i !< index variable along x 419 INTEGER(iwp) :: j !< index variable along y 420 INTEGER(iwp) :: k !< index variable along z 421 INTEGER(iwp) :: k_mm !< dummy index along z 422 INTEGER(iwp) :: k_pp !< dummy index along z 423 INTEGER(iwp) :: k_ppp !< dummy index along z 424 420 425 LOGICAL :: flag_set !< steering variable for advection flags 421 426 … … 425 430 !-- Set flags to steer the degradation of the advection scheme in advec_ws 426 431 !-- near topography, inflow- and outflow boundaries as well as bottom and 427 !-- top of model domain. wall_flags_0remains zero for all non-prognostic432 !-- top of model domain. advc_flags_1 remains zero for all non-prognostic 428 433 !-- grid points. 429 434 DO i = nxl, nxr 430 435 DO j = nys, nyn 431 DO k = nzb _s_inner(j,i)+1, nzt436 DO k = nzb+1, nzt 432 437 ! 433 438 !-- scalar - x-direction 434 439 !-- WS1 (0), WS3 (1), WS5 (2) 435 IF ( ( k <= nzb_s_inner(j,i+1) .OR. k <= nzb_s_inner(j,i+2) & 436 .OR. k <= nzb_s_inner(j,i-1) ) & 437 .OR. ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 438 .AND. i == nxl ) .OR. & 440 IF ( ( .NOT. BTEST(wall_flags_0(k,j,i+1),0) & 441 .OR. .NOT. BTEST(wall_flags_0(k,j,i+2),0) & 442 .OR. .NOT. BTEST(wall_flags_0(k,j,i-1),0) ) & 443 .OR. ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 444 .AND. i == nxl ) & 445 .OR. ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 446 .AND. i == nxr ) ) & 447 THEN 448 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 0 ) 449 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+3),0) & 450 .AND. BTEST(wall_flags_0(k,j,i+1),0) & 451 .AND. BTEST(wall_flags_0(k,j,i+2),0) & 452 .AND. BTEST(wall_flags_0(k,j,i-1),0) & 453 ) .OR. & 454 ( .NOT. BTEST(wall_flags_0(k,j,i-2),0) & 455 .AND. BTEST(wall_flags_0(k,j,i+1),0) & 456 .AND. BTEST(wall_flags_0(k,j,i+2),0) & 457 .AND. BTEST(wall_flags_0(k,j,i-1),0) & 458 ) & 459 .OR. & 439 460 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 440 .AND. i == nxr ) ) & 461 .AND. i == nxr-1 ) .OR. & 462 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 463 .AND. i == nxlu ) ) & 441 464 THEN 442 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 ) 443 ELSEIF ( ( k <= nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i+1)& 444 .AND. k > nzb_s_inner(j,i+2)& 445 .AND. k > nzb_s_inner(j,i-1)& 446 ) .OR. & 447 ( k <= nzb_s_inner(j,i-2) .AND. k > nzb_s_inner(j,i+1)& 448 .AND. k > nzb_s_inner(j,i+2)& 449 .AND. k > nzb_s_inner(j,i-1)& 450 ) & 451 .OR. & 452 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 453 .AND. i == nxr-1 ) .OR. & 454 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 455 .AND. i == nxlu ) ) & 456 THEN 457 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 ) 458 ELSEIF ( k > nzb_s_inner(j,i+1) .AND. k > nzb_s_inner(j,i+2)& 459 .AND. k > nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i-1)& 460 .AND. k > nzb_s_inner(j,i-2) ) & 465 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 1 ) 466 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),0) & 467 .AND. BTEST(wall_flags_0(k,j,i+2),0) & 468 .AND. BTEST(wall_flags_0(k,j,i+3),0) & 469 .AND. BTEST(wall_flags_0(k,j,i-1),0) & 470 .AND. BTEST(wall_flags_0(k,j,i-2),0) ) & 461 471 THEN 462 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )472 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 2 ) 463 473 ENDIF 464 474 ! 465 475 !-- scalar - y-direction 466 476 !-- WS1 (3), WS3 (4), WS5 (5) 467 IF ( ( k <= nzb_s_inner(j+1,i) .OR. k <= nzb_s_inner(j+2,i) &468 .OR. k <= nzb_s_inner(j-1,i) ) &469 .OR.&470 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )&471 .AND. j == nys ) .OR.&472 ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )&473 .AND. j == nyn ) )&477 IF ( ( .NOT. BTEST(wall_flags_0(k,j+1,i),0) & 478 .OR. .NOT. BTEST(wall_flags_0(k,j+2,i),0) & 479 .OR. .NOT. BTEST(wall_flags_0(k,j-1,i),0)) & 480 .OR. ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 481 .AND. j == nys ) & 482 .OR. ( ( inflow_n .OR. outflow_n .OR. nest_bound_n ) & 483 .AND. j == nyn ) ) & 474 484 THEN 475 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )485 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 3 ) 476 486 ! 477 487 !-- WS3 478 ELSEIF ( ( k <= nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j+1,i)& 479 .AND. k > nzb_s_inner(j+2,i)& 480 .AND. k > nzb_s_inner(j-1,i)& 481 ) .OR. & 482 ( k <= nzb_s_inner(j-2,i) .AND. k > nzb_s_inner(j+1,i)& 483 .AND. k > nzb_s_inner(j+2,i)& 484 .AND. k > nzb_s_inner(j-1,i)& 485 ) & 486 .OR. & 487 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 488 .AND. j == nysv ) .OR. & 489 ( ( inflow_n .OR. outflow_n .OR. nest_bound_n ) & 490 .AND. j == nyn-1 ) ) & 488 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+3,i),0) & 489 .AND. BTEST(wall_flags_0(k,j+1,i),0) & 490 .AND. BTEST(wall_flags_0(k,j+2,i),0) & 491 .AND. BTEST(wall_flags_0(k,j-1,i),0) & 492 ) .OR. & 493 ( .NOT. BTEST(wall_flags_0(k,j-2,i),0) & 494 .AND. BTEST(wall_flags_0(k,j+1,i),0) & 495 .AND. BTEST(wall_flags_0(k,j+2,i),0) & 496 .AND. BTEST(wall_flags_0(k,j-1,i),0) & 497 ) & 498 .OR. & 499 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 500 .AND. j == nysv ) .OR. & 501 ( ( inflow_n .OR. outflow_n .OR. nest_bound_n ) & 502 .AND. j == nyn-1 ) ) & 491 503 THEN 492 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 4 )504 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 4 ) 493 505 ! 494 506 !-- WS5 495 ELSEIF ( k > nzb_s_inner(j+1,i) .AND. k > nzb_s_inner(j+2,i)& 496 .AND. k > nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j-1,i)& 497 .AND. k > nzb_s_inner(j-2,i) ) & 507 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),0) & 508 .AND. BTEST(wall_flags_0(k,j+2,i),0) & 509 .AND. BTEST(wall_flags_0(k,j+3,i),0) & 510 .AND. BTEST(wall_flags_0(k,j-1,i),0) & 511 .AND. BTEST(wall_flags_0(k,j-2,i),0) ) & 498 512 THEN 499 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 5 )513 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 5 ) 500 514 ENDIF 501 515 ! 502 516 !-- scalar - z-direction 503 517 !-- WS1 (6), WS3 (7), WS5 (8) 518 IF ( k == nzb+1 ) THEN 519 k_mm = nzb 520 ELSE 521 k_mm = k - 2 522 ENDIF 523 IF ( k > nzt-1 ) THEN 524 k_pp = nzt+1 525 ELSE 526 k_pp = k + 2 527 ENDIF 528 IF ( k > nzt-2 ) THEN 529 k_ppp = nzt+1 530 ELSE 531 k_ppp = k + 3 532 ENDIF 533 504 534 flag_set = .FALSE. 505 IF ( k == nzb_s_inner(j,i) + 1 .OR. k == nzt ) THEN 506 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 6 ) 535 IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),0) .AND. & 536 BTEST(wall_flags_0(k,j,i),0) .OR. & 537 .NOT. BTEST(wall_flags_0(k_pp,j,i),0) .AND. & 538 BTEST(wall_flags_0(k,j,i),0) .OR. & 539 k == nzt ) & 540 THEN 541 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 6 ) 507 542 flag_set = .TRUE. 508 ELSEIF ( k == nzb_s_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 509 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 7 ) 543 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),0) .OR. & 544 .NOT. BTEST(wall_flags_0(k_ppp,j,i),0) ) .AND. & 545 BTEST(wall_flags_0(k-1,j,i),0) .AND. & 546 BTEST(wall_flags_0(k,j,i),0) .AND. & 547 BTEST(wall_flags_0(k+1,j,i),0) .AND. & 548 BTEST(wall_flags_0(k_pp,j,i),0) .OR. & 549 k == nzt - 1 ) & 550 THEN 551 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 7 ) 510 552 flag_set = .TRUE. 511 ELSEIF ( k > nzb_s_inner(j,i) .AND. .NOT. flag_set ) THEN 512 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 ) 553 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),0) & 554 .AND. BTEST(wall_flags_0(k-1,j,i),0) & 555 .AND. BTEST(wall_flags_0(k,j,i),0) & 556 .AND. BTEST(wall_flags_0(k+1,j,i),0) & 557 .AND. BTEST(wall_flags_0(k_pp,j,i),0) & 558 .AND. BTEST(wall_flags_0(k_ppp,j,i),0) & 559 .AND. .NOT. flag_set ) & 560 THEN 561 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 8 ) 513 562 ENDIF 514 563 … … 520 569 IF ( momentum_advec == 'ws-scheme' ) THEN 521 570 ! 522 !-- Set wall_flags_0to steer the degradation of the advection scheme in advec_ws571 !-- Set advc_flags_1 to steer the degradation of the advection scheme in advec_ws 523 572 !-- near topography, inflow- and outflow boundaries as well as bottom and 524 !-- top of model domain. wall_flags_0remains zero for all non-prognostic573 !-- top of model domain. advc_flags_1 remains zero for all non-prognostic 525 574 !-- grid points. 526 575 DO i = nxl, nxr … … 532 581 !-- in order to handle the left/south flux. 533 582 !-- near vertical walls. 534 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )535 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )583 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 9 ) 584 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 12 ) 536 585 ! 537 586 !-- u component - x-direction 538 587 !-- WS1 (9), WS3 (10), WS5 (11) 539 IF ( k <= nzb_u_inner(j,i+1) .OR.&588 IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),1) .OR. & 540 589 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 541 590 .AND. i <= nxlu ) .OR. & … … 543 592 .AND. i == nxr ) ) & 544 593 THEN 545 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )546 ELSEIF ( ( k <= nzb_u_inner(j,i+2) .AND.&547 k > nzb_u_inner(j,i+1) ) .OR.&548 k <= nzb_u_inner(j,i-1)&594 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 9 ) 595 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),1) .AND. & 596 BTEST(wall_flags_0(k,j,i+1),1) .OR. & 597 .NOT. BTEST(wall_flags_0(k,j,i-1),1) ) & 549 598 .OR. & 550 599 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 553 602 .AND. i == nxlu+1) ) & 554 603 THEN 555 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 10 )604 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 10 ) 556 605 ! 557 606 !-- Clear flag for WS1 558 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 ) 559 ELSEIF ( k > nzb_u_inner(j,i+1) .AND. k > nzb_u_inner(j,i+2) & 560 .AND. k > nzb_u_inner(j,i-1) ) & 607 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 9 ) 608 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),1) .AND. & 609 BTEST(wall_flags_0(k,j,i+2),1) .AND. & 610 BTEST(wall_flags_0(k,j,i-1),1) ) & 561 611 THEN 562 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 11 )612 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 11 ) 563 613 ! 564 614 !-- Clear flag for WS1 565 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 )615 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 9 ) 566 616 ENDIF 567 617 ! 568 618 !-- u component - y-direction 569 619 !-- WS1 (12), WS3 (13), WS5 (14) 570 IF ( k <= nzb_u_inner(j+1,i) .OR.&620 IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),1) .OR. & 571 621 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 572 622 .AND. j == nys ) .OR. & … … 574 624 .AND. j == nyn ) ) & 575 625 THEN 576 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )577 ELSEIF ( ( k <= nzb_u_inner(j+2,i) .AND.&578 k > nzb_u_inner(j+1,i) ) .OR.&579 k <= nzb_u_inner(j-1,i)&626 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 12 ) 627 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),1) .AND. & 628 BTEST(wall_flags_0(k,j+1,i),1) .OR. & 629 .NOT. BTEST(wall_flags_0(k,j-1,i),1) ) & 580 630 .OR. & 581 631 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & … … 584 634 .AND. j == nyn-1 ) ) & 585 635 THEN 586 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 )636 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 13 ) 587 637 ! 588 638 !-- Clear flag for WS1 589 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 ) 590 ELSEIF ( k > nzb_u_inner(j+1,i) .AND. k > nzb_u_inner(j+2,i) & 591 .AND. k > nzb_u_inner(j-1,i) ) & 639 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 12 ) 640 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),1) .AND. & 641 BTEST(wall_flags_0(k,j+2,i),1) .AND. & 642 BTEST(wall_flags_0(k,j-1,i),1) ) & 592 643 THEN 593 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 )644 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 14 ) 594 645 ! 595 646 !-- Clear flag for WS1 596 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 )647 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 12 ) 597 648 ENDIF 598 649 ! 599 650 !-- u component - z-direction 600 651 !-- WS1 (15), WS3 (16), WS5 (17) 652 IF ( k == nzb+1 ) THEN 653 k_mm = nzb 654 ELSE 655 k_mm = k - 2 656 ENDIF 657 IF ( k > nzt-1 ) THEN 658 k_pp = nzt+1 659 ELSE 660 k_pp = k + 2 661 ENDIF 662 IF ( k > nzt-2 ) THEN 663 k_ppp = nzt+1 664 ELSE 665 k_ppp = k + 3 666 ENDIF 667 601 668 flag_set = .FALSE. 602 IF ( k == nzb_u_inner(j,i) + 1 .OR. k == nzt ) THEN 603 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 15 ) 669 IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),1) .AND. & 670 BTEST(wall_flags_0(k,j,i),1) .OR. & 671 .NOT. BTEST(wall_flags_0(k_pp,j,i),1) .AND. & 672 BTEST(wall_flags_0(k,j,i),1) .OR. & 673 k == nzt ) & 674 THEN 675 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 15 ) 676 flag_set = .TRUE. 677 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),1) .OR. & 678 .NOT. BTEST(wall_flags_0(k_ppp,j,i),1) ) .AND. & 679 BTEST(wall_flags_0(k-1,j,i),1) .AND. & 680 BTEST(wall_flags_0(k,j,i),1) .AND. & 681 BTEST(wall_flags_0(k+1,j,i),1) .AND. & 682 BTEST(wall_flags_0(k_pp,j,i),1) .OR. & 683 k == nzt - 1 ) & 684 THEN 685 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 16 ) 604 686 flag_set = .TRUE. 605 ELSEIF ( k == nzb_u_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 606 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 16 ) 607 flag_set = .TRUE. 608 ELSEIF ( k > nzb_u_inner(j,i) .AND. .NOT. flag_set ) THEN 609 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 17 ) 687 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),1) .AND. & 688 BTEST(wall_flags_0(k-1,j,i),1) .AND. & 689 BTEST(wall_flags_0(k,j,i),1) .AND. & 690 BTEST(wall_flags_0(k+1,j,i),1) .AND. & 691 BTEST(wall_flags_0(k_pp,j,i),1) .AND. & 692 BTEST(wall_flags_0(k_ppp,j,i),1) .AND. & 693 .NOT. flag_set ) & 694 THEN 695 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 17 ) 610 696 ENDIF 611 697 … … 621 707 !-- Since fluxes are swapped in advec_ws.f90, this is necessary to 622 708 !-- in order to handle the left/south flux. 623 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )624 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )709 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 18 ) 710 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 21 ) 625 711 ! 626 712 !-- v component - x-direction 627 713 !-- WS1 (18), WS3 (19), WS5 (20) 628 IF ( k <= nzb_v_inner(j,i+1) .OR.&714 IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),2) .OR. & 629 715 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 630 716 .AND. i == nxl ) .OR. & … … 632 718 .AND. i == nxr ) ) & 633 719 THEN 634 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )720 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 18 ) 635 721 ! 636 722 !-- WS3 637 ELSEIF ( ( k <= nzb_v_inner(j,i+2) .AND.&638 k > nzb_v_inner(j,i+1) ) .OR.&639 k <= nzb_v_inner(j,i-1)&723 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),2) .AND. & 724 BTEST(wall_flags_0(k,j,i+1),2) ) .OR. & 725 .NOT. BTEST(wall_flags_0(k,j,i-1),2) & 640 726 .OR. & 641 727 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 644 730 .AND. i == nxlu ) ) & 645 731 THEN 646 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 19 )732 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 19 ) 647 733 ! 648 734 !-- Clear flag for WS1 649 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 ) 650 ELSEIF ( k > nzb_v_inner(j,i+1) .AND. k > nzb_v_inner(j,i+2) & 651 .AND. k > nzb_v_inner(j,i-1) ) & 735 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 18 ) 736 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),2) .AND. & 737 BTEST(wall_flags_0(k,j,i+2),2) .AND. & 738 BTEST(wall_flags_0(k,j,i-1),2) ) & 652 739 THEN 653 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 20 )740 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 20 ) 654 741 ! 655 742 !-- Clear flag for WS1 656 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 )743 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 18 ) 657 744 ENDIF 658 745 ! 659 746 !-- v component - y-direction 660 747 !-- WS1 (21), WS3 (22), WS5 (23) 661 IF ( k <= nzb_v_inner(j+1,i) .OR.&748 IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),2) .OR. & 662 749 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 663 750 .AND. j <= nysv ) .OR. & … … 665 752 .AND. j == nyn ) ) & 666 753 THEN 667 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )668 ELSEIF ( ( k <= nzb_v_inner(j+2,i) .AND.&669 k > nzb_v_inner(j+1,i) ) .OR.&670 k <= nzb_v_inner(j-1,i)&754 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 21 ) 755 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),2) .AND. & 756 BTEST(wall_flags_0(k,j+1,i),2) .OR. & 757 .NOT. BTEST(wall_flags_0(k,j-1,i),2) ) & 671 758 .OR. & 672 759 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & … … 675 762 .AND. j == nyn-1 ) ) & 676 763 THEN 677 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )764 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 22 ) 678 765 ! 679 766 !-- Clear flag for WS1 680 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 ) 681 ELSEIF ( k > nzb_v_inner(j+1,i) .AND. k > nzb_v_inner(j+2,i) & 682 .AND. k > nzb_v_inner(j-1,i) ) & 767 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 21 ) 768 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),2) .AND. & 769 BTEST(wall_flags_0(k,j+2,i),2) .AND. & 770 BTEST(wall_flags_0(k,j-1,i),2) ) & 683 771 THEN 684 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )772 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 23 ) 685 773 ! 686 774 !-- Clear flag for WS1 687 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 )775 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 21 ) 688 776 ENDIF 689 777 ! 690 778 !-- v component - z-direction 691 779 !-- WS1 (24), WS3 (25), WS5 (26) 780 IF ( k == nzb+1 ) THEN 781 k_mm = nzb 782 ELSE 783 k_mm = k - 2 784 ENDIF 785 IF ( k > nzt-1 ) THEN 786 k_pp = nzt+1 787 ELSE 788 k_pp = k + 2 789 ENDIF 790 IF ( k > nzt-2 ) THEN 791 k_ppp = nzt+1 792 ELSE 793 k_ppp = k + 3 794 ENDIF 795 692 796 flag_set = .FALSE. 693 IF ( k == nzb_v_inner(j,i) + 1 .OR. k == nzt ) THEN 694 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 ) 797 IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),2) .AND. & 798 BTEST(wall_flags_0(k,j,i),2) .OR. & 799 .NOT. BTEST(wall_flags_0(k_pp,j,i),2) .AND. & 800 BTEST(wall_flags_0(k,j,i),2) .OR. & 801 k == nzt ) & 802 THEN 803 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 24 ) 695 804 flag_set = .TRUE. 696 ELSEIF ( k == nzb_v_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 697 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 25 ) 805 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),2) .OR. & 806 .NOT. BTEST(wall_flags_0(k_ppp,j,i),2) ) .AND. & 807 BTEST(wall_flags_0(k-1,j,i),2) .AND. & 808 BTEST(wall_flags_0(k,j,i),2) .AND. & 809 BTEST(wall_flags_0(k+1,j,i),2) .AND. & 810 BTEST(wall_flags_0(k_pp,j,i),2) .OR. & 811 k == nzt - 1 ) & 812 THEN 813 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 25 ) 698 814 flag_set = .TRUE. 699 ELSEIF ( k > nzb_v_inner(j,i) .AND. .NOT. flag_set ) THEN 700 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 26 ) 815 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),2) .AND. & 816 BTEST(wall_flags_0(k-1,j,i),2) .AND. & 817 BTEST(wall_flags_0(k,j,i),2) .AND. & 818 BTEST(wall_flags_0(k+1,j,i),2) .AND. & 819 BTEST(wall_flags_0(k_pp,j,i),2) .AND. & 820 BTEST(wall_flags_0(k_ppp,j,i),2) .AND. & 821 .NOT. flag_set ) & 822 THEN 823 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 26 ) 701 824 ENDIF 702 825 … … 711 834 !-- Since fluxes are swapped in advec_ws.f90, this is necessary to 712 835 !-- in order to handle the left/south flux. 713 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )714 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )836 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 27 ) 837 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 30 ) 715 838 ! 716 839 !-- w component - x-direction 717 840 !-- WS1 (27), WS3 (28), WS5 (29) 718 IF ( k <= nzb_w_inner(j,i+1) .OR.&841 IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),3) .OR. & 719 842 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 720 843 .AND. i == nxl ) .OR. & … … 722 845 .AND. i == nxr ) ) & 723 846 THEN 724 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )725 ELSEIF ( ( k <= nzb_w_inner(j,i+2) .AND.&726 k > nzb_w_inner(j,i+1) ) .OR.&727 k <= nzb_w_inner(j,i-1)&847 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 27 ) 848 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),3) .AND. & 849 BTEST(wall_flags_0(k,j,i+1),3) .OR. & 850 .NOT. BTEST(wall_flags_0(k,j,i-1),3) ) & 728 851 .OR. & 729 852 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 732 855 .AND. i == nxlu ) ) & 733 856 THEN 734 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 28 )857 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 28 ) 735 858 ! 736 859 !-- Clear flag for WS1 737 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 ) 738 ELSEIF ( k > nzb_w_inner(j,i+1) .AND. k > nzb_w_inner(j,i+2) & 739 .AND. k > nzb_w_inner(j,i-1) ) & 860 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 27 ) 861 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),3) .AND. & 862 BTEST(wall_flags_0(k,j,i+2),3) .AND. & 863 BTEST(wall_flags_0(k,j,i-1),3) ) & 740 864 THEN 741 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i),29 )865 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i),29 ) 742 866 ! 743 867 !-- Clear flag for WS1 744 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 )868 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 27 ) 745 869 ENDIF 746 870 ! 747 871 !-- w component - y-direction 748 872 !-- WS1 (30), WS3 (31), WS5 (32) 749 IF ( k <= nzb_w_inner(j+1,i) .OR.&873 IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),3) .OR. & 750 874 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 751 875 .AND. j == nys ) .OR. & … … 753 877 .AND. j == nyn ) ) & 754 878 THEN 755 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )756 ELSEIF ( ( k <= nzb_w_inner(j+2,i) .AND.&757 k > nzb_w_inner(j+1,i) ) .OR.&758 k <= nzb_w_inner(j-1,i)&879 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 30 ) 880 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),3) .AND. & 881 BTEST(wall_flags_0(k,j+1,i),3) .OR. & 882 .NOT. BTEST(wall_flags_0(k,j-1,i),3) ) & 759 883 .OR. & 760 884 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & … … 763 887 .AND. j == nyn-1 ) ) & 764 888 THEN 765 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 31 )889 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 31 ) 766 890 ! 767 891 !-- Clear flag for WS1 768 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 ) 769 ELSEIF ( k > nzb_w_inner(j+1,i) .AND. k > nzb_w_inner(j+2,i) & 770 .AND. k > nzb_w_inner(j-1,i) ) & 892 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 30 ) 893 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),3) .AND. & 894 BTEST(wall_flags_0(k,j+2,i),3) .AND. & 895 BTEST(wall_flags_0(k,j-1,i),3) ) & 771 896 THEN 772 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 0 )897 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 0 ) 773 898 ! 774 899 !-- Clear flag for WS1 775 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 )900 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 30 ) 776 901 ENDIF 777 902 ! … … 779 904 !-- WS1 (33), WS3 (34), WS5 (35) 780 905 flag_set = .FALSE. 781 IF ( k == nzb_w_inner(j,i) .OR. k == nzb_w_inner(j,i) + 1 & 782 .OR. k == nzt ) THEN 906 IF ( k == nzb+1 ) THEN 907 k_mm = nzb 908 ELSE 909 k_mm = k - 2 910 ENDIF 911 IF ( k > nzt-1 ) THEN 912 k_pp = nzt+1 913 ELSE 914 k_pp = k + 2 915 ENDIF 916 IF ( k > nzt-2 ) THEN 917 k_ppp = nzt+1 918 ELSE 919 k_ppp = k + 3 920 ENDIF 921 922 IF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 923 .NOT. BTEST(wall_flags_0(k,j,i),3) .AND. & 924 BTEST(wall_flags_0(k+1,j,i),3) ) .OR. & 925 ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 926 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 927 ( .NOT. BTEST(wall_flags_0(k+1,j,i),3) .AND. & 928 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 929 k == nzt ) & 930 THEN 783 931 ! 784 932 !-- Please note, at k == nzb_w_inner(j,i) a flag is explictely … … 787 935 !-- because flux_t(nzb_w_inner(j,i)) is used for the tendency 788 936 !-- at k == nzb_w_inner(j,i)+1. 789 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 1 )937 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 1 ) 790 938 flag_set = .TRUE. 791 ELSEIF ( k == nzb_w_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 792 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 2 ) 939 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),3) .OR. & 940 .NOT. BTEST(wall_flags_0(k_ppp,j,i),3) ) .AND. & 941 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 942 BTEST(wall_flags_0(k,j,i),3) .AND. & 943 BTEST(wall_flags_0(k+1,j,i),3) .OR. & 944 k == nzt - 1 ) & 945 THEN 946 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 2 ) 793 947 flag_set = .TRUE. 794 ELSEIF ( k > nzb_w_inner(j,i) .AND. .NOT. flag_set ) THEN 795 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 3 ) 948 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),3) .AND. & 949 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 950 BTEST(wall_flags_0(k,j,i),3) .AND. & 951 BTEST(wall_flags_0(k+1,j,i),3) .AND. & 952 BTEST(wall_flags_0(k_pp,j,i),3) .AND. & 953 BTEST(wall_flags_0(k_ppp,j,i),3) .AND. & 954 .NOT. flag_set ) & 955 THEN 956 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 3 ) 796 957 ENDIF 797 958 … … 809 970 ! 810 971 !-- Exchange ghost points for advection flags 811 CALL exchange_horiz_int( wall_flags_0,nbgp )812 CALL exchange_horiz_int( wall_flags_00, nbgp )972 CALL exchange_horiz_int( advc_flags_1, nbgp ) 973 CALL exchange_horiz_int( advc_flags_2, nbgp ) 813 974 ! 814 975 !-- Set boundary flags at inflow and outflow boundary in case of 815 976 !-- non-cyclic boundary conditions. 816 977 IF ( inflow_l .OR. outflow_l .OR. nest_bound_l ) THEN 817 wall_flags_0(:,:,nxl-1) = wall_flags_0(:,:,nxl)818 wall_flags_00(:,:,nxl-1) = wall_flags_00(:,:,nxl)978 advc_flags_1(:,:,nxl-1) = advc_flags_1(:,:,nxl) 979 advc_flags_2(:,:,nxl-1) = advc_flags_2(:,:,nxl) 819 980 ENDIF 820 981 821 982 IF ( inflow_r .OR. outflow_r .OR. nest_bound_r ) THEN 822 wall_flags_0(:,:,nxr+1) = wall_flags_0(:,:,nxr)823 wall_flags_00(:,:,nxr+1) = wall_flags_00(:,:,nxr)983 advc_flags_1(:,:,nxr+1) = advc_flags_1(:,:,nxr) 984 advc_flags_2(:,:,nxr+1) = advc_flags_2(:,:,nxr) 824 985 ENDIF 825 986 826 987 IF ( inflow_n .OR. outflow_n .OR. nest_bound_n ) THEN 827 wall_flags_0(:,nyn+1,:) = wall_flags_0(:,nyn,:)828 wall_flags_00(:,nyn+1,:) = wall_flags_00(:,nyn,:)988 advc_flags_1(:,nyn+1,:) = advc_flags_1(:,nyn,:) 989 advc_flags_2(:,nyn+1,:) = advc_flags_2(:,nyn,:) 829 990 ENDIF 830 991 831 992 IF ( inflow_s .OR. outflow_s .OR. nest_bound_s ) THEN 832 wall_flags_0(:,nys-1,:) = wall_flags_0(:,nys,:)833 wall_flags_00(:,nys-1,:) = wall_flags_00(:,nys,:)993 advc_flags_1(:,nys-1,:) = advc_flags_1(:,nys,:) 994 advc_flags_2(:,nys-1,:) = advc_flags_2(:,nys,:) 834 995 ENDIF 835 996 … … 910 1071 USE indices, & 911 1072 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, & 912 nzt, wall_flags_01073 nzt, advc_flags_1 913 1074 914 1075 USE kinds … … 976 1137 DO k = nzb+1, nzb_max 977 1138 978 ibit5 = IBITS( wall_flags_0(k,j-1,i),5,1)979 ibit4 = IBITS( wall_flags_0(k,j-1,i),4,1)980 ibit3 = IBITS( wall_flags_0(k,j-1,i),3,1)1139 ibit5 = IBITS(advc_flags_1(k,j-1,i),5,1) 1140 ibit4 = IBITS(advc_flags_1(k,j-1,i),4,1) 1141 ibit3 = IBITS(advc_flags_1(k,j-1,i),3,1) 981 1142 982 1143 v_comp = v(k,j,i) - v_gtrans … … 1037 1198 DO k = nzb+1, nzb_max 1038 1199 1039 ibit2 = IBITS( wall_flags_0(k,j,i-1),2,1)1040 ibit1 = IBITS( wall_flags_0(k,j,i-1),1,1)1041 ibit0 = IBITS( wall_flags_0(k,j,i-1),0,1)1200 ibit2 = IBITS(advc_flags_1(k,j,i-1),2,1) 1201 ibit1 = IBITS(advc_flags_1(k,j,i-1),1,1) 1202 ibit0 = IBITS(advc_flags_1(k,j,i-1),0,1) 1042 1203 1043 1204 u_comp = u(k,j,i) - u_gtrans … … 1106 1267 !-- flux at the end. 1107 1268 1108 ibit2 = IBITS( wall_flags_0(k,j,i),2,1)1109 ibit1 = IBITS( wall_flags_0(k,j,i),1,1)1110 ibit0 = IBITS( wall_flags_0(k,j,i),0,1)1269 ibit2 = IBITS(advc_flags_1(k,j,i),2,1) 1270 ibit1 = IBITS(advc_flags_1(k,j,i),1,1) 1271 ibit0 = IBITS(advc_flags_1(k,j,i),0,1) 1111 1272 1112 1273 u_comp = u(k,j,i+1) - u_gtrans … … 1141 1302 ) 1142 1303 1143 ibit5 = IBITS( wall_flags_0(k,j,i),5,1)1144 ibit4 = IBITS( wall_flags_0(k,j,i),4,1)1145 ibit3 = IBITS( wall_flags_0(k,j,i),3,1)1304 ibit5 = IBITS(advc_flags_1(k,j,i),5,1) 1305 ibit4 = IBITS(advc_flags_1(k,j,i),4,1) 1306 ibit3 = IBITS(advc_flags_1(k,j,i),3,1) 1146 1307 1147 1308 v_comp = v(k,j+1,i) - v_gtrans … … 1178 1339 !-- k index has to be modified near bottom and top, else array 1179 1340 !-- subscripts will be exceeded. 1180 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)1181 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)1182 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)1341 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 1342 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 1343 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 1183 1344 1184 1345 k_ppp = k + 3 * ibit8 … … 1220 1381 !-- by a not sufficient reduction of divergences near topography. 1221 1382 div = ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 ) & 1222 - u(k,j,i) * ( IBITS( wall_flags_0(k,j,i-1),0,1) &1223 + IBITS( wall_flags_0(k,j,i-1),1,1) &1224 + IBITS( wall_flags_0(k,j,i-1),2,1) &1383 - u(k,j,i) * ( IBITS(advc_flags_1(k,j,i-1),0,1) & 1384 + IBITS(advc_flags_1(k,j,i-1),1,1) & 1385 + IBITS(advc_flags_1(k,j,i-1),2,1) & 1225 1386 ) & 1226 1387 ) * rho_air(k) * ddx & 1227 1388 + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 ) & 1228 - v(k,j,i) * ( IBITS( wall_flags_0(k,j-1,i),3,1) &1229 + IBITS( wall_flags_0(k,j-1,i),4,1) &1230 + IBITS( wall_flags_0(k,j-1,i),5,1) &1389 - v(k,j,i) * ( IBITS(advc_flags_1(k,j-1,i),3,1) & 1390 + IBITS(advc_flags_1(k,j-1,i),4,1) & 1391 + IBITS(advc_flags_1(k,j-1,i),5,1) & 1231 1392 ) & 1232 1393 ) * rho_air(k) * ddy & … … 1234 1395 ( ibit6 + ibit7 + ibit8 ) & 1235 1396 - w(k-1,j,i) * rho_air_zw(k-1) * & 1236 ( IBITS( wall_flags_0(k-1,j,i),6,1) &1237 + IBITS( wall_flags_0(k-1,j,i),7,1) &1238 + IBITS( wall_flags_0(k-1,j,i),8,1) &1397 ( IBITS(advc_flags_1(k-1,j,i),6,1) & 1398 + IBITS(advc_flags_1(k-1,j,i),7,1) & 1399 + IBITS(advc_flags_1(k-1,j,i),8,1) & 1239 1400 ) & 1240 1401 ) * ddzw(k) … … 1287 1448 !-- k index has to be modified near bottom and top, else array 1288 1449 !-- subscripts will be exceeded. 1289 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)1290 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)1291 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)1450 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 1451 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 1452 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 1292 1453 1293 1454 k_ppp = k + 3 * ibit8 … … 1450 1611 1451 1612 USE indices, & 1452 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_01613 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1 1453 1614 1454 1615 USE kinds … … 1502 1663 DO k = nzb+1, nzb_max 1503 1664 1504 ibit14 = IBITS( wall_flags_0(k,j-1,i),14,1)1505 ibit13 = IBITS( wall_flags_0(k,j-1,i),13,1)1506 ibit12 = IBITS( wall_flags_0(k,j-1,i),12,1)1665 ibit14 = IBITS(advc_flags_1(k,j-1,i),14,1) 1666 ibit13 = IBITS(advc_flags_1(k,j-1,i),13,1) 1667 ibit12 = IBITS(advc_flags_1(k,j-1,i),12,1) 1507 1668 1508 1669 v_comp = v(k,j,i) + v(k,j,i-1) - gv … … 1560 1721 DO k = nzb+1, nzb_max 1561 1722 1562 ibit11 = IBITS( wall_flags_0(k,j,i-1),11,1)1563 ibit10 = IBITS( wall_flags_0(k,j,i-1),10,1)1564 ibit9 = IBITS( wall_flags_0(k,j,i-1),9,1)1723 ibit11 = IBITS(advc_flags_1(k,j,i-1),11,1) 1724 ibit10 = IBITS(advc_flags_1(k,j,i-1),10,1) 1725 ibit9 = IBITS(advc_flags_1(k,j,i-1),9,1) 1565 1726 1566 1727 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu … … 1622 1783 DO k = nzb+1, nzb_max 1623 1784 1624 ibit11 = IBITS( wall_flags_0(k,j,i),11,1)1625 ibit10 = IBITS( wall_flags_0(k,j,i),10,1)1626 ibit9 = IBITS( wall_flags_0(k,j,i),9,1)1785 ibit11 = IBITS(advc_flags_1(k,j,i),11,1) 1786 ibit10 = IBITS(advc_flags_1(k,j,i),10,1) 1787 ibit9 = IBITS(advc_flags_1(k,j,i),9,1) 1627 1788 1628 1789 u_comp(k) = u(k,j,i+1) + u(k,j,i) … … 1657 1818 ) 1658 1819 1659 ibit14 = IBITS( wall_flags_0(k,j,i),14,1)1660 ibit13 = IBITS( wall_flags_0(k,j,i),13,1)1661 ibit12 = IBITS( wall_flags_0(k,j,i),12,1)1820 ibit14 = IBITS(advc_flags_1(k,j,i),14,1) 1821 ibit13 = IBITS(advc_flags_1(k,j,i),13,1) 1822 ibit12 = IBITS(advc_flags_1(k,j,i),12,1) 1662 1823 1663 1824 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv … … 1694 1855 !-- k index has to be modified near bottom and top, else array 1695 1856 !-- subscripts will be exceeded. 1696 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)1697 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)1698 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)1857 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 1858 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 1859 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 1699 1860 1700 1861 k_ppp = k + 3 * ibit17 … … 1738 1899 div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 ) & 1739 1900 - ( u(k,j,i) + u(k,j,i-1) ) & 1740 * ( IBITS( wall_flags_0(k,j,i-1),9,1) &1741 + IBITS( wall_flags_0(k,j,i-1),10,1) &1742 + IBITS( wall_flags_0(k,j,i-1),11,1) &1901 * ( IBITS(advc_flags_1(k,j,i-1),9,1) & 1902 + IBITS(advc_flags_1(k,j,i-1),10,1) & 1903 + IBITS(advc_flags_1(k,j,i-1),11,1) & 1743 1904 ) & 1744 1905 ) * rho_air(k) * ddx & 1745 1906 + ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 ) & 1746 1907 - ( v(k,j,i) + v(k,j,i-1 ) ) & 1747 * ( IBITS( wall_flags_0(k,j-1,i),12,1) &1748 + IBITS( wall_flags_0(k,j-1,i),13,1) &1749 + IBITS( wall_flags_0(k,j-1,i),14,1) &1908 * ( IBITS(advc_flags_1(k,j-1,i),12,1) & 1909 + IBITS(advc_flags_1(k,j-1,i),13,1) & 1910 + IBITS(advc_flags_1(k,j-1,i),14,1) & 1750 1911 ) & 1751 1912 ) * rho_air(k) * ddy & 1752 1913 + ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) & 1753 1914 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 1754 * ( IBITS( wall_flags_0(k-1,j,i),15,1) &1755 + IBITS( wall_flags_0(k-1,j,i),16,1) &1756 + IBITS( wall_flags_0(k-1,j,i),17,1) &1915 * ( IBITS(advc_flags_1(k-1,j,i),15,1) & 1916 + IBITS(advc_flags_1(k-1,j,i),16,1) & 1917 + IBITS(advc_flags_1(k-1,j,i),17,1) & 1757 1918 ) & 1758 1919 ) * ddzw(k) & … … 1823 1984 !-- k index has to be modified near bottom and top, else array 1824 1985 !-- subscripts will be exceeded. 1825 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)1826 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)1827 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)1986 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 1987 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 1988 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 1828 1989 1829 1990 k_ppp = k + 3 * ibit17 … … 1942 2103 1943 2104 USE indices, & 1944 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_02105 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, advc_flags_1 1945 2106 1946 2107 USE kinds … … 1995 2156 DO k = nzb+1, nzb_max 1996 2157 1997 ibit20 = IBITS( wall_flags_0(k,j,i-1),20,1)1998 ibit19 = IBITS( wall_flags_0(k,j,i-1),19,1)1999 ibit18 = IBITS( wall_flags_0(k,j,i-1),18,1)2158 ibit20 = IBITS(advc_flags_1(k,j,i-1),20,1) 2159 ibit19 = IBITS(advc_flags_1(k,j,i-1),19,1) 2160 ibit18 = IBITS(advc_flags_1(k,j,i-1),18,1) 2000 2161 2001 2162 u_comp = u(k,j-1,i) + u(k,j,i) - gu … … 2053 2214 DO k = nzb+1, nzb_max 2054 2215 2055 ibit23 = IBITS( wall_flags_0(k,j-1,i),23,1)2056 ibit22 = IBITS( wall_flags_0(k,j-1,i),22,1)2057 ibit21 = IBITS( wall_flags_0(k,j-1,i),21,1)2216 ibit23 = IBITS(advc_flags_1(k,j-1,i),23,1) 2217 ibit22 = IBITS(advc_flags_1(k,j-1,i),22,1) 2218 ibit21 = IBITS(advc_flags_1(k,j-1,i),21,1) 2058 2219 2059 2220 v_comp_l = v(k,j,i) + v(k,j-1,i) - gv … … 2115 2276 DO k = nzb+1, nzb_max 2116 2277 2117 ibit20 = IBITS( wall_flags_0(k,j,i),20,1)2118 ibit19 = IBITS( wall_flags_0(k,j,i),19,1)2119 ibit18 = IBITS( wall_flags_0(k,j,i),18,1)2278 ibit20 = IBITS(advc_flags_1(k,j,i),20,1) 2279 ibit19 = IBITS(advc_flags_1(k,j,i),19,1) 2280 ibit18 = IBITS(advc_flags_1(k,j,i),18,1) 2120 2281 2121 2282 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu … … 2150 2311 ) 2151 2312 2152 ibit23 = IBITS( wall_flags_0(k,j,i),23,1)2153 ibit22 = IBITS( wall_flags_0(k,j,i),22,1)2154 ibit21 = IBITS( wall_flags_0(k,j,i),21,1)2313 ibit23 = IBITS(advc_flags_1(k,j,i),23,1) 2314 ibit22 = IBITS(advc_flags_1(k,j,i),22,1) 2315 ibit21 = IBITS(advc_flags_1(k,j,i),21,1) 2155 2316 2156 2317 … … 2188 2349 !-- k index has to be modified near bottom and top, else array 2189 2350 !-- subscripts will be exceeded. 2190 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)2191 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)2192 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)2351 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 2352 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 2353 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 2193 2354 2194 2355 k_ppp = k + 3 * ibit26 … … 2233 2394 * ( ibit18 + ibit19 + ibit20 ) & 2234 2395 - ( u(k,j-1,i) + u(k,j,i) ) & 2235 * ( IBITS( wall_flags_0(k,j,i-1),18,1) &2236 + IBITS( wall_flags_0(k,j,i-1),19,1) &2237 + IBITS( wall_flags_0(k,j,i-1),20,1) &2396 * ( IBITS(advc_flags_1(k,j,i-1),18,1) & 2397 + IBITS(advc_flags_1(k,j,i-1),19,1) & 2398 + IBITS(advc_flags_1(k,j,i-1),20,1) & 2238 2399 ) & 2239 2400 ) * rho_air(k) * ddx & … … 2241 2402 * ( ibit21 + ibit22 + ibit23 ) & 2242 2403 - ( v(k,j,i) + v(k,j-1,i) ) & 2243 * ( IBITS( wall_flags_0(k,j-1,i),21,1) &2244 + IBITS( wall_flags_0(k,j-1,i),22,1) &2245 + IBITS( wall_flags_0(k,j-1,i),23,1) &2404 * ( IBITS(advc_flags_1(k,j-1,i),21,1) & 2405 + IBITS(advc_flags_1(k,j-1,i),22,1) & 2406 + IBITS(advc_flags_1(k,j-1,i),23,1) & 2246 2407 ) & 2247 2408 ) * rho_air(k) * ddy & 2248 2409 + ( w_comp * rho_air_zw(k) * ( ibit24 + ibit25 + ibit26 ) & 2249 2410 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 2250 * ( IBITS( wall_flags_0(k-1,j,i),24,1) &2251 + IBITS( wall_flags_0(k-1,j,i),25,1) &2252 + IBITS( wall_flags_0(k-1,j,i),26,1) &2411 * ( IBITS(advc_flags_1(k-1,j,i),24,1) & 2412 + IBITS(advc_flags_1(k-1,j,i),25,1) & 2413 + IBITS(advc_flags_1(k-1,j,i),26,1) & 2253 2414 ) & 2254 2415 ) * ddzw(k) & … … 2324 2485 !-- k index has to be modified near bottom and top, else array 2325 2486 !-- subscripts will be exceeded. 2326 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)2327 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)2328 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)2487 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 2488 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 2489 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 2329 2490 2330 2491 k_ppp = k + 3 * ibit26 … … 2443 2604 2444 2605 USE indices, & 2445 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0, &2446 wall_flags_002606 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1, & 2607 advc_flags_2 2447 2608 2448 2609 USE kinds … … 2495 2656 2496 2657 DO k = nzb+1, nzb_max 2497 ibit32 = IBITS( wall_flags_00(k,j-1,i),0,1)2498 ibit31 = IBITS( wall_flags_0(k,j-1,i),31,1)2499 ibit30 = IBITS( wall_flags_0(k,j-1,i),30,1)2658 ibit32 = IBITS(advc_flags_2(k,j-1,i),0,1) 2659 ibit31 = IBITS(advc_flags_1(k,j-1,i),31,1) 2660 ibit30 = IBITS(advc_flags_1(k,j-1,i),30,1) 2500 2661 2501 2662 v_comp = v(k+1,j,i) + v(k,j,i) - gv … … 2553 2714 DO k = nzb+1, nzb_max 2554 2715 2555 ibit29 = IBITS( wall_flags_0(k,j,i-1),29,1)2556 ibit28 = IBITS( wall_flags_0(k,j,i-1),28,1)2557 ibit27 = IBITS( wall_flags_0(k,j,i-1),27,1)2716 ibit29 = IBITS(advc_flags_1(k,j,i-1),29,1) 2717 ibit28 = IBITS(advc_flags_1(k,j,i-1),28,1) 2718 ibit27 = IBITS(advc_flags_1(k,j,i-1),27,1) 2558 2719 2559 2720 u_comp = u(k+1,j,i) + u(k,j,i) - gu … … 2608 2769 !-- The lower flux has to be calculated explicetely for the tendency at 2609 2770 !-- the first w-level. For topography wall this is done implicitely by 2610 !-- wall_flags_0.2771 !-- advc_flags_1. 2611 2772 k = nzb + 1 2612 2773 w_comp = w(k,j,i) + w(k-1,j,i) … … 2620 2781 DO k = nzb+1, nzb_max 2621 2782 2622 ibit29 = IBITS( wall_flags_0(k,j,i),29,1)2623 ibit28 = IBITS( wall_flags_0(k,j,i),28,1)2624 ibit27 = IBITS( wall_flags_0(k,j,i),27,1)2783 ibit29 = IBITS(advc_flags_1(k,j,i),29,1) 2784 ibit28 = IBITS(advc_flags_1(k,j,i),28,1) 2785 ibit27 = IBITS(advc_flags_1(k,j,i),27,1) 2625 2786 2626 2787 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu … … 2655 2816 ) 2656 2817 2657 ibit32 = IBITS( wall_flags_00(k,j,i),0,1)2658 ibit31 = IBITS( wall_flags_0(k,j,i),31,1)2659 ibit30 = IBITS( wall_flags_0(k,j,i),30,1)2818 ibit32 = IBITS(advc_flags_2(k,j,i),0,1) 2819 ibit31 = IBITS(advc_flags_1(k,j,i),31,1) 2820 ibit30 = IBITS(advc_flags_1(k,j,i),30,1) 2660 2821 2661 2822 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv … … 2692 2853 !-- k index has to be modified near bottom and top, else array 2693 2854 !-- subscripts will be exceeded. 2694 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)2695 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)2696 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)2855 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 2856 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 2857 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 2697 2858 2698 2859 k_ppp = k + 3 * ibit35 … … 2737 2898 div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 ) & 2738 2899 - ( u(k+1,j,i) + u(k,j,i) ) & 2739 * ( IBITS( wall_flags_0(k,j,i-1),27,1) &2740 + IBITS( wall_flags_0(k,j,i-1),28,1) &2741 + IBITS( wall_flags_0(k,j,i-1),29,1) &2900 * ( IBITS(advc_flags_1(k,j,i-1),27,1) & 2901 + IBITS(advc_flags_1(k,j,i-1),28,1) & 2902 + IBITS(advc_flags_1(k,j,i-1),29,1) & 2742 2903 ) & 2743 2904 ) * rho_air_zw(k) * ddx & 2744 2905 + ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 ) & 2745 2906 - ( v(k+1,j,i) + v(k,j,i) ) & 2746 * ( IBITS( wall_flags_0(k,j-1,i),30,1) &2747 + IBITS( wall_flags_0(k,j-1,i),31,1) &2748 + IBITS( wall_flags_00(k,j-1,i),0,1)&2907 * ( IBITS(advc_flags_1(k,j-1,i),30,1) & 2908 + IBITS(advc_flags_1(k,j-1,i),31,1) & 2909 + IBITS(advc_flags_2(k,j-1,i),0,1) & 2749 2910 ) & 2750 2911 ) * rho_air_zw(k) * ddy & 2751 2912 + ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 ) & 2752 2913 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & 2753 * ( IBITS( wall_flags_00(k-1,j,i),1,1)&2754 + IBITS( wall_flags_00(k-1,j,i),2,1)&2755 + IBITS( wall_flags_00(k-1,j,i),3,1)&2914 * ( IBITS(advc_flags_2(k-1,j,i),1,1) & 2915 + IBITS(advc_flags_2(k-1,j,i),2,1) & 2916 + IBITS(advc_flags_2(k-1,j,i),3,1) & 2756 2917 ) & 2757 2918 ) * ddzu(k+1) & … … 2814 2975 !-- k index has to be modified near bottom and top, else array 2815 2976 !-- subscripts will be exceeded. 2816 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)2817 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)2818 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)2977 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 2978 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 2979 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 2819 2980 2820 2981 k_ppp = k + 3 * ibit35 … … 2919 3080 USE indices, & 2920 3081 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, & 2921 nzt, wall_flags_03082 nzt, advc_flags_1 2922 3083 2923 3084 USE kinds … … 2983 3144 DO k = nzb+1, nzb_max 2984 3145 2985 ibit2 = IBITS( wall_flags_0(k,j,i-1),2,1)2986 ibit1 = IBITS( wall_flags_0(k,j,i-1),1,1)2987 ibit0 = IBITS( wall_flags_0(k,j,i-1),0,1)3146 ibit2 = IBITS(advc_flags_1(k,j,i-1),2,1) 3147 ibit1 = IBITS(advc_flags_1(k,j,i-1),1,1) 3148 ibit0 = IBITS(advc_flags_1(k,j,i-1),0,1) 2988 3149 2989 3150 u_comp = u(k,j,i) - u_gtrans … … 3044 3205 DO k = nzb+1, nzb_max 3045 3206 3046 ibit5 = IBITS( wall_flags_0(k,j-1,i),5,1)3047 ibit4 = IBITS( wall_flags_0(k,j-1,i),4,1)3048 ibit3 = IBITS( wall_flags_0(k,j-1,i),3,1)3207 ibit5 = IBITS(advc_flags_1(k,j-1,i),5,1) 3208 ibit4 = IBITS(advc_flags_1(k,j-1,i),4,1) 3209 ibit3 = IBITS(advc_flags_1(k,j-1,i),3,1) 3049 3210 3050 3211 v_comp = v(k,j,i) - v_gtrans … … 3107 3268 DO k = nzb+1, nzb_max 3108 3269 3109 ibit2 = IBITS( wall_flags_0(k,j,i),2,1)3110 ibit1 = IBITS( wall_flags_0(k,j,i),1,1)3111 ibit0 = IBITS( wall_flags_0(k,j,i),0,1)3270 ibit2 = IBITS(advc_flags_1(k,j,i),2,1) 3271 ibit1 = IBITS(advc_flags_1(k,j,i),1,1) 3272 ibit0 = IBITS(advc_flags_1(k,j,i),0,1) 3112 3273 3113 3274 u_comp = u(k,j,i+1) - u_gtrans … … 3142 3303 ) 3143 3304 3144 ibit5 = IBITS( wall_flags_0(k,j,i),5,1)3145 ibit4 = IBITS( wall_flags_0(k,j,i),4,1)3146 ibit3 = IBITS( wall_flags_0(k,j,i),3,1)3305 ibit5 = IBITS(advc_flags_1(k,j,i),5,1) 3306 ibit4 = IBITS(advc_flags_1(k,j,i),4,1) 3307 ibit3 = IBITS(advc_flags_1(k,j,i),3,1) 3147 3308 3148 3309 v_comp = v(k,j+1,i) - v_gtrans … … 3179 3340 !-- k index has to be modified near bottom and top, else array 3180 3341 !-- subscripts will be exceeded. 3181 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)3182 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)3183 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)3342 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 3343 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 3344 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 3184 3345 3185 3346 k_ppp = k + 3 * ibit8 … … 3221 3382 !-- by a not sufficient reduction of divergences near topography. 3222 3383 div = ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 ) & 3223 - u(k,j,i) * ( IBITS( wall_flags_0(k,j,i-1),0,1) &3224 + IBITS( wall_flags_0(k,j,i-1),1,1) &3225 + IBITS( wall_flags_0(k,j,i-1),2,1) &3384 - u(k,j,i) * ( IBITS(advc_flags_1(k,j,i-1),0,1) & 3385 + IBITS(advc_flags_1(k,j,i-1),1,1) & 3386 + IBITS(advc_flags_1(k,j,i-1),2,1) & 3226 3387 ) & 3227 3388 ) * rho_air(k) * ddx & 3228 3389 + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 ) & 3229 - v(k,j,i) * ( IBITS( wall_flags_0(k,j-1,i),3,1) &3230 + IBITS( wall_flags_0(k,j-1,i),4,1) &3231 + IBITS( wall_flags_0(k,j-1,i),5,1) &3390 - v(k,j,i) * ( IBITS(advc_flags_1(k,j-1,i),3,1) & 3391 + IBITS(advc_flags_1(k,j-1,i),4,1) & 3392 + IBITS(advc_flags_1(k,j-1,i),5,1) & 3232 3393 ) & 3233 3394 ) * rho_air(k) * ddy & … … 3235 3396 ( ibit6 + ibit7 + ibit8 ) & 3236 3397 - w(k-1,j,i) * rho_air_zw(k-1) * & 3237 ( IBITS( wall_flags_0(k-1,j,i),6,1) &3238 + IBITS( wall_flags_0(k-1,j,i),7,1) &3239 + IBITS( wall_flags_0(k-1,j,i),8,1) &3398 ( IBITS(advc_flags_1(k-1,j,i),6,1) & 3399 + IBITS(advc_flags_1(k-1,j,i),7,1) & 3400 + IBITS(advc_flags_1(k-1,j,i),8,1) & 3240 3401 ) & 3241 3402 ) * ddzw(k) … … 3285 3446 !-- k index has to be modified near bottom and top, else array 3286 3447 !-- subscripts will be exceeded. 3287 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)3288 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)3289 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)3448 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 3449 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 3450 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 3290 3451 3291 3452 k_ppp = k + 3 * ibit8 … … 3429 3590 3430 3591 3431 3432 3592 !------------------------------------------------------------------------------! 3433 3593 ! Description: … … 3450 3610 3451 3611 USE indices, & 3452 ONLY: nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_03612 ONLY: nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1 3453 3613 3454 3614 USE kinds … … 3507 3667 DO k = nzb+1, nzb_max 3508 3668 3509 ibit11 = IBITS( wall_flags_0(k,j,i-1),11,1)3510 ibit10 = IBITS( wall_flags_0(k,j,i-1),10,1)3511 ibit9 = IBITS( wall_flags_0(k,j,i-1),9,1)3669 ibit11 = IBITS(advc_flags_1(k,j,i-1),11,1) 3670 ibit10 = IBITS(advc_flags_1(k,j,i-1),10,1) 3671 ibit9 = IBITS(advc_flags_1(k,j,i-1),9,1) 3512 3672 3513 3673 u_comp(k) = u(k,j,i) + u(k,j,i-1) - gu … … 3565 3725 DO k = nzb+1, nzb_max 3566 3726 3567 ibit14 = IBITS( wall_flags_0(k,j-1,i),14,1)3568 ibit13 = IBITS( wall_flags_0(k,j-1,i),13,1)3569 ibit12 = IBITS( wall_flags_0(k,j-1,i),12,1)3727 ibit14 = IBITS(advc_flags_1(k,j-1,i),14,1) 3728 ibit13 = IBITS(advc_flags_1(k,j-1,i),13,1) 3729 ibit12 = IBITS(advc_flags_1(k,j-1,i),12,1) 3570 3730 3571 3731 v_comp = v(k,j,i) + v(k,j,i-1) - gv … … 3626 3786 DO k = nzb+1, nzb_max 3627 3787 3628 ibit11 = IBITS( wall_flags_0(k,j,i),11,1)3629 ibit10 = IBITS( wall_flags_0(k,j,i),10,1)3630 ibit9 = IBITS( wall_flags_0(k,j,i),9,1)3788 ibit11 = IBITS(advc_flags_1(k,j,i),11,1) 3789 ibit10 = IBITS(advc_flags_1(k,j,i),10,1) 3790 ibit9 = IBITS(advc_flags_1(k,j,i),9,1) 3631 3791 3632 3792 u_comp(k) = u(k,j,i+1) + u(k,j,i) … … 3661 3821 ) 3662 3822 3663 ibit14 = IBITS( wall_flags_0(k,j,i),14,1)3664 ibit13 = IBITS( wall_flags_0(k,j,i),13,1)3665 ibit12 = IBITS( wall_flags_0(k,j,i),12,1)3823 ibit14 = IBITS(advc_flags_1(k,j,i),14,1) 3824 ibit13 = IBITS(advc_flags_1(k,j,i),13,1) 3825 ibit12 = IBITS(advc_flags_1(k,j,i),12,1) 3666 3826 3667 3827 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv … … 3698 3858 !-- k index has to be modified near bottom and top, else array 3699 3859 !-- subscripts will be exceeded. 3700 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)3701 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)3702 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)3860 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 3861 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 3862 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 3703 3863 3704 3864 k_ppp = k + 3 * ibit17 … … 3742 3902 div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 ) & 3743 3903 - ( u(k,j,i) + u(k,j,i-1) ) & 3744 * ( IBITS( wall_flags_0(k,j,i-1),9,1) &3745 + IBITS( wall_flags_0(k,j,i-1),10,1) &3746 + IBITS( wall_flags_0(k,j,i-1),11,1) &3904 * ( IBITS(advc_flags_1(k,j,i-1),9,1) & 3905 + IBITS(advc_flags_1(k,j,i-1),10,1) & 3906 + IBITS(advc_flags_1(k,j,i-1),11,1) & 3747 3907 ) & 3748 3908 ) * rho_air(k) * ddx & 3749 3909 + ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 ) & 3750 3910 - ( v(k,j,i) + v(k,j,i-1 ) ) & 3751 * ( IBITS( wall_flags_0(k,j-1,i),12,1) &3752 + IBITS( wall_flags_0(k,j-1,i),13,1) &3753 + IBITS( wall_flags_0(k,j-1,i),14,1) &3911 * ( IBITS(advc_flags_1(k,j-1,i),12,1) & 3912 + IBITS(advc_flags_1(k,j-1,i),13,1) & 3913 + IBITS(advc_flags_1(k,j-1,i),14,1) & 3754 3914 ) & 3755 3915 ) * rho_air(k) * ddy & 3756 3916 + ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) & 3757 3917 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 3758 * ( IBITS( wall_flags_0(k-1,j,i),15,1) &3759 + IBITS( wall_flags_0(k-1,j,i),16,1) &3760 + IBITS( wall_flags_0(k-1,j,i),17,1) &3918 * ( IBITS(advc_flags_1(k-1,j,i),15,1) & 3919 + IBITS(advc_flags_1(k-1,j,i),16,1) & 3920 + IBITS(advc_flags_1(k-1,j,i),17,1) & 3761 3921 ) & 3762 3922 ) * ddzw(k) & … … 3829 3989 !-- k index has to be modified near bottom and top, else array 3830 3990 !-- subscripts will be exceeded. 3831 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)3832 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)3833 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)3991 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 3992 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 3993 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 3834 3994 3835 3995 k_ppp = k + 3 * ibit17 … … 3925 4085 END SUBROUTINE advec_u_ws 3926 4086 3927 4087 3928 4088 !------------------------------------------------------------------------------! 3929 4089 ! Description: … … 3946 4106 3947 4107 USE indices, & 3948 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_04108 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, advc_flags_1 3949 4109 3950 4110 USE kinds … … 4003 4163 DO k = nzb+1, nzb_max 4004 4164 4005 ibit20 = IBITS( wall_flags_0(k,j,i-1),20,1)4006 ibit19 = IBITS( wall_flags_0(k,j,i-1),19,1)4007 ibit18 = IBITS( wall_flags_0(k,j,i-1),18,1)4165 ibit20 = IBITS(advc_flags_1(k,j,i-1),20,1) 4166 ibit19 = IBITS(advc_flags_1(k,j,i-1),19,1) 4167 ibit18 = IBITS(advc_flags_1(k,j,i-1),18,1) 4008 4168 4009 4169 u_comp = u(k,j-1,i) + u(k,j,i) - gu … … 4061 4221 DO k = nzb+1, nzb_max 4062 4222 4063 ibit23 = IBITS( wall_flags_0(k,j-1,i),23,1)4064 ibit22 = IBITS( wall_flags_0(k,j-1,i),22,1)4065 ibit21 = IBITS( wall_flags_0(k,j-1,i),21,1)4223 ibit23 = IBITS(advc_flags_1(k,j-1,i),23,1) 4224 ibit22 = IBITS(advc_flags_1(k,j-1,i),22,1) 4225 ibit21 = IBITS(advc_flags_1(k,j-1,i),21,1) 4066 4226 4067 4227 v_comp(k) = v(k,j,i) + v(k,j-1,i) - gv … … 4121 4281 DO k = nzb+1, nzb_max 4122 4282 4123 ibit20 = IBITS( wall_flags_0(k,j,i),20,1)4124 ibit19 = IBITS( wall_flags_0(k,j,i),19,1)4125 ibit18 = IBITS( wall_flags_0(k,j,i),18,1)4283 ibit20 = IBITS(advc_flags_1(k,j,i),20,1) 4284 ibit19 = IBITS(advc_flags_1(k,j,i),19,1) 4285 ibit18 = IBITS(advc_flags_1(k,j,i),18,1) 4126 4286 4127 4287 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu … … 4156 4316 ) 4157 4317 4158 ibit23 = IBITS( wall_flags_0(k,j,i),23,1)4159 ibit22 = IBITS( wall_flags_0(k,j,i),22,1)4160 ibit21 = IBITS( wall_flags_0(k,j,i),21,1)4318 ibit23 = IBITS(advc_flags_1(k,j,i),23,1) 4319 ibit22 = IBITS(advc_flags_1(k,j,i),22,1) 4320 ibit21 = IBITS(advc_flags_1(k,j,i),21,1) 4161 4321 4162 4322 v_comp(k) = v(k,j+1,i) + v(k,j,i) … … 4193 4353 !-- k index has to be modified near bottom and top, else array 4194 4354 !-- subscripts will be exceeded. 4195 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)4196 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)4197 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)4355 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 4356 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 4357 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 4198 4358 4199 4359 k_ppp = k + 3 * ibit26 … … 4238 4398 * ( ibit18 + ibit19 + ibit20 ) & 4239 4399 - ( u(k,j-1,i) + u(k,j,i) ) & 4240 * ( IBITS( wall_flags_0(k,j,i-1),18,1) &4241 + IBITS( wall_flags_0(k,j,i-1),19,1) &4242 + IBITS( wall_flags_0(k,j,i-1),20,1) &4400 * ( IBITS(advc_flags_1(k,j,i-1),18,1) & 4401 + IBITS(advc_flags_1(k,j,i-1),19,1) & 4402 + IBITS(advc_flags_1(k,j,i-1),20,1) & 4243 4403 ) & 4244 4404 ) * rho_air(k) * ddx & … … 4246 4406 * ( ibit21 + ibit22 + ibit23 ) & 4247 4407 - ( v(k,j,i) + v(k,j-1,i) ) & 4248 * ( IBITS( wall_flags_0(k,j-1,i),21,1) &4249 + IBITS( wall_flags_0(k,j-1,i),22,1) &4250 + IBITS( wall_flags_0(k,j-1,i),23,1) &4408 * ( IBITS(advc_flags_1(k,j-1,i),21,1) & 4409 + IBITS(advc_flags_1(k,j-1,i),22,1) & 4410 + IBITS(advc_flags_1(k,j-1,i),23,1) & 4251 4411 ) & 4252 4412 ) * rho_air(k) * ddy & … … 4254 4414 * ( ibit24 + ibit25 + ibit26 ) & 4255 4415 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 4256 * ( IBITS( wall_flags_0(k-1,j,i),24,1) &4257 + IBITS( wall_flags_0(k-1,j,i),25,1) &4258 + IBITS( wall_flags_0(k-1,j,i),26,1) &4416 * ( IBITS(advc_flags_1(k-1,j,i),24,1) & 4417 + IBITS(advc_flags_1(k-1,j,i),25,1) & 4418 + IBITS(advc_flags_1(k-1,j,i),26,1) & 4259 4419 ) & 4260 4420 ) * ddzw(k) & … … 4332 4492 !-- k index has to be modified near bottom and top, else array 4333 4493 !-- subscripts will be exceeded. 4334 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)4335 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)4336 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)4494 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 4495 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 4496 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 4337 4497 4338 4498 k_ppp = k + 3 * ibit26 … … 4433 4593 4434 4594 4435 4436 4437 4595 !------------------------------------------------------------------------------! 4438 4596 ! Description: … … 4455 4613 4456 4614 USE indices, & 4457 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0, &4458 wall_flags_004615 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1, & 4616 advc_flags_2 4459 4617 4460 4618 USE kinds … … 4512 4670 DO k = nzb+1, nzb_max 4513 4671 4514 ibit29 = IBITS( wall_flags_0(k,j,i-1),29,1)4515 ibit28 = IBITS( wall_flags_0(k,j,i-1),28,1)4516 ibit27 = IBITS( wall_flags_0(k,j,i-1),27,1)4672 ibit29 = IBITS(advc_flags_1(k,j,i-1),29,1) 4673 ibit28 = IBITS(advc_flags_1(k,j,i-1),28,1) 4674 ibit27 = IBITS(advc_flags_1(k,j,i-1),27,1) 4517 4675 4518 4676 u_comp = u(k+1,j,i) + u(k,j,i) - gu … … 4570 4728 DO k = nzb+1, nzb_max 4571 4729 4572 ibit32 = IBITS( wall_flags_00(k,j-1,i),0,1)4573 ibit31 = IBITS( wall_flags_0(k,j-1,i),31,1)4574 ibit30 = IBITS( wall_flags_0(k,j-1,i),30,1)4730 ibit32 = IBITS(advc_flags_2(k,j-1,i),0,1) 4731 ibit31 = IBITS(advc_flags_1(k,j-1,i),31,1) 4732 ibit30 = IBITS(advc_flags_1(k,j-1,i),30,1) 4575 4733 4576 4734 v_comp = v(k+1,j,i) + v(k,j,i) - gv … … 4626 4784 !-- The lower flux has to be calculated explicetely for the tendency 4627 4785 !-- at the first w-level. For topography wall this is done implicitely 4628 !-- by wall_flags_0.4786 !-- by advc_flags_1. 4629 4787 k = nzb + 1 4630 4788 w_comp = w(k,j,i) + w(k-1,j,i) … … 4636 4794 DO k = nzb+1, nzb_max 4637 4795 4638 ibit29 = IBITS( wall_flags_0(k,j,i),29,1)4639 ibit28 = IBITS( wall_flags_0(k,j,i),28,1)4640 ibit27 = IBITS( wall_flags_0(k,j,i),27,1)4796 ibit29 = IBITS(advc_flags_1(k,j,i),29,1) 4797 ibit28 = IBITS(advc_flags_1(k,j,i),28,1) 4798 ibit27 = IBITS(advc_flags_1(k,j,i),27,1) 4641 4799 4642 4800 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu … … 4671 4829 ) 4672 4830 4673 ibit32 = IBITS( wall_flags_00(k,j,i),0,1)4674 ibit31 = IBITS( wall_flags_0(k,j,i),31,1)4675 ibit30 = IBITS( wall_flags_0(k,j,i),30,1)4831 ibit32 = IBITS(advc_flags_2(k,j,i),0,1) 4832 ibit31 = IBITS(advc_flags_1(k,j,i),31,1) 4833 ibit30 = IBITS(advc_flags_1(k,j,i),30,1) 4676 4834 4677 4835 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv … … 4708 4866 !-- k index has to be modified near bottom and top, else array 4709 4867 !-- subscripts will be exceeded. 4710 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)4711 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)4712 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)4868 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 4869 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 4870 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 4713 4871 4714 4872 k_ppp = k + 3 * ibit35 … … 4752 4910 div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 ) & 4753 4911 - ( u(k+1,j,i) + u(k,j,i) ) & 4754 * ( IBITS( wall_flags_0(k,j,i-1),27,1) &4755 + IBITS( wall_flags_0(k,j,i-1),28,1) &4756 + IBITS( wall_flags_0(k,j,i-1),29,1) &4912 * ( IBITS(advc_flags_1(k,j,i-1),27,1) & 4913 + IBITS(advc_flags_1(k,j,i-1),28,1) & 4914 + IBITS(advc_flags_1(k,j,i-1),29,1) & 4757 4915 ) & 4758 4916 ) * rho_air_zw(k) * ddx & 4759 4917 + ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 ) & 4760 4918 - ( v(k+1,j,i) + v(k,j,i) ) & 4761 * ( IBITS( wall_flags_0(k,j-1,i),30,1) &4762 + IBITS( wall_flags_0(k,j-1,i),31,1) &4763 + IBITS( wall_flags_00(k,j-1,i),0,1)&4919 * ( IBITS(advc_flags_1(k,j-1,i),30,1) & 4920 + IBITS(advc_flags_1(k,j-1,i),31,1) & 4921 + IBITS(advc_flags_2(k,j-1,i),0,1) & 4764 4922 ) & 4765 4923 ) * rho_air_zw(k) * ddy & 4766 4924 + ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 ) & 4767 4925 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & 4768 * ( IBITS( wall_flags_00(k-1,j,i),1,1)&4769 + IBITS( wall_flags_00(k-1,j,i),2,1)&4770 + IBITS( wall_flags_00(k-1,j,i),3,1)&4926 * ( IBITS(advc_flags_2(k-1,j,i),1,1) & 4927 + IBITS(advc_flags_2(k-1,j,i),2,1) & 4928 + IBITS(advc_flags_2(k-1,j,i),3,1) & 4771 4929 ) & 4772 4930 ) * ddzu(k+1) & … … 4831 4989 !-- k index has to be modified near bottom and top, else array 4832 4990 !-- subscripts will be exceeded. 4833 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)4834 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)4835 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)4991 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 4992 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 4993 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 4836 4994 4837 4995 k_ppp = k + 3 * ibit35 … … 4916 5074 END SUBROUTINE advec_w_ws 4917 5075 4918 4919 5076 END MODULE advec_ws -
palm/trunk/SOURCE/average_3d_data.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Adjustments to new surface concept - additional ghost point exchange 23 ! of surface variable required 23 24 ! 24 25 ! Former revisions: … … 104 105 105 106 USE control_parameters, & 106 ONLY: average_count_3d, doav, doav_n, urban_surface, varnamelength 107 ONLY: average_count_3d, doav, doav_n, land_surface, urban_surface, & 108 varnamelength 107 109 108 110 USE cpulog, & … … 110 112 111 113 USE indices, & 112 ONLY: n xl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt114 ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 113 115 114 116 USE kinds 115 117 116 118 USE land_surface_model_mod, & 117 ONLY: l and_surface, lsm_3d_data_averaging119 ONLY: lsm_3d_data_averaging 118 120 119 121 USE radiation_model_mod, & … … 171 173 ENDDO 172 174 ENDDO 175 CALL exchange_horiz_2d( qsws_av, nbgp ) 173 176 174 177 CASE ( 'lpt' ) … … 203 206 ENDDO 204 207 ENDDO 208 CALL exchange_horiz_2d( ol_av, nbgp ) 205 209 206 210 CASE ( 'p' ) … … 354 358 ENDDO 355 359 ENDDO 360 CALL exchange_horiz_2d( shf_av, nbgp ) 356 361 357 362 CASE ( 'ssws*' ) … … 361 366 ENDDO 362 367 ENDDO 368 CALL exchange_horiz_2d( ssws_av, nbgp ) 363 369 364 370 CASE ( 't*' ) … … 368 374 ENDDO 369 375 ENDDO 376 CALL exchange_horiz_2d( ts_av, nbgp ) 370 377 371 378 CASE ( 'u' ) … … 384 391 ENDDO 385 392 ENDDO 393 CALL exchange_horiz_2d( us_av, nbgp ) 386 394 387 395 CASE ( 'v' ) … … 418 426 ENDDO 419 427 ENDDO 428 CALL exchange_horiz_2d( z0_av, nbgp ) 420 429 421 430 CASE ( 'z0h*' ) … … 425 434 ENDDO 426 435 ENDDO 436 CALL exchange_horiz_2d( z0h_av, nbgp ) 427 437 ! 428 438 !-- Block of urban surface model outputs -
palm/trunk/SOURCE/boundary_conds.f90
r2119 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Set boundary conditions on topography top using flag method. 23 23 ! 24 24 ! Former revisions: … … 168 168 USE indices, & 169 169 ONLY: nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 170 nzb, nz b_s_inner, nzb_w_inner, nzt170 nzb, nzt, wall_flags_0 171 171 172 172 USE kinds … … 177 177 ONLY : nesting_mode 178 178 179 USE surface_mod, & 180 ONLY : bc_h 179 181 180 182 IMPLICIT NONE 181 183 182 INTEGER(iwp) :: i !< 183 INTEGER(iwp) :: j !< 184 INTEGER(iwp) :: k !< 184 INTEGER(iwp) :: i !< grid index x direction 185 INTEGER(iwp) :: j !< grid index y direction 186 INTEGER(iwp) :: k !< grid index z direction 187 INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on facing. 188 INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls 189 INTEGER(iwp) :: m !< running index surface elements 185 190 186 191 REAL(wp) :: c_max !< … … 194 199 v_p(nzb,:,:) = v_p(nzb+1,:,:) 195 200 ENDIF 196 197 DO i = nxlg, nxrg 198 DO j = nysg, nyng 199 w_p(nzb_w_inner(j,i),j,i) = 0.0_wp 201 ! 202 !-- Set zero vertical velocity at topography top (l=0), or bottom (l=1) in case 203 !-- of downward-facing surfaces. 204 DO l = 0, 1 205 ! 206 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 207 !-- for downward-facing surfaces at topography bottom (k+1). 208 kb = MERGE( -1, 1, l == 0 ) 209 !$OMP PARALLEL DO PRIVATE( i, j, k ) 210 DO m = 1, bc_h(l)%ns 211 i = bc_h(l)%i(m) 212 j = bc_h(l)%j(m) 213 k = bc_h(l)%k(m) 214 w_p(k+kb,j,i) = 0.0_wp 200 215 ENDDO 201 216 ENDDO … … 216 231 217 232 ! 218 !-- Temperature at bottom boundary.233 !-- Temperature at bottom and top boundary. 219 234 !-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by 220 235 !-- the sea surface temperature of the coupled ocean model. 236 !-- Dirichlet 221 237 IF ( ibc_pt_b == 0 ) THEN 222 DO i = nxlg, nxrg 223 DO j = nysg, nyng 224 pt_p(nzb_s_inner(j,i),j,i) = pt(nzb_s_inner(j,i),j,i) 238 DO l = 0, 1 239 ! 240 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 241 !-- for downward-facing surfaces at topography bottom (k+1). 242 kb = MERGE( -1, 1, l == 0 ) 243 !$OMP PARALLEL DO PRIVATE( i, j, k ) 244 DO m = 1, bc_h(l)%ns 245 i = bc_h(l)%i(m) 246 j = bc_h(l)%j(m) 247 k = bc_h(l)%k(m) 248 pt_p(k+kb,j,i) = pt(k+kb,j,i) 225 249 ENDDO 226 250 ENDDO 251 ! 252 !-- Neumann, zero-gradient 227 253 ELSEIF ( ibc_pt_b == 1 ) THEN 228 DO i = nxlg, nxrg 229 DO j = nysg, nyng 230 pt_p(nzb_s_inner(j,i),j,i) = pt_p(nzb_s_inner(j,i)+1,j,i) 254 DO l = 0, 1 255 ! 256 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 257 !-- for downward-facing surfaces at topography bottom (k+1). 258 kb = MERGE( -1, 1, l == 0 ) 259 !$OMP PARALLEL DO PRIVATE( i, j, k ) 260 DO m = 1, bc_h(l)%ns 261 i = bc_h(l)%i(m) 262 j = bc_h(l)%j(m) 263 k = bc_h(l)%k(m) 264 pt_p(k+kb,j,i) = pt_p(k,j,i) 231 265 ENDDO 232 266 ENDDO … … 253 287 !-- Generally Neumann conditions with de/dz=0 are assumed 254 288 IF ( .NOT. constant_diffusion ) THEN 255 DO i = nxlg, nxrg 256 DO j = nysg, nyng 257 e_p(nzb_s_inner(j,i),j,i) = e_p(nzb_s_inner(j,i)+1,j,i) 289 290 DO l = 0, 1 291 ! 292 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 293 !-- for downward-facing surfaces at topography bottom (k+1). 294 kb = MERGE( -1, 1, l == 0 ) 295 !$OMP PARALLEL DO PRIVATE( i, j, k ) 296 DO m = 1, bc_h(l)%ns 297 i = bc_h(l)%i(m) 298 j = bc_h(l)%j(m) 299 k = bc_h(l)%k(m) 300 e_p(k+kb,j,i) = e_p(k,j,i) 258 301 ENDDO 259 302 ENDDO 303 260 304 IF ( .NOT. nest_domain ) THEN 261 305 e_p(nzt+1,:,:) = e_p(nzt,:,:) … … 268 312 ! 269 313 !-- Bottom boundary: Neumann condition because salinity flux is always 270 !-- given 271 DO i = nxlg, nxrg 272 DO j = nysg, nyng 273 sa_p(nzb_s_inner(j,i),j,i) = sa_p(nzb_s_inner(j,i)+1,j,i) 314 !-- given. 315 DO l = 0, 1 316 ! 317 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 318 !-- for downward-facing surfaces at topography bottom (k+1). 319 kb = MERGE( -1, 1, l == 0 ) 320 !$OMP PARALLEL DO PRIVATE( i, j, k ) 321 DO m = 1, bc_h(l)%ns 322 i = bc_h(l)%i(m) 323 j = bc_h(l)%j(m) 324 k = bc_h(l)%k(m) 325 sa_p(k+kb,j,i) = sa_p(k,j,i) 274 326 ENDDO 275 327 ENDDO 276 277 328 ! 278 329 !-- Top boundary: Dirichlet or Neumann … … 291 342 ! 292 343 !-- Surface conditions for constant_humidity_flux 344 !-- Run loop over all non-natural and natural walls. Note, in wall-datatype 345 !-- the k coordinate belongs to the atmospheric grid point, therefore, set 346 !-- q_p at k-1 293 347 IF ( ibc_q_b == 0 ) THEN 294 DO i = nxlg, nxrg 295 DO j = nysg, nyng 296 q_p(nzb_s_inner(j,i),j,i) = q(nzb_s_inner(j,i),j,i) 348 349 DO l = 0, 1 350 ! 351 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 352 !-- for downward-facing surfaces at topography bottom (k+1). 353 kb = MERGE( -1, 1, l == 0 ) 354 !$OMP PARALLEL DO PRIVATE( i, j, k ) 355 DO m = 1, bc_h(l)%ns 356 i = bc_h(l)%i(m) 357 j = bc_h(l)%j(m) 358 k = bc_h(l)%k(m) 359 q_p(k+kb,j,i) = q(k+kb,j,i) 297 360 ENDDO 298 361 ENDDO 362 299 363 ELSE 300 DO i = nxlg, nxrg 301 DO j = nysg, nyng 302 q_p(nzb_s_inner(j,i),j,i) = q_p(nzb_s_inner(j,i)+1,j,i) 364 !$OMP PARALLEL DO PRIVATE( i, j, k ) 365 DO m = 1, bc_h(0)%ns 366 i = bc_h(0)%i(m) 367 j = bc_h(0)%j(m) 368 k = bc_h(0)%k(m) 369 q_p(k-1,j,i) = q_p(k,j,i) 370 ENDDO 371 372 DO l = 0, 1 373 ! 374 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 375 !-- for downward-facing surfaces at topography bottom (k+1). 376 kb = MERGE( -1, 1, l == 0 ) 377 !$OMP PARALLEL DO PRIVATE( i, j, k ) 378 DO m = 1, bc_h(l)%ns 379 i = bc_h(l)%i(m) 380 j = bc_h(l)%j(m) 381 k = bc_h(l)%k(m) 382 q_p(k+kb,j,i) = q_p(k,j,i) 303 383 ENDDO 304 384 ENDDO … … 315 395 ! 316 396 !-- Surface conditions rain water (Dirichlet) 317 DO i = nxlg, nxrg 318 DO j = nysg, nyng 319 qr_p(nzb_s_inner(j,i),j,i) = 0.0_wp 320 nr_p(nzb_s_inner(j,i),j,i) = 0.0_wp 321 ENDDO 397 !-- Run loop over all non-natural and natural walls. Note, in wall-datatype 398 !-- the k coordinate belongs to the atmospheric grid point, therefore, set 399 !-- qr_p and nr_p at k-1 400 !$OMP PARALLEL DO PRIVATE( i, j, k ) 401 DO m = 1, bc_h(0)%ns 402 i = bc_h(0)%i(m) 403 j = bc_h(0)%j(m) 404 k = bc_h(0)%k(m) 405 qr_p(k-1,j,i) = 0.0_wp 406 nr_p(k-1,j,i) = 0.0_wp 322 407 ENDDO 323 408 ! … … 334 419 ! 335 420 !-- Surface conditions for constant_humidity_flux 421 !-- Run loop over all non-natural and natural walls. Note, in wall-datatype 422 !-- the k coordinate belongs to the atmospheric grid point, therefore, set 423 !-- s_p at k-1 336 424 IF ( ibc_s_b == 0 ) THEN 337 DO i = nxlg, nxrg 338 DO j = nysg, nyng 339 s_p(nzb_s_inner(j,i),j,i) = s(nzb_s_inner(j,i),j,i) 425 426 DO l = 0, 1 427 ! 428 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 429 !-- for downward-facing surfaces at topography bottom (k+1). 430 kb = MERGE( -1, 1, l == 0 ) 431 !$OMP PARALLEL DO PRIVATE( i, j, k ) 432 DO m = 1, bc_h(l)%ns 433 i = bc_h(l)%i(m) 434 j = bc_h(l)%j(m) 435 k = bc_h(l)%k(m) 436 s_p(k+kb,j,i) = s(k+kb,j,i) 340 437 ENDDO 341 438 ENDDO 439 342 440 ELSE 343 DO i = nxlg, nxrg 344 DO j = nysg, nyng 345 s_p(nzb_s_inner(j,i),j,i) = s_p(nzb_s_inner(j,i)+1,j,i) 441 !$OMP PARALLEL DO PRIVATE( i, j, k ) 442 DO m = 1, bc_h(0)%ns 443 i = bc_h(0)%i(m) 444 j = bc_h(0)%j(m) 445 k = bc_h(0)%k(m) 446 s_p(k-1,j,i) = s_p(k,j,i) 447 ENDDO 448 449 DO l = 0, 1 450 ! 451 !-- Set kb, for upward-facing surfaces value at topography top (k-1) is set, 452 !-- for downward-facing surfaces at topography bottom (k+1). 453 kb = MERGE( -1, 1, l == 0 ) 454 !$OMP PARALLEL DO PRIVATE( i, j, k ) 455 DO m = 1, bc_h(l)%ns 456 i = bc_h(l)%i(m) 457 j = bc_h(l)%j(m) 458 k = bc_h(l)%k(m) 459 s_p(k+kb,j,i) = s_p(k,j,i) 346 460 ENDDO 347 461 ENDDO … … 394 508 IF ( outflow_s ) THEN 395 509 pt_p(:,nys-1,:) = pt_p(:,nys,:) 396 IF ( .NOT. constant_diffusion 510 IF ( .NOT. constant_diffusion ) e_p(:,nys-1,:) = e_p(:,nys,:) 397 511 IF ( humidity ) THEN 398 512 q_p(:,nys-1,:) = q_p(:,nys,:) -
palm/trunk/SOURCE/buoyancy.f90
r2119 r2232 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Adjustments to new topography concept 23 23 ! 24 24 ! Former revisions: … … 131 131 USE indices, & 132 132 ONLY: nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nzb, & 133 nz b_s_inner, nzt133 nzt, wall_flags_0 134 134 135 135 USE kinds … … 157 157 DO i = nxl, nxr 158 158 DO j = nys, nyn 159 DO k = nzb _s_inner(j,i)+1, nzt-1160 tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * &161 ( &159 DO k = nzb+1, nzt-1 160 tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * & 161 ( & 162 162 ( var(k,j,i) - ref_state(k) ) / ref_state(k) + & 163 163 ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) & 164 ) 164 ) * MERGE( 1.0_wp, 0.0_wp, & 165 BTEST( wall_flags_0(k,j,i), 0 ) ) 165 166 ENDDO 166 167 ENDDO … … 178 179 DO i = nxlu, nxr 179 180 DO j = nys, nyn 180 DO k = nzb _s_inner(j,i)+1, nzt-1181 tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface * &181 DO k = nzb+1, nzt-1 182 tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface * & 182 183 0.5_wp * ( ( pt(k,j,i-1) + pt(k,j,i) ) & 183 184 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) & 184 ) / pt_surface 185 ) / pt_surface & 186 * MERGE( 1.0_wp, 0.0_wp, & 187 BTEST( wall_flags_0(k,j,i), 0 ) ) 185 188 ENDDO 186 189 ENDDO … … 191 194 DO i = nxl, nxr 192 195 DO j = nys, nyn 193 DO k = nzb _s_inner(j,i)+1, nzt-1194 tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface * &196 DO k = nzb+1, nzt-1 197 tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface * & 195 198 0.5_wp * ( ( pt(k,j,i) + pt(k+1,j,i) ) & 196 199 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) & 197 ) / pt_surface 200 ) / pt_surface & 201 * MERGE( 1.0_wp, 0.0_wp, & 202 BTEST( wall_flags_0(k,j,i), 0 ) ) 198 203 ENDDO 199 204 ENDDO … … 231 236 232 237 USE indices, & 233 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_s_inner, nzt238 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 234 239 235 240 USE kinds … … 256 261 ! 257 262 !-- Normal case: horizontal surface 258 DO k = nzb _s_inner(j,i)+1, nzt-1263 DO k = nzb+1, nzt-1 259 264 tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * ( & 260 265 ( var(k,j,i) - ref_state(k) ) / ref_state(k) + & 261 266 ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) & 262 ) 267 ) & 268 * MERGE( 1.0_wp, 0.0_wp, & 269 BTEST( wall_flags_0(k,j,i), 0 ) ) 263 270 ENDDO 264 271 … … 272 279 IF ( wind_component == 1 ) THEN 273 280 274 DO k = nzb _s_inner(j,i)+1, nzt-1275 tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface * &281 DO k = nzb+1, nzt-1 282 tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface * & 276 283 0.5_wp * ( ( pt(k,j,i-1) + pt(k,j,i) ) & 277 284 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) & 278 ) / pt_surface 285 ) / pt_surface & 286 * MERGE( 1.0_wp, 0.0_wp, & 287 BTEST( wall_flags_0(k,j,i), 0 ) ) 279 288 ENDDO 280 289 281 290 ELSEIF ( wind_component == 3 ) THEN 282 291 283 DO k = nzb _s_inner(j,i)+1, nzt-1284 tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface * &292 DO k = nzb+1, nzt-1 293 tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface * & 285 294 0.5_wp * ( ( pt(k,j,i) + pt(k+1,j,i) ) & 286 295 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) & 287 ) / pt_surface 296 ) / pt_surface & 297 * MERGE( 1.0_wp, 0.0_wp, & 298 BTEST( wall_flags_0(k,j,i), 0 ) ) 288 299 ENDDO 289 300 -
palm/trunk/SOURCE/calc_liquid_water_content.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Adjustments to new topography concept 23 23 ! 24 24 ! Former revisions: … … 83 83 84 84 USE indices, & 85 ONLY: nxlg, nxrg, nyng, nysg, nzb _s_inner, nzt85 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 86 86 87 87 USE kinds … … 103 103 DO i = nxlg, nxrg 104 104 DO j = nysg, nyng 105 DO k = nzb _s_inner(j,i)+1, nzt105 DO k = nzb+1, nzt 106 106 107 107 ! … … 131 131 IF ( microphysics_seifert ) THEN 132 132 IF ( ( q(k,j,i) - q_s - qr(k,j,i) ) > 0.0_wp ) THEN 133 qc(k,j,i) = q(k,j,i) - q_s - qr(k,j,i) 134 ql(k,j,i) = qc(k,j,i) + qr(k,j,i) 133 qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) ) & 134 * MERGE( 1.0_wp, 0.0_wp, & 135 BTEST( wall_flags_0(k,j,i), 0 ) ) 136 ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) & 137 * MERGE( 1.0_wp, 0.0_wp, & 138 BTEST( wall_flags_0(k,j,i), 0 ) ) 135 139 ELSE 136 140 IF ( q(k,j,i) < qr(k,j,i) ) q(k,j,i) = qr(k,j,i) 137 141 qc(k,j,i) = 0.0_wp 138 ql(k,j,i) = qr(k,j,i) 142 ql(k,j,i) = qr(k,j,i) & 143 * MERGE( 1.0_wp, 0.0_wp, & 144 BTEST( wall_flags_0(k,j,i), 0 ) ) 139 145 ENDIF 140 146 ELSE 141 147 IF ( ( q(k,j,i) - q_s ) > 0.0_wp ) THEN 142 qc(k,j,i) = q(k,j,i) - q_s 143 ql(k,j,i) = qc(k,j,i) 148 qc(k,j,i) = ( q(k,j,i) - q_s ) & 149 * MERGE( 1.0_wp, 0.0_wp, & 150 BTEST( wall_flags_0(k,j,i), 0 ) ) 151 ql(k,j,i) = qc(k,j,i) & 152 * MERGE( 1.0_wp, 0.0_wp, & 153 BTEST( wall_flags_0(k,j,i), 0 ) ) 144 154 ELSE 145 155 qc(k,j,i) = 0.0_wp -
palm/trunk/SOURCE/calc_mean_profile.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Adjustments to new topography concept 23 23 ! 24 24 ! Former revisions: … … 75 75 76 76 USE indices, & 77 ONLY: ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt 77 ONLY: ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb, nzt, & 78 wall_flags_0 78 79 79 80 USE kinds … … 118 119 DO i = nxl, nxr 119 120 DO j = nys, nyn 120 DO k = nzb_s_inner(j,i), nzt+1 121 sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i) 121 DO k = nzb, nzt+1 122 sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i) & 123 * MERGE( 1.0_wp, 0.0_wp, & 124 BTEST( wall_flags_0(k,j,i), 22 ) ) 122 125 ENDDO 123 126 ENDDO -
palm/trunk/SOURCE/calc_radiation.f90
r2101 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Adjustments to new topography concept 23 23 ! 24 24 ! Former revisions: … … 105 105 106 106 USE indices, & 107 ONLY: nxl, nxr, nyn, nys, nzb, nz b_s_inner, nzt107 ONLY: nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0 108 108 109 109 USE kinds … … 153 153 blackbody_emission(nzb) = sigma * temperature**4 154 154 155 DO k = nzb _s_inner(j,i)+1, nzt155 DO k = nzb+1, nzt 156 156 157 157 k_help = ( nzt+nzb+1 ) - k … … 163 163 164 164 temperature = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i) 165 blackbody_emission(k) = sigma * temperature**4 165 blackbody_emission(k) = sigma * temperature**4 & 166 * MERGE( 1.0_wp, 0.0_wp, & 167 BTEST( wall_flags_0(k,j,i), 0 ) ) 166 168 167 169 ENDDO … … 179 181 impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp 180 182 181 DO k = nzb _s_inner(j,i)+1, nzt183 DO k = nzb+1, nzt 182 184 ! 183 185 !-- Save some computational time, but this may cause load … … 222 224 tend(k,j,i) = tend(k,j,i) - & 223 225 ( pt_d_t(k) / ( rho_surface * cp ) * & 224 ( df_p - df_m ) / dzw(k) ) 226 ( df_p - df_m ) / dzw(k) ) & 227 * MERGE( 1.0_wp, 0.0_wp, & 228 BTEST( wall_flags_0(k,j,i), 0 ) ) 225 229 226 230 ENDIF … … 250 254 251 255 USE indices, & 252 ONLY: nzb, nz b_s_inner, nzt256 ONLY: nzb, nzt, wall_flags_0 253 257 254 258 USE kinds … … 295 299 blackbody_emission(nzb) = sigma * temperature**4 296 300 297 DO k = nzb _s_inner(j,i)+1, nzt301 DO k = nzb+1, nzt 298 302 k_help = ( nzt+nzb+1 ) - k 299 303 lwp_ground(k) = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k) … … 303 307 304 308 temperature = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i) 305 blackbody_emission(k) = sigma * temperature**4 309 blackbody_emission(k) = sigma * temperature**4 & 310 * MERGE( 1.0_wp, 0.0_wp, & 311 BTEST( wall_flags_0(k,j,i), 0 ) ) 306 312 307 313 ENDDO … … 318 324 impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp 319 325 320 DO k = nzb _s_inner(j,i)+1, nzt326 DO k = nzb+1, nzt 321 327 ! 322 328 !-- Store some computational time, … … 356 362 !-- Compute tendency term 357 363 tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) * & 358 ( df_p - df_m ) / dzw(k) ) 364 ( df_p - df_m ) / dzw(k) ) & 365 * MERGE( 1.0_wp, 0.0_wp, & 366 BTEST( wall_flags_0(k,j,i), 0 ) ) 359 367 360 368 ENDIF -
palm/trunk/SOURCE/check_parameters.f90
r2210 r2232 466 466 USE indices 467 467 USE land_surface_model_mod, & 468 ONLY: l and_surface, lsm_check_data_output, lsm_check_data_output_pr,&468 ONLY: lsm_check_data_output, lsm_check_data_output_pr, & 469 469 lsm_check_parameters 470 470 … … 859 859 'momentum_advec = "ws-scheme"' 860 860 CALL message( 'check_parameters', 'PA0447', 1, 2, 0, 6, 0 ) 861 ENDIF 862 IF ( TRIM( approximation ) == 'anelastic' .AND. & 863 TRIM( psolver ) == 'multigrid' ) THEN 864 message_string = 'Anelastic approximation currently only supports: ' // & 865 'psolver = "poisfft", ' // & 866 'psolver = "sor" and ' // & 867 'psolver = "multigrid_noopt"' 868 CALL message( 'check_parameters', 'PA0448', 1, 2, 0, 6, 0 ) 861 869 ENDIF 862 870 IF ( TRIM( approximation ) == 'anelastic' .AND. & -
palm/trunk/SOURCE/coriolis.f90
r2119 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Adjustments to new topography concept 23 23 ! 24 24 ! Former revisions: … … 102 102 103 103 USE indices, & 104 ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner, & 105 nzb_w_inner, nzt 104 ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_0 106 105 107 106 USE kinds … … 110 109 111 110 INTEGER(iwp) :: component !< 112 INTEGER(iwp) :: i !< 113 INTEGER(iwp) :: j !< 114 INTEGER(iwp) :: k !< 115 116 111 INTEGER(iwp) :: i !< running index x direction 112 INTEGER(iwp) :: j !< running index y direction 113 INTEGER(iwp) :: k !< running index z direction 114 115 REAL(wp) :: flag !< flag to mask topography 117 116 ! 118 117 !-- Compute Coriolis terms for the three velocity components … … 124 123 DO i = nxlu, nxr 125 124 DO j = nys, nyn 126 DO k = nzb_u_inner(j,i)+1, nzt 125 DO k = nzb+1, nzt 126 ! 127 !-- Predetermine flag to mask topography 128 flag = MERGE( 1.0_wp, 0.0_wp, & 129 BTEST( wall_flags_0(k,j,i), 1 ) ) 130 127 131 tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * & 128 132 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + & 129 v(k,j+1,i) ) - vg(k) )&133 v(k,j+1,i) ) - vg(k) ) * flag & 130 134 - fs * ( 0.25_wp * & 131 135 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + & 132 w(k,j,i) ) &133 ) 136 w(k,j,i) ) & 137 ) * flag 134 138 ENDDO 135 139 ENDDO … … 141 145 DO i = nxl, nxr 142 146 DO j = nysv, nyn 143 DO k = nzb _v_inner(j,i)+1, nzt147 DO k = nzb+1, nzt 144 148 tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * & 145 149 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + & 146 u(k,j,i+1) ) - ug(k) ) 150 u(k,j,i+1) ) - ug(k) ) * & 151 MERGE( 1.0_wp, 0.0_wp, & 152 BTEST( wall_flags_0(k,j,i), 2 ) ) 147 153 ENDDO 148 154 ENDDO … … 154 160 DO i = nxl, nxr 155 161 DO j = nys, nyn 156 DO k = nzb _w_inner(j,i)+1, nzt162 DO k = nzb+1, nzt 157 163 tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * & 158 164 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + & 159 u(k+1,j,i+1) ) 165 u(k+1,j,i+1) ) * & 166 MERGE( 1.0_wp, 0.0_wp, & 167 BTEST( wall_flags_0(k,j,i), 3 ) ) 160 168 ENDDO 161 169 ENDDO … … 186 194 187 195 USE indices, & 188 ONLY: nzb _u_inner, nzb_v_inner, nzb_w_inner, nzt196 ONLY: nzb, nzt, wall_flags_0 189 197 190 198 USE kinds … … 193 201 194 202 INTEGER(iwp) :: component !< 195 INTEGER(iwp) :: i !< 196 INTEGER(iwp) :: j !< 197 INTEGER(iwp) :: k !< 203 INTEGER(iwp) :: i !< running index x direction 204 INTEGER(iwp) :: j !< running index y direction 205 INTEGER(iwp) :: k !< running index z direction 206 207 REAL(wp) :: flag !< flag to mask topography 198 208 199 209 ! … … 204 214 !-- u-component 205 215 CASE ( 1 ) 206 DO k = nzb_u_inner(j,i)+1, nzt 207 tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * & 216 DO k = nzb+1, nzt 217 ! 218 !-- Predetermine flag to mask topography 219 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) ) 220 221 tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * & 208 222 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + & 209 v(k,j+1,i) ) - vg(k) ) 223 v(k,j+1,i) ) - vg(k) ) * flag & 210 224 - fs * ( 0.25_wp * & 211 225 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + & 212 w(k,j,i) ) )226 w(k,j,i) ) ) * flag 213 227 ENDDO 214 228 … … 216 230 !-- v-component 217 231 CASE ( 2 ) 218 DO k = nzb _v_inner(j,i)+1, nzt219 tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp *&232 DO k = nzb+1, nzt 233 tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * & 220 234 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + & 221 u(k,j,i+1) ) - ug(k) ) 235 u(k,j,i+1) ) - ug(k) ) * & 236 MERGE( 1.0_wp, 0.0_wp, & 237 BTEST( wall_flags_0(k,j,i), 2 ) ) 222 238 ENDDO 223 239 … … 225 241 !-- w-component 226 242 CASE ( 3 ) 227 DO k = nzb _w_inner(j,i)+1, nzt243 DO k = nzb+1, nzt 228 244 tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * & 229 245 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + & 230 u(k+1,j,i+1) ) 246 u(k+1,j,i+1) ) * & 247 MERGE( 1.0_wp, 0.0_wp, & 248 BTEST( wall_flags_0(k,j,i), 3 ) ) 231 249 ENDDO 232 250 -
palm/trunk/SOURCE/data_output_2d.f90
r2191 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! Adjustments to new surface concept 22 23 ! 23 24 ! … … 162 163 163 164 USE arrays_3d, & 164 ONLY: dzw, e, nr, ol, p, pt, precipitation_amount, precipitation_rate,&165 prr, q, qc, ql, ql_c, ql_v, ql_vp, qr, qsws, rho_ocean, s, sa, shf,&166 ssws, tend, ts, u, us, v, vpt, w, z0, z0h, z0q, zu, zw165 ONLY: dzw, e, nr, p, pt, precipitation_amount, precipitation_rate, & 166 prr, q, qc, ql, ql_c, ql_v, ql_vp, qr, rho_ocean, s, sa, & 167 tend, u, v, vpt, w, zu, zw 167 168 168 169 USE averaging … … 177 178 do2d_xz_last_time, do2d_xz_n, do2d_xz_time_count, & 178 179 do2d_yz_last_time, do2d_yz_n, do2d_yz_time_count, & 179 ibc_uv_b, io_blocks, io_group, message_string,&180 ibc_uv_b, io_blocks, io_group, land_surface, message_string, & 180 181 ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, & 181 182 psolver, section, simulated_time, simulated_time_chr, & … … 195 196 196 197 USE land_surface_model_mod, & 197 ONLY: l and_surface, lsm_data_output_2d, zs198 ONLY: lsm_data_output_2d, zs 198 199 199 200 #if defined( __netcdf ) … … 214 215 USE radiation_model_mod, & 215 216 ONLY: radiation, radiation_data_output_2d 217 218 USE surface_mod, & 219 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 216 220 217 221 IMPLICIT NONE … … 234 238 INTEGER(iwp) :: l !< 235 239 INTEGER(iwp) :: layer_xy !< 240 INTEGER(iwp) :: m !< 236 241 INTEGER(iwp) :: n !< 237 242 INTEGER(iwp) :: nis !< … … 255 260 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d !< 256 261 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d_l !< 262 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp_2d !< temporary field used to exchange surface-related quantities 263 257 264 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< 258 265 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections !< … … 417 424 !-- Allocate a temporary array for resorting (kji -> ijk). 418 425 ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) ) 426 local_pf = 0.0 427 ! 428 !-- Allocate temporary array used for exchanging ghoist points of surface-data 429 ALLOCATE( tmp_2d(nysg:nyng,nxlg:nxrg) ) 430 tmp_2d = 0.0 419 431 420 432 ! … … 485 497 CASE ( 'ol*_xy' ) ! 2d-array 486 498 IF ( av == 0 ) THEN 487 DO i = nxlg, nxrg 488 DO j = nysg, nyng 489 local_pf(i,j,nzb+1) = ol(j,i) 490 ENDDO 491 ENDDO 499 DO m = 1, surf_def_h(0)%ns 500 i = surf_def_h(0)%i(m) 501 j = surf_def_h(0)%j(m) 502 tmp_2d(j,i) = surf_def_h(0)%ol(m) 503 ENDDO 504 DO m = 1, surf_lsm_h%ns 505 i = surf_lsm_h%i(m) 506 j = surf_lsm_h%j(m) 507 tmp_2d(j,i) = surf_lsm_h%ol(m) 508 ENDDO 509 DO m = 1, surf_usm_h%ns 510 i = surf_usm_h%i(m) 511 j = surf_usm_h%j(m) 512 tmp_2d(j,i) = surf_usm_h%ol(m) 513 ENDDO 514 515 CALL exchange_horiz_2d( tmp_2d, nbgp ) 516 517 DO i = nxlg, nxrg 518 DO j = nysg, nyng 519 local_pf(i,j,nzb+1) = tmp_2d(j,i) 520 ENDDO 521 ENDDO 522 492 523 ELSE 493 524 DO i = nxlg, nxrg … … 740 771 CASE ( 'qsws*_xy' ) ! 2d-array 741 772 IF ( av == 0 ) THEN 742 DO i = nxlg, nxrg 743 DO j = nysg, nyng 744 local_pf(i,j,nzb+1) = qsws(j,i) 773 DO m = 1, surf_def_h(0)%ns 774 i = surf_def_h(0)%i(m) 775 j = surf_def_h(0)%j(m) 776 tmp_2d(j,i) = surf_def_h(0)%qsws(m) 777 ENDDO 778 DO m = 1, surf_lsm_h%ns 779 i = surf_lsm_h%i(m) 780 j = surf_lsm_h%j(m) 781 tmp_2d(j,i) = surf_lsm_h%qsws(m) 782 ENDDO 783 DO m = 1, surf_usm_h%ns 784 i = surf_usm_h%i(m) 785 j = surf_usm_h%j(m) 786 tmp_2d(j,i) = surf_usm_h%qsws(m) 787 ENDDO 788 789 CALL exchange_horiz_2d( tmp_2d, nbgp ) 790 791 DO i = nxlg, nxrg 792 DO j = nysg, nyng 793 local_pf(i,j,nzb+1) = tmp_2d(j,i) 745 794 ENDDO 746 795 ENDDO … … 796 845 CASE ( 'shf*_xy' ) ! 2d-array 797 846 IF ( av == 0 ) THEN 798 DO i = nxlg, nxrg 799 DO j = nysg, nyng 800 local_pf(i,j,nzb+1) = shf(j,i) 847 DO m = 1, surf_def_h(0)%ns 848 i = surf_def_h(0)%i(m) 849 j = surf_def_h(0)%j(m) 850 tmp_2d(j,i) = surf_def_h(0)%shf(m) 851 ENDDO 852 DO m = 1, surf_lsm_h%ns 853 i = surf_lsm_h%i(m) 854 j = surf_lsm_h%j(m) 855 tmp_2d(j,i) = surf_lsm_h%shf(m) 856 ENDDO 857 DO m = 1, surf_usm_h%ns 858 i = surf_usm_h%i(m) 859 j = surf_usm_h%j(m) 860 tmp_2d(j,i) = surf_usm_h%shf(m) 861 ENDDO 862 863 CALL exchange_horiz_2d( tmp_2d, nbgp ) 864 865 DO i = nxlg, nxrg 866 DO j = nysg, nyng 867 local_pf(i,j,nzb+1) = tmp_2d(j,i) 801 868 ENDDO 802 869 ENDDO … … 814 881 CASE ( 'ssws*_xy' ) ! 2d-array 815 882 IF ( av == 0 ) THEN 816 DO i = nxlg, nxrg 817 DO j = nysg, nyng 818 local_pf(i,j,nzb+1) = ssws(j,i) 883 DO m = 1, surf_def_h(0)%ns 884 i = surf_def_h(0)%i(m) 885 j = surf_def_h(0)%j(m) 886 tmp_2d(j,i) = surf_def_h(0)%ssws(m) 887 ENDDO 888 DO m = 1, surf_lsm_h%ns 889 i = surf_lsm_h%i(m) 890 j = surf_lsm_h%j(m) 891 tmp_2d(j,i) = surf_lsm_h%ssws(m) 892 ENDDO 893 DO m = 1, surf_usm_h%ns 894 i = surf_usm_h%i(m) 895 j = surf_usm_h%j(m) 896 tmp_2d(j,i) = surf_usm_h%ssws(m) 897 ENDDO 898 899 CALL exchange_horiz_2d( tmp_2d, nbgp ) 900 901 DO i = nxlg, nxrg 902 DO j = nysg, nyng 903 local_pf(i,j,nzb+1) = tmp_2d(j,i) 819 904 ENDDO 820 905 ENDDO … … 832 917 CASE ( 't*_xy' ) ! 2d-array 833 918 IF ( av == 0 ) THEN 834 DO i = nxlg, nxrg 835 DO j = nysg, nyng 836 local_pf(i,j,nzb+1) = ts(j,i) 837 ENDDO 838 ENDDO 919 DO m = 1, surf_def_h(0)%ns 920 i = surf_def_h(0)%i(m) 921 j = surf_def_h(0)%j(m) 922 tmp_2d(j,i) = surf_def_h(0)%ts(m) 923 ENDDO 924 DO m = 1, surf_lsm_h%ns 925 i = surf_lsm_h%i(m) 926 j = surf_lsm_h%j(m) 927 tmp_2d(j,i) = surf_lsm_h%ts(m) 928 ENDDO 929 DO m = 1, surf_usm_h%ns 930 i = surf_usm_h%i(m) 931 j = surf_usm_h%j(m) 932 tmp_2d(j,i) = surf_usm_h%ts(m) 933 ENDDO 934 935 CALL exchange_horiz_2d( tmp_2d, nbgp ) 936 937 DO i = nxlg, nxrg 938 DO j = nysg, nyng 939 local_pf(i,j,nzb+1) = tmp_2d(j,i) 940 ENDDO 941 ENDDO 942 839 943 ELSE 840 944 DO i = nxlg, nxrg … … 864 968 CASE ( 'u*_xy' ) ! 2d-array 865 969 IF ( av == 0 ) THEN 866 DO i = nxlg, nxrg 867 DO j = nysg, nyng 868 local_pf(i,j,nzb+1) = us(j,i) 970 DO m = 1, surf_def_h(0)%ns 971 i = surf_def_h(0)%i(m) 972 j = surf_def_h(0)%j(m) 973 tmp_2d(j,i) = surf_def_h(0)%us(m) 974 ENDDO 975 DO m = 1, surf_lsm_h%ns 976 i = surf_lsm_h%i(m) 977 j = surf_lsm_h%j(m) 978 tmp_2d(j,i) = surf_lsm_h%us(m) 979 ENDDO 980 DO m = 1, surf_usm_h%ns 981 i = surf_usm_h%i(m) 982 j = surf_usm_h%j(m) 983 tmp_2d(j,i) = surf_usm_h%us(m) 984 ENDDO 985 986 CALL exchange_horiz_2d( tmp_2d, nbgp ) 987 988 DO i = nxlg, nxrg 989 DO j = nysg, nyng 990 local_pf(i,j,nzb+1) = tmp_2d(j,i) 869 991 ENDDO 870 992 ENDDO … … 912 1034 CASE ( 'z0*_xy' ) ! 2d-array 913 1035 IF ( av == 0 ) THEN 914 DO i = nxlg, nxrg 915 DO j = nysg, nyng 916 local_pf(i,j,nzb+1) = z0(j,i) 917 ENDDO 918 ENDDO 1036 DO m = 1, surf_def_h(0)%ns 1037 i = surf_def_h(0)%i(m) 1038 j = surf_def_h(0)%j(m) 1039 tmp_2d(j,i) = surf_def_h(0)%z0(m) 1040 ENDDO 1041 DO m = 1, surf_lsm_h%ns 1042 i = surf_lsm_h%i(m) 1043 j = surf_lsm_h%j(m) 1044 tmp_2d(j,i) = surf_lsm_h%z0(m) 1045 ENDDO 1046 DO m = 1, surf_usm_h%ns 1047 i = surf_usm_h%i(m) 1048 j = surf_usm_h%j(m) 1049 tmp_2d(j,i) = surf_usm_h%z0(m) 1050 ENDDO 1051 1052 CALL exchange_horiz_2d( tmp_2d, nbgp ) 1053 1054 DO i = nxlg, nxrg 1055 DO j = nysg, nyng 1056 local_pf(i,j,nzb+1) = tmp_2d(j,i) 1057 ENDDO 1058 ENDDO 1059 919 1060 ELSE 920 1061 DO i = nxlg, nxrg … … 930 1071 CASE ( 'z0h*_xy' ) ! 2d-array 931 1072 IF ( av == 0 ) THEN 932 DO i = nxlg, nxrg 933 DO j = nysg, nyng 934 local_pf(i,j,nzb+1) = z0h(j,i) 1073 DO m = 1, surf_def_h(0)%ns 1074 i = surf_def_h(0)%i(m) 1075 j = surf_def_h(0)%j(m) 1076 tmp_2d(j,i) = surf_def_h(0)%z0h(m) 1077 ENDDO 1078 DO m = 1, surf_lsm_h%ns 1079 i = surf_lsm_h%i(m) 1080 j = surf_lsm_h%j(m) 1081 tmp_2d(j,i) = surf_lsm_h%z0h(m) 1082 ENDDO 1083 DO m = 1, surf_usm_h%ns 1084 i = surf_usm_h%i(m) 1085 j = surf_usm_h%j(m) 1086 tmp_2d(j,i) = surf_usm_h%z0h(m) 1087 ENDDO 1088 1089 CALL exchange_horiz_2d( tmp_2d, nbgp ) 1090 1091 DO i = nxlg, nxrg 1092 DO j = nysg, nyng 1093 local_pf(i,j,nzb+1) = tmp_2d(j,i) 935 1094 ENDDO 936 1095 ENDDO … … 948 1107 CASE ( 'z0q*_xy' ) ! 2d-array 949 1108 IF ( av == 0 ) THEN 950 DO i = nxlg, nxrg 951 DO j = nysg, nyng 952 local_pf(i,j,nzb+1) = z0q(j,i) 1109 DO m = 1, surf_def_h(0)%ns 1110 i = surf_def_h(0)%i(m) 1111 j = surf_def_h(0)%j(m) 1112 tmp_2d(j,i) = surf_def_h(0)%z0q(m) 1113 ENDDO 1114 DO m = 1, surf_lsm_h%ns 1115 i = surf_lsm_h%i(m) 1116 j = surf_lsm_h%j(m) 1117 tmp_2d(j,i) = surf_lsm_h%z0q(m) 1118 ENDDO 1119 DO m = 1, surf_usm_h%ns 1120 i = surf_usm_h%i(m) 1121 j = surf_usm_h%j(m) 1122 tmp_2d(j,i) = surf_usm_h%z0q(m) 1123 ENDDO 1124 1125 CALL exchange_horiz_2d( tmp_2d, nbgp ) 1126 1127 DO i = nxlg, nxrg 1128 DO j = nysg, nyng 1129 local_pf(i,j,nzb+1) = tmp_2d(j,i) 953 1130 ENDDO 954 1131 ENDDO -
palm/trunk/SOURCE/data_output_3d.f90
r2210 r2232 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Adjustments to new topography concept 23 23 ! 24 24 ! Former revisions: … … 152 152 153 153 USE arrays_3d, & 154 ONLY: e, nr, p, pt, prr, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, tend,&155 u, v, vpt, w154 ONLY: e, nr, p, pt, prr, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, & 155 tend, u, v, vpt, w 156 156 157 157 USE averaging … … 162 162 USE control_parameters, & 163 163 ONLY: cloud_physics, do3d, do3d_no, do3d_time_count, io_blocks, & 164 io_group, message_string, ntdim_3d, nz_do3d, psolver,&165 simulated_time, time_since_reference_point, urban_surface,&166 varnamelength164 io_group, land_surface, message_string, ntdim_3d, nz_do3d, & 165 psolver, simulated_time, time_since_reference_point, & 166 urban_surface, varnamelength 167 167 168 168 USE cpulog, & … … 175 175 176 176 USE land_surface_model_mod, & 177 ONLY: l and_surface, lsm_data_output_3d, nzb_soil, nzt_soil177 ONLY: lsm_data_output_3d, nzb_soil, nzt_soil 178 178 179 179 #if defined( __netcdf ) -
palm/trunk/SOURCE/diffusion_e.f90
r2119 r2232 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Adjustments to new topography and surface concept 23 23 ! 24 24 ! Former revisions: … … 129 129 130 130 USE arrays_3d, & 131 ONLY: dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw,&131 ONLY: dd2zu, ddzu, ddzw, diss, e, km, l_grid, l_wall, tend, zu, zw,& 132 132 drho_air, rho_air_zw 133 133 … … 140 140 141 141 USE indices, & 142 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_ s_inner,&143 nzt 142 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, & 143 nzt, wall_flags_0 144 144 145 145 USE kinds … … 151 151 ONLY: use_sgs_for_particles, wang_kernel 152 152 153 USE surface_mod, & 154 ONLY : bc_h 155 153 156 IMPLICIT NONE 154 157 155 INTEGER(iwp) :: i !< 156 INTEGER(iwp) :: j !< 157 INTEGER(iwp) :: k !< 158 INTEGER(iwp) :: i !< running index x direction 159 INTEGER(iwp) :: j !< running index y direction 160 INTEGER(iwp) :: k !< running index z direction 161 INTEGER(iwp) :: m !< running index surface elements 162 158 163 REAL(wp) :: dvar_dz !< 164 REAL(wp) :: flag !< flag to mask topography 159 165 REAL(wp) :: l_stable !< 160 166 REAL(wp) :: var_reference !< … … 177 183 DO i = nxl, nxr 178 184 DO j = nys, nyn 179 DO k = nzb _s_inner(j,i)+1, nzt185 DO k = nzb+1, nzt 180 186 ! 181 187 !-- Calculate the mixing length (for dissipation) … … 191 197 !-- Adjustment of the mixing length 192 198 IF ( wall_adjustment ) THEN 193 l(k,j) = MIN( wall_adjustment_factor * & 194 ( zu(k) - zw(nzb_s_inner(j,i)) ), & 199 l(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i), & 195 200 l_grid(k), l_stable ) 196 ll(k,j) = MIN( wall_adjustment_factor * & 197 ( zu(k) - zw(nzb_s_inner(j,i)) ), & 201 ll(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i), & 198 202 l_grid(k) ) 199 203 ELSE … … 208 212 !-- Calculate the tendency terms 209 213 DO j = nys, nyn 210 DO k = nzb_s_inner(j,i)+1, nzt 211 212 dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * & 214 DO k = nzb+1, nzt 215 ! 216 !-- Predetermine flag to mask topography 217 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 218 219 dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * & 213 220 e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j) 214 221 215 tend(k,j,i) = tend(k,j,i)&222 tend(k,j,i) = tend(k,j,i) & 216 223 + ( & 217 224 ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) & 218 225 - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) & 219 ) * ddx2 226 ) * ddx2 * flag & 220 227 + ( & 221 228 ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) & 222 229 - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) & 223 ) * ddy2 230 ) * ddy2 * flag & 224 231 + ( & 225 232 ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) & … … 227 234 - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) & 228 235 * rho_air_zw(k-1) & 229 ) * ddzw(k) * drho_air(k) 230 - dissipation(k,j) 236 ) * ddzw(k) * drho_air(k) * flag & 237 - dissipation(k,j) * flag 231 238 232 239 ENDDO … … 239 246 collision_turbulence ) THEN 240 247 DO j = nys, nyn 241 DO k = nzb_s_inner(j,i)+1, nzt 242 diss(k,j,i) = dissipation(k,j) 248 DO k = nzb+1, nzt 249 diss(k,j,i) = dissipation(k,j) * & 250 MERGE( 1.0_wp, 0.0_wp, & 251 BTEST( wall_flags_0(k,j,i), 0 ) ) 243 252 ENDDO 244 253 ENDDO … … 251 260 DO i = nxl, nxr 252 261 DO j = nys, nyn 253 DO k = nzb _s_inner(j,i)+1, nzt262 DO k = nzb+1, nzt 254 263 ! 255 264 !-- Calculate the mixing length (for dissipation) … … 265 274 !-- Adjustment of the mixing length 266 275 IF ( wall_adjustment ) THEN 267 l(k,j) = MIN( wall_adjustment_factor * & 268 ( zu(k) - zw(nzb_s_inner(j,i)) ), & 276 l(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i), & 269 277 l_grid(k), l_stable ) 270 ll(k,j) = MIN( wall_adjustment_factor * & 271 ( zu(k) - zw(nzb_s_inner(j,i)) ), & 278 ll(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i), & 272 279 l_grid(k) ) 273 280 ELSE … … 282 289 !-- Calculate the tendency terms 283 290 DO j = nys, nyn 284 DO k = nzb_s_inner(j,i)+1, nzt 285 286 dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * & 291 DO k = nzb+1, nzt 292 ! 293 !-- Predetermine flag to mask topography 294 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 295 296 dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) *& 287 297 e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j) 288 298 289 tend(k,j,i) = tend(k,j,i)&299 tend(k,j,i) = tend(k,j,i) & 290 300 + ( & 291 301 ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) & 292 302 - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) & 293 ) * ddx2 303 ) * ddx2 * flag & 294 304 + ( & 295 305 ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) & 296 306 - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) & 297 ) * ddy2 307 ) * ddy2 * flag & 298 308 + ( & 299 309 ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) & … … 301 311 - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) & 302 312 * rho_air_zw(k-1) & 303 ) * ddzw(k) * drho_air(k) 304 - dissipation(k,j) 313 ) * ddzw(k) * drho_air(k) * flag & 314 - dissipation(k,j) * flag 305 315 306 316 ENDDO … … 313 323 collision_turbulence ) THEN 314 324 DO j = nys, nyn 315 DO k = nzb_s_inner(j,i)+1, nzt 316 diss(k,j,i) = dissipation(k,j) 325 DO k = nzb+1, nzt 326 diss(k,j,i) = dissipation(k,j) * & 327 MERGE( 1.0_wp, 0.0_wp, & 328 BTEST( wall_flags_0(k,j,i), 0 ) ) 317 329 ENDDO 318 330 ENDDO … … 324 336 325 337 ! 326 !-- Boundary condition for dissipation338 !-- Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:) 327 339 IF ( use_sgs_for_particles .OR. wang_kernel .OR. & 328 340 collision_turbulence ) THEN 329 DO i = nxl, nxr 330 DO j = nys, nyn 331 diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i) 332 ENDDO 333 ENDDO 341 ! 342 !-- Upward facing surfaces 343 DO m = 1, bc_h(0)%ns 344 i = bc_h(0)%i(m) 345 j = bc_h(0)%j(m) 346 k = bc_h(0)%k(m) 347 diss(k-1,j,i) = diss(k,j,i) 348 ENDDO 349 ! 350 !-- Downward facing surfaces 351 DO m = 1, bc_h(1)%ns 352 i = bc_h(1)%i(m) 353 j = bc_h(1)%j(m) 354 k = bc_h(1)%k(m) 355 diss(k+1,j,i) = diss(k,j,i) 356 ENDDO 357 334 358 ENDIF 335 359 … … 345 369 346 370 USE arrays_3d, & 347 ONLY: dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw,&371 ONLY: dd2zu, ddzu, ddzw, diss, e, km, l_grid, l_wall, tend, zu, zw,& 348 372 drho_air, rho_air_zw 349 373 … … 356 380 357 381 USE indices, & 358 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_ s_inner, nzt382 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 359 383 360 384 USE kinds … … 366 390 ONLY: use_sgs_for_particles, wang_kernel 367 391 392 USE surface_mod, & 393 ONLY : bc_h 394 368 395 IMPLICIT NONE 369 396 370 INTEGER(iwp) :: i !< 371 INTEGER(iwp) :: j !< 372 INTEGER(iwp) :: k !< 397 INTEGER(iwp) :: i !< running index x direction 398 INTEGER(iwp) :: j !< running index y direction 399 INTEGER(iwp) :: k !< running index z direction 400 INTEGER(iwp) :: m !< running index surface elements 401 INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint 402 INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint 403 373 404 REAL(wp) :: dvar_dz !< 405 REAL(wp) :: flag !< flag to mask topography 374 406 REAL(wp) :: l_stable !< 375 407 REAL(wp) :: var_reference !< … … 384 416 REAL(wp), DIMENSION(nzb+1:nzt) :: ll !< 385 417 386 387 418 ! 388 419 !-- Calculate the mixing length (for dissipation) 389 DO k = nzb_s_inner(j,i)+1, nzt 420 DO k = nzb+1, nzt 421 ! 422 !-- Predetermine flag to mask topography 423 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 424 390 425 dvar_dz = atmos_ocean_sign * & 391 426 ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k) … … 404 439 !-- Adjustment of the mixing length 405 440 IF ( wall_adjustment ) THEN 406 l(k) = MIN( wall_adjustment_factor * & 407 ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k), & 408 l_stable ) 409 ll(k) = MIN( wall_adjustment_factor * & 410 ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k) )