Changeset 4717 for palm


Ignore:
Timestamp:
Sep 30, 2020 10:27:40 PM (4 years ago)
Author:
pavelkrc
Message:

Fixes and optimizations of OpenMP parallelization, formatting of OpenMP directives

Location:
palm/trunk/SOURCE
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r4716 r4717  
    2525! -----------------
    2626! $Id$
     27! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     28! directives (J. Resler)
     29!
     30! 4716 2020-09-30 22:06:37Z pavelkrc
    2731! Revert change at water surfaces (previous)
    2832!
     
    17441748    i_off = surf%ioff
    17451749
    1746     !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface, ueff,       &
    1747     !$OMP&                  c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s,      &
    1748     !$OMP&                  f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt,   &
    1749     !$OMP&                  coef_1, coef_2, tend)
    1750     !$OMP DO SCHEDULE (STATIC)
     1750    !$OMP PARALLEL DO PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface, ueff,    &
     1751    !$OMP&                     c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s,   &
     1752    !$OMP&                     f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt,&
     1753    !$OMP&                     coef_1, coef_2, tend) SCHEDULE (STATIC)
    17511754    DO  m = 1, surf%ns
    17521755
     
    21092112       surf%shf(m) = - f_shf * ( surf%pt1(m) - surf%pt_surface(m) ) / c_p
    21102113!
    2111 ! update the 3d field of rad_lw_out array to have consistent output
     2114!--    update the 3d field of rad_lw_out array to have consistent output
    21122115       IF ( upward )  THEN
    21132116          IF ( radiation_scheme == 'rrtmg' ) THEN
     
    22462249
    22472250    ENDDO
    2248     !$OMP END PARALLEL
    22492251
    22502252!
     
    22942296       REAL(wp) ::  resistance    !< aerodynamic and soil resistance term
    22952297
    2296 
    2297        !$OMP PARALLEL PRIVATE (m, i, j, k, e_s, q_s, resistance)
    2298        !$OMP DO SCHEDULE (STATIC)
     2298       !$OMP PARALLEL DO PRIVATE (m, i, j, k, e_s, q_s, resistance) SCHEDULE (STATIC)
    22992299       DO  m = 1, surf%ns
    23002300
     
    23302330                                  ( 1.0_wp + 0.61_wp * surf%q_surface(m) )
    23312331
    2332 
    2333 
    23342332       ENDDO
    2335        !$OMP END PARALLEL
    23362333
    23372334    END SUBROUTINE calc_q_surface
     
    55555552       ENDIF
    55565553
    5557        !$OMP PARALLEL PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg,       &
    5558        !$OMP&                  m_total, root_extr)
    5559        !$OMP DO SCHEDULE (STATIC)
     5554       !$OMP PARALLEL DO PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg,    &
     5555       !$OMP&                     m_total, root_extr) SCHEDULE (STATIC)
    55605556       DO  m = 1, surf%ns
    55615557
     
    58275823
    58285824       ENDDO
    5829        !$OMP END PARALLEL
    58305825!
    58315826!--    Debug location message
     
    77607755!       REAL(wp) :: re_0 !< near-surface roughness Reynolds number
    77617756
    7762        !$OMP DO PRIVATE (m, i, j) SCHEDULE (STATIC) REDUCTION(.OR.:flag_exceed_z0, flag_exceed_z0h)
     7757       !$OMP PARALLEL DO PRIVATE (m, i, j) SCHEDULE (STATIC)                                      &
     7758       !$OMP&            REDUCTION(.OR.:flag_exceed_z0, flag_exceed_z0h)
    77637759       DO  m = 1, surf_lsm_h(0)%ns
    77647760!--       only upward facin horizontal surfaces are considered for water surface processing
     
    78207816          ENDIF
    78217817       ENDDO
    7822        !$OMP END DO
    78237818#if defined( __parallel )
    78247819       CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL,       &
  • palm/trunk/SOURCE/poisfft_mod.f90

    r4671 r4717  
    2525! -----------------
    2626! $Id$
     27! Formatting of OpenMP directives (J. Resler)
     28!
     29! 4671 2020-09-09 20:27:58Z pavelkrc
    2730! OMP bugfix
    2831!
     
    10011004
    10021005    tn = 0              ! Default thread number in case of one thread
    1003 !$OMP  PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix )
     1006    !$OMP  PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix )
    10041007    DO  j = nys_x, nyn_x
    10051008
     
    11421145!
    11431146!--    Code for vector processors
    1144 !$OMP  PARALLEL PRIVATE ( i, j, k )
    1145 !$OMP  DO
     1147       !$OMP  PARALLEL PRIVATE ( i, j, k )
     1148       !$OMP  DO
    11461149       DO  i = 0, nx
    11471150
     
    11541157       ENDDO
    11551158
    1156 !$OMP  DO
     1159       !$OMP  DO
    11571160       DO  j = nys, nyn
    11581161
     
    11661169
    11671170       ENDDO
    1168 !$OMP  END PARALLEL
     1171       !$OMP  END PARALLEL
    11691172
    11701173    ELSE
     
    11721175!
    11731176!--    Cache optimized code (there might still be a potential for better optimization).
    1174 !$OMP  PARALLEL PRIVATE (i,j,k)
    1175 !$OMP  DO
     1177       !$OMP  PARALLEL PRIVATE (i,j,k)
     1178       !$OMP  DO
    11761179       DO  i = 0, nx
    11771180
     
    11841187       ENDDO
    11851188
    1186 !$OMP  DO
     1189       !$OMP  DO
    11871190       DO  j = nys, nyn
    11881191          DO  k = 1, nz
     
    11961199
    11971200       ENDDO
    1198 !$OMP  END PARALLEL
     1201       !$OMP  END PARALLEL
    11991202
    12001203    ENDIF
  • palm/trunk/SOURCE/pres.f90

    r4651 r4717  
    2525! -----------------
    2626! $Id$
     27! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     28! directives (J. Resler)
     29!
     30! 4651 2020-08-27 07:17:45Z raasch
    2731! preprocessor branch for ibm removed
    2832!
    2933! 4649 2020-08-25 12:11:17Z raasch
    3034! File re-formatted to follow the PALM coding standard
    31 !
    3235!
    3336! 4457 2020-03-11 14:20:43Z raasch
     
    171174    REAL(wp) ::  ddt_3d            !<
    172175    REAL(wp) ::  d_weight_pres     !<
    173     REAL(wp) ::  localsum          !<
    174176    REAL(wp) ::  threadsum         !<
    175177    REAL(wp) ::  weight_pres_l     !<
     
    363365
    364366    IF ( psolver(1:9) == 'multigrid' )  THEN
    365        !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)
     367       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    366368       DO  i = nxl-1, nxr+1
    367369          DO  j = nys-1, nyn+1
     
    372374       ENDDO
    373375    ELSE
    374        !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)
     376       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    375377       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    376378       !$ACC PRESENT(d)
     
    384386    ENDIF
    385387
    386     localsum  = 0.0_wp
    387     threadsum = 0.0_wp
    388 
    389     !$OMP PARALLEL PRIVATE (i,j,k)
    390     !$OMP DO SCHEDULE( STATIC )
     388    !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    391389    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    392390    !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_total_0) &
     
    403401       ENDDO
    404402    ENDDO
    405     !$OMP END PARALLEL
    406403
    407404!
     
    410407    IF ( intermediate_timestep_count == intermediate_timestep_count_max  .OR.                      &
    411408         intermediate_timestep_count == 0 )  THEN
    412        !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
    413        !$OMP DO SCHEDULE( STATIC )
     409       threadsum = 0.0_wp
     410       !$OMP PARALLEL DO PRIVATE (i,j,k) REDUCTION(+:threadsum) SCHEDULE( STATIC )
    414411       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
    415412       !$ACC REDUCTION(+:threadsum) COPY(threadsum) &
     
    422419          ENDDO
    423420       ENDDO
    424        localsum = localsum + threadsum * dt_3d * weight_pres_l
    425        !$OMP END PARALLEL
     421       threadsum = threadsum + threadsum * dt_3d * weight_pres_l
    426422    ENDIF
    427423
     
    430426    IF ( intermediate_timestep_count == intermediate_timestep_count_max  .OR.                      &
    431427         intermediate_timestep_count == 0 )  THEN
    432        sums_divold_l(0:statistic_regions) = localsum
     428       sums_divold_l(0:statistic_regions) = threadsum
    433429    ENDIF
    434430
     
    445441!
    446442!--    Store computed perturbation pressure and set boundary condition in z-direction
    447        !$OMP PARALLEL DO PRIVATE (i,j,k)
     443       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    448444       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    449445       !$ACC PRESENT(d, tend)
     
    465461!--       natural and urban surfaces
    466462!--       Upward facing
    467           !$OMP PARALLEL DO PRIVATE( i, j, k )
     463          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
    468464          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
    469465          !$ACC PRESENT(bc_h, tend)
     
    476472!
    477473!--       Downward facing
    478           !$OMP PARALLEL DO PRIVATE( i, j, k )
     474          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
    479475          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
    480476          !$ACC PRESENT(bc_h, tend)
     
    491487!--       urban surfaces
    492488!--       Upward facing
    493           !$OMP PARALLEL DO PRIVATE( i, j, k )
     489          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
    494490          DO  m = 1, bc_h(0)%ns
    495491             i = bc_h(0)%i(m)
     
    500496!
    501497!--       Downward facing
    502           !$OMP PARALLEL DO PRIVATE( i, j, k )
     498          !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC )
    503499          DO  m = 1, bc_h(1)%ns
    504500             i = bc_h(1)%i(m)
     
    515511!
    516512!--       Neumann
    517           !$OMP PARALLEL DO PRIVATE (i,j,k)
     513          !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC )
    518514          DO  i = nxlg, nxrg
    519515             DO  j = nysg, nyng
     
    525521!
    526522!--       Dirichlet
    527           !$OMP PARALLEL DO PRIVATE (i,j,k)
     523          !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC )
    528524          !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
    529525          !$ACC PRESENT(tend)
     
    590586!-- Ghost layers are added in the output routines (except sor-method: see below)
    591587    IF ( intermediate_timestep_count <= 1 )  THEN
    592        !$OMP PARALLEL PRIVATE (i,j,k)
    593        !$OMP DO
     588       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    594589       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    595590       !$ACC PRESENT(p, tend)
     
    601596          ENDDO
    602597       ENDDO
    603        !$OMP END PARALLEL
    604598
    605599    ELSEIF ( intermediate_timestep_count > 1 )  THEN
    606        !$OMP PARALLEL PRIVATE (i,j,k)
    607        !$OMP DO
     600       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    608601       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    609602       !$ACC PRESENT(p, tend)
     
    615608          ENDDO
    616609       ENDDO
    617        !$OMP END PARALLEL
    618610
    619611    ENDIF
     
    635627!-- the velocities, zero-gradient conditions for the pressure are set, so that no modification is
    636628!-- imposed at the boundaries.
    637     !$OMP PARALLEL PRIVATE (i,j,k)
    638     !$OMP DO
     629    !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    639630    !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) &
    640631    !$ACC PRESENT(u, v, w, tend, ddzu, wall_flags_total_0)
     
    660651       ENDDO
    661652    ENDDO
    662     !$OMP END PARALLEL
    663653
    664654!
     
    675665    IF ( conserve_volume_flow  .AND.  bc_lr_cyc  .AND.  bc_ns_cyc  .AND.  nxr == nx )  THEN
    676666
    677        !$OMP PARALLEL PRIVATE (j,k)
    678        !$OMP DO
     667       !$OMP PARALLEL DO PRIVATE (j,k) REDUCTION (volume_flow_l(1))
    679668       DO  j = nys, nyn
    680           !$OMP CRITICAL
    681669          DO  k = nzb+1, nzt
    682670             volume_flow_l(1) = volume_flow_l(1) + u(k,j,nxr) * dzw(k)                             &
    683671                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr), 1 ) )
    684672          ENDDO
    685           !$OMP END CRITICAL
    686        ENDDO
    687        !$OMP END PARALLEL
     673       ENDDO
    688674
    689675    ENDIF
     
    691677    IF ( conserve_volume_flow  .AND.  bc_ns_cyc  .AND.  bc_lr_cyc  .AND. nyn == ny )  THEN
    692678
    693        !$OMP PARALLEL PRIVATE (i,k)
    694        !$OMP DO
    695        DO  i = nxl, nxr
    696           !$OMP CRITICAL
     679       !$OMP PARALLEL DO PRIVATE (i,k) REDUCTION (volume_flow_l(2))
     680       DO  i = nxl, nxr
    697681          DO  k = nzb+1, nzt
    698682             volume_flow_l(2) = volume_flow_l(2) + v(k,nyn,i) * dzw(k)                             &
    699683                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn,i), 2 ) )
    700684           ENDDO
    701           !$OMP END CRITICAL
    702        ENDDO
    703        !$OMP END PARALLEL
     685       ENDDO
    704686
    705687    ENDIF
     
    719701                                 / volume_flow_area(1:2)
    720702
    721        !$OMP PARALLEL PRIVATE (i,j,k)
    722        !$OMP DO
     703       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    723704       DO  i = nxl, nxr
    724705          DO  j = nys, nyn
     
    733714          ENDDO
    734715       ENDDO
    735 
    736        !$OMP END PARALLEL
    737716
    738717    ENDIF
     
    757736       IF ( topography /= 'flat' )  d = 0.0_wp
    758737
    759        localsum  = 0.0_wp
    760        threadsum = 0.0_wp
    761 
    762        !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
    763        !$OMP DO SCHEDULE( STATIC )
     738       !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC )
    764739       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    765740       !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_total_0) &
     
    778753!
    779754!--    Compute possible PE-sum of divergences for flow_statistics
    780        !$OMP DO SCHEDULE( STATIC )
     755       threadsum = 0.0_wp
     756       !$OMP PARALLEL DO PRIVATE (i,j,k) REDUCTION(+:threadsum) SCHEDULE( STATIC )
    781757       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    782758       !$ACC REDUCTION(+:threadsum) COPY(threadsum) &
     
    790766       ENDDO
    791767
    792        localsum = localsum + threadsum
    793        !$OMP END PARALLEL
    794 
    795768!
    796769!--    For completeness, set the divergence sum of all statistic regions to those of the total
    797770!--    domain
    798        sums_divnew_l(0:statistic_regions) = localsum
     771       sums_divnew_l(0:statistic_regions) = threadsum
    799772
    800773       CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
  • palm/trunk/SOURCE/prognostic_equations.f90

    r4671 r4717  
    2525! -----------------
    2626! $Id$
     27! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     28! directives (J. Resler)
     29!
     30! 4671 2020-09-09 20:27:58Z pavelkrc
    2731! Implementation of downward facing USM and LSM surfaces
    2832!
    2933! 4649 2020-08-25 12:11:17Z raasch
    3034! File re-formatted to follow the PALM coding standard
    31 !
    3235!
    3336! 4370 2020-01-10 14:00:44Z raasch
     
    397400    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
    398401
    399     !$OMP PARALLEL PRIVATE (i,j)
    400     !$OMP DO
     402    !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC )
    401403    DO  i = nxl, nxr
    402404       DO  j = nys, nyn
     
    409411!-- Module Inferface for exchange horiz after non_advective_processes but before advection.
    410412!-- Therefore, non_advective_processes must not run for ghost points.
    411     !$OMP END PARALLEL
    412413    CALL module_interface_exchange_horiz()
    413414!
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4713 r4717  
    2828! -----------------
    2929! $Id$
     30! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     31! directives (J. Resler)
     32!
     33! 4713 2020-09-29 12:02:05Z pavelkrc
    3034! Correct OpenMP parallelization including cycles with cumulative variables (J. Resler)
    3135!
     
    59545958     REAL(wp)                          ::  asrc               !< area of source face
    59555959     REAL(wp)                          ::  pcrad              !< irradiance from plant canopy
     5960     REAL(wp)                          ::  temp               !< temporary variable for calculation
    59565961!-   variables for coupling the radiation modle (e.g. RRTMG) and RTM
    59575962     REAL(wp)                          ::  pabsswl            !< total absorbed SW radiation energy in local processor (W)
     
    61646169
    61656170     IF ( surface_reflections)  THEN
    6166         !$OMP DO PRIVATE (i, j, k, isvf, isurf, isurfsrc) SCHEDULE (STATIC)
     6171        !$OMP PARALLEL DO PRIVATE (i, j, k, isvf, isurf, isurfsrc, temp) SCHEDULE (STATIC)
    61676172        DO  isvf = 1, nsvfl
    61686173           isurf = svfsurf(1, isvf)
     
    61746179!--        For surface-to-surface factors we calculate thermal radiation in 1st pass
    61756180           IF ( plant_lw_interact )  THEN
    6176               surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)
     6181              temp = svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)
    61776182           ELSE
    6178               surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
     6183              temp = svf(1,isvf) * surfoutl(isurfsrc)
    61796184           ENDIF
     6185           !$OMP ATOMIC
     6186           surfinl(isurf) = surfinl(isurf) + temp
    61806187        ENDDO
    6181         !$OMP END DO
    61826188     ENDIF
    61836189!
    61846190!--  diffuse radiation using sky view factor
    6185      !$OMP DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl, pinlwl) SCHEDULE (STATIC)
     6191     !$OMP PARALLEL DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl, pinlwl) SCHEDULE (STATIC)
    61866192     DO isurf = 1, nsurfl
    61876193        j = surfl(iy, isurf)
     
    61936199        IF ( plant_lw_interact )  THEN
    61946200           surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvft(isurf)
    6195 !-         update received LW energy for RTM coupling
    6196            pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d)
    61976201        ELSE
    61986202           surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvf(isurf)
    6199 !-         update received LW energy for RTM coupling
    6200            pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d)
    62016203        ENDIF
     6204!-      update received LW energy for RTM coupling
     6205        pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d)
    62026206     ENDDO
    6203      !$OMP END DO
    62046207!
    62056208!--  MRT diffuse irradiance
    6206      !$OMP DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)
     6209     !$OMP PARALLEL DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)
    62076210     DO  imrt = 1, nmrtbl
    62086211        j = mrtbl(iy, imrt)
     
    62116214        mrtinlw(imrt) = mrtsky(imrt) * rad_lw_in_diff(j,i)
    62126215     ENDDO
    6213      !$OMP END DO
    62146216!
    62156217!--  Direct radiation
     
    62296231        isd = dsidir_rev(j, i)
    62306232!-- TODO: check if isd = -1 to report that this solar position is not precalculated
    6231         !$OMP DO PRIVATE (i, j, d, isurf)  REDUCTION(+:pinswl) SCHEDULE (STATIC)
     6233        !$OMP PARALLEL DO PRIVATE (i, j, d, isurf)  REDUCTION(+:pinswl) SCHEDULE (STATIC)
    62326234        DO isurf = 1, nsurfl
    62336235           j = surfl(iy, isurf)
     
    62366238           surfinswdir(isurf) = rad_sw_in_dir(j,i) *                        &
    62376239                costheta(surfl(id, isurf)) * dsitrans(isurf, isd) * sun_direct_factor
    6238 !-        update received SW energy for RTM coupling
     6240!--        update received SW energy for RTM coupling
    62396241           pinswl = pinswl + surfinswdir(isurf) * facearea(d)
    62406242        ENDDO
    6241         !$OMP END DO
    62426243!
    62436244!--     MRT direct irradiance
    6244         !$OMP DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)
     6245        !$OMP PARALLEL DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)
    62456246        DO  imrt = 1, nmrtbl
    62466247           j = mrtbl(iy, imrt)
     
    62496250                                     * sun_direct_factor / 4.0_wp ! normal to sphere
    62506251        ENDDO
    6251         !$OMP END DO
    62526252     ENDIF
    62536253!
    62546254!--  MRT first pass thermal
    6255      !$OMP DO PRIVATE (imrtf, imrt, isurfsrc) SCHEDULE (STATIC)
     6255     !$OMP PARALLEL DO PRIVATE (imrtf, imrt, isurfsrc, temp) SCHEDULE (STATIC)
    62566256     DO  imrtf = 1, nmrtf
    62576257        imrt = mrtfsurf(1, imrtf)
    62586258        isurfsrc = mrtfsurf(2, imrtf)
    6259         mrtinlw(imrt) = mrtinlw(imrt) + mrtf(imrtf) * surfoutl(isurfsrc)
     6259        temp = mrtf(imrtf) * surfoutl(isurfsrc)
     6260        !$OMP ATOMIC
     6261        mrtinlw(imrt) = mrtinlw(imrt) + temp
    62606262     ENDDO
    6261      !$OMP END DO
    62626263!
    62636264!--  Absorption in each local plant canopy grid box from the first atmospheric
     
    62696270         pcbinlw(:) = 0.0_wp
    62706271
    6271          !$OMP DO PRIVATE (icsf, ipcgb, i, j, k, kk, isurfsrc, pc_abs_frac, pcrad, asrc)          &
     6272         !$OMP PARALLEL DO PRIVATE (icsf, ipcgb, i, j, k, kk, isurfsrc, pc_abs_frac, pcrad, asrc) &
    62726273         !$OMP&   REDUCTION(+:pinswl, pinlwl, pabslwl, pemitlwl, pabs_pc_lwdifl) SCHEDULE (STATIC)
    62736274         DO icsf = 1, ncsfl
     
    63286329             ENDIF
    63296330         ENDDO
    6330          !$OMP END DO
    63316331
    63326332         pcbinsw(:) = pcbinswdir(:) + pcbinswdif(:)
     
    64246424!
    64256425!--      Reflected radiation
    6426          !$OMP DO PRIVATE (isvf, isurf, isurfsrc) SCHEDULE (STATIC)
     6426         !$OMP PARALLEL DO PRIVATE (isvf, isurf, isurfsrc) SCHEDULE (STATIC)
    64276427         DO isvf = 1, nsvfl
    64286428             isurf = svfsurf(1, isvf)
     
    64356435             ENDIF
    64366436         ENDDO
    6437          !$OMP END DO
    64386437!
    64396438!--      NOTE: PC absorbtion and MRT from reflected can both be done at once
     
    64436442!
    64446443!--      Radiation absorbed by plant canopy
    6445          !$OMP DO PRIVATE (icsf, ipcgb, isurfsrc, asrc) SCHEDULE (STATIC)
     6444         !$OMP PARALLEL DO PRIVATE (icsf, ipcgb, isurfsrc, asrc, temp) SCHEDULE (STATIC)
    64466445         DO  icsf = 1, ncsfl
    64476446             ipcgb = csfsurf(1, icsf)
     
    64536452!--          stored within `csf'
    64546453             asrc = facearea(surf(id, isurfsrc))
    6455              pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * surfouts(isurfsrc) * asrc
     6454             temp = csf(1,icsf) * surfouts(isurfsrc) * asrc
     6455             !$OMP ATOMIC
     6456             pcbinsw(ipcgb) = pcbinsw(ipcgb) + temp
    64566457             IF ( plant_lw_interact )  THEN
    6457                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + csf(1,icsf) * surfoutl(isurfsrc) * asrc
     6458                temp = csf(1,icsf) * surfoutl(isurfsrc) * asrc
     6459                !$OMP ATOMIC
     6460                pcbinlw(ipcgb) = pcbinlw(ipcgb) + temp
    64586461             ENDIF
    64596462         ENDDO
    6460          !$OMP END DO
    64616463!
    64626464!--      MRT reflected
    6463          !$OMP DO PRIVATE (imrtf, imrt, isurfsrc) SCHEDULE (STATIC)
     6465         !$OMP PARALLEL DO PRIVATE (imrtf, imrt, isurfsrc, temp) SCHEDULE (STATIC)
    64646466         DO  imrtf = 1, nmrtf
    64656467            imrt = mrtfsurf(1, imrtf)
    64666468            isurfsrc = mrtfsurf(2, imrtf)
    6467             mrtinsw(imrt) = mrtinsw(imrt) + mrtft(imrtf) * surfouts(isurfsrc)
    6468             mrtinlw(imrt) = mrtinlw(imrt) + mrtf(imrtf) * surfoutl(isurfsrc)
     6469            temp = mrtft(imrtf) * surfouts(isurfsrc)
     6470            !$OMP ATOMIC
     6471            mrtinsw(imrt) = mrtinsw(imrt) + temp
     6472            temp = mrtf(imrtf) * surfoutl(isurfsrc)
     6473            !$OMP ATOMIC
     6474            mrtinlw(imrt) = mrtinlw(imrt) + temp
    64696475         ENDDO
    6470          !$OMP END DO
    64716476
    64726477         IF ( trace_fluxes_above >= 0.0_wp )  THEN
     
    64906495     IF ( npcbl > 0 )  THEN
    64916496         pcm_heating_rate(:,:,:) = 0.0_wp
    6492          !$OMP DO PRIVATE (ipcgb, i, j, k, kk) REDUCTION(+:pabsswl) SCHEDULE (STATIC)
     6497         !$OMP PARALLEL DO PRIVATE (ipcgb, i, j, k, kk) REDUCTION(+:pabsswl) SCHEDULE (STATIC)
    64936498         DO ipcgb = 1, npcbl
    64946499             j = pcbl(iy, ipcgb)
     
    65036508             pabsswl = pabsswl + pcbinsw(ipcgb)
    65046509         ENDDO
    6505          !$OMP END DO
    65066510
    65076511         IF ( humidity .AND. plant_canopy_transpiration ) THEN
     
    65096513             pcm_transpiration_rate(:,:,:) = 0.0_wp
    65106514             pcm_latent_rate(:,:,:) = 0.0_wp
    6511              !$OMP DO PRIVATE (ipcgb, i, j, k, kk) SCHEDULE (STATIC)
     6515             !$OMP PARALLEL DO PRIVATE (ipcgb, i, j, k, kk) SCHEDULE (STATIC)
    65126516             DO ipcgb = 1, npcbl
    65136517                 i = pcbl(ix, ipcgb)
     
    65206524                                                   pcm_latent_rate(kk,j,i) )
    65216525             ENDDO
    6522              !$OMP END DO
    65236526         ENDIF
    65246527     ENDIF
     
    66306633     ENDDO
    66316634
    6632      !$OMP DO PRIVATE (i, d) REDUCTION(+:pabsswl, pabslwl, pemitlwl, pabs_surf_lwdifl) &
    6633      !$OMP&   SCHEDULE (STATIC)
     6635     !$OMP PARALLEL DO PRIVATE (i, d) REDUCTION(+:pabsswl, pabslwl, pemitlwl, pabs_surf_lwdifl) &
     6636     !$OMP&            SCHEDULE (STATIC)
    66346637     DO  i = 1, nsurfl
    66356638        d  = surfl(id, i)
     
    66466649                           emiss_surf(i) * facearea(d) * surfinlwdif(i)
    66476650     ENDDO
    6648      !$OMP END DO
    66496651
    66506652     DO l = 0, 1
    6651         !$OMP DO PRIVATE (m) SCHEDULE (STATIC)
     6653        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
    66526654        DO  m = 1, surf_usm_h(l)%ns
    66536655           surf_usm_h(l)%surfhf(m) = surf_usm_h(l)%rad_sw_in(m)  +          &
     
    66566658                                  surf_usm_h(l)%rad_lw_out(m)
    66576659        ENDDO
    6658         !$OMP END DO
    6659         !$OMP DO PRIVATE (m) SCHEDULE (STATIC)
     6660        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
    66606661        DO  m = 1, surf_lsm_h(l)%ns
    66616662           surf_lsm_h(l)%surfhf(m) = surf_lsm_h(l)%rad_sw_in(m)  +          &
     
    66646665                                  surf_lsm_h(l)%rad_lw_out(m)
    66656666        ENDDO
    6666         !$OMP END DO
    66676667     ENDDO
    66686668
    66696669     DO  l = 0, 3
    6670         !$OMP DO PRIVATE (m) SCHEDULE (STATIC)
    66716670!--     urban
     6671        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
    66726672        DO  m = 1, surf_usm_v(l)%ns
    66736673           surf_usm_v(l)%surfhf(m) = surf_usm_v(l)%rad_sw_in(m)  +          &
     
    66766676                                     surf_usm_v(l)%rad_lw_out(m)
    66776677        ENDDO
    6678         !$OMP END DO
    66796678!--     land
    6680         !$OMP DO PRIVATE (m) SCHEDULE (STATIC)
     6679        !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC)
    66816680        DO  m = 1, surf_lsm_v(l)%ns
    66826681           surf_lsm_v(l)%surfhf(m) = surf_lsm_v(l)%rad_sw_in(m)  +          &
     
    66866685
    66876686        ENDDO
    6688         !$OMP END DO
    66896687     ENDDO
    66906688!
  • palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

    r4691 r4717  
    2525! -----------------
    2626! $Id$
     27! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     28! directives (J. Resler)
     29!
     30! 4691 2020-09-22 14:38:38Z suehring
    2731! Bugfix for commit 4593 in vector branch of calc_ol
    2832!
     
    720724!-- This is because the scalar coefficients are also used for other scalars such as passive scalars,
    721725!-- chemistry and aerosols.
    722     !$OMP PARALLEL  DO PRIVATE( z_mo )
     726    !$OMP PARALLEL DO PRIVATE( z_mo )
    723727    !$ACC PARALLEL LOOP PRIVATE(z_mo) &
    724728    !$ACC PRESENT(surf)
     
    10501054!
    10511055!--    Calculate the Obukhov length using Newton iteration
    1052        !$OMP PARALLEL DO PRIVATE(i, j, z_mo) &
    1053        !$OMP PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol)
     1056       !$OMP PARALLEL DO PRIVATE(i, j, z_mo, ol_old, iter, ol_m, ol_l, ol_u, f, f_d_ol)
    10541057       !$ACC PARALLEL LOOP PRIVATE(i, j, z_mo) &
    10551058       !$ACC PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol) &
     
    15831586
    15841587          IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
    1585             !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
     1588             !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )
    15861589             DO  m = 1, surf%ns
    15871590                i = surf%i(m)
     
    19521955!--    Compute wsus l={0,1} and wsvs l={2,3}
    19531956       IF ( mom_w )  THEN
    1954           !$OMP PARALLEL  DO PRIVATE( i, j, k )
     1957          !$OMP PARALLEL DO PRIVATE( i, j, k )
    19551958          DO  m = 1, surf%ns
    19561959             i = surf%i(m)
  • palm/trunk/SOURCE/timestep.f90

    r4564 r4717  
    2020! Current revisions:
    2121! -----------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     28! directives (J. Resler)
     29!
     30! 4564 2020-06-12 14:03:36Z raasch
    2731! Vertical nesting method of Huq et al. (2019) removed
    2832!
    2933! 4540 2020-05-18 15:23:29Z raasch
    3034! File re-formatted to follow the PALM coding standard
    31 !
    3235!
    3336! 4444 2020-03-05 15:59:50Z raasch
     
    308311       ENDDO
    309312
    310        !$OMP PARALLEL private(i,j,k) reduction(MIN: dt_diff_l)
    311        !$OMP DO
     313       !$OMP PARALLEL DO private(i,j,k) reduction(MIN: dt_diff_l)
    312314       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
    313315       !$ACC COPY(dt_diff_l) REDUCTION(MIN: dt_diff_l) &
     
    321323          ENDDO
    322324       ENDDO
    323        !$OMP END PARALLEL
    324325#if defined( __parallel )
    325326       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
  • palm/trunk/SOURCE/transpose.f90

    r4540 r4717  
    2020! Current revisions:
    2121! -----------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27! Formatting of OpenMP directives (J. Resler)
     28!
     29! 4540 2020-05-18 15:23:29Z raasch
    2730! File re-formatted to follow the PALM coding standard
    28 !
    2931!
    3032! 4429 2020-02-27 15:24:30Z raasch
     
    197199!
    198200!--    Reorder transposed array
    199 !$OMP  PARALLEL PRIVATE ( i, j, k, l, ys )
     201       !$OMP  PARALLEL PRIVATE ( i, j, k, l, ys )
    200202       DO  l = 0, pdims(2) - 1
    201203          ys = 0 + l * ( nyn_x - nys_x + 1 )
     
    214216          !$OMP END DO NOWAIT
    215217       ENDDO
    216 !$OMP  END PARALLEL
     218       !$OMP  END PARALLEL
    217219#endif
    218220
     
    221223!
    222224!--    Reorder transposed array
    223 !$OMP  PARALLEL PRIVATE ( i, j, k )
    224 !$OMP  DO
     225       !$OMP  PARALLEL PRIVATE ( i, j, k )
     226       !$OMP  DO
    225227#if __acc_fft_device
    226228       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    234236          ENDDO
    235237       ENDDO
    236 !$OMP  END PARALLEL
     238       !$OMP  END PARALLEL
    237239
    238240    ENDIF
     
    271273!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
    272274!-- In case of parallel fft/transposition, scattered store is faster in backward direction!!!
    273    !$OMP  PARALLEL PRIVATE ( i, j, k )
    274    !$OMP  DO
    275 #if __acc_fft_device
    276    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
    277    !$ACC PRESENT(f_out, f_inv)
     275    !$OMP  PARALLEL PRIVATE ( i, j, k )
     276    !$OMP  DO
     277#if __acc_fft_device
     278    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     279    !$ACC PRESENT(f_out, f_inv)
    278280#endif
    279281    DO  i = nxl, nxr
     
    430432!
    431433!--    Reorder the array in a way that the z index is in first position
    432 !$OMP PARALLEL PRIVATE ( i, j, k )
    433 !$OMP DO
     434       !$OMP PARALLEL PRIVATE ( i, j, k )
     435       !$OMP DO
    434436#if __acc_fft_device
    435437       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    443445          ENDDO
    444446       ENDDO
    445 !$OMP END PARALLEL
     447       !$OMP END PARALLEL
    446448
    447449    ENDIF
     
    481483!
    482484!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
    483    !$OMP  PARALLEL PRIVATE ( i, j, k )
    484    !$OMP  DO
     485   !$OMP PARALLEL PRIVATE ( i, j, k )
     486   !$OMP DO
    485487#if __acc_fft_device
    486488   !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    494496        ENDDO
    495497    ENDDO
    496     !$OMP  END PARALLEL
     498    !$OMP END PARALLEL
    497499
    498500 END SUBROUTINE resort_for_yx
     
    560562!
    561563!--    Reorder input array for transposition
    562 !$OMP PARALLEL PRIVATE ( i, j, k, l, ys )
     564       !$OMP PARALLEL PRIVATE ( i, j, k, l, ys )
    563565       DO  l = 0, pdims(2) - 1
    564566          ys = 0 + l * ( nyn_x - nys_x + 1 )
     
    577579          !$OMP END DO NOWAIT
    578580       ENDDO
    579 !$OMP END PARALLEL
     581       !$OMP END PARALLEL
    580582
    581583!
     
    610612!
    611613!--    Reorder array f_in the same way as ALLTOALL did it.
    612 !$OMP PARALLEL PRIVATE ( i, j, k )
    613 !$OMP DO
     614       !$OMP PARALLEL PRIVATE ( i, j, k )
     615       !$OMP DO
    614616#if __acc_fft_device
    615617       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    623625          ENDDO
    624626       ENDDO
    625 !$OMP END PARALLEL
     627       !$OMP END PARALLEL
    626628
    627629    ENDIF
     
    748750!
    749751!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
    750    !$OMP PARALLEL PRIVATE ( i, j, k )
    751    !$OMP DO
     752    !$OMP PARALLEL PRIVATE ( i, j, k )
     753    !$OMP DO
    752754#if __acc_fft_device
    753755    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    761763        ENDDO
    762764    ENDDO
    763     !$OMP  END PARALLEL
     765    !$OMP END PARALLEL
    764766
    765767 END SUBROUTINE resort_for_yz
     
    827829    IF ( pdims(1) == 1 )  THEN
    828830
    829 !$OMP PARALLEL PRIVATE ( i, j, k )
    830 !$OMP DO
     831       !$OMP PARALLEL PRIVATE ( i, j, k )
     832       !$OMP DO
    831833#if __acc_fft_device
    832834       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    840842          ENDDO
    841843       ENDDO
    842 !$OMP END PARALLEL
     844       !$OMP END PARALLEL
    843845
    844846    ELSE
     
    873875!
    874876!--    Reorder transposed array
    875 !$OMP PARALLEL PRIVATE ( i, j, k, l, zs )
     877       !$OMP PARALLEL PRIVATE ( i, j, k, l, zs )
    876878       DO  l = 0, pdims(1) - 1
    877879          zs = 1 + l * ( nzt_y - nzb_y + 1 )
     
    890892          !$OMP END DO NOWAIT
    891893       ENDDO
    892 !$OMP END PARALLEL
     894       !$OMP END PARALLEL
    893895#endif
    894896
     
    927929!
    928930!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
    929    !$OMP PARALLEL PRIVATE ( i, j, k )
    930    !$OMP DO
    931 #if __acc_fft_device
    932    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
    933    !$ACC PRESENT(f_in, f_inv)
     931    !$OMP PARALLEL PRIVATE ( i, j, k )
     932    !$OMP DO
     933#if __acc_fft_device
     934    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     935    !$ACC PRESENT(f_in, f_inv)
    934936#endif
    935937    DO  i = nxl, nxr
     
    940942        ENDDO
    941943    ENDDO
    942     !$OMP  END PARALLEL
     944    !$OMP END PARALLEL
    943945
    944946 END SUBROUTINE resort_for_zx
     
    10161018    IF ( pdims(1) == 1 )  THEN
    10171019
    1018 !$OMP PARALLEL PRIVATE ( i, j, k )
    1019 !$OMP DO
     1020       !$OMP PARALLEL PRIVATE ( i, j, k )
     1021       !$OMP DO
    10201022#if __acc_fft_device
    10211023       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    10291031          ENDDO
    10301032       ENDDO
    1031 !$OMP END PARALLEL
     1033       !$OMP END PARALLEL
    10321034
    10331035    ELSE
     
    10801082       ELSE
    10811083
    1082           !$OMP  PARALLEL PRIVATE ( i, j, k, l, xs )
     1084          !$OMP PARALLEL PRIVATE ( i, j, k, l, xs )
    10831085          DO  l = 0, pdims(1) - 1
    10841086             xs = 0 + l * nnx
     
    10971099             !$OMP END DO NOWAIT
    10981100          ENDDO
    1099           !$OMP  END PARALLEL
     1101          !$OMP END PARALLEL
    11001102
    11011103       ENDIF
     
    11391141!
    11401142!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
    1141     !$OMP  PARALLEL PRIVATE ( i, j, k )
    1142     !$OMP  DO
     1143    !$OMP PARALLEL PRIVATE ( i, j, k )
     1144    !$OMP DO
    11431145#if __acc_fft_device
    11441146    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    11521154        ENDDO
    11531155    ENDDO
    1154     !$OMP  END PARALLEL
     1156    !$OMP END PARALLEL
    11551157
    11561158 END SUBROUTINE resort_for_zy
     
    12201222!
    12211223!--    Reorder input array for transposition
    1222 !$OMP PARALLEL PRIVATE ( i, j, k, l, zs )
     1224       !$OMP PARALLEL PRIVATE ( i, j, k, l, zs )
    12231225       DO  l = 0, pdims(1) - 1
    12241226          zs = 1 + l * ( nzt_y - nzb_y + 1 )
     
    12371239          !$OMP END DO NOWAIT
    12381240       ENDDO
    1239 !$OMP END PARALLEL
     1241       !$OMP END PARALLEL
    12401242
    12411243!
     
    12691271!
    12701272!--    Reorder the array in the same way like ALLTOALL did it
    1271 !$OMP PARALLEL PRIVATE ( i, j, k )
    1272 !$OMP DO
     1273       !$OMP PARALLEL PRIVATE ( i, j, k )
     1274       !$OMP DO
    12731275#if __acc_fft_device
    12741276       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     
    12821284          ENDDO
    12831285       ENDDO
    1284 !$OMP END PARALLEL
     1286       !$OMP END PARALLEL
    12851287
    12861288    ENDIF
  • palm/trunk/SOURCE/turbulence_closure_mod.f90

    r4674 r4717  
    2525! -----------------
    2626! $Id$
     27! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     28! directives (J. Resler)
     29!
     30! 4674 2020-09-10 10:36:55Z pavelkrc
    2731! Update ACC directives for downward facing USM and LSM surfaces
    2832!
     
    21032107!--    Not available in case of non-cyclic boundary conditions.
    21042108!--    Default surfaces, upward-facing
    2105        !$OMP PARALLEL DO PRIVATE(i,j,k,m)
     2109       !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc)
    21062110       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
    21072111       !$ACC PRESENT(surf_def_h(0), u, v, drho_air_zw, zu)
     
    21322136!
    21332137!--    Default surfaces, downward-facing surfaces
    2134        !$OMP PARALLEL DO PRIVATE(i,j,k,m)
    2135        !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
     2138       !$OMP PARALLEL DO PRIVATE(i, j, k, m)
     2139       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) &
    21362140       !$ACC PRESENT(surf_def_h(1), u, v, drho_air_zw, zu, km)
    21372141       DO  m = 1, surf_def_h(1)%ns
     
    21582162!
    21592163!--    Natural surfaces, upward- and downward facing
    2160        !$OMP PARALLEL DO PRIVATE(i,j,k,m)
     2164       !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc)
    21612165       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
    21622166       !$ACC PRESENT(surf_lsm_h(0), u, v, drho_air_zw, zu)
     
    21872191!
    21882192!--    Natural surfaces, downward-facing surfaces
    2189        !$OMP PARALLEL DO PRIVATE(i,j,k,m)
    2190        !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
     2193       !$OMP PARALLEL DO PRIVATE(i, j, k, m)
     2194       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) &
    21912195       !$ACC PRESENT(surf_lsm_h(1), u, v, drho_air_zw, zu, km)
    21922196       DO  m = 1, surf_lsm_h(1)%ns
     
    22132217!
    22142218!--    Urban surfaces, upward-facing
    2215        !$OMP PARALLEL DO PRIVATE(i,j,k,m)
     2219       !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc)
    22162220       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
    22172221       !$ACC PRESENT(surf_usm_h(0), u, v, drho_air_zw, zu)
     
    22422246!
    22432247!--    Urban surfaces, downward-facing surfaces
    2244        !$OMP PARALLEL DO PRIVATE(i,j,k,m)
    2245        !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) &
     2248       !$OMP PARALLEL DO PRIVATE(i, j, k, m)
     2249       !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) &
    22462250       !$ACC PRESENT(surf_usm_h(1), u, v, drho_air_zw, zu, km)
    22472251       DO  m = 1, surf_usm_h(1)%ns
     
    51925196                                                ! Data output
    51935197    !$ACC END KERNELS
    5194 !$OMP END PARALLEL
     5198    !$OMP END PARALLEL
    51955199
    51965200 END SUBROUTINE tcm_diffusivities_default
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r4713 r4717  
    2727! -----------------
    2828! $Id$
     29! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP
     30! directives (J. Resler)
     31!
     32! 4713 2020-09-29 12:02:05Z pavelkrc
    2933! - Do not change original fractions in USM energy balance
    3034! - Correct OpenMP parallelization
     
    51595163    ENDIF
    51605164
    5161     !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)
    51625165    wall_mod=1.0_wp
    51635166    IF ( usm_wall_mod  .AND.  during_spinup )  THEN
     
    51845187!
    51855188!-- Cycle for all surfaces in given direction
    5186     !$OMP DO SCHEDULE (STATIC)
     5189    !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod) SCHEDULE (STATIC)
    51875190    DO  m = 1, surf%ns
    51885191!
     
    51945197!--    Prognostic equation for ground/roof temperature t_wall
    51955198       wtend(:) = 0.0_wp
    5196        wtend(nzb_wall) = ( 1.0_wp / surf%rho_c_wall(nzb_wall,m) )                     &
    5197                           * ( surf%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)          &
    5198                               * ( t_wall%val(nzb_wall+1,m) - t_wall%val(nzb_wall,m) ) &
    5199                               * surf%ddz_wall(nzb_wall+1,m)                           &
    5200                               + surf%frac(m,ind_veg_wall)                             &
    5201                               / ( surf%frac(m,ind_veg_wall)                           &
    5202                                   + surf%frac(m,ind_pav_green) )                      &
    5203                               * surf%wghf_eb(m)                                       &
    5204                               - surf%frac(m,ind_pav_green)                            &
    5205                               / ( surf%frac(m,ind_veg_wall)                           &
    5206                                   + surf%frac(m,ind_pav_green) )                      &
    5207                               * ( surf%lambda_h_green(nzt_wall,m)                     &
    5208                               * wall_mod(nzt_wall)                                    &
    5209                               * surf%ddz_green(nzt_wall,m)                            &
    5210                               + surf%lambda_h(nzb_wall,m)                             &
    5211                               * wall_mod(nzb_wall)                                    &
    5212                               * surf%ddz_wall(nzb_wall,m) )                           &
    5213                               / ( surf%ddz_green(nzt_wall,m)                          &
    5214                               + surf%ddz_wall(nzb_wall,m) )                           &
    5215                               * ( t_wall%val(nzb_wall,m) - t_green%val(nzt_wall,m) )  &
     5199       wtend(nzb_wall) = ( 1.0_wp / surf%rho_c_wall(nzb_wall,m) )                                 &
     5200                          * ( surf%lambda_h(nzb_wall,m) * wall_mod(nzb_wall)                      &
     5201                              * ( t_wall%val(nzb_wall+1,m) - t_wall%val(nzb_wall,m) )             &
     5202                              * surf%ddz_wall(nzb_wall+1,m)                                       &
     5203                              + surf%frac(m,ind_veg_wall)                                         &
     5204                              / ( surf%frac(m,ind_veg_wall)                                       &
     5205                                  + surf%frac(m,ind_pav_green) )                                  &
     5206                              * surf%wghf_eb(m)                                                   &
     5207                              - surf%frac(m,ind_pav_green)                                        &
     5208                              / ( surf%frac(m,ind_veg_wall)                                       &
     5209                                  + surf%frac(m,ind_pav_green) )                                  &
     5210                              * ( surf%lambda_h_green(nzt_wall,m)                                 &
     5211                              * wall_mod(nzt_wall)                                                &
     5212                              * surf%ddz_green(nzt_wall,m)                                        &
     5213                              + surf%lambda_h(nzb_wall,m)                                         &
     5214                              * wall_mod(nzb_wall)                                                &
     5215                              * surf%ddz_wall(nzb_wall,m) )                                       &
     5216                              / ( surf%ddz_green(nzt_wall,m)                                      &
     5217                              + surf%ddz_wall(nzb_wall,m) )                                       &
     5218                              * ( t_wall%val(nzb_wall,m) - t_green%val(nzt_wall,m) )              &
    52165219                            ) * surf%ddz_wall_stag(nzb_wall,m)
    52175220
     
    52265229
    52275230       DO  kw = nzb_wall+1, nzt_wall-1
    5228           wtend(kw) = ( 1.0_wp / surf%rho_c_wall(kw,m) )                   &
    5229                          * ( surf%lambda_h(kw,m) * wall_mod(kw)            &
    5230                              * ( t_wall%val(kw+1,m) - t_wall%val(kw,m) )   &
    5231                              * surf%ddz_wall(kw+1,m)                       &
    5232                              - surf%lambda_h(kw-1,m) * wall_mod(kw-1)      &
    5233                              * ( t_wall%val(kw,m) - t_wall%val(kw-1,m) )   &
    5234                              * surf%ddz_wall(kw,m)                         &
    5235                            ) * surf%ddz_wall_stag(kw,m)
     5231          wtend(kw) = ( 1.0_wp / surf%rho_c_wall(kw,m) )                                          &
     5232                      * ( surf%lambda_h(kw,m) * wall_mod(kw)                                      &
     5233                      * ( t_wall%val(kw+1,m) - t_wall%val(kw,m) )                                 &
     5234                      * surf%ddz_wall(kw+1,m)                                                     &
     5235                      - surf%lambda_h(kw-1,m) * wall_mod(kw-1)                                    &
     5236                      * ( t_wall%val(kw,m) - t_wall%val(kw-1,m) )                                 &
     5237                      * surf%ddz_wall(kw,m)                                                       &
     5238                      ) * surf%ddz_wall_stag(kw,m)
    52365239       ENDDO
    5237 
    5238        wtend(nzt_wall) = ( 1.0_wp / surf%rho_c_wall(nzt_wall,m) )                       &
    5239                             * ( -surf%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)     &
    5240                                 * ( t_wall%val(nzt_wall,m) - t_wall%val(nzt_wall-1,m) ) &
    5241                                 * surf%ddz_wall(nzt_wall,m)                             &
    5242                                 + surf%iwghf_eb(m)                                      &
    5243                               ) * surf%ddz_wall_stag(nzt_wall,m)
    5244 
    5245        t_wall_p%val(nzb_wall:nzt_wall,m) = t_wall%val(nzb_wall:nzt_wall,m) + dt_3d      &
    5246                                          * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3) &
     5240       wtend(nzt_wall) = ( 1.0_wp / surf%rho_c_wall(nzt_wall,m) )                                 &
     5241                         * ( -surf%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1)                  &
     5242                             * ( t_wall%val(nzt_wall,m) - t_wall%val(nzt_wall-1,m) )              &
     5243                              * surf%ddz_wall(nzt_wall,m) + surf%iwghf_eb(m)                      &
     5244                           ) * surf%ddz_wall_stag(nzt_wall,m)
     5245
     5246       t_wall_p%val(nzb_wall:nzt_wall,m) = t_wall%val(nzb_wall:nzt_wall,m) + dt_3d                &
     5247                                         * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3)           &
    52475248                                             * surf%tt_wall_m(nzb_wall:nzt_wall,m) )
    52485249
     
    52555256!--       of shortwave radiation into account
    52565257          wintend(:) = 0.0_wp
    5257           wintend(nzb_wall) = ( 1.0_wp / surf%rho_c_window(nzb_wall,m) )                    &
    5258                                 * ( surf%lambda_h_window(nzb_wall,m)                        &
    5259                                 * ( t_window%val(nzb_wall+1,m) - t_window%val(nzb_wall,m) ) &
    5260                                 * surf%ddz_window(nzb_wall+1,m)                             &
    5261                                 + surf%wghf_eb_window(m)                                    &
    5262                                 + surf%rad_sw_in(m)                                         &
    5263                                 * ( 1.0_wp - exp( -win_absorp                               &
    5264                                     * surf%zw_window(nzb_wall,m) ) )                        &
     5258          wintend(nzb_wall) = ( 1.0_wp / surf%rho_c_window(nzb_wall,m) )                          &
     5259                                * ( surf%lambda_h_window(nzb_wall,m)                              &
     5260                                * ( t_window%val(nzb_wall+1,m) - t_window%val(nzb_wall,m) )       &
     5261                                * surf%ddz_window(nzb_wall+1,m)                                   &
     5262                                + surf%wghf_eb_window(m)                                          &
     5263                                + surf%rad_sw_in(m)                                               &
     5264                                * ( 1.0_wp - exp( -win_absorp                                     &
     5265                                    * surf%zw_window(nzb_wall,m) ) )                              &
    52655266                              ) * surf%ddz_window_stag(nzb_wall,m)
    52665267
     
    52725273          ENDIF
    52735274
     5275
    52745276          DO  kw = nzb_wall+1, nzt_wall-1
    5275              wintend(kw) = ( 1.0_wp / surf%rho_c_window(kw,m) )                        &
    5276                               * ( surf%lambda_h_window(kw,m)                           &
    5277                                   * ( t_window%val(kw+1,m) - t_window%val(kw,m) )      &
    5278                                   * surf%ddz_window(kw+1,m)                            &
    5279                                   - surf%lambda_h_window(kw-1,m)                       &
    5280                                  * ( t_window%val(kw,m) - t_window%val(kw-1,m) )       &
    5281                                  * surf%ddz_window(kw,m)                               &
    5282                                  + surf%rad_sw_in(m)                                   &
    5283                                  * ( exp( -win_absorp * surf%zw_window(kw-1,m) )       &
    5284                                      - exp(-win_absorp * surf%zw_window(kw,m) )        &
    5285                                    )                                                   &
    5286                                  ) * surf%ddz_window_stag(kw,m)
     5277             wintend(kw) = ( 1.0_wp / surf%rho_c_window(kw,m) )                                   &
     5278                           * ( surf%lambda_h_window(kw,m)                                         &
     5279                           * ( t_window%val(kw+1,m) - t_window%val(kw,m) )                        &
     5280                           * surf%ddz_window(kw+1,m)                                              &
     5281                           - surf%lambda_h_window(kw-1,m)                                         &
     5282                           * ( t_window%val(kw,m) - t_window%val(kw-1,m) )                        &
     5283                           * surf%ddz_window(kw,m)                                                &
     5284                           + surf%rad_sw_in(m)                                                    &
     5285                           * ( exp( -win_absorp * surf%zw_window(kw-1,m) )                        &
     5286                           - exp(-win_absorp * surf%zw_window(kw,m) )                             &
     5287                             )                                                                    &
     5288                             ) * surf%ddz_window_stag(kw,m)
    52875289
    52885290          ENDDO
    52895291
    5290           wintend(nzt_wall) = ( 1.0_wp / surf%rho_c_window(nzt_wall,m) )                     &
    5291                               * ( -surf%lambda_h_window(nzt_wall-1,m)                        &
    5292                                  * ( t_window%val(nzt_wall,m) - t_window%val(nzt_wall-1,m) ) &
    5293                                  * surf%ddz_window(nzt_wall,m)                               &
    5294                                  + surf%iwghf_eb_window(m)                                   &
    5295                                  + surf%rad_sw_in(m)                                         &
    5296                                  * ( exp( -win_absorp                                        &
    5297                                      * surf%zw_window(nzt_wall-1,m) )                        &
    5298                                    - exp( -win_absorp                                        &
    5299                                      * surf%zw_window(nzt_wall,m) )                          &
    5300                                    )                                                         &
    5301                                 ) * surf%ddz_window_stag(nzt_wall,m)
    5302 
    5303           t_window_p%val(nzb_wall:nzt_wall,m) = t_window%val(nzb_wall:nzt_wall,m) + dt_3d       &
    5304                                               * ( tsc(2) * wintend(nzb_wall:nzt_wall) + tsc(3)  &
     5292          wintend(nzt_wall) = ( 1.0_wp / surf%rho_c_window(nzt_wall,m) )                          &
     5293                                 * ( -surf%lambda_h_window(nzt_wall-1,m)                          &
     5294                                 * ( t_window%val(nzt_wall,m) - t_window%val(nzt_wall-1,m) )      &
     5295                                 * surf%ddz_window(nzt_wall,m)                                    &
     5296                                 + surf%iwghf_eb_window(m)                                        &
     5297                                 + surf%rad_sw_in(m)                                              &
     5298                                 * ( exp( -win_absorp                                             &
     5299                                 * surf%zw_window(nzt_wall-1,m) )                                 &
     5300                                 - exp( -win_absorp                                               &
     5301                                 * surf%zw_window(nzt_wall,m) )                                   &
     5302                                   )                                                              &
     5303                                   ) * surf%ddz_window_stag(nzt_wall,m)
     5304
     5305          t_window_p%val(nzb_wall:nzt_wall,m) = t_window%val(nzb_wall:nzt_wall,m) + dt_3d         &
     5306                                              * ( tsc(2) * wintend(nzb_wall:nzt_wall) + tsc(3)    &
    53055307                                              * surf%tt_window_m(nzb_wall:nzt_wall,m) )
    53065308
    53075309       ENDIF
    5308 
    53095310!
    53105311!--    Calculate t_wall tendencies for the next Runge-Kutta step
     
    53165317           ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    53175318               DO  kw = nzb_wall, nzt_wall
    5318                   surf%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) +                            &
     5319                  surf%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) +                                 &
    53195320                                               5.3125_wp * surf%tt_wall_m(kw,m)
    53205321               ENDDO
     
    53325333              ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    53335334                  DO  kw = nzb_wall, nzt_wall
    5334                      surf%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +                     &
     5335                     surf%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +                          &
    53355336                                                    5.3125_wp * surf%tt_window_m(kw,m)
    53365337                  ENDDO
     
    53395340       ENDIF
    53405341    ENDDO
    5341     !$OMP END PARALLEL
    53425342
    53435343    IF ( debug_output_timestep )  THEN
     
    54035403       ENDIF
    54045404
    5405        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, gtend,    &
    5406        !$OMP&                  tend, h_vg, gamma_green_temp, m_total, root_extr_green)
    5407        !$OMP DO SCHEDULE (STATIC)
     5405       !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp,      &
     5406       !$OMP&  gtend, tend, h_vg, gamma_green_temp, m_total, root_extr_green) SCHEDULE (STATIC)
    54085407       DO  m = 1, surf%ns
    54095408          IF (surf%frac(m,ind_pav_green) > 0.0_wp)  THEN
     
    54175416!
    54185417!--             Calculate volumetric heat capacity of the soil, taking into account water content
    5419                 surf%rho_c_total_green(kw,m) = (surf%rho_c_green(kw,m)              &
    5420                                                      * (1.0_wp - swc_sat_h(l)%val(kw,m))                     &
     5418                surf%rho_c_total_green(kw,m) = (surf%rho_c_green(kw,m)                            &
     5419                                                     * (1.0_wp - swc_sat_h(l)%val(kw,m))          &
    54215420                                                     + rho_c_water * swc_h(l)%val(kw,m))
    54225421
    54235422!
    54245423!--             Calculate soil heat conductivity at the center of the soil layers
    5425                 lambda_h_green_sat = lambda_h_green_sm ** ( 1.0_wp - swc_sat_h(l)%val(kw,m) )                &
     5424                lambda_h_green_sat = lambda_h_green_sm ** ( 1.0_wp - swc_sat_h(l)%val(kw,m) )     &
    54265425                                     * lambda_h_water ** swc_h(l)%val(kw,m)
    54275426
    54285427                ke = 1.0_wp + LOG10( MAX( 0.1_wp,swc_h(l)%val(kw,m) / swc_sat_h(l)%val(kw,m) ) )
    54295428
    5430                 lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry)                &
     5429                lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry)            &
    54315430                                        + lambda_h_green_dry
    54325431
     
    54395438!--          For pavement surface, the true pavement depth is considered
    54405439             DO  kw = nzb_wall, nzt_wall
    5441                 surf%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) ) &
     5440                surf%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) )   &
    54425441                                                  * 0.5_wp
    54435442             ENDDO
     
    54475446!--          Prognostic equation for ground/roof temperature t_green_h
    54485447             gtend(:) = 0.0_wp
    5449              gtend(nzb_wall) = ( 1.0_wp / surf%rho_c_total_green(nzb_wall,m) )                &
    5450                                * ( surf%lambda_h_green(nzb_wall,m)                            &
    5451                                    * ( t_green_h(l)%val(nzb_wall+1,m)                                         &
    5452                                    - t_green_h(l)%val(nzb_wall,m) )                                           &
    5453                                    * surf%ddz_green(nzb_wall+1,m)                             &
    5454                                    + surf%wghf_eb_green(m)                                    &
     5448             gtend(nzb_wall) = ( 1.0_wp / surf%rho_c_total_green(nzb_wall,m) )                    &
     5449                               * ( surf%lambda_h_green(nzb_wall,m)                                &
     5450                                   * ( t_green_h(l)%val(nzb_wall+1,m)                             &
     5451                                   - t_green_h(l)%val(nzb_wall,m) )                               &
     5452                                   * surf%ddz_green(nzb_wall+1,m)                                 &
     5453                                   + surf%wghf_eb_green(m)                                        &
    54555454                                 ) * surf%ddz_green_stag(nzb_wall,m)
    54565455
    54575456             DO  kw = nzb_wall+1, nzt_wall
    5458                 gtend(kw) = ( 1.0_wp / surf%rho_c_total_green(kw,m) )                         &
    5459                             * ( surf%lambda_h_green(kw,m)                                     &
    5460                                 * ( t_green_h(l)%val(kw+1,m) - t_green_h(l)%val(kw,m) )                              &
    5461                                 * surf%ddz_green(kw+1,m)                                      &
    5462                                 - surf%lambda_h_green(kw-1,m)                                 &
    5463                                 * ( t_green_h(l)%val(kw,m) - t_green_h(l)%val(kw-1,m) )                              &
    5464                                 * surf%ddz_green(kw,m)                                        &
     5457                gtend(kw) = ( 1.0_wp / surf%rho_c_total_green(kw,m) )                             &
     5458                            * ( surf%lambda_h_green(kw,m)                                         &
     5459                                * ( t_green_h(l)%val(kw+1,m) - t_green_h(l)%val(kw,m) )           &
     5460                                * surf%ddz_green(kw+1,m)                                          &
     5461                                - surf%lambda_h_green(kw-1,m)                                     &
     5462                                * ( t_green_h(l)%val(kw,m) - t_green_h(l)%val(kw-1,m) )           &
     5463                                * surf%ddz_green(kw,m)                                            &
    54655464                              ) * surf%ddz_green_stag(kw,m)
    54665465             ENDDO
    54675466
    5468              t_green_h_p(l)%val(nzb_wall:nzt_wall,m) = t_green_h(l)%val(nzb_wall:nzt_wall,m)  &
    5469                             + dt_3d * ( tsc(2) * gtend(nzb_wall:nzt_wall) + tsc(3)            &
     5467             t_green_h_p(l)%val(nzb_wall:nzt_wall,m) = t_green_h(l)%val(nzb_wall:nzt_wall,m)      &
     5468                            + dt_3d * ( tsc(2) * gtend(nzb_wall:nzt_wall) + tsc(3)                &
    54705469                            * surf%tt_green_m(nzb_wall:nzt_wall,m) )
    54715470
     
    54805479                 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    54815480                     DO  kw = nzb_wall, nzt_wall
    5482                         surf%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + 5.3125_wp             &
     5481                        surf%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + 5.3125_wp                 &
    54835482                                                      * surf%tt_green_m(kw,m)
    54845483                     ENDDO
     
    54905489!
    54915490!--             Calculate soil diffusivity at the center of the soil layers
    5492                 lambda_green_temp(kw) = ( - b_ch * surf%gamma_w_green_sat(kw,m) * psi_sat      &
    5493                                           / swc_sat_h(l)%val(kw,m) )                           &
    5494                                         * ( MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) )     &
     5491                lambda_green_temp(kw) = ( - b_ch * surf%gamma_w_green_sat(kw,m) * psi_sat          &
     5492                                          / swc_sat_h(l)%val(kw,m) )                               &
     5493                                        * ( MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) )         &
    54955494                                          / swc_sat_h(l)%val(kw,m) )**( b_ch + 2.0_wp )
    54965495
     
    55005499!
    55015500!--                Calculate the hydraulic conductivity after Van Genuchten (1980)
    5502                    h_vg = ( ( (swc_res_h(l)%val(kw,m) - swc_sat_h(l)%val(kw,m))                &
    5503                               / ( swc_res_h(l)%val(kw,m) -                 &
    5504                               MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) ) )**                                    &
    5505                               ( surf%n_vg_green(m) / (surf%n_vg_green(m) - 1.0_wp ) ) &
    5506                               - 1.0_wp                                                                  &
     5501                   h_vg = ( ( (swc_res_h(l)%val(kw,m) - swc_sat_h(l)%val(kw,m))                    &
     5502                              / ( swc_res_h(l)%val(kw,m) -                                         &
     5503                              MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) ) )**                 &
     5504                              ( surf%n_vg_green(m) / (surf%n_vg_green(m) - 1.0_wp ) )              &
     5505                              - 1.0_wp                                                             &
    55075506                          )** ( 1.0_wp / surf%n_vg_green(m) ) / surf%alpha_vg_green(m)
    55085507
    55095508
    5510                    gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m)                          &
    5511                                           * ( ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )**  &
    5512                                                 surf%n_vg_green(m) )**                          &
    5513                                                 ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) )        &
    5514                                                 - ( surf%alpha_vg_green(m) * h_vg )**           &
    5515                                                 ( surf%n_vg_green(m) - 1.0_wp) )**2             &
    5516                                             ) / ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )**&
    5517                                                   surf%n_vg_green(m) )**                        &
    5518                                                   ( ( 1.0_wp  - 1.0_wp / surf%n_vg_green(m) )   &
    5519                                                     *( surf%l_vg_green(m) + 2.0_wp) )           &
     5509                   gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m)                             &
     5510                                          * ( ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )**     &
     5511                                                surf%n_vg_green(m) )**                             &
     5512                                                ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) )           &
     5513                                                - ( surf%alpha_vg_green(m) * h_vg )**              &
     5514                                                ( surf%n_vg_green(m) - 1.0_wp) )**2                &
     5515                                            ) / ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )**   &
     5516                                                  surf%n_vg_green(m) )**                           &
     5517                                                  ( ( 1.0_wp  - 1.0_wp / surf%n_vg_green(m) )      &
     5518                                                    *( surf%l_vg_green(m) + 2.0_wp) )              &
    55205519                                                )
    55215520
     
    55235522!--             Parametrization of Clapp & Hornberger
    55245523                ELSE
    5525                    gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) * ( swc_h(l)%val(kw,m)   &
     5524                   gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) * ( swc_h(l)%val(kw,m)      &
    55265525                                          / swc_sat_h(l)%val(kw,m) )**( 2.0_wp * b_ch + 3.0_wp )
    55275526                ENDIF
     
    55385537                DO  kw = nzb_wall, nzt_wall-1
    55395538
    5540                    surf%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1)                     &
    5541                                                        + lambda_green_temp(kw) )                      &
     5539                   surf%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1)                          &
     5540                                                       + lambda_green_temp(kw) )                  &
    55425541                                                     * 0.5_wp
    5543                    surf%gamma_w_green(kw,m)  = ( gamma_green_temp(kw+1)                      &
    5544                                                        + gamma_green_temp(kw) )                       &
     5542                   surf%gamma_w_green(kw,m)  = ( gamma_green_temp(kw+1)                           &
     5543                                                       + gamma_green_temp(kw) )                   &
    55455544                                                     * 0.5_wp
    55465545
     
    55885587                tend(:) = 0.0_wp
    55895588
    5590                 tend(nzb_wall) = ( surf_usm_h(l)%lambda_w_green(nzb_wall,m)                           &
    5591                                  * ( swc_h(l)%val(nzb_wall+1,m) - swc_h(l)%val(nzb_wall,m) )          &
    5592                                  * surf_usm_h(l)%ddz_green(nzb_wall+1,m)                              &
    5593                                  - surf_usm_h(l)%gamma_w_green(nzb_wall,m)                            &
    5594                                  - ( root_extr_green(nzb_wall) * surf_usm_h(l)%qsws_veg(m)            &
    5595 !                                    + surf_usm_h(l)%qsws_soil_green(m)                               &
    5596                                    ) * drho_l_lv )                                                    &
     5589                tend(nzb_wall) = ( surf_usm_h(l)%lambda_w_green(nzb_wall,m)                       &
     5590                                 * ( swc_h(l)%val(nzb_wall+1,m) - swc_h(l)%val(nzb_wall,m) )      &
     5591                                 * surf_usm_h(l)%ddz_green(nzb_wall+1,m)                          &
     5592                                 - surf_usm_h(l)%gamma_w_green(nzb_wall,m)                        &
     5593                                 - ( root_extr_green(nzb_wall) * surf_usm_h(l)%qsws_veg(m)        &
     5594!                                    + surf_usm_h(l)%qsws_soil_green(m)                           &
     5595                                   ) * drho_l_lv )                                                &
    55975596                                 * surf_usm_h(l)%ddz_green_stag(nzb_wall,m)
    55985597
    55995598                DO  kw = nzb_wall+1, nzt_wall-1
    5600                    tend(kw) = ( surf_usm_h(l)%lambda_w_green(kw,m)                                    &
    5601                                 * ( swc_h(l)%val(kw+1,m) - swc_h(l)%val(kw,m) )                       &
    5602                                 * surf_usm_h(l)%ddz_green(kw+1,m)                                     &
    5603                                 - surf_usm_h(l)%gamma_w_green(kw,m)                                   &
    5604                                 - surf_usm_h(l)%lambda_w_green(kw-1,m)                                &
    5605                                 * ( swc_h(l)%val(kw,m) - swc_h(l)%val(kw-1,m) )                       &
    5606                                 * surf_usm_h(l)%ddz_green(kw,m)                                       &
    5607                                 + surf_usm_h(l)%gamma_w_green(kw-1,m)                                 &
    5608                                 - (root_extr_green(kw)                                                &
    5609                                 * surf_usm_h(l)%qsws_veg(m)                                           &
    5610                                 * drho_l_lv)                                                          &
     5599                   tend(kw) = ( surf_usm_h(l)%lambda_w_green(kw,m)                                &
     5600                                * ( swc_h(l)%val(kw+1,m) - swc_h(l)%val(kw,m) )                   &
     5601                                * surf_usm_h(l)%ddz_green(kw+1,m)                                 &
     5602                                - surf_usm_h(l)%gamma_w_green(kw,m)                               &
     5603                                - surf_usm_h(l)%lambda_w_green(kw-1,m)                            &
     5604                                * ( swc_h(l)%val(kw,m) - swc_h(l)%val(kw-1,m) )                   &
     5605                                * surf_usm_h(l)%ddz_green(kw,m)                                   &
     5606                                + surf_usm_h(l)%gamma_w_green(kw-1,m)                             &
     5607                                - (root_extr_green(kw)                                            &
     5608                                * surf_usm_h(l)%qsws_veg(m)                                       &
     5609                                * drho_l_lv)                                                      &
    56115610                             ) * surf_usm_h(l)%ddz_green_stag(kw,m)
    56125611
    56135612                ENDDO
    5614                 tend(nzt_wall) = ( - surf_usm_h(l)%gamma_w_green(nzt_wall,m)                          &
    5615                                    - surf_usm_h(l)%lambda_w_green(nzt_wall-1,m)                       &
    5616                                    * (swc_h(l)%val(nzt_wall,m)                                        &
    5617                                    - swc_h(l)%val(nzt_wall-1,m))                                      &
    5618                                    * surf_usm_h(l)%ddz_green(nzt_wall,m)                              &
    5619                                    + surf_usm_h(l)%gamma_w_green(nzt_wall-1,m)                        &
    5620                                    - ( root_extr_green(nzt_wall)                                      &
    5621                                    * surf_usm_h(l)%qsws_veg(m)                                        &
    5622                                    * drho_l_lv  )                                                     &
     5613                tend(nzt_wall) = ( - surf_usm_h(l)%gamma_w_green(nzt_wall,m)                      &
     5614                                   - surf_usm_h(l)%lambda_w_green(nzt_wall-1,m)                   &
     5615                                   * (swc_h(l)%val(nzt_wall,m)                                    &
     5616                                   - swc_h(l)%val(nzt_wall-1,m))                                  &
     5617                                   * surf_usm_h(l)%ddz_green(nzt_wall,m)                          &
     5618                                   + surf_usm_h(l)%gamma_w_green(nzt_wall-1,m)                    &
     5619                                   - ( root_extr_green(nzt_wall)                                  &
     5620                                   * surf_usm_h(l)%qsws_veg(m)                                    &
     5621                                   * drho_l_lv  )                                                 &
    56235622                                 ) * surf_usm_h(l)%ddz_green_stag(nzt_wall,m)
    56245623
    5625                 swc_h_p(l)%val(nzb_wall:nzt_wall,m) = swc_h(l)%val(nzb_wall:nzt_wall,m) + dt_3d       &
    5626                                                * ( tsc(2) * tend(:) + tsc(3)                          &
    5627                                                    * surf_usm_h(l)%tswc_h_m(:,m)                      &
     5624                swc_h_p(l)%val(nzb_wall:nzt_wall,m) = swc_h(l)%val(nzb_wall:nzt_wall,m) + dt_3d   &
     5625                                               * ( tsc(2) * tend(:) + tsc(3)                      &
     5626                                                   * surf_usm_h(l)%tswc_h_m(:,m)                  &
    56285627                                                  )
    56295628
     
    56435642                   ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    56445643                      DO  kw = nzb_wall, nzt_wall
    5645                          surf_usm_h(l)%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp             &
     5644                         surf_usm_h(l)%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp         &
    56465645                                                     * surf_usm_h(l)%tswc_h_m(kw,m)
    56475646                      ENDDO
     
    56525651          ENDIF
    56535652       ENDDO
    5654        !$OMP END PARALLEL
    56555653    ELSE
    56565654       IF ( horizontal) THEN
     
    56655663          t_green      => t_green_v(l)
    56665664       ENDIF
    5667        !$OMP DO SCHEDULE (STATIC)
     5665       !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw) SCHEDULE (STATIC)
    56685666       DO  m = 1, surf%ns
    56695667          IF (surf%frac(m,ind_pav_green) > 0.0_wp)  THEN
     
    56845682! !--          Prognostic equation for green temperature t_green_v
    56855683!              gtend(:) = 0.0_wp
    5686 !              gtend(nzb_wall) = (1.0_wp / surf%rho_c_green(nzb_wall,m)) * &
    5687 !                                      ( surf%lambda_h_green(nzb_wall,m) * &
    5688 !                                        ( t_green%val(nzb_wall+1,m)             &
    5689 !                                        - t_green%val(nzb_wall,m) ) *           &
    5690 !                                        surf%ddz_green(nzb_wall+1,m)      &
    5691 !                                      + surf%wghf_eb(m) ) *               &
     5684!              gtend(nzb_wall) = (1.0_wp / surf%rho_c_green(nzb_wall,m)) *                        &
     5685!                                      ( surf%lambda_h_green(nzb_wall,m) *                        &
     5686!                                        ( t_green%val(nzb_wall+1,m)                              &
     5687!                                        - t_green%val(nzb_wall,m) ) *                            &
     5688!                                        surf%ddz_green(nzb_wall+1,m)                             &
     5689!                                      + surf%wghf_eb(m) ) *                                      &
    56925690!                                        surf%ddz_green_stag(nzb_wall,m)
    56935691!
    56945692!              DO  kw = nzb_wall+1, nzt_wall
    5695 !                 gtend(kw) = (1.0_wp / surf%rho_c_green(kw,m))          &
    5696 !                           * (   surf%lambda_h_green(kw,m)              &
    5697 !                             * ( t_green%val(kw+1,m) - t_green%val(kw,m) ) &
    5698 !                             * surf%ddz_green(kw+1,m)                   &
    5699 !                           - surf%lambda_h(kw-1,m)                      &
    5700 !                             * ( t_green%val(kw,m) - t_green%val(kw-1,m) ) &
    5701 !                             * surf%ddz_green(kw,m) )                   &
     5693!                 gtend(kw) = (1.0_wp / surf%rho_c_green(kw,m))                                   &
     5694!                           * (   surf%lambda_h_green(kw,m)                                       &
     5695!                             * ( t_green%val(kw+1,m) - t_green%val(kw,m) )                       &
     5696!                             * surf%ddz_green(kw+1,m)                                            &
     5697!                           - surf%lambda_h(kw-1,m)                                               &
     5698!                             * ( t_green%val(kw,m) - t_green%val(kw-1,m) )                       &
     5699!                             * surf%ddz_green(kw,m) )                                            &
    57025700!                           * surf%ddz_green_stag(kw,m)
    57035701!              ENDDO
    57045702!
    5705 !              t_green_v_p(l)%val(nzb_wall:nzt_wall,m) =                              &
    5706 !                                   t_green%val(nzb_wall:nzt_wall,m)             &
    5707 !                                 + dt_3d * ( tsc(2)                                &
    5708 !                                 * gtend(nzb_wall:nzt_wall) + tsc(3)               &
     5703!              t_green_v_p(l)%val(nzb_wall:nzt_wall,m) =                                          &
     5704!                                   t_green%val(nzb_wall:nzt_wall,m)                              &
     5705!                                 + dt_3d * ( tsc(2)                                              &
     5706!                                 * gtend(nzb_wall:nzt_wall) + tsc(3)                             &
    57095707!                                 * surf%tt_green_m(nzb_wall:nzt_wall,m) )
    57105708!
     
    57165714!                        surf%tt_green_m(kw,m) = gtend(kw)
    57175715!                     ENDDO
    5718 !                  ELSEIF ( intermediate_timestep_count <                           &
     5716!                  ELSEIF ( intermediate_timestep_count <                                         &
    57195717!                           intermediate_timestep_count_max )  THEN
    57205718!                      DO  kw = nzb_wall, nzt_wall
    5721 !                         surf%tt_green_m(kw,m) =                          &
    5722 !                                     - 9.5625_wp * gtend(kw) +                     &
     5719!                         surf%tt_green_m(kw,m) =                                                 &
     5720!                                     - 9.5625_wp * gtend(kw) +                                   &
    57235721!                                       5.3125_wp * surf%tt_green_m(kw,m)
    57245722!                      ENDDO
     
    67686766!
    67696767!-- First, treat horizontal surface elements
    6770     !$OMP PARALLEL PRIVATE (m, i, j, k, frac_win, frac_wall, frac_green, lambda_surface, ueff,    &
    6771     !$OMP&                  lambda_surface_window, lambda_surface_green, qv1, rho_cp, rho_lv,     &
    6772     !$OMP&                  drho_l_lv, f_shf, f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, &
    6773     !$OMP&                  f3, f_qsws_veg, q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1,     &
    6774     !$OMP&                  coef_window_1, coef_green_1, coef_2, coef_window_2, coef_green_2,     &
    6775     !$OMP&                  stend_wall, stend_window, stend_green, tend, m_liq_max)
    6776     !$OMP DO SCHEDULE (STATIC)
     6768    !$OMP PARALLEL DO PRIVATE (m, i, j, k, frac_win, frac_wall, frac_green, lambda_surface,       &
     6769    !$OMP&             lambda_surface_window, lambda_surface_green, ueff, qv1, rho_cp, rho_lv,    &
     6770    !$OMP&             drho_l_lv, f_shf, f_shf_window, f_shf_green, m_total, f1, f2, e_s, e,      &
     6771    !$OMP&             f3, f_qsws_veg, q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1,          &
     6772    !$OMP&             coef_window_1, coef_green_1, coef_2, coef_window_2, coef_green_2,          &
     6773    !$OMP&             stend_wall, stend_window, stend_green, tend, m_liq_max) SCHEDULE (STATIC)
    67776774    DO  m = 1, surf%ns
    67786775!
     
    72007197
    72017198    ENDDO
    7202     !$OMP END PARALLEL
    72037199
    72047200!
Note: See TracChangeset for help on using the changeset viewer.