Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |