Home

Context Navigation

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

Last change on this file since 1423 was 1354, checked in by heinze, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 10.7 KB

Rev	Line
[1]	1	MODULE coriolis_mod
	2
[1036]	3	!--------------------------------------------------------------------------------!
	4	! This file is part of PALM.
	5	!
	6	! PALM is free software: you can redistribute it and/or modify it under the terms
	7	! of the GNU General Public License as published by the Free Software Foundation,
	8	! either version 3 of the License, or (at your option) any later 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	!
[1310]	17	! Copyright 1997-2014 Leibniz Universitaet Hannover
[1036]	18	!--------------------------------------------------------------------------------!
	19	!
[254]	20	! Current revisions:
[1]	21	! -----------------
[1354]	22	!
	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: coriolis.f90 1354 2014-04-08 15:22:57Z kanani $
	27	!
[1354]	28	! 1353 2014-04-08 15:21:23Z heinze
	29	! REAL constants provided with KIND-attribute
	30	!
[1321]	31	! 1320 2014-03-20 08:40:49Z raasch
[1320]	32	! ONLY-attribute added to USE-statements,
	33	! kind-parameters added to all INTEGER and REAL declaration statements,
	34	! kinds are defined in new module kinds,
	35	! revision history before 2012 removed,
	36	! comment fields (!:) to be used for variable explanations added to
	37	! all variable declaration statements
[1321]	38	!
[1258]	39	! 1257 2013-11-08 15:18:40Z raasch
	40	! openacc loop and loop vector clauses removed
	41	!
[1132]	42	! 1128 2013-04-12 06:19:32Z raasch
	43	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
	44	! j_north
	45	!
[1037]	46	! 1036 2012-10-22 13:43:42Z raasch
	47	! code put under GPL (PALM 3.9)
	48	!
[1017]	49	! 1015 2012-09-27 09:23:24Z raasch
	50	! accelerator version (*_acc) added
	51	!
[1]	52	! Revision 1.1 1997/08/29 08:57:38 raasch
	53	! Initial revision
	54	!
	55	!
	56	! Description:
	57	! ------------
	58	! Computation of all Coriolis terms in the equations of motion.
	59	!------------------------------------------------------------------------------!
	60
	61	PRIVATE
[1015]	62	PUBLIC coriolis, coriolis_acc
[1]	63
	64	INTERFACE coriolis
	65	MODULE PROCEDURE coriolis
	66	MODULE PROCEDURE coriolis_ij
	67	END INTERFACE coriolis
	68
[1015]	69	INTERFACE coriolis_acc
	70	MODULE PROCEDURE coriolis_acc
	71	END INTERFACE coriolis_acc
	72
[1]	73	CONTAINS
	74
	75
	76	!------------------------------------------------------------------------------!
	77	! Call for all grid points
	78	!------------------------------------------------------------------------------!
	79	SUBROUTINE coriolis( component )
	80
[1320]	81	USE arrays_3d, &
	82	ONLY: tend, u, ug, v, vg, w
	83
	84	USE control_parameters, &
	85	ONLY: f, fs, message_string
	86
	87	USE indices, &
	88	ONLY: nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner, &
	89	nzb_w_inner, nzt
	90
	91	USE kinds
[1]	92
	93	IMPLICIT NONE
	94
[1320]	95	INTEGER(iwp) :: component !:
	96	INTEGER(iwp) :: i !:
	97	INTEGER(iwp) :: j !:
	98	INTEGER(iwp) :: k !:
[1]	99
	100
	101	!
	102	!-- Compute Coriolis terms for the three velocity components
	103	SELECT CASE ( component )
	104
	105	!
	106	!-- u-component
	107	CASE ( 1 )
[106]	108	DO i = nxlu, nxr
[1]	109	DO j = nys, nyn
	110	DO k = nzb_u_inner(j,i)+1, nzt
[1353]	111	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
[1320]	112	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
	113	v(k,j+1,i) ) - vg(k) ) &
[1353]	114	- fs * ( 0.25_wp * &
[1320]	115	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
[1]	116	w(k,j,i) ) &
	117	)
	118	ENDDO
	119	ENDDO
	120	ENDDO
	121
	122	!
	123	!-- v-component
	124	CASE ( 2 )
	125	DO i = nxl, nxr
[106]	126	DO j = nysv, nyn
[1]	127	DO k = nzb_v_inner(j,i)+1, nzt
[1353]	128	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
[1320]	129	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
[1]	130	u(k,j,i+1) ) - ug(k) )
	131	ENDDO
	132	ENDDO
	133	ENDDO
	134
	135	!
	136	!-- w-component
	137	CASE ( 3 )
	138	DO i = nxl, nxr
	139	DO j = nys, nyn
	140	DO k = nzb_w_inner(j,i)+1, nzt
[1353]	141	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
[1320]	142	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
[1]	143	u(k+1,j,i+1) )
	144	ENDDO
	145	ENDDO
	146	ENDDO
	147
	148	CASE DEFAULT
	149
[254]	150	WRITE( message_string, * ) ' wrong component: ', component
	151	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
[1]	152
	153	END SELECT
	154
	155	END SUBROUTINE coriolis
	156
	157
	158	!------------------------------------------------------------------------------!
[1015]	159	! Call for all grid points - accelerator version
	160	!------------------------------------------------------------------------------!
	161	SUBROUTINE coriolis_acc( component )
	162
[1320]	163	USE arrays_3d, &
	164	ONLY: tend, u, ug, v, vg, w
	165
	166	USE control_parameters, &
	167	ONLY: f, fs, message_string
	168
	169	USE indices, &
	170	ONLY: i_left, i_right, j_north, j_south, nzb_u_inner, &
	171	nzb_v_inner, nzb_w_inner, nzt
	172
	173	USE kinds
[1015]	174
	175	IMPLICIT NONE
	176
[1320]	177	INTEGER(iwp) :: component !:
	178	INTEGER(iwp) :: i !:
	179	INTEGER(iwp) :: j !:
	180	INTEGER(iwp) :: k !:
[1015]	181
	182
	183	!
	184	!-- Compute Coriolis terms for the three velocity components
	185	SELECT CASE ( component )
	186
	187	!
	188	!-- u-component
	189	CASE ( 1 )
	190	!$acc kernels present( nzb_u_inner, tend, v, vg, w )
[1128]	191	DO i = i_left, i_right
	192	DO j = j_south, j_north
[1015]	193	DO k = 1, nzt
	194	IF ( k > nzb_u_inner(j,i) ) THEN
[1353]	195	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
[1015]	196	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
	197	v(k,j+1,i) ) - vg(k) ) &
[1353]	198	- fs * ( 0.25_wp * &
[1015]	199	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) &
	200	+ w(k,j,i) ) &
	201	)
	202	ENDIF
	203	ENDDO
	204	ENDDO
	205	ENDDO
	206	!$acc end kernels
	207
	208	!
	209	!-- v-component
	210	CASE ( 2 )
	211	!$acc kernels present( nzb_v_inner, tend, u, ug )
[1128]	212	DO i = i_left, i_right
	213	DO j = j_south, j_north
[1015]	214	DO k = 1, nzt
	215	IF ( k > nzb_v_inner(j,i) ) THEN
[1353]	216	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
[1015]	217	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
	218	u(k,j,i+1) ) - ug(k) )
	219	ENDIF
	220	ENDDO
	221	ENDDO
	222	ENDDO
	223	!$acc end kernels
	224
	225	!
	226	!-- w-component
	227	CASE ( 3 )
	228	!$acc kernels present( nzb_w_inner, tend, u )
[1128]	229	DO i = i_left, i_right
	230	DO j = j_south, j_north
[1015]	231	DO k = 1, nzt
	232	IF ( k > nzb_w_inner(j,i) ) THEN
[1353]	233	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
[1320]	234	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
[1015]	235	u(k+1,j,i+1) )
	236	ENDIF
	237	ENDDO
	238	ENDDO
	239	ENDDO
	240	!$acc end kernels
	241
	242	CASE DEFAULT
	243
	244	WRITE( message_string, * ) ' wrong component: ', component
	245	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
	246
	247	END SELECT
	248
	249	END SUBROUTINE coriolis_acc
	250
	251
	252	!------------------------------------------------------------------------------!
[1]	253	! Call for grid point i,j
	254	!------------------------------------------------------------------------------!
	255	SUBROUTINE coriolis_ij( i, j, component )
	256
[1320]	257	USE arrays_3d, &
	258	ONLY: tend, u, ug, v, vg, w
	259
	260	USE control_parameters, &
	261	ONLY: f, fs, message_string
	262
	263	USE indices, &
	264	ONLY: nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
	265
	266	USE kinds
	267
[1]	268	IMPLICIT NONE
	269
[1320]	270	INTEGER(iwp) :: component !:
	271	INTEGER(iwp) :: i !:
	272	INTEGER(iwp) :: j !:
	273	INTEGER(iwp) :: k !:
[1]	274
	275	!
	276	!-- Compute Coriolis terms for the three velocity components
	277	SELECT CASE ( component )
	278
	279	!
	280	!-- u-component
	281	CASE ( 1 )
	282	DO k = nzb_u_inner(j,i)+1, nzt
[1353]	283	tend(k,j,i) = tend(k,j,i) + f * ( 0.25_wp * &
[1320]	284	( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
	285	v(k,j+1,i) ) - vg(k) ) &
[1353]	286	- fs * ( 0.25_wp * &
[1320]	287	( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
	288	w(k,j,i) ) )
[1]	289	ENDDO
	290
	291	!
	292	!-- v-component
	293	CASE ( 2 )
	294	DO k = nzb_v_inner(j,i)+1, nzt
[1353]	295	tend(k,j,i) = tend(k,j,i) - f * ( 0.25_wp * &
[1320]	296	( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
[1]	297	u(k,j,i+1) ) - ug(k) )
	298	ENDDO
	299
	300	!
	301	!-- w-component
	302	CASE ( 3 )
	303	DO k = nzb_w_inner(j,i)+1, nzt
[1353]	304	tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp * &
[1320]	305	( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
[1]	306	u(k+1,j,i+1) )
	307	ENDDO
	308
	309	CASE DEFAULT
	310
[254]	311	WRITE( message_string, * ) ' wrong component: ', component
	312	CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
[1]	313
	314	END SELECT
	315
	316	END SUBROUTINE coriolis_ij
	317
	318	END MODULE coriolis_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |