Home

Context Navigation

subsidence_mod.f90 @ 4867

Last change on this file since 4867 was 4828, checked in by Giersch, 4 years ago
Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code
Property svn:keywords set to `Id`
File size: 17.0 KB

Rev	Line
[1850]	1	!> @file subsidence_mod.f90
[4591]	2	!--------------------------------------------------------------------------------------------------!
[2696]	3	! This file is part of the PALM model system.
[1036]	4	!
[4591]	5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
	6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
	7	! (at your option) any later version.
[1036]	8	!
[4591]	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
	10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
	11	! Public License for more details.
[1036]	12	!
[4591]	13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
	14	! <http://www.gnu.org/licenses/>.
[1036]	15	!
[4828]	16	! Copyright 1997-2021 Leibniz Universitaet Hannover
[4591]	17	!--------------------------------------------------------------------------------------------------!
[1036]	18	!
[4591]	19	!
[411]	20	! Current revisions:
	21	! -----------------
[4591]	22	!
	23	!
[1383]	24	! Former revisions:
	25	! -----------------
	26	! $Id: subsidence_mod.f90 4828 2021-01-05 11:21:41Z moh.hefny $
[4591]	27	! File re-formatted to follow the PALM coding standard
	28	!
	29	!
	30	! 4360 2020-01-07 11:25:50Z suehring
	31	! Introduction of wall_flags_total_0, which currently sets bits based on static topography
	32	! information used in wall_flags_static_0
	33	!
[4346]	34	! 4329 2019-12-10 15:46:36Z motisi
[4329]	35	! Renamed wall_flags_0 to wall_flags_static_0
[4591]	36	!
[4329]	37	! 4182 2019-08-22 15:20:23Z scharf
[4182]	38	! Corrected "Former revisions" section
[4591]	39	!
[4182]	40	! 3655 2019-01-07 16:51:22Z knoop
[4591]	41	! Add subroutine and variable description
[1383]	42	!
[4182]	43	! Revision 3.7 2009-12-11 14:15:58Z heinze
[4591]	44	! Initial revision
[4182]	45	!
[411]	46	! Description:
	47	! ------------
[4591]	48	!> Impact of large-scale subsidence or ascent as tendency term for use in the prognostic equation of
	49	!> potential temperature. This enables the construction of a constant boundary layer height z_i with
	50	!> time.
	51	!--------------------------------------------------------------------------------------------------!
[1682]	52	MODULE subsidence_mod
[411]	53
	54
	55	IMPLICIT NONE
	56
	57	PRIVATE
	58	PUBLIC init_w_subsidence, subsidence
	59
	60	INTERFACE init_w_subsidence
	61	MODULE PROCEDURE init_w_subsidence
	62	END INTERFACE init_w_subsidence
	63
	64	INTERFACE subsidence
	65	MODULE PROCEDURE subsidence
	66	MODULE PROCEDURE subsidence_ij
	67	END INTERFACE subsidence
	68
	69	CONTAINS
	70
[4591]	71	!--------------------------------------------------------------------------------------------------!
[1682]	72	! Description:
	73	! ------------
[3554]	74	!> Initialize vertical subsidence velocity w_subs.
[4591]	75	!--------------------------------------------------------------------------------------------------!
	76	SUBROUTINE init_w_subsidence
[411]	77
[4591]	78	USE arrays_3d, &
	79	ONLY: dzu, &
	80	w_subs, &
	81	zu
[411]	82
[4591]	83	USE control_parameters, &
	84	ONLY: message_string, &
	85	ocean_mode, &
	86	subs_vertical_gradient, &
	87	subs_vertical_gradient_level, &
	88	subs_vertical_gradient_level_i
[1320]	89
[4591]	90	USE indices, &
	91	ONLY: nzb, &
	92	nzt
[1320]	93
	94	USE kinds
	95
[411]	96	IMPLICIT NONE
	97
[4591]	98	INTEGER(iwp) :: i !< loop index
	99	INTEGER(iwp) :: k !< loop index
[411]	100
[4591]	101	REAL(wp) :: gradient !< vertical gradient of subsidence velocity
	102	REAL(wp) :: ws_surface !< subsidence velocity at the surface
[1320]	103
[1862]	104	IF ( .NOT. ALLOCATED( w_subs ) ) THEN
[411]	105	ALLOCATE( w_subs(nzb:nzt+1) )
[1353]	106	w_subs = 0.0_wp
[4591]	107	ENDIF
[411]	108
[3294]	109	IF ( ocean_mode ) THEN
[4591]	110	message_string = 'applying large scale vertical motion is not allowed for ocean mode'
[411]	111	CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 )
	112	ENDIF
	113
	114	!
[4591]	115	!-- Compute the profile of the subsidence/ascent velocity using the given gradients
[411]	116	i = 1
[1353]	117	gradient = 0.0_wp
	118	ws_surface = 0.0_wp
[411]	119
[4591]	120
[580]	121	subs_vertical_gradient_level_i(1) = 0
[411]	122	DO k = 1, nzt+1
[1365]	123	IF ( i < 11 ) THEN
[4591]	124	IF ( subs_vertical_gradient_level(i) < zu(k) .AND. &
[1353]	125	subs_vertical_gradient_level(i) >= 0.0_wp ) THEN
	126	gradient = subs_vertical_gradient(i) / 100.0_wp
[580]	127	subs_vertical_gradient_level_i(i) = k - 1
[411]	128	i = i + 1
	129	ENDIF
	130	ENDIF
[1353]	131	IF ( gradient /= 0.0_wp ) THEN
[411]	132	IF ( k /= 1 ) THEN
	133	w_subs(k) = w_subs(k-1) + dzu(k) * gradient
	134	ELSE
[1353]	135	w_subs(k) = ws_surface + 0.5_wp * dzu(k) * gradient
[411]	136	ENDIF
	137	ELSE
	138	w_subs(k) = w_subs(k-1)
	139	ENDIF
	140	ENDDO
	141
	142	!
[4591]	143	!-- In case of no given gradients for the subsidence/ascent velocity, choose zero gradient
[1353]	144	IF ( subs_vertical_gradient_level(1) == -9999999.9_wp ) THEN
	145	subs_vertical_gradient_level(1) = 0.0_wp
[411]	146	ENDIF
	147
	148	END SUBROUTINE init_w_subsidence
	149
	150
[4591]	151	!--------------------------------------------------------------------------------------------------!
[1682]	152	! Description:
	153	! ------------
[3554]	154	!> Add effect of large-scale subsidence to variable.
[4591]	155	!--------------------------------------------------------------------------------------------------!
	156	SUBROUTINE subsidence( tendency, var, var_init, ls_index )
[411]	157
[4591]	158	USE arrays_3d, &
	159	ONLY: ddzu, &
	160	w_subs
[411]	161
[4591]	162	USE control_parameters, &
	163	ONLY: dt_3d, &
	164	intermediate_timestep_count, &
	165	large_scale_forcing, &
[1380]	166	scalar_rayleigh_damping
[1320]	167
[4591]	168	USE indices, &
	169	ONLY: nxl, &
	170	nxlg, &
	171	nxr, &
	172	nxrg, &
	173	nyn, &
	174	nyng, &
	175	nys, &
	176	nysg, &
	177	nzb, &
	178	nzt, &
[4346]	179	wall_flags_total_0
[1320]	180
	181	USE kinds
	182
[4591]	183	USE statistics, &
	184	ONLY: sums_ls_l, &
	185	weight_substep
[1365]	186
[411]	187	IMPLICIT NONE
	188
[4591]	189	INTEGER(iwp) :: i !< loop index
	190	INTEGER(iwp) :: j !< loop index
	191	INTEGER(iwp) :: k !< loop index
	192	INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l
[411]	193
[4591]	194	REAL(wp) :: tmp_tend !< temporary tendency
	195	REAL(wp) :: tmp_grad !< temporary gradient
	196
	197	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence
	198	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var
	199	REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var
	200	REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var
	201
[464]	202	var_mod = var_init
[411]	203
	204	!
	205	!-- Influence of w_subsidence on the current tendency term
	206	DO i = nxl, nxr
	207	DO j = nys, nyn
[1382]	208
[4591]	209	DO k = nzb+1, nzt
[1365]	210	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
[4591]	211	tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1) * &
	212	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
	213	ELSE ! large-scale ascent
	214	tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) * &
	215	MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[411]	216	ENDIF
[1365]	217
	218	tendency(k,j,i) = tendency(k,j,i) + tmp_tend
	219
	220	IF ( large_scale_forcing ) THEN
[4591]	221	sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend &
	222	* weight_substep(intermediate_timestep_count) &
	223	* MERGE( 1.0_wp, 0.0_wp, &
	224	BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1365]	225	ENDIF
[411]	226	ENDDO
[1382]	227
[1862]	228	IF ( large_scale_forcing ) THEN
	229	sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
	230	ENDIF
[1382]	231
[411]	232	ENDDO
	233	ENDDO
	234
	235	!
[4591]	236	!-- Shifting of the initial profile is especially necessary with Rayleigh damping switched on
	237	IF ( scalar_rayleigh_damping .AND. intermediate_timestep_count == 1 ) THEN
[1380]	238	DO k = nzb, nzt
	239	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
[4591]	240	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
	241	( var_init(k+1) - var_init(k) ) * ddzu(k+1)
[1380]	242	ENDIF
	243	ENDDO
[411]	244	!
[4591]	245	!-- At the upper boundary, the initial profile is shifted with aid of the gradient tmp_grad.
	246	!-- (This is ok if the gradients are linear.)
[1380]	247	IF ( w_subs(nzt) < 0.0_wp ) THEN
	248	tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
[4591]	249	var_mod(nzt+1) = var_init(nzt+1) - dt_3d * w_subs(nzt+1) * tmp_grad
[1380]	250	ENDIF
[411]	251
[4591]	252
[1380]	253	DO k = nzt+1, nzb+1, -1
	254	IF ( w_subs(k) >= 0.0_wp ) THEN ! large-scale ascent
[4591]	255	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
	256	( var_init(k) - var_init(k-1) ) * ddzu(k)
[1380]	257	ENDIF
	258	ENDDO
	259	!
[4591]	260	!-- At the lower boundary shifting is not necessary because the subsidence velocity w_subs(nzb)
	261	!-- vanishes.
[1380]	262	IF ( w_subs(nzb+1) >= 0.0_wp ) THEN
	263	var_mod(nzb) = var_init(nzb)
[411]	264	ENDIF
[1380]	265
	266	var_init = var_mod
[411]	267	ENDIF
	268
	269
	270	END SUBROUTINE subsidence
	271
[4591]	272	!--------------------------------------------------------------------------------------------------!
[1682]	273	! Description:
	274	! ------------
[3554]	275	!> Add effect of large-scale subsidence to variable.
[4591]	276	!--------------------------------------------------------------------------------------------------!
	277	SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index )
[411]	278
[4591]	279	USE arrays_3d, &
	280	ONLY: ddzu, &
	281	w_subs
[411]	282
[4591]	283	USE control_parameters, &
	284	ONLY: dt_3d, &
	285	intermediate_timestep_count, &
	286	large_scale_forcing, &
[1380]	287	scalar_rayleigh_damping
[1320]	288
[4591]	289	USE indices, &
	290	ONLY: nxl, &
	291	nxlg, &
	292	nxrg, &
	293	nyng, &
	294	nys, &
	295	nysg, &
	296	nzb, &
	297	nzt, &
[4346]	298	wall_flags_total_0
[1320]	299
	300	USE kinds
	301
[4591]	302	USE statistics, &
	303	ONLY: sums_ls_l, &
	304	weight_substep
[1365]	305
[411]	306	IMPLICIT NONE
	307
[4591]	308	INTEGER(iwp) :: i !< loop variable
	309	INTEGER(iwp) :: j !< loop variable
	310	INTEGER(iwp) :: k !< loop variable
	311	INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l
[411]	312
[4591]	313	REAL(wp) :: tmp_tend !< temporary tendency
	314	REAL(wp) :: tmp_grad !< temporary gradient
	315
	316	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence
	317	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var
	318	REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var
	319	REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var
	320
[464]	321	var_mod = var_init
[411]	322
	323	!
	324	!-- Influence of w_subsidence on the current tendency term
[4591]	325	DO k = nzb+1, nzt
[1365]	326	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
[4591]	327	tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1) &
	328	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1365]	329	ELSE ! large-scale ascent
[4591]	330	tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) &
	331	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[411]	332	ENDIF
[1365]	333
	334	tendency(k,j,i) = tendency(k,j,i) + tmp_tend
	335
	336	IF ( large_scale_forcing ) THEN
[4591]	337	sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend &
	338	* weight_substep(intermediate_timestep_count) &
	339	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1365]	340	ENDIF
[411]	341	ENDDO
	342
[1489]	343	IF ( large_scale_forcing ) THEN
	344	sums_ls_l(nzt+1,ls_index) = sums_ls_l(nzt,ls_index)
	345	ENDIF
[411]	346
	347	!
[4591]	348	!-- Shifting of the initial profile is especially necessary with Rayleigh damping switched on
	349	IF ( scalar_rayleigh_damping .AND. intermediate_timestep_count == 1 ) THEN
	350	IF ( i == nxl .AND. j == nys ) THEN ! shifting only once per PE
[411]	351
[1380]	352	DO k = nzb, nzt
	353	IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence
[4591]	354	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
	355	( var_init(k+1) - var_init(k) ) * ddzu(k+1)
[1380]	356	ENDIF
	357	ENDDO
	358	!
[4591]	359	!-- At the upper boundary, the initial profile is shifted with aid of the gradient
	360	!-- tmp_grad. (This is ok if the gradients are linear.)
[1380]	361	IF ( w_subs(nzt) < 0.0_wp ) THEN
	362	tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1)
[4591]	363	var_mod(nzt+1) = var_init(nzt+1) - dt_3d * w_subs(nzt+1) * tmp_grad
[411]	364	ENDIF
	365
[4591]	366
[1380]	367	DO k = nzt+1, nzb+1, -1
	368	IF ( w_subs(k) >= 0.0_wp ) THEN ! large-scale ascent
[4591]	369	var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &
	370	( var_init(k) - var_init(k-1) ) * ddzu(k)
[1380]	371	ENDIF
	372	ENDDO
	373	!
[4591]	374	!-- At the lower boundary shifting is not necessary because the subsidence velocity
	375	!-- w_subs(nzb) vanishes.
[1380]	376	IF ( w_subs(nzb+1) >= 0.0_wp ) THEN
	377	var_mod(nzb) = var_init(nzb)
[411]	378	ENDIF
	379
[4591]	380	var_init = var_mod
[411]	381
[1380]	382	ENDIF
[411]	383	ENDIF
	384
	385	END SUBROUTINE subsidence_ij
	386
	387
	388	END MODULE subsidence_mod

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

Context Navigation

source: palm/trunk/SOURCE/subsidence_mod.f90 @ 4867

Download in other formats: