Changeset 862
- Timestamp:
- Mar 26, 2012 2:21:38 PM (13 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/advec_ws.f90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r861 r862 21 21 ! boundary_flags and logicals steering the degradation are removed. 22 22 ! Empty SUBROUTINE local_diss removed. 23 ! 24 ! Further formatting adjustments. 23 25 ! 24 26 ! Former revisions: … … 274 276 IMPLICIT NONE 275 277 276 INTEGER :: i, i_omp, j, k, tn, k_ppp, k_pp, k_mm277 REAL :: flux_d, diss_d, u_comp, v_comp, div278 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 279 REAL :: diss_d, div, flux_d, u_comp, v_comp 278 280 REAL, DIMENSION(:,:,:), POINTER :: sk 279 REAL, DIMENSION(nzb:nzt+1) :: flux_t, diss_t, flux_r, diss_r, &280 flux_ n, diss_n281 REAL, DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: swap_ flux_y_local, &282 swap_ diss_y_local281 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, & 282 flux_r, flux_t 283 REAL, DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: swap_diss_y_local, & 284 swap_flux_y_local 283 285 REAL, DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: & 284 swap_ flux_x_local, &285 swap_ diss_x_local286 swap_diss_x_local, & 287 swap_flux_x_local 286 288 CHARACTER (LEN = *), INTENT(IN) :: sk_char 287 289 … … 671 673 IMPLICIT NONE 672 674 673 INTEGER :: i, i_omp, j, k, tn, k_ppp, k_pp, k_mm674 REAL :: gu, gv, flux_d, diss_d, u_comp_l, v_comp, w_comp, div675 REAL, DIMENSION(nzb:nzt+1) :: flux_t, diss_t, flux_r, diss_r,&676 flux_n, diss_n, u_comp675 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 676 REAL :: diss_d, div, flux_d, gu, gv, u_comp_l, v_comp, w_comp 677 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r, & 678 flux_t, u_comp 677 679 678 680 gu = 2.0 * u_gtrans … … 1058 1060 IMPLICIT NONE 1059 1061 1060 INTEGER :: i, i_omp, j, k, tn, k_ppp, k_pp, k_mm1061 REAL :: gu, gv, flux_d, diss_d, u_comp, v_comp_l, w_comp, div1062 REAL, DIMENSION(nzb:nzt+1) :: flux_t, diss_t, flux_n,&1063 diss_n, flux_r, diss_r, v_comp1062 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 1063 REAL :: diss_d, div, flux_d, gu, gv, u_comp, v_comp_l, w_comp 1064 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r, & 1065 flux_t, v_comp 1064 1066 1065 1067 gu = 2.0 * u_gtrans … … 1451 1453 IMPLICIT NONE 1452 1454 1453 INTEGER :: i, i_omp, j, k, tn, k_ppp, k_pp, k_mm1454 REAL :: gu, gv, flux_d, diss_d, u_comp, v_comp, w_comp, div1455 REAL, DIMENSION(nzb:nzt+1) :: flux_t, diss_t, flux_r, diss_r, flux_n, &1456 diss_n1455 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 1456 REAL :: diss_d, div, flux_d, gu, gv, u_comp, v_comp, w_comp 1457 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r, & 1458 flux_t 1457 1459 1458 1460 gu = 2.0 * u_gtrans … … 1465 1467 DO k = nzb+1, nzb_max 1466 1468 1467 v_comp = v(k+1,j,i) + v(k,j,i) - gv1469 v_comp = v(k+1,j,i) + v(k,j,i) - gv 1468 1470 flux_s_w(k,tn) = v_comp * ( & 1469 1471 ( 37.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5 & … … 1519 1521 DO k = nzb+1, nzb_max 1520 1522 1521 u_comp = u(k+1,j,i) + u(k,j,i) - gu1523 u_comp = u(k+1,j,i) + u(k,j,i) - gu 1522 1524 flux_l_w(k,j,tn) = u_comp * ( & 1523 1525 ( 37.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5 & … … 1567 1569 1568 1570 ENDIF 1569 1570 flux_t(0) = 0.0 1571 diss_t(0) = 0.0 1572 flux_d = 0.0 1573 diss_d = 0.0 1571 ! 1572 !-- The lower flux has to be calculated explicetely for the tendency at 1573 !-- the first w-level. For topography wall this is done implicitely by 1574 !-- wall_flags_0. 1575 k = nzb + 1 1576 w_comp = w(k,j,i) + w(k-1,j,i) 1577 flux_t(0) = w_comp * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 1578 diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 1579 flux_d = flux_t(0) 1580 diss_d = diss_t(0) 1574 1581 ! 1575 1582 !-- Now compute the fluxes and tendency terms for the horizontal … … 1675 1682 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & 1676 1683 ) 1684 1677 1685 ! 1678 1686 !-- Calculate the divergence of the velocity field. A respective … … 1817 1825 IMPLICIT NONE 1818 1826 1819 INTEGER :: i, j, k, tn = 0, k_ppp, k_pp, k_mm1827 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 1820 1828 REAL, DIMENSION(:,:,:), POINTER :: sk 1821 REAL :: flux_d, diss_d, u_comp, v_comp, div1822 REAL, DIMENSION(nzb:nzt) :: flux_r, diss_r, flux_n, diss_n, flux_t, &1823 diss_t1824 REAL, DIMENSION(nzb+1:nzt) :: swap_ flux_y_local, swap_diss_y_local1825 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_ flux_x_local, &1826 swap_ diss_x_local1827 CHARACTER (LEN = *), INTENT(IN) :: sk_char1829 REAL :: diss_d, div, flux_d, u_comp, v_comp 1830 REAL, DIMENSION(nzb:nzt) :: diss_n, diss_r, diss_t, flux_n, flux_r, & 1831 flux_t 1832 REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local, swap_flux_y_local 1833 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local, & 1834 swap_flux_x_local 1835 CHARACTER (LEN = *), INTENT(IN) :: sk_char 1828 1836 1829 1837 ! … … 2197 2205 IMPLICIT NONE 2198 2206 2199 INTEGER :: i, j, k, tn = 0, k_ppp, k_pp, k_mm2200 REAL :: gu, gv, flux_d, diss_d, v_comp, w_comp, div2201 REAL, DIMENSION(nzb+1:nzt) :: swap_ flux_y_local_u, swap_diss_y_local_u2202 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_ flux_x_local_u,&2203 swap_ diss_x_local_u2204 REAL, DIMENSION(nzb:nzt) :: flux_t, diss_t, flux_r, diss_r, flux_n,&2205 diss_n, u_comp2207 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 2208 REAL :: diss_d, div, flux_d, gu, gv, v_comp, w_comp 2209 REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local_u, swap_flux_y_local_u 2210 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_u, & 2211 swap_flux_x_local_u 2212 REAL, DIMENSION(nzb:nzt) :: diss_n, diss_r, diss_t, flux_n, flux_r, & 2213 flux_t, u_comp 2206 2214 2207 2215 gu = 2.0 * u_gtrans … … 2591 2599 2592 2600 2593 INTEGER :: i, j, k, tn = 0, k_ppp, k_pp, k_mm2594 REAL :: gu, gv, flux_d, diss_d, u_comp, w_comp, div2595 REAL, DIMENSION(nzb+1:nzt) :: swap_ flux_y_local_v, swap_diss_y_local_v2596 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_ flux_x_local_v, &2597 swap_ diss_x_local_v2598 REAL, DIMENSION(nzb:nzt) :: flux_t, diss_t, flux_n, diss_n, flux_r, &2599 diss_r, v_comp2601 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 2602 REAL :: diss_d, div, flux_d, gu, gv, u_comp, w_comp 2603 REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local_v, swap_flux_y_local_v 2604 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_v, & 2605 swap_flux_x_local_v 2606 REAL, DIMENSION(nzb:nzt) :: diss_n, diss_r, diss_t, flux_n, flux_r, & 2607 flux_t, v_comp 2600 2608 2601 2609 gu = 2.0 * u_gtrans … … 2993 3001 IMPLICIT NONE 2994 3002 2995 INTEGER :: i, j, k, tn = 0, k_ppp, k_pp, k_mm2996 REAL :: gu, gv, flux_d, diss_d, u_comp, v_comp, w_comp, div2997 REAL, DIMENSION(nzb:nzt) :: flux_t, diss_t2998 REAL, DIMENSION(nzb+1:nzt) :: flux_r, diss_r, flux_n, diss_n, &2999 swap_ flux_y_local_w, &3000 swap_ diss_y_local_w3001 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_ flux_x_local_w, &3002 swap_ diss_x_local_w3003 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 3004 REAL :: diss_d, div, flux_d, gu, gv, u_comp, v_comp, w_comp 3005 REAL, DIMENSION(nzb:nzt) :: diss_t, flux_t 3006 REAL, DIMENSION(nzb+1:nzt) :: diss_n, diss_r, flux_n, flux_r, & 3007 swap_diss_y_local_w, & 3008 swap_flux_y_local_w 3009 REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_w, & 3010 swap_flux_x_local_w 3003 3011 3004 3012 gu = 2.0 * u_gtrans … … 3113 3121 DO j = nys, nyn 3114 3122 3115 flux_t(0) = 0.0 3116 diss_t(0) = 0.0 3117 flux_d = 0.0 3118 diss_d = 0.0 3123 ! 3124 !-- The lower flux has to be calculated explicetely for the tendency 3125 !-- at the first w-level. For topography wall this is done implicitely 3126 !-- by wall_flags_0. 3127 k = nzb + 1 3128 w_comp = w(k,j,i) + w(k-1,j,i) 3129 flux_t(0) = w_comp * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 3130 diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 3131 flux_d = flux_t(0) 3132 diss_d = diss_t(0) 3119 3133 3120 3134 DO k = nzb+1, nzb_max
Note: See TracChangeset
for help on using the changeset viewer.
