Home

Context Navigation

source: palm/trunk/SOURCE/advec_s_pw.f90 @ 3499

Last change on this file since 3499 was 3302, checked in by raasch, 6 years ago
Craik-Leibovich force and wave breaking effects added to ocean mode, header output for ocean mode
Property svn:keywords set to `Id`
File size: 8.9 KB

Line
1	!> @file advec_s_pw.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
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.
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	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: advec_s_pw.f90 3302 2018-10-03 02:39:40Z suehring $
27	! Stokes drift velocity added
28	!
29	! 2718 2018-01-02 08:49:38Z maronga
30	! Corrected "Former revisions" section
31	!
32	! 2696 2017-12-14 17:12:51Z kanani
33	! Change in file header (GPL part)
34	!
35	! 2233 2017-05-30 18:08:54Z suehring
36	!
37	! 2232 2017-05-30 17:47:52Z suehring
38	! topography representation via flags
39	!
40	! 2000 2016-08-20 18:09:15Z knoop
41	! Forced header and separation lines into 80 columns
42	!
43	! 1873 2016-04-18 14:50:06Z maronga
44	! Module renamed (removed _mod)
45	!
46	!
47	! 1850 2016-04-08 13:29:27Z maronga
48	! Module renamed
49	!
50	!
51	! 1682 2015-10-07 23:56:08Z knoop
52	! Code annotations made doxygen readable
53	!
54	! 1374 2014-04-25 12:55:07Z raasch
55	! missing variables added to ONLY list
56	!
57	! 1353 2014-04-08 15:21:23Z heinze
58	! REAL constants provided with KIND-attribute
59	!
60	! 1320 2014-03-20 08:40:49Z raasch
61	! ONLY-attribute added to USE-statements,
62	! kind-parameters added to all INTEGER and REAL declaration statements,
63	! kinds are defined in new module kinds,
64	! revision history before 2012 removed,
65	! comment fields (!:) to be used for variable explanations added to
66	! all variable declaration statements
67	!
68	! 1036 2012-10-22 13:43:42Z raasch
69	! code put under GPL (PALM 3.9)
70	!
71	! 1010 2012-09-20 07:59:54Z raasch
72	! cpp switch __nopointer added for pointer free version
73	!
74	! Revision 1.1 1997/08/29 08:54:20 raasch
75	! Initial revision
76	!
77	!
78	! Description:
79	! ------------
80	!> Advection term for scalar variables using the Piacsek and Williams scheme
81	!> (form C3). Contrary to PW itself, for reasons of accuracy their scheme is
82	!> slightly modified as follows: the values of those scalars that are used for
83	!> the computation of the flux divergence are reduced by the value of the
84	!> relevant scalar at the location where the difference is computed (sk(k,j,i)).
85	!> NOTE: at the first grid point above the surface computation still takes place!
86	!------------------------------------------------------------------------------!
87	MODULE advec_s_pw_mod
88
89
90	PRIVATE
91	PUBLIC advec_s_pw
92
93	INTERFACE advec_s_pw
94	MODULE PROCEDURE advec_s_pw
95	MODULE PROCEDURE advec_s_pw_ij
96	END INTERFACE
97
98	CONTAINS
99
100
101	!------------------------------------------------------------------------------!
102	! Description:
103	! ------------
104	!> Call for all grid points
105	!------------------------------------------------------------------------------!
106	SUBROUTINE advec_s_pw( sk )
107
108	USE arrays_3d, &
109	ONLY: dd2zu, tend, u, u_stokes_zu, v, v_stokes_zu, w
110
111	USE control_parameters, &
112	ONLY: u_gtrans, v_gtrans
113
114	USE grid_variables, &
115	ONLY: ddx, ddy
116
117	USE indices, &
118	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, &
119	nzt, wall_flags_0
120
121	USE kinds
122
123
124	IMPLICIT NONE
125
126	INTEGER(iwp) :: i !<
127	INTEGER(iwp) :: j !<
128	INTEGER(iwp) :: k !<
129
130	REAL(wp) :: gu !< local additional advective velocity
131	REAL(wp) :: gv !< local additional advective velocity
132
133	#if defined( __nopointer )
134	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !<
135	#else
136	REAL(wp), DIMENSION(:,:,:), POINTER :: sk
137	#endif
138
139
140	DO i = nxl, nxr
141	DO j = nys, nyn
142	DO k = nzb+1, nzt
143
144	!
145	!-- Galilean transformation + Stokes drift velocity (ocean only)
146	gu = u_gtrans - u_stokes_zu(k)
147	gv = v_gtrans - v_stokes_zu(k)
148
149	tend(k,j,i) = tend(k,j,i) + &
150	( -0.5_wp * ( ( u(k,j,i+1) - gu ) * &
151	( sk(k,j,i+1) - sk(k,j,i) ) &
152	- ( u(k,j,i) - gu ) * &
153	( sk(k,j,i-1) - sk(k,j,i) ) &
154	) * ddx &
155	-0.5_wp * ( ( v(k,j+1,i) - gv ) * &
156	( sk(k,j+1,i) - sk(k,j,i) ) &
157	- ( v(k,j,i) - gv ) * &
158	( sk(k,j-1,i) - sk(k,j,i) ) &
159	) * ddy &
160	- ( w(k,j,i) * &
161	( sk(k+1,j,i) - sk(k,j,i) ) &
162	- w(k-1,j,i) * &
163	( sk(k-1,j,i) - sk(k,j,i) ) &
164	) * dd2zu(k) &
165	) * MERGE( 1.0_wp, 0.0_wp, &
166	BTEST( wall_flags_0(k,j,i), 0 ) )
167	ENDDO
168	ENDDO
169	ENDDO
170
171	END SUBROUTINE advec_s_pw
172
173
174	!------------------------------------------------------------------------------!
175	! Description:
176	! ------------
177	!> Call for grid point i,j
178	!------------------------------------------------------------------------------!
179	SUBROUTINE advec_s_pw_ij( i, j, sk )
180
181	USE arrays_3d, &
182	ONLY: dd2zu, tend, u, u_stokes_zu, v, v_stokes_zu, w
183
184	USE control_parameters, &
185	ONLY: u_gtrans, v_gtrans
186
187	USE grid_variables, &
188	ONLY: ddx, ddy
189
190	USE indices, &
191	ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0
192
193	USE kinds
194
195
196	IMPLICIT NONE
197
198	INTEGER(iwp) :: i !<
199	INTEGER(iwp) :: j !<
200	INTEGER(iwp) :: k !<
201
202	REAL(wp) :: gu !< local additional advective velocity
203	REAL(wp) :: gv !< local additional advective velocity
204
205	#if defined( __nopointer )
206	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sk !<
207	#else
208	REAL(wp), DIMENSION(:,:,:), POINTER :: sk
209	#endif
210
211
212	DO k = nzb+1, nzt
213
214	!
215	!-- Galilean transformation + Stokes drift velocity (ocean only)
216	gu = u_gtrans - u_stokes_zu(k)
217	gv = v_gtrans - v_stokes_zu(k)
218
219	tend(k,j,i) = tend(k,j,i) + &
220	( -0.5_wp * ( ( u(k,j,i+1) - gu ) * &
221	( sk(k,j,i+1) - sk(k,j,i) ) &
222	- ( u(k,j,i) - gu ) * &
223	( sk(k,j,i-1) - sk(k,j,i) ) &
224	) * ddx &
225	-0.5_wp * ( ( v(k,j+1,i) - gv ) * &
226	( sk(k,j+1,i) - sk(k,j,i) ) &
227	- ( v(k,j,i) - gv ) * &
228	( sk(k,j-1,i) - sk(k,j,i) ) &
229	) * ddy &
230	- ( w(k,j,i) * &
231	( sk(k+1,j,i) - sk(k,j,i) ) &
232	- w(k-1,j,i) * &
233	( sk(k-1,j,i) - sk(k,j,i) ) &
234	) * dd2zu(k) &
235	) * MERGE( 1.0_wp, 0.0_wp, &
236	BTEST( wall_flags_0(k,j,i), 0 ) )
237	ENDDO
238
239	END SUBROUTINE advec_s_pw_ij
240
241	END MODULE advec_s_pw_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |