source: palm/trunk/SOURCE/advec_u_up.f90 @ 4844

Last change on this file since 4844 was 4828, checked in by Giersch, 4 years ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

  • Property svn:keywords set to Id
File size: 6.3 KB
RevLine 
[1873]1!> @file advec_u_up.f90
[4488]2!--------------------------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[4488]5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
[1036]8!
[4488]9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
[1036]12!
[4488]13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
[1036]15!
[4828]16! Copyright 1997-2021 Leibniz Universitaet Hannover
[4488]17!--------------------------------------------------------------------------------------------------!
[1036]18!
[484]19! Current revisions:
[1]20! -----------------
[1354]21!
[2233]22!
[1321]23! Former revisions:
24! -----------------
25! $Id: advec_u_up.f90 4828 2021-01-05 11:21:41Z raasch $
[4488]26! file re-formatted to follow the PALM coding standard
27!
28! 4360 2020-01-07 11:25:50Z suehring
[4182]29! Corrected "Former revisions" section
[4488]30!
[4182]31! 3655 2019-01-07 16:51:22Z knoop
[3547]32! variables documented
[1321]33!
[4182]34! Revision 1.1  1997/08/29 08:55:25  raasch
35! Initial revision
36!
37!
[1]38! Description:
39! ------------
[1682]40!> Advection term for the u velocity-component using upstream scheme.
41!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
42!>       The same problem occurs for all topography boundaries!
[4488]43!--------------------------------------------------------------------------------------------------!
[1682]44 MODULE advec_u_up_mod
[1]45
[4488]46
[1]47    PRIVATE
48    PUBLIC advec_u_up
49
50    INTERFACE advec_u_up
51       MODULE PROCEDURE advec_u_up
52       MODULE PROCEDURE advec_u_up_ij
53    END INTERFACE advec_u_up
54
55 CONTAINS
56
57
[4488]58!--------------------------------------------------------------------------------------------------!
[1682]59! Description:
60! ------------
61!> Call for all grid points
[4488]62!--------------------------------------------------------------------------------------------------!
63 SUBROUTINE advec_u_up
[1]64
[4488]65    USE arrays_3d,                                                                                 &
66        ONLY:  ddzu, tend, u, v, w
[1]67
[4488]68    USE control_parameters,                                                                        &
69        ONLY:  u_gtrans, v_gtrans
[1320]70
[4488]71    USE grid_variables,                                                                            &
72        ONLY:  ddx, ddy
[1320]73
[4488]74    USE indices,                                                                                   &
75        ONLY:  nxlu, nxr, nyn, nys, nzb, nzt
[1320]76
[4488]77    USE kinds
[1320]78
79
[4488]80    IMPLICIT NONE
[1]81
[4488]82    INTEGER(iwp) ::  i !< grid index along x-direction
83    INTEGER(iwp) ::  j !< grid index along y-direction
84    INTEGER(iwp) ::  k !< grid index along z-direction
[1]85
[4488]86    REAL(wp) ::  ukomp !< advection velocity along x-direction
87    REAL(wp) ::  vkomp !< advection velocity along y-direction
88    REAL(wp) ::  wkomp !< advection velocity along z-direction
[1]89
[4488]90
91    DO  i = nxlu, nxr
92       DO  j = nys, nyn
93          DO  k = nzb+1, nzt
[1]94!
[4488]95!--          x-direction
96             ukomp = u(k,j,i) - u_gtrans
97             IF ( ukomp > 0.0_wp )  THEN
98                tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i) - u(k,j,i-1) ) * ddx
99             ELSE
100                tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i+1) - u(k,j,i) ) * ddx
101             ENDIF
[1]102!
[4488]103!--          y-direction
104             vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
105             IF ( vkomp > 0.0_wp )  THEN
106                tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j,i) - u(k,j-1,i) ) * ddy
107             ELSE
108                tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j+1,i) - u(k,j,i) ) * ddy
109             ENDIF
[1]110!
[4488]111!--          z-direction
112             wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
113             IF ( wkomp > 0.0_wp )  THEN
114                tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
115             ELSE
116                tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
117             ENDIF
[1]118
119          ENDDO
120       ENDDO
[4488]121    ENDDO
[1]122
[4488]123 END SUBROUTINE advec_u_up
[1]124
125
[4488]126!--------------------------------------------------------------------------------------------------!
[1682]127! Description:
128! ------------
129!> Call for grid point i,j
[4488]130!--------------------------------------------------------------------------------------------------!
131 SUBROUTINE advec_u_up_ij( i, j )
[1]132
[4488]133    USE arrays_3d,                                                                                 &
134        ONLY:  ddzu, tend, u, v, w
[1]135
[4488]136    USE control_parameters,                                                                        &
137        ONLY:  u_gtrans, v_gtrans
[1320]138
[4488]139    USE grid_variables,                                                                            &
140        ONLY:  ddx, ddy
[1320]141
[4488]142    USE indices,                                                                                   &
143        ONLY:  nzb, nzt
[1320]144
[4488]145    USE kinds
[1320]146
147
[4488]148    IMPLICIT NONE
[1]149
[4488]150    INTEGER(iwp) ::  i !< grid index along x-direction
151    INTEGER(iwp) ::  j !< grid index along y-direction
152    INTEGER(iwp) ::  k !< grid index along z-direction
[1]153
[4488]154    REAL(wp) ::  ukomp !< advection velocity along x-direction
155    REAL(wp) ::  vkomp !< advection velocity along y-direction
156    REAL(wp) ::  wkomp !< advection velocity along z-direction
[1]157
158
[4488]159    DO  k = nzb+1, nzt
[1]160!
[4488]161!--    x-direction
162       ukomp = u(k,j,i) - u_gtrans
163       IF ( ukomp > 0.0_wp )  THEN
164          tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i) - u(k,j,i-1) ) * ddx
165       ELSE
166          tend(k,j,i) = tend(k,j,i) - ukomp * ( u(k,j,i+1) - u(k,j,i) ) * ddx
167       ENDIF
[1]168!
[4488]169!--    y-direction
170       vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
171       IF ( vkomp > 0.0_wp )  THEN
172          tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j,i) - u(k,j-1,i) ) * ddy
173       ELSE
174          tend(k,j,i) = tend(k,j,i) - vkomp * ( u(k,j+1,i) - u(k,j,i) ) * ddy
175       ENDIF
[1]176!
[4488]177!--    z-direction
178       wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
179       IF ( wkomp > 0.0_wp )  THEN
180          tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
181       ELSE
182          tend(k,j,i) = tend(k,j,i) - wkomp * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
183       ENDIF
[1]184
[4488]185    ENDDO
[1]186
[4488]187 END SUBROUTINE advec_u_up_ij
[1]188
189 END MODULE advec_u_up_mod
Note: See TracBrowser for help on using the repository browser.