Home

Context Navigation

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

Last change on this file since 149 was 142, checked in by letzel, 17 years ago
Bugfix in plant_canopy_model: remove IF statement in plant_canopy_model_ij Bugfix in flow_statistics: divide sums(k,8) (e) and sums(k,34) (e*) by ngp_2dh_s_inner(k,sr) (like other scalars)
Property svn:keywords set to `Id`
File size: 10.2 KB

Rev	Line
[138]	1	MODULE plant_canopy_model_mod
	2
	3	!------------------------------------------------------------------------------!
	4	! Actual revisions:
	5	! -----------------
[142]	6	! Bugfix: remove IF statement in plant_canopy_model_ij
[138]	7	!
	8	! Former revisions:
	9	! -----------------
	10	! $Id: plant_canopy_model.f90 142 2007-12-04 12:36:44Z letzel $
	11	!
[139]	12	! 138 2007-11-28 10:03:58Z letzel
	13	! Initial revision
	14	!
[138]	15	! Description:
	16	! ------------
	17	! Evaluation of the drag due to vegetation
	18	!------------------------------------------------------------------------------!
	19
	20	PRIVATE
	21	PUBLIC plant_canopy_model
	22
	23	INTERFACE plant_canopy_model
	24	MODULE PROCEDURE plant_canopy_model
	25	MODULE PROCEDURE plant_canopy_model_ij
	26	END INTERFACE plant_canopy_model
	27
	28	CONTAINS
	29
	30
	31	!------------------------------------------------------------------------------!
	32	! Call for all grid points
	33	!------------------------------------------------------------------------------!
	34	SUBROUTINE plant_canopy_model( component )
	35
	36	USE arrays_3d
	37	USE control_parameters
	38	USE indices
	39	USE pegrid
	40
	41	IMPLICIT NONE
	42
	43	INTEGER :: component, i, j, k
	44
	45	!
	46	!-- Compute drag for the three velocity components and the SGS-TKE
	47	SELECT CASE ( component )
	48
	49	!
	50	!-- u-component
	51	CASE ( 1 )
	52	DO i = nxlu, nxr
	53	DO j = nys, nyn
	54	DO k = nzb_u_inner(j,i)+1, pch_index
	55	tend(k,j,i) = tend(k,j,i) - &
	56	cdc(k,j,i) * lad_u(k,j,i) * &
	57	SQRT( u(k,j,i)**2 + &
	58	( ( v(k,j,i-1) + &
	59	v(k,j,i) + &
	60	v(k,j+1,i) + &
	61	v(k,j+1,i+1) ) &
	62	/ 4.0 )**2 + &
	63	( ( w(k-1,j,i-1) + &
	64	w(k-1,j,i) + &
	65	w(k,j,i-1) + &
	66	w(k,j,i) ) &
	67	/ 4.0 )*2 ) &
	68	u(k,j,i)
	69	ENDDO
	70	ENDDO
	71	ENDDO
	72
	73	!
	74	!-- v-component
	75	CASE ( 2 )
	76	DO i = nxl, nxr
	77	DO j = nysv, nyn
	78	DO k = nzb_v_inner(j,i)+1, pch_index
	79	tend(k,j,i) = tend(k,j,i) - &
	80	cdc(k,j,i) * lad_v(k,j,i) * &
	81	SQRT( ( ( u(k,j-1,i) + &
	82	u(k,j-1,i+1) + &
	83	u(k,j,i) + &
	84	u(k,j,i+1) ) &
	85	/ 4.0 )**2 + &
	86	v(k,j,i)**2 + &
	87	( ( w(k-1,j-1,i) + &
	88	w(k-1,j,i) + &
	89	w(k,j-1,i) + &
	90	w(k,j,i) ) &
	91	/ 4.0 )*2 ) &
	92	v(k,j,i)
	93	ENDDO
	94	ENDDO
	95	ENDDO
	96
	97	!
	98	!-- w-component
	99	CASE ( 3 )
	100	DO i = nxl, nxr
	101	DO j = nys, nyn
	102	DO k = nzb_w_inner(j,i)+1, pch_index
	103	tend(k,j,i) = tend(k,j,i) - &
	104	cdc(k,j,i) * lad_w(k,j,i) * &
	105	SQRT( ( ( u(k,j,i) + &
	106	u(k,j,i+1) + &
	107	u(k+1,j,i) + &
	108	u(k+1,j,i+1) ) &
	109	/ 4.0 )**2 + &
	110	( ( v(k,j,i) + &
	111	v(k,j+1,i) + &
	112	v(k+1,j,i) + &
	113	v(k+1,j+1,i) ) &
	114	/ 4.0 )**2 + &
	115	w(k,j,i)*2 ) &
	116	w(k,j,i)
	117	ENDDO
	118	ENDDO
	119	ENDDO
	120
	121	!
	122	!-- sgs-tke
	123	CASE ( 4 )
	124	DO i = nxl, nxr
	125	DO j = nys, nyn
	126	DO k = nzb_s_inner(j,i)+1, pch_index
	127	tend(k,j,i) = tend(k,j,i) - &
	128	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
	129	SQRT( ( ( u(k,j,i) + &
	130	u(k,j,i+1) ) &
	131	/ 2.0 )**2 + &
	132	( ( v(k,j,i) + &
	133	v(k,j+1,i) ) &
	134	/ 2.0 )**2 + &
	135	( ( w(k,j,i) + &
	136	w(k+1,j,i) ) &
	137	/ 2.0 )*2 ) &
	138	e(k,j,i)
	139	ENDDO
	140	ENDDO
	141	ENDDO
	142
	143	CASE DEFAULT
	144
	145	IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', &
	146	component
	147	CALL local_stop
	148
	149	END SELECT
	150
	151	END SUBROUTINE plant_canopy_model
	152
	153
	154	!------------------------------------------------------------------------------!
	155	! Call for grid point i,j
	156	!------------------------------------------------------------------------------!
	157	SUBROUTINE plant_canopy_model_ij( i, j, component )
	158
	159	USE arrays_3d
	160	USE control_parameters
	161	USE indices
	162	USE pegrid
	163
	164	IMPLICIT NONE
	165
	166	INTEGER :: component, i, j, k
	167
	168	!
[142]	169	!-- Compute drag for the three velocity components
	170	SELECT CASE ( component )
[138]	171
	172	!
[142]	173	!-- u-component
	174	CASE ( 1 )
	175	DO k = nzb_u_inner(j,i)+1, pch_index
	176	tend(k,j,i) = tend(k,j,i) - &
	177	cdc(k,j,i) * lad_u(k,j,i) * &
	178	SQRT( u(k,j,i)**2 + &
	179	( ( v(k,j,i-1) + &
	180	v(k,j,i) + &
	181	v(k,j+1,i) + &
	182	v(k,j+1,i+1) ) &
	183	/ 4.0 )**2 + &
	184	( ( w(k-1,j,i-1) + &
	185	w(k-1,j,i) + &
	186	w(k,j,i-1) + &
	187	w(k,j,i) ) &
	188	/ 4.0 )*2 ) &
	189	u(k,j,i)
	190	ENDDO
[138]	191
	192	!
[142]	193	!-- v-component
	194	CASE ( 2 )
	195	DO k = nzb_v_inner(j,i)+1, pch_index
	196	tend(k,j,i) = tend(k,j,i) - &
	197	cdc(k,j,i) * lad_v(k,j,i) * &
	198	SQRT( ( ( u(k,j-1,i) + &
	199	u(k,j-1,i+1) + &
	200	u(k,j,i) + &
	201	u(k,j,i+1) ) &
	202	/ 4.0 )**2 + &
	203	v(k,j,i)**2 + &
	204	( ( w(k-1,j-1,i) + &
	205	w(k-1,j,i) + &
	206	w(k,j-1,i) + &
	207	w(k,j,i) ) &
	208	/ 4.0 )*2 ) &
	209	v(k,j,i)
	210	ENDDO
[138]	211
	212	!
[142]	213	!-- w-component
	214	CASE ( 3 )
	215	DO k = nzb_w_inner(j,i)+1, pch_index
	216	tend(k,j,i) = tend(k,j,i) - &
	217	cdc(k,j,i) * lad_w(k,j,i) * &
	218	SQRT( ( ( u(k,j,i) + &
	219	u(k,j,i+1) + &
	220	u(k+1,j,i) + &
	221	u(k+1,j,i+1) ) &
	222	/ 4.0 )**2 + &
	223	( ( v(k,j,i) + &
	224	v(k,j+1,i) + &
	225	v(k+1,j,i) + &
	226	v(k+1,j+1,i) ) &
	227	/ 4.0 )**2 + &
	228	w(k,j,i)*2 ) &
	229	w(k,j,i)
[138]	230
[142]	231	ENDDO
[138]	232
	233	!
[142]	234	!-- sgs-tke
	235	CASE ( 4 )
	236	DO k = nzb_s_inner(j,i)+1, pch_index
	237	tend(k,j,i) = tend(k,j,i) - &
	238	2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
	239	SQRT( ( ( u(k,j,i) + &
	240	u(k,j,i+1) ) &
	241	/ 2.0 )**2 + &
	242	( ( v(k,j,i) + &
	243	v(k,j+1,i) ) &
	244	/ 2.0 )**2 + &
	245	( ( w(k,j,i) + &
	246	w(k+1,j,i) ) &
	247	/ 2.0 )*2 ) &
	248	e(k,j,i)
	249	ENDDO
[138]	250
[142]	251	CASE DEFAULT
[138]	252
[142]	253	IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', &
	254	component
	255	CALL local_stop
[138]	256
[142]	257	END SELECT
[138]	258
	259	END SUBROUTINE plant_canopy_model_ij
	260
	261	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 |