Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_s.f90 @ 2183

Last change on this file since 2183 was 2119, checked in by raasch, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 14.8 KB

Rev	Line
[1873]	1	!> @file diffusion_s.f90
[2000]	2	!------------------------------------------------------------------------------!
[1036]	3	! This file is part of PALM.
	4	!
[2000]	5	! PALM is free software: you can redistribute it and/or modify it under the
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
[1036]	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	!
[2101]	17	! Copyright 1997-2017 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[484]	20	! Current revisions:
[1001]	21	! ------------------
[1341]	22	!
[2119]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: diffusion_s.f90 2119 2017-01-17 16:51:50Z schwenkel $
	27	!
[2119]	28	! 2118 2017-01-17 16:38:49Z raasch
	29	! OpenACC version of subroutine removed
	30	!
[2038]	31	! 2037 2016-10-26 11:15:40Z knoop
	32	! Anelastic approximation implemented
	33	!
[2001]	34	! 2000 2016-08-20 18:09:15Z knoop
	35	! Forced header and separation lines into 80 columns
	36	!
[1874]	37	! 1873 2016-04-18 14:50:06Z maronga
	38	! Module renamed (removed _mod)
[2118]	39	!
[1851]	40	! 1850 2016-04-08 13:29:27Z maronga
	41	! Module renamed
	42	!
[1692]	43	! 1691 2015-10-26 16:17:44Z maronga
	44	! Formatting corrections.
	45	!
[1683]	46	! 1682 2015-10-07 23:56:08Z knoop
	47	! Code annotations made doxygen readable
	48	!
[1375]	49	! 1374 2014-04-25 12:55:07Z raasch
	50	! missing variables added to ONLY list
	51	!
[1341]	52	! 1340 2014-03-25 19:45:13Z kanani
	53	! REAL constants defined as wp-kind
	54	!
[1321]	55	! 1320 2014-03-20 08:40:49Z raasch
[1320]	56	! ONLY-attribute added to USE-statements,
	57	! kind-parameters added to all INTEGER and REAL declaration statements,
	58	! kinds are defined in new module kinds,
	59	! revision history before 2012 removed,
	60	! comment fields (!:) to be used for variable explanations added to
	61	! all variable declaration statements
[1321]	62	!
[1258]	63	! 1257 2013-11-08 15:18:40Z raasch
	64	! openacc loop and loop vector clauses removed
	65	!
[1132]	66	! 1128 2013-04-12 06:19:32Z raasch
	67	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
	68	! j_north
	69	!
[1093]	70	! 1092 2013-02-02 11:24:22Z raasch
	71	! unused variables removed
	72	!
[1037]	73	! 1036 2012-10-22 13:43:42Z raasch
	74	! code put under GPL (PALM 3.9)
	75	!
[1017]	76	! 1015 2012-09-27 09:23:24Z raasch
	77	! accelerator version (*_acc) added
	78	!
[1011]	79	! 1010 2012-09-20 07:59:54Z raasch
	80	! cpp switch __nopointer added for pointer free version
	81	!
[1002]	82	! 1001 2012-09-13 14:08:46Z raasch
	83	! some arrays comunicated by module instead of parameter list
	84	!
[1]	85	! Revision 1.1 2000/04/13 14:54:02 schroeter
	86	! Initial revision
	87	!
	88	!
	89	! Description:
	90	! ------------
[1682]	91	!> Diffusion term of scalar quantities (temperature and water content)
[1]	92	!------------------------------------------------------------------------------!
[1682]	93	MODULE diffusion_s_mod
	94
[1]	95
	96	PRIVATE
[2118]	97	PUBLIC diffusion_s
[1]	98
	99	INTERFACE diffusion_s
	100	MODULE PROCEDURE diffusion_s
	101	MODULE PROCEDURE diffusion_s_ij
	102	END INTERFACE diffusion_s
	103
	104	CONTAINS
	105
	106
	107	!------------------------------------------------------------------------------!
[1682]	108	! Description:
	109	! ------------
	110	!> Call for all grid points
[1]	111	!------------------------------------------------------------------------------!
[1001]	112	SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
[1]	113
[1320]	114	USE arrays_3d, &
[2037]	115	ONLY: ddzu, ddzw, kh, tend, drho_air, rho_air_zw
[1320]	116
	117	USE control_parameters, &
	118	ONLY: use_surface_fluxes, use_top_fluxes
	119
	120	USE grid_variables, &
	121	ONLY: ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	122
	123	USE indices, &
[1374]	124	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, &
[1320]	125	nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
	126
	127	USE kinds
[1]	128
	129	IMPLICIT NONE
	130
[1682]	131	INTEGER(iwp) :: i !<
	132	INTEGER(iwp) :: j !<
	133	INTEGER(iwp) :: k !<
	134	REAL(wp) :: wall_s_flux(0:4) !<
	135	REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b, s_flux_t !<
[1010]	136	#if defined( __nopointer )
[1682]	137	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s !<
[1010]	138	#else
[1682]	139	REAL(wp), DIMENSION(:,:,:), POINTER :: s !<
[1010]	140	#endif
[1]	141
	142	DO i = nxl, nxr
	143	DO j = nys,nyn
	144	!
	145	!-- Compute horizontal diffusion
[19]	146	DO k = nzb_s_outer(j,i)+1, nzt
[1]	147
[1320]	148	tend(k,j,i) = tend(k,j,i) &
[1340]	149	+ 0.5_wp * ( &
[1320]	150	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	151	- ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
[1340]	152	) * ddx2 &
	153	+ 0.5_wp * ( &
[1320]	154	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	155	- ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
[1340]	156	) * ddy2
[1]	157	ENDDO
	158
	159	!
	160	!-- Apply prescribed horizontal wall heatflux where necessary
[1691]	161	IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) &
	162	) THEN
[1]	163	DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
	164
[1320]	165	tend(k,j,i) = tend(k,j,i) &
[1340]	166	+ ( fwxp(j,i) * 0.5_wp * &
[1320]	167	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
[1340]	168	+ ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1) &
	169	-fwxm(j,i) * 0.5_wp * &
[1320]	170	( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
[1340]	171	+ ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2) &
[1320]	172	) * ddx2 &
[1340]	173	+ ( fwyp(j,i) * 0.5_wp * &
[1320]	174	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
[1340]	175	+ ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3) &
	176	-fwym(j,i) * 0.5_wp * &
[1320]	177	( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
[1340]	178	+ ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4) &
[1]	179	) * ddy2
	180	ENDDO
	181	ENDIF
	182
	183	!
	184	!-- Compute vertical diffusion. In case that surface fluxes have been
[19]	185	!-- prescribed or computed at bottom and/or top, index k starts/ends at
	186	!-- nzb+2 or nzt-1, respectively.
	187	DO k = nzb_diff_s_inner(j,i), nzt_diff
[1]	188
[1320]	189	tend(k,j,i) = tend(k,j,i) &
[1340]	190	+ 0.5_wp * ( &
[1320]	191	( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
[2037]	192	* rho_air_zw(k) &
[1320]	193	- ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
[2037]	194	* rho_air_zw(k-1) &
	195	) * ddzw(k) * drho_air(k)
[1]	196	ENDDO
	197
	198	!
[19]	199	!-- Vertical diffusion at the first computational gridpoint along
[1]	200	!-- z-direction
	201	IF ( use_surface_fluxes ) THEN
	202
	203	k = nzb_s_inner(j,i)+1
	204
[1320]	205	tend(k,j,i) = tend(k,j,i) &
[1340]	206	+ ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) ) &
	207	* ( s(k+1,j,i)-s(k,j,i) ) &
	208	* ddzu(k+1) &
[2037]	209	* rho_air_zw(k) &
[1320]	210	+ s_flux_b(j,i) &
[2037]	211	) * ddzw(k) * drho_air(k)
[1]	212
	213	ENDIF
	214
[19]	215	!
	216	!-- Vertical diffusion at the last computational gridpoint along
	217	!-- z-direction
	218	IF ( use_top_fluxes ) THEN
	219
	220	k = nzt
	221
[1320]	222	tend(k,j,i) = tend(k,j,i) &
	223	+ ( - s_flux_t(j,i) &
[1340]	224	- 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
	225	* ( s(k,j,i)-s(k-1,j,i) ) &
	226	* ddzu(k) &
[2037]	227	* rho_air_zw(k-1) &
	228	) * ddzw(k) * drho_air(k)
[19]	229
	230	ENDIF
	231
[1]	232	ENDDO
	233	ENDDO
	234
	235	END SUBROUTINE diffusion_s
	236
	237
	238	!------------------------------------------------------------------------------!
[1682]	239	! Description:
	240	! ------------
	241	!> Call for grid point i,j
[1]	242	!------------------------------------------------------------------------------!
[1001]	243	SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
[1]	244
[1320]	245	USE arrays_3d, &
[2037]	246	ONLY: ddzu, ddzw, kh, tend, drho_air, rho_air_zw
[1320]	247
	248	USE control_parameters, &
	249	ONLY: use_surface_fluxes, use_top_fluxes
	250
	251	USE grid_variables, &
	252	ONLY: ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
	253
	254	USE indices, &
[1374]	255	ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_diff_s_inner, nzb_s_inner, &
[1320]	256	nzb_s_outer, nzt, nzt_diff
	257
	258	USE kinds
[1]	259
	260	IMPLICIT NONE
	261
[1682]	262	INTEGER(iwp) :: i !<
	263	INTEGER(iwp) :: j !<
	264	INTEGER(iwp) :: k !<
	265	REAL(wp) :: wall_s_flux(0:4) !<
	266	REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b !<
	267	REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_t !<
[1010]	268	#if defined( __nopointer )
[1682]	269	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s !<
[1010]	270	#else
[1682]	271	REAL(wp), DIMENSION(:,:,:), POINTER :: s !<
[1010]	272	#endif
[1]	273
	274	!
	275	!-- Compute horizontal diffusion
[19]	276	DO k = nzb_s_outer(j,i)+1, nzt
[1]	277
[1320]	278	tend(k,j,i) = tend(k,j,i) &
[1340]	279	+ 0.5_wp * ( &
[1320]	280	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	281	- ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
[1340]	282	) * ddx2 &
	283	+ 0.5_wp * ( &
[1320]	284	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	285	- ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
[1340]	286	) * ddy2
[1]	287	ENDDO
	288
	289	!
	290	!-- Apply prescribed horizontal wall heatflux where necessary
[1691]	291	IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) ) &
[1]	292	THEN
	293	DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
	294
[1320]	295	tend(k,j,i) = tend(k,j,i) &
[1340]	296	+ ( fwxp(j,i) * 0.5_wp * &
[1320]	297	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
[1340]	298	+ ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1) &
	299	-fwxm(j,i) * 0.5_wp * &
[1320]	300	( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
[1340]	301	+ ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2) &
[1320]	302	) * ddx2 &
[1340]	303	+ ( fwyp(j,i) * 0.5_wp * &
[1320]	304	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
[1340]	305	+ ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3) &
	306	-fwym(j,i) * 0.5_wp * &
[1320]	307	( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
[1340]	308	+ ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4) &
[1]	309	) * ddy2
	310	ENDDO
	311	ENDIF
	312
	313	!
	314	!-- Compute vertical diffusion. In case that surface fluxes have been
[19]	315	!-- prescribed or computed at bottom and/or top, index k starts/ends at
	316	!-- nzb+2 or nzt-1, respectively.
	317	DO k = nzb_diff_s_inner(j,i), nzt_diff
[1]	318
[1320]	319	tend(k,j,i) = tend(k,j,i) &
[1340]	320	+ 0.5_wp * ( &
[1320]	321	( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
[2037]	322	* rho_air_zw(k) &
[1320]	323	- ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
[2037]	324	* rho_air_zw(k-1) &
	325	) * ddzw(k) * drho_air(k)
[1]	326	ENDDO
	327
	328	!
[19]	329	!-- Vertical diffusion at the first computational gridpoint along z-direction
[1]	330	IF ( use_surface_fluxes ) THEN
	331
	332	k = nzb_s_inner(j,i)+1
	333
[1340]	334	tend(k,j,i) = tend(k,j,i) + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) ) &
	335	* ( s(k+1,j,i)-s(k,j,i) ) &
	336	* ddzu(k+1) &
[2037]	337	* rho_air_zw(k) &
[1320]	338	+ s_flux_b(j,i) &
[2037]	339	) * ddzw(k) * drho_air(k)
[1]	340
	341	ENDIF
	342
[19]	343	!
	344	!-- Vertical diffusion at the last computational gridpoint along z-direction
	345	IF ( use_top_fluxes ) THEN
	346
	347	k = nzt
	348
[1320]	349	tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i) &
[1340]	350	- 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) ) &
	351	* ( s(k,j,i)-s(k-1,j,i) ) &
	352	* ddzu(k) &
[2037]	353	* rho_air_zw(k-1) &
	354	) * ddzw(k) * drho_air(k)
[19]	355
	356	ENDIF
	357
[1]	358	END SUBROUTINE diffusion_s_ij
	359
	360	END MODULE diffusion_s_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |