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

Last change on this file since 2412 was 2233, checked in by suehring, 7 years ago

last commit documented

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