source: palm/trunk/SOURCE/diffusion_s.f90 @ 2119

Last change on this file since 2119 was 2119, checked in by raasch, 7 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 14.8 KB
RevLine 
[1873]1!> @file diffusion_s.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:
[1001]21! ------------------
[1341]22!
[2119]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: diffusion_s.f90 2119 2017-01-17 16:51:50Z raasch $
27!
[2119]28! 2118 2017-01-17 16:38:49Z raasch
29! OpenACC version of subroutine removed
30!
[2038]31! 2037 2016-10-26 11:15:40Z knoop
32! Anelastic approximation implemented
33!
[2001]34! 2000 2016-08-20 18:09:15Z knoop
35! Forced header and separation lines into 80 columns
36!
[1874]37! 1873 2016-04-18 14:50:06Z maronga
38! Module renamed (removed _mod)
[2118]39!
[1851]40! 1850 2016-04-08 13:29:27Z maronga
41! Module renamed
42!
[1692]43! 1691 2015-10-26 16:17:44Z maronga
44! Formatting corrections.
45!
[1683]46! 1682 2015-10-07 23:56:08Z knoop
47! Code annotations made doxygen readable
48!
[1375]49! 1374 2014-04-25 12:55:07Z raasch
50! missing variables added to ONLY list
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
65!
[1132]66! 1128 2013-04-12 06:19:32Z raasch
67! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
68! j_north
69!
[1093]70! 1092 2013-02-02 11:24:22Z raasch
71! unused variables removed
72!
[1037]73! 1036 2012-10-22 13:43:42Z raasch
74! code put under GPL (PALM 3.9)
75!
[1017]76! 1015 2012-09-27 09:23:24Z raasch
77! accelerator version (*_acc) added
78!
[1011]79! 1010 2012-09-20 07:59:54Z raasch
80! cpp switch __nopointer added for pointer free version
81!
[1002]82! 1001 2012-09-13 14:08:46Z raasch
83! some arrays comunicated by module instead of parameter list
84!
[1]85! Revision 1.1  2000/04/13 14:54:02  schroeter
86! Initial revision
87!
88!
89! Description:
90! ------------
[1682]91!> Diffusion term of scalar quantities (temperature and water content)
[1]92!------------------------------------------------------------------------------!
[1682]93 MODULE diffusion_s_mod
94 
[1]95
96    PRIVATE
[2118]97    PUBLIC diffusion_s
[1]98
99    INTERFACE diffusion_s
100       MODULE PROCEDURE diffusion_s
101       MODULE PROCEDURE diffusion_s_ij
102    END INTERFACE diffusion_s
103
104 CONTAINS
105
106
107!------------------------------------------------------------------------------!
[1682]108! Description:
109! ------------
110!> Call for all grid points
[1]111!------------------------------------------------------------------------------!
[1001]112    SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
[1]113
[1320]114       USE arrays_3d,                                                          &
[2037]115           ONLY:  ddzu, ddzw, kh, tend, drho_air, rho_air_zw
[1320]116       
117       USE control_parameters,                                                 & 
118           ONLY: use_surface_fluxes, use_top_fluxes
119       
120       USE grid_variables,                                                     &
121           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
122       
123       USE indices,                                                            &
[1374]124           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
[1320]125                  nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
126       
127       USE kinds
[1]128
129       IMPLICIT NONE
130
[1682]131       INTEGER(iwp) ::  i                 !<
132       INTEGER(iwp) ::  j                 !<
133       INTEGER(iwp) ::  k                 !<
134       REAL(wp)     ::  wall_s_flux(0:4)  !<
135       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t !<
[1010]136#if defined( __nopointer )
[1682]137       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !<
[1010]138#else
[1682]139       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !<
[1010]140#endif
[1]141
142       DO  i = nxl, nxr
143          DO  j = nys,nyn
144!
145!--          Compute horizontal diffusion
[19]146             DO  k = nzb_s_outer(j,i)+1, nzt
[1]147
[1320]148                tend(k,j,i) = tend(k,j,i)                                      &
[1340]149                                          + 0.5_wp * (                         &
[1320]150                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
151                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
[1340]152                                                     ) * ddx2                  &
153                                          + 0.5_wp * (                         &
[1320]154                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
155                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
[1340]156                                                     ) * ddy2
[1]157             ENDDO
158
159!
160!--          Apply prescribed horizontal wall heatflux where necessary
[1691]161             IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) &
162                )  THEN
[1]163                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
164
[1320]165                   tend(k,j,i) = tend(k,j,i)                                   &
[1340]166                                                + ( fwxp(j,i) * 0.5_wp *       &
[1320]167                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
[1340]168                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
169                                                   -fwxm(j,i) * 0.5_wp *       &
[1320]170                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
[1340]171                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
[1320]172                                                  ) * ddx2                     &
[1340]173                                                + ( fwyp(j,i) * 0.5_wp *       &
[1320]174                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
[1340]175                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
176                                                   -fwym(j,i) * 0.5_wp *       &
[1320]177                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
[1340]178                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
[1]179                                                  ) * ddy2
180                ENDDO
181             ENDIF
182
183!
184!--          Compute vertical diffusion. In case that surface fluxes have been
[19]185!--          prescribed or computed at bottom and/or top, index k starts/ends at
186!--          nzb+2 or nzt-1, respectively.
187             DO  k = nzb_diff_s_inner(j,i), nzt_diff
[1]188
[1320]189                tend(k,j,i) = tend(k,j,i)                                      &
[1340]190                                       + 0.5_wp * (                            &
[1320]191            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
[2037]192                                                            * rho_air_zw(k)    &
[1320]193          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
[2037]194                                                            * rho_air_zw(k-1)  &
195                                                  ) * ddzw(k) * drho_air(k)
[1]196             ENDDO
197
198!
[19]199!--          Vertical diffusion at the first computational gridpoint along
[1]200!--          z-direction
201             IF ( use_surface_fluxes )  THEN
202
203                k = nzb_s_inner(j,i)+1
204
[1320]205                tend(k,j,i) = tend(k,j,i)                                      &
[1340]206                                       + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )  &
207                                                  * ( s(k+1,j,i)-s(k,j,i) )    &
208                                                  * ddzu(k+1)                  &
[2037]209                                                  * rho_air_zw(k)              &
[1320]210                                           + s_flux_b(j,i)                     &
[2037]211                                         ) * ddzw(k) * drho_air(k)
[1]212
213             ENDIF
214
[19]215!
216!--          Vertical diffusion at the last computational gridpoint along
217!--          z-direction
218             IF ( use_top_fluxes )  THEN
219
220                k = nzt
221
[1320]222                tend(k,j,i) = tend(k,j,i)                                      &
223                                       + ( - s_flux_t(j,i)                     &
[1340]224                                           - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
225                                                    * ( s(k,j,i)-s(k-1,j,i) )  &
226                                                    * ddzu(k)                  &
[2037]227                                                    * rho_air_zw(k-1)          &
228                                         ) * ddzw(k) * drho_air(k)
[19]229
230             ENDIF
231
[1]232          ENDDO
233       ENDDO
234
235    END SUBROUTINE diffusion_s
236
237
238!------------------------------------------------------------------------------!
[1682]239! Description:
240! ------------
241!> Call for grid point i,j
[1]242!------------------------------------------------------------------------------!
[1001]243    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
[1]244
[1320]245       USE arrays_3d,                                                          &
[2037]246           ONLY:  ddzu, ddzw, kh, tend, drho_air, rho_air_zw
[1320]247           
248       USE control_parameters,                                                 & 
249           ONLY: use_surface_fluxes, use_top_fluxes
250       
251       USE grid_variables,                                                     &
252           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
253       
254       USE indices,                                                            &
[1374]255           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_diff_s_inner, nzb_s_inner,  &
[1320]256                  nzb_s_outer, nzt, nzt_diff
257       
258       USE kinds
[1]259
260       IMPLICIT NONE
261
[1682]262       INTEGER(iwp) ::  i                 !<
263       INTEGER(iwp) ::  j                 !<
264       INTEGER(iwp) ::  k                 !<
265       REAL(wp)     ::  wall_s_flux(0:4)  !<
266       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b  !<
267       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t  !<
[1010]268#if defined( __nopointer )
[1682]269       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s !<
[1010]270#else
[1682]271       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !<
[1010]272#endif
[1]273
274!
275!--    Compute horizontal diffusion
[19]276       DO  k = nzb_s_outer(j,i)+1, nzt
[1]277
[1320]278          tend(k,j,i) = tend(k,j,i)                                            &
[1340]279                                          + 0.5_wp * (                         &
[1320]280                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
281                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
[1340]282                                                     ) * ddx2                  &
283                                          + 0.5_wp * (                         &
[1320]284                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
285                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
[1340]286                                                     ) * ddy2
[1]287       ENDDO
288
289!
290!--    Apply prescribed horizontal wall heatflux where necessary
[1691]291       IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) )     &
[1]292       THEN
293          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
294
[1320]295             tend(k,j,i) = tend(k,j,i)                                         &
[1340]296                                                + ( fwxp(j,i) * 0.5_wp *       &
[1320]297                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
[1340]298                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
299                                                   -fwxm(j,i) * 0.5_wp *       &
[1320]300                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
[1340]301                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
[1320]302                                                  ) * ddx2                     &
[1340]303                                                + ( fwyp(j,i) * 0.5_wp *       &
[1320]304                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
[1340]305                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
306                                                   -fwym(j,i) * 0.5_wp *       &
[1320]307                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
[1340]308                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
[1]309                                                  ) * ddy2
310          ENDDO
311       ENDIF
312
313!
314!--    Compute vertical diffusion. In case that surface fluxes have been
[19]315!--    prescribed or computed at bottom and/or top, index k starts/ends at
316!--    nzb+2 or nzt-1, respectively.
317       DO  k = nzb_diff_s_inner(j,i), nzt_diff
[1]318
[1320]319          tend(k,j,i) = tend(k,j,i)                                            &
[1340]320                                       + 0.5_wp * (                            &
[1320]321            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
[2037]322                                                            * rho_air_zw(k)    &
[1320]323          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
[2037]324                                                            * rho_air_zw(k-1)  &
325                                                  ) * ddzw(k) * drho_air(k)
[1]326       ENDDO
327
328!
[19]329!--    Vertical diffusion at the first computational gridpoint along z-direction
[1]330       IF ( use_surface_fluxes )  THEN
331
332          k = nzb_s_inner(j,i)+1
333
[1340]334          tend(k,j,i) = tend(k,j,i) + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )     &
335                                               * ( s(k+1,j,i)-s(k,j,i) )       &
336                                               * ddzu(k+1)                     &
[2037]337                                               * rho_air_zw(k)                 &
[1320]338                                        + s_flux_b(j,i)                        &
[2037]339                                      ) * ddzw(k) * drho_air(k)
[1]340
341       ENDIF
342
[19]343!
344!--    Vertical diffusion at the last computational gridpoint along z-direction
345       IF ( use_top_fluxes )  THEN
346
347          k = nzt
348
[1320]349          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                        &
[1340]350                                      - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )     &
351                                               * ( s(k,j,i)-s(k-1,j,i) )       &
352                                               * ddzu(k)                       &
[2037]353                                               * rho_air_zw(k-1)               &
354                                      ) * ddzw(k) * drho_air(k)
[19]355
356       ENDIF
357
[1]358    END SUBROUTINE diffusion_s_ij
359
360 END MODULE diffusion_s_mod
Note: See TracBrowser for help on using the repository browser.