Home

Context Navigation

source: palm/trunk/SOURCE/coriolis.f90 @ 4482

Last change on this file since 4482 was 4360, checked in by suehring, 5 years ago
Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update
Property svn:keywords set to `Id`
File size: 11.6 KB

Rev	Line
[1873]	1	!> @file coriolis.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	!
[4360]	17	! Copyright 1997-2020 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[254]	20	! Current revisions:
[1]	21	! -----------------
[1354]	22	!
[3183]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: coriolis.f90 4360 2020-01-07 11:25:50Z maronga $
[4346]	27	! Introduction of wall_flags_total_0, which currently sets bits based on static
	28	! topography information used in wall_flags_static_0
	29	!
	30	! 4329 2019-12-10 15:46:36Z motisi
[4329]	31	! Renamed wall_flags_0 to wall_flags_static_0
	32	!
	33	! 4196 2019-08-29 11:02:06Z gronemeier
[4196]	34	! Consider rotation of model domain
	35	!
	36	! 4182 2019-08-22 15:20:23Z scharf
[4182]	37	! Corrected "Former revisions" section
	38	!
	39	! 3655 2019-01-07 16:51:22Z knoop
[3634]	40	! OpenACC port for SPEC
[1321]	41	!
[4182]	42	! Revision 1.1 1997/08/29 08:57:38 raasch
	43	! Initial revision
	44	!
	45	!
[1]	46	! Description:
	47	! ------------
[1682]	48	!> Computation of all Coriolis terms in the equations of motion.
[3538]	49	!>
	50	!> @note In this routine the topography is masked, even though this
	51	!> is again done in prognostic_equations. However, omitting the masking
	52	!> here lead to slightly different results. Reason unknown.
[1]	53	!------------------------------------------------------------------------------!
[1682]	54	MODULE coriolis_mod
	55
[1]	56
	57	PRIVATE
[2118]	58	PUBLIC coriolis
[1]	59
	60	INTERFACE coriolis
	61	MODULE PROCEDURE coriolis
	62	MODULE PROCEDURE coriolis_ij
	63	END INTERFACE coriolis
	64
	65	CONTAINS
	66
	67
	68	!------------------------------------------------------------------------------!
[1682]	69	! Description:
	70	! ------------
	71	!> Call for all grid points
[1]	72	!------------------------------------------------------------------------------!
	73	SUBROUTINE coriolis( component )
	74
[1320]	75	USE arrays_3d, &
	76	ONLY: tend, u, ug, v, vg, w
[4196]	77
	78	USE basic_constants_and_equations_mod, &
	79	ONLY: pi
	80
[1320]	81	USE control_parameters, &
[4196]	82	ONLY: f, fs, message_string, rotation_angle
[1320]	83
	84	USE indices, &
[4346]	85	ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, &
	86	wall_flags_total_0
[1320]	87
	88	USE kinds
[1]	89
	90	IMPLICIT NONE
	91
[4196]	92	INTEGER(iwp) :: component !< component of momentum equation
	93	INTEGER(iwp) :: i !< running index x direction
	94	INTEGER(iwp) :: j !< running index y direction
	95	INTEGER(iwp) :: k !< running index z direction
[1]	96
[4196]	97	REAL(wp) :: cos_rot_angle !< cosine of model rotation angle
[3182]	98	REAL(wp) :: flag !< flag to mask topography
[4196]	99	REAL(wp) :: sin_rot_angle !< sine of model rotation angle
[2696]	100
[1]	101	!
[4196]	102	!-- Precalculate cosine and sine of rotation angle
	103	cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
	104	sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
	105
	106	!
[1]	107	!-- Compute Coriolis terms for the three velocity components
	108	SELECT CASE ( component )
	109
	110	!
	111	!-- u-component
	112	CASE ( 1 )
[3634]	113	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
[4346]	114	!$ACC PRESENT(wall_flags_total_0) &
[3634]	115	!$ACC PRESENT(v, w, vg) &
	116	!$ACC PRESENT(tend)
[106]	117	DO i = nxlu, nxr
[1]	118	DO j = nys, nyn
[2232]	119	DO k = nzb+1, nzt
	120	!
[2696]	121	!-- Predetermine flag to mask topography
[4346]	122	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
[2232]	123
[4196]	124	tend(k,j,i) = tend(k,j,i) + flag * &
	125	( f &
	126	* ( 0.25_wp * ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + v(k,j+1,i) ) &
	127	- vg(k) ) &
	128	- fs * cos_rot_angle &
	129	* 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
	130	)
[1]	131	ENDDO
	132	ENDDO
	133	ENDDO
	134
	135	!
	136	!-- v-component
	137	CASE ( 2 )
[3634]	138	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
[4346]	139	!$ACC PRESENT(wall_flags_total_0) &
[4196]	140	!$ACC PRESENT(u, w, ug) &
[3634]	141	!$ACC PRESENT(tend)
[1]	142	DO i = nxl, nxr
[106]	143	DO j = nysv, nyn
[2232]	144	DO k = nzb+1, nzt
[2696]	145	!
	146	!-- Predetermine flag to mask topography
[4346]	147	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
[2696]	148
[4196]	149	tend(k,j,i) = tend(k,j,i) - flag * &
	150	( f &
	151	* ( 0.25_wp * ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + u(k,j,i+1) ) &
	152	- ug(k) ) &
	153	+ fs * sin_rot_angle &
	154	* 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) ) &
	155	)
[1]	156	ENDDO
	157	ENDDO
	158	ENDDO
	159
	160	!
	161	!-- w-component
	162	CASE ( 3 )
[3634]	163	!$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
[4346]	164	!$ACC PRESENT(wall_flags_total_0) &
[4196]	165	!$ACC PRESENT(u, v) &
[3634]	166	!$ACC PRESENT(tend)
[1]	167	DO i = nxl, nxr
	168	DO j = nys, nyn
[2232]	169	DO k = nzb+1, nzt
[2696]	170	!
	171	!-- Predetermine flag to mask topography
[4346]	172	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
[2696]	173
[4196]	174	tend(k,j,i) = tend(k,j,i) &
	175	+ fs * 0.25_wp * flag &
	176	* ( cos_rot_angle &
	177	* ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) ) &
	178	+ sin_rot_angle &
	179	* ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) ) &
	180	)
[1]	181	ENDDO
	182	ENDDO
	183	ENDDO
	184
	185	CASE DEFAULT
	186
[254]	187	WRITE( message_string, * ) ' wrong component: ', component
	188	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
[1]	189
	190	END SELECT
	191
	192	END SUBROUTINE coriolis
	193
	194
	195	!------------------------------------------------------------------------------!
[1682]	196	! Description:
	197	! ------------
	198	!> Call for grid point i,j
[1]	199	!------------------------------------------------------------------------------!
	200	SUBROUTINE coriolis_ij( i, j, component )
	201
[1320]	202	USE arrays_3d, &
	203	ONLY: tend, u, ug, v, vg, w
[4196]	204
	205	USE basic_constants_and_equations_mod, &
	206	ONLY: pi
	207
[1320]	208	USE control_parameters, &
[4196]	209	ONLY: f, fs, message_string, rotation_angle
[1320]	210
	211	USE indices, &
[4346]	212	ONLY: nzb, nzt, wall_flags_total_0
[1320]	213
	214	USE kinds
[4196]	215
[1]	216	IMPLICIT NONE
	217
[4196]	218	INTEGER(iwp) :: component !< component of momentum equation
[2232]	219	INTEGER(iwp) :: i !< running index x direction
	220	INTEGER(iwp) :: j !< running index y direction
	221	INTEGER(iwp) :: k !< running index z direction
[1]	222
[4196]	223	REAL(wp) :: cos_rot_angle !< cosine of model rotation angle
	224	REAL(wp) :: flag !< flag to mask topography
	225	REAL(wp) :: sin_rot_angle !< sine of model rotation angle
[2232]	226
[1]	227	!
[4196]	228	!-- Precalculate cosine and sine of rotation angle
	229	cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
	230	sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
	231
	232	!
[1]	233	!-- Compute Coriolis terms for the three velocity components
	234	SELECT CASE ( component )
	235
	236	!
	237	!-- u-component
	238	CASE ( 1 )
[2232]	239	DO k = nzb+1, nzt
	240	!
	241	!-- Predetermine flag to mask topography
[4346]	242	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
[2232]	243
[4196]	244	tend(k,j,i) = tend(k,j,i) + flag * &
	245	( f &
	246	* ( 0.25_wp * ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + v(k,j+1,i) ) &
	247	- vg(k) ) &
	248	- fs * cos_rot_angle &
	249	* 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
	250	)
[1]	251	ENDDO
	252
	253	!
	254	!-- v-component
	255	CASE ( 2 )
[2232]	256	DO k = nzb+1, nzt
[2696]	257	!
	258	!-- Predetermine flag to mask topography
[4346]	259	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
[2696]	260
[4196]	261	tend(k,j,i) = tend(k,j,i) - flag * &
	262	( f &
	263	* ( 0.25_wp * ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + u(k,j,i+1) ) &
	264	- ug(k) ) &
	265	+ fs * sin_rot_angle &
	266	* 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) ) &
	267	)
[1]	268	ENDDO
	269
	270	!
	271	!-- w-component
	272	CASE ( 3 )
[2232]	273	DO k = nzb+1, nzt
[2696]	274	!
	275	!-- Predetermine flag to mask topography
[4346]	276	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
[2696]	277
[4196]	278	tend(k,j,i) = tend(k,j,i) &
	279	+ fs * 0.25_wp * flag &
	280	* ( cos_rot_angle &
	281	* ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) ) &
	282	+ sin_rot_angle &
	283	* ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) ) &
	284	)
[1]	285	ENDDO
	286
	287	CASE DEFAULT
	288
[254]	289	WRITE( message_string, * ) ' wrong component: ', component
	290	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
[1]	291
	292	END SELECT
	293
	294	END SUBROUTINE coriolis_ij
	295
	296	END MODULE coriolis_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |