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

Last change on this file since 3933 was 3655, checked in by knoop, 6 years ago

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

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