Home

Context Navigation

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

Last change on this file since 50 was 39, checked in by raasch, 18 years ago
comments prepared for 3.1c
Property svn:keywords set to `Id`
File size: 10.5 KB

Rev	Line
[1]	1	MODULE diffusion_s_mod
	2
	3	!------------------------------------------------------------------------------!
	4	! Actual revisions:
	5	! -----------------
[39]	6	!
[1]	7	!
	8	! Former revisions:
	9	! -----------------
[3]	10	! $Id: diffusion_s.f90 39 2007-03-01 12:46:59Z raasch $
[39]	11	!
	12	! 20 2007-02-26 00:12:32Z raasch
	13	! Bugfix: ddzw dimensioned 1:nzt"+1"
	14	! Calculation extended for gridpoint nzt, fluxes can be given at top,
	15	! +s_flux_t in parameter list, s_flux renamed s_flux_b
	16	!
[3]	17	! RCS Log replace by Id keyword, revision history cleaned up
	18	!
[1]	19	! Revision 1.8 2006/02/23 10:34:17 raasch
	20	! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
	21	! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
	22	! fluxes at vertically oriented topography
	23	!
	24	! Revision 1.1 2000/04/13 14:54:02 schroeter
	25	! Initial revision
	26	!
	27	!
	28	! Description:
	29	! ------------
	30	! Diffusion term of scalar quantities (temperature and water content)
	31	!------------------------------------------------------------------------------!
	32
	33	PRIVATE
	34	PUBLIC diffusion_s
	35
	36	INTERFACE diffusion_s
	37	MODULE PROCEDURE diffusion_s
	38	MODULE PROCEDURE diffusion_s_ij
	39	END INTERFACE diffusion_s
	40
	41	CONTAINS
	42
	43
	44	!------------------------------------------------------------------------------!
	45	! Call for all grid points
	46	!------------------------------------------------------------------------------!
[19]	47	SUBROUTINE diffusion_s( ddzu, ddzw, kh, s, s_flux_b, s_flux_t, tend )
[1]	48
	49	USE control_parameters
	50	USE grid_variables
	51	USE indices
	52
	53	IMPLICIT NONE
	54
	55	INTEGER :: i, j, k
	56	REAL :: vertical_gridspace
[20]	57	REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
[1]	58	REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
[19]	59	REAL, DIMENSION(:,:), POINTER :: s_flux_b, s_flux_t
[1]	60	REAL, DIMENSION(:,:,:), POINTER :: kh, s
	61
	62	DO i = nxl, nxr
	63	DO j = nys,nyn
	64	!
	65	!-- Compute horizontal diffusion
[19]	66	DO k = nzb_s_outer(j,i)+1, nzt
[1]	67
	68	tend(k,j,i) = tend(k,j,i) &
	69	+ 0.5 * ( &
	70	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	71	- ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
	72	) * ddx2 &
	73	+ 0.5 * ( &
	74	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	75	- ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
	76	) * ddy2
	77	ENDDO
	78
	79	!
	80	!-- Apply prescribed horizontal wall heatflux where necessary
	81	IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
	82	THEN
	83	DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
	84
	85	tend(k,j,i) = tend(k,j,i) &
	86	+ 0.5 * ( fwxp(j,i) * &
	87	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	88	- ( 1.0 - fwxp(j,i) ) * wall_heatflux(1) &
	89	-fwxm(j,i) * &
	90	( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
	91	+ ( 1.0 - fwxm(j,i) ) * wall_heatflux(3) &
	92	) * ddx2 &
	93	+ 0.5 * ( fwyp(j,i) * &
	94	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	95	- ( 1.0 - fwyp(j,i) ) * wall_heatflux(2) &
	96	-fwym(j,i) * &
	97	( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
	98	+ ( 1.0 - fwym(j,i) ) * wall_heatflux(4) &
	99	) * ddy2
	100	ENDDO
	101	ENDIF
	102
	103	!
	104	!-- Compute vertical diffusion. In case that surface fluxes have been
[19]	105	!-- prescribed or computed at bottom and/or top, index k starts/ends at
	106	!-- nzb+2 or nzt-1, respectively.
	107	DO k = nzb_diff_s_inner(j,i), nzt_diff
[1]	108
	109	tend(k,j,i) = tend(k,j,i) &
	110	+ 0.5 * ( &
	111	( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
	112	- ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
	113	) * ddzw(k)
	114	ENDDO
	115
	116	!
[19]	117	!-- Vertical diffusion at the first computational gridpoint along
[1]	118	!-- z-direction
	119	IF ( use_surface_fluxes ) THEN
	120
	121	k = nzb_s_inner(j,i)+1
	122
	123	tend(k,j,i) = tend(k,j,i) &
	124	+ ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
	125	* ( s(k+1,j,i)-s(k,j,i) ) &
	126	* ddzu(k+1) &
[19]	127	+ s_flux_b(j,i) &
[1]	128	) * ddzw(k)
	129
	130	ENDIF
	131
[19]	132	!
	133	!-- Vertical diffusion at the last computational gridpoint along
	134	!-- z-direction
	135	IF ( use_top_fluxes ) THEN
	136
	137	k = nzt
	138
	139	tend(k,j,i) = tend(k,j,i) &
	140	+ ( - s_flux_t(j,i) &
[20]	141	- 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) &
	142	* ( s(k,j,i)-s(k-1,j,i) ) &
	143	* ddzu(k) &
[19]	144	) * ddzw(k)
	145
	146	ENDIF
	147
[1]	148	ENDDO
	149	ENDDO
	150
	151	END SUBROUTINE diffusion_s
	152
	153
	154	!------------------------------------------------------------------------------!
	155	! Call for grid point i,j
	156	!------------------------------------------------------------------------------!
[19]	157	SUBROUTINE diffusion_s_ij( i, j, ddzu, ddzw, kh, s, s_flux_b, s_flux_t, &
	158	tend )
[1]	159
	160	USE control_parameters
	161	USE grid_variables
	162	USE indices
	163
	164	IMPLICIT NONE
	165
	166	INTEGER :: i, j, k
	167	REAL :: vertical_gridspace
[20]	168	REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
[1]	169	REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
[19]	170	REAL, DIMENSION(:,:), POINTER :: s_flux_b, s_flux_t
[1]	171	REAL, DIMENSION(:,:,:), POINTER :: kh, s
	172
	173	!
	174	!-- Compute horizontal diffusion
[19]	175	DO k = nzb_s_outer(j,i)+1, nzt
[1]	176
	177	tend(k,j,i) = tend(k,j,i) &
	178	+ 0.5 * ( &
	179	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	180	- ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
	181	) * ddx2 &
	182	+ 0.5 * ( &
	183	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	184	- ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
	185	) * ddy2
	186	ENDDO
	187
	188	!
	189	!-- Apply prescribed horizontal wall heatflux where necessary
	190	IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
	191	THEN
	192	DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
	193
	194	tend(k,j,i) = tend(k,j,i) &
	195	+ 0.5 * ( fwxp(j,i) * &
	196	( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
	197	- ( 1.0 - fwxp(j,i) ) * wall_heatflux(1) &
	198	-fwxm(j,i) * &
	199	( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
	200	+ ( 1.0 - fwxm(j,i) ) * wall_heatflux(3) &
	201	) * ddx2 &
	202	+ 0.5 * ( fwyp(j,i) * &
	203	( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
	204	- ( 1.0 - fwyp(j,i) ) * wall_heatflux(2) &
	205	-fwym(j,i) * &
	206	( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
	207	+ ( 1.0 - fwym(j,i) ) * wall_heatflux(4) &
	208	) * ddy2
	209	ENDDO
	210	ENDIF
	211
	212	!
	213	!-- Compute vertical diffusion. In case that surface fluxes have been
[19]	214	!-- prescribed or computed at bottom and/or top, index k starts/ends at
	215	!-- nzb+2 or nzt-1, respectively.
	216	DO k = nzb_diff_s_inner(j,i), nzt_diff
[1]	217
	218	tend(k,j,i) = tend(k,j,i) &
	219	+ 0.5 * ( &
	220	( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
	221	- ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
	222	) * ddzw(k)
	223	ENDDO
	224
	225	!
[19]	226	!-- Vertical diffusion at the first computational gridpoint along z-direction
[1]	227	IF ( use_surface_fluxes ) THEN
	228
	229	k = nzb_s_inner(j,i)+1
	230
[19]	231	tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
	232	* ( s(k+1,j,i)-s(k,j,i) ) &
	233	* ddzu(k+1) &
	234	+ s_flux_b(j,i) &
	235	) * ddzw(k)
[1]	236
	237	ENDIF
	238
[19]	239	!
	240	!-- Vertical diffusion at the last computational gridpoint along z-direction
	241	IF ( use_top_fluxes ) THEN
	242
	243	k = nzt
	244
	245	tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i) &
	246	- 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) &
	247	* ( s(k,j,i)-s(k-1,j,i) ) &
	248	* ddzu(k) &
	249	) * ddzw(k)
	250
	251	ENDIF
	252
[1]	253	END SUBROUTINE diffusion_s_ij
	254
	255	END MODULE diffusion_s_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |