Home

Context Navigation

source: palm/trunk/SOURCE/plant_canopy_model.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: 15.3 KB

Rev	Line
[138]	1	MODULE plant_canopy_model_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	!
[257]	20	! Current revisions:
[138]	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
[153]	29	!
[138]	30	! Former revisions:
	31	! -----------------
	32	! $Id: plant_canopy_model.f90 1320 2014-03-20 08:40:49Z raasch $
	33	!
[1037]	34	! 1036 2012-10-22 13:43:42Z raasch
	35	! code put under GPL (PALM 3.9)
	36	!
[139]	37	! 138 2007-11-28 10:03:58Z letzel
	38	! Initial revision
	39	!
[138]	40	! Description:
	41	! ------------
[153]	42	! Evaluation of sinks and sources of momentum, heat and scalar concentration
	43	! due to canopy elements
[138]	44	!------------------------------------------------------------------------------!
	45
	46	PRIVATE
	47	PUBLIC plant_canopy_model
	48
	49	INTERFACE plant_canopy_model
	50	MODULE PROCEDURE plant_canopy_model
	51	MODULE PROCEDURE plant_canopy_model_ij
	52	END INTERFACE plant_canopy_model
	53
	54	CONTAINS
	55
	56
	57	!------------------------------------------------------------------------------!
	58	! Call for all grid points
	59	!------------------------------------------------------------------------------!
	60	SUBROUTINE plant_canopy_model( component )
	61
[1320]	62	USE arrays_3d, &
	63	ONLY: canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w, &
	64	q, sec, sls, tend, u, v, w
[138]	65
[1320]	66	USE control_parameters, &
	67	ONLY: pch_index, message_string
	68
	69	USE indices, &
	70	ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner, &
	71	nzb_v_inner, nzb_w_inner
	72
	73	USE kinds
	74
[138]	75	IMPLICIT NONE
	76
[1320]	77	INTEGER(iwp) :: component !:
	78	INTEGER(iwp) :: i !:
	79	INTEGER(iwp) :: j !:
	80	INTEGER(iwp) :: k !:
[138]	81
	82	!
	83	!-- Compute drag for the three velocity components and the SGS-TKE
	84	SELECT CASE ( component )
	85
	86	!
	87	!-- u-component
	88	CASE ( 1 )
	89	DO i = nxlu, nxr
	90	DO j = nys, nyn
	91	DO k = nzb_u_inner(j,i)+1, pch_index
	92	tend(k,j,i) = tend(k,j,i) - &
	93	cdc(k,j,i) * lad_u(k,j,i) * &
	94	SQRT( u(k,j,i)**2 + &
	95	( ( v(k,j,i-1) + &
	96	v(k,j,i) + &
	97	v(k,j+1,i) + &
[153]	98	v(k,j+1,i-1) ) &
[138]	99	/ 4.0 )**2 + &
	100	( ( w(k-1,j,i-1) + &
	101	w(k-1,j,i) + &
	102	w(k,j,i-1) + &
	103	w(k,j,i) ) &
	104	/ 4.0 )*2 ) &
	105	u(k,j,i)
	106	ENDDO
	107	ENDDO
	108	ENDDO
	109
	110	!
	111	!-- v-component
	112	CASE ( 2 )
	113	DO i = nxl, nxr
	114	DO j = nysv, nyn
	115	DO k = nzb_v_inner(j,i)+1, pch_index
	116	tend(k,j,i) = tend(k,j,i) - &
	117	cdc(k,j,i) * lad_v(k,j,i) * &
	118	SQRT( ( ( u(k,j-1,i) + &
	119	u(k,j-1,i+1) + &
	120	u(k,j,i) + &
	121	u(k,j,i+1) ) &
	122	/ 4.0 )**2 + &
	123	v(k,j,i)**2 + &
	124	( ( w(k-1,j-1,i) + &
	125	w(k-1,j,i) + &
	126	w(k,j-1,i) + &
	127	w(k,j,i) ) &
	128	/ 4.0 )*2 ) &
	129	v(k,j,i)
	130	ENDDO
	131	ENDDO
	132	ENDDO
	133
	134	!
	135	!-- w-component
	136	CASE ( 3 )
	137	DO i = nxl, nxr
	138	DO j = nys, nyn
	139	DO k = nzb_w_inner(j,i)+1, pch_index
	140	tend(k,j,i) = tend(k,j,i) - &
	141	cdc(k,j,i) * lad_w(k,j,i) * &
	142	SQRT( ( ( u(k,j,i) + &
	143	u(k,j,i+1) + &
	144	u(k+1,j,i) + &
	145	u(k+1,j,i+1) ) &
	146	/ 4.0 )**2 + &
	147	( ( v(k,j,i) + &
	148	v(k,j+1,i) + &
	149	v(k+1,j,i) + &
	150	v(k+1,j+1,i) ) &
	151	/ 4.0 )**2 + &
	152	w(k,j,i)*2 ) &
	153	w(k,j,i)
	154	ENDDO
	155	ENDDO
	156	ENDDO
	157
	158	!
[153]	159	!-- potential temperature
[138]	160	CASE ( 4 )
	161	DO i = nxl, nxr
	162	DO j = nys, nyn
	163	DO k = nzb_s_inner(j,i)+1, pch_index
[1320]	164	tend(k,j,i) = tend(k,j,i) + &
[153]	165	( canopy_heat_flux(k,j,i) - &
	166	canopy_heat_flux(k-1,j,i) ) / &
	167	dzw(k)
	168	ENDDO
	169	ENDDO
	170	ENDDO
	171
	172	!
	173	!-- scalar concentration
	174	CASE ( 5 )
	175	DO i = nxl, nxr
	176	DO j = nys, nyn
	177	DO k = nzb_s_inner(j,i)+1, pch_index
[138]	178	tend(k,j,i) = tend(k,j,i) - &
[153]	179	sec(k,j,i) * lad_s(k,j,i) * &
	180	SQRT( ( ( u(k,j,i) + &
	181	u(k,j,i+1) ) &
	182	/ 2.0 )**2 + &
	183	( ( v(k,j,i) + &
	184	v(k,j+1,i) ) &
	185	/ 2.0 )**2 + &
	186	( ( w(k-1,j,i) + &
	187	w(k,j,i) ) &
	188	/ 2.0 )*2 ) &
	189	( q(k,j,i) - sls(k,j,i) )
	190	ENDDO
	191	ENDDO
	192	ENDDO
	193
	194	!
	195	!-- sgs-tke
	196	CASE ( 6 )
	197	DO i = nxl, nxr
	198	DO j = nys, nyn
	199	DO k = nzb_s_inner(j,i)+1, pch_index
	200	tend(k,j,i) = tend(k,j,i) - &
[138]	201	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
	202	SQRT( ( ( u(k,j,i) + &
	203	u(k,j,i+1) ) &
	204	/ 2.0 )**2 + &
	205	( ( v(k,j,i) + &
	206	v(k,j+1,i) ) &
	207	/ 2.0 )**2 + &
	208	( ( w(k,j,i) + &
	209	w(k+1,j,i) ) &
	210	/ 2.0 )*2 ) &
	211	e(k,j,i)
	212	ENDDO
	213	ENDDO
	214	ENDDO
	215
	216	CASE DEFAULT
	217
[257]	218	WRITE( message_string, * ) 'wrong component: ', component
	219	CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
[138]	220
	221	END SELECT
	222
	223	END SUBROUTINE plant_canopy_model
	224
	225
	226	!------------------------------------------------------------------------------!
	227	! Call for grid point i,j
	228	!------------------------------------------------------------------------------!
	229	SUBROUTINE plant_canopy_model_ij( i, j, component )
	230
[1320]	231	USE arrays_3d, &
	232	ONLY: canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w, &
	233	q, sec, sls, tend, u, v, w
[138]	234
[1320]	235	USE control_parameters, &
	236	ONLY: pch_index, message_string
	237
	238	USE indices, &
	239	ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner, &
	240	nzb_v_inner, nzb_w_inner
	241
	242	USE kinds
	243
[138]	244	IMPLICIT NONE
	245
[1320]	246	INTEGER(iwp) :: component !:
	247	INTEGER(iwp) :: i !:
	248	INTEGER(iwp) :: j !:
	249	INTEGER(iwp) :: k !:
[138]	250
	251	!
[1320]	252	!-- Compute drag for the three velocity components
[142]	253	SELECT CASE ( component )
[138]	254
	255	!
[142]	256	!-- u-component
	257	CASE ( 1 )
	258	DO k = nzb_u_inner(j,i)+1, pch_index
[1320]	259	tend(k,j,i) = tend(k,j,i) - &
[142]	260	cdc(k,j,i) * lad_u(k,j,i) * &
	261	SQRT( u(k,j,i)**2 + &
	262	( ( v(k,j,i-1) + &
	263	v(k,j,i) + &
	264	v(k,j+1,i) + &
[153]	265	v(k,j+1,i-1) ) &
[142]	266	/ 4.0 )**2 + &
	267	( ( w(k-1,j,i-1) + &
	268	w(k-1,j,i) + &
	269	w(k,j,i-1) + &
	270	w(k,j,i) ) &
	271	/ 4.0 )*2 ) &
	272	u(k,j,i)
	273	ENDDO
[138]	274
	275	!
[142]	276	!-- v-component
	277	CASE ( 2 )
	278	DO k = nzb_v_inner(j,i)+1, pch_index
[1320]	279	tend(k,j,i) = tend(k,j,i) - &
[142]	280	cdc(k,j,i) * lad_v(k,j,i) * &
	281	SQRT( ( ( u(k,j-1,i) + &
	282	u(k,j-1,i+1) + &
	283	u(k,j,i) + &
	284	u(k,j,i+1) ) &
	285	/ 4.0 )**2 + &
	286	v(k,j,i)**2 + &
	287	( ( w(k-1,j-1,i) + &
	288	w(k-1,j,i) + &
	289	w(k,j-1,i) + &
	290	w(k,j,i) ) &
	291	/ 4.0 )*2 ) &
	292	v(k,j,i)
	293	ENDDO
[138]	294
	295	!
[142]	296	!-- w-component
	297	CASE ( 3 )
	298	DO k = nzb_w_inner(j,i)+1, pch_index
[1320]	299	tend(k,j,i) = tend(k,j,i) - &
[142]	300	cdc(k,j,i) * lad_w(k,j,i) * &
	301	SQRT( ( ( u(k,j,i) + &
	302	u(k,j,i+1) + &
	303	u(k+1,j,i) + &
	304	u(k+1,j,i+1) ) &
	305	/ 4.0 )**2 + &
	306	( ( v(k,j,i) + &
	307	v(k,j+1,i) + &
	308	v(k+1,j,i) + &
	309	v(k+1,j+1,i) ) &
	310	/ 4.0 )**2 + &
	311	w(k,j,i)*2 ) &
	312	w(k,j,i)
[138]	313
[142]	314	ENDDO
[138]	315
	316	!
[153]	317	!-- potential temperature
	318	CASE ( 4 )
	319	DO k = nzb_s_inner(j,i)+1, pch_index
[1320]	320	tend(k,j,i) = tend(k,j,i) + &
[153]	321	( canopy_heat_flux(k,j,i) - &
	322	canopy_heat_flux(k-1,j,i) ) / &
	323	dzw(k)
	324	ENDDO
	325
	326
	327	!
	328	!-- scalar concentration
	329	CASE ( 5 )
	330	DO k = nzb_s_inner(j,i)+1, pch_index
	331	tend(k,j,i) = tend(k,j,i) - &
	332	sec(k,j,i) * lad_s(k,j,i) * &
	333	SQRT( ( ( u(k,j,i) + &
	334	u(k,j,i+1) ) &
	335	/ 2.0 )**2 + &
	336	( ( v(k,j,i) + &
	337	v(k,j+1,i) ) &
	338	/ 2.0 )**2 + &
	339	( ( w(k-1,j,i) + &
	340	w(k,j,i) ) &
	341	/ 2.0 )*2 ) &
	342	( q(k,j,i) - sls(k,j,i) )
	343	ENDDO
	344
	345	!
[142]	346	!-- sgs-tke
[153]	347	CASE ( 6 )
[142]	348	DO k = nzb_s_inner(j,i)+1, pch_index
[1320]	349	tend(k,j,i) = tend(k,j,i) - &
[142]	350	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
	351	SQRT( ( ( u(k,j,i) + &
	352	u(k,j,i+1) ) &
	353	/ 2.0 )**2 + &
	354	( ( v(k,j,i) + &
	355	v(k,j+1,i) ) &
	356	/ 2.0 )**2 + &
	357	( ( w(k,j,i) + &
	358	w(k+1,j,i) ) &
	359	/ 2.0 )*2 ) &
	360	e(k,j,i)
	361	ENDDO
[138]	362
[142]	363	CASE DEFAULT
[138]	364
[257]	365	WRITE( message_string, * ) 'wrong component: ', component
	366	CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
[138]	367
[142]	368	END SELECT
[138]	369
	370	END SUBROUTINE plant_canopy_model_ij
	371
	372	END MODULE plant_canopy_model_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |