Changeset 4327 for palm/trunk/SOURCE/advec_ws.f90
- Timestamp:
- Dec 6, 2019 2:48:31 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/advec_ws.f90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r4325 r4327 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Setting of advection flags for vertical fluxes of w revised, air density for 28 ! vertical flux calculation of w at k=1 is considered now 29 ! 30 ! 4325 2019-12-06 07:14:04Z Giersch 27 31 ! Vertical fluxes of w are now set to zero at nzt and nzt+1, setting of 28 32 ! advection flags for fluxes in z-direction revised, comments extended … … 748 752 749 753 flag_set = .FALSE. 750 IF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 751 .NOT. BTEST(wall_flags_0(k,j,i),3) .AND. & 754 IF ( ( .NOT. BTEST(wall_flags_0(k,j,i),3) .AND. & 752 755 BTEST(wall_flags_0(k+1,j,i),3) ) .OR. & 753 ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. &754 BTEST(wall_flags_0(k,j,i),3) ) .OR. &755 756 ( .NOT. BTEST(wall_flags_0(k+1,j,i),3) .AND. & 756 757 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 757 k == nzt )&758 k == nzt -1 ) & 758 759 THEN 759 760 ! … … 765 766 advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 24 ) 766 767 flag_set = .TRUE. 767 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),3) .OR. & 768 .NOT. BTEST(wall_flags_0(k_ppp,j,i),3) ) .AND. & 769 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 770 BTEST(wall_flags_0(k,j,i),3) .AND. & 771 BTEST(wall_flags_0(k+1,j,i),3) .AND. & 772 .NOT. flag_set .OR. & 773 k == nzt - 1 ) & 768 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 769 BTEST(wall_flags_0(k,j,i),3) .AND. & 770 BTEST(wall_flags_0(k+1,j,i),3) .AND. & 771 BTEST(wall_flags_0(k_pp,j,i),3) ) .OR. & 772 ( .NOT. BTEST(wall_flags_0(k_pp,j,i),3) .AND. & 773 BTEST(wall_flags_0(k+1,j,i),3) .AND. & 774 BTEST(wall_flags_0(k,j,i),3) .AND. & 775 BTEST(wall_flags_0(k-1,j,i),3) ) .AND. & 776 .NOT. flag_set .OR. & 777 k == nzt - 2 ) & 774 778 THEN 775 779 advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 25 ) 776 780 flag_set = .TRUE. 777 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),3) .AND. & 778 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 781 ELSEIF ( BTEST(wall_flags_0(k-1,j,i),3) .AND. & 779 782 BTEST(wall_flags_0(k,j,i),3) .AND. & 780 783 BTEST(wall_flags_0(k+1,j,i),3) .AND. & 781 784 BTEST(wall_flags_0(k_pp,j,i),3) .AND. & 782 BTEST(wall_flags_0(k_ppp,j,i),3) .AND. &783 785 .NOT. flag_set ) & 784 786 THEN … … 3355 3357 k = nzb + 1 3356 3358 w_comp(k) = w(k,j,i) + w(k-1,j,i) 3357 flux_t(0) = w_comp(k) * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 3358 diss_t(0) = -ABS(w_comp(k)) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 3359 flux_t(0) = w_comp(k) * rho_air(k) & 3360 * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 3361 diss_t(0) = -ABS(w_comp(k)) * rho_air(k) & 3362 * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 3359 3363 3360 3364 DO k = nzb+1, nzb+1 … … 4574 4578 ( 37.0_wp * ibit2 * adv_mom_5 & 4575 4579 + 7.0_wp * ibit1 * adv_mom_3 & 4576 + ibit0 * adv_mom_1 &4580 + ibit0 * adv_mom_1 & 4577 4581 ) * & 4578 4582 ( u(k,j,i) + u(k,j,i-1) ) & … … 5042 5046 5043 5047 w_comp = w(k,j,i) + w(k,j,i-1) 5044 flux_t = w_comp * rho_air_zw(k) * ( &5048 flux_t = w_comp * rho_air_zw(k) * ( & 5045 5049 ( 37.0_wp * ibit8 * adv_mom_5 & 5046 5050 + 7.0_wp * ibit7 * adv_mom_3 & 5047 5051 + ibit6 * adv_mom_1 & 5048 ) * &5049 ( u(k+1,j,i) + u(k,j,i) ) &5052 ) * & 5053 ( u(k+1,j,i) + u(k,j,i) ) & 5050 5054 - ( 8.0_wp * ibit8 * adv_mom_5 & 5051 5055 + ibit7 * adv_mom_3 & 5052 ) * &5053 ( u(k_pp,j,i) + u(k-1,j,i) ) &5056 ) * & 5057 ( u(k_pp,j,i) + u(k-1,j,i) ) & 5054 5058 + ( ibit8 * adv_mom_5 & 5055 ) * &5056 ( u(k_ppp,j,i) + u(k_mm,j,i) ) &5059 ) * & 5060 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & 5057 5061 ) 5058 5062 5059 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( &5063 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 5060 5064 ( 10.0_wp * ibit8 * adv_mom_5 & 5061 5065 + 3.0_wp * ibit7 * adv_mom_3 & 5062 5066 + ibit6 * adv_mom_1 & 5063 ) * &5064 ( u(k+1,j,i) - u(k,j,i) ) &5067 ) * & 5068 ( u(k+1,j,i) - u(k,j,i) ) & 5065 5069 - ( 5.0_wp * ibit8 * adv_mom_5 & 5066 5070 + ibit7 * adv_mom_3 & 5067 ) * &5068 ( u(k_pp,j,i) - u(k-1,j,i) ) &5071 ) * & 5072 ( u(k_pp,j,i) - u(k-1,j,i) ) & 5069 5073 + ( ibit8 * adv_mom_5 & 5070 ) * &5071 ( u(k_ppp,j,i) - u(k_mm,j,i) ) &5074 ) * & 5075 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & 5072 5076 ) 5073 5077 ! … … 5075 5079 !-- correction is needed to overcome numerical instabilities caused 5076 5080 !-- by a not sufficient reduction of divergences near topography. 5077 div = ( ( u_comp - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx &5078 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy &5079 + ( w_comp * rho_air_zw(k) - &5080 ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) &5081 ) * drho_air(k) * ddzw(k) &5081 div = ( ( u_comp - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx & 5082 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy & 5083 + ( w_comp * rho_air_zw(k) - & 5084 ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 5085 ) * drho_air(k) * ddzw(k) & 5082 5086 ) * 0.5_wp 5083 5087 … … 5231 5235 u_comp = u(k,j-1,i) + u(k,j,i) - gu 5232 5236 swap_flux_x_local_v(k,j) = u_comp * ( & 5233 ( 37.0_wp * ibit11 * adv_mom_5 5234 + 7.0_wp * ibit10 * adv_mom_3 5235 + ibit9 * adv_mom_1 5237 ( 37.0_wp * ibit11 * adv_mom_5 & 5238 + 7.0_wp * ibit10 * adv_mom_3 & 5239 + ibit9 * adv_mom_1 & 5236 5240 ) * & 5237 5241 ( v(k,j,i) + v(k,j,i-1) ) & 5238 - ( 8.0_wp * ibit11 * adv_mom_5 5239 + ibit10 * adv_mom_3 5242 - ( 8.0_wp * ibit11 * adv_mom_5 & 5243 + ibit10 * adv_mom_3 & 5240 5244 ) * & 5241 5245 ( v(k,j,i+1) + v(k,j,i-2) ) & 5242 + ( ibit11 * adv_mom_5 5246 + ( ibit11 * adv_mom_5 & 5243 5247 ) * & 5244 5248 ( v(k,j,i+2) + v(k,j,i-3) ) & … … 5246 5250 5247 5251 swap_diss_x_local_v(k,j) = - ABS( u_comp ) * ( & 5248 ( 10.0_wp * ibit11 * adv_mom_5 5249 + 3.0_wp * ibit10 * adv_mom_3 5250 + ibit9 * adv_mom_1 5252 ( 10.0_wp * ibit11 * adv_mom_5 & 5253 + 3.0_wp * ibit10 * adv_mom_3 & 5254 + ibit9 * adv_mom_1 & 5251 5255 ) * & 5252 5256 ( v(k,j,i) - v(k,j,i-1) ) & 5253 - ( 5.0_wp * ibit11 * adv_mom_5 5254 + ibit10 * adv_mom_3 5257 - ( 5.0_wp * ibit11 * adv_mom_5 & 5258 + ibit10 * adv_mom_3 & 5255 5259 ) * & 5256 5260 ( v(k,j,i+1) - v(k,j,i-2) ) & 5257 + ( ibit11 * adv_mom_5 5261 + ( ibit11 * adv_mom_5 & 5258 5262 ) * & 5259 5263 ( v(k,j,i+2) - v(k,j,i-3) ) & … … 5265 5269 5266 5270 u_comp = u(k,j-1,i) + u(k,j,i) - gu 5267 swap_flux_x_local_v(k,j) = u_comp * ( &5268 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) 5269 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) 5271 swap_flux_x_local_v(k,j) = u_comp * ( & 5272 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) & 5273 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) & 5270 5274 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5 5271 swap_diss_x_local_v(k,j) = - ABS( u_comp ) * ( &5272 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) 5273 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) 5275 swap_diss_x_local_v(k,j) = - ABS( u_comp ) * ( & 5276 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) & 5277 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) & 5274 5278 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5 5275 5279 … … 5307 5311 5308 5312 v_comp = v(k,j,i) + v(k,j-1,i) - gv 5309 swap_flux_y_local_v(k) = v_comp * ( &5310 ( 37.0_wp * ibit14 * adv_mom_5 5311 + 7.0_wp * ibit13 * adv_mom_3 5312 + ibit12 * adv_mom_1 5313 ) * &5314 ( v(k,j,i) + v(k,j-1,i) ) &5315 - ( 8.0_wp * ibit14 * adv_mom_5 5316 + ibit13 * adv_mom_3 5317 ) * &5318 ( v(k,j+1,i) + v(k,j-2,i) ) &5319 + ( ibit14 * adv_mom_5 5320 ) * &5321 ( v(k,j+2,i) + v(k,j-3,i) ) &5313 swap_flux_y_local_v(k) = v_comp * ( & 5314 ( 37.0_wp * ibit14 * adv_mom_5 & 5315 + 7.0_wp * ibit13 * adv_mom_3 & 5316 + ibit12 * adv_mom_1 & 5317 ) * & 5318 ( v(k,j,i) + v(k,j-1,i) ) & 5319 - ( 8.0_wp * ibit14 * adv_mom_5 & 5320 + ibit13 * adv_mom_3 & 5321 ) * & 5322 ( v(k,j+1,i) + v(k,j-2,i) ) & 5323 + ( ibit14 * adv_mom_5 & 5324 ) * & 5325 ( v(k,j+2,i) + v(k,j-3,i) ) & 5322 5326 ) 5323 5327 5324 swap_diss_y_local_v(k) = - ABS( v_comp ) * ( &5325 ( 10.0_wp * ibit14 * adv_mom_5 5326 + 3.0_wp * ibit13 * adv_mom_3 5327 + ibit12 * adv_mom_1 5328 ) * &5329 ( v(k,j,i) - v(k,j-1,i) ) &5330 - ( 5.0_wp * ibit14 * adv_mom_5 5331 + ibit13 * adv_mom_3 5332 ) * &5333 ( v(k,j+1,i) - v(k,j-2,i) ) &5334 + ( ibit14 * adv_mom_5 5335 ) * &5336 ( v(k,j+2,i) - v(k,j-3,i) ) &5328 swap_diss_y_local_v(k) = - ABS( v_comp ) * ( & 5329 ( 10.0_wp * ibit14 * adv_mom_5 & 5330 + 3.0_wp * ibit13 * adv_mom_3 & 5331 + ibit12 * adv_mom_1 & 5332 ) * & 5333 ( v(k,j,i) - v(k,j-1,i) ) & 5334 - ( 5.0_wp * ibit14 * adv_mom_5 & 5335 + ibit13 * adv_mom_3 & 5336 ) * & 5337 ( v(k,j+1,i) - v(k,j-2,i) ) & 5338 + ( ibit14 * adv_mom_5 & 5339 ) * & 5340 ( v(k,j+2,i) - v(k,j-3,i) ) & 5337 5341 ) 5338 5342 … … 5342 5346 5343 5347 v_comp = v(k,j,i) + v(k,j-1,i) - gv 5344 swap_flux_y_local_v(k) = v_comp * ( &5345 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) 5346 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) 5348 swap_flux_y_local_v(k) = v_comp * ( & 5349 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) & 5350 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) & 5347 5351 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5 5348 swap_diss_y_local_v(k) = - ABS( v_comp ) * ( &5349 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) 5350 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) 5352 swap_diss_y_local_v(k) = - ABS( v_comp ) * ( & 5353 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) & 5354 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) & 5351 5355 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5 5352 5356 … … 5366 5370 5367 5371 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 5368 flux_r = u_comp * ( &5369 ( 37.0_wp * ibit11 * adv_mom_5 5370 + 7.0_wp * ibit10 * adv_mom_3 5372 flux_r = u_comp * ( & 5373 ( 37.0_wp * ibit11 * adv_mom_5 & 5374 + 7.0_wp * ibit10 * adv_mom_3 & 5371 5375 + ibit9 * adv_mom_1 & 5372 ) * &5373 ( v(k,j,i+1) + v(k,j,i) ) &5374 - ( 8.0_wp * ibit11 * adv_mom_5 5375 + ibit10 * adv_mom_3 5376 ) * &5377 ( v(k,j,i+2) + v(k,j,i-1) ) &5378 + ( ibit11 * adv_mom_5 5379 ) * &5380 ( v(k,j,i+3) + v(k,j,i-2) ) &5376 ) * & 5377 ( v(k,j,i+1) + v(k,j,i) ) & 5378 - ( 8.0_wp * ibit11 * adv_mom_5 & 5379 + ibit10 * adv_mom_3 & 5380 ) * & 5381 ( v(k,j,i+2) + v(k,j,i-1) ) & 5382 + ( ibit11 * adv_mom_5 & 5383 ) * & 5384 ( v(k,j,i+3) + v(k,j,i-2) ) & 5381 5385 ) 5382 5386 5383 diss_r = - ABS( u_comp ) * ( &5384 ( 10.0_wp * ibit11 * adv_mom_5 5385 + 3.0_wp * ibit10 * adv_mom_3 5387 diss_r = - ABS( u_comp ) * ( & 5388 ( 10.0_wp * ibit11 * adv_mom_5 & 5389 + 3.0_wp * ibit10 * adv_mom_3 & 5386 5390 + ibit9 * adv_mom_1 & 5387 ) * &5388 ( v(k,j,i+1) - v(k,j,i) ) &5389 - ( 5.0_wp * ibit11 * adv_mom_5 5390 + ibit10 * adv_mom_3 5391 ) * &5392 ( v(k,j,i+2) - v(k,j,i-1) ) &5393 + ( ibit11 * adv_mom_5 5394 ) * &5395 ( v(k,j,i+3) - v(k,j,i-2) ) &5391 ) * & 5392 ( v(k,j,i+1) - v(k,j,i) ) & 5393 - ( 5.0_wp * ibit11 * adv_mom_5 & 5394 + ibit10 * adv_mom_3 & 5395 ) * & 5396 ( v(k,j,i+2) - v(k,j,i-1) ) & 5397 + ( ibit11 * adv_mom_5 & 5398 ) * & 5399 ( v(k,j,i+3) - v(k,j,i-2) ) & 5396 5400 ) 5397 5401 … … 5404 5408 5405 5409 u_comp_l = u(k,j-1,i) + u(k,j,i) - gu 5406 flux_l = u_comp_l * ( &5407 ( 37.0_wp * ibit11_l * adv_mom_5 5408 + 7.0_wp * ibit10_l * adv_mom_3 5410 flux_l = u_comp_l * ( & 5411 ( 37.0_wp * ibit11_l * adv_mom_5 & 5412 + 7.0_wp * ibit10_l * adv_mom_3 & 5409 5413 + ibit9_l * adv_mom_1 & 5410 ) * &5411 ( v(k,j,i) + v(k,j,i-1) ) &5412 - ( 8.0_wp * ibit11_l * adv_mom_5 5413 + ibit10_l * adv_mom_3 5414 ) * &5415 ( v(k,j,i+1) + v(k,j,i-2) ) &5416 + ( ibit11_l * adv_mom_5 5417 ) * &5418 ( v(k,j,i+2) + v(k,j,i-3) ) &5414 ) * & 5415 ( v(k,j,i) + v(k,j,i-1) ) & 5416 - ( 8.0_wp * ibit11_l * adv_mom_5 & 5417 + ibit10_l * adv_mom_3 & 5418 ) * & 5419 ( v(k,j,i+1) + v(k,j,i-2) ) & 5420 + ( ibit11_l * adv_mom_5 & 5421 ) * & 5422 ( v(k,j,i+2) + v(k,j,i-3) ) & 5419 5423 ) 5420 5424 5421 diss_l = - ABS( u_comp_l ) * ( &5422 ( 10.0_wp * ibit11_l * adv_mom_5 5423 + 3.0_wp * ibit10_l * adv_mom_3 5425 diss_l = - ABS( u_comp_l ) * ( & 5426 ( 10.0_wp * ibit11_l * adv_mom_5 & 5427 + 3.0_wp * ibit10_l * adv_mom_3 & 5424 5428 + ibit9_l * adv_mom_1 & 5425 ) * &5426 ( v(k,j,i) - v(k,j,i-1) ) &5427 - ( 5.0_wp * ibit11_l * adv_mom_5 5428 + ibit10_l * adv_mom_3 5429 ) * &5430 ( v(k,j,i+1) - v(k,j,i-2) ) &5431 + ( ibit11_l * adv_mom_5 5432 ) * &5433 ( v(k,j,i+2) - v(k,j,i-3) ) &5429 ) * & 5430 ( v(k,j,i) - v(k,j,i-1) ) & 5431 - ( 5.0_wp * ibit11_l * adv_mom_5 & 5432 + ibit10_l * adv_mom_3 & 5433 ) * & 5434 ( v(k,j,i+1) - v(k,j,i-2) ) & 5435 + ( ibit11_l * adv_mom_5 & 5436 ) * & 5437 ( v(k,j,i+2) - v(k,j,i-3) ) & 5434 5438 ) 5435 5439 #else … … 5443 5447 5444 5448 v_comp = v(k,j+1,i) + v(k,j,i) 5445 flux_n = ( v_comp - gv ) * ( &5446 ( 37.0_wp * ibit14 * adv_mom_5 5447 + 7.0_wp * ibit13 * adv_mom_3 5448 + ibit12 * adv_mom_1 5449 ) * &5450 ( v(k,j+1,i) + v(k,j,i) ) &5451 - ( 8.0_wp * ibit14 * adv_mom_5 5452 + ibit13 * adv_mom_3 5453 ) * &5454 ( v(k,j+2,i) + v(k,j-1,i) ) &5455 + ( ibit14 * adv_mom_5 5456 ) * &5457 ( v(k,j+3,i) + v(k,j-2,i) ) &5449 flux_n = ( v_comp - gv ) * ( & 5450 ( 37.0_wp * ibit14 * adv_mom_5 & 5451 + 7.0_wp * ibit13 * adv_mom_3 & 5452 + ibit12 * adv_mom_1 & 5453 ) * & 5454 ( v(k,j+1,i) + v(k,j,i) ) & 5455 - ( 8.0_wp * ibit14 * adv_mom_5 & 5456 + ibit13 * adv_mom_3 & 5457 ) * & 5458 ( v(k,j+2,i) + v(k,j-1,i) ) & 5459 + ( ibit14 * adv_mom_5 & 5460 ) * & 5461 ( v(k,j+3,i) + v(k,j-2,i) ) & 5458 5462 ) 5459 5463 5460 diss_n = - ABS( v_comp - gv ) * ( &5461 ( 10.0_wp * ibit14 * adv_mom_5 5462 + 3.0_wp * ibit13 * adv_mom_3 5463 + ibit12 * adv_mom_1 5464 ) * &5465 ( v(k,j+1,i) - v(k,j,i) ) &5466 - ( 5.0_wp * ibit14 * adv_mom_5 5467 + ibit13 * adv_mom_3 5468 ) * &5469 ( v(k,j+2,i) - v(k,j-1,i) ) &5470 + ( ibit14 * adv_mom_5 5471 ) * &5472 ( v(k,j+3,i) - v(k,j-2,i) ) &5464 diss_n = - ABS( v_comp - gv ) * ( & 5465 ( 10.0_wp * ibit14 * adv_mom_5 & 5466 + 3.0_wp * ibit13 * adv_mom_3 & 5467 + ibit12 * adv_mom_1 & 5468 ) * & 5469 ( v(k,j+1,i) - v(k,j,i) ) & 5470 - ( 5.0_wp * ibit14 * adv_mom_5 & 5471 + ibit13 * adv_mom_3 & 5472 ) * & 5473 ( v(k,j+2,i) - v(k,j-1,i) ) & 5474 + ( ibit14 * adv_mom_5 & 5475 ) * & 5476 ( v(k,j+3,i) - v(k,j-2,i) ) & 5473 5477 ) 5474 5478 … … 5481 5485 5482 5486 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv 5483 flux_s = v_comp_s * ( &5484 ( 37.0_wp * ibit14_s * adv_mom_5 5485 + 7.0_wp * ibit13_s * adv_mom_3 5486 + ibit12_s * adv_mom_1 5487 ) * &5488 ( v(k,j,i) + v(k,j-1,i) ) &5489 - ( 8.0_wp * ibit14_s * adv_mom_5 5490 + ibit13_s * adv_mom_3 5491 ) * &5492 ( v(k,j+1,i) + v(k,j-2,i) ) &5493 + ( ibit14_s * adv_mom_5 5494 ) * &5495 ( v(k,j+2,i) + v(k,j-3,i) ) &5487 flux_s = v_comp_s * ( & 5488 ( 37.0_wp * ibit14_s * adv_mom_5 & 5489 + 7.0_wp * ibit13_s * adv_mom_3 & 5490 + ibit12_s * adv_mom_1 & 5491 ) * & 5492 ( v(k,j,i) + v(k,j-1,i) ) & 5493 - ( 8.0_wp * ibit14_s * adv_mom_5 & 5494 + ibit13_s * adv_mom_3 & 5495 ) * & 5496 ( v(k,j+1,i) + v(k,j-2,i) ) & 5497 + ( ibit14_s * adv_mom_5 & 5498 ) * & 5499 ( v(k,j+2,i) + v(k,j-3,i) ) & 5496 5500 ) 5497 5501 5498 diss_s = - ABS( v_comp_s ) * ( &5499 ( 10.0_wp * ibit14_s * adv_mom_5 5500 + 3.0_wp * ibit13_s * adv_mom_3 5501 + ibit12_s * adv_mom_1 5502 ) * &5503 ( v(k,j,i) - v(k,j-1,i) ) &5504 - ( 5.0_wp * ibit14_s * adv_mom_5 5505 + ibit13_s * adv_mom_3 5506 ) * &5507 ( v(k,j+1,i) - v(k,j-2,i) ) &5508 + ( ibit14_s * adv_mom_5 5509 ) * &5510 ( v(k,j+2,i) - v(k,j-3,i) ) &5502 diss_s = - ABS( v_comp_s ) * ( & 5503 ( 10.0_wp * ibit14_s * adv_mom_5 & 5504 + 3.0_wp * ibit13_s * adv_mom_3 & 5505 + ibit12_s * adv_mom_1 & 5506 ) * & 5507 ( v(k,j,i) - v(k,j-1,i) ) & 5508 - ( 5.0_wp * ibit14_s * adv_mom_5 & 5509 + ibit13_s * adv_mom_3 & 5510 ) * & 5511 ( v(k,j+1,i) - v(k,j-2,i) ) & 5512 + ( ibit14_s * adv_mom_5 & 5513 ) * & 5514 ( v(k,j+2,i) - v(k,j-3,i) ) & 5511 5515 ) 5512 5516 #else … … 5527 5531 5528 5532 w_comp = w(k,j-1,i) + w(k,j,i) 5529 flux_t = w_comp * rho_air_zw(k) * ( &5530 ( 37.0_wp * ibit17 * adv_mom_5 5531 + 7.0_wp * ibit16 * adv_mom_3 5532 + ibit15 * adv_mom_1 5533 ) * &5534 ( v(k+1,j,i) + v(k,j,i) ) &5535 - ( 8.0_wp * ibit17 * adv_mom_5 5536 + ibit16 * adv_mom_3 5537 ) * &5538 ( v(k_pp,j,i) + v(k-1,j,i) ) &5539 + ( ibit17 * adv_mom_5 5540 ) * &5541 ( v(k_ppp,j,i) + v(k_mm,j,i) ) &5533 flux_t = w_comp * rho_air_zw(k) * ( & 5534 ( 37.0_wp * ibit17 * adv_mom_5 & 5535 + 7.0_wp * ibit16 * adv_mom_3 & 5536 + ibit15 * adv_mom_1 & 5537 ) * & 5538 ( v(k+1,j,i) + v(k,j,i) ) & 5539 - ( 8.0_wp * ibit17 * adv_mom_5 & 5540 + ibit16 * adv_mom_3 & 5541 ) * & 5542 ( v(k_pp,j,i) + v(k-1,j,i) ) & 5543 + ( ibit17 * adv_mom_5 & 5544 ) * & 5545 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & 5542 5546 ) 5543 5547 5544 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( &5545 ( 10.0_wp * ibit17 * adv_mom_5 5546 + 3.0_wp * ibit16 * adv_mom_3 5547 + ibit15 * adv_mom_1 5548 ) * &5549 ( v(k+1,j,i) - v(k,j,i) ) &5550 - ( 5.0_wp * ibit17 * adv_mom_5 5551 + ibit16 * adv_mom_3 5552 ) * &5553 ( v(k_pp,j,i) - v(k-1,j,i) ) &5554 + ( ibit17 * adv_mom_5 5555 ) * &5556 ( v(k_ppp,j,i) - v(k_mm,j,i) ) &5548 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 5549 ( 10.0_wp * ibit17 * adv_mom_5 & 5550 + 3.0_wp * ibit16 * adv_mom_3 & 5551 + ibit15 * adv_mom_1 & 5552 ) * & 5553 ( v(k+1,j,i) - v(k,j,i) ) & 5554 - ( 5.0_wp * ibit17 * adv_mom_5 & 5555 + ibit16 * adv_mom_3 & 5556 ) * & 5557 ( v(k_pp,j,i) - v(k-1,j,i) ) & 5558 + ( ibit17 * adv_mom_5 & 5559 ) * & 5560 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & 5557 5561 ) 5558 5562 ! … … 5560 5564 !-- correction is needed to overcome numerical instabilities caused 5561 5565 !-- by a not sufficient reduction of divergences near topography. 5562 div = ( ( ( u_comp + gu ) &5563 * ( ibit9 + ibit10 + ibit11 ) &5564 - ( u(k,j-1,i) + u(k,j,i) ) &5565 * ( &5566 REAL( IBITS(advc_flags_m(k,j,i-1),9,1), KIND = wp ) &5567 + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp ) &5568 + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp ) &5569 ) &5570 ) * ddx &5571 + ( v_comp &5572 * ( ibit12 + ibit13 + ibit14 ) &5573 - ( v(k,j,i) + v(k,j-1,i) ) &5574 * ( &5575 REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp ) &5576 + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp ) &5577 + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp ) &5578 ) &5579 ) * ddy &5580 + ( w_comp * rho_air_zw(k) &5581 * ( ibit15 + ibit16 + ibit17 ) &5582 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) &5583 * ( &5584 REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp ) &5585 + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp ) &5586 + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp ) &5587 ) &5588 ) * drho_air(k) * ddzw(k) &5566 div = ( ( ( u_comp + gu ) & 5567 * ( ibit9 + ibit10 + ibit11 ) & 5568 - ( u(k,j-1,i) + u(k,j,i) ) & 5569 * ( & 5570 REAL( IBITS(advc_flags_m(k,j,i-1),9,1), KIND = wp ) & 5571 + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp ) & 5572 + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp ) & 5573 ) & 5574 ) * ddx & 5575 + ( v_comp & 5576 * ( ibit12 + ibit13 + ibit14 ) & 5577 - ( v(k,j,i) + v(k,j-1,i) ) & 5578 * ( & 5579 REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp ) & 5580 + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp ) & 5581 + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp ) & 5582 ) & 5583 ) * ddy & 5584 + ( w_comp * rho_air_zw(k) & 5585 * ( ibit15 + ibit16 + ibit17 ) & 5586 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 5587 * ( & 5588 REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp ) & 5589 + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp ) & 5590 + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp ) & 5591 ) & 5592 ) * drho_air(k) * ddzw(k) & 5589 5593 ) * 0.5_wp 5590 5594 5591 5595 5592 tend(k,j,i) = tend(k,j,i) - ( &5593 ( ( flux_r + diss_r ) &5594 - ( flux_l + diss_l ) ) * ddx &5595 + ( ( flux_n + diss_n ) &5596 - ( flux_s + diss_s ) ) * ddy &5597 + ( ( flux_t + diss_t ) &5598 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) &5596 tend(k,j,i) = tend(k,j,i) - ( & 5597 ( ( flux_r + diss_r ) & 5598 - ( flux_l + diss_l ) ) * ddx & 5599 + ( ( flux_n + diss_n ) & 5600 - ( flux_s + diss_s ) ) * ddy & 5601 + ( ( flux_t + diss_t ) & 5602 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 5599 5603 ) + v(k,j,i) * div 5600 5604 … … 5637 5641 5638 5642 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 5639 flux_r = u_comp * ( &5640 37.0_wp * ( v(k,j,i+1) + v(k,j,i) ) 5641 - 8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) ) 5643 flux_r = u_comp * ( & 5644 37.0_wp * ( v(k,j,i+1) + v(k,j,i) ) & 5645 - 8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) ) & 5642 5646 + ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5 5643 5647 5644 diss_r = - ABS( u_comp ) * ( &5645 10.0_wp * ( v(k,j,i+1) - v(k,j,i) ) 5646 - 5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) ) 5648 diss_r = - ABS( u_comp ) * ( & 5649 10.0_wp * ( v(k,j,i+1) - v(k,j,i) ) & 5650 - 5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) ) & 5647 5651 + ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5 5648 5652 … … 5651 5655 !-- Recompute the left fluxes. 5652 5656 u_comp_l = u(k,j-1,i) + u(k,j,i) - gu 5653 flux_l = u_comp_l * ( &5654 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) 5655 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) 5657 flux_l = u_comp_l * ( & 5658 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) & 5659 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) & 5656 5660 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5 5657 diss_l = - ABS( u_comp_l ) * ( &5658 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) 5659 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) 5661 diss_l = - ABS( u_comp_l ) * ( & 5662 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) & 5663 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) & 5660 5664 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5 5661 5665 #else … … 5665 5669 5666 5670 v_comp = v(k,j+1,i) + v(k,j,i) 5667 flux_n = ( v_comp - gv ) * ( &5668 37.0_wp * ( v(k,j+1,i) + v(k,j,i) ) 5669 - 8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) ) 5671 flux_n = ( v_comp - gv ) * ( & 5672 37.0_wp * ( v(k,j+1,i) + v(k,j,i) ) & 5673 - 8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) ) & 5670 5674 + ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5 5671 5675 5672 diss_n = - ABS( v_comp - gv ) * ( &5673 10.0_wp * ( v(k,j+1,i) - v(k,j,i) ) 5674 - 5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) ) 5676 diss_n = - ABS( v_comp - gv ) * ( & 5677 10.0_wp * ( v(k,j+1,i) - v(k,j,i) ) & 5678 - 5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) ) & 5675 5679 + ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5 5676 5680 … … 5679 5683 !-- Recompute the south fluxes. 5680 5684 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv 5681 flux_s = v_comp_s * ( &5682 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) 5683 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) 5685 flux_s = v_comp_s * ( & 5686 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) & 5687 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) & 5684 5688 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5 5685 diss_s = - ABS( v_comp_s ) * ( &5686 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) 5687 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) 5689 diss_s = - ABS( v_comp_s ) * ( & 5690 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) & 5691 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) & 5688 5692 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5 5689 5693 #else … … 5704 5708 5705 5709 w_comp = w(k,j-1,i) + w(k,j,i) 5706 flux_t = w_comp * rho_air_zw(k) * ( &5707 ( 37.0_wp * ibit17 * adv_mom_5 5708 + 7.0_wp * ibit16 * adv_mom_3 5709 + ibit15 * adv_mom_1 5710 ) * &5711 ( v(k+1,j,i) + v(k,j,i) ) &5712 - ( 8.0_wp * ibit17 * adv_mom_5 5713 + ibit16 * adv_mom_3 5714 ) * &5715 ( v(k_pp,j,i) + v(k-1,j,i) ) &5716 + ( ibit17 * adv_mom_5 5717 ) * &5718 ( v(k_ppp,j,i) + v(k_mm,j,i) ) &5710 flux_t = w_comp * rho_air_zw(k) * ( & 5711 ( 37.0_wp * ibit17 * adv_mom_5 & 5712 + 7.0_wp * ibit16 * adv_mom_3 & 5713 + ibit15 * adv_mom_1 & 5714 ) * & 5715 ( v(k+1,j,i) + v(k,j,i) ) & 5716 - ( 8.0_wp * ibit17 * adv_mom_5 & 5717 + ibit16 * adv_mom_3 & 5718 ) * & 5719 ( v(k_pp,j,i) + v(k-1,j,i) ) & 5720 + ( ibit17 * adv_mom_5 & 5721 ) * & 5722 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & 5719 5723 ) 5720 5724 5721 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( &5722 ( 10.0_wp * ibit17 * adv_mom_5 5723 + 3.0_wp * ibit16 * adv_mom_3 5724 + ibit15 * adv_mom_1 5725 ) * &5726 ( v(k+1,j,i) - v(k,j,i) ) &5727 - ( 5.0_wp * ibit17 * adv_mom_5 5728 + ibit16 * adv_mom_3 5729 ) * &5730 ( v(k_pp,j,i) - v(k-1,j,i) ) &5731 + ( ibit17 * adv_mom_5 5732 ) * &5733 ( v(k_ppp,j,i) - v(k_mm,j,i) ) &5725 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 5726 ( 10.0_wp * ibit17 * adv_mom_5 & 5727 + 3.0_wp * ibit16 * adv_mom_3 & 5728 + ibit15 * adv_mom_1 & 5729 ) * & 5730 ( v(k+1,j,i) - v(k,j,i) ) & 5731 - ( 5.0_wp * ibit17 * adv_mom_5 & 5732 + ibit16 * adv_mom_3 & 5733 ) * & 5734 ( v(k_pp,j,i) - v(k-1,j,i) ) & 5735 + ( ibit17 * adv_mom_5 & 5736 ) * & 5737 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & 5734 5738 ) 5735 5739 ! … … 5737 5741 !-- correction is needed to overcome numerical instabilities caused 5738 5742 !-- by a not sufficient reduction of divergences near topography. 5739 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx &5740 + ( v_comp - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy &5741 + ( w_comp * rho_air_zw(k) - &5742 ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) &5743 ) * drho_air(k) * ddzw(k) &5743 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx & 5744 + ( v_comp - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy & 5745 + ( w_comp * rho_air_zw(k) - & 5746 ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 5747 ) * drho_air(k) * ddzw(k) & 5744 5748 ) * 0.5_wp 5745 5749 5746 tend(k,j,i) = tend(k,j,i) - ( &5747 ( ( flux_r + diss_r ) &5748 - ( flux_l + diss_l ) ) * ddx &5749 + ( ( flux_n + diss_n ) &5750 - ( flux_s + diss_s ) ) * ddy &5751 + ( ( flux_t + diss_t ) &5752 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) &5750 tend(k,j,i) = tend(k,j,i) - ( & 5751 ( ( flux_r + diss_r ) & 5752 - ( flux_l + diss_l ) ) * ddx & 5753 + ( ( flux_n + diss_n ) & 5754 - ( flux_s + diss_s ) ) * ddy & 5755 + ( ( flux_t + diss_t ) & 5756 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 5753 5757 ) + v(k,j,i) * div 5754 5758 … … 5896 5900 u_comp = u(k+1,j,i) + u(k,j,i) - gu 5897 5901 swap_flux_x_local_w(k,j) = u_comp * ( & 5898 ( 37.0_wp * ibit20 * adv_mom_5 5899 + 7.0_wp * ibit19 * adv_mom_3 5900 + ibit18 * adv_mom_1 5902 ( 37.0_wp * ibit20 * adv_mom_5 & 5903 + 7.0_wp * ibit19 * adv_mom_3 & 5904 + ibit18 * adv_mom_1 & 5901 5905 ) * & 5902 5906 ( w(k,j,i) + w(k,j,i-1) ) & 5903 - ( 8.0_wp * ibit20 * adv_mom_5 5904 + ibit19 * adv_mom_3 5907 - ( 8.0_wp * ibit20 * adv_mom_5 & 5908 + ibit19 * adv_mom_3 & 5905 5909 ) * & 5906 5910 ( w(k,j,i+1) + w(k,j,i-2) ) & 5907 + ( ibit20 * adv_mom_5 5911 + ( ibit20 * adv_mom_5 & 5908 5912 ) * & 5909 5913 ( w(k,j,i+2) + w(k,j,i-3) ) & … … 5911 5915 5912 5916 swap_diss_x_local_w(k,j) = - ABS( u_comp ) * ( & 5913 ( 10.0_wp * ibit20 * adv_mom_5 5914 + 3.0_wp * ibit19 * adv_mom_3 5915 + ibit18 * adv_mom_1 5917 ( 10.0_wp * ibit20 * adv_mom_5 & 5918 + 3.0_wp * ibit19 * adv_mom_3 & 5919 + ibit18 * adv_mom_1 & 5916 5920 ) * & 5917 5921 ( w(k,j,i) - w(k,j,i-1) ) & 5918 - ( 5.0_wp * ibit20 * adv_mom_5 5919 + ibit19 * adv_mom_3 5922 - ( 5.0_wp * ibit20 * adv_mom_5 & 5923 + ibit19 * adv_mom_3 & 5920 5924 ) * & 5921 5925 ( w(k,j,i+1) - w(k,j,i-2) ) & 5922 + ( ibit20 * adv_mom_5 5926 + ( ibit20 * adv_mom_5 & 5923 5927 ) * & 5924 5928 ( w(k,j,i+2) - w(k,j,i-3) ) & … … 5931 5935 u_comp = u(k+1,j,i) + u(k,j,i) - gu 5932 5936 swap_flux_x_local_w(k,j) = u_comp * ( & 5933 37.0_wp * ( w(k,j,i) + w(k,j,i-1) ) 5934 - 8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) ) 5937 37.0_wp * ( w(k,j,i) + w(k,j,i-1) ) & 5938 - 8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) ) & 5935 5939 + ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5 5936 5940 swap_diss_x_local_w(k,j) = - ABS( u_comp ) * ( & 5937 10.0_wp * ( w(k,j,i) - w(k,j,i-1) ) 5938 - 5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) ) 5941 10.0_wp * ( w(k,j,i) - w(k,j,i-1) ) & 5942 - 5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) ) & 5939 5943 + ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 5940 5944 … … 5972 5976 5973 5977 v_comp = v(k+1,j,i) + v(k,j,i) - gv 5974 swap_flux_y_local_w(k) = v_comp * ( &5975 ( 37.0_wp * ibit23 * adv_mom_5 5976 + 7.0_wp * ibit22 * adv_mom_3 5977 + ibit21 * adv_mom_1 5978 swap_flux_y_local_w(k) = v_comp * ( & 5979 ( 37.0_wp * ibit23 * adv_mom_5 & 5980 + 7.0_wp * ibit22 * adv_mom_3 & 5981 + ibit21 * adv_mom_1 & 5978 5982 ) * & 5979 ( w(k,j,i) + w(k,j-1,i) ) &5980 - ( 8.0_wp * ibit23 * adv_mom_5 5981 + ibit22 * adv_mom_3 5982 ) * &5983 ( w(k,j+1,i) + w(k,j-2,i) ) &5984 + ( ibit23 * adv_mom_5 5985 ) * &5986 ( w(k,j+2,i) + w(k,j-3,i) ) &5983 ( w(k,j,i) + w(k,j-1,i) ) & 5984 - ( 8.0_wp * ibit23 * adv_mom_5 & 5985 + ibit22 * adv_mom_3 & 5986 ) * & 5987 ( w(k,j+1,i) + w(k,j-2,i) ) & 5988 + ( ibit23 * adv_mom_5 & 5989 ) * & 5990 ( w(k,j+2,i) + w(k,j-3,i) ) & 5987 5991 ) 5988 5992 5989 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( &5990 ( 10.0_wp * ibit23 * adv_mom_5 5991 + 3.0_wp * ibit22 * adv_mom_3 5992 + ibit21 * adv_mom_1 5993 ) * &5994 ( w(k,j,i) - w(k,j-1,i) ) &5995 - ( 5.0_wp * ibit23 * adv_mom_5 5996 + ibit22 * adv_mom_3 5997 ) * &5998 ( w(k,j+1,i) - w(k,j-2,i) ) &5999 + ( ibit23 * adv_mom_5 6000 ) * &6001 ( w(k,j+2,i) - w(k,j-3,i) ) &5993 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( & 5994 ( 10.0_wp * ibit23 * adv_mom_5 & 5995 + 3.0_wp * ibit22 * adv_mom_3 & 5996 + ibit21 * adv_mom_1 & 5997 ) * & 5998 ( w(k,j,i) - w(k,j-1,i) ) & 5999 - ( 5.0_wp * ibit23 * adv_mom_5 & 6000 + ibit22 * adv_mom_3 & 6001 ) * & 6002 ( w(k,j+1,i) - w(k,j-2,i) ) & 6003 + ( ibit23 * adv_mom_5 & 6004 ) * & 6005 ( w(k,j+2,i) - w(k,j-3,i) ) & 6002 6006 ) 6003 6007 … … 6007 6011 6008 6012 v_comp = v(k+1,j,i) + v(k,j,i) - gv 6009 swap_flux_y_local_w(k) = v_comp * ( &6010 37.0_wp * ( w(k,j,i) + w(k,j-1,i) ) 6011 - 8.0_wp * ( w(k,j+1,i) +w(k,j-2,i) ) 6013 swap_flux_y_local_w(k) = v_comp * ( & 6014 37.0_wp * ( w(k,j,i) + w(k,j-1,i) ) & 6015 - 8.0_wp * ( w(k,j+1,i) +w(k,j-2,i) ) & 6012 6016 + ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5 6013 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( &6014 10.0_wp * ( w(k,j,i) - w(k,j-1,i) ) 6015 - 5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) ) 6017 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( & 6018 10.0_wp * ( w(k,j,i) - w(k,j-1,i) ) & 6019 - 5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) ) & 6016 6020 + ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5 6017 6021 … … 6027 6031 k = nzb + 1 6028 6032 w_comp = w(k,j,i) + w(k-1,j,i) 6029 flux_d = w_comp * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 6030 diss_d = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 6033 flux_d = w_comp * rho_air(k) & 6034 * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 6035 diss_d = -ABS(w_comp) * rho_air(k) & 6036 * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 6031 6037 6032 6038 DO k = nzb+1, nzb_max_l … … 6037 6043 6038 6044 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 6039 flux_r = u_comp * ( &6040 ( 37.0_wp * ibit20 * adv_mom_5 6041 + 7.0_wp * ibit19 * adv_mom_3 6042 + ibit18 * adv_mom_1 6043 ) * &6044 ( w(k,j,i+1) + w(k,j,i) ) &6045 - ( 8.0_wp * ibit20 * adv_mom_5 6046 + ibit19 * adv_mom_3 6047 ) * &6048 ( w(k,j,i+2) + w(k,j,i-1) ) &6049 + ( ibit20 * adv_mom_5 6050 ) * &6051 ( w(k,j,i+3) + w(k,j,i-2) ) &6045 flux_r = u_comp * ( & 6046 ( 37.0_wp * ibit20 * adv_mom_5 & 6047 + 7.0_wp * ibit19 * adv_mom_3 & 6048 + ibit18 * adv_mom_1 & 6049 ) * & 6050 ( w(k,j,i+1) + w(k,j,i) ) & 6051 - ( 8.0_wp * ibit20 * adv_mom_5 & 6052 + ibit19 * adv_mom_3 & 6053 ) * & 6054 ( w(k,j,i+2) + w(k,j,i-1) ) & 6055 + ( ibit20 * adv_mom_5 & 6056 ) * & 6057 ( w(k,j,i+3) + w(k,j,i-2) ) & 6052 6058 ) 6053 6059 6054 diss_r = - ABS( u_comp ) * ( &6055 ( 10.0_wp * ibit20 * adv_mom_5 6056 + 3.0_wp * ibit19 * adv_mom_3 6057 + ibit18 * adv_mom_1 6058 ) * &6059 ( w(k,j,i+1) - w(k,j,i) ) &6060 - ( 5.0_wp * ibit20 * adv_mom_5 6061 + ibit19 * adv_mom_3 6062 ) * &6063 ( w(k,j,i+2) - w(k,j,i-1) ) &6064 + ( ibit20 * adv_mom_5 6065 ) * &6066 ( w(k,j,i+3) - w(k,j,i-2) ) &6060 diss_r = - ABS( u_comp ) * ( & 6061 ( 10.0_wp * ibit20 * adv_mom_5 & 6062 + 3.0_wp * ibit19 * adv_mom_3 & 6063 + ibit18 * adv_mom_1 & 6064 ) * & 6065 ( w(k,j,i+1) - w(k,j,i) ) & 6066 - ( 5.0_wp * ibit20 * adv_mom_5 & 6067 + ibit19 * adv_mom_3 & 6068 ) * & 6069 ( w(k,j,i+2) - w(k,j,i-1) ) & 6070 + ( ibit20 * adv_mom_5 & 6071 ) * & 6072 ( w(k,j,i+3) - w(k,j,i-2) ) & 6067 6073 ) 6068 6074 … … 6075 6081 6076 6082 u_comp_l = u(k+1,j,i) + u(k,j,i) - gu 6077 flux_l = u_comp_l * ( &6078 ( 37.0_wp * ibit20_l * adv_mom_5 6079 + 7.0_wp * ibit19_l * adv_mom_3 6080 + ibit18_l * adv_mom_1 6081 ) * &6082 ( w(k,j,i) + w(k,j,i-1) ) &6083 - ( 8.0_wp * ibit20_l * adv_mom_5 6084 + ibit19_l * adv_mom_3 6085 ) * &6086 ( w(k,j,i+1) + w(k,j,i-2) ) &6087 + ( ibit20_l * adv_mom_5 6088 ) * &6089 ( w(k,j,i+2) + w(k,j,i-3) ) &6083 flux_l = u_comp_l * ( & 6084 ( 37.0_wp * ibit20_l * adv_mom_5 & 6085 + 7.0_wp * ibit19_l * adv_mom_3 & 6086 + ibit18_l * adv_mom_1 & 6087 ) * & 6088 ( w(k,j,i) + w(k,j,i-1) ) & 6089 - ( 8.0_wp * ibit20_l * adv_mom_5 & 6090 + ibit19_l * adv_mom_3 & 6091 ) * & 6092 ( w(k,j,i+1) + w(k,j,i-2) ) & 6093 + ( ibit20_l * adv_mom_5 & 6094 ) * & 6095 ( w(k,j,i+2) + w(k,j,i-3) ) & 6090 6096 ) 6091 6097 6092 diss_l = - ABS( u_comp_l ) * ( &6093 ( 10.0_wp * ibit20_l * adv_mom_5 6094 + 3.0_wp * ibit19_l * adv_mom_3 6095 + ibit18_l * adv_mom_1 6096 ) * &6097 ( w(k,j,i) - w(k,j,i-1) ) &6098 - ( 5.0_wp * ibit20_l * adv_mom_5 6099 + ibit19_l * adv_mom_3 6100 ) * &6101 ( w(k,j,i+1) - w(k,j,i-2) ) &6102 + ( ibit20_l * adv_mom_5 6103 ) * &6104 ( w(k,j,i+2) - w(k,j,i-3) ) &6098 diss_l = - ABS( u_comp_l ) * ( & 6099 ( 10.0_wp * ibit20_l * adv_mom_5 & 6100 + 3.0_wp * ibit19_l * adv_mom_3 & 6101 + ibit18_l * adv_mom_1 & 6102 ) * & 6103 ( w(k,j,i) - w(k,j,i-1) ) & 6104 - ( 5.0_wp * ibit20_l * adv_mom_5 & 6105 + ibit19_l * adv_mom_3 & 6106 ) * & 6107 ( w(k,j,i+1) - w(k,j,i-2) ) & 6108 + ( ibit20_l * adv_mom_5 & 6109 ) * & 6110 ( w(k,j,i+2) - w(k,j,i-3) ) & 6105 6111 ) 6106 6112 #else … … 6115 6121 6116 6122 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 6117 flux_n = v_comp * ( &6118 ( 37.0_wp * ibit23 * adv_mom_5 6119 + 7.0_wp * ibit22 * adv_mom_3 6120 + ibit21 * adv_mom_1 6121 ) * &6122 ( w(k,j+1,i) + w(k,j,i) ) &6123 - ( 8.0_wp * ibit23 * adv_mom_5 6124 + ibit22 * adv_mom_3 6125 ) * &6126 ( w(k,j+2,i) + w(k,j-1,i) ) &6127 + ( ibit23 * adv_mom_5 6128 ) * &6129 ( w(k,j+3,i) + w(k,j-2,i) ) &6123 flux_n = v_comp * ( & 6124 ( 37.0_wp * ibit23 * adv_mom_5 & 6125 + 7.0_wp * ibit22 * adv_mom_3 & 6126 + ibit21 * adv_mom_1 & 6127 ) * & 6128 ( w(k,j+1,i) + w(k,j,i) ) & 6129 - ( 8.0_wp * ibit23 * adv_mom_5 & 6130 + ibit22 * adv_mom_3 & 6131 ) * & 6132 ( w(k,j+2,i) + w(k,j-1,i) ) & 6133 + ( ibit23 * adv_mom_5 & 6134 ) * & 6135 ( w(k,j+3,i) + w(k,j-2,i) ) & 6130 6136 ) 6131 6137 6132 diss_n = - ABS( v_comp ) * ( &6133 ( 10.0_wp * ibit23 * adv_mom_5 6134 + 3.0_wp * ibit22 * adv_mom_3 6135 + ibit21 * adv_mom_1 6136 ) * &6137 ( w(k,j+1,i) - w(k,j,i) ) &6138 - ( 5.0_wp * ibit23 * adv_mom_5 6139 + ibit22 * adv_mom_3 6140 ) * &6141 ( w(k,j+2,i) - w(k,j-1,i) ) &6142 + ( ibit23 * adv_mom_5 6143 ) * &6144 ( w(k,j+3,i) - w(k,j-2,i) ) &6138 diss_n = - ABS( v_comp ) * ( & 6139 ( 10.0_wp * ibit23 * adv_mom_5 & 6140 + 3.0_wp * ibit22 * adv_mom_3 & 6141 + ibit21 * adv_mom_1 & 6142 ) * & 6143 ( w(k,j+1,i) - w(k,j,i) ) & 6144 - ( 5.0_wp * ibit23 * adv_mom_5 & 6145 + ibit22 * adv_mom_3 & 6146 ) * & 6147 ( w(k,j+2,i) - w(k,j-1,i) ) & 6148 + ( ibit23 * adv_mom_5 & 6149 ) * & 6150 ( w(k,j+3,i) - w(k,j-2,i) ) & 6145 6151 ) 6146 6152 … … 6153 6159 6154 6160 v_comp_s = v(k+1,j,i) + v(k,j,i) - gv 6155 flux_s = v_comp_s * ( &6156 ( 37.0_wp * ibit23_s * adv_mom_5 6157 + 7.0_wp * ibit22_s * adv_mom_3 6158 + ibit21_s * adv_mom_1 6159 ) * &6160 ( w(k,j,i) + w(k,j-1,i) ) &6161 - ( 8.0_wp * ibit23_s * adv_mom_5 6162 + ibit22_s * adv_mom_3 6163 ) * &6164 ( w(k,j+1,i) + w(k,j-2,i) ) &6165 + ( ibit23_s * adv_mom_5 6166 ) * &6167 ( w(k,j+2,i) + w(k,j-3,i) ) &6161 flux_s = v_comp_s * ( & 6162 ( 37.0_wp * ibit23_s * adv_mom_5 & 6163 + 7.0_wp * ibit22_s * adv_mom_3 & 6164 + ibit21_s * adv_mom_1 & 6165 ) * & 6166 ( w(k,j,i) + w(k,j-1,i) ) & 6167 - ( 8.0_wp * ibit23_s * adv_mom_5 & 6168 + ibit22_s * adv_mom_3 & 6169 ) * & 6170 ( w(k,j+1,i) + w(k,j-2,i) ) & 6171 + ( ibit23_s * adv_mom_5 & 6172 ) * & 6173 ( w(k,j+2,i) + w(k,j-3,i) ) & 6168 6174 ) 6169 6175 6170 diss_s = - ABS( v_comp_s ) * ( &6171 ( 10.0_wp * ibit23_s * adv_mom_5 6172 + 3.0_wp * ibit22_s * adv_mom_3 6173 + ibit21_s * adv_mom_1 6174 ) * &6175 ( w(k,j,i) - w(k,j-1,i) ) &6176 - ( 5.0_wp * ibit23_s * adv_mom_5 6177 + ibit22_s * adv_mom_3 6178 ) * &6179 ( w(k,j+1,i) - w(k,j-2,i) ) &6180 + ( ibit23_s * adv_mom_5 6181 ) * &6182 ( w(k,j+2,i) - w(k,j-3,i) ) &6176 diss_s = - ABS( v_comp_s ) * ( & 6177 ( 10.0_wp * ibit23_s * adv_mom_5 & 6178 + 3.0_wp * ibit22_s * adv_mom_3 & 6179 + ibit21_s * adv_mom_1 & 6180 ) * & 6181 ( w(k,j,i) - w(k,j-1,i) ) & 6182 - ( 5.0_wp * ibit23_s * adv_mom_5 & 6183 + ibit22_s * adv_mom_3 & 6184 ) * & 6185 ( w(k,j+1,i) - w(k,j-2,i) ) & 6186 + ( ibit23_s * adv_mom_5 & 6187 ) * & 6188 ( w(k,j+2,i) - w(k,j-3,i) ) & 6183 6189 ) 6184 6190 #else … … 6199 6205 6200 6206 w_comp = w(k+1,j,i) + w(k,j,i) 6201 flux_t = w_comp * rho_air(k+1) * ( &6202 ( 37.0_wp * ibit26 * adv_mom_5 6203 + 7.0_wp * ibit25 * adv_mom_3 6204 + ibit24 * adv_mom_1 6205 ) * &6206 ( w(k+1,j,i) + w(k,j,i) ) &6207 - ( 8.0_wp * ibit26 * adv_mom_5 6208 + ibit25 * adv_mom_3 6209 ) * &6210 ( w(k_pp,j,i) + w(k-1,j,i) ) &6211 + ( ibit26 * adv_mom_5 6212 ) * &6213 ( w(k_ppp,j,i) + w(k_mm,j,i) ) &6207 flux_t = w_comp * rho_air(k+1) * ( & 6208 ( 37.0_wp * ibit26 * adv_mom_5 & 6209 + 7.0_wp * ibit25 * adv_mom_3 & 6210 + ibit24 * adv_mom_1 & 6211 ) * & 6212 ( w(k+1,j,i) + w(k,j,i) ) & 6213 - ( 8.0_wp * ibit26 * adv_mom_5 & 6214 + ibit25 * adv_mom_3 & 6215 ) * & 6216 ( w(k_pp,j,i) + w(k-1,j,i) ) & 6217 + ( ibit26 * adv_mom_5 & 6218 ) * & 6219 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & 6214 6220 ) 6215 6221 6216 diss_t = - ABS( w_comp ) * rho_air(k+1) * ( &6217 ( 10.0_wp * ibit26 * adv_mom_5 6218 + 3.0_wp * ibit25 * adv_mom_3 6219 + ibit24 * adv_mom_1 6220 ) * &6221 ( w(k+1,j,i) - w(k,j,i) ) &6222 - ( 5.0_wp * ibit26 * adv_mom_5 6223 + ibit25 * adv_mom_3 6224 ) * &6225 ( w(k_pp,j,i) - w(k-1,j,i) ) &6226 + ( ibit26 * adv_mom_5 6227 ) * &6228 ( w(k_ppp,j,i) - w(k_mm,j,i) ) &6222 diss_t = - ABS( w_comp ) * rho_air(k+1) * ( & 6223 ( 10.0_wp * ibit26 * adv_mom_5 & 6224 + 3.0_wp * ibit25 * adv_mom_3 & 6225 + ibit24 * adv_mom_1 & 6226 ) * & 6227 ( w(k+1,j,i) - w(k,j,i) ) & 6228 - ( 5.0_wp * ibit26 * adv_mom_5 & 6229 + ibit25 * adv_mom_3 & 6230 ) * & 6231 ( w(k_pp,j,i) - w(k-1,j,i) ) & 6232 + ( ibit26 * adv_mom_5 & 6233 ) * & 6234 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & 6229 6235 ) 6230 6236 !
Note: See TracChangeset
for help on using the changeset viewer.
