Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Jan 17, 2017 4:38:49 PM (7 years ago)
Author:
raasch
Message:

all OpenACC directives and related parts removed from the code

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/prognostic_equations.f90

    r2101 r2118  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! OpenACC version of subroutine removed
    2323!
    2424! Former revisions:
    … …  
    246246
    247247    USE indices,                                                               &
    248         ONLY:  i_left, i_right, j_north, j_south, nxl, nxlu, nxr, nyn, nys,    &
    249                nysv, nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
     248        ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_s_inner, nzb_u_inner,       &
     249               nzb_v_inner, nzb_w_inner, nzt
    250250
    251251    USE advec_ws,                                                              &
    252         ONLY:  advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc,         &
    253                advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc
     252        ONLY:  advec_s_ws, advec_u_ws, advec_v_ws, advec_w_ws
    254253
    255254    USE advec_s_bc_mod,                                                        &
    … …  
    281280
    282281    USE buoyancy_mod,                                                          &
    283         ONLY:  buoyancy, buoyancy_acc
     282        ONLY:  buoyancy
    284283
    285284    USE calc_radiation_mod,                                                    &
    … …  
    287286 
    288287    USE coriolis_mod,                                                          &
    289         ONLY:  coriolis, coriolis_acc
     288        ONLY:  coriolis
    290289
    291290    USE diffusion_e_mod,                                                       &
    292         ONLY:  diffusion_e, diffusion_e_acc
     291        ONLY:  diffusion_e
    293292
    294293    USE diffusion_s_mod,                                                       &
    295         ONLY:  diffusion_s, diffusion_s_acc
     294        ONLY:  diffusion_s
    296295
    297296    USE diffusion_u_mod,                                                       &
    298         ONLY:  diffusion_u, diffusion_u_acc
     297        ONLY:  diffusion_u
    299298
    300299    USE diffusion_v_mod,                                                       &
    301         ONLY:  diffusion_v, diffusion_v_acc
     300        ONLY:  diffusion_v
    302301
    303302    USE diffusion_w_mod,                                                       &
    304         ONLY:  diffusion_w, diffusion_w_acc
     303        ONLY:  diffusion_w
    305304
    306305    USE kinds
    … …  
    319318
    320319    USE production_e_mod,                                                      &
    321         ONLY:  production_e, production_e_acc
     320        ONLY:  production_e
    322321
    323322    USE radiation_model_mod,                                                   &
    … …  
    342341
    343342    PRIVATE
    344     PUBLIC prognostic_equations_cache, prognostic_equations_vector, &
    345            prognostic_equations_acc
     343    PUBLIC prognostic_equations_cache, prognostic_equations_vector
    346344
    347345    INTERFACE prognostic_equations_cache
    … …  
    352350       MODULE PROCEDURE prognostic_equations_vector
    353351    END INTERFACE prognostic_equations_vector
    354 
    355     INTERFACE prognostic_equations_acc
    356        MODULE PROCEDURE prognostic_equations_acc
    357     END INTERFACE prognostic_equations_acc
    358352
    359353
    … …  
    20011995
    20021996
    2003 !------------------------------------------------------------------------------!
    2004 ! Description:
    2005 ! ------------
    2006 !> Version for accelerator boards
    2007 !------------------------------------------------------------------------------!
    2008  
    2009  SUBROUTINE prognostic_equations_acc
    2010 
    2011 
    2012     IMPLICIT NONE
    2013 
    2014     INTEGER(iwp) ::  i           !<
    2015     INTEGER(iwp) ::  j           !<
    2016     INTEGER(iwp) ::  k           !<
    2017     INTEGER(iwp) ::  runge_step  !<
    2018 
    2019     REAL(wp)     ::  sbt         !<
    2020 
    2021 !
    2022 !-- Set switch for intermediate Runge-Kutta step
    2023     runge_step = 0
    2024     IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2025        IF ( intermediate_timestep_count == 1 )  THEN
    2026           runge_step = 1
    2027        ELSEIF ( intermediate_timestep_count < &
    2028                 intermediate_timestep_count_max )  THEN
    2029           runge_step = 2
    2030        ENDIF
    2031     ENDIF
    2032 
    2033 !
    2034 !-- If required, calculate cloud microphysical impacts (two-moment scheme)
    2035     IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
    2036          ( intermediate_timestep_count == 1  .OR.                              &
    2037            call_microphysics_at_all_substeps )                                 &
    2038        )  THEN
    2039        CALL cpu_log( log_point(51), 'microphysics', 'start' )
    2040        CALL microphysics_control
    2041        CALL cpu_log( log_point(51), 'microphysics', 'stop' )
    2042     ENDIF
    2043 
    2044 !
    2045 !-- u-velocity component
    2046 !++ Statistics still not completely ported to accelerators
    2047     !$acc update device( hom, ref_state )
    2048     CALL cpu_log( log_point(5), 'u-equation', 'start' )
    2049 
    2050     IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2051        IF ( ws_scheme_mom )  THEN
    2052           CALL advec_u_ws_acc
    2053        ELSE
    2054           tend = 0.0_wp   ! to be removed later??
    2055           CALL advec_u_pw
    2056        ENDIF
    2057     ELSE
    2058        CALL advec_u_up
    2059     ENDIF
    2060     CALL diffusion_u_acc
    2061     CALL coriolis_acc( 1 )
    2062     IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
    2063        CALL buoyancy( pt, 1 )
    2064     ENDIF
    2065 
    2066 !
    2067 !-- Drag by plant canopy
    2068     IF ( plant_canopy )  CALL pcm_tendency( 1 )
    2069 
    2070 !
    2071 !-- External pressure gradient
    2072     IF ( dp_external )  THEN
    2073        DO  i = i_left, i_right
    2074           DO  j = j_south, j_north
    2075              DO  k = dp_level_ind_b+1, nzt
    2076                 tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
    2077              ENDDO
    2078           ENDDO
    2079        ENDDO
    2080     ENDIF
    2081 
    2082 !
    2083 !-- Nudging
    2084     IF ( nudging )  CALL nudge( simulated_time, 'u' )
    2085 
    2086 !
    2087 !-- Forces by wind turbines
    2088     IF ( wind_turbine )  CALL wtm_tendencies( 1 )
    2089 
    2090     CALL user_actions( 'u-tendency' )
    2091 
    2092 !
    2093 !-- Prognostic equation for u-velocity component
    2094     !$acc kernels present( nzb_u_inner, rdf, tend, tu_m, u, u_init, u_p )
    2095     !$acc loop independent
    2096     DO  i = i_left, i_right
    2097        !$acc loop independent
    2098        DO  j = j_south, j_north
    2099           !$acc loop independent
    2100           DO  k = 1, nzt
    2101              IF ( k > nzb_u_inner(j,i) )  THEN
    2102                 u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
    2103                                                   tsc(3) * tu_m(k,j,i) )       &
    2104                                       - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
    2105 !
    2106 !--             Tendencies for the next Runge-Kutta step
    2107                 IF ( runge_step == 1 )  THEN
    2108                    tu_m(k,j,i) = tend(k,j,i)
    2109                 ELSEIF ( runge_step == 2 )  THEN
    2110                    tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
    2111                 ENDIF
    2112              ENDIF
    2113           ENDDO
    2114        ENDDO
    2115     ENDDO
    2116     !$acc end kernels
    2117 
    2118     CALL cpu_log( log_point(5), 'u-equation', 'stop' )
    2119 
    2120 !
    2121 !-- v-velocity component
    2122     CALL cpu_log( log_point(6), 'v-equation', 'start' )
    2123 
    2124     IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2125        IF ( ws_scheme_mom )  THEN
    2126           CALL advec_v_ws_acc
    2127        ELSE
    2128           tend = 0.0_wp    ! to be removed later??
    2129           CALL advec_v_pw
    2130        END IF
    2131     ELSE
    2132        CALL advec_v_up
    2133     ENDIF
    2134     CALL diffusion_v_acc
    2135     CALL coriolis_acc( 2 )
    2136 
    2137 !
    2138 !-- Drag by plant canopy
    2139     IF ( plant_canopy )  CALL pcm_tendency( 2 )
    2140 
    2141 !
    2142 !-- External pressure gradient
    2143     IF ( dp_external )  THEN
    2144        DO  i = i_left, i_right
    2145           DO  j = j_south, j_north
    2146              DO  k = dp_level_ind_b+1, nzt
    2147                 tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
    2148              ENDDO
    2149           ENDDO
    2150        ENDDO
    2151     ENDIF
    2152 
    2153 !
    2154 !-- Nudging
    2155     IF ( nudging )  CALL nudge( simulated_time, 'v' )
    2156 
    2157 !
    2158 !-- Forces by wind turbines
    2159     IF ( wind_turbine )  CALL wtm_tendencies( 2 )
    2160 
    2161     CALL user_actions( 'v-tendency' )
    2162 
    2163 !
    2164 !-- Prognostic equation for v-velocity component
    2165     !$acc kernels present( nzb_v_inner, rdf, tend, tv_m, v, v_init, v_p )
    2166     !$acc loop independent
    2167     DO  i = i_left, i_right
    2168        !$acc loop independent
    2169        DO  j = j_south, j_north
    2170           !$acc loop independent
    2171           DO  k = 1, nzt
    2172              IF ( k > nzb_v_inner(j,i) )  THEN
    2173                 v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
    2174                                                   tsc(3) * tv_m(k,j,i) )       &
    2175                                       - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
    2176 !
    2177 !--             Tendencies for the next Runge-Kutta step
    2178                 IF ( runge_step == 1 )  THEN
    2179                    tv_m(k,j,i) = tend(k,j,i)
    2180                 ELSEIF ( runge_step == 2 )  THEN
    2181                    tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
    2182                 ENDIF
    2183              ENDIF
    2184           ENDDO
    2185        ENDDO
    2186     ENDDO
    2187     !$acc end kernels
    2188 
    2189     CALL cpu_log( log_point(6), 'v-equation', 'stop' )
    2190 
    2191 !
    2192 !-- w-velocity component
    2193     CALL cpu_log( log_point(7), 'w-equation', 'start' )
    2194 
    2195     IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2196        IF ( ws_scheme_mom )  THEN
    2197           CALL advec_w_ws_acc
    2198        ELSE
    2199           tend = 0.0_wp    ! to be removed later??
    2200           CALL advec_w_pw
    2201        ENDIF
    2202     ELSE
    2203        CALL advec_w_up
    2204     ENDIF
    2205     CALL diffusion_w_acc
    2206     CALL coriolis_acc( 3 )
    2207 
    2208     IF ( .NOT. neutral )  THEN
    2209        IF ( ocean )  THEN
    2210           CALL buoyancy( rho_ocean, 3 )
    2211        ELSE
    2212           IF ( .NOT. humidity )  THEN
    2213              CALL buoyancy_acc( pt, 3 )
    2214           ELSE
    2215              CALL buoyancy( vpt, 3 )
    2216           ENDIF
    2217        ENDIF
    2218     ENDIF
    2219 
    2220 !
    2221 !-- Drag by plant canopy
    2222     IF ( plant_canopy )  CALL pcm_tendency( 3 )
    2223 
    2224 !
    2225 !-- Forces by wind turbines
    2226     IF ( wind_turbine )  CALL wtm_tendencies( 3 )
    2227 
    2228     CALL user_actions( 'w-tendency' )
    2229 
    2230 !
    2231 !-- Prognostic equation for w-velocity component
    2232     !$acc kernels present( nzb_w_inner, rdf, tend, tw_m, w, w_p )
    2233     !$acc loop independent
    2234     DO  i = i_left, i_right
    2235        !$acc loop independent
    2236        DO  j = j_south, j_north
    2237           !$acc loop independent
    2238           DO  k = 1, nzt-1
    2239              IF ( k > nzb_w_inner(j,i) )  THEN
    2240                 w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
    2241                                                   tsc(3) * tw_m(k,j,i) )       &
    2242                                       - tsc(5) * rdf(k) * w(k,j,i)
    2243    !
    2244    !--          Tendencies for the next Runge-Kutta step
    2245                 IF ( runge_step == 1 )  THEN
    2246                    tw_m(k,j,i) = tend(k,j,i)
    2247                 ELSEIF ( runge_step == 2 )  THEN
    2248                    tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
    2249                 ENDIF
    2250              ENDIF
    2251           ENDDO
    2252        ENDDO
    2253     ENDDO
    2254     !$acc end kernels
    2255 
    2256     CALL cpu_log( log_point(7), 'w-equation', 'stop' )
    2257 
    2258 
    2259 !
    2260 !-- If required, compute prognostic equation for potential temperature
    2261     IF ( .NOT. neutral )  THEN
    2262 
    2263        CALL cpu_log( log_point(13), 'pt-equation', 'start' )
    2264 
    2265 !
    2266 !--    pt-tendency terms with communication
    2267        sbt = tsc(2)
    2268        IF ( scalar_advec == 'bc-scheme' )  THEN
    2269 
    2270           IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2271 !
    2272 !--          Bott-Chlond scheme always uses Euler time step. Thus:
    2273              sbt = 1.0_wp
    2274           ENDIF
    2275           tend = 0.0_wp
    2276           CALL advec_s_bc( pt, 'pt' )
    2277 
    2278        ENDIF
    2279 
    2280 !
    2281 !--    pt-tendency terms with no communication
    2282        IF ( scalar_advec /= 'bc-scheme' )  THEN
    2283           tend = 0.0_wp
    2284           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2285              IF ( ws_scheme_sca )  THEN
    2286                 CALL advec_s_ws_acc( pt, 'pt' )
    2287              ELSE
    2288                 tend = 0.0_wp    ! to be removed later??
    2289                 CALL advec_s_pw( pt )
    2290              ENDIF
    2291           ELSE
    2292              CALL advec_s_up( pt )
    2293           ENDIF
    2294        ENDIF
    2295 
    2296        CALL diffusion_s_acc( pt, shf, tswst, wall_heatflux )
    2297 
    2298 !
    2299 !--    Tendency pt from wall heat flux from urban surface
    2300        IF ( urban_surface )  THEN
    2301           CALL usm_wall_heat_flux
    2302        ENDIF
    2303 
    2304 !
    2305 !--    If required compute heating/cooling due to long wave radiation processes
    2306        IF ( cloud_top_radiation )  THEN
    2307           CALL calc_radiation
    2308        ENDIF
    2309 
    2310 !
    2311 !--    Consideration of heat sources within the plant canopy
    2312        IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
    2313           CALL pcm_tendency( 4 )
    2314        ENDIF
    2315 
    2316 !
    2317 !--    Large scale advection
    2318        IF ( large_scale_forcing )  THEN
    2319           CALL ls_advec( simulated_time, 'pt' )
    2320        ENDIF
    2321 
    2322 !
    2323 !--    Nudging
    2324        IF ( nudging )  CALL nudge( simulated_time, 'pt' )
    2325 
    2326 !
    2327 !--    If required compute influence of large-scale subsidence/ascent
    2328        IF ( large_scale_subsidence  .AND.                                      &
    2329             .NOT. use_subsidence_tendencies )  THEN
    2330           CALL subsidence( tend, pt, pt_init, 2 )
    2331        ENDIF
    2332 
    2333        IF ( radiation .AND.                                                    &
    2334             simulated_time > skip_time_do_radiation )  THEN
    2335             CALL radiation_tendency ( tend )
    2336        ENDIF
    2337 
    2338        CALL user_actions( 'pt-tendency' )
    2339 
    2340 !
    2341 !--    Prognostic equation for potential temperature
    2342        !$acc kernels present( nzb_s_inner, rdf_sc, ptdf_x, ptdf_y, pt_init ) &
    2343        !$acc         present( tend, tpt_m, pt, pt_p )
    2344        !$acc loop independent
    2345        DO  i = i_left, i_right
    2346           !$acc loop independent
    2347           DO  j = j_south, j_north
    2348              !$acc loop independent
    2349              DO  k = 1, nzt
    2350                 IF ( k > nzb_s_inner(j,i) )  THEN
    2351                    pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
    2352                                                        tsc(3) * tpt_m(k,j,i) )    &
    2353                                            - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
    2354                                              ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
    2355 !
    2356 !--                Tendencies for the next Runge-Kutta step
    2357                    IF ( runge_step == 1 )  THEN
    2358                       tpt_m(k,j,i) = tend(k,j,i)
    2359                    ELSEIF ( runge_step == 2 )  THEN
    2360                       tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tpt_m(k,j,i)
    2361                    ENDIF
    2362                 ENDIF
    2363              ENDDO
    2364           ENDDO
    2365        ENDDO
    2366        !$acc end kernels
    2367 
    2368        CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
    2369 
    2370     ENDIF
    2371 
    2372 !
    2373 !-- If required, compute prognostic equation for salinity
    2374     IF ( ocean )  THEN
    2375 
    2376        CALL cpu_log( log_point(37), 'sa-equation', 'start' )
    2377 
    2378 !
    2379 !--    sa-tendency terms with communication
    2380        sbt = tsc(2)
    2381        IF ( scalar_advec == 'bc-scheme' )  THEN
    2382 
    2383           IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2384 !
    2385 !--          Bott-Chlond scheme always uses Euler time step. Thus:
    2386              sbt = 1.0_wp
    2387           ENDIF
    2388           tend = 0.0_wp
    2389           CALL advec_s_bc( sa, 'sa' )
    2390 
    2391        ENDIF
    2392 
    2393 !
    2394 !--    sa-tendency terms with no communication
    2395        IF ( scalar_advec /= 'bc-scheme' )  THEN
    2396           tend = 0.0_wp
    2397           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2398              IF ( ws_scheme_sca )  THEN
    2399                  CALL advec_s_ws( sa, 'sa' )
    2400              ELSE
    2401                  CALL advec_s_pw( sa )
    2402              ENDIF
    2403           ELSE
    2404              CALL advec_s_up( sa )
    2405           ENDIF
    2406        ENDIF
    2407 
    2408        CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
    2409 
    2410        CALL user_actions( 'sa-tendency' )
    2411 
    2412 !
    2413 !--    Prognostic equation for salinity
    2414        DO  i = i_left, i_right
    2415           DO  j = j_south, j_north
    2416              DO  k = nzb_s_inner(j,i)+1, nzt
    2417                 sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
    2418                                                     tsc(3) * tsa_m(k,j,i) )    &
    2419                                         - tsc(5) * rdf_sc(k) *                 &
    2420                                           ( sa(k,j,i) - sa_init(k) )
    2421                 IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
    2422 !
    2423 !--             Tendencies for the next Runge-Kutta step
    2424                 IF ( runge_step == 1 )  THEN
    2425                    tsa_m(k,j,i) = tend(k,j,i)
    2426                 ELSEIF ( runge_step == 2 )  THEN
    2427                    tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tsa_m(k,j,i)
    2428                 ENDIF
    2429              ENDDO
    2430           ENDDO
    2431        ENDDO
    2432 
    2433        CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
    2434 
    2435 !
    2436 !--    Calculate density by the equation of state for seawater
    2437        CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
    2438        CALL eqn_state_seawater
    2439        CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
    2440 
    2441     ENDIF
    2442 
    2443 !
    2444 !-- If required, compute prognostic equation for total water content
    2445     IF ( humidity )  THEN
    2446 
    2447        CALL cpu_log( log_point(29), 'q-equation', 'start' )
    2448 
    2449 !
    2450 !--    Scalar/q-tendency terms with communication
    2451        sbt = tsc(2)
    2452        IF ( scalar_advec == 'bc-scheme' )  THEN
    2453 
    2454           IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2455 !
    2456 !--          Bott-Chlond scheme always uses Euler time step. Thus:
    2457              sbt = 1.0_wp
    2458           ENDIF
    2459           tend = 0.0_wp
    2460           CALL advec_s_bc( q, 'q' )
    2461 
    2462        ENDIF
    2463 
    2464 !
    2465 !--    Scalar/q-tendency terms with no communication
    2466        IF ( scalar_advec /= 'bc-scheme' )  THEN
    2467           tend = 0.0_wp
    2468           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2469              IF ( ws_scheme_sca )  THEN
    2470                 CALL advec_s_ws( q, 'q' )
    2471              ELSE
    2472                 CALL advec_s_pw( q )
    2473              ENDIF
    2474           ELSE
    2475              CALL advec_s_up( q )
    2476           ENDIF
    2477        ENDIF
    2478 
    2479        CALL diffusion_s( q, qsws, qswst, wall_qflux )
    2480 
    2481 !
    2482 !--    Sink or source of scalar concentration due to canopy elements
    2483        IF ( plant_canopy ) CALL pcm_tendency( 5 )
    2484 
    2485 !
    2486 !--    Large scale advection
    2487        IF ( large_scale_forcing )  THEN
    2488           CALL ls_advec( simulated_time, 'q' )
    2489        ENDIF
    2490 
    2491 !
    2492 !--    Nudging
    2493        IF ( nudging )  CALL nudge( simulated_time, 'q' )
    2494 
    2495 !
    2496 !--    If required compute influence of large-scale subsidence/ascent
    2497        IF ( large_scale_subsidence  .AND.                                      &
    2498             .NOT. use_subsidence_tendencies )  THEN
    2499          CALL subsidence( tend, q, q_init, 3 )
    2500        ENDIF
    2501 
    2502        CALL user_actions( 'q-tendency' )
    2503 
    2504 !
    2505 !--    Prognostic equation for total water content / scalar
    2506        DO  i = i_left, i_right
    2507           DO  j = j_south, j_north
    2508              DO  k = nzb_s_inner(j,i)+1, nzt
    2509                 q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
    2510                                                   tsc(3) * tq_m(k,j,i) )       &
    2511                                       - tsc(5) * rdf_sc(k) *                   &
    2512                                         ( q(k,j,i) - q_init(k) )
    2513                 IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
    2514 !
    2515 !--             Tendencies for the next Runge-Kutta step
    2516                 IF ( runge_step == 1 )  THEN
    2517                    tq_m(k,j,i) = tend(k,j,i)
    2518                 ELSEIF ( runge_step == 2 )  THEN
    2519                    tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
    2520                 ENDIF
    2521              ENDDO
    2522           ENDDO
    2523        ENDDO
    2524 
    2525        CALL cpu_log( log_point(29), 'q-equation', 'stop' )
    2526 
    2527 !
    2528 !--    If required, calculate prognostic equations for rain water content
    2529 !--    and rain drop concentration
    2530        IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    2531 
    2532           CALL cpu_log( log_point(52), 'qr-equation', 'start' )
    2533 !
    2534 !--       qr-tendency terms with communication
    2535           sbt = tsc(2)
    2536           IF ( scalar_advec == 'bc-scheme' )  THEN
    2537 
    2538              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2539 !
    2540 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2541                 sbt = 1.0_wp
    2542              ENDIF
    2543              tend = 0.0_wp
    2544              CALL advec_s_bc( qr, 'qr' )
    2545 
    2546           ENDIF
    2547 
    2548 !
    2549 !--       qr-tendency terms with no communication
    2550           IF ( scalar_advec /= 'bc-scheme' )  THEN
    2551              tend = 0.0_wp
    2552              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2553                 IF ( ws_scheme_sca )  THEN
    2554                    CALL advec_s_ws( qr, 'qr' )
    2555                 ELSE
    2556                    CALL advec_s_pw( qr )
    2557                 ENDIF
    2558              ELSE
    2559                 CALL advec_s_up( qr )
    2560              ENDIF
    2561           ENDIF
    2562 
    2563           CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
    2564 
    2565 !
    2566 !--       Prognostic equation for rain water content
    2567           DO  i = i_left, i_right
    2568              DO  j = j_south, j_north
    2569                 DO  k = nzb_s_inner(j,i)+1, nzt
    2570                    qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
    2571                                                        tsc(3) * tqr_m(k,j,i) ) &
    2572                                            - tsc(5) * rdf_sc(k) * qr(k,j,i)
    2573                    IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
    2574 !
    2575 !--                Tendencies for the next Runge-Kutta step
    2576                    IF ( runge_step == 1 )  THEN
    2577                       tqr_m(k,j,i) = tend(k,j,i)
    2578                    ELSEIF ( runge_step == 2 )  THEN
    2579                       tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp *    &
    2580                                                                 tqr_m(k,j,i)
    2581                    ENDIF
    2582                 ENDDO
    2583              ENDDO
    2584           ENDDO
    2585 
    2586           CALL cpu_log( log_point(52), 'qr-equation', 'stop' )
    2587           CALL cpu_log( log_point(53), 'nr-equation', 'start' )
    2588 
    2589 !
    2590 !--       nr-tendency terms with communication
    2591           sbt = tsc(2)
    2592           IF ( scalar_advec == 'bc-scheme' )  THEN
    2593 
    2594              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2595 !
    2596 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2597                 sbt = 1.0_wp
    2598              ENDIF
    2599              tend = 0.0_wp
    2600              CALL advec_s_bc( nr, 'nr' )
    2601 
    2602           ENDIF
    2603 
    2604 !
    2605 !--       nr-tendency terms with no communication
    2606           IF ( scalar_advec /= 'bc-scheme' )  THEN
    2607              tend = 0.0_wp
    2608              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2609                 IF ( ws_scheme_sca )  THEN
    2610                    CALL advec_s_ws( nr, 'nr' )
    2611                 ELSE
    2612                    CALL advec_s_pw( nr )
    2613                 ENDIF
    2614              ELSE
    2615                 CALL advec_s_up( nr )
    2616              ENDIF
    2617           ENDIF
    2618 
    2619           CALL diffusion_s( nr, nrsws, nrswst, wall_nrflux )
    2620 
    2621 !
    2622 !--       Prognostic equation for rain drop concentration
    2623           DO  i = i_left, i_right
    2624              DO  j = j_south, j_north
    2625                 DO  k = nzb_s_inner(j,i)+1, nzt
    2626                    nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
    2627                                                        tsc(3) * tnr_m(k,j,i) ) &
    2628                                            - tsc(5) * rdf_sc(k) * nr(k,j,i)
    2629                    IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
    2630 !
    2631 !--                Tendencies for the next Runge-Kutta step
    2632                    IF ( runge_step == 1 )  THEN
    2633                       tnr_m(k,j,i) = tend(k,j,i)
    2634                    ELSEIF ( runge_step == 2 )  THEN
    2635                       tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp *    &
    2636                                                                 tnr_m(k,j,i)
    2637                    ENDIF
    2638                 ENDDO
    2639              ENDDO
    2640           ENDDO
    2641 
    2642           CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
    2643 
    2644        ENDIF
    2645 
    2646     ENDIF
    2647 
    2648 !
    2649 !-- If required, compute prognostic equation for scalar
    2650     IF ( passive_scalar )  THEN
    2651 
    2652        CALL cpu_log( log_point(66), 's-equation', 'start' )
    2653 
    2654 !
    2655 !--    Scalar/q-tendency terms with communication
    2656        sbt = tsc(2)
    2657        IF ( scalar_advec == 'bc-scheme' )  THEN
    2658 
    2659           IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2660 !
    2661 !--          Bott-Chlond scheme always uses Euler time step. Thus:
    2662              sbt = 1.0_wp
    2663           ENDIF
    2664           tend = 0.0_wp
    2665           CALL advec_s_bc( s, 's' )
    2666 
    2667        ENDIF
    2668 
    2669 !
    2670 !--    Scalar/q-tendency terms with no communication
    2671        IF ( scalar_advec /= 'bc-scheme' )  THEN
    2672           tend = 0.0_wp
    2673           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2674              IF ( ws_scheme_sca )  THEN
    2675                 CALL advec_s_ws( s, 's' )
    2676              ELSE
    2677                 CALL advec_s_pw( s )
    2678              ENDIF
    2679           ELSE
    2680              CALL advec_s_up( s )
    2681           ENDIF
    2682        ENDIF
    2683 
    2684        CALL diffusion_s( s, ssws, sswst, wall_sflux )
    2685 
    2686 !
    2687 !--    Sink or source of scalar concentration due to canopy elements
    2688        IF ( plant_canopy ) CALL pcm_tendency( 7 )
    2689 
    2690 !
    2691 !--    Large scale advection. Not implemented so far.
    2692 !        IF ( large_scale_forcing )  THEN
    2693 !           CALL ls_advec( simulated_time, 's' )
    2694 !        ENDIF
    2695 
    2696 !
    2697 !--    Nudging. Not implemented so far.
    2698 !        IF ( nudging )  CALL nudge( simulated_time, 's' )
    2699 
    2700 !
    2701 !--    If required compute influence of large-scale subsidence/ascent.
    2702 !--    Not implemented so far.
    2703        IF ( large_scale_subsidence  .AND.                                      &
    2704             .NOT. use_subsidence_tendencies  .AND.                             &
    2705             .NOT. large_scale_forcing )  THEN
    2706          CALL subsidence( tend, s, s_init, 3 )
    2707        ENDIF
    2708 
    2709        CALL user_actions( 's-tendency' )
    2710 
    2711 !
    2712 !--    Prognostic equation for total water content / scalar
    2713        DO  i = i_left, i_right
    2714           DO  j = j_south, j_north
    2715              DO  k = nzb_s_inner(j,i)+1, nzt
    2716                 s_p(k,j,i) = s(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
    2717                                                   tsc(3) * ts_m(k,j,i) )       &
    2718                                       - tsc(5) * rdf_sc(k) *                   &
    2719                                         ( s(k,j,i) - s_init(k) )
    2720                 IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
    2721 !
    2722 !--             Tendencies for the next Runge-Kutta step
    2723                 IF ( runge_step == 1 )  THEN
    2724                    ts_m(k,j,i) = tend(k,j,i)
    2725                 ELSEIF ( runge_step == 2 )  THEN
    2726                    ts_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * ts_m(k,j,i)
    2727                 ENDIF
    2728              ENDDO
    2729           ENDDO
    2730        ENDDO
    2731 
    2732        CALL cpu_log( log_point(66), 's-equation', 'stop' )
    2733 
    2734     ENDIF
    2735 !
    2736 !-- If required, compute prognostic equation for turbulent kinetic
    2737 !-- energy (TKE)
    2738     IF ( .NOT. constant_diffusion )  THEN
    2739 
    2740        CALL cpu_log( log_point(16), 'tke-equation', 'start' )
    2741 
    2742        sbt = tsc(2)
    2743        IF ( .NOT. use_upstream_for_tke )  THEN
    2744           IF ( scalar_advec == 'bc-scheme' )  THEN
    2745 
    2746              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2747 !
    2748 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2749                 sbt = 1.0_wp
    2750              ENDIF
    2751              tend = 0.0_wp
    2752              CALL advec_s_bc( e, 'e' )
    2753 
    2754           ENDIF
    2755        ENDIF
    2756 
    2757 !
    2758 !--    TKE-tendency terms with no communication
    2759        IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
    2760           IF ( use_upstream_for_tke )  THEN
    2761              tend = 0.0_wp
    2762              CALL advec_s_up( e )
    2763           ELSE
    2764              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2765                 IF ( ws_scheme_sca )  THEN
    2766                    CALL advec_s_ws_acc( e, 'e' )
    2767                 ELSE
    2768                    tend = 0.0_wp    ! to be removed later??
    2769                    CALL advec_s_pw( e )
    2770                 ENDIF
    2771              ELSE
    2772                 tend = 0.0_wp    ! to be removed later??
    2773                 CALL advec_s_up( e )
    2774              ENDIF
    2775           ENDIF
    2776        ENDIF
    2777 
    2778        IF ( .NOT. humidity )  THEN
    2779           IF ( ocean )  THEN
    2780              CALL diffusion_e( prho, prho_reference )
    2781           ELSE
    2782              CALL diffusion_e_acc( pt, pt_reference )
    2783           ENDIF
    2784        ELSE
    2785           CALL diffusion_e( vpt, pt_reference )
    2786        ENDIF
    2787 
    2788        CALL production_e_acc
    2789 
    2790 !
    2791 !--    Additional sink term for flows through plant canopies
    2792        IF ( plant_canopy )  CALL pcm_tendency( 6 )
    2793        CALL user_actions( 'e-tendency' )
    2794 
    2795 !
    2796 !--    Prognostic equation for TKE.
    2797 !--    Eliminate negative TKE values, which can occur due to numerical
    2798 !--    reasons in the course of the integration. In such cases the old TKE
    2799 !--    value is reduced by 90%.
    2800        !$acc kernels present( e, e_p, nzb_s_inner, tend, te_m )
    2801        !$acc loop independent
    2802        DO  i = i_left, i_right
    2803           !$acc loop independent
    2804           DO  j = j_south, j_north
    2805              !$acc loop independent
    2806              DO  k = 1, nzt
    2807                 IF ( k > nzb_s_inner(j,i) )  THEN
    2808                    e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
    2809                                                      tsc(3) * te_m(k,j,i) )
    2810                    IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
    2811 !
    2812 !--                Tendencies for the next Runge-Kutta step
    2813                    IF ( runge_step == 1 )  THEN
    2814                       te_m(k,j,i) = tend(k,j,i)
    2815                    ELSEIF ( runge_step == 2 )  THEN
    2816                       te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
    2817                    ENDIF
    2818                 ENDIF
    2819              ENDDO
    2820           ENDDO
    2821        ENDDO
    2822        !$acc end kernels
    2823 
    2824        CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
    2825 
    2826     ENDIF
    2827 
    2828  END SUBROUTINE prognostic_equations_acc
    2829 
    2830 
    28311997 END MODULE prognostic_equations_mod
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |