source: palm/trunk/SOURCE/diffusion_v.f90 @ 2845

Last change on this file since 2845 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

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