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

Last change on this file since 3545 was 3241, checked in by raasch, 6 years ago

various changes to avoid compiler warnings (mainly removal of unused variables)

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