Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |