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

Last change on this file since 2284 was 2233, checked in by suehring, 8 years ago

last commit documented

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