Home

Context Navigation

source: palm/trunk/SOURCE/plant_canopy_model.f90 @ 1315

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