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

Last change on this file since 4340 was 4329, checked in by motisi, 5 years ago

Renamed wall_flags_0 to wall_flags_static_0

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