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

Last change on this file since 2232 was 2232, checked in by suehring, 4 years ago

Adjustments according new topography and surface-modelling concept implemented

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