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

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