source: palm/trunk/SOURCE/diffusion_u.f90 @ 2689

Last change on this file since 2689 was 2638, checked in by raasch, 7 years ago

bugfix for cases with constant top momentumflux

  • Property svn:keywords set to Id
File size: 24.7 KB
RevLine 
[1873]1!> @file diffusion_u.f90
[2000]2!------------------------------------------------------------------------------!
[1036]3! This file is part of PALM.
4!
[2000]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.
[1036]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!
[2101]17! Copyright 1997-2017 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1]21! -----------------
[1341]22!
[2233]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: diffusion_u.f90 2638 2017-11-23 12:44:23Z Giersch $
[2638]27! bugfix for constant top momentumflux
28!
29! 2233 2017-05-30 18:08:54Z suehring
[1321]30!
[2233]31! 2232 2017-05-30 17:47:52Z suehring
32! Adjustments to new topography and surface concept
33!
[2119]34! 2118 2017-01-17 16:38:49Z raasch
35! OpenACC version of subroutine removed
36!
[2038]37! 2037 2016-10-26 11:15:40Z knoop
38! Anelastic approximation implemented
39!
[2001]40! 2000 2016-08-20 18:09:15Z knoop
41! Forced header and separation lines into 80 columns
42!
[1874]43! 1873 2016-04-18 14:50:06Z maronga
44! Module renamed (removed _mod)
45!
[1851]46! 1850 2016-04-08 13:29:27Z maronga
47! Module renamed
48!
[1741]49! 1740 2016-01-13 08:19:40Z raasch
50! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
51!
[1692]52! 1691 2015-10-26 16:17:44Z maronga
53! Formatting corrections.
54!
[1683]55! 1682 2015-10-07 23:56:08Z knoop
56! Code annotations made doxygen readable
57!
[1341]58! 1340 2014-03-25 19:45:13Z kanani
59! REAL constants defined as wp-kind
60!
[1321]61! 1320 2014-03-20 08:40:49Z raasch
[1320]62! ONLY-attribute added to USE-statements,
63! kind-parameters added to all INTEGER and REAL declaration statements,
64! kinds are defined in new module kinds,
65! revision history before 2012 removed,
66! comment fields (!:) to be used for variable explanations added to
67! all variable declaration statements
[1321]68!
[1258]69! 1257 2013-11-08 15:18:40Z raasch
70! openacc loop and loop vector clauses removed, declare create moved after
71! the FORTRAN declaration statement
72!
[1132]73! 1128 2013-04-12 06:19:32Z raasch
74! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
75! j_north
76!
[1037]77! 1036 2012-10-22 13:43:42Z raasch
78! code put under GPL (PALM 3.9)
79!
[1017]80! 1015 2012-09-27 09:23:24Z raasch
81! accelerator version (*_acc) added
82!
[1002]83! 1001 2012-09-13 14:08:46Z raasch
84! arrays comunicated by module instead of parameter list
85!
[979]86! 978 2012-08-09 08:28:32Z fricke
87! outflow damping layer removed
88! kmym_x/_y and kmyp_x/_y change to kmym and kmyp
89!
[1]90! Revision 1.1  1997/09/12 06:23:51  raasch
91! Initial revision
92!
93!
94! Description:
95! ------------
[1682]96!> Diffusion term of the u-component
97!> @todo additional damping (needed for non-cyclic bc) causes bad vectorization
98!>       and slows down the speed on NEC about 5-10%
[1]99!------------------------------------------------------------------------------!
[1682]100 MODULE diffusion_u_mod
101 
[1]102
103    PRIVATE
[2118]104    PUBLIC diffusion_u
[1]105
106    INTERFACE diffusion_u
107       MODULE PROCEDURE diffusion_u
108       MODULE PROCEDURE diffusion_u_ij
109    END INTERFACE diffusion_u
110
111 CONTAINS
112
113
114!------------------------------------------------------------------------------!
[1682]115! Description:
116! ------------
117!> Call for all grid points
[1]118!------------------------------------------------------------------------------!
[1001]119    SUBROUTINE diffusion_u
[1]120
[1320]121       USE arrays_3d,                                                          &
[2232]122           ONLY:  ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
[1320]123       
124       USE control_parameters,                                                 &
[2232]125           ONLY:  constant_top_momentumflux, use_surface_fluxes,               &
[1320]126                  use_top_fluxes
127       
128       USE grid_variables,                                                     &
[2232]129           ONLY:  ddx, ddx2, ddy
[1320]130       
131       USE indices,                                                            &
[2232]132           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
133     
[1320]134       USE kinds
[1]135
[2232]136       USE surface_mod,                                                        &
137           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
138                   surf_usm_v
139
[1]140       IMPLICIT NONE
141
[2232]142       INTEGER(iwp) ::  i             !< running index x direction
143       INTEGER(iwp) ::  j             !< running index y direction
144       INTEGER(iwp) ::  k             !< running index z direction
145       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
146       INTEGER(iwp) ::  m             !< running index surface elements
147       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
148       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
[1001]149
[2232]150       REAL(wp)     ::  flag          !< flag to mask topography grid points
151       REAL(wp)     ::  kmym          !<
152       REAL(wp)     ::  kmyp          !<
153       REAL(wp)     ::  kmzm          !<
154       REAL(wp)     ::  kmzp          !<
155       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface       
156       REAL(wp)     ::  mask_north    !< flag to mask vertical surface north of the grid point
157       REAL(wp)     ::  mask_south    !< flag to mask vertical surface south of the grid point
158       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
[1]159
[56]160
[2232]161
[106]162       DO  i = nxlu, nxr
[1001]163          DO  j = nys, nyn
[1]164!
165!--          Compute horizontal diffusion
[2232]166             DO  k = nzb+1, nzt
[1]167!
[2232]168!--             Predetermine flag to mask topography and wall-bounded grid points.
169!--             It is sufficient to masked only north- and south-facing surfaces, which
170!--             need special treatment for the u-component.
171                flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   1 ) ) 
172                mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
173                mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
174!
[1]175!--             Interpolate eddy diffusivities on staggered gridpoints
[1340]176                kmyp = 0.25_wp *                                               &
[978]177                       ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
[1340]178                kmym = 0.25_wp *                                               &
[978]179                       ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
[1]180
[1320]181                tend(k,j,i) = tend(k,j,i)                                      &
[2232]182                        + 2.0_wp * (                                           &
183                                  km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
184                                - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
185                                   ) * ddx2 * flag                             &
186                        +          ( mask_north * (                            &
187                            kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
188                          + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
189                                                  )                            &
190                                   - mask_south * (                            &
191                            kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
192                          + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
193                                                  )                            &
194                                   ) * ddy  * flag                             
[1]195             ENDDO
196!
[2232]197!--          Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
198!--          surfaces. Note, in the the flat case, loops won't be entered as
199!--          start_index > end_index. Furtermore, note, no vertical natural surfaces
200!--          so far.           
201!--          Default-type surfaces
202             DO  l = 0, 1
203                surf_s = surf_def_v(l)%start_index(j,i)
204                surf_e = surf_def_v(l)%end_index(j,i)
205                DO  m = surf_s, surf_e
206                   k           = surf_def_v(l)%k(m)
207                   tend(k,j,i) = tend(k,j,i) +                                 &                   
208                                    surf_def_v(l)%mom_flux_uv(m) * ddy
209                ENDDO   
210             ENDDO
211!
212!--          Natural-type surfaces
213             DO  l = 0, 1
214                surf_s = surf_lsm_v(l)%start_index(j,i)
215                surf_e = surf_lsm_v(l)%end_index(j,i)
216                DO  m = surf_s, surf_e
217                   k           = surf_lsm_v(l)%k(m)
218                   tend(k,j,i) = tend(k,j,i) +                                 &                   
219                                    surf_lsm_v(l)%mom_flux_uv(m) * ddy
220                ENDDO   
221             ENDDO
222!
223!--          Urban-type surfaces
224             DO  l = 0, 1
225                surf_s = surf_usm_v(l)%start_index(j,i)
226                surf_e = surf_usm_v(l)%end_index(j,i)
227                DO  m = surf_s, surf_e
228                   k           = surf_usm_v(l)%k(m)
229                   tend(k,j,i) = tend(k,j,i) +                                 &                   
230                                    surf_usm_v(l)%mom_flux_uv(m) * ddy
231                ENDDO   
232             ENDDO
[51]233
[1]234!
[2232]235!--          Compute vertical diffusion. In case of simulating a surface layer,
236!--          respective grid diffusive fluxes are masked (flag 8) within this
237!--          loop, and added further below, else, simple gradient approach is
238!--          applied. Model top is also mask if top-momentum flux is given.
239             DO  k = nzb+1, nzt
[1]240!
[2232]241!--             Determine flags to mask topography below and above. Flag 1 is
242!--             used to mask topography in general, and flag 8 implies
243!--             information about use_surface_fluxes. Flag 9 is used to control
244!--             momentum flux at model top. 
245                mask_bottom = MERGE( 1.0_wp, 0.0_wp,                           &
246                                     BTEST( wall_flags_0(k-1,j,i), 8 ) ) 
247                mask_top    = MERGE( 1.0_wp, 0.0_wp,                           &
248                                     BTEST( wall_flags_0(k+1,j,i), 8 ) ) *     &
249                              MERGE( 1.0_wp, 0.0_wp,                           &
250                                     BTEST( wall_flags_0(k+1,j,i), 9 ) ) 
251                flag        = MERGE( 1.0_wp, 0.0_wp,                           &
252                                     BTEST( wall_flags_0(k,j,i), 1 ) ) 
253!
[1]254!--             Interpolate eddy diffusivities on staggered gridpoints
[1340]255                kmzp = 0.25_wp *                                               &
[1]256                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
[1340]257                kmzm = 0.25_wp *                                               &
[1]258                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
259
[1320]260                tend(k,j,i) = tend(k,j,i)                                      &
[2232]261                        + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
262                                   + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
263                                   ) * rho_air_zw(k)   * mask_top              &
264                          - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
265                                   + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
266                                   ) * rho_air_zw(k-1) * mask_bottom           &
267                          ) * ddzw(k) * drho_air(k) * flag
[1]268             ENDDO
269
270!
271!--          Vertical diffusion at the first grid point above the surface,
272!--          if the momentum flux at the bottom is given by the Prandtl law or
273!--          if it is prescribed by the user.
274!--          Difference quotient of the momentum flux is not formed over half
275!--          of the grid spacing (2.0*ddzw(k)) any more, since the comparison
[1320]276!--          with other (LES) models showed that the values of the momentum
[1]277!--          flux becomes too large in this case.
278!--          The term containing w(k-1,..) (see above equation) is removed here
279!--          because the vertical velocity is assumed to be zero at the surface.
280             IF ( use_surface_fluxes )  THEN
281!
[2232]282!--             Default-type surfaces, upward-facing
283                surf_s = surf_def_h(0)%start_index(j,i)
284                surf_e = surf_def_h(0)%end_index(j,i)
285                DO  m = surf_s, surf_e
[1]286
[2232]287                   k   = surf_def_h(0)%k(m)
[1]288
[2232]289                   tend(k,j,i) = tend(k,j,i)                                   &
290                        + ( - ( - surf_def_h(0)%usws(m) )                      &
291                          ) * ddzw(k) * drho_air(k)
292                ENDDO
[102]293!
[2232]294!--             Default-type surfaces, dowward-facing
295                surf_s = surf_def_h(1)%start_index(j,i)
296                surf_e = surf_def_h(1)%end_index(j,i)
297                DO  m = surf_s, surf_e
298
299                   k   = surf_def_h(1)%k(m)
300
301                   tend(k,j,i) = tend(k,j,i)                                   &
302                        + ( - surf_def_h(1)%usws(m)                            &
303                          ) * ddzw(k) * drho_air(k)
304                ENDDO
[102]305!
[2232]306!--             Natural-type surfaces, upward-facing
307                surf_s = surf_lsm_h%start_index(j,i)
308                surf_e = surf_lsm_h%end_index(j,i)
309                DO  m = surf_s, surf_e
[102]310
[2232]311                   k   = surf_lsm_h%k(m)
312
313                   tend(k,j,i) = tend(k,j,i)                                   &
314                        + ( - ( - surf_lsm_h%usws(m) )                         &
315                          ) * ddzw(k) * drho_air(k)
316                ENDDO
317!
318!--             Urban-type surfaces, upward-facing
319                surf_s = surf_usm_h%start_index(j,i)
320                surf_e = surf_usm_h%end_index(j,i)
321                DO  m = surf_s, surf_e
322
323                   k   = surf_usm_h%k(m)
324
325                   tend(k,j,i) = tend(k,j,i)                                   &
326                       + ( - ( - surf_usm_h%usws(m) )                          &
327                         ) * ddzw(k) * drho_air(k)
328                ENDDO
329
[102]330             ENDIF
[2232]331!
332!--          Add momentum flux at model top
[2638]333             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
[2232]334                surf_s = surf_def_h(2)%start_index(j,i)
335                surf_e = surf_def_h(2)%end_index(j,i)
336                DO  m = surf_s, surf_e
[102]337
[2232]338                   k   = surf_def_h(2)%k(m)
339
340                   tend(k,j,i) = tend(k,j,i)                                   &
341                        + ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
342                ENDDO
343             ENDIF
344
[1]345          ENDDO
346       ENDDO
347
348    END SUBROUTINE diffusion_u
349
350
351!------------------------------------------------------------------------------!
[1682]352! Description:
353! ------------
354!> Call for grid point i,j
[1]355!------------------------------------------------------------------------------!
[1001]356    SUBROUTINE diffusion_u_ij( i, j )
[1]357
[1320]358       USE arrays_3d,                                                          &
[2232]359           ONLY:  ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
[1320]360       
361       USE control_parameters,                                                 &
[2232]362           ONLY:  constant_top_momentumflux, use_surface_fluxes,               &
363                  use_top_fluxes
[1320]364       
365       USE grid_variables,                                                     &
[2232]366           ONLY:  ddx, ddx2, ddy
[1320]367       
368       USE indices,                                                            &
[2232]369           ONLY:  nzb, nzt, wall_flags_0
370     
[1320]371       USE kinds
[1]372
[2232]373       USE surface_mod,                                                        &
374           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
375                   surf_usm_v
376
[1]377       IMPLICIT NONE
378
[2232]379       INTEGER(iwp) ::  i             !< running index x direction
380       INTEGER(iwp) ::  j             !< running index y direction
381       INTEGER(iwp) ::  k             !< running index z direction
382       INTEGER(iwp) ::  l             !< running index of surface type, south- or north-facing wall
383       INTEGER(iwp) ::  m             !< running index surface elements
384       INTEGER(iwp) ::  surf_e        !< End index of surface elements at (j,i)-gridpoint
385       INTEGER(iwp) ::  surf_s        !< Start index of surface elements at (j,i)-gridpoint
[1]386
[2232]387       REAL(wp)     ::  flag          !< flag to mask topography grid points
388       REAL(wp)     ::  kmym          !<
389       REAL(wp)     ::  kmyp          !<
390       REAL(wp)     ::  kmzm          !<
391       REAL(wp)     ::  kmzp          !<
392       REAL(wp)     ::  mask_bottom   !< flag to mask vertical upward-facing surface       
393       REAL(wp)     ::  mask_north    !< flag to mask vertical surface north of the grid point
394       REAL(wp)     ::  mask_south    !< flag to mask vertical surface south of the grid point
395       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface
396!
[1]397!--    Compute horizontal diffusion
[2232]398       DO  k = nzb+1, nzt
[1]399!
[2232]400!--       Predetermine flag to mask topography and wall-bounded grid points.
401!--       It is sufficient to masked only north- and south-facing surfaces, which
402!--       need special treatment for the u-component.
403          flag       = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i),   1 ) ) 
404          mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
405          mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
406!
[1]407!--       Interpolate eddy diffusivities on staggered gridpoints
[1340]408          kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
409          kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
[1]410
[1320]411          tend(k,j,i) = tend(k,j,i)                                            &
[2232]412                       + 2.0_wp * (                                            &
413                                 km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )     &
414                               - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )     &
415                                   ) * ddx2 * flag                             &
416                                 + (                                           &
417                  mask_north * kmyp * ( ( u(k,j+1,i) - u(k,j,i)     ) * ddy    &
418                                      + ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx    &
419                                      )                                        &
420                - mask_south * kmym * ( ( u(k,j,i)   - u(k,j-1,i)   ) * ddy    &
421                                      + ( v(k,j,i)   - v(k,j,i-1)   ) * ddx    &
422                                      )                                        &
423                                   ) * ddy  * flag
[1]424       ENDDO
425
426!
[2232]427!--    Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
428!--    surfaces. Note, in the the flat case, loops won't be entered as
429!--    start_index > end_index. Furtermore, note, no vertical natural surfaces
430!--    so far.           
431!--    Default-type surfaces
432       DO  l = 0, 1
433          surf_s = surf_def_v(l)%start_index(j,i)
434          surf_e = surf_def_v(l)%end_index(j,i)
435          DO  m = surf_s, surf_e
436             k           = surf_def_v(l)%k(m)
437             tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddy
438          ENDDO   
439       ENDDO
[51]440!
[2232]441!--    Natural-type surfaces
442       DO  l = 0, 1
443          surf_s = surf_lsm_v(l)%start_index(j,i)
444          surf_e = surf_lsm_v(l)%end_index(j,i)
445          DO  m = surf_s, surf_e
446             k           = surf_lsm_v(l)%k(m)
447             tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddy
448          ENDDO   
449       ENDDO
[1]450!
[2232]451!--    Urban-type surfaces
452       DO  l = 0, 1
453          surf_s = surf_usm_v(l)%start_index(j,i)
454          surf_e = surf_usm_v(l)%end_index(j,i)
455          DO  m = surf_s, surf_e
456             k           = surf_usm_v(l)%k(m)
457             tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddy
458          ENDDO   
459       ENDDO
[1]460!
[2232]461!--    Compute vertical diffusion. In case of simulating a surface layer,
462!--    respective grid diffusive fluxes are masked (flag 8) within this
463!--    loop, and added further below, else, simple gradient approach is
464!--    applied. Model top is also mask if top-momentum flux is given.
465       DO  k = nzb+1, nzt
466!
467!--       Determine flags to mask topography below and above. Flag 1 is
468!--       used to mask topography in general, and flag 8 implies
469!--       information about use_surface_fluxes. Flag 9 is used to control
470!--       momentum flux at model top.
471          mask_bottom = MERGE( 1.0_wp, 0.0_wp,                                 &
472                               BTEST( wall_flags_0(k-1,j,i), 8 ) ) 
473          mask_top    = MERGE( 1.0_wp, 0.0_wp,                                 &
474                               BTEST( wall_flags_0(k+1,j,i), 8 ) ) *           &
475                        MERGE( 1.0_wp, 0.0_wp,                                 &
476                               BTEST( wall_flags_0(k+1,j,i), 9 ) )
477          flag        = MERGE( 1.0_wp, 0.0_wp,                                 &
478                               BTEST( wall_flags_0(k,j,i), 1 ) ) 
479!
[1]480!--       Interpolate eddy diffusivities on staggered gridpoints
[1340]481          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
482          kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
[1]483
[1320]484          tend(k,j,i) = tend(k,j,i)                                            &
[2232]485                        + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
486                                   + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
487                                   ) * rho_air_zw(k)   * mask_top              &
488                          - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
489                                   + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
490                                   ) * rho_air_zw(k-1) * mask_bottom           &
491                          ) * ddzw(k) * drho_air(k) * flag
[1]492       ENDDO
493
494!
[2232]495!--    Vertical diffusion at the first surface grid points, if the
[1]496!--    momentum flux at the bottom is given by the Prandtl law or if it is
497!--    prescribed by the user.
498!--    Difference quotient of the momentum flux is not formed over half of
499!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with
[1320]500!--    other (LES) models showed that the values of the momentum flux becomes
[1]501!--    too large in this case.
502       IF ( use_surface_fluxes )  THEN
503!
[2232]504!--       Default-type surfaces, upward-facing
505          surf_s = surf_def_h(0)%start_index(j,i)
506          surf_e = surf_def_h(0)%end_index(j,i)
507          DO  m = surf_s, surf_e
[1]508
[2232]509             k   = surf_def_h(0)%k(m)
[1]510
[2232]511             tend(k,j,i) = tend(k,j,i)                                         &
512                        + ( - ( - surf_def_h(0)%usws(m) )                      &
513                          ) * ddzw(k) * drho_air(k)
514          ENDDO
[102]515!
[2232]516!--       Default-type surfaces, dowward-facing (except for model-top fluxes)
517          surf_s = surf_def_h(1)%start_index(j,i)
518          surf_e = surf_def_h(1)%end_index(j,i)
519          DO  m = surf_s, surf_e
520
521             k   = surf_def_h(1)%k(m)
522
523             tend(k,j,i) = tend(k,j,i)                                         &
524                        + ( - surf_def_h(1)%usws(m)                            &
525                          ) * ddzw(k) * drho_air(k)
526          ENDDO
[102]527!
[2232]528!--       Natural-type surfaces, upward-facing
529          surf_s = surf_lsm_h%start_index(j,i)
530          surf_e = surf_lsm_h%end_index(j,i)
531          DO  m = surf_s, surf_e
[102]532
[2232]533             k   = surf_lsm_h%k(m)
534
535             tend(k,j,i) = tend(k,j,i)                                         &
536                        + ( - ( - surf_lsm_h%usws(m) )                         &
537                          ) * ddzw(k) * drho_air(k)
538          ENDDO
539!
540!--       Urban-type surfaces, upward-facing
541          surf_s = surf_usm_h%start_index(j,i)
542          surf_e = surf_usm_h%end_index(j,i)
543          DO  m = surf_s, surf_e
544
545             k   = surf_usm_h%k(m)
546
547             tend(k,j,i) = tend(k,j,i)                                         &
548                       + ( - ( - surf_usm_h%usws(m) )                          &
549                         ) * ddzw(k) * drho_air(k)
550          ENDDO
551
[102]552       ENDIF
[2232]553!
554!--    Add momentum flux at model top
[2638]555       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
[2232]556          surf_s = surf_def_h(2)%start_index(j,i)
557          surf_e = surf_def_h(2)%end_index(j,i)
558          DO  m = surf_s, surf_e
[102]559
[2232]560             k   = surf_def_h(2)%k(m)
561
562             tend(k,j,i) = tend(k,j,i)                                         &
563                           + ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
564          ENDDO
565       ENDIF
566
567
[1]568    END SUBROUTINE diffusion_u_ij
569
570 END MODULE diffusion_u_mod
Note: See TracBrowser for help on using the repository browser.