Changeset 4317
- Timestamp:
- Dec 3, 2019 12:43:22 PM (5 years ago)
- Location:
- palm/trunk
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r4204 r4317 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Comments revised/added, formatting improved, fluxes for u,v, and scalars are 28 ! explicitly set to zero at nzt+1, fluxes of w-component are now calculated only 29 ! until nzt-1 (Prognostic equation for w-velocity component ends at nzt-1) 30 ! 31 ! 4204 2019-08-30 12:30:17Z knoop 27 32 ! Bugfix: Changed sk_num initialization default to avoid implicit SAVE-Attribut 28 33 ! … … 450 455 ENDIF 451 456 ! 452 !-- u component - z-direction 457 !-- u component - z-direction. Fluxes are calculated on w-grid level 453 458 !-- WS1 (6), WS3 (7), WS5 (8) 454 459 IF ( k == nzb+1 ) THEN … … 479 484 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),1) .OR. & 480 485 .NOT. BTEST(wall_flags_0(k_ppp,j,i),1) ) .AND. & 481 BTEST(wall_flags_0(k-1,j,i),1) .AND.&482 BTEST(wall_flags_0(k,j,i),1) .AND.&483 BTEST(wall_flags_0(k+1,j,i),1) .AND.&484 BTEST(wall_flags_0(k_pp,j,i),1) .OR.&485 k == nzt - 1 )&486 BTEST(wall_flags_0(k-1,j,i),1) .AND. & 487 BTEST(wall_flags_0(k,j,i),1) .AND. & 488 BTEST(wall_flags_0(k+1,j,i),1) .AND. & 489 BTEST(wall_flags_0(k_pp,j,i),1) .OR. & 490 k == nzt - 1 ) & 486 491 THEN 487 492 advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 7 ) … … 579 584 ENDIF 580 585 ! 581 !-- v component - z-direction 586 !-- v component - z-direction. Fluxes are calculated on w-grid level 582 587 !-- WS1 (15), WS3 (16), WS5 (17) 583 588 IF ( k == nzb+1 ) THEN … … 608 613 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),2) .OR. & 609 614 .NOT. BTEST(wall_flags_0(k_ppp,j,i),2) ) .AND. & 610 BTEST(wall_flags_0(k-1,j,i),2) .AND.&611 BTEST(wall_flags_0(k,j,i),2) .AND.&612 BTEST(wall_flags_0(k+1,j,i),2) .AND.&613 BTEST(wall_flags_0(k_pp,j,i),2) .OR.&614 k == nzt - 1 )&615 BTEST(wall_flags_0(k-1,j,i),2) .AND. & 616 BTEST(wall_flags_0(k,j,i),2) .AND. & 617 BTEST(wall_flags_0(k+1,j,i),2) .AND. & 618 BTEST(wall_flags_0(k_pp,j,i),2) .OR. & 619 k == nzt - 1 ) & 615 620 THEN 616 621 advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 16 ) … … 706 711 ENDIF 707 712 ! 708 !-- w component - z-direction 709 !-- WS1 (24), WS3 (25), WS5 (26) 710 flag_set = .FALSE. 713 !-- w component - z-direction. Fluxes are calculated on scalar grid 714 !-- level. WS1 (24), WS3 (25), WS5 (26) 711 715 IF ( k == nzb+1 ) THEN 712 716 k_mm = nzb … … 725 729 ENDIF 726 730 727 IF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 728 .NOT. BTEST(wall_flags_0(k,j,i),3) .AND. & 729 BTEST(wall_flags_0(k+1,j,i),3) ) .OR. & 730 ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 731 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 732 ( .NOT. BTEST(wall_flags_0(k+1,j,i),3) .AND. & 733 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 731 flag_set = .FALSE. 732 IF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 733 .NOT. BTEST(wall_flags_0(k,j,i),3) .AND. & 734 BTEST(wall_flags_0(k+1,j,i),3) ) .OR. & 735 ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 736 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 737 ( .NOT. BTEST(wall_flags_0(k+1,j,i),3) .AND. & 738 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 734 739 k == nzt ) & 735 740 THEN 736 741 ! 737 !-- Please note, at k == nzb_w_inner(j,i) a flag is explic tely742 !-- Please note, at k == nzb_w_inner(j,i) a flag is explicitly 738 743 !-- set, although this is not a prognostic level. However, 739 744 !-- contrary to the advection of u,v and s this is necessary … … 742 747 advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 24 ) 743 748 flag_set = .TRUE. 744 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),3) .OR.&749 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),3) .OR. & 745 750 .NOT. BTEST(wall_flags_0(k_ppp,j,i),3) ) .AND. & 746 BTEST(wall_flags_0(k-1,j,i),3) .AND.&747 BTEST(wall_flags_0(k,j,i),3) .AND.&748 BTEST(wall_flags_0(k+1,j,i),3) .OR.&751 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 752 BTEST(wall_flags_0(k,j,i),3) .AND. & 753 BTEST(wall_flags_0(k+1,j,i),3) .OR. & 749 754 k == nzt - 1 ) & 750 755 THEN … … 1027 1032 1028 1033 ! 1029 !-- scalar - z-direction 1034 !-- scalar - z-direction. Fluxes are calculated on w-grid level 1030 1035 !-- WS1 (6), WS3 (7), WS5 (8) 1031 1036 IF ( k == nzb+1 ) THEN … … 1056 1061 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),0) .OR. & 1057 1062 .NOT. BTEST(wall_flags_0(k_ppp,j,i),0) ) .AND. & 1058 BTEST(wall_flags_0(k-1,j,i),0) .AND.&1059 BTEST(wall_flags_0(k,j,i),0) .AND.&1060 BTEST(wall_flags_0(k+1,j,i),0) .AND.&1061 BTEST(wall_flags_0(k_pp,j,i),0) .OR.&1063 BTEST(wall_flags_0(k-1,j,i),0) .AND. & 1064 BTEST(wall_flags_0(k,j,i),0) .AND. & 1065 BTEST(wall_flags_0(k+1,j,i),0) .AND. & 1066 BTEST(wall_flags_0(k_pp,j,i),0) .OR. & 1062 1067 k == nzt - 1 ) & 1063 1068 THEN 1064 1069 advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 7 ) 1065 1070 flag_set = .TRUE. 1066 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),0) 1067 .AND. BTEST(wall_flags_0(k-1,j,i),0)&1068 .AND. BTEST(wall_flags_0(k,j,i),0)&1069 .AND. BTEST(wall_flags_0(k+1,j,i),0)&1070 .AND. BTEST(wall_flags_0(k_pp,j,i),0)&1071 .AND. BTEST(wall_flags_0(k_ppp,j,i),0)&1072 .AND..NOT. flag_set ) &1071 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),0) .AND. & 1072 BTEST(wall_flags_0(k-1,j,i),0) .AND. & 1073 BTEST(wall_flags_0(k,j,i),0) .AND. & 1074 BTEST(wall_flags_0(k+1,j,i),0) .AND. & 1075 BTEST(wall_flags_0(k_pp,j,i),0) .AND. & 1076 BTEST(wall_flags_0(k_ppp,j,i),0) .AND. & 1077 .NOT. flag_set ) & 1073 1078 THEN 1074 1079 advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 8 ) … … 1480 1485 flux_t(nzb) = 0.0_wp 1481 1486 diss_t(nzb) = 0.0_wp 1487 1482 1488 DO k = nzb+1, nzb+2 1483 1489 ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp ) … … 1598 1604 ) 1599 1605 ENDDO 1600 1606 1607 ! 1608 !-- Set resolved/turbulent flux at model top to zero (w-level) 1609 flux_t(nzt+1) = 0.0_wp 1610 diss_t(nzt+1) = 0.0_wp 1611 1601 1612 IF ( limiter ) THEN 1602 1613 ! … … 2191 2202 !-- indirect indexing. This allows better vectorization for the main loop. 2192 2203 !-- First, compute the flux at model surface, which need has to be 2193 !-- calculated explic etely for the tendency at2204 !-- calculated explicitly for the tendency at 2194 2205 !-- the first w-level. For topography wall this is done implicitely by 2195 2206 !-- advc_flags_m. … … 2197 2208 diss_t(nzb) = 0.0_wp 2198 2209 w_comp(nzb) = 0.0_wp 2210 2199 2211 DO k = nzb+1, nzb+2 2200 2212 ! … … 2322 2334 ) 2323 2335 ENDDO 2336 2337 ! 2338 !-- Set resolved/turbulent flux at model top to zero (w-level) 2339 flux_t(nzt+1) = 0.0_wp 2340 diss_t(nzt+1) = 0.0_wp 2341 w_comp(nzt+1) = 0.0_wp 2324 2342 2325 2343 DO k = nzb+1, nzb_max_l … … 2748 2766 !-- indirect indexing. This allows better vectorization for the main loop. 2749 2767 !-- First, compute the flux at model surface, which need has to be 2750 !-- calculated explic etely for the tendency at2768 !-- calculated explicitly for the tendency at 2751 2769 !-- the first w-level. For topography wall this is done implicitely by 2752 2770 !-- advc_flags_m. … … 2880 2898 ) 2881 2899 ENDDO 2900 2901 ! 2902 !-- Set resolved/turbulent flux at model top to zero (w-level) 2903 flux_t(nzt+1) = 0.0_wp 2904 diss_t(nzt+1) = 0.0_wp 2905 w_comp(nzt+1) = 0.0_wp 2882 2906 2883 2907 DO k = nzb+1, nzb_max_l … … 3125 3149 ENDDO 3126 3150 3127 DO k = nzb_max_l+1, nzt 3151 DO k = nzb_max_l+1, nzt-1 3128 3152 3129 3153 v_comp(k) = v(k+1,j,i) + v(k,j,i) - gv … … 3183 3207 ENDDO 3184 3208 3185 DO k = nzb_max_l+1, nzt 3209 DO k = nzb_max_l+1, nzt-1 3186 3210 3187 3211 u_comp(k) = u(k+1,j,i) + u(k,j,i) - gu … … 3274 3298 ENDDO 3275 3299 3276 DO k = nzb_max_l+1, nzt 3300 DO k = nzb_max_l+1, nzt-1 3277 3301 3278 3302 u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu … … 3305 3329 !-- indirect indexing. This allows better vectorization for the main loop. 3306 3330 !-- First, compute the flux at model surface, which need has to be 3307 !-- calculated explic etely for the tendency at3331 !-- calculated explicitly for the tendency at 3308 3332 !-- the first w-level. For topography wall this is done implicitely by 3309 3333 !-- advc_flags_m. … … 3395 3419 ENDDO 3396 3420 3397 DO k = nzt-1, nzt 3421 DO k = nzt-1, nzt-1 3398 3422 ! 3399 3423 !-- k index has to be modified near bottom and top, else array … … 3513 3537 ENDDO 3514 3538 3515 DO k = nzb_max_l+1, nzt 3539 DO k = nzb_max_l+1, nzt-1 3516 3540 3517 3541 flux_d = flux_t(k-1) … … 5870 5894 ENDDO 5871 5895 5872 DO k = nzb_max_l+1, nzt 5896 DO k = nzb_max_l+1, nzt-1 5873 5897 5874 5898 u_comp = u(k+1,j,i) + u(k,j,i) - gu … … 5947 5971 ENDDO 5948 5972 5949 DO k = nzb_max_l+1, nzt 5973 DO k = nzb_max_l+1, nzt-1 5950 5974 5951 5975 v_comp = v(k+1,j,i) + v(k,j,i) - gv … … 5965 5989 5966 5990 ! 5967 !-- The lower flux has to be calculated explic etely for the tendency5991 !-- The lower flux has to be calculated explicitly for the tendency 5968 5992 !-- at the first w-level. For topography wall this is done implicitely 5969 5993 !-- by advc_flags_m. … … 6233 6257 ENDDO 6234 6258 6235 DO k = nzb_max_l+1, nzt 6259 DO k = nzb_max_l+1, nzt-1 6236 6260 6237 6261 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu
Note: See TracChangeset
for help on using the changeset viewer.