Home


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

Changeset 4510 for palm/trunk/SOURCE


Ignore:
Timestamp:
Apr 29, 2020 2:19:18 PM (5 years ago)
Author:
raasch
Message:

files re-formatted to follow the PALM coding standard

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/tridia_solver_mod.f90

    r4360 r4510  
    11!> @file tridia_solver_mod.f90
    2 !------------------------------------------------------------------------------!
     2!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    44!
    5 ! PALM is free software: you can redistribute it and/or modify it under the
    6 ! terms of the GNU General Public License as published by the Free Software
    7 ! Foundation, either version 3 of the License, or (at your option) any later
    8 ! version.
    9 !
    10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
    11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
    12 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
    13 !
    14 ! You should have received a copy of the GNU General Public License along with
    15 ! PALM. If not, see <http://www.gnu.org/licenses/>.
     5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
     6! Public License as published by the Free Software Foundation, either version 3 of the License, or
     7! (at your option) any later version.
     8!
     9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
     10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
     11! Public License for more details.
     12!
     13! You should have received a copy of the GNU General Public License along with PALM. If not, see
     14! <http://www.gnu.org/licenses/>.
    1615!
    1716! Copyright 1997-2020 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     17!--------------------------------------------------------------------------------------------------!
     18!
    1919!
    2020! Current revisions:
    21 ! ------------------
     21! -----------------
    2222!
    2323!
    … …  
    2525! -----------------
    2626! $Id$
     27! file re-formatted to follow the PALM coding standard
     28!
     29! 4360 2020-01-07 11:25:50Z suehring
    2730! Added missing OpenMP directives
    28 ! 
     31!
    2932! 4182 2019-08-22 15:20:23Z scharf
    3033! Corrected "Former revisions" section
    31 ! 
     34!
    3235! 3761 2019-02-25 15:31:42Z raasch
    3336! OpenACC modification to prevent compiler warning about unused variable
    34 ! 
     37!
    3538! 3690 2019-01-22 22:56:42Z knoop
    3639! OpenACC port for SPEC
    … …  
    3841! 1212 2013-08-15 08:46:27Z raasch
    3942! Initial revision.
    40 ! Routines have been moved to seperate module from former file poisfft to here.
    41 ! The tridiagonal matrix coefficients of array tri are calculated only once at
    42 ! the beginning, i.e. routine split is called within tridia_init.
    43 !
    44 !
    45 ! Description:
    46 ! ------------
    47 !> solves the linear system of equations:
     43! Routines have been moved to seperate module from former file poisfft to here. The tridiagonal
     44! matrix coefficients of array tri are calculated only once at the beginning, i.e. routine split is
     45! called within tridia_init.
     46!
     47!
     48! Description:
     49! ------------
     50!> Solves the linear system of equations:
    4851!>
    49 !> -(4 pi^2(i^2/(dx^2*nnx^2)+j^2/(dy^2*nny^2))+
    50 !>   1/(dzu(k)*dzw(k))+1/(dzu(k-1)*dzw(k)))*p(i,j,k)+
     52!> -(4 pi^2(i^2/(dx^2*nnx^2)+j^2/(dy^2*nny^2))+ 1/(dzu(k)*dzw(k))+1/(dzu(k-1)*dzw(k)))*p(i,j,k)+
    5153!> 1/(dzu(k)*dzw(k))*p(i,j,k+1)+1/(dzu(k-1)*dzw(k))*p(i,j,k-1)=d(i,j,k)
    5254!>
    5355!> by using the Thomas algorithm
    54 !------------------------------------------------------------------------------!
     56!--------------------------------------------------------------------------------------------------!
    5557
    5658#define __acc_fft_device ( defined( _OPENACC ) && ( defined ( __cuda_fft ) ) )
    5759
    5860 MODULE tridia_solver
    59  
    60 
    61     USE basic_constants_and_equations_mod,                                     &
     61
     62
     63    USE basic_constants_and_equations_mod,                                                         &
    6264        ONLY:  pi
    6365
    64     USE indices,                                                               &
    65         ONLY:  nx, ny, nz
     66    USE indices,                                                                                   &
     67        ONLY:  nx,                                                                                 &
     68               ny,                                                                                 &
     69               nz
    6670
    6771    USE kinds
    6872
    69     USE transpose_indices,                                                     &
    70         ONLY:  nxl_z, nyn_z, nxr_z, nys_z
    71 
    72     IMPLICIT NONE
    73 
    74     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddzuw !<
     73    USE transpose_indices,                                                                         &
     74        ONLY:  nxl_z,                                                                              &
     75               nyn_z,                                                                              &
     76               nxr_z,                                                                              &
     77               nys_z
     78
     79    IMPLICIT NONE
     80
     81    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ddzuw  !<
    7582
    7683    PRIVATE
    … …  
    8996
    9097
    91 !------------------------------------------------------------------------------!
     98!--------------------------------------------------------------------------------------------------!
    9299! Description:
    93100! ------------
    94101!> @todo Missing subroutine description.
    95 !------------------------------------------------------------------------------!
    96     SUBROUTINE tridia_init
    97 
    98        USE arrays_3d,                                                          &
    99            ONLY:  ddzu_pres, ddzw, rho_air_zw
     102!--------------------------------------------------------------------------------------------------!
     103 SUBROUTINE tridia_init
     104
     105    USE arrays_3d,                                                                                 &
     106        ONLY:  ddzu_pres,                                                                          &
     107               ddzw,                                                                               &
     108               rho_air_zw
    100109
    101110#if defined( _OPENACC )
    102        USE arrays_3d,                                                          &
     111       USE arrays_3d,                                                                              &
    103112           ONLY:  tri
    104113#endif
    105114
    106        IMPLICIT NONE
    107 
    108        INTEGER(iwp) ::  k !<
    109 
    110        ALLOCATE( ddzuw(0:nz-1,3) )
    111 
    112        DO  k = 0, nz-1
    113           ddzuw(k,1) = ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
    114           ddzuw(k,2) = ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
    115           ddzuw(k,3) = -1.0_wp * &
    116                        ( ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1) +        &
    117                          ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k) )
    118        ENDDO
    119 !
    120 !--    Calculate constant coefficients of the tridiagonal matrix
    121        CALL maketri
    122        CALL split
    123 
    124 #if __acc_fft_device
    125        !$ACC ENTER DATA &
    126        !$ACC COPYIN(ddzuw(0:nz-1,1:3)) &
    127        !$ACC COPYIN(tri(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1,1:2))
    128 #endif
    129 
    130     END SUBROUTINE tridia_init
    131 
    132 
    133 !------------------------------------------------------------------------------!
    134 ! Description:
    135 ! ------------
    136 !> Computes the i- and j-dependent component of the matrix
    137 !> Provide the constant coefficients of the tridiagonal matrix for solution
    138 !> of the Poisson equation in Fourier space.
    139 !> The coefficients are computed following the method of
    140 !> Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
    141 !> Siano's original version by discretizing the Poisson equation,
    142 !> before it is Fourier-transformed.
    143 !------------------------------------------------------------------------------!
    144     SUBROUTINE maketri
    145 
    146 
    147           USE arrays_3d,                                                       &
    148               ONLY:  tric, rho_air
    149 
    150           USE control_parameters,                                              &
    151               ONLY:  ibc_p_b, ibc_p_t
    152 
    153           USE grid_variables,                                                  &
    154               ONLY:  dx, dy
    155 
    156 
    157           IMPLICIT NONE
    158 
    159           INTEGER(iwp) ::  i    !<
    160           INTEGER(iwp) ::  j    !<
    161           INTEGER(iwp) ::  k    !<
    162           INTEGER(iwp) ::  nnxh !<
    163           INTEGER(iwp) ::  nnyh !<
    164 
    165           REAL(wp)    ::  ll(nxl_z:nxr_z,nys_z:nyn_z) !<
    166 
    167 
    168           nnxh = ( nx + 1 ) / 2
    169           nnyh = ( ny + 1 ) / 2
    170 
    171           DO  j = nys_z, nyn_z
    172              DO  i = nxl_z, nxr_z
    173                 IF ( j >= 0  .AND.  j <= nnyh )  THEN
    174                    IF ( i >= 0  .AND.  i <= nnxh )  THEN
    175                       ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) / &
    176                                             REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
    177                                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
    178                                             REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
    179                    ELSE
    180                       ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) / &
    181                                             REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
    182                                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
    183                                             REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
    184                    ENDIF
    185                 ELSE
    186                    IF ( i >= 0  .AND.  i <= nnxh )  THEN
    187                       ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) / &
    188                                             REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
    189                                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) / &
    190                                             REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
    191                    ELSE
    192                       ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) / &
    193                                             REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
    194                                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) / &
    195                                             REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
    196                    ENDIF
    197                 ENDIF
    198              ENDDO
    199           ENDDO
    200 
    201           DO  k = 0, nz-1
    202              DO  j = nys_z, nyn_z
    203                 DO  i = nxl_z, nxr_z
    204                    tric(i,j,k) = ddzuw(k,3) - ll(i,j) * rho_air(k+1)
    205                 ENDDO
    206              ENDDO
    207           ENDDO
    208 
    209           IF ( ibc_p_b == 1 )  THEN
    210              DO  j = nys_z, nyn_z
    211                 DO  i = nxl_z, nxr_z
    212                    tric(i,j,0) = tric(i,j,0) + ddzuw(0,1)
    213                 ENDDO
    214              ENDDO
    215           ENDIF
    216           IF ( ibc_p_t == 1 )  THEN
    217              DO  j = nys_z, nyn_z
    218                 DO  i = nxl_z, nxr_z
    219                    tric(i,j,nz-1) = tric(i,j,nz-1) + ddzuw(nz-1,2)
    220                 ENDDO
    221              ENDDO
    222           ENDIF
    223 
    224     END SUBROUTINE maketri
    225 
    226 
    227 !------------------------------------------------------------------------------!
    228 ! Description:
    229 ! ------------
    230 !> Substitution (Forward and Backward) (Thomas algorithm)
    231 !------------------------------------------------------------------------------!
    232     SUBROUTINE tridia_substi( ar )
    233 
    234 
    235           USE arrays_3d,                                                       &
    236               ONLY:  tri
    237 
    238           USE control_parameters,                                              &
    239               ONLY:  ibc_p_b, ibc_p_t
    240 
    241           IMPLICIT NONE
    242 
    243           INTEGER(iwp) ::  i !<
    244           INTEGER(iwp) ::  j !<
    245           INTEGER(iwp) ::  k !<
    246 
    247           REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !<
    248 
    249           REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1)   ::  ar1 !<
    250 #if __acc_fft_device
    251           !$ACC DECLARE CREATE(ar1)
    252 #endif
    253 
    254           !$OMP PARALLEL PRIVATE(i,j,k)
    255 
    256 !
    257 !--       Forward substitution
    258 #if __acc_fft_device
    259           !$ACC PARALLEL PRESENT(ar, ar1, tri) PRIVATE(i,j,k)
    260 #endif
    261           DO  k = 0, nz - 1
    262 #if __acc_fft_device
    263              !$ACC LOOP COLLAPSE(2)
    264 #endif
    265              !$OMP DO
    266              DO  j = nys_z, nyn_z
    267                 DO  i = nxl_z, nxr_z
    268 
    269                    IF ( k == 0 )  THEN
    270                       ar1(i,j,k) = ar(i,j,k+1)
    271                    ELSE
    272                       ar1(i,j,k) = ar(i,j,k+1) - tri(i,j,k,2) * ar1(i,j,k-1)
    273                    ENDIF
    274 
    275                 ENDDO
    276              ENDDO
    277           ENDDO
    278 #if __acc_fft_device
    279           !$ACC END PARALLEL
    280 #endif
    281 
    282 !
    283 !--       Backward substitution
    284 !--       Note, the 1.0E-20 in the denominator is due to avoid divisions
    285 !--       by zero appearing if the pressure bc is set to neumann at the top of
    286 !--       the model domain.
    287 #if __acc_fft_device
    288           !$ACC PARALLEL PRESENT(ar, ar1, ddzuw, tri) PRIVATE(i,j,k)
    289 #endif
    290           DO  k = nz-1, 0, -1
    291 #if __acc_fft_device
    292              !$ACC LOOP COLLAPSE(2)
    293 #endif
    294              !$OMP DO
    295              DO  j = nys_z, nyn_z
    296                 DO  i = nxl_z, nxr_z
    297 
    298                    IF ( k == nz-1 )  THEN
    299                       ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,j,k,1) + 1.0E-20_wp )
    300                    ELSE
    301                       ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) &
    302                               / tri(i,j,k,1)
    303                    ENDIF
    304                 ENDDO
    305              ENDDO
    306           ENDDO
    307 #if __acc_fft_device
    308           !$ACC END PARALLEL
    309 #endif
    310 
    311           !$OMP END PARALLEL
    312 
    313 !
    314 !--       Indices i=0, j=0 correspond to horizontally averaged pressure.
    315 !--       The respective values of ar should be zero at all k-levels if
    316 !--       acceleration of horizontally averaged vertical velocity is zero.
    317           IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
    318              IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
    319 #if __acc_fft_device
    320                 !$ACC PARALLEL LOOP PRESENT(ar)
    321 #endif
    322                 DO  k = 1, nz
    323                    ar(nxl_z,nys_z,k) = 0.0_wp
    324                 ENDDO
     115    IMPLICIT NONE
     116
     117    INTEGER(iwp) ::  k  !<
     118
     119    ALLOCATE( ddzuw(0:nz-1,3) )
     120
     121    DO  k = 0, nz-1
     122       ddzuw(k,1) = ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
     123       ddzuw(k,2) = ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
     124       ddzuw(k,3) = -1.0_wp * ( ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1) +                     &
     125                                ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k) )
     126    ENDDO
     127!
     128!-- Calculate constant coefficients of the tridiagonal matrix
     129    CALL maketri
     130    CALL split
     131
     132#if __acc_fft_device
     133    !$ACC ENTER DATA &
     134    !$ACC COPYIN(ddzuw(0:nz-1,1:3)) &
     135    !$ACC COPYIN(tri(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1,1:2))
     136#endif
     137
     138 END SUBROUTINE tridia_init
     139
     140
     141!--------------------------------------------------------------------------------------------------!
     142! Description:
     143! ------------
     144!> Computes the i- and j-dependent component of the matrix.
     145!> Provide the constant coefficients of the tridiagonal matrix for solution of the Poisson equation
     146!> in Fourier space. The coefficients are computed following the method of Schmidt et al.
     147!> (DFVLR-Mitteilung 84-15), which departs from Stephan Siano's original version by discretizing the
     148!> Poisson equation, before it is Fourier-transformed.
     149!--------------------------------------------------------------------------------------------------!
     150 SUBROUTINE maketri
     151
     152
     153    USE arrays_3d,                                                                                 &
     154        ONLY:  tric,                                                                               &
     155               rho_air
     156
     157    USE control_parameters,                                                                        &
     158        ONLY:  ibc_p_b,                                                                            &
     159               ibc_p_t
     160
     161    USE grid_variables,                                                                            &
     162        ONLY:  dx,                                                                                 &
     163               dy
     164
     165
     166    IMPLICIT NONE
     167
     168    INTEGER(iwp) ::  i     !<
     169    INTEGER(iwp) ::  j     !<
     170    INTEGER(iwp) ::  k     !<
     171    INTEGER(iwp) ::  nnxh  !<
     172    INTEGER(iwp) ::  nnyh  !<
     173
     174    REAL(wp)    ::  ll(nxl_z:nxr_z,nys_z:nyn_z)  !<
     175
     176
     177    nnxh = ( nx + 1 ) / 2
     178    nnyh = ( ny + 1 ) / 2
     179
     180    DO  j = nys_z, nyn_z
     181       DO  i = nxl_z, nxr_z
     182          IF ( j >= 0  .AND.  j <= nnyh )  THEN
     183             IF ( i >= 0  .AND.  i <= nnxh )  THEN
     184                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) /                           &
     185                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
     186                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                           &
     187                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
     188             ELSE
     189                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) /                  &
     190                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
     191                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                           &
     192                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
     193             ENDIF
     194          ELSE
     195             IF ( i >= 0  .AND.  i <= nnxh )  THEN
     196                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) /                           &
     197                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
     198                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) /                  &
     199                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
     200             ELSE
     201                ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) /                  &
     202                                     REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) +                     &
     203                          2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) /                  &
     204                                     REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
    325205             ENDIF
    326206          ENDIF
    327 
    328     END SUBROUTINE tridia_substi
    329 
    330 
    331 !------------------------------------------------------------------------------!
    332 ! Description:
    333 ! ------------
    334 !> Substitution (Forward and Backward) (Thomas algorithm)
    335 !------------------------------------------------------------------------------!
    336     SUBROUTINE tridia_substi_overlap( ar, jj )
    337 
    338 
    339           USE arrays_3d,                                                       &
    340               ONLY:  tri
    341 
    342           USE control_parameters,                                              &
    343               ONLY:  ibc_p_b, ibc_p_t
    344 
    345           IMPLICIT NONE
    346 
    347           INTEGER(iwp) ::  i  !<
    348           INTEGER(iwp) ::  j  !<
    349           INTEGER(iwp) ::  jj !<
    350           INTEGER(iwp) ::  k  !<
    351 
    352           REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !<
    353 
    354           REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) ::  ar1 !<
    355 
    356 !
    357 !--       Forward substitution
    358           DO  k = 0, nz - 1
    359              DO  j = nys_z, nyn_z
    360                 DO  i = nxl_z, nxr_z
    361 
    362                    IF ( k == 0 )  THEN
    363                       ar1(i,j,k) = ar(i,j,k+1)
    364                    ELSE
    365                       ar1(i,j,k) = ar(i,j,k+1) - tri(i,jj,k,2) * ar1(i,j,k-1)
    366                    ENDIF
    367 
    368                 ENDDO
    369              ENDDO
    370           ENDDO
    371 
    372 !
    373 !--       Backward substitution
    374 !--       Note, the 1.0E-20 in the denominator is due to avoid divisions
    375 !--       by zero appearing if the pressure bc is set to neumann at the top of
    376 !--       the model domain.
    377           DO  k = nz-1, 0, -1
    378              DO  j = nys_z, nyn_z
    379                 DO  i = nxl_z, nxr_z
    380 
    381                    IF ( k == nz-1 )  THEN
    382                       ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,jj,k,1) + 1.0E-20_wp )
    383                    ELSE
    384                       ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) &
    385                               / tri(i,jj,k,1)
    386                    ENDIF
    387                 ENDDO
    388              ENDDO
    389           ENDDO
    390 
    391 !
    392 !--       Indices i=0, j=0 correspond to horizontally averaged pressure.
    393 !--       The respective values of ar should be zero at all k-levels if
    394 !--       acceleration of horizontally averaged vertical velocity is zero.
    395           IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
    396              IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
    397                 DO  k = 1, nz
    398                    ar(nxl_z,nys_z,k) = 0.0_wp
    399                 ENDDO
     207       ENDDO
     208    ENDDO
     209
     210    DO  k = 0, nz-1
     211       DO  j = nys_z, nyn_z
     212          DO  i = nxl_z, nxr_z
     213             tric(i,j,k) = ddzuw(k,3) - ll(i,j) * rho_air(k+1)
     214          ENDDO
     215       ENDDO
     216    ENDDO
     217
     218    IF ( ibc_p_b == 1 )  THEN
     219       DO  j = nys_z, nyn_z
     220          DO  i = nxl_z, nxr_z
     221             tric(i,j,0) = tric(i,j,0) + ddzuw(0,1)
     222          ENDDO
     223       ENDDO
     224    ENDIF
     225    IF ( ibc_p_t == 1 )  THEN
     226       DO  j = nys_z, nyn_z
     227          DO  i = nxl_z, nxr_z
     228             tric(i,j,nz-1) = tric(i,j,nz-1) + ddzuw(nz-1,2)
     229          ENDDO
     230       ENDDO
     231    ENDIF
     232
     233 END SUBROUTINE maketri
     234
     235
     236!--------------------------------------------------------------------------------------------------!
     237! Description:
     238! ------------
     239!> Substitution (Forward and Backward) (Thomas algorithm).
     240!--------------------------------------------------------------------------------------------------!
     241 SUBROUTINE tridia_substi( ar )
     242
     243
     244    USE arrays_3d,                                                                                 &
     245        ONLY:  tri
     246
     247    USE control_parameters,                                                                        &
     248        ONLY:  ibc_p_b,                                                                            &
     249               ibc_p_t
     250
     251    IMPLICIT NONE
     252
     253    INTEGER(iwp) ::  i !<
     254    INTEGER(iwp) ::  j !<
     255    INTEGER(iwp) ::  k !<
     256
     257    REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
     258
     259    REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) ::  ar1  !<
     260#if __acc_fft_device
     261    !$ACC DECLARE CREATE(ar1)
     262#endif
     263
     264    !$OMP PARALLEL PRIVATE(i,j,k)
     265
     266!
     267!-- Forward substitution
     268#if __acc_fft_device
     269    !$ACC PARALLEL PRESENT(ar, ar1, tri) PRIVATE(i,j,k)
     270#endif
     271    DO  k = 0, nz - 1
     272#if __acc_fft_device
     273       !$ACC LOOP COLLAPSE(2)
     274#endif
     275       !$OMP DO
     276       DO  j = nys_z, nyn_z
     277          DO  i = nxl_z, nxr_z
     278
     279             IF ( k == 0 )  THEN
     280                ar1(i,j,k) = ar(i,j,k+1)
     281             ELSE
     282                ar1(i,j,k) = ar(i,j,k+1) - tri(i,j,k,2) * ar1(i,j,k-1)
    400283             ENDIF
    401           ENDIF
    402 
    403     END SUBROUTINE tridia_substi_overlap
    404 
    405 
    406 !------------------------------------------------------------------------------!
    407 ! Description:
    408 ! ------------
    409 !> Splitting of the tridiagonal matrix (Thomas algorithm)
    410 !------------------------------------------------------------------------------!
    411     SUBROUTINE split
    412 
    413 
    414           USE arrays_3d,                                                       &
    415               ONLY:  tri, tric
    416 
    417           IMPLICIT NONE
    418 
    419           INTEGER(iwp) ::  i !<
    420           INTEGER(iwp) ::  j !<
    421           INTEGER(iwp) ::  k !<
    422 !
    423 !--       Splitting
    424           DO  j = nys_z, nyn_z
    425              DO  i = nxl_z, nxr_z
    426                 tri(i,j,0,1) = tric(i,j,0)
    427              ENDDO
    428           ENDDO
    429 
    430           DO  k = 1, nz-1
    431              DO  j = nys_z, nyn_z
    432                 DO  i = nxl_z, nxr_z
    433                    tri(i,j,k,2) = ddzuw(k,1) / tri(i,j,k-1,1)
    434                    tri(i,j,k,1) = tric(i,j,k) - ddzuw(k-1,2) * tri(i,j,k,2)
    435                 ENDDO
    436              ENDDO
    437           ENDDO
    438 
    439     END SUBROUTINE split
    440 
    441 
    442 !------------------------------------------------------------------------------!
    443 ! Description:
    444 ! ------------
    445 !> Solves the linear system of equations for a 1d-decomposition along x (see
    446 !> tridia)
     284
     285          ENDDO
     286       ENDDO
     287    ENDDO
     288#if __acc_fft_device
     289    !$ACC END PARALLEL
     290#endif
     291
     292!
     293!-- Backward substitution
     294!-- Note, the 1.0E-20 in the denominator is due to avoid divisions by zero appearing if the
     295!-- pressure bc is set to neumann at the top of the model domain.
     296#if __acc_fft_device
     297    !$ACC PARALLEL PRESENT(ar, ar1, ddzuw, tri) PRIVATE(i,j,k)
     298#endif
     299    DO  k = nz-1, 0, -1
     300#if __acc_fft_device
     301       !$ACC LOOP COLLAPSE(2)
     302#endif
     303       !$OMP DO
     304       DO  j = nys_z, nyn_z
     305          DO  i = nxl_z, nxr_z
     306
     307             IF ( k == nz-1 )  THEN
     308                ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,j,k,1) + 1.0E-20_wp )
     309             ELSE
     310                ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) / tri(i,j,k,1)
     311             ENDIF
     312          ENDDO
     313       ENDDO
     314    ENDDO
     315#if __acc_fft_device
     316    !$ACC END PARALLEL
     317#endif
     318
     319    !$OMP END PARALLEL
     320
     321!
     322!-- Indices i=0, j=0 correspond to horizontally averaged pressure. The respective values of ar
     323!-- should be zero at all k-levels if acceleration of horizontally averaged vertical velocity
     324!-- is zero.
     325    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
     326       IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
     327#if __acc_fft_device
     328             !$ACC PARALLEL LOOP PRESENT(ar)
     329#endif
     330          DO  k = 1, nz
     331             ar(nxl_z,nys_z,k) = 0.0_wp
     332          ENDDO
     333       ENDIF
     334    ENDIF
     335
     336 END SUBROUTINE tridia_substi
     337
     338
     339!--------------------------------------------------------------------------------------------------!
     340! Description:
     341! ------------
     342!> Substitution (Forward and Backward) (Thomas algorithm).
     343!--------------------------------------------------------------------------------------------------!
     344 SUBROUTINE tridia_substi_overlap( ar, jj )
     345
     346
     347    USE arrays_3d,                                                                                 &
     348        ONLY:  tri
     349
     350    USE control_parameters,                                                                        &
     351        ONLY:  ibc_p_b,                                                                            &
     352               ibc_p_t
     353
     354    IMPLICIT NONE
     355
     356    INTEGER(iwp) ::  i  !<
     357    INTEGER(iwp) ::  j  !<
     358    INTEGER(iwp) ::  jj !<
     359    INTEGER(iwp) ::  k  !<
     360
     361    REAL(wp)     ::  ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
     362
     363    REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) ::  ar1  !<
     364
     365!
     366!-- Forward substitution
     367    DO  k = 0, nz - 1
     368       DO  j = nys_z, nyn_z
     369          DO  i = nxl_z, nxr_z
     370
     371             IF ( k == 0 )  THEN
     372                ar1(i,j,k) = ar(i,j,k+1)
     373             ELSE
     374                ar1(i,j,k) = ar(i,j,k+1) - tri(i,jj,k,2) * ar1(i,j,k-1)
     375             ENDIF
     376
     377          ENDDO
     378       ENDDO
     379    ENDDO
     380
     381!
     382!-- Backward substitution
     383!-- Note, the 1.0E-20 in the denominator is due to avoid divisions by zero appearing if the
     384!-- pressure bc is set to neumann at the top of the model domain.
     385    DO  k = nz-1, 0, -1
     386       DO  j = nys_z, nyn_z
     387          DO  i = nxl_z, nxr_z
     388
     389             IF ( k == nz-1 )  THEN
     390                ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,jj,k,1) + 1.0E-20_wp )
     391             ELSE
     392                ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) / tri(i,jj,k,1)
     393             ENDIF
     394          ENDDO
     395       ENDDO
     396    ENDDO
     397
     398!
     399!-- Indices i=0, j=0 correspond to horizontally averaged pressure. The respective values of ar
     400!-- should be zero at all k-levels if acceleration of horizontally averaged vertical velocity
     401!-- is zero.
     402    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
     403       IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
     404          DO  k = 1, nz
     405             ar(nxl_z,nys_z,k) = 0.0_wp
     406          ENDDO
     407       ENDIF
     408    ENDIF
     409
     410 END SUBROUTINE tridia_substi_overlap
     411
     412
     413!--------------------------------------------------------------------------------------------------!
     414! Description:
     415! ------------
     416!> Splitting of the tridiagonal matrix (Thomas algorithm).
     417!--------------------------------------------------------------------------------------------------!
     418 SUBROUTINE split
     419
     420
     421    USE arrays_3d,                                                                                 &
     422        ONLY:  tri,                                                                                &
     423               tric
     424
     425    IMPLICIT NONE
     426
     427    INTEGER(iwp) ::  i  !<
     428    INTEGER(iwp) ::  j  !<
     429    INTEGER(iwp) ::  k  !<
     430!
     431!   Splitting
     432    DO  j = nys_z, nyn_z
     433       DO  i = nxl_z, nxr_z
     434          tri(i,j,0,1) = tric(i,j,0)
     435       ENDDO
     436    ENDDO
     437
     438    DO  k = 1, nz-1
     439       DO  j = nys_z, nyn_z
     440          DO  i = nxl_z, nxr_z
     441             tri(i,j,k,2) = ddzuw(k,1) / tri(i,j,k-1,1)
     442             tri(i,j,k,1) = tric(i,j,k) - ddzuw(k-1,2) * tri(i,j,k,2)
     443          ENDDO
     444       ENDDO
     445    ENDDO
     446
     447 END SUBROUTINE split
     448
     449
     450!--------------------------------------------------------------------------------------------------!
     451! Description:
     452! ------------
     453!> Solves the linear system of equations for a 1d-decomposition along x (see tridia).
    447454!>
    448 !> @attention when using the intel compilers older than 12.0, array tri must
    449 !>            be passed as an argument to the contained subroutines. Otherwise
    450 !>            addres faults will occur. This feature can be activated with
    451 !>            cpp-switch __intel11
    452 !>            On NEC, tri should not be passed (except for routine substi_1dd)
    453 !>            because this causes very bad performance.
    454 !------------------------------------------------------------------------------!
    455  
    456     SUBROUTINE tridia_1dd( ddx2, ddy2, nx, ny, j, ar, tri_for_1d )
    457 
    458 
    459        USE arrays_3d,                                                          &
    460            ONLY:  ddzu_pres, ddzw, rho_air, rho_air_zw
    461 
    462        USE control_parameters,                                                 &
    463            ONLY:  ibc_p_b, ibc_p_t
    464 
    465        IMPLICIT NONE
    466 
    467        INTEGER(iwp) ::  i                  !<
    468        INTEGER(iwp) ::  j                  !<
    469        INTEGER(iwp) ::  k                  !<
    470        INTEGER(iwp) ::  nnyh               !<
    471        INTEGER(iwp) ::  nx                 !<
    472        INTEGER(iwp) ::  ny                 !<
    473 
    474        REAL(wp)     ::  ddx2 !<
    475        REAL(wp)     ::  ddy2 !<
    476 
    477        REAL(wp), DIMENSION(0:nx,1:nz)     ::  ar         !<
    478        REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d !<
    479 
    480 
    481        nnyh = ( ny + 1 ) / 2
    482 
    483 !
    484 !--    Define constant elements of the tridiagonal matrix.
    485 !--    The compiler on SX6 does loop exchange. If 0:nx is a high power of 2,
    486 !--    the exchanged loops create bank conflicts. The following directive
    487 !--    prohibits loop exchange and the loops perform much better.
     455!> @attention When using intel compilers older than 12.0, array tri must be passed as an argument to
     456!>            the contained subroutines. Otherwise address faults will occur. This feature can be
     457!>            activated with cpp-switch __intel11. On NEC, tri should not be passed
     458!>            (except for routine substi_1dd) because this causes very bad performance.
     459!--------------------------------------------------------------------------------------------------!
     460
     461 SUBROUTINE tridia_1dd( ddx2, ddy2, nx, ny, j, ar, tri_for_1d )
     462
     463
     464    USE arrays_3d,                                                                                 &
     465        ONLY:  ddzu_pres,                                                                          &
     466               ddzw,                                                                               &
     467               rho_air,                                                                            &
     468               rho_air_zw
     469
     470    USE control_parameters,                                                                        &
     471        ONLY:  ibc_p_b,                                                                            &
     472               ibc_p_t
     473
     474    IMPLICIT NONE
     475
     476    INTEGER(iwp) ::  i     !<
     477    INTEGER(iwp) ::  j     !<
     478    INTEGER(iwp) ::  k     !<
     479    INTEGER(iwp) ::  nnyh  !<
     480    INTEGER(iwp) ::  nx    !<
     481    INTEGER(iwp) ::  ny    !<
     482
     483    REAL(wp)     ::  ddx2  !<
     484    REAL(wp)     ::  ddy2  !<
     485
     486    REAL(wp), DIMENSION(0:nx,1:nz)     ::  ar          !<
     487    REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d  !<
     488
     489
     490    nnyh = ( ny + 1 ) / 2
     491
     492!
     493!-- Define constant elements of the tridiagonal matrix. The compiler on SX6 does loop exchange.
     494!-- If 0:nx is a high power of 2, the exchanged loops create bank conflicts. The following directive
     495!-- prohibits loop exchange and the loops perform much better.
    488496!CDIR NOLOOPCHG
    489        DO  k = 0, nz-1
    490           DO  i = 0,nx
    491              tri_for_1d(2,i,k) = ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
    492              tri_for_1d(3,i,k) = ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
    493           ENDDO
    494        ENDDO
    495 
    496        IF ( j <= nnyh )  THEN
    497           CALL maketri_1dd( j )
     497    DO  k = 0, nz-1
     498       DO  i = 0,nx
     499          tri_for_1d(2,i,k) = ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
     500          tri_for_1d(3,i,k) = ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
     501       ENDDO
     502    ENDDO
     503
     504    IF ( j <= nnyh )  THEN
     505       CALL maketri_1dd( j )
     506    ELSE
     507       CALL maketri_1dd( ny+1-j )
     508    ENDIF
     509
     510    CALL split_1dd
     511    CALL substi_1dd( ar, tri_for_1d )
     512
     513 CONTAINS
     514
     515
     516!--------------------------------------------------------------------------------------------------!
     517! Description:
     518! ------------
     519!> Computes the i- and j-dependent component of the matrix.
     520!--------------------------------------------------------------------------------------------------!
     521 SUBROUTINE maketri_1dd( j )
     522
     523    IMPLICIT NONE
     524
     525    INTEGER(iwp) ::  i    !<
     526    INTEGER(iwp) ::  j    !<
     527    INTEGER(iwp) ::  k    !<
     528    INTEGER(iwp) ::  nnxh !<
     529
     530    REAL(wp)     ::  a !<
     531    REAL(wp)     ::  c !<
     532
     533    REAL(wp), DIMENSION(0:nx) ::  l !<
     534
     535
     536    nnxh = ( nx + 1 ) / 2
     537!
     538!-- Provide the tridiagonal matrix for solution of the Poisson equation in Fourier space.
     539!-- The coefficients are computed following the method of Schmidt et al. (DFVLR-Mitteilung 84-15),
     540!-- which departs from Stephan Siano's original version by discretizing the Poisson equation,
     541!-- before it is Fourier-transformed.
     542    DO  i = 0, nx
     543       IF ( i >= 0 .AND. i <= nnxh ) THEN
     544          l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) /                                    &
     545                            REAL( nx+1, KIND=wp ) ) ) * ddx2 +                                     &
     546                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                                    &
     547                            REAL( ny+1, KIND=wp ) ) ) * ddy2
    498548       ELSE
    499           CALL maketri_1dd( ny+1-j )
     549          l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) /                           &
     550                            REAL( nx+1, KIND=wp ) ) ) * ddx2 +                                     &
     551                 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) /                                    &
     552                            REAL( ny+1, KIND=wp ) ) ) * ddy2
    500553       ENDIF
    501 
    502        CALL split_1dd
    503        CALL substi_1dd( ar, tri_for_1d )
    504 
    505     CONTAINS
    506 
    507 
    508 !------------------------------------------------------------------------------!
    509 ! Description:
    510 ! ------------
    511 !> computes the i- and j-dependent component of the matrix
    512 !------------------------------------------------------------------------------!
    513        SUBROUTINE maketri_1dd( j )
    514 
    515           IMPLICIT NONE
    516 
    517           INTEGER(iwp) ::  i    !<
    518           INTEGER(iwp) ::  j    !<
    519           INTEGER(iwp) ::  k    !<
    520           INTEGER(iwp) ::  nnxh !<
    521 
    522           REAL(wp)     ::  a !<
    523           REAL(wp)     ::  c !<
    524 
    525           REAL(wp), DIMENSION(0:nx) ::  l !<
    526 
    527 
    528           nnxh = ( nx + 1 ) / 2
    529 !
    530 !--       Provide the tridiagonal matrix for solution of the Poisson equation in
    531 !--       Fourier space. The coefficients are computed following the method of
    532 !--       Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
    533 !--       Siano's original version by discretizing the Poisson equation,
    534 !--       before it is Fourier-transformed
    535           DO  i = 0, nx
    536              IF ( i >= 0 .AND. i <= nnxh ) THEN
    537                 l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) / &
    538                                    REAL( nx+1, KIND=wp ) ) ) * ddx2 + &
    539                        2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
    540                                    REAL( ny+1, KIND=wp ) ) ) * ddy2
    541              ELSE
    542                 l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) / &
    543                                    REAL( nx+1, KIND=wp ) ) ) * ddx2 + &
    544                        2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
    545                                    REAL( ny+1, KIND=wp ) ) ) * ddy2
    546              ENDIF
    547           ENDDO
    548 
    549           DO  k = 0, nz-1
    550              DO  i = 0, nx
    551                 a = -1.0_wp * ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
    552                 c = -1.0_wp * ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
    553                 tri_for_1d(1,i,k) = a + c - l(i) * rho_air(k+1)
    554              ENDDO
    555           ENDDO
    556           IF ( ibc_p_b == 1 )  THEN
    557              DO  i = 0, nx
    558                 tri_for_1d(1,i,0) = tri_for_1d(1,i,0) + tri_for_1d(2,i,0)
    559              ENDDO
    560           ENDIF
    561           IF ( ibc_p_t == 1 )  THEN
    562              DO  i = 0, nx
    563                 tri_for_1d(1,i,nz-1) = tri_for_1d(1,i,nz-1) + tri_for_1d(3,i,nz-1)
    564              ENDDO
    565           ENDIF
    566 
    567        END SUBROUTINE maketri_1dd
    568 
    569 
    570 !------------------------------------------------------------------------------!
    571 ! Description:
    572 ! ------------
    573 !> Splitting of the tridiagonal matrix (Thomas algorithm)
    574 !------------------------------------------------------------------------------!
    575        SUBROUTINE split_1dd
    576 
    577           IMPLICIT NONE
    578 
    579           INTEGER(iwp) ::  i !<
    580           INTEGER(iwp) ::  k !<
    581 
    582 
    583 !
    584 !--       Splitting
    585           DO  i = 0, nx
    586              tri_for_1d(4,i,0) = tri_for_1d(1,i,0)
    587           ENDDO
    588           DO  k = 1, nz-1
    589              DO  i = 0, nx
    590                 tri_for_1d(5,i,k) = tri_for_1d(2,i,k) / tri_for_1d(4,i,k-1)
    591                 tri_for_1d(4,i,k) = tri_for_1d(1,i,k) - tri_for_1d(3,i,k-1) * tri_for_1d(5,i,k)
    592              ENDDO
    593           ENDDO
    594 
    595        END SUBROUTINE split_1dd
    596 
    597 
    598 !------------------------------------------------------------------------------!
    599 ! Description:
    600 ! ------------
    601 !> Substitution (Forward and Backward) (Thomas algorithm)
    602 !------------------------------------------------------------------------------!
    603        SUBROUTINE substi_1dd( ar, tri_for_1d )
    604 
    605 
    606           IMPLICIT NONE
    607 
    608           INTEGER(iwp) ::  i !<
    609           INTEGER(iwp) ::  k !<
    610 
    611           REAL(wp), DIMENSION(0:nx,nz)       ::  ar         !<
    612           REAL(wp), DIMENSION(0:nx,0:nz-1)   ::  ar1        !<
    613           REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d !<
    614 
    615 !
    616 !--       Forward substitution
    617           DO  i = 0, nx
    618              ar1(i,0) = ar(i,1)
    619           ENDDO
    620           DO  k = 1, nz-1
    621              DO  i = 0, nx
    622                 ar1(i,k) = ar(i,k+1) - tri_for_1d(5,i,k) * ar1(i,k-1)
    623              ENDDO
    624           ENDDO
    625 
    626 !
    627 !--       Backward substitution
    628 !--       Note, the add of 1.0E-20 in the denominator is due to avoid divisions
    629 !--       by zero appearing if the pressure bc is set to neumann at the top of
    630 !--       the model domain.
    631           DO  i = 0, nx
    632              ar(i,nz) = ar1(i,nz-1) / ( tri_for_1d(4,i,nz-1) + 1.0E-20_wp )
    633           ENDDO
    634           DO  k = nz-2, 0, -1
    635              DO  i = 0, nx
    636                 ar(i,k+1) = ( ar1(i,k) - tri_for_1d(3,i,k) * ar(i,k+2) ) &
    637                             / tri_for_1d(4,i,k)
    638              ENDDO
    639           ENDDO
    640 
    641 !
    642 !--       Indices i=0, j=0 correspond to horizontally averaged pressure.
    643 !--       The respective values of ar should be zero at all k-levels if
    644 !--       acceleration of horizontally averaged vertical velocity is zero.
    645           IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
    646              IF ( j == 0 )  THEN
    647                 DO  k = 1, nz
    648                    ar(0,k) = 0.0_wp
    649                 ENDDO
    650              ENDIF
    651           ENDIF
    652 
    653        END SUBROUTINE substi_1dd
    654 
    655     END SUBROUTINE tridia_1dd
     554    ENDDO
     555
     556    DO  k = 0, nz-1
     557       DO  i = 0, nx
     558          a = -1.0_wp * ddzu_pres(k+2) * ddzw(k+1) * rho_air_zw(k+1)
     559          c = -1.0_wp * ddzu_pres(k+1) * ddzw(k+1) * rho_air_zw(k)
     560          tri_for_1d(1,i,k) = a + c - l(i) * rho_air(k+1)
     561       ENDDO
     562    ENDDO
     563    IF ( ibc_p_b == 1 )  THEN
     564       DO  i = 0, nx
     565          tri_for_1d(1,i,0) = tri_for_1d(1,i,0) + tri_for_1d(2,i,0)
     566       ENDDO
     567    ENDIF
     568    IF ( ibc_p_t == 1 )  THEN
     569       DO  i = 0, nx
     570          tri_for_1d(1,i,nz-1) = tri_for_1d(1,i,nz-1) + tri_for_1d(3,i,nz-1)
     571       ENDDO
     572    ENDIF
     573
     574 END SUBROUTINE maketri_1dd
     575
     576
     577!--------------------------------------------------------------------------------------------------!
     578! Description:
     579! ------------
     580!> Splitting of the tridiagonal matrix (Thomas algorithm).
     581!--------------------------------------------------------------------------------------------------!
     582 SUBROUTINE split_1dd
     583
     584    IMPLICIT NONE
     585
     586    INTEGER(iwp) ::  i  !<
     587    INTEGER(iwp) ::  k  !<
     588
     589
     590!
     591!-- Splitting
     592    DO  i = 0, nx
     593       tri_for_1d(4,i,0) = tri_for_1d(1,i,0)
     594    ENDDO
     595    DO  k = 1, nz-1
     596       DO  i = 0, nx
     597          tri_for_1d(5,i,k) = tri_for_1d(2,i,k) / tri_for_1d(4,i,k-1)
     598          tri_for_1d(4,i,k) = tri_for_1d(1,i,k) - tri_for_1d(3,i,k-1) * tri_for_1d(5,i,k)
     599       ENDDO
     600    ENDDO
     601
     602 END SUBROUTINE split_1dd
     603
     604
     605!--------------------------------------------------------------------------------------------------!
     606! Description:
     607! ------------
     608!> Substitution (Forward and Backward) (Thomas algorithm).
     609!--------------------------------------------------------------------------------------------------!
     610 SUBROUTINE substi_1dd( ar, tri_for_1d )
     611
     612
     613    IMPLICIT NONE
     614
     615    INTEGER(iwp) ::  i  !<
     616    INTEGER(iwp) ::  k  !<
     617
     618    REAL(wp), DIMENSION(0:nx,nz)       ::  ar          !<
     619    REAL(wp), DIMENSION(0:nx,0:nz-1)   ::  ar1         !<
     620    REAL(wp), DIMENSION(5,0:nx,0:nz-1) ::  tri_for_1d  !<
     621
     622!
     623!-- Forward substitution
     624    DO  i = 0, nx
     625       ar1(i,0) = ar(i,1)
     626    ENDDO
     627    DO  k = 1, nz-1
     628       DO  i = 0, nx
     629          ar1(i,k) = ar(i,k+1) - tri_for_1d(5,i,k) * ar1(i,k-1)
     630       ENDDO
     631    ENDDO
     632
     633!
     634!-- Backward substitution
     635!-- Note, the add of 1.0E-20 in the denominator is due to avoid divisions by zero appearing if the
     636!-- pressure bc is set to neumann at the top of the model domain.
     637    DO  i = 0, nx
     638       ar(i,nz) = ar1(i,nz-1) / ( tri_for_1d(4,i,nz-1) + 1.0E-20_wp )
     639    ENDDO
     640    DO  k = nz-2, 0, -1
     641       DO  i = 0, nx
     642          ar(i,k+1) = ( ar1(i,k) - tri_for_1d(3,i,k) * ar(i,k+2) ) / tri_for_1d(4,i,k)
     643       ENDDO
     644    ENDDO
     645
     646!
     647!-- Indices i=0, j=0 correspond to horizontally averaged pressure. The respective values of ar
     648!-- should be zero at all k-levels if acceleration of horizontally averaged vertical velocity is
     649!-- zero.
     650    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
     651       IF ( j == 0 )  THEN
     652          DO  k = 1, nz
     653             ar(0,k) = 0.0_wp
     654          ENDDO
     655       ENDIF
     656    ENDIF
     657
     658 END SUBROUTINE substi_1dd
     659
     660 END SUBROUTINE tridia_1dd
    656661
    657662

  • palm/trunk/SOURCE/turbulence_closure_mod.f90

    r4495 r4510  
    11!> @file turbulence_closure_mod.f90
    2 !------------------------------------------------------------------------------!
     2!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    44!
    5 ! PALM is free software: you can redistribute it and/or modify it under the
    6 ! terms of the GNU General Public License as published by the Free Software
    7 ! Foundation, either version 3 of the License, or (at your option) any later
    8 ! version.
    9 !
    10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
    11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
    12 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
    13 !
    14 ! You should have received a copy of the GNU General Public License along with
    15 ! PALM. If not, see <http://www.gnu.org/licenses/>.
    16 !
    17 ! Copyright 2017-2020 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
     6! Public License as published by the Free Software Foundation, either version 3 of the License, or
     7! (at your option) any later version.
     8!
     9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
     10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
     11! Public License for more details.
     12!
     13! You should have received a copy of the GNU General Public License along with PALM. If not, see
     14! <http://www.gnu.org/licenses/>.
     15!
     16! Copyright 1997-2020 Leibniz Universitaet Hannover
     17!--------------------------------------------------------------------------------------------------!
     18!
    1919!
    2020! Current revisions:
    … …  
    2525! -----------------
    2626! $Id$
     27! file re-formatted to follow the PALM coding standard
     28!
     29! 4495 2020-04-13 20:11:20Z raasch
    2730! workaround for Intel14 compiler added
    28 ! 
     31!
    2932! 4486 2020-04-02 20:45:12Z maronga
    30 ! Bugfix: include topography in calculation of distance_to_wall (1.5-order-dai
    31 ! closure)
    32 !
     33! Bugfix: include topography in calculation of distance_to_wall (1.5-order-dai closure)
     34!
    3335! 4481 2020-03-31 18:55:54Z maronga
    34 ! - added new LES closure after Dai et al. (2020), which provides much better grid
    35 !   convergence in stable boundary layer runs. The implementation is experimental
    36 !   at the moment and should be used with special care. The new SGS closure can be
    37 !   switched on via turbulence_closure = '1.5-order-dai'
    38 ! - variable ml_wall_adjusted renamed to delta as it represents a grid size and
    39 !   not a mixing length (see Equations 14 and 18 in Maronga et al. 2015, GMD)
     36! - added new LES closure after Dai et al. (2020), which provides much better grid convergence in
     37!   stable boundary layer runs. The implementation is experimental at the moment and should be used
     38!   with special care. The new SGS closure can be switched on via
     39!   turbulence_closure = '1.5-order-dai'
     40! - variable ml_wall_adjusted renamed to delta as it represents a grid size and not a mixing length
     41!   (see Equations 14 and 18 in Maronga et al. 2015, GMD)
    4042! - nameing of turbulence closures revised:
    4143!        'Moeng_Wyngaard' to '1.5-order'
    … …  
    4446! - LOGICAL steering variable renamed:
    4547!        les_mw to les_default
    46 ! 
     48!
    4749! 4473 2020-03-25 21:04:07Z gronemeier
    4850! - rename l-grid to gridsize-geometric-mean
    … …  
    5456!          l to ml
    5557! - adjust some comments
    56 ! - corrected definition of wall-adjusted mixing length to include
    57 !   gridsize-geometric-mean
     58! - corrected definition of wall-adjusted mixing length to include gridsize-geometric-mean
    5859! - moved definition of wall_adjustment_factor to this module
    5960!
    … …  
    6869!
    6970! 4346 2019-12-18 11:55:56Z motisi
    70 ! Introduction of wall_flags_total_0, which currently sets bits based on static
    71 ! topography information used in wall_flags_static_0
     71! Introduction of wall_flags_total_0, which currently sets bits based on static topography
     72! information used in wall_flags_static_0
    7273!
    7374! 4329 2019-12-10 15:46:36Z motisi
    … …  
    8182!
    8283! 4170 2019-08-19 17:12:31Z gronemeier
    83 ! - add performance optimizations according to K. Ketelsen
    84 !   to diffusion_e and tcm_diffusivities_default
     84! - add performance optimizations according to K. Ketelsen to diffusion_e and
     85!   tcm_diffusivities_default
    8586! - bugfix in calculating l_wall for vertical walls
    8687! - bugfix in using l_wall in initialization (consider wall_adjustment_factor)
    … …  
    9192!
    9293! 4110 2019-07-22 17:05:21Z suehring
    93 ! pass integer flag array as well as boundary flags to WS scalar advection
    94 ! routine
     94! pass integer flag array as well as boundary flags to WS scalar advection routine
    9595!
    9696! 4109 2019-07-22 17:00:34Z suehring
    9797! - Modularize setting of boundary conditions for TKE and dissipation
    9898! - Neumann boundary condition for TKE at model top is set also in child domain
    99 ! - Revise setting of Neumann boundary conditions at non-cyclic lateral
    100 !   boundaries
    101 ! - Bugfix, set Neumann boundary condition for TKE at vertical wall instead of
    102 !   an implicit Dirichlet boundary condition which implied a sink of TKE
    103 !   at vertical walls
     99! - Revise setting of Neumann boundary conditions at non-cyclic lateral boundaries
     100! - Bugfix, set Neumann boundary condition for TKE at vertical wall instead of an implicit Dirichlet
     101!   boundary condition which implied a sink of TKE at vertical walls
    104102!
    105103! 4048 2019-06-21 21:00:21Z knoop
    … …  
    113111!
    114112! 3719 2019-02-06 13:10:18Z kanani
    115 ! Changed log_point to log_point_s, otherwise this overlaps with
    116 ! 'all progn.equations' cpu measurement.
     113! Changed log_point to log_point_s, otherwise this overlaps with 'all progn.equations' cpu
     114! measurement.
    117115!
    118116! 3684 2019-01-20 20:20:58Z knoop
    … …  
    136134!> @todo Check for random disturbances
    137135!> @note <Enter notes on the module>
    138 !-----------------------------------------------------------------------------!
     136!--------------------------------------------------------------------------------------------------!
    139137 MODULE turbulence_closure_mod
    140138
    141139
    142     USE arrays_3d,                                                            &
    143         ONLY:  diss, diss_1, diss_2, diss_3, diss_p, dzu, e, e_1, e_2, e_3,   &
    144                e_p, kh, km, mean_inflow_profiles, prho, pt, tdiss_m,          &
    145                te_m, tend, u, v, vpt, w
    146 
    147     USE basic_constants_and_equations_mod,                                    &
    148         ONLY:  g, kappa, lv_d_cp, lv_d_rd, rd_d_rv
    149 
    150     USE control_parameters,                                                   &
    151         ONLY:  bc_dirichlet_l,                                                &
    152                bc_dirichlet_n,                                                &
    153                bc_dirichlet_r,                                                &
    154                bc_dirichlet_s,                                                &
    155                bc_radiation_l,                                                &
    156                bc_radiation_n,                                                &
    157                bc_radiation_r,                                                &
    158                bc_radiation_s,                                                &
    159                child_domain,                                                  &
    160                constant_diffusion, dt_3d, e_init, humidity,                   &
    161                initializing_actions, intermediate_timestep_count,             &
    162                intermediate_timestep_count_max, km_constant,                  &
    163                les_dai, les_dynamic, les_default,                             &
    164                ocean_mode, plant_canopy, prandtl_number,                      &
    165                pt_reference, rans_mode, rans_tke_e, rans_tke_l,               &
    166                timestep_scheme, turbulence_closure,                           &
    167                turbulent_inflow, use_upstream_for_tke, vpt_reference,         &
    168                ws_scheme_sca, current_timestep_number
    169 
    170     USE advec_ws,                                                             &
     140    USE arrays_3d,                                                                                 &
     141        ONLY:  diss,                                                                               &
     142               diss_1,                                                                             &
     143               diss_2,                                                                             &
     144               diss_3,                                                                             &
     145               diss_p,                                                                             &
     146               dzu,                                                                                &
     147               e,                                                                                  &
     148               e_1,                                                                                &
     149               e_2,                                                                                &
     150               e_3,                                                                                &
     151               e_p,                                                                                &
     152               kh,                                                                                 &
     153               km,                                                                                 &
     154               mean_inflow_profiles,                                                               &
     155               prho,                                                                               &
     156               pt,                                                                                 &
     157               tdiss_m,                                                                            &
     158               te_m,                                                                               &
     159               tend,                                                                               &
     160               u,                                                                                  &
     161               v,                                                                                  &
     162               vpt,                                                                                &
     163               w
     164
     165    USE basic_constants_and_equations_mod,                                                         &
     166        ONLY:  g,                                                                                  &
     167               kappa,                                                                              &
     168               lv_d_cp,                                                                            &
     169               lv_d_rd,                                                                            &
     170               rd_d_rv
     171
     172    USE control_parameters,                                                                        &
     173        ONLY:  bc_dirichlet_l,                                                                     &
     174               bc_dirichlet_n,                                                                     &
     175               bc_dirichlet_r,                                                                     &
     176               bc_dirichlet_s,                                                                     &
     177               bc_radiation_l,                                                                     &
     178               bc_radiation_n,                                                                     &
     179               bc_radiation_r,                                                                     &
     180               bc_radiation_s,                                                                     &
     181               child_domain,                                                                       &
     182               constant_diffusion,                                                                 &
     183               current_timestep_number,                                                            &
     184               dt_3d,                                                                              &
     185               e_init,                                                                             &
     186               humidity,                                                                           &
     187               initializing_actions,                                                               &
     188               intermediate_timestep_count,                                                        &
     189               intermediate_timestep_count_max,                                                    &
     190               km_constant,                                                                        &
     191               les_dai,                                                                            &
     192               les_dynamic,                                                                        &
     193               les_default,                                                                        &
     194               ocean_mode,                                                                         &
     195               plant_canopy,                                                                       &
     196               prandtl_number,                                                                     &
     197               pt_reference,                                                                       &
     198               rans_mode,                                                                          &
     199               rans_tke_e,                                                                         &
     200               rans_tke_l,                                                                         &
     201               timestep_scheme,                                                                    &
     202               turbulence_closure,                                                                 &
     203               turbulent_inflow,                                                                   &
     204               use_upstream_for_tke,                                                               &
     205               vpt_reference,                                                                      &
     206               ws_scheme_sca
     207
     208
     209    USE advec_ws,                                                                                  &
    171210        ONLY:  advec_s_ws
    172211
    173     USE advec_s_bc_mod,                                                       &
     212    USE advec_s_bc_mod,                                                                            &
    174213        ONLY:  advec_s_bc
    175214
    176     USE advec_s_pw_mod,                                                       &
     215    USE advec_s_pw_mod,                                                                            &
    177216        ONLY:  advec_s_pw
    178217
    179     USE advec_s_up_mod,                                                       &
     218    USE advec_s_up_mod,                                                                            &
    180219        ONLY:  advec_s_up
    181220
    182     USE cpulog,                                                               &
     221    USE cpulog,                                                                                    &
    183222        ONLY:  cpu_log, log_point_s
    184223
    185     USE indices,                                                              &
    186         ONLY:  advc_flags_s,                                                  &
    187                nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt,    &
    188                topo_top_ind,                                                  &
     224    USE indices,                                                                                   &
     225        ONLY:  advc_flags_s,                                                                       &
     226               nbgp,                                                                               &
     227               nxl,                                                                                &
     228               nxlg,                                                                               &
     229               nxr,                                                                                &
     230               nxrg,                                                                               &
     231               nyn,                                                                                &
     232               nyng,                                                                               &
     233               nys,                                                                                &
     234               nysg,                                                                               &
     235               nzb,                                                                                &
     236               nzt,                                                                                &
     237               topo_top_ind,                                                                       &
    189238               wall_flags_total_0
    190239
    191240    USE kinds
    192241
    193     USE ocean_mod,                                                            &
     242    USE ocean_mod,                                                                                 &
    194243        ONLY:  prho_reference
    195244
    196245    USE pegrid
    197246
    198     USE plant_canopy_model_mod,                                               &
     247    USE plant_canopy_model_mod,                                                                    &
    199248        ONLY:  pcm_tendency
    200249
    201     USE statistics,                                                           &
    202         ONLY:  hom, hom_sum, statistic_regions
    203 
    204     USE surface_mod,                                                          &
    205         ONLY:  bc_h,                                                          &
    206                bc_v,                                                          &
    207                surf_def_h,                                                    &
    208                surf_def_v,                                                    &
    209                surf_lsm_h,                                                    &
    210                surf_lsm_v,                                                    &
    211                surf_usm_h,                                                    &
     250    USE statistics,                                                                                &
     251        ONLY:  hom,                                                                                &
     252               hom_sum,                                                                            &
     253               statistic_regions
     254
     255    USE surface_mod,                                                                               &
     256        ONLY:  bc_h,                                                                               &
     257               bc_v,                                                                               &
     258               surf_def_h,                                                                         &
     259               surf_def_v,                                                                         &
     260               surf_lsm_h,                                                                         &
     261               surf_lsm_v,                                                                         &
     262               surf_usm_h,                                                                         &
    212263               surf_usm_v
    213264
    … …  
    225276    REAL(wp) ::  wall_adjustment_factor = 1.8_wp  !< adjustment factor for mixing length
    226277
    227     REAL(wp), DIMENSION(0:4) :: rans_const_c = &        !< model constants for RANS mode (namelist param)
    228        (/ 0.55_wp, 1.44_wp, 1.92_wp, 1.44_wp, 0.0_wp /) !> default values fit for standard-tke-e closure
    229 
    230     REAL(wp), DIMENSION(2) :: rans_const_sigma = &      !< model constants for RANS mode, sigma values (namelist param)
    231        (/ 1.0_wp, 1.30_wp /)                            !> (sigma_e, sigma_diss)
    232 
    233     REAL(wp), ALLOCATABLE, DIMENSION(:)     ::  ml_blackadar             !< mixing length according to Blackadar
    234     REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  delta                    !< grid size, possibly limited by wall adjustment factor
    235     REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  distance_to_wall         !< distance to the surface/wall
     278    REAL(wp), DIMENSION(0:4) ::  rans_const_c = &        !< model constants for RANS mode (namelist param)
     279       (/ 0.55_wp, 1.44_wp, 1.92_wp, 1.44_wp, 0.0_wp /)  !> default values fit for standard-tke-e closure
     280
     281    REAL(wp), DIMENSION(2) ::  rans_const_sigma = &      !< model constants for RANS mode, sigma values (namelist param)
     282       (/ 1.0_wp, 1.30_wp /)                             !> (sigma_e, sigma_diss)
     283
     284    REAL(wp), ALLOCATABLE, DIMENSION(:)     ::  ml_blackadar      !< mixing length according to Blackadar
     285    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  delta             !< grid size, possibly limited by wall adjustment factor
     286    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  distance_to_wall  !< distance to the surface/wall
    236287
    237288!
    238289!-- Public variables
    239     PUBLIC c_0, rans_const_c, rans_const_sigma
     290    PUBLIC c_0,                                                                                    &
     291           rans_const_c,                                                                           &
     292           rans_const_sigma
    240293
    241294    SAVE
    … …  
    244297!
    245298!-- Public subroutines
    246     PUBLIC                                                                     &
    247        tcm_boundary_conds,                                                     &
    248        tcm_check_parameters,                                                   &
    249        tcm_check_data_output,                                                  &
    250        tcm_define_netcdf_grid,                                                 &
    251        tcm_init_arrays,                                                        &
    252        tcm_init,                                                               &
    253        tcm_actions,                                                            &
    254        tcm_prognostic_equations,                                               &
    255        tcm_swap_timelevel,                                                     &
    256        tcm_3d_data_averaging,                                                  &
    257        tcm_data_output_2d,                                                     &
    258        tcm_data_output_3d,                                                     &
    259        tcm_diffusivities
     299    PUBLIC  tcm_actions,                                                                           &
     300            tcm_boundary_conds,                                                                    &
     301            tcm_check_parameters,                                                                  &
     302            tcm_check_data_output,                                                                 &
     303            tcm_data_output_2d,                                                                    &
     304            tcm_data_output_3d,                                                                    &
     305            tcm_define_netcdf_grid,                                                                &
     306            tcm_diffusivities,                                                                     &
     307            tcm_init_arrays,                                                                       &
     308            tcm_init,                                                                              &
     309            tcm_prognostic_equations,                                                              &
     310            tcm_swap_timelevel,                                                                    &
     311            tcm_3d_data_averaging
     312
     313
     314
    260315
    261316!
    … …  
    342397 CONTAINS
    343398
    344 !------------------------------------------------------------------------------!
     399!--------------------------------------------------------------------------------------------------!
    345400! Description:
    346401! ------------
    347402!> Check parameters routine for turbulence closure module.
    348 !------------------------------------------------------------------------------!
     403!--------------------------------------------------------------------------------------------------!
    349404 SUBROUTINE tcm_boundary_conds
    350405
    351     USE pmc_interface,                                                         &
     406    USE pmc_interface,                                                                             &
    352407        ONLY : rans_mode_parent
    353408
    … …  
    364419!
    365420!--    In LES mode, Neumann conditions with de/x_i=0 are assumed at solid walls.
    366 !--    Note, only TKE is prognostic in this case and dissipation is only
    367 !--    a diagnostic quantity.
     421!--    Note, only TKE is prognostic in this case and dissipation is only a diagnostic quantity.
    368422       IF ( .NOT. rans_mode )  THEN
    369423!
    … …  
    384438          DO  l = 0, 3
    385439!
    386 !--          Note concerning missing ACC directive for this loop: Even though
    387 !--          the data structure bc_v is present, it may not contain any
    388 !--          allocated arrays in the flat but also in a topography case,
    389 !--          leading to a runtime error. Therefore, omit ACC directives
    390 !--          for this loop, in contrast to the bc_h loop.
     440!--          Note concerning missing ACC directive for this loop: Even though the data structure
     441!--          bc_v is present, it may not contain any allocated arrays in the flat but also in a
     442!--          topography case, leading to a runtime error. Therefore, omit ACC directives for this
     443!--          loop, in contrast to the bc_h loop.
    391444             !$OMP PARALLEL DO PRIVATE( i, j, k )
    392445             DO  m = 1, bc_v(l)%ns
    … …  
    402455!
    403456!--       Use wall function within constant-flux layer
    404 !--       Note, grid points listed in bc_h are not included in any calculations in RANS mode and
    405 !--       are therefore not set here.
     457!--       Note, grid points listed in bc_h are not included in any calculations in RANS mode and are
     458!--       therefore not set here.
    406459!
    407460!--       Upward-facing surfaces
    … …  
    459512       ENDIF
    460513!
    461 !--    Set Neumann boundary condition for TKE at model top. Do this also
    462 !--    in case of a nested run.
     514!--    Set Neumann boundary condition for TKE at model top. Do this also in case of a nested run.
    463515       !$ACC KERNELS PRESENT(e_p)
    464516       e_p(nzt+1,:,:) = e_p(nzt,:,:)
    465517       !$ACC END KERNELS
    466518!
    467 !--    Nesting case: if parent operates in RANS mode and child in LES mode,
    468 !--    no TKE is transfered. This case, set Neumann conditions at lateral and
    469 !--    top child boundaries.
    470 !--    If not ( both either in RANS or in LES mode ), TKE boundary condition
    471 !--    is treated in the nesting.
     519!--    Nesting case: if parent operates in RANS mode and child in LES mode, no TKE is transfered.
     520!--    This case, set Neumann conditions at lateral and top child boundaries.
     521!--    If not ( both either in RANS or in LES mode ), TKE boundary condition is treated in the
     522!--    nesting.
    472523       If ( child_domain )  THEN
    473524          IF ( rans_mode_parent  .AND.  .NOT. rans_mode )  THEN
    … …  
    482533       ENDIF
    483534!
    484 !--    At in- and outflow boundaries also set Neumann boundary conditions
    485 !--    for the SGS-TKE. An exception is made for the child domain if
    486 !--    both parent and child operate in RANS mode. This case no
    487 !--    lateral Neumann boundary conditions will be set but Dirichlet
    488 !--    conditions will be set in the nesting.
    489        IF ( .NOT. child_domain  .AND.  .NOT. rans_mode_parent  .AND.           &
    490             .NOT. rans_mode )  THEN
     535!--    At in- and outflow boundaries also set Neumann boundary conditions for the SGS-TKE. An
     536!--    exception is made for the child domain if both parent and child operate in RANS mode. This
     537!--    case no lateral Neumann boundary conditions will be set but Dirichlet conditions will be set
     538!--    in the nesting.
     539       IF ( .NOT. child_domain  .AND.  .NOT. rans_mode_parent  .AND.  .NOT. rans_mode )  THEN
    491540          IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
    492541             e_p(:,nys-1,:) = e_p(:,nys,:)
    … …  
    519568          j = surf_def_h(0)%j(m)
    520569          k = surf_def_h(0)%k(m)
    521           diss_p(k,j,i) = surf_def_h(0)%us(m)**3          &
    522                         / ( kappa * surf_def_h(0)%z_mo(m) )
     570          diss_p(k,j,i) = surf_def_h(0)%us(m)**3 / ( kappa * surf_def_h(0)%z_mo(m) )
    523571       ENDDO
    524572!
    … …  
    528576          j = surf_lsm_h%j(m)
    529577          k = surf_lsm_h%k(m)
    530           diss_p(k,j,i) = surf_lsm_h%us(m)**3          &
    531                         / ( kappa * surf_lsm_h%z_mo(m) )
     578          diss_p(k,j,i) = surf_lsm_h%us(m)**3 / ( kappa * surf_lsm_h%z_mo(m) )
    532579       ENDDO
    533580!
    … …  
    537584          j = surf_usm_h%j(m)
    538585          k = surf_usm_h%k(m)
    539           diss_p(k,j,i) = surf_usm_h%us(m)**3          &
    540                         / ( kappa * surf_usm_h%z_mo(m) )
     586          diss_p(k,j,i) = surf_usm_h%us(m)**3 / ( kappa * surf_usm_h%z_mo(m) )
    541587       ENDDO
    542588!
    … …  
    549595             j = surf_def_v(l)%j(m)
    550596             k = surf_def_v(l)%k(m)
    551              diss_p(k,j,i) = surf_def_v(l)%us(m)**3          &
    552                            / ( kappa * surf_def_v(l)%z_mo(m) )
     597             diss_p(k,j,i) = surf_def_v(l)%us(m)**3 / ( kappa * surf_def_v(l)%z_mo(m) )
    553598          ENDDO
    554599!
    … …  
    558603             j = surf_lsm_v(l)%j(m)
    559604             k = surf_lsm_v(l)%k(m)
    560              diss_p(k,j,i) = surf_lsm_v(l)%us(m)**3          &
    561                            / ( kappa * surf_lsm_v(l)%z_mo(m) )
     605             diss_p(k,j,i) = surf_lsm_v(l)%us(m)**3 / ( kappa * surf_lsm_v(l)%z_mo(m) )
    562606          ENDDO
    563607!
    … …  
    567611             j = surf_usm_v(l)%j(m)
    568612             k = surf_usm_v(l)%k(m)
    569              diss_p(k,j,i) = surf_usm_v(l)%us(m)**3          &
    570                            / ( kappa * surf_usm_v(l)%z_mo(m) )
     613             diss_p(k,j,i) = surf_usm_v(l)%us(m)**3 / ( kappa * surf_usm_v(l)%z_mo(m) )
    571614          ENDDO
    572615       ENDDO
    573616!
    574 !--    Limit change of diss to be between -90% and +100%. Also, set an absolute
    575 !--    minimum value
     617!--    Limit change of diss to be between -90% and +100%. Also, set an absolute minimum value
    576618       DO  i = nxl, nxr
    577619          DO  j = nys, nyn
    578620             DO  k = nzb, nzt+1
    579                 diss_p(k,j,i) = MAX( MIN( diss_p(k,j,i),          &
    580                                           2.0_wp * diss(k,j,i) ), &
    581                                      0.1_wp * diss(k,j,i),        &
    582                                      0.0001_wp )
     621                diss_p(k,j,i) = MAX( MIN( diss_p(k,j,i), 2.0_wp * diss(k,j,i) ),                   &
     622                                          0.1_wp * diss(k,j,i), 0.0001_wp )
    583623             ENDDO
    584624          ENDDO
    … …  
    591631 END SUBROUTINE tcm_boundary_conds
    592632
    593 !------------------------------------------------------------------------------!
     633!--------------------------------------------------------------------------------------------------!
    594634! Description:
    595635! ------------
    596636!> Check parameters routine for turbulence closure module.
    597 !------------------------------------------------------------------------------!
     637!--------------------------------------------------------------------------------------------------!
    598638 SUBROUTINE tcm_check_parameters
    599639
    600     USE control_parameters,                                                    &
    601         ONLY:  message_string, turbulent_inflow, turbulent_outflow
     640    USE control_parameters,                                                                        &
     641        ONLY:  message_string,                                                                     &
     642               turbulent_inflow,                                                                   &
     643               turbulent_outflow
    602644
    603645    IMPLICIT NONE
    … …  
    625667
    626668       CASE DEFAULT
    627           message_string = 'Unknown turbulence closure: ' //                &
    628                            TRIM( turbulence_closure )
     669          message_string = 'Unknown turbulence closure: ' // TRIM( turbulence_closure )
    629670          CALL message( 'tcm_check_parameters', 'PA0500', 1, 2, 0, 6, 0 )
    630671
    … …  
    641682       c_1 = rans_const_c(1)
    642683       c_2 = rans_const_c(2)
    643        c_3 = rans_const_c(3)   !> @todo clarify how to switch between different models
     684       c_3 = rans_const_c(3)   !> @todo Clarify how to switch between different models
    644685       c_4 = rans_const_c(4)
    645686
    646687       IF ( turbulent_inflow .OR. turbulent_outflow )  THEN
    647           message_string = 'turbulent inflow/outflow is not yet '//            &
    648                            'implemented for RANS mode'
     688          message_string = 'turbulent inflow/outflow is not yet '// 'implemented for RANS mode'
    649689          CALL message( 'tcm_check_parameters', 'PA0501', 1, 2, 0, 6, 0 )
    650690       ENDIF
    … …  
    653693!
    654694!--    LES mode
    655        c_0 = 0.1_wp    !according to Lilly (1967) and Deardorff (1980)
    656 
    657        dsig_e = 1.0_wp !assure to use K_m to calculate TKE instead
    658                        !of K_e which is used in RANS mode
     695       c_0 = 0.1_wp    !According to Lilly (1967) and Deardorff (1980)
     696
     697       dsig_e = 1.0_wp !Assure to use K_m to calculate TKE instead of K_e which is used in RANS mode
    659698
    660699    ENDIF
    … …  
    662701 END SUBROUTINE tcm_check_parameters
    663702
    664 !------------------------------------------------------------------------------!
     703!--------------------------------------------------------------------------------------------------!
    665704! Description:
    666705! ------------
    667706!> Check data output.
    668 !------------------------------------------------------------------------------!
     707!--------------------------------------------------------------------------------------------------!
    669708 SUBROUTINE tcm_check_data_output( var, unit )
    670709
    671710    IMPLICIT NONE
    672711
    673     CHARACTER (LEN=*) ::  unit     !< unit of output variable
    674     CHARACTER (LEN=*) ::  var      !< name of output variable
     712    CHARACTER(LEN=*) ::  unit  !< unit of output variable
     713    CHARACTER(LEN=*) ::  var   !< name of output variable
    675714
    676715
    … …  
    691730
    692731
    693 !------------------------------------------------------------------------------!
     732!--------------------------------------------------------------------------------------------------!
    694733! Description:
    695734! ------------
    696 !> Define appropriate grid for netcdf variables.
    697 !> It is called out from subroutine netcdf.
    698 !------------------------------------------------------------------------------!
     735!> Define appropriate grid for netcdf variables. It is called out from subroutine netcdf.
     736!--------------------------------------------------------------------------------------------------!
    699737 SUBROUTINE tcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
    700738
    701739    IMPLICIT NONE
    702740
    703     CHARACTER (LEN=*), INTENT(OUT) ::  grid_x   !< x grid of output variable
    704     CHARACTER (LEN=*), INTENT(OUT) ::  grid_y   !< y grid of output variable
    705     CHARACTER (LEN=*), INTENT(OUT) ::  grid_z   !< z grid of output variable
    706     CHARACTER (LEN=*), INTENT(IN)  ::  var      !< name of output variable
     741    CHARACTER(LEN=*), INTENT(OUT) ::  grid_x  !< x grid of output variable
     742    CHARACTER(LEN=*), INTENT(OUT) ::  grid_y  !< y grid of output variable
     743    CHARACTER(LEN=*), INTENT(OUT) ::  grid_z  !< z grid of output variable
     744    CHARACTER(LEN=*), INTENT(IN)  ::  var     !< name of output variable
    707745
    708746    LOGICAL, INTENT(OUT) ::  found   !< flag if output variable is found
    … …  
    740778
    741779
    742 !------------------------------------------------------------------------------!
     780!--------------------------------------------------------------------------------------------------!
    743781! Description:
    744782! ------------
    745783!> Average 3D data.
    746 !------------------------------------------------------------------------------!
     784!--------------------------------------------------------------------------------------------------!
    747785 SUBROUTINE tcm_3d_data_averaging( mode, variable )
    748786
    749787
    750     USE averaging,                                                             &
    751         ONLY:  diss_av, kh_av, km_av
    752 
    753     USE control_parameters,                                                    &
     788    USE averaging,                                                                                 &
     789        ONLY:  diss_av,                                                                            &
     790               kh_av,                                                                              &
     791               km_av
     792
     793    USE control_parameters,                                                                        &
    754794        ONLY:  average_count_3d
    755795
    756796    IMPLICIT NONE
    757797
    758     CHARACTER (LEN=*) ::  mode       !< flag defining mode 'allocate', 'sum' or 'average'
    759     CHARACTER (LEN=*) ::  variable   !< name of variable
    760 
    761     INTEGER(iwp) ::  i   !< loop index
    762     INTEGER(iwp) ::  j   !< loop index
    763     INTEGER(iwp) ::  k   !< loop index
     798    CHARACTER(LEN=*) ::  mode      !< flag defining mode 'allocate', 'sum' or 'average'
     799    CHARACTER(LEN=*) ::  variable  !< name of variable
     800
     801    INTEGER(iwp) ::  i  !< loop index
     802    INTEGER(iwp) ::  j  !< loop index
     803    INTEGER(iwp) ::  k  !< loop index
    764804
    765805    IF ( mode == 'allocate' )  THEN
    … …  
    841881                   DO  j = nysg, nyng
    842882                      DO  k = nzb, nzt+1
    843                          diss_av(k,j,i) = diss_av(k,j,i)                       &
    844                                         / REAL( average_count_3d, KIND=wp )
     883                         diss_av(k,j,i) = diss_av(k,j,i) / REAL( average_count_3d, KIND = wp )
    845884                      ENDDO
    846885                   ENDDO
    … …  
    853892                   DO  j = nysg, nyng
    854893                      DO  k = nzb, nzt+1
    855                          kh_av(k,j,i) = kh_av(k,j,i)                           &
    856                                         / REAL( average_count_3d, KIND=wp )
     894                         kh_av(k,j,i) = kh_av(k,j,i) / REAL( average_count_3d, KIND = wp )
    857895                      ENDDO
    858896                   ENDDO
    … …  
    865903                   DO  j = nysg, nyng
    866904                      DO  k = nzb, nzt+1
    867                          km_av(k,j,i) = km_av(k,j,i)                           &
    868                                         / REAL( average_count_3d, KIND=wp )
     905                         km_av(k,j,i) = km_av(k,j,i) / REAL( average_count_3d, KIND = wp )
    869906                      ENDDO
    870907                   ENDDO
    … …  
    879916
    880917
    881 !------------------------------------------------------------------------------!
     918!--------------------------------------------------------------------------------------------------!
    882919! Description:
    883920! ------------
    884921!> Define 2D output variables.
    885 !------------------------------------------------------------------------------!
    886  SUBROUTINE tcm_data_output_2d( av, variable, found, grid, mode, local_pf,     &
    887                                 nzb_do, nzt_do )
    888 
    889     USE averaging,                                                             &
    890         ONLY:  diss_av, kh_av, km_av
     922!--------------------------------------------------------------------------------------------------!
     923 SUBROUTINE tcm_data_output_2d( av, variable, found, grid, mode, local_pf, nzb_do, nzt_do )
     924
     925    USE averaging,                                                                                 &
     926        ONLY:  diss_av,                                                                            &
     927               kh_av,                                                                              &
     928               km_av
    891929
    892930    IMPLICIT NONE
    893931
    894     CHARACTER (LEN=*) ::  grid       !< name of vertical grid
    895     CHARACTER (LEN=*) ::  mode       !< either 'xy', 'xz' or 'yz'
    896     CHARACTER (LEN=*) ::  variable   !< name of variable
    897 
    898     INTEGER(iwp) ::  av        !< flag for (non-)average output
    899     INTEGER(iwp) ::  flag_nr   !< number of masking flag
    900     INTEGER(iwp) ::  i         !< loop index
    901     INTEGER(iwp) ::  j         !< loop index
    902     INTEGER(iwp) ::  k         !< loop index
    903     INTEGER(iwp) ::  nzb_do    !< vertical output index (bottom)
    904     INTEGER(iwp) ::  nzt_do    !< vertical output index (top)
     932    CHARACTER(LEN=*) ::  grid      !< name of vertical grid
     933    CHARACTER(LEN=*) ::  mode      !< either 'xy', 'xz' or 'yz'
     934    CHARACTER(LEN=*) ::  variable  !< name of variable
     935
     936    INTEGER(iwp) ::  av       !< flag for (non-)average output
     937    INTEGER(iwp) ::  flag_nr  !< number of masking flag
     938    INTEGER(iwp) ::  i        !< loop index
     939    INTEGER(iwp) ::  j        !< loop index
     940    INTEGER(iwp) ::  k        !< loop index
     941    INTEGER(iwp) ::  nzb_do   !< vertical output index (bottom)
     942    INTEGER(iwp) ::  nzt_do   !< vertical output index (top)
    905943
    906944    LOGICAL ::  found     !< flag if output variable is found
    … …  
    909947    REAL(wp) ::  fill_value = -9999.0_wp  !< value for the _FillValue attribute
    910948
    911     REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !< local
    912        !< array to which output data is resorted to
     949    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
     950     !< array to which output data is resorted to
    913951
    914952    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to selected output variable
    … …  
    926964             to_be_resorted => diss
    927965          ELSE
    928              IF ( .NOT. ALLOCATED( diss_av ) ) THEN
     966             IF ( .NOT. ALLOCATED( diss_av ) )  THEN
    929967                ALLOCATE( diss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    930968                diss_av = REAL( fill_value, KIND = wp )
    … …  
    938976             to_be_resorted => kh
    939977          ELSE
    940              IF ( .NOT. ALLOCATED( kh_av ) ) THEN
     978             IF ( .NOT. ALLOCATED( kh_av ) )  THEN
    941979                ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    942980                kh_av = REAL( fill_value, KIND = wp )
    … …  
    950988             to_be_resorted => km
    951989          ELSE
    952              IF ( .NOT. ALLOCATED( km_av ) ) THEN
     990             IF ( .NOT. ALLOCATED( km_av ) )  THEN
    953991                ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    954992                km_av = REAL( fill_value, KIND = wp )
    … …  
    9641002    END SELECT
    9651003
    966     IF ( found .AND. .NOT. resorted )  THEN
     1004    IF ( found  .AND.  .NOT. resorted )  THEN
    9671005       DO  i = nxl, nxr
    9681006          DO  j = nys, nyn
    9691007             DO  k = nzb_do, nzt_do
    970                 local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),                &
    971                                   REAL( fill_value, KIND = wp ),               &
     1008                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, KIND = wp ),     &
    9721009                                  BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
    9731010             ENDDO
    … …  
    9791016
    9801017
    981 !------------------------------------------------------------------------------!
     1018!--------------------------------------------------------------------------------------------------!
    9821019! Description:
    9831020! ------------
    9841021!> Define 3D output variables.
    985 !------------------------------------------------------------------------------!
     1022!--------------------------------------------------------------------------------------------------!
    9861023 SUBROUTINE tcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
    9871024
    9881025
    989     USE averaging,                                                             &
    990         ONLY:  diss_av, kh_av, km_av
     1026    USE averaging,                                                                                 &
     1027        ONLY:  diss_av,                                                                            &
     1028               kh_av,                                                                              &
     1029               km_av
    9911030
    9921031    IMPLICIT NONE
    9931032
    994     CHARACTER (LEN=*) ::  variable   !< name of variable
    995 
    996     INTEGER(iwp) ::  av        !< flag for (non-)average output
    997     INTEGER(iwp) ::  flag_nr   !< number of masking flag
    998     INTEGER(iwp) ::  i         !< loop index
    999     INTEGER(iwp) ::  j         !< loop index
    1000     INTEGER(iwp) ::  k         !< loop index
    1001     INTEGER(iwp) ::  nzb_do    !< lower limit of the data output (usually 0)
    1002     INTEGER(iwp) ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
     1033    CHARACTER(LEN=*) ::  variable  !< name of variable
     1034
     1035    INTEGER(iwp) ::  av       !< flag for (non-)average output
     1036    INTEGER(iwp) ::  flag_nr  !< number of masking flag
     1037    INTEGER(iwp) ::  i        !< loop index
     1038    INTEGER(iwp) ::  j        !< loop index
     1039    INTEGER(iwp) ::  k        !< loop index
     1040    INTEGER(iwp) ::  nzb_do   !< lower limit of the data output (usually 0)
     1041    INTEGER(iwp) ::  nzt_do   !< vertical upper limit of the data output (usually nz_do3d)
    10031042
    10041043    LOGICAL ::  found     !< flag if output variable is found
    … …  
    10071046    REAL(wp) ::  fill_value = -9999.0_wp  !< value for the _FillValue attribute
    10081047
    1009     REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf   !< local
     1048    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< local
    10101049       !< array to which output data is resorted to
    10111050
    … …  
    10241063             to_be_resorted => diss
    10251064          ELSE
    1026              IF ( .NOT. ALLOCATED( diss_av ) ) THEN
     1065             IF ( .NOT. ALLOCATED( diss_av ) )  THEN
    10271066                ALLOCATE( diss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    10281067                diss_av = REAL( fill_value, KIND = wp )
    … …  
    10351074             to_be_resorted => kh
    10361075          ELSE
    1037              IF ( .NOT. ALLOCATED( kh_av ) ) THEN
     1076             IF ( .NOT. ALLOCATED( kh_av ) )  THEN
    10381077                ALLOCATE( kh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    10391078                kh_av = REAL( fill_value, KIND = wp )
    … …  
    10461085             to_be_resorted => km
    10471086          ELSE
    1048              IF ( .NOT. ALLOCATED( km_av ) ) THEN
     1087             IF ( .NOT. ALLOCATED( km_av ) )  THEN
    10491088                ALLOCATE( km_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    10501089                km_av = REAL( fill_value, KIND = wp )
    … …  
    10591098
    10601099
    1061     IF ( found .AND. .NOT. resorted )  THEN
     1100    IF ( found  .AND.  .NOT. resorted )  THEN
    10621101       DO  i = nxl, nxr
    10631102          DO  j = nys, nyn
    10641103             DO  k = nzb_do, nzt_do
    1065                 local_pf(i,j,k) = MERGE(                                 &
    1066                                    to_be_resorted(k,j,i),                &
    1067                                    REAL( fill_value, KIND = wp ),        &
    1068                                    BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
     1104                local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, KIND = wp ),     &
     1105                                  BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
    10691106             ENDDO
    10701107          ENDDO
    … …  
    10761113
    10771114
    1078 !------------------------------------------------------------------------------!
     1115!--------------------------------------------------------------------------------------------------!
    10791116! Description:
    10801117! ------------
    10811118!> Allocate arrays and assign pointers.
    1082 !------------------------------------------------------------------------------!
     1119!--------------------------------------------------------------------------------------------------!
    10831120 SUBROUTINE tcm_init_arrays
    10841121
    1085     USE bulk_cloud_model_mod,                                                  &
     1122    USE bulk_cloud_model_mod,                                                                      &
    10861123        ONLY:  collision_turbulence
    10871124
    1088     USE pmc_interface,                                                         &
     1125    USE pmc_interface,                                                                             &
    10891126        ONLY:  nested_run
    10901127
    … …  
    11001137!
    11011138!-- Allocate arrays required for dissipation.
    1102 !-- Please note, if it is a nested run, arrays need to be allocated even if
    1103 !-- they do not necessarily need to be transferred, which is attributed to
    1104 !-- the design of the model coupler which allocates memory for each variable.
     1139!-- Please note, if it is a nested run, arrays need to be allocated even if they do not necessarily
     1140!-- need to be transferred, which is attributed to the design of the model coupler which allocates
     1141!-- memory for each variable.
    11051142    ALLOCATE( diss_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    11061143
    … …  
    11221159
    11231160
    1124 !------------------------------------------------------------------------------!
     1161!--------------------------------------------------------------------------------------------------!
    11251162! Description:
    11261163! ------------
    11271164!> Initialization of turbulence closure module.
    1128 !------------------------------------------------------------------------------!
     1165!--------------------------------------------------------------------------------------------------!
    11291166 SUBROUTINE tcm_init
    11301167
    1131     USE control_parameters,                                                    &
    1132         ONLY:  bc_dirichlet_l, complex_terrain, topography
    1133 
    1134     USE model_1d_mod,                                                          &
    1135         ONLY:  e1d, kh1d, km1d
     1168    USE control_parameters,                                                                        &
     1169        ONLY:  bc_dirichlet_l,                                                                     &
     1170               complex_terrain,                                                                    &
     1171               topography
     1172
     1173    USE model_1d_mod,                                                                              &
     1174        ONLY:  e1d,                                                                                &
     1175               kh1d,                                                                               &
     1176               km1d
    11361177
    11371178    IMPLICIT NONE
    11381179
    1139     INTEGER(iwp) :: i            !< loop index
    1140     INTEGER(iwp) :: j            !< loop index
    1141     INTEGER(iwp) :: k            !< loop index
    1142     INTEGER(iwp) :: nz_s_shift   !< lower shift index for scalars
    1143     INTEGER(iwp) :: nz_s_shift_l !< local lower shift index in case of turbulent inflow
     1180    INTEGER(iwp) :: i             !< loop index
     1181    INTEGER(iwp) :: j             !< loop index
     1182    INTEGER(iwp) :: k             !< loop index
     1183    INTEGER(iwp) :: nz_s_shift    !< lower shift index for scalars
     1184    INTEGER(iwp) :: nz_s_shift_l  !< local lower shift index in case of turbulent inflow
    11441185
    11451186!
    … …  
    11491190!
    11501191!-- Actions for initial runs
    1151     IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.            &
     1192    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.                                &
    11521193         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
    11531194
    11541195       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
    11551196
    1156           IF ( .NOT. rans_tke_e ) THEN
     1197          IF ( .NOT. rans_tke_e )  THEN
    11571198!
    11581199!--          Transfer initial profiles to the arrays of the 3D model
    … …  
    11731214          ELSE
    11741215!
    1175 !--          In case of TKE-e closure in RANS mode, do not use e, diss, and km
    1176 !--          profiles from 1D model. Instead, initialize with constant profiles
     1216!--          In case of TKE-e closure in RANS mode, do not use e, diss, and km profiles from 1D
     1217!--          model. Instead, initialize with constant profiles
    11771218             IF ( constant_diffusion )  THEN
    11781219                km = km_constant
    … …  
    11831224                   DO  j = nysg, nyng
    11841225                      DO  k = nzb+1, nzt
    1185                          km(k,j,i) = c_0 * SQRT( e_init ) * MIN( delta(k,j,i), &
    1186                                                                  ml_blackadar(k) )
     1226                         km(k,j,i) = c_0 * SQRT( e_init ) * MIN( delta(k,j,i), ml_blackadar(k) )
    11871227                      ENDDO
    11881228                   ENDDO
    … …  
    11941234             ELSE
    11951235                IF ( .NOT. ocean_mode )  THEN
    1196                    kh   = 0.01_wp   ! there must exist an initial diffusion, because
    1197                    km   = 0.01_wp   ! otherwise no TKE would be produced by the
    1198                                     ! production terms, as long as not yet
    1199                                     ! e = (u*/cm)**2 at k=nzb+1
     1236                   kh   = 0.01_wp   ! There must exist an initial diffusion, because otherwise no
     1237                   km   = 0.01_wp   ! TKE would be produced by the production terms, as long as not
     1238                                    ! yet e = (u*/cm)**2 at k=nzb+1
    12001239                ELSE
    12011240                   kh   = 0.00001_wp
    … …  
    12171256          ENDIF
    12181257
    1219        ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 .OR. &
     1258       ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 .OR.                   &
    12201259                INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
    12211260
    … …  
    12381277          ELSE
    12391278             IF ( .NOT. ocean_mode )  THEN
    1240                 kh   = 0.01_wp   ! there must exist an initial diffusion, because
    1241                 km   = 0.01_wp   ! otherwise no TKE would be produced by the
    1242                                  ! production terms, as long as not yet
     1279                kh   = 0.01_wp   ! There must exist an initial diffusion, because otherwise no TKE
     1280                km   = 0.01_wp   ! would be produced by the production terms, as long as not yet
    12431281                                 ! e = (u*/cm)**2 at k=nzb+1
    12441282             ELSE
    … …  
    12771315       ENDIF
    12781316
    1279     ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.         &
    1280              TRIM( initializing_actions ) == 'cyclic_fill' )                   &
    1281     THEN
    1282 
    1283 !
    1284 !--    In case of complex terrain and cyclic fill method as initialization,
    1285 !--    shift initial data in the vertical direction for each point in the
    1286 !--    x-y-plane depending on local surface height
    1287        IF ( complex_terrain  .AND.                                             &
    1288             TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
     1317    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.                             &
     1318             TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
     1319
     1320!
     1321!--    In case of complex terrain and cyclic fill method as initialization, shift initial data in
     1322!--    the vertical direction for each point in the x-y-plane depending on local surface height
     1323       IF ( complex_terrain  .AND.  TRIM( initializing_actions ) == 'cyclic_fill' )  THEN
    12891324          DO  i = nxlg, nxrg
    12901325             DO  j = nysg, nyng
    … …  
    13111346!
    13121347!--    Initialization of the turbulence recycling method
    1313        IF ( TRIM( initializing_actions ) == 'cyclic_fill'  .AND.               &
    1314             turbulent_inflow )  THEN
     1348       IF ( TRIM( initializing_actions ) == 'cyclic_fill'  .AND.  turbulent_inflow )  THEN
    13151349          mean_inflow_profiles(:,5) = hom_sum(:,8,0)   ! e
    13161350!
    1317 !--       In case of complex terrain, determine vertical displacement at inflow
    1318 !--       boundary and adjust mean inflow profiles
     1351!--       In case of complex terrain, determine vertical displacement at inflow boundary and adjust
     1352!--       mean inflow profiles
    13191353          IF ( complex_terrain )  THEN
    1320              IF ( nxlg <= 0 .AND. nxrg >= 0 .AND.  &
    1321                   nysg <= 0 .AND. nyng >= 0        )  THEN
     1354             IF ( nxlg <= 0  .AND.  nxrg >= 0  .AND.  nysg <= 0  .AND.  nyng >= 0 )  THEN
    13221355                nz_s_shift_l = topo_top_ind(0,0,0)
    13231356             ELSE
    … …  
    13251358             ENDIF
    13261359#if defined( __parallel )
    1327              CALL MPI_ALLREDUCE(nz_s_shift_l, nz_s_shift, 1, MPI_INTEGER,      &
    1328                                 MPI_MAX, comm2d, ierr)
     1360             CALL MPI_ALLREDUCE(nz_s_shift_l, nz_s_shift, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr)
    13291361#else
    13301362             nz_s_shift = nz_s_shift_l
    13311363#endif
    1332              mean_inflow_profiles(nz_s_shift:nzt+1,5) =  &
    1333                 hom_sum(0:nzt+1-nz_s_shift,8,0)  ! e
     1364             mean_inflow_profiles(nz_s_shift:nzt+1,5) = hom_sum(0:nzt+1-nz_s_shift,8,0)  ! e
    13341365          ENDIF
    13351366!
    1336 !--       Use these mean profiles at the inflow (provided that Dirichlet
    1337 !--       conditions are used)
     1367!--       Use these mean profiles at the inflow (provided that Dirichlet conditions are used)
    13381368          IF ( bc_dirichlet_l )  THEN
    13391369             DO  j = nysg, nyng
    … …  
    13461376!
    13471377!--    Inside buildings set TKE back to zero
    1348        IF ( TRIM( initializing_actions ) == 'cyclic_fill' .AND.                &
    1349             topography /= 'flat' )  THEN
     1378       IF ( TRIM( initializing_actions ) == 'cyclic_fill' .AND. topography /= 'flat' )  THEN
    13501379!
    13511380!--       Inside buildings set TKE back to zero.
    1352 !--       Other scalars (km, kh,...) are ignored at present,
    1353 !--       maybe revise later.
     1381!--       Other scalars (km, kh,...) are ignored at present, maybe revise later.
    13541382          DO  i = nxlg, nxrg
    13551383             DO  j = nysg, nyng
    13561384                DO  k = nzb, nzt
    1357                    e(k,j,i)     = MERGE( e(k,j,i), 0.0_wp,                     &
    1358                                          BTEST( wall_flags_total_0(k,j,i), 0 ) )
     1385                   e(k,j,i) = MERGE( e(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    13591386                ENDDO
    13601387             ENDDO
    … …  
    13651392                DO  j = nysg, nyng
    13661393                   DO  k = nzb, nzt
    1367                       diss(k,j,i)    = MERGE( diss(k,j,i), 0.0_wp,             &
    1368                                          BTEST( wall_flags_total_0(k,j,i), 0 ) )
     1394                      diss(k,j,i) = MERGE( diss(k,j,i), 0.0_wp,                                    &
     1395                                    BTEST( wall_flags_total_0(k,j,i), 0 ) )
    13691396                   ENDDO
    13701397                ENDDO
    … …  
    13731400       ENDIF
    13741401!
    1375 !--    Initialize new time levels (only done in order to set boundary values
    1376 !--    including ghost points)
     1402!--    Initialize new time levels (only done in order to set boundary values including ghost points)
    13771403       e_p = e
    13781404!
    1379 !--    Allthough tendency arrays are set in prognostic_equations, they have
    1380 !--    to be predefined here because there they are used (but multiplied with 0)
    1381 !--    before they are set.
     1405!--    Although tendency arrays are set in prognostic_equations, they have to be predefined here
     1406!--    because there they are used (but multiplied with 0) before they are set.
    13821407       te_m = 0.0_wp
    13831408
    … …  
    13921417
    13931418
    1394 !------------------------------------------------------------------------------!
     1419!--------------------------------------------------------------------------------------------------!
    13951420! Description:
    13961421! ------------
    13971422!> Pre-computation of grid-dependent and near-wall mixing length.
    1398 !> @todo consider walls in horizontal direction at a distance further than a
    1399 !>       single grid point (RANS mode)
    1400 !------------------------------------------------------------------------------!
     1423!> @todo consider walls in horizontal direction at a distance further than a single grid point
     1424!> (RANS mode)
     1425!--------------------------------------------------------------------------------------------------!
    14011426 SUBROUTINE tcm_init_mixing_length
    14021427
    1403     USE arrays_3d,                                                             &
    1404         ONLY:  dzw, ug, vg, zu, zw
    1405 
    1406     USE control_parameters,                                                    &
    1407         ONLY:  f, message_string, wall_adjustment
    1408 
    1409     USE exchange_horiz_mod,                                                    &
    1410         ONLY:  exchange_horiz, exchange_horiz_int
    1411 
    1412     USE grid_variables,                                                        &
    1413         ONLY:  dx, dy
    1414 
    1415     USE indices,                                                               &
    1416         ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb,  &
    1417                nzt, wall_flags_total_0
     1428    USE arrays_3d,                                                                                 &
     1429        ONLY:  dzw,                                                                                &
     1430               ug,                                                                                 &
     1431               vg,                                                                                 &
     1432               zu,                                                                                 &
     1433               zw
     1434
     1435    USE control_parameters,                                                                        &
     1436        ONLY:  f,                                                                                  &
     1437               message_string,                                                                     &
     1438               wall_adjustment
     1439
     1440    USE exchange_horiz_mod,                                                                        &
     1441        ONLY:  exchange_horiz,                                                                     &
     1442               exchange_horiz_int
     1443
     1444    USE grid_variables,                                                                            &
     1445        ONLY:  dx,                                                                                 &
     1446               dy
     1447
     1448    USE indices,                                                                                   &
     1449        ONLY:  nbgp,                                                                               &
     1450               nx,                                                                                 &
     1451               nxl,                                                                                &
     1452               nxlg,                                                                               &
     1453               nxr,                                                                                &
     1454               nxrg,                                                                               &
     1455               ny,                                                                                 &
     1456               nyn,                                                                                &
     1457               nyng,                                                                               &
     1458               nys,                                                                                &
     1459               nysg,                                                                               &
     1460               nzb,                                                                                &
     1461               nzt,                                                                                &
     1462               wall_flags_total_0
    14181463
    14191464    USE kinds
    … …  
    14221467    IMPLICIT NONE
    14231468
    1424     INTEGER(iwp) :: dist_dx     !< found distance devided by dx
    1425     INTEGER(iwp) :: i           !< index variable along x
    1426     INTEGER(iwp) :: ii          !< index variable along x
    1427     INTEGER(iwp) :: j           !< index variable along y
    1428     INTEGER(iwp) :: k           !< index variable along z
    1429     INTEGER(iwp) :: k_max_topo  !< index of maximum topography height
    1430     INTEGER(iwp) :: kk          !< index variable along z
    1431     INTEGER(iwp) :: rad_i       !< search radius in grid points along x
    1432     INTEGER(iwp) :: rad_i_l     !< possible search radius to the left
    1433     INTEGER(iwp) :: rad_i_r     !< possible search radius to the right
    1434     INTEGER(iwp) :: rad_j       !< search radius in grid points along y
    1435     INTEGER(iwp) :: rad_j_n     !< possible search radius to north
    1436     INTEGER(iwp) :: rad_j_s     !< possible search radius to south
    1437     INTEGER(iwp) :: rad_k       !< search radius in grid points along z
    1438     INTEGER(iwp) :: rad_k_b     !< search radius in grid points along negative z
    1439     INTEGER(iwp) :: rad_k_t     !< search radius in grid points along positive z
    1440 
    1441     INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: vic_yz !< contains a quarter of a single yz-slice of vicinity
    1442 
    1443     INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: vicinity !< contains topography information of the vicinity of (i/j/k)
    1444 
    1445     REAL(wp) :: distance_up            !< distance of grid box center to its boundary in upper direction
    1446     REAL(wp) :: distance_down          !< distance of grid box center to its boundary in lower direction
    1447     REAL(wp) :: distance_ns            !< distance of grid box center to its boundary in y direction
    1448     REAL(wp) :: distance_lr            !< distance of grid box center to its boundary in x direction
    1449     REAL(wp) :: distance_edge_yz_down  !< distance of grid box center to its boundary along yz diagonal (down)
    1450     REAL(wp) :: distance_edge_yz_up    !< distance of grid box center to its boundary along yz diagonal (up)
    1451     REAL(wp) :: distance_edge_xz_down  !< distance of grid box center to its boundary along xz diagonal
    1452     REAL(wp) :: distance_edge_xz_up    !< distance of grid box center to its boundary along xz diagonal (up)
    1453     REAL(wp) :: distance_edge_xy       !< distance of grid box center to its boundary along xy diagonal
    1454     REAL(wp) :: distance_corners_down  !< distance of grid box center to its upper corners
    1455     REAL(wp) :: distance_corners_up    !< distance of grid box center to its lower corners
    1456     REAL(wp) :: radius                 !< search radius in meter
     1469    INTEGER(iwp) ::  dist_dx     !< found distance devided by dx
     1470    INTEGER(iwp) ::  i           !< index variable along x
     1471    INTEGER(iwp) ::  ii          !< index variable along x
     1472    INTEGER(iwp) ::  j           !< index variable along y
     1473    INTEGER(iwp) ::  k           !< index variable along z
     1474    INTEGER(iwp) ::  k_max_topo  !< index of maximum topography height
     1475    INTEGER(iwp) ::  kk          !< index variable along z
     1476    INTEGER(iwp) ::  rad_i       !< search radius in grid points along x
     1477    INTEGER(iwp) ::  rad_i_l     !< possible search radius to the left
     1478    INTEGER(iwp) ::  rad_i_r     !< possible search radius to the right
     1479    INTEGER(iwp) ::  rad_j       !< search radius in grid points along y
     1480    INTEGER(iwp) ::  rad_j_n     !< possible search radius to north
     1481    INTEGER(iwp) ::  rad_j_s     !< possible search radius to south
     1482    INTEGER(iwp) ::  rad_k       !< search radius in grid points along z
     1483    INTEGER(iwp) ::  rad_k_b     !< search radius in grid points along negative z
     1484    INTEGER(iwp) ::  rad_k_t     !< search radius in grid points along positive z
     1485
     1486    INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE ::  vic_yz !< contains a quarter of a single yz-slice of vicinity
     1487
     1488    INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  vicinity !< contains topography information of the vicinity of (i/j/k)
     1489
     1490    REAL(wp) ::  distance_up            !< distance of grid box center to its boundary in upper direction
     1491    REAL(wp) ::  distance_down          !< distance of grid box center to its boundary in lower direction
     1492    REAL(wp) ::  distance_ns            !< distance of grid box center to its boundary in y direction
     1493    REAL(wp) ::  distance_lr            !< distance of grid box center to its boundary in x direction
     1494    REAL(wp) ::  distance_edge_yz_down  !< distance of grid box center to its boundary along yz diagonal (down)
     1495    REAL(wp) ::  distance_edge_yz_up    !< distance of grid box center to its boundary along yz diagonal (up)
     1496    REAL(wp) ::  distance_edge_xz_down  !< distance of grid box center to its boundary along xz diagonal
     1497    REAL(wp) ::  distance_edge_xz_up    !< distance of grid box center to its boundary along xz diagonal (up)
     1498    REAL(wp) ::  distance_edge_xy       !< distance of grid box center to its boundary along xy diagonal
     1499    REAL(wp) ::  distance_corners_down  !< distance of grid box center to its upper corners
     1500    REAL(wp) ::  distance_corners_up    !< distance of grid box center to its lower corners
     1501    REAL(wp) ::  radius                 !< search radius in meter
    14571502
    14581503    REAL(wp), DIMENSION(nzb:nzt+1) ::  gridsize_geometric_mean  !< geometric mean of grid sizes dx, dy, dz
    … …  
    14761521       gridsize_geometric_mean(nzt+1) = gridsize_geometric_mean(nzt)
    14771522
    1478        IF ( ANY( gridsize_geometric_mean > 1.5_wp * dx * wall_adjustment_factor ) .OR. &
     1523       IF ( ANY( gridsize_geometric_mean > 1.5_wp * dx * wall_adjustment_factor )  .OR.            &
    14791524            ANY( gridsize_geometric_mean > 1.5_wp * dy * wall_adjustment_factor ) )  THEN
    1480             WRITE( message_string, * ) 'grid anisotropy exceeds threshold',    &
    1481                                       ' &starting from height level k = ', k, &
    1482                                       '.'
     1525            WRITE( message_string, * ) 'grid anisotropy exceeds threshold',                        &
     1526                                       ' &starting from height level k = ', k, '.'
    14831527           CALL message( 'init_grid', 'PA0202', 0, 1, 0, 6, 0 )
    14841528       ENDIF
    … …  
    14911535
    14921536!
    1493 !--    If Dai et al. (2020) closure is used, the distance to the wall (distance to nearest upward facing surface)
    1494 !--    must be stored
     1537!--    If Dai et al. (2020) closure is used, the distance to the wall (distance to nearest upward
     1538!--    facing surface) must be stored
    14951539       IF ( les_dai )  THEN
    14961540          DO  i = nxl, nxr
    … …  
    15051549       IF ( wall_adjustment )  THEN
    15061550!
    1507 !--       In case of topography, adjust mixing length if there is any wall at
    1508 !--       the surrounding grid boxes:
     1551!--       In case of topography, adjust mixing length if there is any wall at the surrounding grid
     1552!--       boxes:
    15091553          !> @todo check if this is correct also for the ocean case
    15101554          DO  i = nxl, nxr
    … …  
    15151559                   IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )  THEN
    15161560!
    1517 !--                   First, check if grid points directly next to current grid point
    1518 !--                   are surface grid points
     1561!--                   First, check if grid points directly next to current grid point are surface
     1562!--                   grid points
    15191563!--                   Check along...
    15201564!--                   ...vertical direction, down
    … …  
    15331577!
    15341578!--                   ...y-direction (north/south)
    1535                       IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 )  .OR. &
     1579                      IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 )  .OR.                     &
    15361580                           .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) )  THEN
    15371581                         distance_ns = 0.5_wp * dy
    … …  
    15411585!
    15421586!--                   ...x-direction (left/right)
    1543                       IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 )  .OR. &
     1587                      IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 )  .OR.                     &
    15441588                           .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) )  THEN
    15451589                         distance_lr = 0.5_wp * dx
    … …  
    15501594!--                   Now, check the edges along...
    15511595!--                   ...yz-direction (vertical edges, down)
    1552                       IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i), 0 )  .OR.  &
     1596                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i), 0 )  .OR.                   &
    15531597                           .NOT. BTEST( wall_flags_total_0(k-1,j+1,i), 0 )  )  THEN
    15541598                         distance_edge_yz_down = SQRT( 0.25_wp * dy**2 + ( zu(k) - zw(k-1) )**2 )
    … …  
    15581602!
    15591603!--                   ...yz-direction (vertical edges, up)
    1560                       IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i), 0 )  .OR.  &
     1604                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i), 0 )  .OR.                   &
    15611605                           .NOT. BTEST( wall_flags_total_0(k+1,j+1,i), 0 )  )  THEN
    15621606                         distance_edge_yz_up = SQRT( 0.25_wp * dy**2 + ( zw(k) - zu(k) )**2 )
    … …  
    15661610!
    15671611!--                   ...xz-direction (vertical edges, down)
    1568                       IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i-1), 0 )  .OR.  &
     1612                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i-1), 0 )  .OR.                   &
    15691613                           .NOT. BTEST( wall_flags_total_0(k-1,j,i+1), 0 )  )  THEN
    15701614                         distance_edge_xz_down = SQRT( 0.25_wp * dx**2 + ( zu(k) - zw(k-1) )**2 )
    … …  
    15741618!
    15751619!--                   ...xz-direction (vertical edges, up)
    1576                       IF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i-1), 0 )  .OR.  &
     1620                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i-1), 0 )  .OR.                   &
    15771621                           .NOT. BTEST( wall_flags_total_0(k+1,j,i+1), 0 )  )  THEN
    15781622                         distance_edge_xz_up = SQRT( 0.25_wp * dx**2 + ( zw(k) - zu(k) )**2 )
    … …  
    15821626!
    15831627!--                   ...xy-direction (horizontal edges)
    1584                       IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i-1), 0 )  .OR. &
    1585                            .NOT. BTEST( wall_flags_total_0(k,j+1,i-1), 0 )  .OR. &
    1586                            .NOT. BTEST( wall_flags_total_0(k,j-1,i+1), 0 )  .OR. &
     1628                      IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i-1), 0 )  .OR.                   &
     1629                           .NOT. BTEST( wall_flags_total_0(k,j+1,i-1), 0 )  .OR.                   &
     1630                           .NOT. BTEST( wall_flags_total_0(k,j-1,i+1), 0 )  .OR.                   &
    15871631                           .NOT. BTEST( wall_flags_total_0(k,j+1,i+1), 0 ) )  THEN
    15881632                         distance_edge_xy = SQRT( 0.25_wp * ( dx**2 + dy**2 ) )
    … …  
    15931637!--                   Now, check the corners...
    15941638!--                   ...lower four corners
    1595                       IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i-1), 0 )  .OR. &
    1596                            .NOT. BTEST( wall_flags_total_0(k-1,j+1,i-1), 0 )  .OR. &
    1597                            .NOT. BTEST( wall_flags_total_0(k-1,j-1,i+1), 0 )  .OR. &
     1639                      IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i-1), 0 )  .OR.                 &
     1640                           .NOT. BTEST( wall_flags_total_0(k-1,j+1,i-1), 0 )  .OR.                 &
     1641                           .NOT. BTEST( wall_flags_total_0(k-1,j-1,i+1), 0 )  .OR.                 &
    15981642                           .NOT. BTEST( wall_flags_total_0(k-1,j+1,i+1), 0 ) )  THEN
    1599                          distance_corners_down = SQRT( 0.25_wp * ( dx**2 + dy**2 ) &
     1643                         distance_corners_down = SQRT( 0.25_wp * ( dx**2 + dy**2 )                 &
    16001644                                                       + ( zu(k) - zw(k-1) )**2 )
    16011645                      ELSE
    … …  
    16041648!
    16051649!--                   ...upper four corners
    1606                       IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i-1), 0 )  .OR. &
    1607                            .NOT. BTEST( wall_flags_total_0(k+1,j+1,i-1), 0 )  .OR. &
    1608                            .NOT. BTEST( wall_flags_total_0(k+1,j-1,i+1), 0 )  .OR. &
     1650                      IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i-1), 0 )  .OR.                 &
     1651                           .NOT. BTEST( wall_flags_total_0(k+1,j+1,i-1), 0 )  .OR.                 &
     1652                           .NOT. BTEST( wall_flags_total_0(k+1,j-1,i+1), 0 )  .OR.                 &
    16091653                           .NOT. BTEST( wall_flags_total_0(k+1,j+1,i+1), 0 ) )  THEN
    1610                          distance_corners_up = SQRT( 0.25_wp * ( dx**2 + dy**2 )   &
     1654                         distance_corners_up = SQRT( 0.25_wp * ( dx**2 + dy**2 )                   &
    16111655                                                     + ( zw(k) - zu(k) )**2 )
    16121656                      ELSE
    … …  
    16151659
    16161660!
    1617 !--                   Calculate the minimum distance from the wall and store it
    1618 !--                   temporarily in the array delta
    1619                       delta(k,j,i) = MIN(                                      &
    1620                          distance_up, distance_down, distance_ns, distance_lr, &
    1621                          distance_edge_yz_down, distance_edge_yz_up,           &
    1622                          distance_edge_xz_down, distance_edge_xz_up,           &
    1623                          distance_edge_xy,                                     &
    1624                          distance_corners_down, distance_corners_up )
    1625 
    1626 !
    1627 !--                   If Dai et al. (2020) closure is used, the distance to the wall
    1628 !--                   must be permanently stored
     1661!--                   Calculate the minimum distance from the wall and store it temporarily in the
     1662!--                   array delta
     1663                      delta(k,j,i) = MIN( distance_up, distance_down, distance_ns, distance_lr,    &
     1664                                          distance_edge_yz_down, distance_edge_yz_up,              &
     1665                                          distance_edge_xz_down, distance_edge_xz_up,              &
     1666                                          distance_edge_xy, distance_corners_down,                 &
     1667                                          distance_corners_up )
     1668
     1669!
     1670!--                   If Dai et al. (2020) closure is used, the distance to the wall must be
     1671!--                   permanently stored
    16291672                      IF ( les_dai  .AND.  delta(k,j,i) /= 9999999.9_wp )  THEN
    16301673                         distance_to_wall(k,j,i) = delta(k,j,i)
    … …  
    16351678                      delta(k,j,i) = wall_adjustment_factor * delta(k,j,i)
    16361679
    1637                   ENDIF  !if grid point belongs to atmosphere
    1638 
    1639 
    1640 
    1641 !
    1642 !--               The grid size (delta) is defined as the the minimum of the distance to
    1643 !--               the nearest wall * 1.8 and the geometric mean grid size.
     1680                  ENDIF  ! If grid point belongs to atmosphere
     1681
     1682
     1683
     1684!
     1685!--               The grid size (delta) is defined as the the minimum of the distance to the nearest
     1686!--               wall * 1.8 and the geometric mean grid size.
    16441687                  delta(k,j,i) = MIN( delta(k,j,i), gridsize_geometric_mean(k) )
    16451688
    … …  
    16591702!--    Calculate mixing length according to Blackadar (1962)
    16601703       IF ( f /= 0.0_wp )  THEN
    1661           length_scale_max = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 )   &
    1662                            / ABS( f ) + 1.0E-10_wp
     1704          length_scale_max = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / ABS( f ) + 1.0E-10_wp
    16631705       ELSE
    16641706          length_scale_max = 30.0_wp
    … …  
    16771719          DO  j = nysg, nyng
    16781720             DO  k = nzb+1, nzt-1
    1679                 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 0 ) .AND.  &
    1680                      k > k_max_topo )  &
     1721                IF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 0 )  .AND.  k > k_max_topo )          &
    16811722                   k_max_topo = k
    16821723             ENDDO
    … …  
    16871728       delta(nzt+1,:,:) = ml_blackadar(nzt+1)
    16881729!
    1689 !--    Limit mixing length to either nearest wall or Blackadar mixing length.
    1690 !--    For that, analyze each grid point (i/j/k) ("analysed grid point") and
    1691 !--    search within its vicinity for the shortest distance to a wall by cal-
    1692 !--    culating the distance between the analysed grid point and the "viewed
    1693 !--    grid point" if it contains a wall (belongs to topography).
     1730!--    Limit mixing length to either nearest wall or Blackadar mixing length. For that, analyze each
     1731!--    grid point (i/j/k) ("analysed grid point") and search within its vicinity for the shortest
     1732!--    distance to a wall by calculating the distance between the analysed grid point and the
     1733!--    "viewed grid point" if it contains a wall (belongs to topography).
    16941734       DO  k = nzb+1, nzt
    16951735
    … …  
    17201760          rad_k = MAX( rad_k_b, rad_k_t )
    17211761!
    1722 !--       When analysed grid point lies above maximum topography, set search
    1723 !--       radius to 0 if the distance between the analysed grid point and max
    1724 !--       topography height is larger than the maximum search radius
     1762!--       When analysed grid point lies above maximum topography, set search radius to 0 if the
     1763!--       distance between the analysed grid point and max topography height is larger than the
     1764!--       maximum search radius
    17251765          IF ( zu(k-rad_k_b) > zu(k_max_topo) )  rad_k_b = 0
    17261766!
    … …  
    17291769
    17301770             !> @note shape of vicinity is larger in z direction
    1731              !>   Shape of vicinity is two grid points larger than actual search
    1732              !>   radius in vertical direction. The first and last grid point is
    1733              !>   always set to 1 to asure correct detection of topography. See
    1734              !>   function "shortest_distance" for details.
     1771             !>   Shape of vicinity is two grid points larger than actual search radius in vertical
     1772             !>   direction. The first and last grid point is always set to 1 to asure correct
     1773             !>   detection of topography. See function "shortest_distance" for details.
    17351774             !>   2018-03-16, gronemeier
    17361775             ALLOCATE( vicinity(-rad_k-1:rad_k+1,-rad_j:rad_j,-rad_i:rad_i) )
    … …  
    17481787                      vicinity(-rad_k:rad_k,:,:) = 0
    17491788!
    1750 !--                   Copy area surrounding analysed grid point into vicinity.
    1751 !--                   First, limit size of data copied to vicinity by the domain
    1752 !--                   border
     1789!--                   Copy area surrounding analysed grid point into vicinity. First, limit size of
     1790!--                   data copied to vicinity by the domain border
    17531791                      !> @note limit copied area to 1 grid point in hor. dir.
    1754                       !>   Ignore walls in horizontal direction which are
    1755                       !>   further away than a single grid point. This allows to
    1756                       !>   only search within local subdomain without the need
    1757                       !>   of global topography information.
    1758                       !>   The error made by this assumption are acceptable at
    1759                       !>   the moment.
     1792                      !>   Ignore walls in horizontal direction which are further away than a single
     1793                      !>   grid point. This allows to only search within local subdomain without the
     1794                      !>   need of global topography information. The error made by this assumption
     1795                      !>   are acceptable at the moment.
    17601796                      !>   2018-10-01, gronemeier
    17611797                      rad_i_l = MIN( 1, rad_i, i )
    … …  
    17651801                      rad_j_n = MIN( 1, rad_j, ny-j )
    17661802
    1767                       CALL copy_into_vicinity( k, j, i,           &
    1768                                                -rad_k_b, rad_k_t, &
    1769                                                -rad_j_s, rad_j_n, &
     1803                      CALL copy_into_vicinity( k, j, i, -rad_k_b, rad_k_t, -rad_j_s, rad_j_n,      &
    17701804                                               -rad_i_l, rad_i_r  )
    1771                       !> @note in case of cyclic boundaries, those parts of the
    1772                       !>   topography which lies beyond the domain borders but
    1773                       !>   still within the search radius still needs to be
    1774                       !>   copied into 'vicinity'. As the effective search
    1775                       !>   radius is limited to 1 at the moment, no further
    1776                       !>   copying is needed. Old implementation (prior to
    1777                       !>   2018-10-01) had this covered but used a global array.
    1778                       !>   2018-10-01, gronemeier
     1805                      !> @note in case of cyclic boundaries, those parts of the topography which
     1806                      !> lies beyond the domain borders but still within the search radius still
     1807                      !> needs to be copied into 'vicinity'. As the effective search radius is
     1808                      !> limited to 1 at the moment, no further copying is needed. Old
     1809                      !> implementation (prior to 2018-10-01) had this covered but used a global
     1810                      !> array.
     1811                      !> 2018-10-01, gronemeier
    17791812
    17801813!
    … …  
    17861819                         DO  ii = 0, dist_dx
    17871820!
    1788 !--                         Search along vertical direction only if below
    1789 !--                         maximum topography
    1790                             IF ( rad_k_t > 0 ) THEN
     1821!--                         Search along vertical direction only if below maximum topography
     1822                            IF ( rad_k_t > 0 )  THEN
    17911823!
    17921824!--                            Search for walls within octant (+++)
    17931825                               vic_yz = vicinity(0:rad_k+1,0:rad_j,ii)
    1794                                delta(k,j,i) = MIN( delta(k,j,i),             &
    1795                                        shortest_distance( vic_yz, .TRUE., ii ) )
     1826                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
     1827                                                   shortest_distance( vic_yz, .TRUE., ii ) )
    17961828!
    17971829!--                            Search for walls within octant (+-+)
    1798 !--                            Switch order of array so that the analysed grid
    1799 !--                            point is always located at (0/0) (required by
    1800 !--                            shortest_distance").
     1830!--                            Switch order of array so that the analysed grid point is always
     1831!--                            located at (0/0) (required by shortest_distance").
    18011832                               vic_yz = vicinity(0:rad_k+1,0:-rad_j:-1,ii)
    1802                                delta(k,j,i) = MIN( delta(k,j,i),             &
    1803                                        shortest_distance( vic_yz, .TRUE., ii ) )
     1833                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
     1834                                                   shortest_distance( vic_yz, .TRUE., ii ) )
    18041835
    18051836                            ENDIF
    … …  
    18071838!--                         Search for walls within octant (+--)
    18081839                            vic_yz = vicinity(0:-rad_k-1:-1,0:-rad_j:-1,ii)
    1809                             delta(k,j,i) = MIN( delta(k,j,i),                &
    1810                                       shortest_distance( vic_yz, .FALSE., ii ) )
     1840                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
     1841                                                shortest_distance( vic_yz, .FALSE., ii ) )
    18111842!
    18121843!--                         Search for walls within octant (++-)
    18131844                            vic_yz = vicinity(0:-rad_k-1:-1,0:rad_j,ii)
    1814                             delta(k,j,i) = MIN( delta(k,j,i),                &
    1815                                       shortest_distance( vic_yz, .FALSE., ii ) )
     1845                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
     1846                                                shortest_distance( vic_yz, .FALSE., ii ) )
    18161847!
    18171848!--                         Reduce search along x by already found distance
    … …  
    18231854                         DO  ii = 0, -dist_dx, -1
    18241855!
    1825 !--                         Search along vertical direction only if below
    1826 !--                         maximum topography
    1827                             IF ( rad_k_t > 0 ) THEN
     1856!--                         Search along vertical direction only if below maximum topography
     1857                            IF ( rad_k_t > 0 )  THEN
    18281858!
    18291859!--                            Search for walls within octant (-++)
    18301860                               vic_yz = vicinity(0:rad_k+1,0:rad_j,ii)
    1831                                delta(k,j,i) = MIN( delta(k,j,i),             &
    1832                                       shortest_distance( vic_yz, .TRUE., -ii ) )
     1861                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
     1862                                                   shortest_distance( vic_yz, .TRUE., -ii ) )
    18331863!
    18341864!--                            Search for walls within octant (--+)
    1835 !--                            Switch order of array so that the analysed grid
    1836 !--                            point is always located at (0/0) (required by
    1837 !--                            shortest_distance").
     1865!--                            Switch order of array so that the analysed grid point is always
     1866!--                            located at (0/0) (required by shortest_distance").
    18381867                               vic_yz = vicinity(0:rad_k+1,0:-rad_j:-1,ii)
    1839                                delta(k,j,i) = MIN( delta(k,j,i),             &
    1840                                       shortest_distance( vic_yz, .TRUE., -ii ) )
     1868                               delta(k,j,i) = MIN( delta(k,j,i),                                   &
     1869                                                   shortest_distance( vic_yz, .TRUE., -ii ) )
    18411870
    18421871                            ENDIF
    … …  
    18441873!--                         Search for walls within octant (---)
    18451874                            vic_yz = vicinity(0:-rad_k-1:-1,0:-rad_j:-1,ii)
    1846                             delta(k,j,i) = MIN( delta(k,j,i),                &
    1847                                      shortest_distance( vic_yz, .FALSE., -ii ) )
     1875                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
     1876                                                shortest_distance( vic_yz, .FALSE., -ii ) )
    18481877!
    18491878!--                         Search for walls within octant (-+-)
    18501879                            vic_yz = vicinity(0:-rad_k-1:-1,0:rad_j,ii)
    1851                             delta(k,j,i) = MIN( delta(k,j,i),                &
    1852                                      shortest_distance( vic_yz, .FALSE., -ii ) )
     1880                            delta(k,j,i) = MIN( delta(k,j,i),                                      &
     1881                                                shortest_distance( vic_yz, .FALSE., -ii ) )
    18531882!
    18541883!--                         Reduce search along x by already found distance
    … …  
    18711900             DEALLOCATE( vic_yz )
    18721901
    1873           ENDIF  !check vertical size of vicinity
     1902          ENDIF  !Check vertical size of vicinity
    18741903
    18751904       ENDDO  !k loop
    … …  
    18921921
    18931922    CONTAINS
    1894 !------------------------------------------------------------------------------!
     1923!--------------------------------------------------------------------------------------------------!
    18951924! Description:
    18961925! ------------
    1897 !> Calculate the shortest distance between position (i/j/k)=(0/0/0) and
    1898 !> (pos_i/jj/kk), where (jj/kk) is the position of the maximum of 'array'
    1899 !> closest to the origin (0/0) of 'array'.
    1900 !------------------------------------------------------------------------------!
     1926!> Calculate the shortest distance between position (i/j/k)=(0/0/0) and (pos_i/jj/kk), where (jj/kk)
     1927!> is the position of the maximum of 'array' closest to the origin (0/0) of 'array'.
     1928!--------------------------------------------------------------------------------------------------!
    19011929    REAL(wp) FUNCTION shortest_distance( array, orientation, pos_i )
    19021930
    19031931       IMPLICIT NONE
    19041932
    1905        LOGICAL, INTENT(IN) :: orientation    !< flag if array represents an array oriented upwards (true) or downwards (false)
    1906 
    1907        INTEGER(iwp), INTENT(IN) :: pos_i     !< x position of the yz-plane 'array'
    1908 
    1909        INTEGER(iwp) :: a                     !< loop index
    1910        INTEGER(iwp) :: b                     !< loop index
    1911        INTEGER(iwp) :: jj                    !< loop index
    1912 
    1913        INTEGER(KIND=1) :: maximum            !< maximum of array along z dimension
    1914 
    1915        INTEGER(iwp), DIMENSION(0:rad_j) :: loc_k !< location of closest wall along vertical dimension
    1916 
    1917        INTEGER(KIND=1), DIMENSION(0:rad_k+1,0:rad_j), INTENT(IN) :: array !< array containing a yz-plane at position pos_i
    1918 
    1919 !
    1920 !--    Get coordinate of first maximum along vertical dimension
    1921 !--    at each y position of array (similar to function maxloc but more stable).
     1933       INTEGER(iwp), INTENT(IN) ::  pos_i  !< x position of the yz-plane 'array'
     1934
     1935       INTEGER(iwp) ::  a   !< loop index
     1936       INTEGER(iwp) ::  b   !< loop index
     1937       INTEGER(iwp) ::  jj  !< loop index
     1938
     1939       INTEGER(KIND=1) ::  maximum  !< maximum of array along z dimension
     1940
     1941       INTEGER(iwp), DIMENSION(0:rad_j) ::  loc_k  !< location of closest wall along vertical dimension
     1942
     1943       INTEGER(KIND=1), DIMENSION(0:rad_k+1,0:rad_j), INTENT(IN) ::  array  !< array containing a yz-plane at position pos_i
     1944
     1945       LOGICAL, INTENT(IN) ::  orientation  !< flag if array represents an array oriented upwards (true) or downwards (false)
     1946
     1947!
     1948!--    Get coordinate of first maximum along vertical dimension at each y position of array
     1949!--    (similar to function maxloc but more stable).
    19221950       DO  a = 0, rad_j
    19231951          loc_k(a) = rad_k+1
    … …  
    19341962       shortest_distance = radius
    19351963!
    1936 !--    Calculate distance between position (0/0/0) and
    1937 !--    position (pos_i/jj/loc(jj)) and only save the shortest distance.
    1938        IF ( orientation ) THEN  !if array is oriented upwards
     1964!--    Calculate distance between position (0/0/0) and position (pos_i/jj/loc(jj)) and only save the
     1965!--    shortest distance.
     1966       IF ( orientation )  THEN  !if array is oriented upwards
    19391967          DO  jj = 0, rad_j
    1940              shortest_distance =                                               &
    1941                 MIN( shortest_distance,                                        &
    1942                      SQRT( MAX(REAL(pos_i, KIND=wp)*dx-0.5_wp*dx, 0.0_wp)**2   &
    1943                          + MAX(REAL(jj, KIND=wp)*dy-0.5_wp*dy, 0.0_wp)**2      &
    1944                          + MAX(zw(loc_k(jj)+k-1)-zu(k), 0.0_wp)**2             &
    1945                          )                                                     &
    1946                    )
     1968             shortest_distance =                                                                   &
     1969               MIN( shortest_distance,                                                             &
     1970                    SQRT( MAX( REAL( pos_i, KIND = wp ) * dx - 0.5_wp * dx, 0.0_wp)**2             &
     1971                        + MAX( REAL( jj, KIND = wp ) * dy - 0.5_wp * dy, 0.0_wp)**2                &
     1972                        + MAX( zw(loc_k(jj)+k-1) - zu(k), 0.0_wp)**2                               &
     1973                        )                                                                          &
     1974                  )
    19471975          ENDDO
    19481976       ELSE  !if array is oriented downwards
    19491977          !> @note MAX within zw required to circumvent error at domain border
    1950           !>   At the domain border, if non-cyclic boundary is present, the
    1951           !>   index for zw could be -1, which will be errorneous (zw(-1) does
    1952           !>   not exist). The MAX function limits the index to be at least 0.
     1978          !>   At the domain border, if non-cyclic boundary is present, the index for zw could be
     1979          !>   -1, which will be errorneous (zw(-1) does not exist). The MAX function limits the
     1980          !>   index to be at least 0.
    19531981          DO  jj = 0, rad_j
    1954              shortest_distance =                                               &
    1955                 MIN( shortest_distance,                                        &
    1956                      SQRT( MAX(REAL(pos_i, KIND=wp)*dx-0.5_wp*dx, 0.0_wp)**2   &
    1957                          + MAX(REAL(jj, KIND=wp)*dy-0.5_wp*dy, 0.0_wp)**2      &
    1958                          + MAX(zu(k)-zw(MAX(k-loc_k(jj),0_iwp)), 0.0_wp)**2    &
    1959                          )                                                     &
     1982             shortest_distance =                                                                   &
     1983                MIN( shortest_distance,                                                            &
     1984                     SQRT( MAX(REAL(pos_i, KIND=wp)*dx-0.5_wp*dx, 0.0_wp)**2                       &
     1985                         + MAX(REAL(jj, KIND=wp)*dy-0.5_wp*dy, 0.0_wp)**2                          &
     1986                         + MAX(zu(k)-zw(MAX(k-loc_k(jj),0_iwp)), 0.0_wp)**2                        &
     1987                         )                                                                         &
    19601988                   )
    19611989          ENDDO
    … …  
    19641992    END FUNCTION
    19651993
    1966 !------------------------------------------------------------------------------!
     1994!--------------------------------------------------------------------------------------------------!
    19671995! Description:
    19681996! ------------
    1969 !> Copy a subarray of size (kb:kt,js:jn,il:ir) centered around grid point
    1970 !> (kp,jp,ip) containing the first bit of wall_flags_total_0 into the array
    1971 !> 'vicinity'. Only copy first bit as this indicates the presence of topography.
    1972 !------------------------------------------------------------------------------!
     1997!> Copy a subarray of size (kb:kt,js:jn,il:ir) centered around grid point (kp,jp,ip) containing the
     1998!> first bit of wall_flags_total_0 into the array 'vicinity'. Only copy first bit as this indicates
     1999!> the presence of topography.
     2000!--------------------------------------------------------------------------------------------------!
    19732001    SUBROUTINE copy_into_vicinity( kp, jp, ip, kb, kt, js, jn, il, ir )
    19742002
    19752003       IMPLICIT NONE
    19762004
    1977        INTEGER(iwp), INTENT(IN) :: il !< left loop boundary
    1978        INTEGER(iwp), INTENT(IN) :: ip !< center position in x-direction
    1979        INTEGER(iwp), INTENT(IN) :: ir !< right loop boundary
    1980        INTEGER(iwp), INTENT(IN) :: jn !< northern loop boundary
    1981        INTEGER(iwp), INTENT(IN) :: jp !< center position in y-direction
    1982        INTEGER(iwp), INTENT(IN) :: js !< southern loop boundary
    1983        INTEGER(iwp), INTENT(IN) :: kb !< bottom loop boundary
    1984        INTEGER(iwp), INTENT(IN) :: kp !< center position in z-direction
    1985        INTEGER(iwp), INTENT(IN) :: kt !< top loop boundary
    1986 
    1987        INTEGER(iwp) :: i   !< loop index
    1988        INTEGER(iwp) :: j   !< loop index
    1989        INTEGER(iwp) :: k   !< loop index
     2005       INTEGER(iwp), INTENT(IN) ::  il !< left loop boundary
     2006       INTEGER(iwp), INTENT(IN) ::  ip !< center position in x-direction
     2007       INTEGER(iwp), INTENT(IN) ::  ir !< right loop boundary
     2008       INTEGER(iwp), INTENT(IN) ::  jn !< northern loop boundary
     2009       INTEGER(iwp), INTENT(IN) ::  jp !< center position in y-direction
     2010       INTEGER(iwp), INTENT(IN) ::  js !< southern loop boundary
     2011       INTEGER(iwp), INTENT(IN) ::  kb !< bottom loop boundary
     2012       INTEGER(iwp), INTENT(IN) ::  kp !< center position in z-direction
     2013       INTEGER(iwp), INTENT(IN) ::  kt !< top loop boundary
     2014
     2015       INTEGER(iwp) ::  i  !< loop index
     2016       INTEGER(iwp) ::  j  !< loop index
     2017       INTEGER(iwp) ::  k  !< loop index
    19902018
    19912019       DO  i = il, ir
    19922020          DO  j = js, jn
    19932021             DO  k = kb, kt
    1994                 vicinity(k,j,i) = MERGE( 0, 1,               &
    1995                        BTEST( wall_flags_total_0(kp+k,jp+j,ip+i), 0 ) )
     2022                vicinity(k,j,i) = MERGE( 0, 1, BTEST( wall_flags_total_0(kp+k,jp+j,ip+i), 0 ) )
    19962023             ENDDO
    19972024          ENDDO
    … …  
    20032030
    20042031
    2005 !------------------------------------------------------------------------------!
     2032!--------------------------------------------------------------------------------------------------!
    20062033! Description:
    20072034! ------------
    20082035!> Initialize virtual velocities used later in production_e.
    2009 !------------------------------------------------------------------------------!
     2036!--------------------------------------------------------------------------------------------------!
    20102037 SUBROUTINE production_e_init
    20112038
    2012     USE arrays_3d,                                                             &
    2013         ONLY:  drho_air_zw, zu
    2014 
    2015     USE control_parameters,                                                    &
     2039    USE arrays_3d,                                                                                 &
     2040        ONLY:  drho_air_zw,                                                                        &
     2041               zu
     2042
     2043    USE control_parameters,                                                                        &
    20162044        ONLY:  constant_flux_layer
    20172045
    2018     USE surface_layer_fluxes_mod,                                              &
     2046    USE surface_layer_fluxes_mod,                                                                  &
    20192047        ONLY:  phi_m
    20202048
    20212049    IMPLICIT NONE
    20222050
    2023     INTEGER(iwp) ::  i      !< grid index x-direction
    2024     INTEGER(iwp) ::  j      !< grid index y-direction
    2025     INTEGER(iwp) ::  k      !< grid index z-direction
    2026     INTEGER(iwp) ::  m      !< running index surface elements
    2027 
    2028     REAL(wp) ::  km_sfc     !< diffusion coefficient, used to compute virtual velocities
     2051    INTEGER(iwp) ::  i  !< grid index x-direction
     2052    INTEGER(iwp) ::  j  !< grid index y-direction
     2053    INTEGER(iwp) ::  k  !< grid index z-direction
     2054    INTEGER(iwp) ::  m  !< running index surface elements
     2055
     2056    REAL(wp) ::  km_sfc  !< diffusion coefficient, used to compute virtual velocities
    20292057
    20302058    IF ( constant_flux_layer )  THEN
    20312059!
    2032 !--    Calculate a virtual velocity at the surface in a way that the
    2033 !--    vertical velocity gradient at k = 1 (u(k+1)-u_0) matches the
    2034 !--    Prandtl law (-w'u'/km). This gradient is used in the TKE shear
    2035 !--    production term at k=1 (see production_e_ij).
    2036 !--    The velocity gradient has to be limited in case of too small km
    2037 !--    (otherwise the timestep may be significantly reduced by large
    2038 !--    surface winds).
    2039 !--    not available in case of non-cyclic boundary conditions.
     2060!--    Calculate a virtual velocity at the surface in a way that the vertical velocity gradient at
     2061!--    k = 1 (u(k+1)-u_0) matches the Prandtl law (-w'u'/km). This gradient is used in the TKE shear
     2062!--    production term at k=1 (see production_e_ij). The velocity gradient has to be limited in case
     2063!--    of too small km (otherwise the timestep may be significantly reduced by large surface winds).
     2064!--    Not available in case of non-cyclic boundary conditions.
    20402065!--    Default surfaces, upward-facing
    20412066       !$OMP PARALLEL DO PRIVATE(i,j,k,m)
    … …  
    20482073          k = surf_def_h(0)%k(m)
    20492074!
    2050 !--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v
    2051 !--       and km are not on the same grid. Actually, a further
    2052 !--       interpolation of km onto the u/v-grid is necessary. However, the
     2075!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
     2076!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
    20532077!--       effect of this error is negligible.
    2054           km_sfc = kappa * surf_def_h(0)%us(m) * surf_def_h(0)%z_mo(m) /       &
     2078          km_sfc = kappa * surf_def_h(0)%us(m) * surf_def_h(0)%z_mo(m) /                           &
    20552079                   phi_m( surf_def_h(0)%z_mo(m) / surf_def_h(0)%ol(m) )
    20562080
    2057           surf_def_h(0)%u_0(m) = u(k+1,j,i) + surf_def_h(0)%usws(m) *          &
    2058                                      drho_air_zw(k-1)               *          &
    2059                                      ( zu(k+1) - zu(k-1)    )       /          &
    2060                                      ( km_sfc  + 1.0E-20_wp )
    2061           surf_def_h(0)%v_0(m) = v(k+1,j,i) + surf_def_h(0)%vsws(m) *          &
    2062                                      drho_air_zw(k-1)               *          &
    2063                                      ( zu(k+1) - zu(k-1)    )       /          &
    2064                                      ( km_sfc  + 1.0E-20_wp )
    2065 
    2066           IF ( ABS( u(k+1,j,i) - surf_def_h(0)%u_0(m) )  >                     &
    2067                ABS( u(k+1,j,i) - u(k-1,j,i)           )                        &
    2068              )  surf_def_h(0)%u_0(m) = u(k-1,j,i)
    2069 
    2070           IF ( ABS( v(k+1,j,i) - surf_def_h(0)%v_0(m) )  >                     &
    2071                ABS( v(k+1,j,i) - v(k-1,j,i)           )                        &
    2072              )  surf_def_h(0)%v_0(m) = v(k-1,j,i)
     2081          surf_def_h(0)%u_0(m) = u(k+1,j,i) + surf_def_h(0)%usws(m) * drho_air_zw(k-1) *           &
     2082                                 ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
     2083          surf_def_h(0)%v_0(m) = v(k+1,j,i) + surf_def_h(0)%vsws(m) * drho_air_zw(k-1) *           &
     2084                                 ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
     2085
     2086          IF ( ABS( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )         &
     2087             surf_def_h(0)%u_0(m) = u(k-1,j,i)
     2088
     2089          IF ( ABS( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )         &
     2090             surf_def_h(0)%v_0(m) = v(k-1,j,i)
    20732091
    20742092       ENDDO
    … …  
    20842102          k = surf_def_h(1)%k(m)
    20852103!
    2086 !--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v
    2087 !--       and km are not on the same grid. Actually, a further
    2088 !--       interpolation of km onto the u/v-grid is necessary. However, the
     2104!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
     2105!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
    20892106!--       effect of this error is negligible.
    2090           surf_def_h(1)%u_0(m) = u(k-1,j,i) - surf_def_h(1)%usws(m) *          &
    2091                                      drho_air_zw(k-1) *                        &
    2092                                      ( zu(k+1)    - zu(k-1)    )  /            &
    2093                                      ( km(k,j,i)  + 1.0E-20_wp )
    2094           surf_def_h(1)%v_0(m) = v(k-1,j,i) - surf_def_h(1)%vsws(m) *          &
    2095                                      drho_air_zw(k-1) *                        &
    2096                                      ( zu(k+1)    - zu(k-1)    )  /            &
    2097                                      ( km(k,j,i)  + 1.0E-20_wp )
    2098 
    2099           IF ( ABS( surf_def_h(1)%u_0(m) - u(k-1,j,i) )  >                     &
    2100                ABS( u(k+1,j,i)           - u(k-1,j,i) )                        &
    2101              )  surf_def_h(1)%u_0(m) = u(k+1,j,i)
    2102 
    2103           IF ( ABS( surf_def_h(1)%v_0(m) - v(k-1,j,i) )  >                     &
    2104                ABS( v(k+1,j,i)           - v(k-1,j,i) )                        &
    2105              )  surf_def_h(1)%v_0(m) = v(k+1,j,i)
     2107          surf_def_h(1)%u_0(m) = u(k-1,j,i) - surf_def_h(1)%usws(m) * drho_air_zw(k-1) *           &
     2108                                     ( zu(k+1) - zu(k-1) ) / ( km(k,j,i) + 1.0E-20_wp )
     2109          surf_def_h(1)%v_0(m) = v(k-1,j,i) - surf_def_h(1)%vsws(m) * drho_air_zw(k-1) *           &
     2110                                     ( zu(k+1) - zu(k-1) ) / (km(k,j,i) + 1.0E-20_wp )
     2111
     2112          IF ( ABS( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )         &
     2113             surf_def_h(1)%u_0(m) = u(k+1,j,i)
     2114
     2115          IF ( ABS( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )         &
     2116             surf_def_h(1)%v_0(m) = v(k+1,j,i)
    21062117
    21072118       ENDDO
    … …  
    21172128          k = surf_lsm_h%k(m)
    21182129!
    2119 !--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v
    2120 !--       and km are not on the same grid. Actually, a further
    2121 !--       interpolation of km onto the u/v-grid is necessary. However, the
     2130!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
     2131!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
    21222132!--       effect of this error is negligible.
    2123           km_sfc = kappa * surf_lsm_h%us(m) * surf_lsm_h%z_mo(m) /             &
     2133          km_sfc = kappa * surf_lsm_h%us(m) * surf_lsm_h%z_mo(m) /                                 &
    21242134                   phi_m( surf_lsm_h%z_mo(m) / surf_lsm_h%ol(m) )
    21252135
    2126           surf_lsm_h%u_0(m) = u(k+1,j,i) + surf_lsm_h%usws(m)    *             &
    2127                                         drho_air_zw(k-1)         *             &
    2128                                         ( zu(k+1) - zu(k-1)    ) /             &
    2129                                         ( km_sfc  + 1.0E-20_wp )
    2130           surf_lsm_h%v_0(m) = v(k+1,j,i) + surf_lsm_h%vsws(m)    *             &
    2131                                         drho_air_zw(k-1)         *             &
    2132                                         ( zu(k+1) - zu(k-1)    ) /             &
    2133                                         ( km_sfc  + 1.0E-20_wp )
    2134 
    2135           IF ( ABS( u(k+1,j,i) - surf_lsm_h%u_0(m) )  >                        &
    2136                ABS( u(k+1,j,i) - u(k-1,j,i)   )                                &
    2137              )  surf_lsm_h%u_0(m) = u(k-1,j,i)
    2138 
    2139           IF ( ABS( v(k+1,j,i) - surf_lsm_h%v_0(m) )  >                        &
    2140                ABS( v(k+1,j,i) - v(k-1,j,i)   )                                &
    2141              )  surf_lsm_h%v_0(m) = v(k-1,j,i)
     2136          surf_lsm_h%u_0(m) = u(k+1,j,i) + surf_lsm_h%usws(m) * drho_air_zw(k-1) *                 &
     2137                              ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
     2138          surf_lsm_h%v_0(m) = v(k+1,j,i) + surf_lsm_h%vsws(m) * drho_air_zw(k-1) *                 &
     2139                                        ( zu(k+1) - zu(k-1)) / ( km_sfc  + 1.0E-20_wp )
     2140
     2141          IF ( ABS( u(k+1,j,i) - surf_lsm_h%u_0(m) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )            &
     2142             surf_lsm_h%u_0(m) = u(k-1,j,i)
     2143
     2144          IF ( ABS( v(k+1,j,i) - surf_lsm_h%v_0(m) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )            &
     2145             surf_lsm_h%v_0(m) = v(k-1,j,i)
    21422146
    21432147       ENDDO
    … …  
    21532157          k = surf_usm_h%k(m)
    21542158!
    2155 !--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v
    2156 !--       and km are not on the same grid. Actually, a further
    2157 !--       interpolation of km onto the u/v-grid is necessary. However, the
     2159!--       Note, calculation of u_0 and v_0 is not fully accurate, as u/v and km are not on the same
     2160!--       grid. Actually, a further interpolation of km onto the u/v-grid is necessary. However, the
    21582161!--       effect of this error is negligible.
    2159           km_sfc = kappa * surf_usm_h%us(m) * surf_usm_h%z_mo(m) /             &
     2162          km_sfc = kappa * surf_usm_h%us(m) * surf_usm_h%z_mo(m) /                                 &
    21602163                   phi_m( surf_usm_h%z_mo(m) / surf_usm_h%ol(m) )
    21612164
    2162           surf_usm_h%u_0(m) = u(k+1,j,i) + surf_usm_h%usws(m)    *             &
    2163                                         drho_air_zw(k-1)         *             &
    2164                                         ( zu(k+1) - zu(k-1)    ) /             &
    2165                                         ( km_sfc  + 1.0E-20_wp )
    2166           surf_usm_h%v_0(m) = v(k+1,j,i) + surf_usm_h%vsws(m)    *             &
    2167                                         drho_air_zw(k-1)         *             &
    2168                                         ( zu(k+1) - zu(k-1)    ) /             &
    2169                                         ( km_sfc  + 1.0E-20_wp )
    2170 
    2171           IF ( ABS( u(k+1,j,i) - surf_usm_h%u_0(m) )  >                        &
    2172                ABS( u(k+1,j,i) - u(k-1,j,i)   )                                &
    2173              )  surf_usm_h%u_0(m) = u(k-1,j,i)
    2174 
    2175           IF ( ABS( v(k+1,j,i) - surf_usm_h%v_0(m) )  >                        &
    2176                ABS( v(k+1,j,i) - v(k-1,j,i)   )                                &
    2177              )  surf_usm_h%v_0(m) = v(k-1,j,i)
     2165          surf_usm_h%u_0(m) = u(k+1,j,i) + surf_usm_h%usws(m) * drho_air_zw(k-1) *                 &
     2166                                        ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
     2167          surf_usm_h%v_0(m) = v(k+1,j,i) + surf_usm_h%vsws(m) * drho_air_zw(k-1) *                 &
     2168                                        ( zu(k+1) - zu(k-1) ) / ( km_sfc  + 1.0E-20_wp )
     2169
     2170          IF ( ABS( u(k+1,j,i) - surf_usm_h%u_0(m) ) > ABS( u(k+1,j,i) - u(k-1,j,i) ) )            &
     2171             surf_usm_h%u_0(m) = u(k-1,j,i)
     2172
     2173          IF ( ABS( v(k+1,j,i) - surf_usm_h%v_0(m) ) > ABS( v(k+1,j,i) - v(k-1,j,i) ) )            &
     2174             surf_usm_h%v_0(m) = v(k-1,j,i)
    21782175
    21792176       ENDDO
    … …  
    21922189
    21932190
    2194     CHARACTER (LEN=*) ::  location !<
     2191    CHARACTER(LEN=*) ::  location !<
    21952192
    21962193!    INTEGER(iwp) ::  i !<
    … …  
    22002197!
    22012198!-- Here the module-specific actions follow
    2202 !-- No calls for single grid points are allowed at locations before and
    2203 !-- after the timestep, since these calls are not within an i,j-loop
     2199!-- No calls for single grid points are allowed at locations before and after the timestep, since
     2200!-- these calls are not within an i, j-loop
    22042201    SELECT CASE ( location )
    22052202
    … …  
    22582255
    22592256
    2260     CHARACTER (LEN=*) ::  location
    2261 
    2262     INTEGER(iwp) ::  i
    2263     INTEGER(iwp) ::  j
     2257    CHARACTER(LEN=*) ::  location  !<
     2258
     2259    INTEGER(iwp) ::  i  !<
     2260    INTEGER(iwp) ::  j  !<
    22642261
    22652262!
    … …  
    23012298
    23022299
    2303 !------------------------------------------------------------------------------!
     2300!--------------------------------------------------------------------------------------------------!
    23042301! Description:
    23052302! ------------
    2306 !> Prognostic equation for subgrid-scale TKE and TKE dissipation rate.
    2307 !> Vector-optimized version
    2308 !------------------------------------------------------------------------------!
     2303!> Prognostic equation for subgrid-scale TKE and TKE dissipation rate. Vector-optimized version
     2304!--------------------------------------------------------------------------------------------------!
    23092305 SUBROUTINE tcm_prognostic_equations
    23102306
    2311     USE control_parameters,                                                    &
    2312         ONLY:  scalar_advec, tsc
     2307    USE control_parameters,                                                                        &
     2308        ONLY:  scalar_advec,                                                                       &
     2309               tsc
    23132310
    23142311    IMPLICIT NONE
    23152312
    2316     INTEGER(iwp) ::  i       !< loop index
    2317     INTEGER(iwp) ::  j       !< loop index
    2318     INTEGER(iwp) ::  k       !< loop index
    2319 
    2320     REAL(wp)     ::  sbt     !< wheighting factor for sub-time step
    2321 
    2322 !
    2323 !-- If required, compute prognostic equation for turbulent kinetic
    2324 !-- energy (TKE)
     2313    INTEGER(iwp) ::  i  !< loop index
     2314    INTEGER(iwp) ::  j  !< loop index
     2315    INTEGER(iwp) ::  k  !< loop index
     2316
     2317    REAL(wp)     ::  sbt  !< wheighting factor for sub-time step
     2318
     2319!
     2320!-- If required, compute prognostic equation for turbulent kinetic energy (TKE)
    23252321    IF ( .NOT. constant_diffusion )  THEN
    23262322
    … …  
    23542350             IF ( timestep_scheme(1:5) == 'runge' )  THEN
    23552351                IF ( ws_scheme_sca )  THEN
    2356                    CALL advec_s_ws( advc_flags_s, e, 'e',                      &
    2357                                     bc_dirichlet_l  .OR.  bc_radiation_l,      &
    2358                                     bc_dirichlet_n  .OR.  bc_radiation_n,      &
    2359                                     bc_dirichlet_r  .OR.  bc_radiation_r,      &
    2360                                     bc_dirichlet_s  .OR.  bc_radiation_s )
     2352                   CALL advec_s_ws( advc_flags_s, e, 'e', bc_dirichlet_l  .OR.  bc_radiation_l,    &
     2353                                                          bc_dirichlet_n  .OR.  bc_radiation_n,    &
     2354                                                          bc_dirichlet_r  .OR.  bc_radiation_r,    &
     2355                                                          bc_dirichlet_s  .OR.  bc_radiation_s )
    23612356                ELSE
    23622357                   CALL advec_s_pw( e )
    … …  
    23892384!
    23902385!--    Prognostic equation for TKE.
    2391 !--    Eliminate negative TKE values, which can occur due to numerical
    2392 !--    reasons in the course of the integration. In such cases the old TKE
    2393 !--    value is reduced by 90%.
     2386!--    Eliminate negative TKE values, which can occur due to numerical reasons in the course of the
     2387!--    integration. In such cases the old TKE value is reduced by 90%.
    23942388       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    23952389       !$ACC PRESENT(e, tend, te_m, wall_flags_total_0) &
    … …  
    23982392       DO  i = nxl, nxr
    23992393          DO  j = nys, nyn
    2400              !following directive is required to vectorize on Intel19
     2394             !Following directive is required to vectorize on Intel19
    24012395             !DIR$ IVDEP
    24022396             DO  k = nzb+1, nzt
    2403                 e_p(k,j,i) = e(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +        &
    2404                                                  tsc(3) * te_m(k,j,i) )        &
    2405                                         )                                      &
    2406                                    * MERGE( 1.0_wp, 0.0_wp,                    &
    2407                                        BTEST( wall_flags_total_0(k,j,i), 0 )   &
    2408                                           )
     2397                e_p(k,j,i) = e(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) ) )   &
     2398                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    24092399                IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
    24102400             ENDDO
    … …  
    24252415                ENDDO
    24262416             ENDDO
    2427           ELSEIF ( intermediate_timestep_count < &
    2428                    intermediate_timestep_count_max )  THEN
     2417          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    24292418             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
    24302419             !$ACC PRESENT(tend, te_m)
    … …  
    24322421                DO  j = nys, nyn
    24332422                   DO  k = nzb+1, nzt
    2434                       te_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                 &
    2435                                      + 5.3125_wp * te_m(k,j,i)
     2423                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
    24362424                   ENDDO
    24372425                ENDDO
    … …  
    24662454
    24672455!
    2468 !--    dissipation-tendency terms with no communication
     2456!--    Dissipation-tendency terms with no communication
    24692457       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
    24702458          IF ( use_upstream_for_tke )  THEN
    … …  
    24752463             IF ( timestep_scheme(1:5) == 'runge' )  THEN
    24762464                IF ( ws_scheme_sca )  THEN
    2477                    CALL advec_s_ws( advc_flags_s, diss, 'diss',                &
    2478                                     bc_dirichlet_l  .OR.  bc_radiation_l,      &
    2479                                     bc_dirichlet_n  .OR.  bc_radiation_n,      &
    2480                                     bc_dirichlet_r  .OR.  bc_radiation_r,      &
     2465                   CALL advec_s_ws( advc_flags_s, diss, 'diss',                                    &
     2466                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
     2467                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
     2468                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
    24812469                                    bc_dirichlet_s  .OR.  bc_radiation_s )
    24822470                ELSE
    … …  
    25022490!
    25032491!--    Prognostic equation for TKE dissipation.
    2504 !--    Eliminate negative dissipation values, which can occur due to numerical
    2505 !--    reasons in the course of the integration. In such cases the old
    2506 !--    dissipation value is reduced by 90%.
     2492!--    Eliminate negative dissipation values, which can occur due to numerical reasons in the course
     2493!--    of the integration. In such cases the old dissipation value is reduced by 90%.
    25072494       DO  i = nxl, nxr
    25082495          DO  j = nys, nyn
    25092496             DO  k = nzb+1, nzt
    2510                 diss_p(k,j,i) = diss(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +  &
    2511                                                  tsc(3) * tdiss_m(k,j,i) )     &
    2512                                         )                                      &
    2513                                    * MERGE( 1.0_wp, 0.0_wp,                    &
    2514                                        BTEST( wall_flags_total_0(k,j,i), 0 )   &
    2515                                           )
    2516                 IF ( diss_p(k,j,i) < 0.0_wp )                                  &
    2517                    diss_p(k,j,i) = 0.1_wp * diss(k,j,i)
     2497                diss_p(k,j,i) = diss(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3)               &
     2498                                                          * tdiss_m(k,j,i) ) )                     &
     2499                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     2500                IF ( diss_p(k,j,i) < 0.0_wp )  diss_p(k,j,i) = 0.1_wp * diss(k,j,i)
    25182501             ENDDO
    25192502          ENDDO
    … …  
    25312514                ENDDO
    25322515             ENDDO
    2533           ELSEIF ( intermediate_timestep_count < &
    2534                    intermediate_timestep_count_max )  THEN
     2516          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    25352517             DO  i = nxl, nxr
    25362518                DO  j = nys, nyn
    25372519                   DO  k = nzb+1, nzt
    2538                       tdiss_m(k,j,i) =   -9.5625_wp * tend(k,j,i)              &
    2539                                         + 5.3125_wp * tdiss_m(k,j,i)
     2520                      tdiss_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tdiss_m(k,j,i)
    25402521                   ENDDO
    25412522                ENDDO
    … …  
    25512532
    25522533
    2553 !------------------------------------------------------------------------------!
     2534!--------------------------------------------------------------------------------------------------!
    25542535! Description:
    25552536! ------------
    2556 !> Prognostic equation for subgrid-scale TKE and TKE dissipation rate.
    2557 !> Cache-optimized version
    2558 !------------------------------------------------------------------------------!
     2537!> Prognostic equation for subgrid-scale TKE and TKE dissipation rate. Cache-optimized version
     2538!--------------------------------------------------------------------------------------------------!
    25592539 SUBROUTINE tcm_prognostic_equations_ij( i, j, i_omp, tn )
    25602540
    2561     USE arrays_3d,                                                             &
    2562         ONLY:  diss_l_diss, diss_l_e, diss_s_diss, diss_s_e, flux_l_diss,      &
    2563                flux_l_e, flux_s_diss, flux_s_e
    2564 
    2565     USE control_parameters,                                                    &
     2541    USE arrays_3d,                                                                                 &
     2542        ONLY:  diss_l_diss,                                                                        &
     2543               diss_l_e,                                                                           &
     2544               diss_s_diss,                                                                        &
     2545               diss_s_e,                                                                           &
     2546               flux_l_diss,                                                                        &
     2547               flux_l_e,                                                                           &
     2548               flux_s_diss,                                                                        &
     2549               flux_s_e
     2550
     2551    USE control_parameters,                                                                        &
    25662552        ONLY:  tsc
    25672553
    25682554    IMPLICIT NONE
    25692555
    2570     INTEGER(iwp) ::  i       !< loop index x direction
    2571     INTEGER(iwp) ::  i_omp   !< first loop index of i-loop in prognostic_equations
    2572     INTEGER(iwp) ::  j       !< loop index y direction
    2573     INTEGER(iwp) ::  k       !< loop index z direction
    2574     INTEGER(iwp) ::  tn      !< task number of openmp task
    2575 
    2576 !
    2577 !-- If required, compute prognostic equation for turbulent kinetic
    2578 !-- energy (TKE)
     2556    INTEGER(iwp) ::  i      !< loop index x direction
     2557    INTEGER(iwp) ::  i_omp  !< first loop index of i-loop in prognostic_equations
     2558    INTEGER(iwp) ::  j      !< loop index y direction
     2559    INTEGER(iwp) ::  k      !< loop index z direction
     2560    INTEGER(iwp) ::  tn     !< task number of openmp task
     2561
     2562!
     2563!-- If required, compute prognostic equation for turbulent kinetic energy (TKE)
    25792564    IF ( .NOT. constant_diffusion )  THEN
    25802565
    … …  
    25822567!--    Tendency-terms for TKE
    25832568       tend(:,j,i) = 0.0_wp
    2584        IF ( timestep_scheme(1:5) == 'runge'  &
    2585            .AND.  .NOT. use_upstream_for_tke )  THEN
     2569       IF ( timestep_scheme(1:5) == 'runge'  .AND.  .NOT. use_upstream_for_tke )  THEN
    25862570           IF ( ws_scheme_sca )  THEN
    2587                CALL advec_s_ws( advc_flags_s,                                  &
    2588                                 i, j, e, 'e', flux_s_e, diss_s_e,              &
    2589                                 flux_l_e, diss_l_e , i_omp, tn,                &
    2590                                 bc_dirichlet_l  .OR.  bc_radiation_l,          &
    2591                                 bc_dirichlet_n  .OR.  bc_radiation_n,          &
    2592                                 bc_dirichlet_r  .OR.  bc_radiation_r,          &
     2571               CALL advec_s_ws( advc_flags_s, i, j, e, 'e', flux_s_e, diss_s_e, flux_l_e,          &
     2572                                diss_l_e , i_omp, tn,                                              &
     2573                                bc_dirichlet_l  .OR.  bc_radiation_l,                              &
     2574                                bc_dirichlet_n  .OR.  bc_radiation_n,                              &
     2575                                bc_dirichlet_r  .OR.  bc_radiation_r,                              &
    25932576                                bc_dirichlet_s  .OR.  bc_radiation_s )
    25942577           ELSE
    … …  
    26192602!
    26202603!--    Prognostic equation for TKE.
    2621 !--    Eliminate negative TKE values, which can occur due to numerical
    2622 !--    reasons in the course of the integration. In such cases the old
    2623 !--    TKE value is reduced by 90%.
     2604!--    Eliminate negative TKE values, which can occur due to numerical reasons in the course of the
     2605!--    integration. In such cases the old TKE value is reduced by 90%.
    26242606       DO  k = nzb+1, nzt
    2625           e_p(k,j,i) = e(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) +           &
    2626                                               tsc(3) * te_m(k,j,i) )           &
    2627                                   )                                            &
    2628                                  * MERGE( 1.0_wp, 0.0_wp,                      &
    2629                                     BTEST( wall_flags_total_0(k,j,i), 0 )      &
    2630                                         )
     2607          e_p(k,j,i) = e(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * te_m(k,j,i) ) )      &
     2608                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    26312609          IF ( e_p(k,j,i) <= 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
    26322610       ENDDO
    … …  
    26392617                te_m(k,j,i) = tend(k,j,i)
    26402618             ENDDO
    2641           ELSEIF ( intermediate_timestep_count < &
    2642                    intermediate_timestep_count_max )  THEN
     2619          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    26432620             DO  k = nzb+1, nzt
    2644                 te_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +                     &
    2645                                  5.3125_wp * te_m(k,j,i)
     2621                te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
    26462622             ENDDO
    26472623          ENDIF
    … …  
    26562632!--    Tendency-terms for dissipation
    26572633       tend(:,j,i) = 0.0_wp
    2658        IF ( timestep_scheme(1:5) == 'runge'  &
    2659            .AND.  .NOT. use_upstream_for_tke )  THEN
     2634       IF ( timestep_scheme(1:5) == 'runge'  .AND.  .NOT. use_upstream_for_tke )  THEN
    26602635           IF ( ws_scheme_sca )  THEN
    2661                CALL advec_s_ws( advc_flags_s,                                  &
    2662                                 i, j, diss, 'diss', flux_s_diss, diss_s_diss,  &
    2663                                 flux_l_diss, diss_l_diss, i_omp, tn,           &
    2664                                 bc_dirichlet_l  .OR.  bc_radiation_l,          &
    2665                                 bc_dirichlet_n  .OR.  bc_radiation_n,          &
    2666                                 bc_dirichlet_r  .OR.  bc_radiation_r,          &
     2636               CALL advec_s_ws( advc_flags_s, i, j, diss, 'diss', flux_s_diss, diss_s_diss,        &
     2637                                flux_l_diss, diss_l_diss, i_omp, tn,                               &
     2638                                bc_dirichlet_l  .OR.  bc_radiation_l,                              &
     2639                                bc_dirichlet_n  .OR.  bc_radiation_n,                              &
     2640                                bc_dirichlet_r  .OR.  bc_radiation_r,                              &
    26672641                                bc_dirichlet_s  .OR.  bc_radiation_s )
    26682642           ELSE
    … …  
    26862660!
    26872661!--    Prognostic equation for TKE dissipation
    2688 !--    Eliminate negative dissipation values, which can occur due to
    2689 !--    numerical reasons in the course of the integration. In such cases
    2690 !--    the old dissipation value is reduced by 90%.
     2662!--    Eliminate negative dissipation values, which can occur due to numerical reasons in the course
     2663!--    of the integration. In such cases the old dissipation value is reduced by 90%.
    26912664       DO  k = nzb+1, nzt
    2692           diss_p(k,j,i) = diss(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) +     &
    2693                                                     tsc(3) * tdiss_m(k,j,i) )  &
    2694                                         )                                      &
    2695                                         * MERGE( 1.0_wp, 0.0_wp,               &
    2696                                           BTEST( wall_flags_total_0(k,j,i), 0 )&
    2697                                                )
     2665          diss_p(k,j,i) = diss(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3)                  &
     2666                          * tdiss_m(k,j,i) ) )                                                     &
     2667                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    26982668       ENDDO
    26992669
    … …  
    27052675                tdiss_m(k,j,i) = tend(k,j,i)
    27062676             ENDDO
    2707           ELSEIF ( intermediate_timestep_count < &
    2708                    intermediate_timestep_count_max )  THEN
     2677          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
    27092678             DO  k = nzb+1, nzt
    2710                 tdiss_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +                  &
    2711                                     5.3125_wp * tdiss_m(k,j,i)
     2679                tdiss_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tdiss_m(k,j,i)
    27122680             ENDDO
    27132681          ENDIF
    27142682       ENDIF
    27152683
    2716     ENDIF   ! dissipation equation
     2684    ENDIF   ! Dissipation equation
    27172685
    27182686 END SUBROUTINE tcm_prognostic_equations_ij
    27192687
    27202688
    2721 !------------------------------------------------------------------------------!
     2689!--------------------------------------------------------------------------------------------------!
    27222690! Description:
    27232691! ------------
    27242692!> Production terms (shear + buoyancy) of the TKE.
    27252693!> Vector-optimized version
    2726 !> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is
    2727 !>          not considered well!
    2728 !------------------------------------------------------------------------------!
     2694!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is not considered well!
     2695!--------------------------------------------------------------------------------------------------!
    27292696 SUBROUTINE production_e( diss_production )
    27302697
    2731     USE arrays_3d,                                                             &
    2732         ONLY:  ddzw, dd2zu, drho_air_zw, q, ql, d_exner, exner
    2733 
    2734     USE control_parameters,                                                    &
    2735         ONLY:  cloud_droplets, constant_flux_layer, neutral,                   &
    2736                rho_reference, use_single_reference_value, use_surface_fluxes,  &
     2698    USE arrays_3d,                                                                                 &
     2699        ONLY:  ddzw,                                                                               &
     2700               dd2zu,                                                                              &
     2701               d_exner,                                                                            &
     2702               drho_air_zw,                                                                        &
     2703               exner,                                                                              &
     2704               q,                                                                                  &
     2705               ql
     2706
     2707
     2708
     2709    USE control_parameters,                                                                        &
     2710        ONLY:  cloud_droplets,                                                                     &
     2711               constant_flux_layer,                                                                &
     2712               neutral,                                                                            &
     2713               rho_reference,                                                                      &
     2714               use_single_reference_value,                                                         &
     2715               use_surface_fluxes,                                                                 &
    27372716               use_top_fluxes
    27382717
    2739     USE grid_variables,                                                        &
    2740         ONLY:  ddx, dx, ddy, dy
    2741 
    2742     USE bulk_cloud_model_mod,                                                  &
     2718    USE grid_variables,                                                                            &
     2719        ONLY:  ddx,                                                                                &
     2720               dx,                                                                                 &
     2721               ddy,                                                                                &
     2722               dy
     2723
     2724    USE bulk_cloud_model_mod,                                                                      &
    27432725        ONLY:  bulk_cloud_model
    27442726
    27452727    IMPLICIT NONE
    27462728
    2747     LOGICAL :: diss_production
    2748 
    2749     INTEGER(iwp) ::  i       !< running index x-direction
    2750     INTEGER(iwp) ::  j       !< running index y-direction
    2751     INTEGER(iwp) ::  k       !< running index z-direction
    2752     INTEGER(iwp) ::  l       !< running index for different surface type orientation
    2753     INTEGER(iwp) ::  m       !< running index surface elements
    2754     INTEGER(iwp) ::  surf_e  !< end index of surface elements at given i-j position
    2755     INTEGER(iwp) ::  surf_s  !< start index of surface elements at given i-j position
    2756     INTEGER(iwp) ::  flag_nr !< number of masking flag
     2729    LOGICAL ::  diss_production  !<
     2730
     2731    INTEGER(iwp) ::  flag_nr  !< number of masking flag
     2732    INTEGER(iwp) ::  i        !< running index x-direction
     2733    INTEGER(iwp) ::  j        !< running index y-direction
     2734    INTEGER(iwp) ::  k        !< running index z-direction
     2735    INTEGER(iwp) ::  l        !< running index for different surface type orientation
     2736    INTEGER(iwp) ::  m        !< running index surface elements
     2737    INTEGER(iwp) ::  surf_e   !< end index of surface elements at given i-j position
     2738    INTEGER(iwp) ::  surf_s   !< start index of surface elements at given i-j position
    27572739
    27582740    REAL(wp)     ::  def         !< ( du_i/dx_j + du_j/dx_i ) * du_i/dx_j
    … …  
    27612743    REAL(wp)     ::  k2          !< temporary factor
    27622744    REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
     2745    REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
    27632746    REAL(wp)     ::  theta       !< virtual potential temperature
    27642747    REAL(wp)     ::  temp        !< theta * Exner-function
    2765     REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
    27662748    REAL(wp)     ::  usvs        !< momentum flux u"v"
    27672749    REAL(wp)     ::  vsus        !< momentum flux v"u"
    … …  
    27692751    REAL(wp)     ::  wsvs        !< momentum flux w"v"
    27702752
    2771     REAL(wp), DIMENSION(nzb+1:nzt) ::  dudx  !< Gradient of u-component in x-direction
    2772     REAL(wp), DIMENSION(nzb+1:nzt) ::  dudy  !< Gradient of u-component in y-direction
    2773     REAL(wp), DIMENSION(nzb+1:nzt) ::  dudz  !< Gradient of u-component in z-direction
    2774     REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdx  !< Gradient of v-component in x-direction
    2775     REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdy  !< Gradient of v-component in y-direction
    2776     REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdz  !< Gradient of v-component in z-direction
    2777     REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdx  !< Gradient of w-component in x-direction
    2778     REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdy  !< Gradient of w-component in y-direction
    2779     REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdz  !< Gradient of w-component in z-direction
     2753    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudx      !< Gradient of u-component in x-direction
     2754    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudy      !< Gradient of u-component in y-direction
     2755    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudz      !< Gradient of u-component in z-direction
     2756    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdx      !< Gradient of v-component in x-direction
     2757    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdy      !< Gradient of v-component in y-direction
     2758    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdz      !< Gradient of v-component in z-direction
     2759    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdx      !< Gradient of w-component in x-direction
     2760    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdy      !< Gradient of w-component in y-direction
     2761    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdz      !< Gradient of w-component in z-direction
    27802762    REAL(wp), DIMENSION(nzb+1:nzt) ::  tmp_flux  !< temporary flux-array in z-direction
    27812763
    … …  
    27832765
    27842766!
    2785 !-- Calculate TKE production by shear. Calculate gradients at all grid
    2786 !-- points first, gradients at surface-bounded grid points will be
    2787 !-- overwritten further below.
     2767!-- Calculate TKE production by shear. Calculate gradients at all grid points first, gradients at
     2768!-- surface-bounded grid points will be overwritten further below.
    27882769    !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, l) &
    27892770    !$ACC PRIVATE(surf_s, surf_e) &
    … …  
    28002781
    28012782             dudx(k) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    2802              dudy(k) = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) -                 &
    2803                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    2804              dudz(k) = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) -                 &
    2805                                    u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    2806 
    2807              dvdx(k) = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) -                 &
    2808                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
     2783             dudy(k) = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
     2784             dudz(k) = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
     2785
     2786             dvdx(k) = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    28092787             dvdy(k) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    2810              dvdz(k) = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) -                 &
    2811                                      v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    2812 
    2813              dwdx(k) = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) -                 &
    2814                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    2815              dwdy(k) = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) -                 &
    2816                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
     2788             dvdz(k) = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
     2789
     2790             dwdx(k) = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
     2791             dwdy(k) = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    28172792             dwdz(k) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    28182793
    … …  
    28322807!--          'bottom and wall: use u_0,v_0 and wall functions'
    28332808!
    2834 !--          Compute gradients at north- and south-facing surfaces.
    2835 !--          First, for default surfaces, then for urban surfaces.
    2836 !--          Note, so far no natural vertical surfaces implemented
     2809!--          Compute gradients at north- and south-facing surfaces. First, for default surfaces,
     2810!--          then for urban surfaces. Note, so far no natural vertical surfaces implemented
    28372811             DO  l = 0, 1
    28382812                surf_s = surf_def_v(l)%start_index(j,i)
    … …  
    28442818                   wsvs        = surf_def_v(l)%mom_flux_tke(1,m)
    28452819
    2846                    km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp         &
    2847                                       * 0.5_wp * dy
     2820                   km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
    28482821!
    28492822!--                -1.0 for right-facing wall, 1.0 for left-facing wall
    2850                    sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    2851                               BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
     2823                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
    28522824                   dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
    28532825                   dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
    … …  
    28632835                   wsvs        = surf_lsm_v(l)%mom_flux_tke(1,m)
    28642836
    2865                    km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp         &
    2866                                       * 0.5_wp * dy
     2837                   km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
    28672838!
    28682839!--                -1.0 for right-facing wall, 1.0 for left-facing wall
    2869                    sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    2870                               BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
     2840                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
    28712841                   dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
    28722842                   dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
    … …  
    28822852                   wsvs        = surf_usm_v(l)%mom_flux_tke(1,m)
    28832853
    2884                    km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp         &
    2885                                       * 0.5_wp * dy
     2854                   km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
    28862855!
    28872856!--                -1.0 for right-facing wall, 1.0 for left-facing wall
    2888                    sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    2889                               BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
     2857                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
    28902858                   dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
    28912859                   dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
    … …  
    29032871                   wsus  = surf_def_v(l)%mom_flux_tke(1,m)
    29042872
    2905                    km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp         &
    2906                                       * 0.5_wp * dx
     2873                   km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
    29072874!
    29082875!--                -1.0 for right-facing wall, 1.0 for left-facing wall
    2909                    sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    2910                               BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
     2876                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
    29112877                   dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
    29122878                   dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
    … …  
    29222888                   wsus  = surf_lsm_v(l)%mom_flux_tke(1,m)
    29232889
    2924                    km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp         &
    2925                                       * 0.5_wp * dx
     2890                   km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
    29262891!
    29272892!--                -1.0 for right-facing wall, 1.0 for left-facing wall
    2928                    sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    2929                               BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
     2893                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
    29302894                   dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
    29312895                   dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
    … …  
    29412905                   wsus  = surf_usm_v(l)%mom_flux_tke(1,m)
    29422906
    2943                    km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp         &
    2944                                       * 0.5_wp * dx
     2907                   km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
    29452908!
    29462909!--                -1.0 for right-facing wall, 1.0 for left-facing wall
    2947                    sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    2948                               BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
     2910                   sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
    29492911                   dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
    29502912                   dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
    … …  
    29592921                k = surf_def_h(0)%k(m)
    29602922!
    2961 !--             Please note, actually, an interpolation of u_0 and v_0
    2962 !--             onto the grid center would be required. However, this
    2963 !--             would require several data transfers between 2D-grid and
    2964 !--             wall type. The effect of this missing interpolation is
    2965 !--             negligible. (See also production_e_init).
     2923!--             Please note, actually, an interpolation of u_0 and v_0 onto the grid center would be
     2924!--             required. However, this would require several data transfers between 2D-grid and
     2925!--             wall type. The effect of this missing interpolation is negligible.
     2926!--            (See also production_e_init).
    29662927                dudz(k) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)
    29672928                dvdz(k) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
    … …  
    29932954             ENDDO
    29942955!
    2995 !--          Compute gradients at downward-facing walls, only for
    2996 !--          non-natural default surfaces
     2956!--          Compute gradients at downward-facing walls, only for non-natural default surfaces
    29972957             surf_s = surf_def_h(1)%start_index(j,i)
    29982958             surf_e = surf_def_h(1)%end_index(j,i)
    … …  
    30132973          DO  k = nzb+1, nzt
    30142974
    3015              def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) +         &
    3016                               dudy(k)**2 + dvdx(k)**2 + dwdx(k)**2 +           &
    3017                               dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2 +           &
    3018                    2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) +              &
    3019                               dwdy(k)*dvdz(k) )
     2975             def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) + dudy(k)**2 + dvdx(k)**2 +   &
     2976                   dwdx(k)**2 + dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2 +                             &
     2977                   2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) + dwdy(k)*dvdz(k) )
    30202978
    30212979             IF ( def < 0.0_wp )  def = 0.0_wp
    … …  
    30312989
    30322990!--             RANS mode: Compute tendency for dissipation-rate-production from shear
    3033                 tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag *           &
    3034                               diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_1
     2991                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag * diss(k,j,i) /                 &
     2992                              ( e(k,j,i) + 1.0E-20_wp ) * c_1
    30352993
    30362994             ENDIF
    … …  
    30503008          IF ( ocean_mode )  THEN
    30513009!
    3052 !--          So far in the ocean no special treatment of density flux
    3053 !--          in the bottom and top surface layer
     3010!--          So far in the ocean no special treatment of density flux in the bottom and top surface
     3011!--          layer
    30543012             DO  i = nxl, nxr
    30553013                DO  j = nys, nyn
    … …  
    30593017                   ENDDO
    30603018!
    3061 !--                Treatment of near-surface grid points, at up- and down-
    3062 !--                ward facing surfaces
     3019!--                Treatment of near-surface grid points, at up- and down-ward facing surfaces
    30633020                   IF ( use_surface_fluxes )  THEN
    30643021                      DO  l = 0, 1
    … …  
    30853042!--                   Compute tendency for TKE-production from shear
    30863043                      DO  k = nzb+1, nzt
    3087                          flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3088                          tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3089                                        MERGE( rho_reference, prho(k,j,i),       &
     3044                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3045                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
     3046                                       MERGE( rho_reference, prho(k,j,i),                          &
    30903047                                              use_single_reference_value ) )
    30913048                      ENDDO
    … …  
    30953052!--                   RANS mode: Compute tendency for dissipation-rate-production from shear
    30963053                      DO  k = nzb+1, nzt
    3097                          flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3098                          tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3099                                        MERGE( rho_reference, prho(k,j,i),       &
    3100                                               use_single_reference_value ) ) *  &
    3101                                        diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *  &
    3102                                        c_3
     3054                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3055                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
     3056                                       MERGE( rho_reference, prho(k,j,i),                          &
     3057                                              use_single_reference_value ) ) *                     &
     3058                                       diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *  c_3
    31033059                      ENDDO
    31043060
    … …  
    31733129                     !$ACC LOOP PRIVATE(k, flag)
    31743130                      DO  k = nzb+1, nzt
    3175                          flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3176                          tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3177                                        MERGE( pt_reference, pt(k,j,i),          &
     3131                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3132                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
     3133                                       MERGE( pt_reference, pt(k,j,i),                             &
    31783134                                              use_single_reference_value ) )
    31793135                      ENDDO
    … …  
    31833139!--                   RANS mode: Compute tendency for dissipation-rate-production from shear
    31843140                      DO  k = nzb+1, nzt
    3185                          flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3186                          tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3187                                        MERGE( pt_reference, pt(k,j,i),          &
    3188                                               use_single_reference_value ) ) *  &
    3189                                        diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *  &
    3190                                        c_3
     3141                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3142                         tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                    &
     3143                                       MERGE( pt_reference, pt(k,j,i),                             &
     3144                                              use_single_reference_value ) ) *                     &
     3145                                       diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
    31913146                      ENDDO
    31923147
    … …  
    31963151             ENDDO
    31973152
    3198           ENDIF ! from IF ( .NOT. ocean_mode )
    3199 
    3200        ELSE ! or IF ( humidity )  THEN
     3153          ENDIF ! From IF ( .NOT. ocean_mode )
     3154
     3155       ELSE ! Or IF ( humidity )  THEN
    32013156
    32023157          DO  i = nxl, nxr
    … …  
    32053160                DO  k = nzb+1, nzt
    32063161
    3207                    IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3162                   IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets )  THEN
    32083163                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    32093164                      k2 = 0.61_wp * pt(k,j,i)
    3210                       tmp_flux(k) = -1.0_wp * kh(k,j,i) *                      &
    3211                                       ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
    3212                                         k2 * ( q(k+1,j,i)  - q(k-1,j,i) )      &
    3213                                       ) * dd2zu(k)
     3165                      tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
     3166                                                            k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) )    &
     3167                                    * dd2zu(k)
    32143168                   ELSE IF ( bulk_cloud_model )  THEN
    32153169                      IF ( ql(k,j,i) == 0.0_wp )  THEN
    … …  
    32193173                         theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    32203174                         temp  = theta * exner(k)
    3221                          k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                  &
    3222                                        ( q(k,j,i) - ql(k,j,i) ) *              &
    3223                               ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /        &
    3224                               ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *         &
     3175                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *           &
     3176                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                            &
     3177                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                             &
    32253178                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    32263179                         k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    32273180                      ENDIF
    3228                       tmp_flux(k) = -1.0_wp * kh(k,j,i) *                      &
    3229                                       ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
    3230                                         k2 * ( q(k+1,j,i)  - q(k-1,j,i) )      &
    3231                                       ) * dd2zu(k)
     3181                      tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
     3182                                                            k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) )    &
     3183                                    * dd2zu(k)
    32323184                   ELSE IF ( cloud_droplets )  THEN
    32333185                      k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
    32343186                      k2 = 0.61_wp * pt(k,j,i)
    3235                       tmp_flux(k) = -1.0_wp * kh(k,j,i) * &
    3236                                       ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
    3237                                         k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) -    &
    3238                                         pt(k,j,i) * ( ql(k+1,j,i) -            &
    3239                                         ql(k-1,j,i) ) ) * dd2zu(k)
     3187                      tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
     3188                                                            k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) -    &
     3189                                                            pt(k,j,i) * ( ql(k+1,j,i) -            &
     3190                                                            ql(k-1,j,i) ) ) * dd2zu(k)
    32403191                   ENDIF
    32413192
    … …  
    32513202                         k = surf_def_h(l)%k(m)
    32523203
    3253                          IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3204                         IF (  .NOT.  bulk_cloud_model  .AND.  .NOT.  cloud_droplets ) THEN
    32543205                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    32553206                            k2 = 0.61_wp * pt(k,j,i)
    … …  
    32613212                               theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    32623213                               temp  = theta * exner(k)
    3263                                k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
    3264                                           ( q(k,j,i) - ql(k,j,i) ) *           &
    3265                                  ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /     &
    3266                                  ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *      &
    3267                                  ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
     3214                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *     &
     3215                                    ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                      &
     3216                                    ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                       &
     3217                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    32683218                               k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    32693219                            ENDIF
    … …  
    32733223                         ENDIF
    32743224
    3275                          tmp_flux(k) = ( k1 * surf_def_h(l)%shf(m) +           &
    3276                                          k2 * surf_def_h(l)%qsws(m)            &
    3277                                        ) * drho_air_zw(k-1)
     3225                         tmp_flux(k) = ( k1 * surf_def_h(l)%shf(m) + k2 * surf_def_h(l)%qsws(m) )  &
     3226                                         * drho_air_zw(k-1)
    32783227                      ENDDO
    32793228                   ENDDO
    … …  
    32853234                      k = surf_lsm_h%k(m)
    32863235
    3287                       IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3236                      IF (  .NOT.  bulk_cloud_model  .AND.  .NOT.  cloud_droplets ) THEN
    32883237                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    32893238                         k2 = 0.61_wp * pt(k,j,i)
    … …  
    32953244                            theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    32963245                            temp  = theta * exner(k)
    3297                             k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    3298                                           ( q(k,j,i) - ql(k,j,i) ) *           &
    3299                                  ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /     &
    3300                                  ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *      &
     3246                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *        &
     3247                                 ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                         &
     3248                                 ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                          &
    33013249                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    33023250                            k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    … …  
    33073255                      ENDIF
    33083256
    3309                       tmp_flux(k) = ( k1 * surf_lsm_h%shf(m) +                 &
    3310                                       k2 * surf_lsm_h%qsws(m)                  &
    3311                                     ) * drho_air_zw(k-1)
     3257                      tmp_flux(k) = ( k1 * surf_lsm_h%shf(m) + k2 * surf_lsm_h%qsws(m) )           &
     3258                                    * drho_air_zw(k-1)
    33123259                   ENDDO
    33133260!
    … …  
    33183265                      k = surf_usm_h%k(m)
    33193266
    3320                       IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3267                      IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    33213268                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    33223269                         k2 = 0.61_wp * pt(k,j,i)
    … …  
    33283275                            theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    33293276                            temp  = theta * exner(k)
    3330                             k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    3331                                           ( q(k,j,i) - ql(k,j,i) ) *           &
    3332                                  ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /     &
    3333                                  ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *      &
     3277                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *        &
     3278                                 ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                         &
     3279                                 ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                          &
    33343280                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    33353281                            k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    … …  
    33403286                      ENDIF
    33413287
    3342                       tmp_flux(k) = ( k1 * surf_usm_h%shf(m) +                 &
    3343                                       k2 * surf_usm_h%qsws(m)                  &
    3344                                     ) * drho_air_zw(k-1)
     3288                      tmp_flux(k) = ( k1 * surf_usm_h%shf(m) + k2 * surf_usm_h%qsws(m) )           &
     3289                                    * drho_air_zw(k-1)
    33453290                   ENDDO
    33463291
    3347                 ENDIF ! from IF ( use_surface_fluxes )  THEN
     3292                ENDIF ! From IF ( use_surface_fluxes )  THEN
    33483293
    33493294                IF ( use_top_fluxes )  THEN
    … …  
    33543299                      k = surf_def_h(2)%k(m)
    33553300
    3356                       IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3301                      IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    33573302                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    33583303                         k2 = 0.61_wp * pt(k,j,i)
    … …  
    33643309                            theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    33653310                            temp  = theta * exner(k)
    3366                             k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    3367                                        ( q(k,j,i) - ql(k,j,i) ) *              &
    3368                               ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /        &
    3369                               ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *         &
     3311                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *        &
     3312                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                            &
     3313                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                             &
    33703314                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    33713315                            k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    … …  
    33763320                      ENDIF
    33773321
    3378                       tmp_flux(k) = ( k1 * surf_def_h(2)%shf(m) +              &
    3379                                       k2 * surf_def_h(2)%qsws(m)               &
    3380                                     ) * drho_air_zw(k)
     3322                      tmp_flux(k) = ( k1 * surf_def_h(2)%shf(m) + k2 * surf_def_h(2)%qsws(m) )     &
     3323                                    * drho_air_zw(k)
    33813324
    33823325                   ENDDO
    33833326
    3384                 ENDIF ! from IF ( use_top_fluxes )  THEN
     3327                ENDIF ! From IF ( use_top_fluxes )  THEN
    33853328
    33863329                IF ( .NOT. diss_production )  THEN
    … …  
    33883331!--                Compute tendency for TKE-production from shear
    33893332                   DO  k = nzb+1, nzt
    3390                       flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3391                       tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3392                                     MERGE( vpt_reference, vpt(k,j,i),          &
    3393                                            use_single_reference_value ) )
     3333                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3334                      tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                       &
     3335                                    MERGE( vpt_reference, vpt(k,j,i), use_single_reference_value ) )
    33943336                   ENDDO
    33953337
    … …  
    33983340!--                RANS mode: Compute tendency for dissipation-rate-production from shear
    33993341                   DO  k = nzb+1, nzt
    3400                       flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3401                       tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /   &
    3402                                     MERGE( vpt_reference, vpt(k,j,i),          &
    3403                                            use_single_reference_value ) ) *    &
    3404                                     diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *    &
    3405                                     c_3
     3342                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3343                      tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) *                             &
     3344                                    ( g / MERGE( vpt_reference, vpt(k,j,i),                        &
     3345                                                  use_single_reference_value ) )                   &
     3346                                   * diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
    34063347                   ENDDO
    34073348
    … …  
    34183359
    34193360
    3420 !------------------------------------------------------------------------------!
     3361!--------------------------------------------------------------------------------------------------!
    34213362! Description:
    34223363! ------------
    34233364!> Production terms (shear + buoyancy) of the TKE.
    34243365!> Cache-optimized version
    3425 !> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is
    3426 !>          not considered well!
    3427 !------------------------------------------------------------------------------!
     3366!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is not considered well!
     3367!--------------------------------------------------------------------------------------------------!
    34283368 SUBROUTINE production_e_ij( i, j, diss_production )
    34293369
    3430     USE arrays_3d,                                                             &
    3431         ONLY:  ddzw, dd2zu, drho_air_zw, q, ql, d_exner, exner
    3432 
    3433     USE control_parameters,                                                    &
    3434         ONLY:  cloud_droplets, constant_flux_layer, neutral,                   &
    3435                rho_reference, use_single_reference_value, use_surface_fluxes,  &
     3370    USE arrays_3d,                                                                                 &
     3371        ONLY:  ddzw,                                                                               &
     3372               dd2zu,                                                                              &
     3373               drho_air_zw,                                                                        &
     3374               d_exner,                                                                            &
     3375               exner,                                                                              &
     3376               q,                                                                                  &
     3377               ql
     3378
     3379
     3380
     3381    USE control_parameters,                                                                        &
     3382        ONLY:  cloud_droplets,                                                                     &
     3383               constant_flux_layer,                                                                &
     3384               neutral,                                                                            &
     3385               rho_reference,                                                                      &
     3386               use_single_reference_value,                                                         &
     3387               use_surface_fluxes,                                                                 &
    34363388               use_top_fluxes
    34373389
    3438     USE grid_variables,                                                        &
    3439         ONLY:  ddx, dx, ddy, dy
    3440 
    3441     USE bulk_cloud_model_mod,                                                  &
     3390    USE grid_variables,                                                                            &
     3391        ONLY:  ddx,                                                                                &
     3392               dx,                                                                                 &
     3393               ddy,                                                                                &
     3394               dy
     3395
     3396    USE bulk_cloud_model_mod,                                                                      &
    34423397        ONLY:  bulk_cloud_model
    34433398
    34443399    IMPLICIT NONE
    34453400
    3446     LOGICAL :: diss_production
    3447 
    3448     INTEGER(iwp) ::  i       !< running index x-direction
    3449     INTEGER(iwp) ::  j       !< running index y-direction
    3450     INTEGER(iwp) ::  k       !< running index z-direction
    3451     INTEGER(iwp) ::  l       !< running index for different surface type orientation
    3452     INTEGER(iwp) ::  m       !< running index surface elements
    3453     INTEGER(iwp) ::  surf_e  !< end index of surface elements at given i-j position
    3454     INTEGER(iwp) ::  surf_s  !< start index of surface elements at given i-j position
    3455     INTEGER(iwp) ::  flag_nr !< number of masking flag
     3401    LOGICAL ::  diss_production  !<
     3402
     3403    INTEGER(iwp) ::  flag_nr  !< number of masking flag
     3404    INTEGER(iwp) ::  i        !< running index x-direction
     3405    INTEGER(iwp) ::  j        !< running index y-direction
     3406    INTEGER(iwp) ::  k        !< running index z-direction
     3407    INTEGER(iwp) ::  l        !< running index for different surface type orientation
     3408    INTEGER(iwp) ::  m        !< running index surface elements
     3409    INTEGER(iwp) ::  surf_e   !< end index of surface elements at given i-j position
     3410    INTEGER(iwp) ::  surf_s   !< start index of surface elements at given i-j position
    34563411
    34573412    REAL(wp)     ::  def         !< ( du_i/dx_j + du_j/dx_i ) * du_i/dx_j
    … …  
    34603415    REAL(wp)     ::  k2          !< temporary factor
    34613416    REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
     3417    REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
    34623418    REAL(wp)     ::  theta       !< virtual potential temperature
    34633419    REAL(wp)     ::  temp        !< theta * Exner-function
    3464     REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation
    34653420    REAL(wp)     ::  usvs        !< momentum flux u"v"
    34663421    REAL(wp)     ::  vsus        !< momentum flux v"u"
    … …  
    34683423    REAL(wp)     ::  wsvs        !< momentum flux w"v"
    34693424
    3470     REAL(wp), DIMENSION(nzb+1:nzt) ::  dudx  !< Gradient of u-component in x-direction
    3471     REAL(wp), DIMENSION(nzb+1:nzt) ::  dudy  !< Gradient of u-component in y-direction
    3472     REAL(wp), DIMENSION(nzb+1:nzt) ::  dudz  !< Gradient of u-component in z-direction
    3473     REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdx  !< Gradient of v-component in x-direction
    3474     REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdy  !< Gradient of v-component in y-direction
    3475     REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdz  !< Gradient of v-component in z-direction
    3476     REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdx  !< Gradient of w-component in x-direction
    3477     REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdy  !< Gradient of w-component in y-direction
    3478     REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdz  !< Gradient of w-component in z-direction
     3425    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudx      !< Gradient of u-component in x-direction
     3426    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudy      !< Gradient of u-component in y-direction
     3427    REAL(wp), DIMENSION(nzb+1:nzt) ::  dudz      !< Gradient of u-component in z-direction
     3428    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdx      !< Gradient of v-component in x-direction
     3429    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdy      !< Gradient of v-component in y-direction
     3430    REAL(wp), DIMENSION(nzb+1:nzt) ::  dvdz      !< Gradient of v-component in z-direction
     3431    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdx      !< Gradient of w-component in x-direction
     3432    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdy      !< Gradient of w-component in y-direction
     3433    REAL(wp), DIMENSION(nzb+1:nzt) ::  dwdz      !< Gradient of w-component in z-direction
    34793434    REAL(wp), DIMENSION(nzb+1:nzt) ::  tmp_flux  !< temporary flux-array in z-direction
    34803435
    … …  
    34823437
    34833438!
    3484 !-- Calculate TKE production by shear. Calculate gradients at all grid
    3485 !-- points first, gradients at surface-bounded grid points will be
    3486 !-- overwritten further below.
     3439!-- Calculate TKE production by shear. Calculate gradients at all grid points first, gradients at
     3440!-- surface-bounded grid points will be overwritten further below.
    34873441    DO  k = nzb+1, nzt
    34883442
    34893443       dudx(k) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    3490        dudy(k) = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) -                 &
    3491                              u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    3492        dudz(k) = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) -                 &
    3493                              u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    3494 
    3495        dvdx(k) = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) -                 &
    3496                              v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
     3444       dudy(k) = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
     3445       dudz(k) = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
     3446
     3447       dvdx(k) = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    34973448       dvdy(k) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    3498        dvdz(k) = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) -                 &
    3499                              v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    3500 
    3501        dwdx(k) = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) -                 &
    3502                              w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    3503        dwdy(k) = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) -                 &
    3504                              w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
     3449       dvdz(k) = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
     3450
     3451       dwdx(k) = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
     3452       dwdy(k) = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    35053453       dwdz(k) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    35063454
    … …  
    35173465!--    'bottom and wall: use u_0,v_0 and wall functions'
    35183466!
    3519 !--    Compute gradients at north- and south-facing surfaces.
    3520 !--    First, for default surfaces, then for urban surfaces.
    3521 !--    Note, so far no natural vertical surfaces implemented
     3467!--    Compute gradients at north- and south-facing surfaces. First, for default surfaces, then for
     3468!--    urban surfaces. Note, so far no natural vertical surfaces implemented
    35223469       DO  l = 0, 1
    35233470          surf_s = surf_def_v(l)%start_index(j,i)
    … …  
    35283475             wsvs        = surf_def_v(l)%mom_flux_tke(1,m)
    35293476
    3530              km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp         &
    3531                                 * 0.5_wp * dy
     3477             km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
    35323478!
    35333479!--          -1.0 for right-facing wall, 1.0 for left-facing wall
    3534              sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    3535                         BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
     3480             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
    35363481             dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
    35373482             dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
    … …  
    35463491             wsvs        = surf_lsm_v(l)%mom_flux_tke(1,m)
    35473492
    3548              km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp         &
    3549                                 * 0.5_wp * dy
     3493             km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
    35503494!
    35513495!--          -1.0 for right-facing wall, 1.0 for left-facing wall
    3552              sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    3553                         BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
     3496             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
    35543497             dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
    35553498             dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
    … …  
    35643507             wsvs        = surf_usm_v(l)%mom_flux_tke(1,m)
    35653508
    3566              km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp         &
    3567                                 * 0.5_wp * dy
     3509             km_neutral = kappa * ( usvs**2 + wsvs**2 )**0.25_wp * 0.5_wp * dy
    35683510!
    35693511!--          -1.0 for right-facing wall, 1.0 for left-facing wall
    3570              sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    3571                         BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
     3512             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) )
    35723513             dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
    35733514             dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp )
    … …  
    35843525             wsus  = surf_def_v(l)%mom_flux_tke(1,m)
    35853526
    3586              km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp         &
    3587                                 * 0.5_wp * dx
     3527             km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
    35883528!
    35893529!--          -1.0 for right-facing wall, 1.0 for left-facing wall
    3590              sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    3591                         BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
     3530             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
    35923531             dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
    35933532             dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
    … …  
    36023541             wsus  = surf_lsm_v(l)%mom_flux_tke(1,m)
    36033542
    3604              km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp         &
    3605                                 * 0.5_wp * dx
     3543             km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
    36063544!
    36073545!--          -1.0 for right-facing wall, 1.0 for left-facing wall
    3608              sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    3609                         BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
     3546             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
    36103547             dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
    36113548             dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
    … …  
    36203557             wsus  = surf_usm_v(l)%mom_flux_tke(1,m)
    36213558
    3622              km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp         &
    3623                                 * 0.5_wp * dx
     3559             km_neutral = kappa * ( vsus**2 + wsus**2 )**0.25_wp * 0.5_wp * dx
    36243560!
    36253561!--          -1.0 for right-facing wall, 1.0 for left-facing wall
    3626              sign_dir = MERGE( 1.0_wp, -1.0_wp,                          &
    3627                         BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
     3562             sign_dir = MERGE( 1.0_wp, -1.0_wp, BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) )
    36283563             dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
    36293564             dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp )
    … …  
    36373572          k = surf_def_h(0)%k(m)
    36383573!
    3639 !--       Please note, actually, an interpolation of u_0 and v_0
    3640 !--       onto the grid center would be required. However, this
    3641 !--       would require several data transfers between 2D-grid and
    3642 !--       wall type. The effect of this missing interpolation is
    3643 !--       negligible. (See also production_e_init).
     3574!--       Please note, actually, an interpolation of u_0 and v_0 onto the grid center would be
     3575!--       required. However, this would require several data transfers between 2D-grid and wall
     3576!--       type. The effect of this missing interpolation is negligible. (See also production_e_init).
    36443577          dudz(k) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)
    36453578          dvdz(k) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
    … …  
    36693602       ENDDO
    36703603!
    3671 !--    Compute gradients at downward-facing walls, only for
    3672 !--    non-natural default surfaces
     3604!--    Compute gradients at downward-facing walls, only for non-natural default surfaces
    36733605       surf_s = surf_def_h(1)%start_index(j,i)
    36743606       surf_e = surf_def_h(1)%end_index(j,i)
    … …  
    36853617    DO  k = nzb+1, nzt
    36863618
    3687        def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) +         &
    3688                         dudy(k)**2 + dvdx(k)**2 + dwdx(k)**2 +           &
    3689                         dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2 +           &
    3690              2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) +              &
    3691                         dwdy(k)*dvdz(k) )
     3619       def = 2.0_wp * ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 ) +                                   &
     3620                        dudy(k)**2 + dvdx(k)**2 + dwdx(k)**2 +                                     &
     3621                        dwdy(k)**2 + dudz(k)**2 + dvdz(k)**2 +                                     &
     3622             2.0_wp * ( dvdx(k)*dudy(k) + dwdx(k)*dudz(k) + dwdy(k)*dvdz(k) )
    36923623
    36933624       IF ( def < 0.0_wp )  def = 0.0_wp
    … …  
    37033634
    37043635!--       RANS mode: Compute tendency for dissipation-rate-production from shear
    3705           tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag *           &
    3706                         diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_1
     3636          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag *                                     &
     3637                        diss(k,j,i) / ( e(k,j,i) + 1.0E-20_wp ) * c_1
    37073638
    37083639       ENDIF
    … …  
    37183649          IF ( ocean_mode )  THEN
    37193650!
    3720 !--          So far in the ocean no special treatment of density flux
    3721 !--          in the bottom and top surface layer
     3651!--          So far in the ocean no special treatment of density flux in the bottom and top surface
     3652!--          layer
    37223653             DO  k = nzb+1, nzt
    37233654                tmp_flux(k) = kh(k,j,i) * ( prho(k+1,j,i) - prho(k-1,j,i) ) * dd2zu(k)
    37243655             ENDDO
    37253656!
    3726 !--          Treatment of near-surface grid points, at up- and down-
    3727 !--          ward facing surfaces
     3657!--          Treatment of near-surface grid points, at up- and down- ward facing surfaces
    37283658             IF ( use_surface_fluxes )  THEN
    37293659                DO  l = 0, 1
    … …  
    37503680!--             Compute tendency for TKE-production from shear
    37513681                DO  k = nzb+1, nzt
    3752                    flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3753                    tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3754                                  MERGE( rho_reference, prho(k,j,i),       &
    3755                                         use_single_reference_value ) )
     3682                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3683                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
     3684                                 MERGE( rho_reference, prho(k,j,i), use_single_reference_value ) )
    37563685                ENDDO
    37573686
    … …  
    37603689!--             RANS mode: Compute tendency for dissipation-rate-production from shear
    37613690                DO  k = nzb+1, nzt
    3762                    flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3763                    tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3764                                  MERGE( rho_reference, prho(k,j,i),       &
    3765                                         use_single_reference_value ) ) *  &
    3766                                  diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *  &
    3767                                  c_3
     3691                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3692                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
     3693                                 MERGE( rho_reference, prho(k,j,i),                                &
     3694                                 use_single_reference_value ) ) *                                  &
     3695                                 diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
    37683696                ENDDO
    37693697
    … …  
    38193747!--             Compute tendency for TKE-production from shear
    38203748                DO  k = nzb+1, nzt
    3821                    flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3822                    tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3823                                  MERGE( pt_reference, pt(k,j,i),          &
    3824                                         use_single_reference_value ) )
     3749                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3750                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
     3751                                 MERGE( pt_reference, pt(k,j,i), use_single_reference_value ) )
    38253752                ENDDO
    38263753
    … …  
    38293756!--             RANS mode: Compute tendency for dissipation-rate-production from shear
    38303757                DO  k = nzb+1, nzt
    3831                    flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    3832                    tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    3833                                  MERGE( pt_reference, pt(k,j,i),          &
    3834                                         use_single_reference_value ) ) *  &
    3835                                  diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *  &
    3836                                  c_3
     3758                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     3759                   tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                          &
     3760                                 MERGE( pt_reference, pt(k,j,i),                                   &
     3761                                        use_single_reference_value ) ) *                           &
     3762                                 diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
    38373763                ENDDO
    38383764
    38393765             ENDIF
    38403766
    3841           ENDIF ! from IF ( .NOT. ocean_mode )
    3842 
    3843        ELSE ! or IF ( humidity )  THEN
     3767          ENDIF ! From IF ( .NOT. ocean_mode )
     3768
     3769       ELSE ! Or IF ( humidity )  THEN
    38443770
    38453771          DO  k = nzb+1, nzt
    38463772
    3847              IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3773             IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    38483774                k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    38493775                k2 = 0.61_wp * pt(k,j,i)
    3850                 tmp_flux(k) = -1.0_wp * kh(k,j,i) *                      &
    3851                                 ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
    3852                                   k2 * ( q(k+1,j,i)  - q(k-1,j,i) )      &
    3853                                 ) * dd2zu(k)
     3776                tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +         &
     3777                                                      k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) ) * dd2zu(k)
    38543778             ELSE IF ( bulk_cloud_model )  THEN
    38553779                IF ( ql(k,j,i) == 0.0_wp )  THEN
    … …  
    38593783                   theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    38603784                   temp  = theta * exner(k)
    3861                    k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                  &
    3862                                  ( q(k,j,i) - ql(k,j,i) ) *              &
    3863                         ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /        &
    3864                         ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *         &
     3785                   k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *                 &
     3786                        ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                                  &
     3787                        ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                   &
    38653788                        ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    38663789                   k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    38673790                ENDIF
    3868                 tmp_flux(k) = -1.0_wp * kh(k,j,i) *                      &
    3869                                 ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
    3870                                   k2 * ( q(k+1,j,i)  - q(k-1,j,i) )      &
    3871                                 ) * dd2zu(k)
     3791                tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +         &
     3792                                                      k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) ) * dd2zu(k)
    38723793             ELSE IF ( cloud_droplets )  THEN
    38733794                k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
    38743795                k2 = 0.61_wp * pt(k,j,i)
    3875                 tmp_flux(k) = -1.0_wp * kh(k,j,i) * &
    3876                                 ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +   &
    3877                                   k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) -    &
    3878                                   pt(k,j,i) * ( ql(k+1,j,i) -            &
    3879                                   ql(k-1,j,i) ) ) * dd2zu(k)
     3796                tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( k1 * ( pt(k+1,j,i) - pt(k-1,j,i) ) +         &
     3797                                                      k2 * ( q(k+1,j,i)  - q(k-1,j,i) ) -          &
     3798                                                      pt(k,j,i) * ( ql(k+1,j,i) -                  &
     3799                                                      ql(k-1,j,i) ) ) * dd2zu(k)
    38803800             ENDIF
    38813801
    … …  
    38913811                   k = surf_def_h(l)%k(m)
    38923812
    3893                    IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3813                   IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    38943814                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    38953815                      k2 = 0.61_wp * pt(k,j,i)
    … …  
    39013821                         theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    39023822                         temp  = theta * exner(k)
    3903                          k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
    3904                                     ( q(k,j,i) - ql(k,j,i) ) *           &
    3905                            ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /     &
    3906                            ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *      &
    3907                            ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
     3823                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *           &
     3824                              ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                            &
     3825                              ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                             &
     3826                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    39083827                         k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    39093828                      ENDIF
    … …  
    39133832                   ENDIF
    39143833
    3915                    tmp_flux(k) = ( k1 * surf_def_h(l)%shf(m) +           &
    3916                                    k2 * surf_def_h(l)%qsws(m)            &
    3917                                  ) * drho_air_zw(k-1)
     3834                   tmp_flux(k) = ( k1 * surf_def_h(l)%shf(m) + k2 * surf_def_h(l)%qsws(m) ) *      &
     3835                                 drho_air_zw(k-1)
    39183836                ENDDO
    39193837             ENDDO
    … …  
    39253843                k = surf_lsm_h%k(m)
    39263844
    3927                 IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3845                IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    39283846                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    39293847                   k2 = 0.61_wp * pt(k,j,i)
    … …  
    39353853                      theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    39363854                      temp  = theta * exner(k)
    3937                       k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    3938                                     ( q(k,j,i) - ql(k,j,i) ) *           &
    3939                            ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /     &
    3940                            ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *      &
     3855                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *              &
     3856                           ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                               &
     3857                           ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                &
    39413858                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    39423859                      k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    … …  
    39473864                ENDIF
    39483865
    3949                 tmp_flux(k) = ( k1 * surf_lsm_h%shf(m) +                 &
    3950                                 k2 * surf_lsm_h%qsws(m)                  &
    3951                               ) * drho_air_zw(k-1)
     3866                tmp_flux(k) = ( k1 * surf_lsm_h%shf(m) + k2 * surf_lsm_h%qsws(m) ) *               &
     3867                              drho_air_zw(k-1)
    39523868             ENDDO
    39533869!
    … …  
    39583874                k = surf_usm_h%k(m)
    39593875
    3960                 IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3876                IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    39613877                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    39623878                   k2 = 0.61_wp * pt(k,j,i)
    … …  
    39683884                      theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    39693885                      temp  = theta * exner(k)
    3970                       k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    3971                                     ( q(k,j,i) - ql(k,j,i) ) *           &
    3972                            ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /     &
    3973                            ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *      &
     3886                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *              &
     3887                           ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                               &
     3888                           ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                &
    39743889                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    39753890                      k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    … …  
    39803895                ENDIF
    39813896
    3982                 tmp_flux(k) = ( k1 * surf_usm_h%shf(m) +                 &
    3983                                 k2 * surf_usm_h%qsws(m)                  &
    3984                               ) * drho_air_zw(k-1)
    3985              ENDDO
    3986 
    3987           ENDIF ! from IF ( use_surface_fluxes )  THEN
     3897                tmp_flux(k) = ( k1 * surf_usm_h%shf(m) + k2 * surf_usm_h%qsws(m) ) *               &
     3898                              drho_air_zw(k-1)
     3899             ENDDO
     3900
     3901          ENDIF ! From IF ( use_surface_fluxes )  THEN
    39883902
    39893903          IF ( use_top_fluxes )  THEN
    … …  
    39943908                k = surf_def_h(2)%k(m)
    39953909
    3996                 IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN
     3910                IF ( .NOT. bulk_cloud_model  .AND.  .NOT. cloud_droplets ) THEN
    39973911                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
    39983912                   k2 = 0.61_wp * pt(k,j,i)
    … …  
    40043918                      theta = pt(k,j,i) + d_exner(k) * lv_d_cp * ql(k,j,i)
    40053919                      temp  = theta * exner(k)
    4006                       k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
    4007                                  ( q(k,j,i) - ql(k,j,i) ) *              &
    4008                         ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /        &
    4009                         ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *         &
     3920                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp * ( q(k,j,i) - ql(k,j,i) ) *              &
     3921                        ( 1.0_wp + rd_d_rv * lv_d_rd / temp ) ) /                                  &
     3922                        ( 1.0_wp + rd_d_rv * lv_d_rd * lv_d_cp *                                   &
    40103923                        ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
    40113924                      k2 = theta * ( lv_d_cp / temp * k1 - 1.0_wp )
    … …  
    40163929                ENDIF
    40173930
    4018                 tmp_flux(k) = ( k1 * surf_def_h(2)%shf(m) +              &
    4019                                 k2 * surf_def_h(2)%qsws(m)               &
    4020                               ) * drho_air_zw(k)
    4021 
    4022              ENDDO
    4023 
    4024           ENDIF ! from IF ( use_top_fluxes )  THEN
     3931                tmp_flux(k) = ( k1 * surf_def_h(2)%shf(m) + k2 * surf_def_h(2)%qsws(m) ) *         &
     3932                              drho_air_zw(k)
     3933
     3934             ENDDO
     3935
     3936          ENDIF ! From IF ( use_top_fluxes )  THEN
    40253937
    40263938          IF ( .NOT. diss_production )  THEN
    … …  
    40293941             DO  k = nzb+1, nzt
    40303942                flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    4031                 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / &
    4032                               MERGE( vpt_reference, vpt(k,j,i),        &
    4033                                      use_single_reference_value ) )
     3943                tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                             &
     3944                              MERGE( vpt_reference, vpt(k,j,i), use_single_reference_value ) )
    40343945             ENDDO
    40353946
    … …  
    40393950             DO  k = nzb+1, nzt
    40403951                flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) )
    4041                 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /   &
    4042                               MERGE( vpt_reference, vpt(k,j,i),          &
    4043                                      use_single_reference_value ) ) *    &
    4044                               diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) *    &
    4045                               c_3
     3952                tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g /                             &
     3953                              MERGE( vpt_reference, vpt(k,j,i),                                    &
     3954                                     use_single_reference_value ) ) *                              &
     3955                              diss(k,j,i)/( e(k,j,i) + 1.0E-20_wp ) * c_3
    40463956             ENDDO
    40473957
    … …  
    40553965
    40563966
    4057 !------------------------------------------------------------------------------!
     3967!--------------------------------------------------------------------------------------------------!
    40583968! Description:
    40593969! ------------
    40603970!> Diffusion and dissipation terms for the TKE.
    40613971!> Vector-optimized version
    4062 !> @todo Try to avoid the usage of the 3d-array 'diss' where possible (case les
    4063 !>       and rans_tke_l if not wang_kernel, use_sgs_for_particles, or
    4064 !>       collision_turbulence).
    4065 !------------------------------------------------------------------------------!
     3972!> @todo Try to avoid the usage of the 3d-array 'diss' where possible (case les and rans_tke_l if
     3973!> not wang_kernel, use_sgs_for_particles, or collision_turbulence).
     3974!--------------------------------------------------------------------------------------------------!
    40663975 SUBROUTINE diffusion_e( var, var_reference )
    40673976
    4068     USE arrays_3d,                                                             &
    4069         ONLY:  dd2zu, ddzu, ddzw, drho_air, rho_air_zw
    4070 
    4071     USE control_parameters,                                                    &
    4072         ONLY:  atmos_ocean_sign, use_single_reference_value
    4073 
    4074     USE grid_variables,                                                        &
    4075         ONLY:  ddx2, ddy2
    4076 
    4077     USE bulk_cloud_model_mod,                                                  &
     3977    USE arrays_3d,                                                                                 &
     3978        ONLY:  dd2zu,                                                                              &
     3979               ddzu,                                                                               &
     3980               ddzw,                                                                               &
     3981               drho_air,                                                                           &
     3982               rho_air_zw
     3983
     3984    USE control_parameters,                                                                        &
     3985        ONLY:  atmos_ocean_sign,                                                                   &
     3986               use_single_reference_value
     3987
     3988    USE grid_variables,                                                                            &
     3989        ONLY:  ddx2,                                                                               &
     3990               ddy2
     3991
     3992    USE bulk_cloud_model_mod,                                                                      &
    40783993        ONLY:  collision_turbulence
    40793994
    4080     USE particle_attributes,                                                   &
    4081         ONLY:  use_sgs_for_particles, wang_kernel
     3995    USE particle_attributes,                                                                       &
     3996        ONLY:  use_sgs_for_particles,                                                              &
     3997               wang_kernel
    40823998
    40833999    IMPLICIT NONE
    40844000
    4085     INTEGER(iwp) ::  i              !< running index x direction
    4086     INTEGER(iwp) ::  j              !< running index y direction
    4087     INTEGER(iwp) ::  k              !< running index z direction
    4088     INTEGER(iwp) ::  m              !< running index surface elements
     4001    INTEGER(iwp) ::  i  !< running index x direction
     4002    INTEGER(iwp) ::  j  !< running index y direction
     4003    INTEGER(iwp) ::  k  !< running index z direction
     4004    INTEGER(iwp) ::  m  !< running index surface elements
    40894005
    40904006    REAL(wp)     ::  duv2_dz2       !< squared vertical gradient of wind vector
    … …  
    41124028
    41134029                dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    4114                 IF ( dvar_dz > 0.0_wp ) THEN
     4030                IF ( dvar_dz > 0.0_wp )  THEN
    41154031                   IF ( use_single_reference_value )  THEN
    4116                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )         &
    4117                                  / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
     4032                     ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) ) /                           &
     4033                                           SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    41184034                   ELSE
    4119                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )         &
    4120                                  / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
     4035                     ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) ) /                           &
     4036                                           SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    41214037                   ENDIF
    41224038                ELSE
    … …  
    41274043
    41284044!
    4129 !--          ATTENTION: Don't merge the following loop with the previous one, because this would prohibit proper vectorization by
    4130 !--          the Intel18 compiler. This behaviour might change for future compiler versions.
     4045!--          ATTENTION: Don't merge the following loop with the previous one, because this would
     4046!--          prohibit proper vectorization by the Intel18 compiler. This behaviour might change for
     4047!--          future compiler versions.
    41314048             !$ACC LOOP PRIVATE(k)
    41324049             !DIR$ IVDEP
    … …  
    41354052                ml = MIN( delta(k,j,i), ml_stratification(k) )
    41364053
    4137                 diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )           &
    4138                               * e(k,j,i) * SQRT( e(k,j,i) ) / ml                             &
     4054                diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) ) * e(k,j,i)                 &
     4055                              * SQRT( e(k,j,i) ) / ml                                              &
    41394056                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    41404057
    … …  
    41554072             DO  k = nzb+1, nzt
    41564073                dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    4157                 IF ( dvar_dz > 0.0_wp ) THEN
    4158 !
    4159 !--                The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is
    4160 !--                the stratification term. 1E-5 is added as l is zero at the beginning of
    4161 !--                the simulation.
     4074                IF ( dvar_dz > 0.0_wp )  THEN
     4075!
     4076!--                The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is the
     4077!--                stratification term. 1E-5 is added as l is zero at the beginning of the simulation.
    41624078                   IF ( use_single_reference_value )  THEN
    4163                       ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) ) &
     4079                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
    41644080                                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    41654081                   ELSE
    4166                       ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) ) &
     4082                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
    41674083                                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    41684084                   ENDIF
    4169                    ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) ) &
     4085                   ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) )  &
    41704086                                                   + 1.0_wp / ml_stratification(k) )
    41714087                ELSE
    … …  
    41764092
    41774093!
    4178 !--          ATTENTION: Don't merge the following loop with the previous one, because this would prohibit proper vectorization by
    4179 !--          the Intel18 compiler. This behaviour might change for future compiler versions.
     4094!--          ATTENTION: Don't merge the following loop with the previous one, because this would
     4095!--          prohibit proper vectorization by the Intel18 compiler. This behaviour might change for
     4096!--          future compiler versions.
    41804097             !$ACC LOOP PRIVATE(k)
    41814098             !DIR$ IVDEP
    … …  
    41834100
    41844101                ml          = ml_stratification(k)
    4185                 diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                      &
    4186                               * e(k,j,i) * SQRT( e(k,j,i) ) / ml                             &
     4102                diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                            &
     4103                              * e(k,j,i) * SQRT( e(k,j,i) ) / ml                                   &
    41874104                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    41884105
    … …  
    42084125                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    42094126
    4210                    duv2_dz2 =   ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2  &
    4211                               + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2  &
    4212                               + 1E-30_wp
     4127                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
     4128                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
    42134129
    42144130                   rif(k) = MIN( MAX( g / var_reference * dvar_dz / duv2_dz2, -5.0_wp ),  1.0_wp )
    … …  
    42164132             ELSE
    42174133!
    4218 !--             ATTENTION: Don't merge the following loops with the previous one, because this would prohibit proper vectorization
    4219 !--             by the Intel18 compiler. This behaviour might change for future compiler versions.
     4134!--             ATTENTION: Don't merge the following loops with the previous one, because this would
     4135!--             prohibit proper vectorization by the Intel18 compiler. This behaviour might change
     4136!--             for future compiler versions.
    42204137                !$ACC LOOP PRIVATE(k)
    42214138                DO  k = nzb+1, nzt
    … …  
    42234140                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    42244141
    4225                    duv2_dz2 =   ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2  &
    4226                               + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2  &
    4227                               + 1E-30_wp
     4142                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
     4143                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
    42284144
    42294145                   rif(k) = MIN( MAX( g / var(k,j,i) * dvar_dz / duv2_dz2, -5.0_wp ),  1.0_wp )
    … …  
    42454161             DO  k = nzb+1, nzt
    42464162
    4247                 diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) )                         &
    4248                             / MIN( ml_stratification(k), delta(k,j,i) )                    &
     4163                diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) )                                 &
     4164                            / MIN( ml_stratification(k), delta(k,j,i) )                            &
    42494165                            * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    42504166
    … …  
    42544170       ENDDO
    42554171
    4256 !-- Note, in case of rans_tke_e, the dissipation is already calculated
    4257 !-- in prognostic_equations
     4172!-- Note, in case of rans_tke_e, the dissipation is already calculated in prognostic_equations
    42584173    ENDIF
    42594174
    … …  
    42654180          DO  k = nzb+1, nzt
    42664181
    4267              tend(k,j,i) = tend(k,j,i) + (                                            &
    4268                                            (                                          &
    4269                        ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )            &
    4270                      - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )            &
    4271                                            ) * ddx2                                   &
    4272                                          + (                                          &
    4273                        ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )            &
    4274                      - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )            &
    4275                                            ) * ddy2                                   &
    4276                                          + (                                          &
    4277             ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1)           &
    4278                                                           * rho_air_zw(k)             &
    4279           - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)             &
    4280                                                           * rho_air_zw(k-1)           &
    4281                                            ) * ddzw(k) * drho_air(k)                  &
    4282                                          ) * dsig_e                                   &
    4283                                            * MERGE( 1.0_wp, 0.0_wp,                   &
    4284                                              BTEST( wall_flags_total_0(k,j,i), 0 ) )  &
     4182             tend(k,j,i) = tend(k,j,i) + ( ( ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )   &
     4183                                           - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )   &
     4184                                           ) * ddx2                                                &
     4185                                         + ( ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )   &
     4186                                           - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )   &
     4187                                           ) * ddy2                                                &
     4188                                         + ( ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) )   &
     4189                                               * ddzu(k+1) * rho_air_zw(k)                         &
     4190                                         - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) )     &
     4191                                             * ddzu(k) * rho_air_zw(k-1)                           &
     4192                                           ) * ddzw(k) * drho_air(k)                               &
     4193                                         ) * dsig_e * MERGE( 1.0_wp, 0.0_wp,                       &
     4194                                                      BTEST( wall_flags_total_0(k,j,i), 0 ) )      &
    42854195                          - diss(k,j,i)
    42864196
    … …  
    42914201!
    42924202!-- Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:).
    4293 !-- Note, bc cannot be set in tcm_boundary conditions as the dissipation
    4294 !-- in LES mode is only a diagnostic quantity.
    4295     IF ( .NOT. rans_tke_e .AND. ( use_sgs_for_particles  .OR.                  &
    4296          wang_kernel  .OR.  collision_turbulence  ) )  THEN
     4203!-- Note, bc cannot be set in tcm_boundary conditions as the dissipation in LES mode is only a
     4204!-- diagnostic quantity.
     4205    IF ( .NOT. rans_tke_e  .AND.                                                                   &
     4206         ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  collision_turbulence  ) )  THEN
    42974207!
    42984208!--    Upward facing surfaces
    … …  
    43174227
    43184228
    4319 !------------------------------------------------------------------------------!
     4229!--------------------------------------------------------------------------------------------------!
    43204230! Description:
    43214231! ------------
    43224232!> Diffusion and dissipation terms for the TKE.
    43234233!> Cache-optimized version
    4324 !> @todo Try to avoid the usage of the 3d-array 'diss' where possible (case les
    4325 !>       and rans_tke_l if not wang_kernel, use_sgs_for_particles, or
    4326 !>       collision_turbulence).
    4327 !------------------------------------------------------------------------------!
     4234!> @todo Try to avoid the usage of the 3d-array 'diss' where possible (case les and rans_tke_l if
     4235!>  not wang_kernel, use_sgs_for_particles, or collision_turbulence).
     4236!--------------------------------------------------------------------------------------------------!
    43284237 SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
    43294238
    4330     USE arrays_3d,                                                             &
    4331         ONLY:  dd2zu, ddzu, ddzw, drho_air, rho_air_zw
    4332 
    4333     USE control_parameters,                                                    &
    4334         ONLY:  atmos_ocean_sign, use_single_reference_value
    4335 
    4336     USE grid_variables,                                                        &
    4337         ONLY:  ddx2, ddy2
    4338 
    4339     USE bulk_cloud_model_mod,                                                  &
     4239    USE arrays_3d,                                                                                 &
     4240        ONLY:  dd2zu,                                                                              &
     4241               ddzu,                                                                               &
     4242               ddzw,                                                                               &
     4243               drho_air,                                                                           &
     4244               rho_air_zw
     4245
     4246    USE control_parameters,                                                                        &
     4247        ONLY:  atmos_ocean_sign,                                                                   &
     4248               use_single_reference_value
     4249
     4250    USE grid_variables,                                                                            &
     4251        ONLY:  ddx2,                                                                               &
     4252               ddy2
     4253
     4254    USE bulk_cloud_model_mod,                                                                      &
    43404255        ONLY:  collision_turbulence
    43414256
    4342     USE particle_attributes,                                                   &
    4343         ONLY:  use_sgs_for_particles, wang_kernel
     4257    USE particle_attributes,                                                                       &
     4258        ONLY:  use_sgs_for_particles,                                                              &
     4259               wang_kernel
    43444260
    43454261    IMPLICIT NONE
    43464262
    4347     INTEGER(iwp) ::  i              !< running index x direction
    4348     INTEGER(iwp) ::  j              !< running index y direction
    4349     INTEGER(iwp) ::  k              !< running index z direction
    4350     INTEGER(iwp) ::  m              !< running index surface elements
    4351     INTEGER(iwp) ::  surf_e         !< End index of surface elements at (j,i)-gridpoint
    4352     INTEGER(iwp) ::  surf_s         !< Start index of surface elements at (j,i)-gridpoint
     4263    INTEGER(iwp) ::  i       !< running index x direction
     4264    INTEGER(iwp) ::  j       !< running index y direction
     4265    INTEGER(iwp) ::  k       !< running index z direction
     4266    INTEGER(iwp) ::  m       !< running index surface elements
     4267    INTEGER(iwp) ::  surf_e  !< End index of surface elements at (j,i)-gridpoint
     4268    INTEGER(iwp) ::  surf_s  !< Start index of surface elements at (j,i)-gridpoint
    43534269
    43544270    REAL(wp)     ::  duv2_dz2       !< squared vertical gradient of wind vector
    … …  
    43714287          IF ( dvar_dz > 0.0_wp ) THEN
    43724288             IF ( use_single_reference_value )  THEN
    4373                 ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )              &
    4374                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
     4289                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
     4290                                       / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    43754291             ELSE
    4376                 ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )              &
    4377                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
     4292                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
     4293                                       / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    43784294             ENDIF
    43794295          ELSE
    … …  
    43864302          ml  = MIN( delta(k,j,i), ml_stratification(k) )
    43874303
    4388           diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                      &
    4389                         * e(k,j,i) * SQRT( e(k,j,i) ) / ml                             &
     4304          diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                                  &
     4305                        * e(k,j,i) * SQRT( e(k,j,i) ) / ml                                         &
    43904306                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    43914307       ENDDO
    … …  
    43974313          IF ( dvar_dz > 0.0_wp ) THEN
    43984314!
    4399 !--          The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is
    4400 !--          the stratification term. 1E-5 is added as l is zero at the beginning of
    4401 !--          the simulation.
     4315!--          The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is the
     4316!--          stratification term. 1E-5 is added as l is zero at the beginning of the simulation.
    44024317             IF ( use_single_reference_value )  THEN
    4403                 ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                           &
     4318                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
    44044319                                       / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    44054320             ELSE
    4406                 ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                           &
     4321                ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                                  &
    44074322                                       / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    44084323             ENDIF
    44094324
    4410              ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) ) &
     4325             ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) )        &
    44114326                                             + 1.0_wp / ml_stratification(k) )
    44124327
    … …  
    44204335          ml  = ml_stratification(k)
    44214336
    4422           diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                      &
    4423                         * e(k,j,i) * SQRT( e(k,j,i) ) / ml                             &
     4337          diss(k,j,i) = ( 0.19_wp + 0.74_wp * ml / delta(k,j,i) )                                  &
     4338                        * e(k,j,i) * SQRT( e(k,j,i) ) / ml                                         &
    44244339                        * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    44254340       ENDDO
    … …  
    44384353             dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    44394354
    4440              duv2_dz2 =   ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2           &
    4441                         + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2           &
    4442                         + 1E-30_wp
     4355             duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                              &
     4356                      + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
    44434357
    44444358             rif(k) = MIN( MAX( g / var_reference * dvar_dz / duv2_dz2, -5.0_wp ),  1.0_wp )
    … …  
    44484362             dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    44494363
    4450              duv2_dz2 =   ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2           &
    4451                         + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2           &
    4452                         + 1E-30_wp
     4364             duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                              &
     4365                      + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
    44534366
    44544367             rif(k) = MIN( MAX( g / var(k,j,i) * dvar_dz / duv2_dz2, -5.0_wp ), 1.0_wp )
    … …  
    44684381       !DIR$ IVDEP
    44694382       DO  k = nzb+1, nzt
    4470           diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) )                         &
    4471                       / MIN( ml_stratification(k), delta(k,j,i) )                    &
     4383          diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) )                                       &
     4384                      / MIN( ml_stratification(k), delta(k,j,i) )                                  &
    44724385                      * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    44734386       ENDDO
    44744387
    4475 !-- Note, in case of rans_tke_e, the dissipation is already calculated
    4476 !-- in prognostic_equations
     4388!-- Note, in case of rans_tke_e, the dissipation is already calculated in prognostic_equations
    44774389    ENDIF
    44784390
    … …  
    44824394    DO  k = nzb+1, nzt
    44834395
    4484        tend(k,j,i) = tend(k,j,i) + (                                           &
    4485                                       (                                        &
    4486                       ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )      &
    4487                     - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )      &
    4488                                       ) * ddx2                                 &
    4489                                     + (                                        &
    4490                       ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )      &
    4491                     - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )      &
    4492                                       ) * ddy2                                 &
    4493                                     + (                                        &
    4494            ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1)     &
    4495                                                          * rho_air_zw(k)       &
    4496          - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)       &
    4497                                                          * rho_air_zw(k-1)     &
    4498                                       ) * ddzw(k) * drho_air(k)                &
    4499                                    ) * dsig_e                                  &
    4500                                      * MERGE( 1.0_wp, 0.0_wp,                  &
    4501                                         BTEST( wall_flags_total_0(k,j,i), 0 ) )&
    4502                                  - diss(k,j,i)
     4396       tend(k,j,i) = tend(k,j,i) + ( ( ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )         &
     4397                                     - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )         &
     4398                                     ) * ddx2                                                      &
     4399                                   + ( ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )         &
     4400                                     - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )         &
     4401                                     ) * ddy2                                                      &
     4402                                   + ( ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) )         &
     4403                                         * ddzu(k+1) * rho_air_zw(k)                               &
     4404                                     - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) )         &
     4405                                         * ddzu(k) * rho_air_zw(k-1) ) * ddzw(k) * drho_air(k)     &
     4406                                   ) * dsig_e * MERGE( 1.0_wp, 0.0_wp,                             &
     4407                                                BTEST( wall_flags_total_0(k,j,i), 0 ) )            &
     4408                     - diss(k,j,i)
    45034409
    45044410    ENDDO
    45054411
    45064412!
    4507 !-- Set boundary conditions of dissipation if needed for calculating the sgs
    4508 !-- particle velocities.
     4413!-- Set boundary conditions of dissipation if needed for calculating the sgs particle velocities.
    45094414!-- Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
    4510 !-- For each surface type determine start and end index (in case of elevated
    4511 !-- topography several up/downward facing surfaces may exist.
    4512 !-- Note, bc cannot be set in tcm_boundary conditions as the dissipation
    4513 !-- in LES mode is only a diagnostic quantity.
    4514     IF ( .NOT. rans_tke_e .AND.  ( use_sgs_for_particles  .OR.  wang_kernel    &
    4515           .OR.  collision_turbulence ) )  THEN
     4415!-- For each surface type determine start and end index (in case of elevated topography several
     4416!-- up/downward facing surfaces may exist.
     4417!-- Note, bc cannot be set in tcm_boundary conditions as the dissipation in LES mode is only a
     4418!-- diagnostic quantity.
     4419    IF ( .NOT. rans_tke_e  .AND.                                                                   &
     4420         ( use_sgs_for_particles  .OR.  wang_kernel .OR.  collision_turbulence ) )  THEN
    45164421       surf_s = bc_h(0)%start_index(j,i)
    45174422       surf_e = bc_h(0)%end_index(j,i)
    … …  
    45334438
    45344439
    4535 !------------------------------------------------------------------------------!
     4440!--------------------------------------------------------------------------------------------------!
    45364441! Description:
    45374442! ------------
    45384443!> Diffusion term for the TKE dissipation rate
    45394444!> Vector-optimized version
    4540 !------------------------------------------------------------------------------!
     4445!--------------------------------------------------------------------------------------------------!
    45414446 SUBROUTINE diffusion_diss
    4542     USE arrays_3d,                                                             &
    4543         ONLY:  ddzu, ddzw, drho_air, rho_air_zw
    4544 
    4545     USE grid_variables,                                                        &
    4546         ONLY:  ddx2, ddy2
     4447    USE arrays_3d,                                                                                 &
     4448        ONLY:  ddzu,                                                                               &
     4449               ddzw,                                                                               &
     4450               drho_air,                                                                           &
     4451               rho_air_zw
     4452
     4453    USE grid_variables,                                                                            &
     4454        ONLY:  ddx2,                                                                               &
     4455               ddy2
    45474456
    45484457    IMPLICIT NONE
    45494458
    4550     INTEGER(iwp) ::  i              !< running index x direction
    4551     INTEGER(iwp) ::  j              !< running index y direction
    4552     INTEGER(iwp) ::  k              !< running index z direction
    4553 
    4554     REAL(wp)     ::  flag           !< flag to mask topography
     4459    INTEGER(iwp) ::  i  !< running index x direction
     4460    INTEGER(iwp) ::  j  !< running index y direction
     4461    INTEGER(iwp) ::  k  !< running index z direction
     4462
     4463    REAL(wp)     ::  flag  !< flag to mask topography
    45554464
    45564465!
    … …  
    45644473             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    45654474
    4566              tend(k,j,i) = tend(k,j,i) +                                       &
    4567                          (       (                                             &
    4568                  ( km(k,j,i)+km(k,j,i+1) ) * ( diss(k,j,i+1)-diss(k,j,i) )     &
    4569                - ( km(k,j,i)+km(k,j,i-1) ) * ( diss(k,j,i)-diss(k,j,i-1) )     &
    4570                                  ) * ddx2                                      &
    4571                                + (                                             &
    4572                  ( km(k,j,i)+km(k,j+1,i) ) * ( diss(k,j+1,i)-diss(k,j,i) )     &
    4573                - ( km(k,j,i)+km(k,j-1,i) ) * ( diss(k,j,i)-diss(k,j-1,i) )     &
    4574                                  ) * ddy2                                      &
    4575                                + (                                             &
    4576       ( km(k,j,i)+km(k+1,j,i) ) * ( diss(k+1,j,i)-diss(k,j,i) ) * ddzu(k+1)    &
    4577                                                     * rho_air_zw(k)            &
    4578     - ( km(k,j,i)+km(k-1,j,i) ) * ( diss(k,j,i)-diss(k-1,j,i) ) * ddzu(k)      &
    4579                                                     * rho_air_zw(k-1)          &
    4580                                  ) * ddzw(k) * drho_air(k)                     &
    4581                          ) * flag * dsig_diss                                  &
    4582                          - c_2 * diss(k,j,i)**2                                &
    4583                                / ( e(k,j,i) + 1.0E-20_wp ) * flag
     4475             tend(k,j,i) = tend(k,j,i) +                                                           &
     4476                           ( ( ( km(k,j,i)+km(k,j,i+1) ) * ( diss(k,j,i+1)-diss(k,j,i) )           &
     4477                             - ( km(k,j,i)+km(k,j,i-1) ) * ( diss(k,j,i)-diss(k,j,i-1) ) ) * ddx2  &
     4478                           + ( ( km(k,j,i)+km(k,j+1,i) ) * ( diss(k,j+1,i)-diss(k,j,i) )           &
     4479                             - ( km(k,j,i)+km(k,j-1,i) ) * ( diss(k,j,i)-diss(k,j-1,i) ) ) * ddy2  &
     4480                           + ( ( km(k,j,i)+km(k+1,j,i) ) * ( diss(k+1,j,i)-diss(k,j,i) )           &
     4481                               * ddzu(k+1) * rho_air_zw(k)                                         &
     4482                             - ( km(k,j,i)+km(k-1,j,i) ) * ( diss(k,j,i)-diss(k-1,j,i) ) * ddzu(k) &
     4483                               * rho_air_zw(k-1) ) * ddzw(k) * drho_air(k)                         &
     4484                           )  * flag * dsig_diss - c_2 * diss(k,j,i)**2                            &
     4485                              / ( e(k,j,i) + 1.0E-20_wp ) * flag
    45844486
    45854487          ENDDO
    … …  
    45904492
    45914493
    4592 !------------------------------------------------------------------------------!
     4494!--------------------------------------------------------------------------------------------------!
    45934495! Description:
    45944496! ------------
    45954497!> Diffusion term for the TKE dissipation rate
    45964498!> Cache-optimized version
    4597 !------------------------------------------------------------------------------!
     4499!--------------------------------------------------------------------------------------------------!
    45984500 SUBROUTINE diffusion_diss_ij( i, j )
    45994501
    4600     USE arrays_3d,                                                             &
    4601         ONLY:  ddzu, ddzw, drho_air, rho_air_zw
    4602 
    4603     USE grid_variables,                                                        &
    4604         ONLY:  ddx2, ddy2
     4502    USE arrays_3d,                                                                                 &
     4503        ONLY:  ddzu,                                                                               &
     4504               ddzw,                                                                               &
     4505               drho_air,                                                                           &
     4506               rho_air_zw
     4507
     4508    USE grid_variables,                                                                            &
     4509        ONLY:  ddx2,                                                                               &
     4510               ddy2
    46054511
    46064512    IMPLICIT NONE
    46074513
    4608     INTEGER(iwp) ::  i         !< running index x direction
    4609     INTEGER(iwp) ::  j         !< running index y direction
    4610     INTEGER(iwp) ::  k         !< running index z direction
    4611 
    4612     REAL(wp)     ::  flag      !< flag to mask topography
     4514    INTEGER(iwp) ::  i  !< running index x direction
     4515    INTEGER(iwp) ::  j  !< running index y direction
     4516    INTEGER(iwp) ::  k  !< running index z direction
     4517
     4518    REAL(wp)     ::  flag  !< flag to mask topography
    46134519
    46144520!
    … …  
    46224528!
    46234529!--    Calculate the tendency term
    4624        tend(k,j,i) =  tend(k,j,i) +                                            &
    4625                    (            (                                              &
    4626                 ( km(k,j,i)+km(k,j,i+1) ) * ( diss(k,j,i+1)-diss(k,j,i) )      &
    4627               - ( km(k,j,i)+km(k,j,i-1) ) * ( diss(k,j,i)-diss(k,j,i-1) )      &
    4628                                 ) * ddx2                                       &
    4629                               + (                                              &
    4630                 ( km(k,j,i)+km(k,j+1,i) ) * ( diss(k,j+1,i)-diss(k,j,i) )      &
    4631               - ( km(k,j,i)+km(k,j-1,i) ) * ( diss(k,j,i)-diss(k,j-1,i) )      &
    4632                                 ) * ddy2                                       &
    4633                               + (                                              &
    4634      ( km(k,j,i)+km(k+1,j,i) ) * ( diss(k+1,j,i)-diss(k,j,i) ) * ddzu(k+1)     &
    4635                                                    * rho_air_zw(k)             &
    4636    - ( km(k,j,i)+km(k-1,j,i) ) * ( diss(k,j,i)-diss(k-1,j,i) ) * ddzu(k)       &
    4637                                                    * rho_air_zw(k-1)           &
    4638                                 ) * ddzw(k) * drho_air(k)                      &
    4639                    ) * flag * dsig_diss                                        &
    4640                    - c_2 * diss(k,j,i)**2 / ( e(k,j,i) + 1.0E-20_wp ) * flag
     4530       tend(k,j,i) =  tend(k,j,i) +                                                                &
     4531                      ( ( ( km(k,j,i)+km(k,j,i+1) ) * ( diss(k,j,i+1)-diss(k,j,i) )                &
     4532                        - ( km(k,j,i)+km(k,j,i-1) ) * ( diss(k,j,i)-diss(k,j,i-1) ) ) * ddx2       &
     4533                      + ( ( km(k,j,i)+km(k,j+1,i) ) * ( diss(k,j+1,i)-diss(k,j,i) )                &
     4534                        - ( km(k,j,i)+km(k,j-1,i) ) * ( diss(k,j,i)-diss(k,j-1,i) ) ) * ddy2       &
     4535                      + ( ( km(k,j,i)+km(k+1,j,i) ) * ( diss(k+1,j,i)-diss(k,j,i) )                &
     4536                          * ddzu(k+1) * rho_air_zw(k)                                              &
     4537                        - ( km(k,j,i)+km(k-1,j,i) ) * ( diss(k,j,i)-diss(k-1,j,i) )                &
     4538                          * ddzu(k) * rho_air_zw(k-1) ) * ddzw(k) * drho_air(k)                    &
     4539                      )  * flag * dsig_diss - c_2 * diss(k,j,i)**2 / ( e(k,j,i) + 1.0E-20_wp )     &
     4540                         * flag
    46414541
    46424542    ENDDO
    … …  
    46454545
    46464546
    4647 !------------------------------------------------------------------------------!
     4547!--------------------------------------------------------------------------------------------------!
    46484548! Description:
    46494549! ------------
    46504550!> Computation of the turbulent diffusion coefficients for momentum and heat.
    46514551!> @bug unstable stratification is not properly considered for kh in rans mode.
    4652 !------------------------------------------------------------------------------!
     4552!--------------------------------------------------------------------------------------------------!
    46534553 SUBROUTINE tcm_diffusivities( var, var_reference )
    46544554
    4655     USE control_parameters,                                                    &
    4656         ONLY:  bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
     4555    USE control_parameters,                                                                        &
     4556        ONLY:  bc_radiation_l,                                                                     &
     4557               bc_radiation_n,                                                                     &
     4558               bc_radiation_r,                                                                     &
     4559               bc_radiation_s,                                                                     &
    46574560               e_min
    46584561
    4659     USE exchange_horiz_mod,                                                    &
     4562    USE exchange_horiz_mod,                                                                        &
    46604563        ONLY:  exchange_horiz
    46614564
    4662     USE surface_layer_fluxes_mod,                                              &
     4565    USE surface_layer_fluxes_mod,                                                                  &
    46634566        ONLY:  phi_m
    46644567
    4665     INTEGER(iwp) ::  i          !< loop index
    4666     INTEGER(iwp) ::  j          !< loop index
    4667     INTEGER(iwp) ::  k          !< loop index
    4668     INTEGER(iwp) ::  m          !< loop index
    4669     INTEGER(iwp) ::  n          !< loop index
     4568    INTEGER(iwp) ::  i  !< loop index
     4569    INTEGER(iwp) ::  j  !< loop index
     4570    INTEGER(iwp) ::  k  !< loop index
     4571    INTEGER(iwp) ::  m  !< loop index
     4572    INTEGER(iwp) ::  n  !< loop index
    46704573
    46714574    REAL(wp) ::  var_reference  !< reference temperature
    … …  
    46814584          DO  j = nysg, nyng
    46824585             DO  k = nzb+1, nzt
    4683                 e(k,j,i) = MAX( e(k,j,i), e_min ) *                            &
     4586                e(k,j,i) = MAX( e(k,j,i), e_min ) *                                                &
    46844587                        MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    46854588             ENDDO
    … …  
    47094612          j = surf_def_h(0)%j(m)
    47104613          k = surf_def_h(0)%k(m)
    4711           km(k,j,i) = kappa * surf_def_h(0)%us(m) * surf_def_h(0)%z_mo(m) /    &
     4614          km(k,j,i) = kappa * surf_def_h(0)%us(m) * surf_def_h(0)%z_mo(m) /                        &
    47124615                      phi_m( surf_def_h(0)%z_mo(m) / surf_def_h(0)%ol(m) )
    47134616          kh(k,j,i) = 1.35_wp * km(k,j,i)
    … …  
    47204623          j = surf_lsm_h%j(m)
    47214624          k = surf_lsm_h%k(m)
    4722           km(k,j,i) = kappa * surf_lsm_h%us(m) * surf_lsm_h%z_mo(m) /          &
     4625          km(k,j,i) = kappa * surf_lsm_h%us(m) * surf_lsm_h%z_mo(m) /                              &
    47234626                      phi_m( surf_lsm_h%z_mo(m) / surf_lsm_h%ol(m) )
    47244627          kh(k,j,i) = 1.35_wp * km(k,j,i)
    … …  
    47314634          j = surf_usm_h%j(m)
    47324635          k = surf_usm_h%k(m)
    4733           km(k,j,i) = kappa * surf_usm_h%us(m) * surf_usm_h%z_mo(m) /          &
     4636          km(k,j,i) = kappa * surf_usm_h%us(m) * surf_usm_h%z_mo(m) /                              &
    47344637                      phi_m( surf_usm_h%z_mo(m) / surf_usm_h%ol(m) )
    47354638          kh(k,j,i) = 1.35_wp * km(k,j,i)
    … …  
    48144717
    48154718!
    4816 !-- Set Neumann boundary conditions at the outflow boundaries in case of
    4817 !-- non-cyclic lateral boundaries
     4719!-- Set Neumann boundary conditions at the outflow boundaries in case of non-cyclic lateral
     4720!-- boundaries
    48184721    IF ( bc_radiation_l )  THEN
    48194722       km(:,:,nxl-1) = km(:,:,nxl)
    … …  
    48364739
    48374740
    4838 !------------------------------------------------------------------------------!
     4741!--------------------------------------------------------------------------------------------------!
    48394742! Description:
    48404743! ------------
    4841 !> Computation of the turbulent diffusion coefficients for momentum and heat
    4842 !> according to Prandtl-Kolmogorov.
    4843 !------------------------------------------------------------------------------!
     4744!> Computation of the turbulent diffusion coefficients for momentum and heat according to
     4745!> Prandtl-Kolmogorov.
     4746!--------------------------------------------------------------------------------------------------!
    48444747 SUBROUTINE tcm_diffusivities_default( var, var_reference )
    48454748
    4846     USE arrays_3d,                                                             &
     4749    USE arrays_3d,                                                                                 &
    48474750        ONLY:  dd2zu
    48484751
    4849     USE control_parameters,                                                    &
    4850         ONLY:  atmos_ocean_sign, use_single_reference_value
    4851 
    4852     USE statistics,                                                            &
    4853         ONLY :  rmask, sums_l_l
     4752    USE control_parameters,                                                                        &
     4753        ONLY:  atmos_ocean_sign,                                                                   &
     4754               use_single_reference_value
     4755
     4756    USE statistics,                                                                                &
     4757        ONLY :  rmask,                                                                             &
     4758                sums_l_l
    48544759
    48554760    IMPLICIT NONE
    … …  
    49014806!
    49024807!--             Determine the mixing length
    4903 !--             @note The following code cannot be transferred to a subroutine
    4904 !--             due to errors when using OpenACC directives. The execution
    4905 !--             crashes reliably if a subroutine is called at this point (the
    4906 !--             reason for this behaviour is unknown, however).
     4808!--             @note The following code cannot be transferred to a subroutine due to errors when
     4809!--             using OpenACC directives. The execution crashes reliably if a subroutine is called
     4810!--             at this point (the reason for this behaviour is unknown, however).
    49074811                dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    49084812                IF ( dvar_dz > 0.0_wp )  THEN
    49094813                   IF ( use_single_reference_value )  THEN
    4910                       ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )         &
     4814                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
    49114815#if defined( __imuk_old )
    4912                              / SQRT( g / var_reference * ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
     4816                                             / SQRT( g / var_reference *                           &
     4817                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
    49134818#else
    4914                                   / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
     4819                                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    49154820#endif
    49164821                   ELSE
    4917                       ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )         &
     4822                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
    49184823#if defined( __imuk_old )
    4919                              / SQRT( g / var(k,j,i)    * ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
     4824                                             / SQRT( g / var(k,j,i) *                              &
     4825                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
    49204826#else
    4921                                   / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
     4827                                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    49224828#endif
    49234829                   ENDIF
    … …  
    49324838             DO  k = nzb+1, nzt
    49334839
    4934                 ml = MIN( delta(k,j,i), ml_stratification(k) )                    &
     4840                ml = MIN( delta(k,j,i), ml_stratification(k) )                                     &
    49354841                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    49364842                ml_local_profile(k) = ml
    … …  
    49674873                IF ( dvar_dz > 0.0_wp ) THEN
    49684874!
    4969 !--                The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is
    4970 !--                the stratification term. 1E-5 is added as l is zero at the beginning of
    4971 !--                the simulation.
     4875!--                The mixing length is calculated as 1/l = 1/(kappa*z) + 1/Lb, where Lb is the
     4876!--                stratification term. 1E-5 is added as l is zero at the beginning of the
     4877!--                simulation.
    49724878                   IF ( use_single_reference_value )  THEN
    4973                       ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                           &
     4879                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
    49744880#if defined( __imuk_old )
    4975                              / SQRT( g / var_reference * ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
     4881                                             / SQRT( g / var_reference *                           &
     4882                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! Required for intel14
    49764883#else
    4977                                   / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
     4884                                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
    49784885#endif
    49794886                   ELSE
    4980                       ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                           &
     4887                      ml_stratification(k) = 0.76_wp * SQRT( e(k,j,i) )                            &
    49814888#if defined( __imuk_old )
    4982                              / SQRT( g / var(k,j,i)    * ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! required for intel14
     4889                                             / SQRT( g / var(k,j,i) *                              &
     4890                                             ( ABS( dvar_dz ) + 1.0E-10_wp ) ) + 1E-5_wp ! Required for intel14
    49834891#else
    4984                                   / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
     4892                                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
    49854893#endif
    49864894                   ENDIF
    49874895
    4988                    ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) ) &
     4896                   ml_stratification(k) = 1.0_wp / ( 1.0_wp / ( kappa * distance_to_wall(k,j,i) )  &
    49894897                                        + 1.0_wp / ml_stratification(k) )
    49904898                ELSE
    … …  
    49984906             DO  k = nzb+1, nzt
    49994907
    5000                 ml_local_profile(k) = ml_stratification(k) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
     4908                ml_local_profile(k) = ml_stratification(k) *                                       &
     4909                                      MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    50014910                ml  = ml_local_profile(k)
    50024911!
    … …  
    50054914
    50064915                dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    5007                 IF ( dvar_dz > 0.0_wp ) THEN
     4916                IF ( dvar_dz > 0.0_wp )  THEN
    50084917                   kh(k,j,i) = km(k,j,i)
    50094918                ELSE
    … …  
    50414950                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    50424951
    5043                    duv2_dz2 =   ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2  &
    5044                               + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2  &
    5045                               + 1E-30_wp
     4952                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
     4953                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
    50464954
    50474955                   rif(k) = MIN( MAX( g / var_reference * dvar_dz / duv2_dz2, -5.0_wp ),  1.0_wp )
    … …  
    50534961                   dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
    50544962
    5055                    duv2_dz2 =   ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2  &
    5056                               + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2  &
    5057                               + 1E-30_wp
     4963                   duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2                        &
     4964                            + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 + 1E-30_wp
    50584965
    50594966                   rif(k) = MIN( MAX( g / var(k,j,i) * dvar_dz / duv2_dz2, -5.0_wp ),  1.0_wp )
    … …  
    50774984             !DIR$ IVDEP
    50784985             DO  k = nzb+1, nzt
    5079                 ml_local_profile(k) = MIN( ml_stratification(k), delta(k,j,i) ) &
     4986                ml_local_profile(k) = MIN( ml_stratification(k), delta(k,j,i) )                    &
    50804987                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
    50814988                km(k,j,i) = c_0 * ml_local_profile(k) * SQRT( e(k,j,i) )
    … …  
    51325039
    51335040    !$ACC KERNELS PRESENT(sums_l_l)
    5134     sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! quasi boundary-condition for
    5135                                                 ! data output
     5041    sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! Quasi boundary-condition for
     5042                                                ! Data output
    51365043    !$ACC END KERNELS
    51375044!$OMP END PARALLEL
    … …  
    51405047
    51415048
    5142 !------------------------------------------------------------------------------!
     5049!--------------------------------------------------------------------------------------------------!
    51435050! Description:
    51445051! ------------
    5145 !> Calculates the eddy viscosity dynamically using the linear dynamic model
    5146 !> according to
    5147 !> Heinz, Stefan. "Realizability of dynamic subgrid-scale stress models via
    5148 !> stochastic analysis."
     5052!> Calculates the eddy viscosity dynamically using the linear dynamic model according to
     5053!> Heinz, Stefan. "Realizability of dynamic subgrid-scale stress models via stochastic analysis."
    51495054!> Monte Carlo Methods and Applications 14.4 (2008): 311-329.
    51505055!>
    5151 !> Furthermore dynamic bounds are used to limit the absolute value of c* as
    5152 !> described in
    5153 !> Mokhtarpoor, Reza, and Stefan Heinz. "Dynamic large eddy simulation:
    5154 !> Stability via realizability." Physics of Fluids 29.10 (2017): 105104.
     5056!> Furthermore dynamic bounds are used to limit the absolute value of c* as described in
     5057!> Mokhtarpoor, Reza, and Stefan Heinz. "Dynamic large eddy simulation: Stability via realizability."
     5058!> Physics of Fluids 29.10 (2017): 105104.
    51555059!>
    51565060!> @author Hauke Wurps
    51575061!> @author Björn Maronga
    5158 !------------------------------------------------------------------------------!
     5062!--------------------------------------------------------------------------------------------------!
    51595063 SUBROUTINE tcm_diffusivities_dynamic
    51605064
    5161     USE arrays_3d,                                                             &
    5162         ONLY:  ddzw, dzw, dd2zu, w, ug, vg
    5163 
    5164     USE grid_variables,                                                        &
    5165         ONLY : ddx, ddy, dx, dy
     5065    USE arrays_3d,                                                                                 &
     5066        ONLY:  ddzw,                                                                               &
     5067               dzw,                                                                                &
     5068               dd2zu,                                                                              &
     5069               ug,                                                                                 &
     5070               vg,                                                                                 &
     5071               w
     5072
     5073    USE grid_variables,                                                                            &
     5074        ONLY : ddx,                                                                                &
     5075               ddy,                                                                                &
     5076               dx,                                                                                 &
     5077               dy
    51665078
    51675079    IMPLICIT NONE
    51685080
    5169     INTEGER(iwp) ::  i           !< running index x-direction
    5170     INTEGER(iwp) ::  j           !< running index y-direction
    5171     INTEGER(iwp) ::  k           !< running index z-direction
    5172     INTEGER(iwp) ::  l           !< running index
    5173     INTEGER(iwp) ::  m           !< running index
    5174 
    5175     REAL(wp)     ::  dudx        !< Gradient of u-component in x-direction
    5176     REAL(wp)     ::  dudy        !< Gradient of u-component in y-direction
    5177     REAL(wp)     ::  dudz        !< Gradient of u-component in z-direction
    5178     REAL(wp)     ::  dvdx        !< Gradient of v-component in x-direction
    5179     REAL(wp)     ::  dvdy        !< Gradient of v-component in y-direction
    5180     REAL(wp)     ::  dvdz        !< Gradient of v-component in z-direction
    5181     REAL(wp)     ::  dwdx        !< Gradient of w-component in x-direction
    5182     REAL(wp)     ::  dwdy        !< Gradient of w-component in y-direction
    5183     REAL(wp)     ::  dwdz        !< Gradient of w-component in z-direction
    5184 
    5185     REAL(wp)     ::  flag        !< topography flag
     5081    INTEGER(iwp) ::  i     !< running index x-direction
     5082    INTEGER(iwp) ::  j     !< running index y-direction
     5083    INTEGER(iwp) ::  k     !< running index z-direction
     5084    INTEGER(iwp) ::  l     !< running index
     5085    INTEGER(iwp) ::  m     !< running index
     5086
     5087    REAL(wp)     ::  cst        !< c*
     5088    REAL(wp)     ::  cstnust_t  !< product c*nu*
     5089    REAL(wp)     ::  cst_max    !< bounds of c*
     5090    REAL(wp)     ::  delta_max  !< maximum of the grid spacings
     5091
     5092    REAL(wp)     ::  dudx  !< Gradient of u-component in x-direction
     5093    REAL(wp)     ::  dudy  !< Gradient of u-component in y-direction
     5094    REAL(wp)     ::  dudz  !< Gradient of u-component in z-direction
     5095    REAL(wp)     ::  dvdx  !< Gradient of v-component in x-direction
     5096    REAL(wp)     ::  dvdy  !< Gradient of v-component in y-direction
     5097    REAL(wp)     ::  dvdz  !< Gradient of v-component in z-direction
     5098    REAL(wp)     ::  dwdx  !< Gradient of w-component in x-direction
     5099    REAL(wp)     ::  dwdy  !< Gradient of w-component in y-direction
     5100    REAL(wp)     ::  dwdz  !< Gradient of w-component in z-direction
     5101
     5102    REAL(wp)     ::  flag  !< topography flag
    51865103
    51875104    REAL(wp)     ::  uc(-1:1,-1:1)  !< u on grid center
    … …  
    51935110    REAL(wp)     ::  wt(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !< test filtered w
    51945111
    5195     REAL(wp)     ::  uct         !< test filtered u on grid center
    5196     REAL(wp)     ::  vct         !< test filtered v on grid center
    5197     REAL(wp)     ::  wct         !< test filtered w on grid center
    5198     REAL(wp)     ::  u2t         !< test filtered u**2 on grid center
    5199     REAL(wp)     ::  v2t         !< test filtered v**2 on grid center
    5200     REAL(wp)     ::  w2t         !< test filtered w**2 on grid center
    5201     REAL(wp)     ::  uvt         !< test filtered u*v on grid center
    5202     REAL(wp)     ::  uwt         !< test filtered u*w on grid center
    5203     REAL(wp)     ::  vwt         !< test filtered v*w on grid center
    5204 
    5205     REAL(wp)     ::  sd11        !< deviatoric shear tensor
    5206     REAL(wp)     ::  sd22        !< deviatoric shear tensor
    5207     REAL(wp)     ::  sd33        !<f deviatoric shear tensor
    5208     REAL(wp)     ::  sd12        !< deviatoric shear tensor
    5209     REAL(wp)     ::  sd13        !< deviatoric shear tensor
    5210     REAL(wp)     ::  sd23        !< deviatoric shear tensor
    5211 
    5212     REAL(wp)     ::  sd2         !< sum: sd_ij*sd_ij
    5213 
    5214     REAL(wp)     ::  sdt11       !< filtered deviatoric shear tensor
    5215     REAL(wp)     ::  sdt22       !< filtered deviatoric shear tensor
    5216     REAL(wp)     ::  sdt33       !< filtered deviatoric shear tensor
    5217     REAL(wp)     ::  sdt12       !< filtered deviatoric shear tensor
    5218     REAL(wp)     ::  sdt13       !< filtered deviatoric shear tensor
    5219     REAL(wp)     ::  sdt23       !< filtered deviatoric shear tensor
    5220 
    5221     REAL(wp)     ::  sdt2        !< sum: sdt_ij*sdt_ij
    5222 
    5223     REAL(wp)     ::  ld11        !< deviatoric stress tensor
    5224     REAL(wp)     ::  ld22        !< deviatoric stress tensor
    5225     REAL(wp)     ::  ld33        !< deviatoric stress tensor
    5226     REAL(wp)     ::  ld12        !< deviatoric stress tensor
    5227     REAL(wp)     ::  ld13        !< deviatoric stress tensor
    5228     REAL(wp)     ::  ld23        !< deviatoric stress tensor
    5229 
    5230     REAL(wp)     ::  lnn         !< sum ld_nn
    5231     REAL(wp)     ::  ldsd        !< sum: ld_ij*sd_ij
    5232 
    5233     REAL(wp)     ::  delta_max   !< maximum of the grid spacings
    5234     REAL(wp)     ::  cst         !< c*
    5235     REAL(wp)     ::  cstnust_t   !< product c*nu*
    5236     REAL(wp)     ::  cst_max     !< bounds of c*
    5237 
    5238     REAL(wp), PARAMETER :: fac_cmax = 23.0_wp/(24.0_wp*sqrt(3.0_wp))  !< constant
    5239 
    5240 !
    5241 !-- velocities on grid centers:
     5112    REAL(wp)     ::  uct    !< test filtered u on grid center
     5113    REAL(wp)     ::  vct    !< test filtered v on grid center
     5114    REAL(wp)     ::  wct    !< test filtered w on grid center
     5115    REAL(wp)     ::  u2t    !< test filtered u**2 on grid center
     5116    REAL(wp)     ::  v2t    !< test filtered v**2 on grid center
     5117    REAL(wp)     ::  w2t    !< test filtered w**2 on grid center
     5118    REAL(wp)     ::  uvt    !< test filtered u*v on grid center
     5119    REAL(wp)     ::  uwt    !< test filtered u*w on grid center
     5120    REAL(wp)     ::  vwt    !< test filtered v*w on grid center
     5121
     5122    REAL(wp)     ::  sd11   !< deviatoric shear tensor
     5123    REAL(wp)     ::  sd22   !< deviatoric shear tensor
     5124    REAL(wp)     ::  sd33   !<f deviatoric shear tensor
     5125    REAL(wp)     ::  sd12   !< deviatoric shear tensor
     5126    REAL(wp)     ::  sd13   !< deviatoric shear tensor
     5127    REAL(wp)     ::  sd23   !< deviatoric shear tensor
     5128
     5129    REAL(wp)     ::  sd2    !< sum: sd_ij*sd_ij
     5130
     5131    REAL(wp)     ::  sdt11  !< filtered deviatoric shear tensor
     5132    REAL(wp)     ::  sdt22  !< filtered deviatoric shear tensor
     5133    REAL(wp)     ::  sdt33  !< filtered deviatoric shear tensor
     5134    REAL(wp)     ::  sdt12  !< filtered deviatoric shear tensor
     5135    REAL(wp)     ::  sdt13  !< filtered deviatoric shear tensor
     5136    REAL(wp)     ::  sdt23  !< filtered deviatoric shear tensor
     5137
     5138    REAL(wp)     ::  sdt2   !< sum: sdt_ij*sdt_ij
     5139
     5140    REAL(wp)     ::  ld11   !< deviatoric stress tensor
     5141    REAL(wp)     ::  ld22   !< deviatoric stress tensor
     5142    REAL(wp)     ::  ld33   !< deviatoric stress tensor
     5143    REAL(wp)     ::  ld12   !< deviatoric stress tensor
     5144    REAL(wp)     ::  ld13   !< deviatoric stress tensor
     5145    REAL(wp)     ::  ld23   !< deviatoric stress tensor
     5146
     5147    REAL(wp)     ::  lnn    !< sum ld_nn
     5148    REAL(wp)     ::  ldsd   !< sum: ld_ij*sd_ij
     5149
     5150
     5151    REAL(wp), PARAMETER :: fac_cmax = 23.0_wp / ( 24.0_wp * SQRT (3.0_wp) )  !< constant
     5152
     5153!
     5154!-- Velocities on grid centers:
    52425155    CALL tcm_box_filter_2d_array( u, ut )
    52435156    CALL tcm_box_filter_2d_array( v, vt )
    … …  
    52545167!--          s_ij =  0.5 * ( du_i/dx_j + du_j/dx_i )
    52555168             dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
    5256              dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
    5257                                  u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
    5258              dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
    5259                                  u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
    5260 
    5261              dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
    5262                                  v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
     5169             dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
     5170             dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
     5171
     5172             dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
    52635173             dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
    5264              dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
    5265                                  v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
    5266 
    5267              dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
    5268                                  w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
    5269              dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
    5270                                  w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
     5174             dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
     5175
     5176             dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
     5177             dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
    52715178             dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
    52725179
    … …  
    52795186!
    52805187!--          sum: sd_ij*sd_ij
    5281              sd2 = sd11**2 + sd22**2 + sd33**2                     &
    5282                    + 2.0_wp * ( sd12**2 + sd13**2 + sd23**2 )
    5283 !
    5284 !--          The filtered velocities are needed to calculate the filtered shear
    5285 !--          tensor: sdt_ij = 0.5 * ( dut_i/dx_j + dut_j/dx_i )
    5286              dudx  =           ( ut(k,j,i+1) - ut(k,j,i)     ) * ddx
    5287              dudy  = 0.25_wp * ( ut(k,j+1,i) + ut(k,j+1,i+1) - &
    5288                                  ut(k,j-1,i) - ut(k,j-1,i+1) ) * ddy
    5289              dudz  = 0.5_wp  * ( ut(k+1,j,i) + ut(k+1,j,i+1) - &
    5290                                  ut(k-1,j,i) - ut(k-1,j,i+1) ) * dd2zu(k)
    5291 
    5292              dvdx  = 0.25_wp * ( vt(k,j,i+1) + vt(k,j+1,i+1) - &
    5293                                  vt(k,j,i-1) - vt(k,j+1,i-1) ) * ddx
     5188             sd2 = sd11**2 + sd22**2 + sd33**2 + 2.0_wp * ( sd12**2 + sd13**2 + sd23**2 )
     5189!
     5190!--          The filtered velocities are needed to calculate the filtered shear tensor:
     5191!--          sdt_ij = 0.5 * ( dut_i/dx_j + dut_j/dx_i )
     5192             dudx  =           ( ut(k,j,i+1) - ut(k,j,i)      ) * ddx
     5193             dudy  = 0.25_wp * ( ut(k,j+1,i) + ut(k,j+1,i+1) - ut(k,j-1,i) - ut(k,j-1,i+1) ) * ddy
     5194             dudz  = 0.5_wp  * ( ut(k+1,j,i) + ut(k+1,j,i+1) -                                     &
     5195                                 ut(k-1,j,i) - ut(k-1,j,i+1)  ) * dd2zu(k)
     5196
     5197             dvdx  = 0.25_wp * ( vt(k,j,i+1) + vt(k,j+1,i+1) - vt(k,j,i-1) - vt(k,j+1,i-1) ) * ddx
    52945198             dvdy  =           ( vt(k,j+1,i) - vt(k,j,i)     ) * ddy
    5295              dvdz  = 0.5_wp  * ( vt(k+1,j,i) + vt(k+1,j+1,i) - &
     5199             dvdz  = 0.5_wp  * ( vt(k+1,j,i) + vt(k+1,j+1,i) -                                     &
    52965200                                 vt(k-1,j,i) - vt(k-1,j+1,i) ) * dd2zu(k)
    52975201
    5298              dwdx  = 0.25_wp * ( wt(k,j,i+1) + wt(k-1,j,i+1) - &
    5299                                  wt(k,j,i-1) - wt(k-1,j,i-1) ) * ddx
    5300              dwdy  = 0.25_wp * ( wt(k,j+1,i) + wt(k-1,j+1,i) - &
    5301                                  wt(k,j-1,i) - wt(k-1,j-1,i) ) * ddy
    5302              dwdz  =           ( wt(k,j,i)   - wt(k-1,j,i)   ) * ddzw(k)
     5202             dwdx  = 0.25_wp * ( wt(k,j,i+1) + wt(k-1,j,i+1) - wt(k,j,i-1) - wt(k-1,j,i-1) ) * ddx
     5203             dwdy  = 0.25_wp * ( wt(k,j+1,i) + wt(k-1,j+1,i) - wt(k,j-1,i) - wt(k-1,j-1,i) ) * ddy
     5204             dwdz  =           ( wt(k,j,i)   - wt(k-1,j,i)  ) * ddzw(k)
    53035205
    53045206             sdt11 = dudx
    … …  
    53105212!
    53115213!--          sum: sd_ij*sd_ij
    5312              sdt2 = sdt11**2 + sdt22**2 + sdt33**2         &
    5313                    + 2.0_wp * ( sdt12**2 + sdt13**2 + sdt23**2 )
    5314 !
    5315 !--          Need filtered velocities and filtered squared velocities on grid
    5316 !--          centers. Substraction of geostrophic velocity helps to avoid
    5317 !--          numerical errors in the expression <u**2> - <u>*<u>, which can be
    5318 !--          very small (<...> means filtered).
     5214             sdt2 = sdt11**2 + sdt22**2 + sdt33**2 + 2.0_wp * ( sdt12**2 + sdt13**2 + sdt23**2 )
     5215!
     5216!--          Need filtered velocities and filtered squared velocities on grid centers. Substraction
     5217!--          of geostrophic velocity helps to avoid numerical errors in the expression
     5218!--          <u**2> - <u>*<u>, which can be very small (<...> means filtered).
    53195219             DO  l = -1, 1
    53205220                DO  m = -1, 1
    … …  
    53495249             ld33 = ld33 - lnn / 3.0_wp
    53505250
    5351              ldsd = ld11 * sdt11 + ld22 * sdt22 + ld33 * sdt33 + &
    5352                     2.0_wp * ( ld12 * sdt12 + ld13 * sdt13 + ld23 * sdt23 )
     5251             ldsd = ld11 * sdt11 + ld22 * sdt22 + ld33 * sdt33 + 2.0_wp *                          &
     5252                  ( ld12 * sdt12 + ld13 * sdt13 + ld23 * sdt23 )
    53535253!
    53545254!--          c* nu*^T is SGS viscosity on test filter level:
    53555255             cstnust_t = -ldsd / ( sdt2 + 1.0E-20_wp )
    53565256!
    5357 !--          The model was only tested for an isotropic grid. The following
    5358 !--          expression was a recommendation of Stefan Heinz.
     5257!--          The model was only tested for an isotropic grid. The following expression was a
     5258!--          recommendation of Stefan Heinz.
    53595259             delta_max = MAX( dx, dy, dzw(k) )
    53605260
    5361              IF ( lnn <= 0.0_wp ) THEN
     5261             IF ( lnn <= 0.0_wp )  THEN
    53625262                cst = 0.0_wp
    53635263             ELSE
    5364                 cst = cstnust_t /                                              &
    5365                    ( 4.0_wp * delta_max * SQRT( lnn / 2.0_wp ) + 1.0E-20_wp )
     5264                cst = cstnust_t / ( 4.0_wp * delta_max * SQRT( lnn / 2.0_wp ) + 1.0E-20_wp )
    53665265             ENDIF
    53675266
    53685267!
    53695268!--          Calculate border according to Mokhtarpoor and Heinz (2017)
    5370              cst_max = fac_cmax * SQRT( e(k,j,i) ) /                           &
     5269             cst_max = fac_cmax * SQRT( e(k,j,i) ) /                                               &
    53715270                       ( delta_max * SQRT( 2.0_wp * sd2 ) + 1.0E-20_wp )
    53725271
    … …  
    53845283
    53855284
    5386 !------------------------------------------------------------------------------!
     5285!--------------------------------------------------------------------------------------------------!
    53875286! Description:
    53885287! ------------
    5389 !> This subroutine acts as a box filter with filter width 2 * dx.
    5390 !> Output is only one point.
    5391 !------------------------------------------------------------------------------!
     5288!> This subroutine acts as a box filter with filter width 2 * dx. Output is only one point.
     5289!--------------------------------------------------------------------------------------------------!
    53925290 SUBROUTINE tcm_box_filter_2d_single( var, var_fil )
    53935291
    53945292    IMPLICIT NONE
    53955293
    5396     REAL(wp)     ::  var(-1:1,-1:1)      !< variable to be filtered
    5397     REAL(wp)     ::  var_fil             !< filtered variable
    5398 !
    5399 !-- It is assumed that a box with a side length of 2 * dx and centered at the
    5400 !-- variable*s position contains one half of the four closest neigbours and one
    5401 !-- forth of the diagonally closest neighbours.
    5402     var_fil = 0.25_wp * ( var(0,0) +                                           &
    5403                       0.5_wp  * ( var(0,1)  + var(1,0)   +                     &
    5404                                   var(0,-1) + var(-1,0)  ) +                   &
    5405                       0.25_wp * ( var(1,1)  + var(1,-1)  +                     &
    5406                                   var(-1,1) + var(-1,-1) ) )
     5294    REAL(wp)     ::  var(-1:1,-1:1)  !< variable to be filtered
     5295    REAL(wp)     ::  var_fil         !< filtered variable
     5296!
     5297!-- It is assumed that a box with a side length of 2 * dx and centered at the variable*s position
     5298!-- contains one half of the four closest neigbours and one forth of the diagonally closest
     5299!-- neighbours.
     5300    var_fil = 0.25_wp * ( var(0,0) + 0.5_wp * ( var(0,1) + var(1,0) + var(0,-1) + var(-1,0) ) +    &
     5301                          0.25_wp * ( var(1,1) + var(1,-1) + var(-1,1) + var(-1,-1) ) )
    54075302
    54085303 END SUBROUTINE tcm_box_filter_2d_single
    54095304
    5410 !------------------------------------------------------------------------------!
     5305!--------------------------------------------------------------------------------------------------!
    54115306! Description:
    54125307! ------------
    5413 !> This subroutine acts as a box filter with filter width 2 * dx.
    5414 !> The filtered variable var_fil is on the same grid as var.
    5415 !------------------------------------------------------------------------------!
     5308!> This subroutine acts as a box filter with filter width 2 * dx. The filtered variable var_fil is
     5309!> on the same grid as var.
     5310!--------------------------------------------------------------------------------------------------!
    54165311 SUBROUTINE tcm_box_filter_2d_array( var, var_fil )
    54175312
    54185313    IMPLICIT NONE
    54195314
    5420     INTEGER(iwp) ::  i    !< running index x-direction
    5421     INTEGER(iwp) ::  j    !< running index y-direction
    5422     INTEGER(iwp) ::  k    !< running index z-direction
     5315    INTEGER(iwp) ::  i  !< running index x-direction
     5316    INTEGER(iwp) ::  j  !< running index y-direction
     5317    INTEGER(iwp) ::  k  !< running index z-direction
    54235318
    54245319    REAL(wp)     ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)      !< variable to be filtered
    54255320    REAL(wp)     ::  var_fil(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !< filtered variable
    54265321!
    5427 !-- It is assumed that a box with a side length of 2 * dx and centered at the
    5428 !-- variable's position contains one half of the four closest neigbours and one
    5429 !-- forth of the diagonally closest neighbours.
     5322!-- It is assumed that a box with a side length of 2 * dx and centered at the variable's position
     5323!-- contains one half of the four closest neigbours and one forth of the diagonally closest
     5324!-- neighbours.
    54305325    DO  i = nxlg+1, nxrg-1
    54315326       DO  j = nysg+1, nyng-1
    54325327          DO  k = nzb, nzt+1
    5433              var_fil(k,j,i) = 0.25_wp * ( var(k,j,i) +                         &
    5434                               0.5_wp  * ( var(k,j,i+1)   + var(k,j+1,i)   +    &
    5435                                           var(k,j,i-1)   + var(k,j-1,i)     ) +&
    5436                               0.25_wp * ( var(k,j+1,i+1) + var(k,j+1,i-1) +    &
    5437                                           var(k,j-1,i+1) + var(k,j-1,i-1)   )  )
     5328             var_fil(k,j,i) = 0.25_wp * ( var(k,j,i) + 0.5_wp * ( var(k,j,i+1) + var(k,j+1,i) +    &
     5329                                          var(k,j,i-1) + var(k,j-1,i) ) + 0.25_wp *                &
     5330                                        ( var(k,j+1,i+1) + var(k,j+1,i-1) +                        &
     5331                                          var(k,j-1,i+1) + var(k,j-1,i-1) ) )
    54385332          END DO
    54395333       END DO
    … …  
    54435337
    54445338
    5445 !------------------------------------------------------------------------------!
     5339!--------------------------------------------------------------------------------------------------!
    54465340! Description:
    54475341! ------------
    54485342!> Swapping of timelevels.
    5449 !------------------------------------------------------------------------------!
     5343!--------------------------------------------------------------------------------------------------!
    54505344 SUBROUTINE tcm_swap_timelevel ( mod_count )
    54515345
    … …  
    54535347
    54545348
    5455     INTEGER, INTENT(IN) ::  mod_count  !< flag defining where pointers point to
     5349    INTEGER, INTENT(IN) ::  mod_count  !< Flag defining where pointers point to
    54565350
    54575351

  • palm/trunk/SOURCE/urban_surface_mod.f90

    r4509 r4510  
    1818! Copyright 1997-2020 Leibniz Universitaet Hannover
    1919!--------------------------------------------------------------------------------------------------!
     20!
    2021!
    2122! Current revisions:
    … …  
    2627! -----------------
    2728! $Id$
    28 ! file re-formatted to follow the PALM coding standard
     29! Further re-formatting to follow the PALM coding standard
     30!
     31! 4509 2020-04-26 15:57:55Z raasch
     32! File re-formatted to follow the PALM coding standard
    2933!
    3034! 4500 2020-04-17 10:12:45Z suehring
    3135! Allocate array for wall heat flux, which is further used to aggregate tile
    3236! fractions in the surface output
    33 ! 
     37!
    3438! 4495 2020-04-13 20:11:20Z raasch
    35 ! restart data handling with MPI-IO added
     39! Restart data handling with MPI-IO added
    3640!
    3741! 4493 2020-04-10 09:49:43Z pavelkrc
    3842! J.Resler, 2020/03/19
    39 ! - remove reading of deprecated input parameters c_surface and lambda_surf
    40 ! - and calculate them from parameters of the outer wall/roof layer
     43! - Remove reading of deprecated input parameters c_surface and lambda_surf
     44! - And calculate them from parameters of the outer wall/roof layer
    4145!
    4246! 4481 2020-03-31 18:55:54Z maronga
    43 ! use statement for exchange horiz added
     47! Use statement for exchange horiz added
    4448!
    4549! 4442 2020-03-04 19:21:13Z suehring
    … …  
    8084!
    8185! 4227 2019-09-10 18:04:34Z gronemeier
    82 ! implement new palm_date_time_mod
     86! Implement new palm_date_time_mod
    8387!
    8488! 4214 2019-09-02 15:57:02Z suehring
    … …  
    152156!
    153157! 3832 2019-03-28 13:16:58Z raasch
    154 ! instrumented with openmp directives
     158! Instrumented with openmp directives
    155159!
    156160! 3824 2019-03-27 15:56:16Z pavelkrc
    … …  
    159163!
    160164! 3814 2019-03-26 08:40:31Z pavelkrc
    161 ! unused subroutine commented out
     165! Unused subroutine commented out
    162166!
    163167! 3769 2019-02-28 10:16:49Z moh.hefny
    164 ! removed unused variables
     168! Removed unused variables
    165169!
    166170! 3767 2019-02-27 08:18:02Z raasch
    167 ! unused variables removed from rrd-subroutines parameter list
     171! Unused variables removed from rrd-subroutines parameter list
    168172!
    169173! 3748 2019-02-18 10:38:31Z suehring
    … …  
    172176! 3745 2019-02-15 18:57:56Z suehring
    173177! - Remove internal flag indoor_model (is a global control parameter)
    174 ! - add waste heat from buildings to the kinmatic heat flux
    175 ! - consider waste heat in restart data
    176 ! - remove unused USE statements
     178! - Add waste heat from buildings to the kinmatic heat flux
     179! - Consider waste heat in restart data
     180! - Remove unused USE statements
    177181!
    178182! 3744 2019-02-15 18:38:58Z suehring
    179 ! fixed surface heat capacity in the building parameters convert the file back to unix format
     183! Fixed surface heat capacity in the building parameters convert the file back to unix format
    180184!
    181185! 3730 2019-02-11 11:26:47Z moh.hefny
    … …  
    186190!
    187191! 3705 2019-01-29 19:56:39Z suehring
    188 ! make nzb_wall public, required for virtual-measurements
     192! Make nzb_wall public, required for virtual-measurements
    189193!
    190194! 3704 2019-01-29 19:51:41Z suehring
    … …  
    208212!> Module for Urban Surface Model (USM)
    209213!> The module includes:
    210 !>    1. radiation model with direct/diffuse radiation, shading, reflections and integration with
     214!>    1. Radiation model with direct/diffuse radiation, shading, reflections and integration with
    211215!>       plant canopy
    212 !>    2. wall and wall surface model
    213 !>    3. surface layer energy balance
    214 !>    4. anthropogenic heat (only from transportation so far)
    215 !>    5. necessary auxiliary subroutines (reading inputs, writing outputs, restart simulations, ...)
     216!>    2. Wall and wall surface model
     217!>    3. Surface layer energy balance
     218!>    4. Anthropogenic heat (only from transportation so far)
     219!>    5. Necessary auxiliary subroutines (reading inputs, writing outputs, restart simulations, ...)
    216220!> It also makes use of standard radiation and integrates it into urban surface model.
    217221!>
    … …  
    223227!> fraq(0,m) + fraq(1,m) = 0?!
    224228!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
    225 !> @todo remove reading of old csv inputs
     229!> @todo Remove reading of old csv inputs
    226230!--------------------------------------------------------------------------------------------------!
    227231 MODULE urban_surface_mod
    … …  
    418422                                 /), (/ 4, 7 /) )
    419423!
    420 !-- value 9999999.9_wp -> generic available or user-defined value must be set otherwise
    421 !-- -> no generic variable and user setting is optional
     424!-- Value 9999999.9_wp -> Generic available or user-defined value must be set otherwise
     425!-- -> No generic variable and user setting is optional
    422426    REAL(wp) ::  alpha_vangenuchten = 9999999.9_wp      !< NAMELIST alpha_vg
    423427    REAL(wp) ::  field_capacity = 9999999.9_wp          !< NAMELIST fc
    … …  
    430434
    431435!
    432 !-- configuration parameters (they can be setup in PALM config)
     436!-- Configuration parameters (they can be setup in PALM config)
    433437    LOGICAL ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
    434438    LOGICAL ::  read_wall_temp_3d = .FALSE.        !<
    … …  
    645649    TYPE(surf_type_usm), TARGET   ::  tm_liq_usm_h_m  !< liquid water reservoir tendency (m), horizontal surface elements
    646650!
    647 !-- anthropogenic heat sources
     651!-- Anthropogenic heat sources
    648652    INTEGER(iwp)                                   ::  naheatlayers = 1  !< number of layers of anthropogenic heat
    649653
    … …  
    653657
    654658!
    655 !-- wall surface model
    656 !-- wall surface model constants
     659!-- Wall surface model
     660!-- Wall surface model constants
    657661    INTEGER(iwp), PARAMETER                        ::  nzb_wall = 0  !< inner side of the wall model (to be switched)
    658662    INTEGER(iwp), PARAMETER                        ::  nzt_wall = 3  !< outer side of the wall model (to be switched)
    … …  
    680684
    681685!
    682 !-- surface and material model variables for walls, ground, roofs
     686!-- Surface and material model variables for walls, ground, roofs
    683687    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  zwn                 !< normalized wall layer depths (m)
    684688    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  zwn_green           !< normalized green layer depths (m)
    … …  
    715719!
    716720!-- Energy balance variables
    717 !-- parameters of the land, roof and wall surfaces
     721!-- Parameters of the land, roof and wall surfaces
    718722    REAL(wp), DIMENSION(:,:), POINTER                ::  fc_h          !<
    719723    REAL(wp), DIMENSION(:,:), POINTER                ::  rootfr_h      !<
    … …  
    763767!
    764768!-- Surface and material parameter classes (surface_type)
    765 !-- albedo, emissivity, lambda_surf, roughness, thickness, volumetric heat capacity, thermal conductivity
     769!-- Albedo, emissivity, lambda_surf, roughness, thickness, volumetric heat capacity, thermal conductivity
    766770    CHARACTER(12), DIMENSION(:), ALLOCATABLE  ::  surface_type_names    !< names of wall types (used only for reports)
    767771
    … …  
    790794
    791795!
    792 !-- interfaces of subroutines accessed from outside of this module
     796!-- Interfaces of subroutines accessed from outside of this module
    793797    INTERFACE usm_3d_data_averaging
    794798       MODULE PROCEDURE usm_3d_data_averaging
    … …  
    923927!
    924928!-- Wall surface model
    925 !-- allocate arrays for wall surface model and define pointers
    926 !-- allocate array of wall types and wall parameters
     929!-- Allocate arrays for wall surface model and define pointers
     930!-- Allocate array of wall types and wall parameters
    927931    ALLOCATE ( surf_usm_h%surface_types(1:surf_usm_h%ns)      )
    928932    ALLOCATE ( surf_usm_h%building_type(1:surf_usm_h%ns)      )
    … …  
    984988
    985989!
    986 !-- wall and roof surface parameters. First for horizontal surfaces
     990!-- Wall and roof surface parameters. First for horizontal surfaces
    987991    ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)        )
    988992    ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)        )
    … …  
    10201024
    10211025!
    1022 !-- allocate wall and roof material parameters. First for horizontal surfaces
     1026!-- Allocate wall and roof material parameters. First for horizontal surfaces
    10231027    ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns)                    )
    10241028    ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns)                  )
    … …  
    10551059
    10561060!
    1057 !-- allocate green wall and roof vegetation and soil parameters. First horizontal surfaces
     1061!-- Allocate green wall and roof vegetation and soil parameters. First horizontal surfaces
    10581062    ALLOCATE ( surf_usm_h%g_d(1:surf_usm_h%ns)              )
    10591063    ALLOCATE ( surf_usm_h%c_liq(1:surf_usm_h%ns)            )
    … …  
    10771081
    10781082!
    1079 !-- allocate wall and roof layers sizes. For horizontal surfaces.
     1083!-- Allocate wall and roof layers sizes. For horizontal surfaces.
    10801084    ALLOCATE ( zwn(nzb_wall:nzt_wall)                                        )
    10811085    ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)       )
    … …  
    13261330
    13271331
    1328     IF ( variable(1:4) == 'usm_' )  THEN  ! is such a check really required?
    1329 
    1330 !
    1331 !-- find the real name of the variable
     1332    IF ( variable(1:4) == 'usm_' )  THEN  ! Is such a check really required?
     1333
     1334!
     1335!-- Find the real name of the variable
    13321336    ids = -1
    13331337    l = -1
    … …  
    13431347       ENDIF
    13441348    ENDDO
    1345     l = idsint - 2  ! horizontal direction index - terrible hack !
     1349    l = idsint - 2  ! Horizontal direction index - terrible hack !
    13461350    IF ( l < 0 .OR. l > 3 )  THEN
    13471351       l = -1
    … …  
    13521356    IF ( var(1:11) == 'usm_t_wall_'  .AND.  len( TRIM( var ) ) >= 12 )  THEN
    13531357!
    1354 !--      wall layers
     1358!--      Wall layers
    13551359        READ( var(12:12), '(I1)', iostat=istat ) iwl
    13561360        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    13581362        ELSE
    13591363!
    1360 !--         wrong wall layer index
     1364!--         Wrong wall layer index
    13611365            RETURN
    13621366        ENDIF
    … …  
    13641368    IF ( var(1:13) == 'usm_t_window_'  .AND.  len( TRIM(var) ) >= 14 )  THEN
    13651369!
    1366 !--      wall layers
     1370!--      Wall layers
    13671371        READ( var(14:14), '(I1)', iostat=istat ) iwl
    13681372        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    13701374        ELSE
    13711375!
    1372 !--         wrong window layer index
     1376!--         Wrong window layer index
    13731377            RETURN
    13741378        ENDIF
    … …  
    13761380    IF ( var(1:12) == 'usm_t_green_'  .AND.  len( TRIM( var ) ) >= 13 )  THEN
    13771381!
    1378 !--      wall layers
     1382!--      Wall layers
    13791383        READ( var(13:13), '(I1)', iostat=istat ) iwl
    13801384        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    13821386        ELSE
    13831387!
    1384 !--         wrong green layer index
     1388!--         Wrong green layer index
    13851389            RETURN
    13861390        ENDIF
    … …  
    13881392    IF ( var(1:8) == 'usm_swc_'  .AND.  len( TRIM( var ) ) >= 9 )  THEN
    13891393!
    1390 !--      swc layers
     1394!--      Swc layers
    13911395        READ( var(9:9), '(I1)', iostat=istat ) iwl
    13921396        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    13941398        ELSE
    13951399!
    1396 !--         wrong swc layer index
     1400!--         Wrong swc layer index
    13971401            RETURN
    13981402        ENDIF
    … …  
    14051409            CASE ( 'usm_wshf' )
    14061410!
    1407 !--             array of sensible heat flux from surfaces
    1408 !--             land surfaces
     1411!--             Array of sensible heat flux from surfaces
     1412!--             Land surfaces
    14091413                IF ( l == -1 )  THEN
    14101414                   IF ( .NOT.  ALLOCATED( surf_usm_h%wshf_eb_av ) )  THEN
    … …  
    14211425            CASE ( 'usm_qsws' )
    14221426!
    1423 !--             array of latent heat flux from surfaces
    1424 !--             land surfaces
     1427!--             Array of latent heat flux from surfaces
     1428!--             Land surfaces
    14251429                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%qsws_av ) )  THEN
    14261430                    ALLOCATE ( surf_usm_h%qsws_av(1:surf_usm_h%ns) )
    … …  
    14351439            CASE ( 'usm_qsws_veg' )
    14361440!
    1437 !--             array of latent heat flux from vegetation surfaces
    1438 !--             land surfaces
     1441!--             Array of latent heat flux from vegetation surfaces
     1442!--             Land surfaces
    14391443                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%qsws_veg_av ) )  THEN
    14401444                    ALLOCATE ( surf_usm_h%qsws_veg_av(1:surf_usm_h%ns) )
    … …  
    14491453            CASE ( 'usm_qsws_liq' )
    14501454!
    1451 !--             array of latent heat flux from surfaces with liquid
    1452 !--             land surfaces
     1455!--             Array of latent heat flux from surfaces with liquid
     1456!--             Land surfaces
    14531457                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%qsws_liq_av ) )  THEN
    14541458                    ALLOCATE ( surf_usm_h%qsws_liq_av(1:surf_usm_h%ns) )
    … …  
    14661470            CASE ( 'usm_wghf' )
    14671471!
    1468 !--             array of heat flux from ground (wall, roof, land)
     1472!--             Array of heat flux from ground (wall, roof, land)
    14691473                IF ( l == -1 )  THEN
    14701474                   IF ( .NOT.  ALLOCATED( surf_usm_h%wghf_eb_av ) )  THEN
    … …  
    14811485            CASE ( 'usm_wghf_window' )
    14821486!
    1483 !--             array of heat flux from window ground (wall, roof, land)
     1487!--             Array of heat flux from window ground (wall, roof, land)
    14841488                IF ( l == -1 )  THEN
    14851489                   IF ( .NOT.  ALLOCATED( surf_usm_h%wghf_eb_window_av ) )  THEN
    … …  
    14961500            CASE ( 'usm_wghf_green' )
    14971501!
    1498 !--             array of heat flux from green ground (wall, roof, land)
     1502!--             Array of heat flux from green ground (wall, roof, land)
    14991503                IF ( l == -1 )  THEN
    15001504                   IF ( .NOT.  ALLOCATED( surf_usm_h%wghf_eb_green_av ) )  THEN
    … …  
    15111515            CASE ( 'usm_iwghf' )
    15121516!
    1513 !--             array of heat flux from indoor ground (wall, roof, land)
     1517!--             Array of heat flux from indoor ground (wall, roof, land)
    15141518                IF ( l == -1 )  THEN
    15151519                   IF ( .NOT.  ALLOCATED( surf_usm_h%iwghf_eb_av ) )  THEN
    … …  
    15261530            CASE ( 'usm_iwghf_window' )
    15271531!
    1528 !--             array of heat flux from indoor window ground (wall, roof, land)
     1532!--             Array of heat flux from indoor window ground (wall, roof, land)
    15291533                IF ( l == -1 ) THEN
    15301534                   IF ( .NOT.  ALLOCATED( surf_usm_h%iwghf_eb_window_av ) )  THEN
    … …  
    15411545            CASE ( 'usm_t_surf_wall' )
    15421546!
    1543 !--             surface temperature for surfaces
     1547!--             Surface temperature for surfaces
    15441548                IF ( l == -1 )  THEN
    15451549                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_surf_wall_av ) )  THEN
    … …  
    15561560            CASE ( 'usm_t_surf_window' )
    15571561!
    1558 !--             surface temperature for window surfaces
     1562!--             Surface temperature for window surfaces
    15591563                IF ( l == -1 )  THEN
    15601564                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_surf_window_av ) )  THEN
    … …  
    15711575            CASE ( 'usm_t_surf_green' )
    15721576!
    1573 !--             surface temperature for green surfaces
     1577!--             Surface temperature for green surfaces
    15741578                IF ( l == -1 )  THEN
    15751579                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_surf_green_av ) )  THEN
    … …  
    15861590            CASE ( 'usm_theta_10cm' )
    15871591!
    1588 !--             near surface (10cm) temperature for whole surfaces
     1592!--             Near surface (10cm) temperature for whole surfaces
    15891593                IF ( l == -1 )  THEN
    15901594                   IF ( .NOT.  ALLOCATED( surf_usm_h%pt_10cm_av ) )  THEN
    … …  
    16011605            CASE ( 'usm_t_wall' )
    16021606!
    1603 !--             wall temperature for iwl layer of walls and land
     1607!--             Wall temperature for iwl layer of walls and land
    16041608                IF ( l == -1 )  THEN
    16051609                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_wall_av ) )  THEN
    … …  
    16161620            CASE ( 'usm_t_window' )
    16171621!
    1618 !--             window temperature for iwl layer of walls and land
     1622!--             Window temperature for iwl layer of walls and land
    16191623                IF ( l == -1 )  THEN
    16201624                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_window_av ) )  THEN
    … …  
    16311635            CASE ( 'usm_t_green' )
    16321636!
    1633 !--             green temperature for iwl layer of walls and land
     1637!--             Green temperature for iwl layer of walls and land
    16341638                IF ( l == -1 )  THEN
    16351639                   IF ( .NOT.  ALLOCATED( surf_usm_h%t_green_av ) )  THEN
    … …  
    16451649            CASE ( 'usm_swc' )
    16461650!
    1647 !--             soil water content for iwl layer of walls and land
     1651!--             Soil water content for iwl layer of walls and land
    16481652                IF ( l == -1 .AND. .NOT.  ALLOCATED( surf_usm_h%swc_av ) )  THEN
    16491653                    ALLOCATE ( surf_usm_h%swc_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
    … …  
    16671671            CASE ( 'usm_wshf' )
    16681672!
    1669 !--             array of sensible heat flux from surfaces (land, roof, wall)
     1673!--             Array of sensible heat flux from surfaces (land, roof, wall)
    16701674                IF ( l == -1 )  THEN
    16711675                   DO  m = 1, surf_usm_h%ns
    … …  
    16811685            CASE ( 'usm_qsws' )
    16821686!
    1683 !--             array of latent heat flux from surfaces (land, roof, wall)
     1687!--             Array of latent heat flux from surfaces (land, roof, wall)
    16841688                IF ( l == -1 ) THEN
    16851689                DO  m = 1, surf_usm_h%ns
    … …  
    16951699            CASE ( 'usm_qsws_veg' )
    16961700!
    1697 !--             array of latent heat flux from vegetation surfaces (land, roof, wall)
     1701!--             Array of latent heat flux from vegetation surfaces (land, roof, wall)
    16981702                IF ( l == -1 )  THEN
    16991703                DO  m = 1, surf_usm_h%ns
    … …  
    17091713            CASE ( 'usm_qsws_liq' )
    17101714!
    1711 !--             array of latent heat flux from surfaces with liquid (land, roof, wall)
     1715!--             Array of latent heat flux from surfaces with liquid (land, roof, wall)
    17121716                IF ( l == -1 ) THEN
    17131717                DO  m = 1, surf_usm_h%ns
    … …  
    17241728            CASE ( 'usm_wghf' )
    17251729!
    1726 !--             array of heat flux from ground (wall, roof, land)
     1730!--             Array of heat flux from ground (wall, roof, land)
    17271731                IF ( l == -1 ) THEN
    17281732                   DO  m = 1, surf_usm_h%ns
    … …  
    17391743            CASE ( 'usm_wghf_window' )
    17401744!
    1741 !--             array of heat flux from window ground (wall, roof, land)
     1745!--             Array of heat flux from window ground (wall, roof, land)
    17421746                IF ( l == -1 )  THEN
    17431747                   DO  m = 1, surf_usm_h%ns
    … …  
    17541758            CASE ( 'usm_wghf_green' )
    17551759!
    1756 !--             array of heat flux from green ground (wall, roof, land)
     1760!--             Array of heat flux from green ground (wall, roof, land)
    17571761                IF ( l == -1 )  THEN
    17581762                   DO  m = 1, surf_usm_h%ns
    … …  
    17691773            CASE ( 'usm_iwghf' )
    17701774!
    1771 !--             array of heat flux from indoor ground (wall, roof, land)
     1775!--             Array of heat flux from indoor ground (wall, roof, land)
    17721776                IF ( l == -1 )  THEN
    17731777                   DO  m = 1, surf_usm_h%ns
    … …  
    17831787            CASE ( 'usm_iwghf_window' )
    17841788!
    1785 !--             array of heat flux from indoor window ground (wall, roof, land)
     1789!--             Array of heat flux from indoor window ground (wall, roof, land)
    17861790                IF ( l == -1 )  THEN
    17871791                   DO  m = 1, surf_usm_h%ns
    … …  
    17981802            CASE ( 'usm_t_surf_wall' )
    17991803!
    1800 !--             surface temperature for surfaces
     1804!--             Surface temperature for surfaces
    18011805                IF ( l == -1 )  THEN
    18021806                   DO  m = 1, surf_usm_h%ns
    … …  
    18121816            CASE ( 'usm_t_surf_window' )
    18131817!
    1814 !--             surface temperature for window surfaces
     1818!--             Surface temperature for window surfaces
    18151819                IF ( l == -1 )  THEN
    18161820                   DO  m = 1, surf_usm_h%ns
    … …  
    18271831            CASE ( 'usm_t_surf_green' )
    18281832!
    1829 !--             surface temperature for green surfaces
     1833!--             Surface temperature for green surfaces
    18301834                IF ( l == -1 )  THEN
    18311835                   DO  m = 1, surf_usm_h%ns
    … …  
    18421846            CASE ( 'usm_theta_10cm' )
    18431847!
    1844 !--             near surface temperature for whole surfaces
     1848!--             Near surface temperature for whole surfaces
    18451849                IF ( l == -1 )  THEN
    18461850                   DO  m = 1, surf_usm_h%ns
    … …  
    18571861            CASE ( 'usm_t_wall' )
    18581862!
    1859 !--             wall temperature for  iwl layer of walls and land
     1863!--             Wall temperature for  iwl layer of walls and land
    18601864                IF ( l == -1 )  THEN
    18611865                   DO  m = 1, surf_usm_h%ns
    … …  
    18721876            CASE ( 'usm_t_window' )
    18731877!
    1874 !--             window temperature for  iwl layer of walls and land
     1878!--             Window temperature for  iwl layer of walls and land
    18751879                IF ( l == -1 )  THEN
    18761880                   DO  m = 1, surf_usm_h%ns
    … …  
    18871891            CASE ( 'usm_t_green' )
    18881892!
    1889 !--             green temperature for  iwl layer of walls and land
     1893!--             Green temperature for  iwl layer of walls and land
    18901894                IF ( l == -1 )  THEN
    18911895                   DO  m = 1, surf_usm_h%ns
    … …  
    19011905            CASE ( 'usm_swc' )
    19021906!
    1903 !--             soil water content for  iwl layer of walls and land
     1907!--             Soil water content for  iwl layer of walls and land
    19041908                IF ( l == -1 )  THEN
    19051909                   DO  m = 1, surf_usm_h%ns
    … …  
    19201924            CASE ( 'usm_wshf' )
    19211925!
    1922 !--             array of sensible heat flux from surfaces (land, roof, wall)
     1926!--             Array of sensible heat flux from surfaces (land, roof, wall)
    19231927                IF ( l == -1 )  THEN
    19241928                   DO  m = 1, surf_usm_h%ns
    … …  
    19351939            CASE ( 'usm_qsws' )
    19361940!
    1937 !--             array of latent heat flux from surfaces (land, roof, wall)
     1941!--             Array of latent heat flux from surfaces (land, roof, wall)
    19381942                IF ( l == -1 )  THEN
    19391943                DO  m = 1, surf_usm_h%ns
    … …  
    19501954            CASE ( 'usm_qsws_veg' )
    19511955!
    1952 !--             array of latent heat flux from vegetation surfaces (land, roof, wall)
     1956!--             Array of latent heat flux from vegetation surfaces (land, roof, wall)
    19531957                IF ( l == -1 )  THEN
    19541958                DO  m = 1, surf_usm_h%ns
    … …  
    19651969            CASE ( 'usm_qsws_liq' )
    19661970!
    1967 !--             array of latent heat flux from surfaces with liquid (land, roof, wall)
     1971!--             Array of latent heat flux from surfaces with liquid (land, roof, wall)
    19681972                IF ( l == -1 )  THEN
    19691973                DO  m = 1, surf_usm_h%ns
    … …  
    19801984            CASE ( 'usm_wghf' )
    19811985!
    1982 !--             array of heat flux from ground (wall, roof, land)
     1986!--             Array of heat flux from ground (wall, roof, land)
    19831987                IF ( l == -1 )  THEN
    19841988                   DO  m = 1, surf_usm_h%ns
    … …  
    19951999            CASE ( 'usm_wghf_window' )
    19962000!
    1997 !--             array of heat flux from window ground (wall, roof, land)
     2001!--             Array of heat flux from window ground (wall, roof, land)
    19982002                IF ( l == -1 )  THEN
    19992003                   DO  m = 1, surf_usm_h%ns
    … …  
    20102014            CASE ( 'usm_wghf_green' )
    20112015!
    2012 !--             array of heat flux from green ground (wall, roof, land)
     2016!--             Array of heat flux from green ground (wall, roof, land)
    20132017                IF ( l == -1 )  THEN
    20142018                   DO  m = 1, surf_usm_h%ns
    … …  
    20252029            CASE ( 'usm_iwghf' )
    20262030!
    2027 !--             array of heat flux from indoor ground (wall, roof, land)
     2031!--             Array of heat flux from indoor ground (wall, roof, land)
    20282032                IF ( l == -1 )  THEN
    20292033                   DO  m = 1, surf_usm_h%ns
    … …  
    20402044            CASE ( 'usm_iwghf_window' )
    20412045!
    2042 !--             array of heat flux from indoor window ground (wall, roof, land)
     2046!--             Array of heat flux from indoor window ground (wall, roof, land)
    20432047                IF ( l == -1 )  THEN
    20442048                   DO  m = 1, surf_usm_h%ns
    … …  
    20552059            CASE ( 'usm_t_surf_wall' )
    20562060!
    2057 !--             surface temperature for surfaces
     2061!--             Surface temperature for surfaces
    20582062                IF ( l == -1 )  THEN
    20592063                   DO  m = 1, surf_usm_h%ns
    … …  
    20702074            CASE ( 'usm_t_surf_window' )
    20712075!
    2072 !--             surface temperature for window surfaces
     2076!--             Surface temperature for window surfaces
    20732077                IF ( l == -1 )  THEN
    20742078                   DO  m = 1, surf_usm_h%ns
    … …  
    20852089            CASE ( 'usm_t_surf_green' )
    20862090!
    2087 !--             surface temperature for green surfaces
     2091!--             Surface temperature for green surfaces
    20882092                IF ( l == -1 )  THEN
    20892093                   DO  m = 1, surf_usm_h%ns
    … …  
    21002104            CASE ( 'usm_theta_10cm' )
    21012105!
    2102 !--             near surface temperature for whole surfaces
     2106!--             Near surface temperature for whole surfaces
    21032107                IF ( l == -1 )  THEN
    21042108                   DO  m = 1, surf_usm_h%ns
    … …  
    21162120            CASE ( 'usm_t_wall' )
    21172121!
    2118 !--             wall temperature for  iwl layer of walls and land
     2122!--             Wall temperature for  iwl layer of walls and land
    21192123                IF ( l == -1 )  THEN
    21202124                   DO  m = 1, surf_usm_h%ns
    … …  
    21312135            CASE ( 'usm_t_window' )
    21322136!
    2133 !--             window temperature for  iwl layer of walls and land
     2137!--             Window temperature for  iwl layer of walls and land
    21342138                IF ( l == -1 )  THEN
    21352139                   DO  m = 1, surf_usm_h%ns
    … …  
    21462150            CASE ( 'usm_t_green' )
    21472151!
    2148 !--             green temperature for  iwl layer of walls and land
     2152!--             Green temperature for  iwl layer of walls and land
    21492153                IF ( l == -1 )  THEN
    21502154                   DO  m = 1, surf_usm_h%ns
    … …  
    21612165            CASE ( 'usm_swc' )
    21622166!
    2163 !--             soil water content for  iwl layer of walls and land
     2167!--             Soil water content for  iwl layer of walls and land
    21642168                IF ( l == -1 )  THEN
    21652169                DO  m = 1, surf_usm_h%ns
    … …  
    22812285
    22822286!
    2283 !-- check if variable exists
    2284 !-- directional variables
     2287!-- Check if variable exists
     2288!-- Directional variables
    22852289    DO  i = 1, nl1
    22862290       DO  j = 1, nd
    … …  
    22942298    IF ( lfound )  GOTO 10
    22952299!
    2296 !-- directional layer variables
     2300!-- Directional layer variables
    22972301    DO  i = 1, nl2
    22982302       DO  j = 1, nd
    … …  
    23882392    ENDIF
    23892393!
    2390 !-- naheatlayers
     2394!-- Naheatlayers
    23912395    IF ( naheatlayers > nzt )  THEN
    23922396       message_string = 'number of anthropogenic heat layers "naheatlayers" can not be larger ' // &
    … …  
    24732477    IF ( var(1:11) == 'usm_t_wall_'  .AND.  len( TRIM( var ) ) >= 12 )  THEN
    24742478!
    2475 !--     wall layers
     2479!--     Wall layers
    24762480        READ( var(12:12), '(I1)', iostat = istat ) iwl
    24772481        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    24812485    IF ( var(1:13) == 'usm_t_window_'  .AND.  len( TRIM( var ) ) >= 14 )  THEN
    24822486!
    2483 !--     window layers
     2487!--     Window layers
    24842488        READ( var(14:14), '(I1)', iostat = istat ) iwl
    24852489        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    24892493    IF ( var(1:12) == 'usm_t_green_'  .AND.  len( TRIM( var ) ) >= 13 )  THEN
    24902494!
    2491 !--     green layers
     2495!--     Green layers
    24922496        READ( var(13:13), '(I1)', iostat = istat ) iwl
    24932497        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    24972501    IF ( var(1:8) == 'usm_swc_'  .AND.  len( TRIM( var ) ) >= 9 )  THEN
    24982502!
    2499 !--     green layers soil water content
     2503!--     Green layers soil water content
    25002504        READ( var(9:9), '(I1)', iostat = istat ) iwl
    25012505        IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
    … …  
    25082512      CASE ( 'usm_surfz' )
    25092513!
    2510 !--       array of surface height (z)
     2514!--       Array of surface height (z)
    25112515          IF ( idsint == iup_u )  THEN
    25122516             DO  m = 1, surf_usm_h%ns
    … …  
    25282532      CASE ( 'usm_surfcat' )
    25292533!
    2530 !--       surface category
     2534!--       Surface category
    25312535          IF ( idsint == iup_u )  THEN
    25322536             DO  m = 1, surf_usm_h%ns
    … …  
    25482552      CASE ( 'usm_surfwintrans' )
    25492553!
    2550 !--       transmissivity window tiles
     2554!--       Transmissivity window tiles
    25512555          IF ( idsint == iup_u )  THEN
    25522556             DO  m = 1, surf_usm_h%ns
    … …  
    25682572      CASE ( 'usm_wshf' )
    25692573!
    2570 !--       array of sensible heat flux from surfaces
     2574!--       Array of sensible heat flux from surfaces
    25712575          IF ( av == 0 )  THEN
    25722576             IF ( idsint == iup_u )  THEN
    … …  
    26082612      CASE ( 'usm_qsws' )
    26092613!
    2610 !--       array of latent heat flux from surfaces
     2614!--       Array of latent heat flux from surfaces
    26112615          IF ( av == 0 )  THEN
    26122616             IF ( idsint == iup_u )  THEN
    … …  
    26472651      CASE ( 'usm_qsws_veg' )
    26482652!
    2649 !--       array of latent heat flux from vegetation surfaces
     2653!--       Array of latent heat flux from vegetation surfaces
    26502654          IF ( av == 0 )  THEN
    26512655             IF ( idsint == iup_u )  THEN
    … …  
    26862690      CASE ( 'usm_qsws_liq' )
    26872691!
    2688 !--       array of latent heat flux from surfaces with liquid
     2692!--       Array of latent heat flux from surfaces with liquid
    26892693          IF ( av == 0 )  THEN
    26902694             IF ( idsint == iup_u )  THEN
    … …  
    27252729      CASE ( 'usm_wghf' )
    27262730!
    2727 !--       array of heat flux from ground (land, wall, roof)
     2731!--       Array of heat flux from ground (land, wall, roof)
    27282732          IF ( av == 0 )  THEN
    27292733             IF ( idsint == iup_u )  THEN
    … …  
    27642768      CASE ( 'usm_wghf_window' )
    27652769!
    2766 !--       array of heat flux from window ground (land, wall, roof)
     2770!--       Array of heat flux from window ground (land, wall, roof)
    27672771          IF ( av == 0 )  THEN
    27682772             IF ( idsint == iup_u )  THEN
    … …  
    28032807      CASE ( 'usm_wghf_green' )
    28042808!
    2805 !--       array of heat flux from green ground (land, wall, roof)
     2809!--       Array of heat flux from green ground (land, wall, roof)
    28062810          IF ( av == 0 )  THEN
    28072811             IF ( idsint == iup_u )  THEN
    … …  
    28422846      CASE ( 'usm_iwghf' )
    28432847!
    2844 !--       array of heat flux from indoor ground (land, wall, roof)
     2848!--       Array of heat flux from indoor ground (land, wall, roof)
    28452849          IF ( av == 0 )  THEN
    28462850             IF ( idsint == iup_u )  THEN
    … …  
    28812885      CASE ( 'usm_iwghf_window' )
    28822886!
    2883 !--       array of heat flux from indoor window ground (land, wall, roof)
     2887!--       Array of heat flux from indoor window ground (land, wall, roof)
    28842888          IF ( av == 0 )  THEN
    28852889             IF ( idsint == iup_u )  THEN
    … …  
    29202924      CASE ( 'usm_t_surf_wall' )
    29212925!
    2922 !--       surface temperature for surfaces
     2926!--       Surface temperature for surfaces
    29232927          IF ( av == 0 )  THEN
    29242928             IF ( idsint == iup_u )  THEN
    … …  
    29592963      CASE ( 'usm_t_surf_window' )
    29602964!
    2961 !--       surface temperature for window surfaces
     2965!--       Surface temperature for window surfaces
    29622966          IF ( av == 0 )  THEN
    29632967             IF ( idsint == iup_u )  THEN
    … …  
    30013005      CASE ( 'usm_t_surf_green' )
    30023006!
    3003 !--       surface temperature for green surfaces
     3007!--       Surface temperature for green surfaces
    30043008          IF ( av == 0 )  THEN
    30053009             IF ( idsint == iup_u )  THEN
    … …  
    30433047      CASE ( 'usm_theta_10cm' )
    30443048!
    3045 !--       near surface temperature for whole surfaces
     3049!--       Near surface temperature for whole surfaces
    30463050          IF ( av == 0 )  THEN
    30473051             IF ( idsint == iup_u )  THEN
    … …  
    30853089      CASE ( 'usm_t_wall' )
    30863090!
    3087 !--       wall temperature for  iwl layer of walls and land
     3091!--       Wall temperature for  iwl layer of walls and land
    30883092          IF ( av == 0 )  THEN
    30893093             IF ( idsint == iup_u )  THEN
    … …  
    31243128      CASE ( 'usm_t_window' )
    31253129!
    3126 !--       window temperature for iwl layer of walls and land
     3130!--       Window temperature for iwl layer of walls and land
    31273131          IF ( av == 0 )  THEN
    31283132             IF ( idsint == iup_u )  THEN
    … …  
    31633167      CASE ( 'usm_t_green' )
    31643168!
    3165 !--       green temperature for  iwl layer of walls and land
     3169!--       Green temperature for  iwl layer of walls and land
    31663170          IF ( av == 0 )  THEN
    31673171             IF ( idsint == iup_u )  THEN
    … …  
    32023206          CASE ( 'usm_swc' )
    32033207!
    3204 !--       soil water content for  iwl layer of walls and land
     3208!--       Soil water content for  iwl layer of walls and land
    32053209          IF ( av == 0 )  THEN
    32063210             IF ( idsint == iup_u )  THEN
    … …  
    33463350       IF (surf_usm_h%green_type_roof(m) == 2.0_wp )  THEN
    33473351!
    3348 !-- extensive green roof
    3349 !-- set ratio of substrate layer thickness, soil-type and LAI
     3352!-- Extensive green roof
     3353!-- Set ratio of substrate layer thickness, soil-type and LAI
    33503354          soil_type = 3
    33513355          surf_usm_h%lai(m) = 2.0_wp
    … …  
    33573361       ELSE
    33583362!
    3359 !-- intensiv green roof
    3360 !-- set ratio of substrate layer thickness, soil-type and LAI
     3363!-- Intensiv green roof
     3364!-- Set ratio of substrate layer thickness, soil-type and LAI
    33613365          soil_type = 6
    33623366          surf_usm_h%lai(m) = 4.0_wp
    … …  
    35603564    CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
    35613565!
    3562 !-- surface forcing has to be disabled for LSF in case of enabled urban surface module
     3566!-- Surface forcing has to be disabled for LSF in case of enabled urban surface module
    35633567    IF ( large_scale_forcing )  THEN
    35643568        lsf_surf = .FALSE.
    … …  
    36943698        surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)
    36953699!
    3696 !--     emissivity of wall-, green- and window fraction
     3700!--     Emissivity of wall-, green- and window fraction
    36973701        surf_usm_h%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall_r,building_type)
    36983702        surf_usm_h%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,building_type)
    … …  
    37053709        surf_usm_h%z0q(m)                      = building_pars(ind_z0qh,building_type)
    37063710!
    3707 !--     albedo type for wall fraction, green fraction, window fraction
     3711!--     Albedo type for wall fraction, green fraction, window fraction
    37083712        surf_usm_h%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall_r,building_type) )
    37093713        surf_usm_h%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,building_type) )
    … …  
    37323736        DO  m = 1, surf_usm_v(l)%ns
    37333737
    3734            surf_usm_v(l)%surface_types(m) = wall_category         !< default category for root surface
     3738           surf_usm_v(l)%surface_types(m) = wall_category     !< Default category for root surface
    37353739!
    37363740!--        In order to distinguish between ground floor level and above-ground-floor level surfaces,
    … …  
    38503854           surf_usm_v(l)%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,building_type)
    38513855!
    3852 !--        emissivity of wall-, green- and window fraction
     3856!--        Emissivity of wall-, green- and window fraction
    38533857           surf_usm_v(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall,building_type)
    38543858           surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,building_type)
    … …  
    39433947              surf_usm_h%target_temp_winter(m)  = building_pars(ind_indoor_target_temp_winter,st)
    39443948!
    3945 !--           emissivity of wall-, green- and window fraction
     3949!--           Emissivity of wall-, green- and window fraction
    39463950              surf_usm_h%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall_r,st)
    39473951              surf_usm_h%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,st)
    … …  
    39543958              surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,st)
    39553959!
    3956 !--           albedo type for wall fraction, green fraction, window fraction
     3960!--           Albedo type for wall fraction, green fraction, window fraction
    39573961              surf_usm_h%albedo_type(m,ind_veg_wall)  = INT( building_pars(ind_alb_wall_r,st) )
    39583962              surf_usm_h%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,st) )
    … …  
    41064110                 surf_usm_v(l)%target_temp_winter(m) = building_pars(ind_indoor_target_temp_winter,st)
    41074111!
    4108 !--              emissivity of wall-, green- and window fraction
     4112!--              Emissivity of wall-, green- and window fraction
    41094113                 surf_usm_v(l)%emissivity(m,ind_veg_wall)  = building_pars(ind_emis_wall,st)
    41104114                 surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,st)
    … …  
    46594663                 ENDIF
    46604664
    4661                  EXIT ! surface was found and processed
     4665                 EXIT ! Surface was found and processed
    46624666              ENDIF
    46634667           ENDDO
    … …  
    46914695                       surf_usm_v(l)%frac(m,ind_pav_green) =                                       &
    46924696                       building_surface_pars_f%pars(ind_s_green_frac_r,is)
    4693                        !TODO clarify: why should _w and _r be on the same surface?
     4697                       !TODO Clarify: why should _w and _r be on the same surface?
    46944698
    46954699                    IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /=                        &
    … …  
    48024806                    ENDIF
    48034807
    4804                     EXIT ! surface was found and processed
     4808                    EXIT ! Surface was found and processed
    48054809                 ENDIF
    48064810              ENDDO
    … …  
    48834887     CALL usm_init_material_model()
    48844888
    4885 !--  init skin layer properties (can be done after initialization of wall layers)
     4889!--  Init skin layer properties (can be done after initialization of wall layers)
    48864890
    48874891     DO  m = 1, surf_usm_h%ns
    … …  
    49244928
    49254929!
    4926 !--  init anthropogenic sources of heat
     4930!--  Init anthropogenic sources of heat
    49274931     IF ( usm_anthropogenic_heat )  THEN
    49284932!
    4929 !--      init anthropogenic sources of heat (from transportation for now)
     4933!--      Init anthropogenic sources of heat (from transportation for now)
    49304934         CALL usm_read_anthropogenic_heat()
    49314935     ENDIF
    … …  
    50315035         ENDIF
    50325036!
    5033 !--      initial values for t_wall
    5034 !--      outer value is set to surface temperature, inner value is set to wall_inner_temperature
     5037!--      Initial values for t_wall
     5038!--      Outer value is set to surface temperature, inner value is set to wall_inner_temperature
    50355039!--      and profile is logaritmic (linear in nz).
    50365040!--      Horizontal surfaces
    … …  
    50905094
    50915095!
    5092 !--  initialize prognostic values for the first timestep
     5096!--  Initialize prognostic values for the first timestep
    50935097     t_surf_wall_h_p = t_surf_wall_h
    50945098     t_surf_wall_v_p = t_surf_wall_v
    … …  
    51825186       k = surf_usm_h%k(m)
    51835187!
    5184 !--    prognostic equation for ground/roof temperature t_wall_h
     5188!--    Prognostic equation for ground/roof temperature t_wall_h
    51855189       wtend(:) = 0.0_wp
    51865190       wtend(nzb_wall) = ( 1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m) )                            &
    … …  
    52065210                            ) * surf_usm_h%ddz_wall_stag(nzb_wall,m)
    52075211!
    5208 !-- if indoor model is used inner wall layer is calculated by using iwghf (indoor wall ground heat flux)
     5212!-- If indoor model is used inner wall layer is calculated by using iwghf (indoor wall ground heat flux)
    52095213       IF ( indoor_model )  THEN
    52105214          DO  kw = nzb_wall+1, nzt_wall-1
    … …  
    52455249
    52465250!
    5247 !-- during spinup the tempeature inside window layers is not calculated to make larger timesteps possible
     5251!-- During spinup the tempeature inside window layers is not calculated to make larger timesteps possible
    52485252       IF ( .NOT. during_spinup )  THEN
    52495253          win_absorp = -log( surf_usm_h%transmissivity(m) ) / surf_usm_h%zw_window(nzt_wall,m)
    52505254!
    5251 !--       prognostic equation for ground/roof window temperature t_window_h takes absorption of
     5255!--       Prognostic equation for ground/roof window temperature t_window_h takes absorption of
    52525256!--       shortwave radiation into account
    52535257          wintend(:) = 0.0_wp
    … …  
    53125316
    53135317!
    5314 !--    calculate t_wall tendencies for the next Runge-Kutta step
     5318!--    Calculate t_wall tendencies for the next Runge-Kutta step
    53155319       IF ( timestep_scheme(1:5) == 'runge' )  THEN
    53165320           IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    53285332       IF ( .NOT. during_spinup )  THEN
    53295333!
    5330 !--       calculate t_window tendencies for the next Runge-Kutta step
     5334!--       Calculate t_window tendencies for the next Runge-Kutta step
    53315335          IF ( timestep_scheme(1:5) == 'runge' )  THEN
    53325336              IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    53565360          k = surf_usm_v(l)%k(m)
    53575361!
    5358 !--       prognostic equation for wall temperature t_wall_v
     5362!--       Prognostic equation for wall temperature t_wall_v
    53595363          wtend(:) = 0.0_wp
    53605364
    … …  
    54255429                          surf_usm_v(l)%zw_window(nzt_wall,m)
    54265430!
    5427 !--          prognostic equation for window temperature t_window_v
     5431!--          Prognostic equation for window temperature t_window_v
    54285432             wintend(:) = 0.0_wp
    54295433             wintend(nzb_wall) = ( 1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m) )               &
    … …  
    54925496
    54935497!
    5494 !--       calculate t_wall tendencies for the next Runge-Kutta step
     5498!--       Calculate t_wall tendencies for the next Runge-Kutta step
    54955499          IF ( timestep_scheme(1:5) == 'runge' )  THEN
    54965500              IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    55095513          IF ( .NOT. during_spinup )  THEN
    55105514!
    5511 !--          calculate t_window tendencies for the next Runge-Kutta step
     5515!--          Calculate t_window tendencies for the next Runge-Kutta step
    55125516             IF ( timestep_scheme(1:5) == 'runge' )  THEN
    55135517                 IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    58375841          IF (surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp)  THEN
    58385842!
    5839 !-- no substrate layer for green walls / only groundbase green walls (ivy i.e.) -> green layers get
     5843!-- No substrate layer for green walls / only groundbase green walls (ivy i.e.) -> Green layers get
    58405844!-- same temperature as first wall layer, therefore no temperature calculations for vertical green
    58415845!-- substrate layers now
    … …  
    58505854!              t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
    58515855! !
    5852 ! !--          prognostic equation for green temperature t_green_v
     5856! !--          Prognostic equation for green temperature t_green_v
    58535857!              gtend(:) = 0.0_wp
    58545858!              gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
    … …  
    58785882!
    58795883! !
    5880 ! !--          calculate t_green tendencies for the next Runge-Kutta step
     5884! !--          Calculate t_green tendencies for the next Runge-Kutta step
    58815885!              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    58825886!                  IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    60376041        IF ( ii == io_group )  THEN
    60386042
    6039 !--         open anthropogenic heat file
     6043!--         Open anthropogenic heat file
    60406044            OPEN( 151, file = 'ANTHROPOGENIC_HEAT' // TRIM( coupling_char ), action = 'read',      &
    60416045                  status = 'old', form = 'formatted', err = 11 )
    … …  
    60466050                IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.  j <= nyn )  THEN
    60476051                    IF ( k <= naheatlayers  .AND.  k > topo_top_ind(j,i,0) )  THEN
    6048 !--                     write heat into the array
     6052!--                     Write heat into the array
    60496053                        aheat(k,j,i) = heat
    60506054                    ENDIF
    … …  
    67046708
    67056709!
    6706 !-- read categories of walls and their parameters
     6710!-- Read categories of walls and their parameters
    67076711    DO  ii = 0, io_blocks-1
    67086712        IF ( ii == io_group )  THEN
    67096713!
    6710 !--         open urban surface file
     6714!--         Open urban surface file
    67116715            OPEN( 151, file = 'SURFACE_PARAMETERS' // coupling_char,  action = 'read', &
    67126716                       status = 'old', form = 'formatted', err = 15 )
    67136717!
    6714 !--         first test and get n_surface_types
     6718!--         First test and get n_surface_types
    67156719            k = 0
    67166720            l = 0
    … …  
    67276731            ALLOCATE( surface_params(n_surface_params, n_surface_types) )
    67286732!
    6729 !--         real reading
     6733!--         Real reading
    67306734            rewind( 151 )
    67316735            k = 0
    … …  
    67496753
    67506754!
    6751 !-- read types of surfaces
     6755!-- Read types of surfaces
    67526756    usm_par = 0
    67536757    DO  ii = 0, io_blocks-1
    … …  
    67556759
    67566760!
    6757 !--         open csv urban surface file
     6761!--         Open csv urban surface file
    67586762            OPEN( 151, file = 'URBAN_SURFACE' // TRIM( coupling_char ), action = 'read',           &
    67596763                  status = 'old', form = 'formatted', err = 23 )
    … …  
    67786782               IF ( i >= nxlg  .AND.  i <= nxrg  .AND.  j >= nysg  .AND.  j <= nyng )  THEN
    67796783!
    6780 !--                write integer variables into array
     6784!--                Write integer variables into array
    67816785                   usm_par(:,j,i) = (/1, nz, roof, dirwe, dirsn, category,                         &
    67826786                                     weheight1, wecat1, weheight2, wecat2, weheight3, wecat3,      &
    67836787                                     snheight1, sncat1, snheight2, sncat2, snheight3, sncat3 /)
    67846788!
    6785 !--                write real values into array
     6789!--                Write real values into array
    67866790                   usm_val(:,j,i) = (/ albedo, thick,                                              &
    67876791                                      wealbedo1, wethick1, wealbedo2, wethick2,                    &
    … …  
    68076811
    68086812!
    6809 !-- check completeness and formal correctness of the data
     6813!-- Check completeness and formal correctness of the data
    68106814    DO  i = nxlg, nxrg
    68116815        DO  j = nysg, nyng
    … …  
    68296833                ) )  THEN
    68306834!
    6831 !--             incorrect input data
     6835!--             Incorrect input data
    68326836                WRITE( message_string, '(A,2I5)' )                                                 &
    68336837                'missing or incorrect data in file URBAN_SURFACE' //  TRIM( coupling_char ) //     &
    … …  
    68526856          IF ( zu(kw) >= roof_height_limit )  THEN
    68536857             surf_usm_h%isroof_surf(m)   = .TRUE.
    6854              surf_usm_h%surface_types(m) = roof_category !< default category for root surface
     6858             surf_usm_h%surface_types(m) = roof_category !< Default category for root surface
    68556859          ELSE
    68566860             surf_usm_h%isroof_surf(m)   = .FALSE.
    6857              surf_usm_h%surface_types(m) = land_category !< default category for land surface
     6861             surf_usm_h%surface_types(m) = land_category !< Default category for land surface
    68586862          ENDIF
    68596863
    … …  
    68906894       IF ( ip == -99999 )  THEN
    68916895!
    6892 !--       land/roof category not found
     6896!--       Land/roof category not found
    68936897          WRITE(9, '(A, I5, A, 3I5)' ) 'land/roof category ', it, ' not found  for i, j, k = ',    &
    68946898                                       iw, jw, kw
    … …  
    69076911          IF ( ip == -99999 )  THEN
    69086912!
    6909 !--          default land/roof category not found
     6913!--          Default land/roof category not found
    69106914             WRITE( 9, '(A, I5, A, 3I5)' ) 'Default land/roof category ', category, ' not found!'
    69116915             FLUSH( 9 )
    … …  
    69276931       ENDIF
    69286932!
    6929 !--    emissivity of the wall
     6933!--    Emissivity of the wall
    69306934       surf_usm_h%emissivity(m,:) = surface_params(iemiss, ip)
    69316935!
    6932 !--    heat conductivity λS between air and wall ( W m−2 K−1 )
     6936!--    Heat conductivity λS between air and wall ( W m−2 K−1 )
    69336937       surf_usm_h%lambda_surf(m)        = surface_params(ilambdas,ip)
    69346938       surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
    69356939       surf_usm_h%lambda_surf_green(m)  = surface_params(ilambdas,ip)
    69366940!
    6937 !--    roughness length for momentum, heat and humidity
     6941!--    Roughness length for momentum, heat and humidity
    69386942       surf_usm_h%z0(m)  = surface_params(irough,ip)
    69396943       surf_usm_h%z0h(m) = surface_params(iroughh,ip)
    … …  
    69456949       surf_usm_h%c_surface_green(m)  = surface_params(icsurf,ip)
    69466950!
    6947 !--    wall material parameters:
    6948 !--    thickness of the wall (m) missing values are replaced by default value for category
     6951!--    Wall material parameters:
     6952!--    Thickness of the wall (m) missing values are replaced by default value for category
    69496953       IF ( surf_usm_h%thickness_wall(m) <= 0.001_wp )  THEN
    69506954            surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
    … …  
    69576961       ENDIF
    69586962!
    6959 !--    volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
     6963!--    Volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
    69606964       surf_usm_h%rho_c_wall(:,m)   = surface_params(irhoC,ip)
    69616965       surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
    69626966       surf_usm_h%rho_c_green(:,m)  = surface_params(irhoC,ip)
    69636967!
    6964 !--    thermal conductivity λH of the wall (W m−1 K−1 )
     6968!--    Thermal conductivity λH of the wall (W m−1 K−1 )
    69656969       surf_usm_h%lambda_h(:,m)        = surface_params(ilambdah,ip)
    69666970       surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
    … …  
    69816985          kw = surf_usm_v(l)%k(m)
    69826986
    6983           IF ( l == 3 )  THEN ! westward facing
     6987          IF ( l == 3 )  THEN ! Westward facing
    69846988             iw = i
    69856989             jw = j
    … …  
    70057009          IF ( iw < 0 .OR. jw < 0 ) THEN
    70067010!
    7007 !--          wall on west or south border of the domain - assign default category
     7011!--          Wall on west or south border of the domain - assign default category
    70087012             IF ( kw <= roof_height_limit ) THEN
    7009                  surf_usm_v(l)%surface_types(m) = wall_category   !< default category for wall surface in wall zone
     7013                 surf_usm_v(l)%surface_types(m) = wall_category   !< Default category for wall surface in wall zone
    70107014             ELSE
    7011                  surf_usm_v(l)%surface_types(m) = roof_category   !< default category for wall surface in roof zone
     7015                 surf_usm_v(l)%surface_types(m) = roof_category   !< Default category for wall surface in roof zone
    70127016             ENDIF
    70137017             surf_usm_v(l)%albedo(m,:)         = -1.0_wp
    … …  
    70187022          ELSE IF ( kw <= usm_par(ii,jw,iw) )  THEN
    70197023!
    7020 !--             pedestrian zone
     7024!--             Pedestrian zone
    70217025             IF ( usm_par(ii+1,jw,iw) == 0 )  THEN
    7022                  surf_usm_v(l)%surface_types(m)  = pedestrian_category   !< default category for wall surface in
    7023                                                                          !< pedestrian zone
     7026                 surf_usm_v(l)%surface_types(m)  = pedestrian_category   !< Default category for wall surface in
     7027                                                                         !< Pedestrian zone
    70247028                 surf_usm_v(l)%albedo(m,:)         = -1.0_wp
    70257029                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
    … …  
    70377041          ELSE IF ( kw <= usm_par(ii+2,jw,iw) )  THEN
    70387042!
    7039 !--          wall zone
     7043!--          Wall zone
    70407044             IF ( usm_par(ii+3,jw,iw) == 0 )  THEN
    70417045                 surf_usm_v(l)%surface_types(m)    = wall_category  !< default category for wall surface
    … …  
    70557059          ELSE IF ( kw <= usm_par(ii+4,jw,iw) )  THEN
    70567060!
    7057 !--          roof zone
     7061!--          Roof zone
    70587062             IF ( usm_par(ii+5,jw,iw) == 0 )  THEN
    7059                  surf_usm_v(l)%surface_types(m)    = roof_category  !< default category for roof surface
     7063                 surf_usm_v(l)%surface_types(m)    = roof_category  !< Default category for roof surface
    70607064                 surf_usm_v(l)%albedo(m,:)         = -1.0_wp
    70617065                 surf_usm_v(l)%thickness_wall(m)   = -1.0_wp
    … …  
    70817085             FLUSH( 9 )
    70827086!
    7083 !--          supply the default category
     7087!--          Supply the default category
    70847088             IF ( kw <= roof_height_limit )  THEN
    7085                  surf_usm_v(l)%surface_types(m) = wall_category  !< default category for wall surface in wall zone
     7089                 surf_usm_v(l)%surface_types(m) = wall_category  !< Default category for wall surface in wall zone
    70867090             ELSE
    7087                  surf_usm_v(l)%surface_types(m) = roof_category  !< default category for wall surface in roof zone
     7091                 surf_usm_v(l)%surface_types(m) = roof_category  !< Default category for wall surface in roof zone
    70887092             ENDIF
    70897093             surf_usm_v(l)%albedo(m,:)         = -1.0_wp
    … …  
    71057109          IF ( ip == -99999 )  THEN
    71067110!
    7107 !--          wall category not found
     7111!--          Wall category not found
    71087112             WRITE( 9, '(A,I7,A,3I5)' ) 'wall category ', it, ' not found  for i,j,k = ', iw, jw, kw
    71097113             FLUSH(9)
    … …  
    71177121             IF ( ip == -99999 )  THEN
    71187122!
    7119 !--             default wall category not found
     7123!--             Default wall category not found
    71207124                WRITE ( 9, '(A,I5,A,3I5)' ) 'Default wall category', category, ' not found!'
    71217125                FLUSH( 9 )
    … …  
    71367140          ENDIF
    71377141!
    7138 !--       emissivity of the wall
     7142!--       Emissivity of the wall
    71397143          surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
    71407144!
    7141 !--       heat conductivity lambda S between air and wall ( W m-2 K-1 )
     7145!--       Heat conductivity lambda S between air and wall ( W m-2 K-1 )
    71427146          surf_usm_v(l)%lambda_surf(m)        = surface_params(ilambdas,ip)
    71437147          surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
    71447148          surf_usm_v(l)%lambda_surf_green(m)  = surface_params(ilambdas,ip)
    71457149!
    7146 !--       roughness length
     7150!--       Roughness length
    71477151          surf_usm_v(l)%z0(m)  = surface_params(irough,ip)
    71487152          surf_usm_v(l)%z0h(m) = surface_params(iroughh,ip)
    … …  
    71547158          surf_usm_v(l)%c_surface_green(m)  = surface_params(icsurf,ip)
    71557159!
    7156 !--       wall material parameters:
    7157 !--       thickness of the wall (m)
    7158 !--       missing values are replaced by default value for category
     7160!--       Wall material parameters:
     7161!--       Thickness of the wall (m)
     7162!--       Missing values are replaced by default value for category
    71597163          IF ( surf_usm_v(l)%thickness_wall(m) <= 0.001_wp )  THEN
    71607164               surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
    … …  
    71677171          ENDIF
    71687172!
    7169 !--       volumetric heat capacity rho*C of the wall ( J m-3 K-1 )
     7173!--       Volumetric heat capacity rho*C of the wall ( J m-3 K-1 )
    71707174          surf_usm_v(l)%rho_c_wall(:,m)   = surface_params(irhoC,ip)
    71717175          surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
    71727176          surf_usm_v(l)%rho_c_green(:,m)  = surface_params(irhoC,ip)
    71737177!
    7174 !--       thermal conductivity lambda H of the wall (W m-1 K-1 )
     7178!--       Thermal conductivity lambda H of the wall (W m-1 K-1 )
    71757179          surf_usm_v(l)%lambda_h(:,m)        = surface_params(ilambdah,ip)
    71767180          surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
    … …  
    71897193    ENDDO
    71907194!
    7191 !-- apply for all particular surface grids. First for horizontal surfaces
     7195!-- Apply for all particular surface grids. First for horizontal surfaces
    71927196    DO  m = 1, surf_usm_h%ns
    71937197       surf_usm_h%zw(:,m)        = zwn(:) * surf_usm_h%thickness_wall(m)
    … …  
    72647268        IF ( ii == io_group )  THEN
    72657269!
    7266 !--         open wall temperature file
     7270!--         Open wall temperature file
    72677271            OPEN( 152, file = 'WALL_TEMPERATURE' // coupling_char, action = 'read', &
    72687272                       status = 'old', form = 'formatted', err = 15 )
    … …  
    72717275            iline = 1
    72727276            DO
    7273                 rtwall = -9999.0_wp  !< for incomplete lines
     7277                rtwall = -9999.0_wp  !< For incomplete lines
    72747278                READ( 152, *, err = 13, end = 14 )  i, j, k, d, rtsurf, rtwall
    72757279
    7276                 IF ( nxl <= i .AND. i <= nxr .AND. nys <= j .AND. j <= nyn)  THEN  !< local processor
     7280                IF ( nxl <= i .AND. i <= nxr .AND. nys <= j .AND. j <= nyn)  THEN  !< Local processor
    72777281!--                 identify surface id
    72787282                    isurfl = find_surface( i, j, k, d )
    … …  
    72847288                    ENDIF
    72857289!
    7286 !--                 assign temperatures
     7290!--                 Assign temperatures
    72877291                    IF ( d == 0 )  THEN
    72887292                       t_surf_wall_h(isurfl) = rtsurf
    … …  
    74467450       ENDIF
    74477451!
    7448 !--    calculate rho * c_p coefficient at surface layer
     7452!--    Calculate rho * c_p coefficient at surface layer
    74497453       rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exner(k) )
    74507454
    … …  
    74867490
    74877491!
    7488 !--    factor for shf_eb
     7492!--    Factor for shf_eb
    74897493       f_shf         = rho_cp / surf_usm_h%r_a(m)
    74907494       f_shf_window  = rho_cp / surf_usm_h%r_a_window(m)
    … …  
    74977501!--       ECMWF documentation
    74987502
    7499 !--       f1: correction for incoming shortwave radiation (stomata close at night)
     7503!--       f1: Correction for incoming shortwave radiation (stomata close at night)
    75007504          f1 = MIN( 1.0_wp, ( 0.004_wp * surf_usm_h%rad_sw_in(m) + 0.05_wp ) /                     &
    75017505                    (0.81_wp * ( 0.004_wp * surf_usm_h%rad_sw_in(m) + 1.0_wp ) ) )
    75027506!
    7503 !--       f2: correction for soil moisture availability to plants (the integrated soil moisture must
     7507!--       f2: Correction for soil moisture availability to plants (the integrated soil moisture must
    75047508!--       thus be considered here) f2 = 0 for very dry soils
    75057509          m_total = 0.0_wp
    … …  
    75217525                                           / ( t_surf_green_h(m) - 35.86_wp ) )
    75227526!
    7523 !--       f3: correction for vapour pressure deficit
     7527!--       f3: Correction for vapour pressure deficit
    75247528          IF ( surf_usm_h%g_d(m) /= 0.0_wp )  THEN
    75257529!
    … …  
    75747578       ENDIF
    75757579!
    7576 !--    add LW up so that it can be removed in prognostic equation
     7580!--    Add LW up so that it can be removed in prognostic equation
    75777581       surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m)  - surf_usm_h%rad_sw_out(m) +             &
    75787582                                 surf_usm_h%rad_lw_in(m)  - surf_usm_h%rad_lw_out(m)
    75797583!
    7580 !--    numerator of the prognostic equation
     7584!--    Numerator of the prognostic equation
    75817585!--    Todo: Adjust to tile approach. So far, emissivity for wall (element 0) is used
    75827586       coef_1 = surf_usm_h%rad_net_l(m) + ( 3.0_wp + 1.0_wp )                                      &
    … …  
    76037607       ENDIF
    76047608!
    7605 !--    denominator of the prognostic equation
     7609!--    Denominator of the prognostic equation
    76067610       coef_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_veg_wall) * sigma_sb * t_surf_wall_h(m)**3    &
    76077611                + lambda_surface + f_shf / exner(k)
    … …  
    76197623       ENDIF
    76207624!
    7621 !--    implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
     7625!--    Implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
    76227626       t_surf_wall_h_p(m) = ( coef_1 * dt_3d * tsc(2) + surf_usm_h%c_surface(m)                    &
    76237627                              * t_surf_wall_h(m) )                                                 &
    … …  
    76327636                             /  ( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
    76337637!
    7634 !--    add RK3 term
     7638!--    Add RK3 term
    76357639       t_surf_wall_h_p(m) = t_surf_wall_h_p(m) + dt_3d * tsc(3) *  surf_usm_h%tt_surface_wall_m(m)
    76367640
    … …  
    76507654       IF ( humidity )  surf_usm_h%vpt_surface(m) = surf_usm_h%pt_surface(m)
    76517655!
    7652 !--    calculate true tendency
     7656!--    Calculate true tendency
    76537657       stend_wall = ( t_surf_wall_h_p(m) - t_surf_wall_h(m) - dt_3d * tsc(3) *                     &
    76547658                      surf_usm_h%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
    … …  
    76587662                       surf_usm_h%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
    76597663!
    7660 !--    calculate t_surf tendencies for the next Runge-Kutta step
     7664!--    Calculate t_surf tendencies for the next Runge-Kutta step
    76617665       IF ( timestep_scheme(1:5) == 'runge' )  THEN
    76627666          IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    76747678       ENDIF
    76757679!
    7676 !--    in case of fast changes in the skin temperature, it is required to update the radiative
     7680!--    In case of fast changes in the skin temperature, it is required to update the radiative
    76777681!--    fluxes in order to keep the solution stable
    76787682       IF ( ( ( ABS( t_surf_wall_h_p(m)   - t_surf_wall_h(m) )   > 1.0_wp )   .OR.                 &
    … …  
    76837687       ENDIF
    76847688!
    7685 !--    calculate fluxes
    7686 !--    rad_net_l is never used!
     7689!--    Calculate fluxes
     7690!--    Rad_net_l is never used!
    76877691       surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) + surf_usm_h%frac(m,ind_veg_wall)         &
    76887692                                 * sigma_sb * surf_usm_h%emissivity(m,ind_veg_wall)                &
    … …  
    77027706
    77037707!
    7704 !--    ground/wall/roof surface heat flux
     7708!--    Ground/wall/roof surface heat flux
    77057709       surf_usm_h%wshf_eb(m)   = - f_shf  * ( surf_usm_h%pt1(m) - t_surf_wall_h_p(m) / exner(k) )  &
    77067710                                 * surf_usm_h%frac(m,ind_veg_wall) - f_shf_window                  &
    … …  
    77107714                                 * surf_usm_h%frac(m,ind_pav_green)
    77117715!
    7712 !--    store kinematic surface heat fluxes for utilization in other processes diffusion_s,
     7716!--    Store kinematic surface heat fluxes for utilization in other processes diffusion_s,
    77137717!--    surface_layer_fluxes,...
    77147718       surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / c_p
    … …  
    78627866           ENDIF
    78637867!
    7864 !--        calculate rho * c_p coefficient at wall layer
     7868!--        Calculate rho * c_p coefficient at wall layer
    78657869           rho_cp  = c_p * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exner(k) )
    78667870
    … …  
    78747878!--        Calculation of r_a for vertical surfaces
    78757879!--
    7876 !--        heat transfer coefficient for forced convection along vertical walls follows formulation
     7880!--        Heat transfer coefficient for forced convection along vertical walls follows formulation
    78777881!--        in TUF3d model (Krayenhoff & Voogt, 2006)
    78787882!--
    … …  
    78807884!--        httc = rw * (11.8 + 4.2 * Ueff) - 4.0
    78817885!--
    7882 !--             rw: wall patch roughness relative to 1.0 for concrete
    7883 !--             Ueff: effective wind speed
     7886!--             rw: Wall patch roughness relative to 1.0 for concrete
     7887!--             Ueff: Effective wind speed
    78847888!--             - 4.0 is a reduction of Rowley et al (1930) formulation based on
    78857889!--             Cole and Sturrock (1977)
    78867890!--
    78877891!--             Ucan: Canyon wind speed
    7888 !--             wstar: convective velocity
    7889 !--             Qs: surface heat flux
    7890 !--             zH: height of the convective layer
     7892!--             wstar: Convective velocity
     7893!--             Qs: Surface heat flux
     7894!--             zH: Height of the convective layer
    78917895!--             wstar = (g/Tcan*Qs*zH)**(1./3.)
    78927896!--        Effective velocity components must always be defined at scalar grid point. The wall
    … …  
    79177921                                / (0.81_wp * (0.004_wp * surf_usm_v(l)%rad_sw_in(m) + 1.0_wp) ) )
    79187922!
    7919 !--           f2: correction for soil moisture availability to plants (the integrated soil moisture
     7923!--           f2: Correction for soil moisture availability to plants (the integrated soil moisture
    79207924!--           must thus be considered here) f2 = 0 for very dry soils
    79217925              f2=1.0_wp
    … …  
    79267930                                               / (  t_surf_green_v_p(l)%t(m) - 35.86_wp ) )
    79277931!
    7928 !--           f3: correction for vapour pressure deficit
     7932!--           f3: Correction for vapour pressure deficit
    79297933              IF ( surf_usm_v(l)%g_d(m) /= 0.0_wp )  THEN
    79307934!
    … …  
    79727976
    79737977!
    7974 !--        add LW up so that it can be removed in prognostic equation
     7978!--        Add LW up so that it can be removed in prognostic equation
    79757979           surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_sw_in(m) - surf_usm_v(l)%rad_sw_out(m)   &
    79767980                                        + surf_usm_v(l)%rad_lw_in(m)  - surf_usm_v(l)%rad_lw_out(m)
    79777981!
    7978 !--        numerator of the prognostic equation
    7979            coef_1 = surf_usm_v(l)%rad_net_l(m) +                             & ! coef +1 corresponds to -lwout
     7982!--        Numerator of the prognostic equation
     7983           coef_1 = surf_usm_v(l)%rad_net_l(m) +                             & ! Coef +1 corresponds to -lwout
    79807984                                                                               ! included in calculation of radnet_l
    79817985           ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_veg_wall) *                        &
    … …  
    79847988                                   lambda_surface * t_wall_v(l)%t(nzb_wall,m)
    79857989           IF ( ( .NOT. during_spinup )  .AND.  ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN
    7986               coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                   & ! coef +1 corresponds to -lwout
     7990              coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                   & ! Coef +1 corresponds to -lwout
    79877991                                                                               ! included in calculation of radnet_l
    79887992             ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_wat_win) *                       &
    … …  
    79927996           ENDIF
    79937997           IF ( ( humidity )  .AND.  ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) )  THEN
    7994               coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                      & ! coef +1 corresponds to -lwout
     7998              coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                      & ! Coef +1 corresponds to -lwout
    79957999                                                                                 ! included in calculation of radnet_l
    79968000              ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb *         &
    … …  
    80008004                                   lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
    80018005           ELSE
    8002              coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                       & ! coef +1 corresponds to -lwout included
     8006             coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                       & ! Coef +1 corresponds to -lwout included
    80038007                                                                                 ! in calculation of radnet_l
    80048008             ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb *          &
    … …  
    80098013
    80108014!
    8011 !--        denominator of the prognostic equation
     8015!--        Denominator of the prognostic equation
    80128016           coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_veg_wall) * sigma_sb                   &
    80138017                    * t_surf_wall_v(l)%t(m)**3 + lambda_surface + f_shf / exner(k)
    … …  
    80258029           ENDIF
    80268030!
    8027 !--        implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
     8031!--        Implicit solution when the surface layer has no heat capacity, otherwise use RK3 scheme.
    80288032           t_surf_wall_v_p(l)%t(m) = ( coef_1 * dt_3d * tsc(2) + surf_usm_v(l)%c_surface(m)        &
    80298033                                       * t_surf_wall_v(l)%t(m) ) / ( surf_usm_v(l)%c_surface(m)    &
    … …  
    80428046                                        + coef_green_2 * dt_3d * tsc(2) )
    80438047!
    8044 !--        add RK3 term
     8048!--        Add RK3 term
    80458049           t_surf_wall_v_p(l)%t(m)   = t_surf_wall_v_p(l)%t(m) + dt_3d * tsc(3) *                  &
    80468050                                       surf_usm_v(l)%tt_surface_wall_m(m)
    … …  
    80628066           IF ( humidity )  surf_usm_v(l)%vpt_surface(m) = surf_usm_v(l)%pt_surface(m)
    80638067!
    8064 !--        calculate true tendency
     8068!--        Calculate true tendency
    80658069           stend_wall = ( t_surf_wall_v_p(l)%t(m) - t_surf_wall_v(l)%t(m) - dt_3d * tsc(3) *       &
    80668070                          surf_usm_v(l)%tt_surface_wall_m(m) ) / ( dt_3d  * tsc(2) )
    … …  
    80718075
    80728076!
    8073 !--        calculate t_surf_* tendencies for the next Runge-Kutta step
     8077!--        Calculate t_surf_* tendencies for the next Runge-Kutta step
    80748078           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    80758079              IF ( intermediate_timestep_count == 1 )  THEN
    … …  
    80888092
    80898093!
    8090 !--        in case of fast changes in the skin temperature, it is required to update the radiative
     8094!--        In case of fast changes in the skin temperature, it is required to update the radiative
    80918095!--        fluxes in order to keep the solution stable
    80928096
    … …  
    80998103
    81008104!
    8101 !--        calculate fluxes
    8102 !--        prognostic rad_net_l is used just for output!
     8105!--        Calculate fluxes
     8106!--        Prognostic rad_net_l is used just for output!
    81038107           surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(m,ind_veg_wall) *                       &
    81048108                                        ( surf_usm_v(l)%rad_net_l(m) + 3.0_wp * sigma_sb *         &
    … …  
    81248128
    81258129!
    8126 !--        ground/wall/roof surface heat flux
     8130!--        Ground/wall/roof surface heat flux
    81278131           surf_usm_v(l)%wshf_eb(m) = - f_shf  * ( surf_usm_v(l)%pt1(m) - t_surf_wall_v_p(l)%t(m)  &
    81288132                                      / exner(k) ) * surf_usm_v(l)%frac(m,ind_veg_wall)            &
    … …  
    81348138
    81358139!
    8136 !--        store kinematic surface heat fluxes for utilization in other processes diffusion_s,
     8140!--        Store kinematic surface heat fluxes for utilization in other processes diffusion_s,
    81378141!--        surface_layer_fluxes,...
    81388142           surf_usm_v(l)%shf(m) = surf_usm_v(l)%wshf_eb(m) / c_p
    … …  
    82218225!--      TO_DO: activate, if testcase is available
    82228226!--      !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp)
    8223 !--      it may also improve performance to move topo_top_ind before the k-loop
     8227!--      It may also improve performance to move topo_top_ind before the k-loop
    82248228         DO i = nxl, nxr
    82258229            DO j = nys, nyn
    … …  
    82278231                  IF ( k > topo_top_ind(j,i,0) )  THEN
    82288232!
    8229 !--                 increase of pt in box i,j,k in time dt_3d given to anthropogenic heat
     8233!--                 Increase of pt in box i,j,k in time dt_3d given to anthropogenic heat
    82308234!--                 aheat*acoef (W*m-2)
    82318235!--                 linear interpolation of coeficient
    … …  
    82368240                     IF ( aheat(k,j,i) > 0.0_wp )  THEN
    82378241!
    8238 !--                    calculate rho * c_p coefficient at layer k
     8242!--                    Calculate rho * c_p coefficient at layer k
    82398243                        rho_cp  = c_p * hyp(k) / ( r_d * pt(k+1,j,i) * exner(k) )
    82408244                        pt(k,j,i) = pt(k,j,i) + aheat(k,j,i) * acoef * dt_3d / (exner(k) * rho_cp  &
    … …  
    83038307!!                                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-10_wp )
    83048308!!
    8305 !! !-    make sure that the resistance does not drop to zero
     8309!! !-    Make sure that the resistance does not drop to zero
    83068310!!       IF ( ABS(surf_usm_h%r_a_green(m)) < 1.0E-10_wp )  surf_usm_h%r_a_green(m) = 1.0E-10_wp
    83078311!
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |