Changeset 4317 for palm/trunk
 Timestamp:
 Dec 3, 2019 12:43:22 PM (20 months 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 wcomponent are now calculated only 29 ! until nzt1 (Prognostic equation for wvelocity component ends at nzt1) 30 ! 31 ! 4204 20190830 12:30:17Z knoop 27 32 ! Bugfix: Changed sk_num initialization default to avoid implicit SAVEAttribut 28 33 ! … … 450 455 ENDIF 451 456 ! 452 ! u component  zdirection 457 ! u component  zdirection. Fluxes are calculated on wgrid 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(k1,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(k1,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  zdirection 586 ! v component  zdirection. Fluxes are calculated on wgrid 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(k1,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(k1,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  zdirection 709 ! WS1 (24), WS3 (25), WS5 (26) 710 flag_set = .FALSE. 713 ! w component  zdirection. 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(k1,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(k1,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(k1,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(k1,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(k1,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(k1,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  zdirection 1034 ! scalar  zdirection. Fluxes are calculated on wgrid 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(k1,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(k1,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(k1,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(k1,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 (wlevel) 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 wlevel. 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 (wlevel) 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 wlevel. 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 (wlevel) 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, nzt1 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, nzt1 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, nzt1 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 wlevel. For topography wall this is done implicitely by 3309 3333 ! advc_flags_m. … … 3395 3419 ENDDO 3396 3420 3397 DO k = nzt1, nzt 3421 DO k = nzt1, nzt1 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, nzt1 3516 3540 3517 3541 flux_d = flux_t(k1) … … 5870 5894 ENDDO 5871 5895 5872 DO k = nzb_max_l+1, nzt 5896 DO k = nzb_max_l+1, nzt1 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, nzt1 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 wlevel. 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, nzt1 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.