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

Last change on this file since 2638 was 2638, checked in by raasch, 4 years ago

bugfix for cases with constant top momentumflux

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