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

Last change on this file since 3943 was 3655, checked in by knoop, 5 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

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