Home

Context Navigation

source: palm/trunk/SOURCE/ls_forcing.f90 @ 1373

Last change on this file since 1373 was 1366, checked in by boeske, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 19.8 KB

Rev	Line
[1239]	1	MODULE ls_forcing_mod
	2
	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
[1239]	18	!--------------------------------------------------------------------------------!
	19	!
	20	! Current revisions:
	21	! ------------------
[1366]	22	!
	23	!
	24	! Former revisions:
	25	! -----------------
	26	! $Id: ls_forcing.f90 1366 2014-04-22 15:06:33Z raasch $
	27	!
	28	! 1365 2014-04-22 15:03:56Z boeske
[1365]	29	! Usage of large scale forcing for pt and q enabled:
	30	! Added new subroutine ls_advec for horizontal large scale advection and large
	31	! scale subsidence,
	32	! error message in init_ls_forcing specified,
	33	! variable t renamed nt
[1354]	34	!
	35	! 1353 2014-04-08 15:21:23Z heinze
	36	! REAL constants provided with KIND-attribute
	37	!
[1321]	38	! 1320 2014-03-20 08:40:49Z raasch
[1320]	39	! ONLY-attribute added to USE-statements,
	40	! kind-parameters added to all INTEGER and REAL declaration statements,
	41	! kinds are defined in new module kinds,
	42	! comment fields (!:) to be used for variable explanations added to
	43	! all variable declaration statements
[1239]	44	!
[1319]	45	! 1318 2014-03-17 13:35:16Z raasch
	46	! module interfaces removed
	47	!
[1300]	48	! 1299 2014-03-06 13:15:21Z heinze
	49	! Ensure a zero large scale vertical velocity at the surface
	50	! Bugfix: typo in case of boundary condition in if-clause
	51	!
[1277]	52	! 1276 2014-01-15 13:40:41Z heinze
	53	! Use LSF_DATA also in case of Dirichlet bottom boundary condition for scalars
	54	!
[1250]	55	! 1249 2013-11-06 10:45:47Z heinze
	56	! remove call of user module
	57	! reformatting
	58	!
[1242]	59	! 1241 2013-10-30 11:36:58Z heinze
	60	! Initial revision
[1239]	61	!
	62	! Description:
	63	! ------------
	64	! Calculates large scale forcings (geostrophic wind and subsidence velocity) as
[1299]	65	! well as surfaces fluxes dependent on time given in an external file (LSF_DATA).
[1239]	66	! Code is based in parts on DALES and UCLA-LES.
	67	!--------------------------------------------------------------------------------!
	68
	69	PRIVATE
[1365]	70	PUBLIC init_ls_forcing, ls_forcing_surf, ls_forcing_vert, ls_advec
[1239]	71	SAVE
	72
[1365]	73	INTERFACE ls_advec
	74	MODULE PROCEDURE ls_advec
	75	MODULE PROCEDURE ls_advec_ij
	76	END INTERFACE ls_advec
[1239]	77
	78	CONTAINS
	79
	80	SUBROUTINE init_ls_forcing
	81
[1320]	82	USE arrays_3d, &
[1365]	83	ONLY: p_surf, pt_lsa, pt_subs, pt_surf, q_lsa, q_subs, q_surf, &
	84	qsws_surf, shf_surf, time_surf, time_vert, ug_vert, vg_vert, &
	85	wsubs_vert, zu
[1239]	86
[1320]	87	USE control_parameters, &
	88	ONLY: end_time, lsf_surf, lsf_vert, message_string, nlsf
	89
	90	USE indices, &
[1365]	91	ONLY: ngp_sums_ls, nzb, nz, nzt
[1320]	92
	93	USE kinds
	94
[1365]	95	USE statistics, &
	96	ONLY: sums_ls_l
[1320]	97
[1365]	98
[1239]	99	IMPLICIT NONE
	100
[1365]	101	CHARACTER(100) :: chmess !:
	102	CHARACTER(1) :: hash !:
[1239]	103
[1365]	104	INTEGER(iwp) :: ierrn !:
	105	INTEGER(iwp) :: finput = 90 !:
	106	INTEGER(iwp) :: k !:
	107	INTEGER(iwp) :: nt !:
[1320]	108
[1365]	109	REAL(wp) :: fac !:
	110	REAL(wp) :: highheight !:
	111	REAL(wp) :: highug_vert !:
	112	REAL(wp) :: highvg_vert !:
	113	REAL(wp) :: highwsubs_vert !:
	114	REAL(wp) :: lowheight !:
	115	REAL(wp) :: lowug_vert !:
	116	REAL(wp) :: lowvg_vert !:
	117	REAL(wp) :: lowwsubs_vert !:
	118	REAL(wp) :: highpt_lsa !:
	119	REAL(wp) :: lowpt_lsa !:
	120	REAL(wp) :: highq_lsa !:
	121	REAL(wp) :: lowq_lsa !:
	122	REAL(wp) :: highpt_subs !:
	123	REAL(wp) :: lowpt_subs !:
	124	REAL(wp) :: highq_subs !:
	125	REAL(wp) :: lowq_subs !:
	126	REAL(wp) :: r_dummy !:
[1320]	127
[1365]	128	ALLOCATE( p_surf(0:nlsf), pt_lsa(nzb:nzt+1,0:nlsf), &
	129	pt_subs(nzb:nzt+1,0:nlsf), pt_surf(0:nlsf), &
	130	q_lsa(nzb:nzt+1,0:nlsf), q_subs(nzb:nzt+1,0:nlsf), &
	131	q_surf(0:nlsf), qsws_surf(0:nlsf), shf_surf(0:nlsf), &
	132	time_vert(0:nlsf), time_surf(0:nlsf), &
	133	ug_vert(nzb:nzt+1,0:nlsf), vg_vert(nzb:nzt+1,0:nlsf), &
	134	wsubs_vert(nzb:nzt+1,0:nlsf) )
[1239]	135
[1365]	136	p_surf = 0.0_wp; pt_lsa = 0.0; pt_subs = 0.0; pt_surf = 0.0_wp
	137	q_lsa = 0.0; q_subs = 0.0; q_surf = 0.0_wp; qsws_surf = 0.0_wp
	138	shf_surf = 0.0_wp; time_vert = 0.0_wp; time_surf = 0.0_wp;
	139	ug_vert = 0.0_wp; vg_vert = 0.0_wp; wsubs_vert = 0.0_wp
[1239]	140
[1365]	141	!
	142	!-- Array for storing large scale forcing and nudging tendencies at each
	143	!-- timestep for data output
	144	ALLOCATE( sums_ls_l(nzb:nzt+1,0:7) )
	145	sums_ls_l = 0.0_wp
[1239]	146
[1365]	147	ngp_sums_ls = (nz+2)*6
	148
[1249]	149	OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', &
	150	FORM='FORMATTED', IOSTAT=ierrn )
[1239]	151
[1249]	152	IF ( ierrn /= 0 ) THEN
[1239]	153	message_string = 'file LSF_DATA does not exist'
	154	CALL message( 'ls_forcing', 'PA0368', 1, 2, 0, 6, 0 )
	155	ENDIF
	156
	157	ierrn = 0
	158	!
	159	!-- First three lines of LSF_DATA contain header
[1249]	160	READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
	161	READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
	162	READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
[1239]	163
[1249]	164	IF ( ierrn /= 0 ) THEN
[1239]	165	message_string = 'errors in file LSF_DATA'
	166	CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
	167	ENDIF
	168
	169	!
	170	!-- Surface values are read in
[1365]	171	nt = 0
[1239]	172	ierrn = 0
	173
[1365]	174	DO WHILE ( time_surf(nt) < end_time )
	175	nt = nt + 1
	176	READ ( finput, *, IOSTAT = ierrn ) time_surf(nt), shf_surf(nt), &
	177	qsws_surf(nt), pt_surf(nt), &
	178	q_surf(nt), p_surf(nt)
[1239]	179
[1249]	180	IF ( ierrn < 0 ) THEN
[1299]	181	WRITE ( message_string, * ) 'No time dependent surface variables ',&
[1239]	182	'in&LSF_DATA for end of run found'
	183
	184	CALL message( 'ls_forcing', 'PA0370', 1, 2, 0, 6, 0 )
	185	ENDIF
	186	ENDDO
	187
	188
[1249]	189	IF ( time_surf(1) > end_time ) THEN
[1299]	190	WRITE ( message_string, * ) 'No time dependent surface variables in ',&
[1365]	191	'&LSF_DATA for end of run found - ', &
[1239]	192	'lsf_surf is set to FALSE'
	193	CALL message( 'ls_forcing', 'PA0371', 0, 0, 0, 6, 0 )
	194	lsf_surf = .FALSE.
	195	ENDIF
	196
	197	!
	198	!-- Go to the end of the list with surface variables
	199	DO WHILE ( ierrn == 0 )
[1249]	200	READ ( finput, *, IOSTAT = ierrn ) r_dummy
[1239]	201	ENDDO
	202
	203	!
	204	!-- Profiles of ug, vg and w_subs are read in (large scale forcing)
	205
[1365]	206	nt = 0
	207	DO WHILE ( time_vert(nt) < end_time )
	208	nt = nt + 1
[1239]	209	hash = "#"
	210	ierrn = 1 ! not zero
	211	!
	212	!-- Search for the next line consisting of "# time",
	213	!-- from there onwards the profiles will be read
	214	DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) )
[1365]	215	READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(nt)
[1249]	216	IF ( ierrn < 0 ) THEN
[1299]	217	WRITE( message_string, * ) 'No time dependent vertical profiles',&
[1239]	218	' in&LSF_DATA for end of run found'
	219	CALL message( 'ls_forcing', 'PA0372', 1, 2, 0, 6, 0 )
	220	ENDIF
	221	ENDDO
	222
[1365]	223	IF ( nt == 1 .AND. time_vert(nt) > end_time ) EXIT
[1239]	224
[1365]	225	READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, &
	226	lowwsubs_vert, lowpt_lsa, &
	227	lowq_lsa, lowpt_subs, lowq_subs
[1249]	228	IF ( ierrn /= 0 ) THEN
[1239]	229	message_string = 'errors in file LSF_DATA'
[1299]	230	CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
[1239]	231	ENDIF
	232
[1365]	233	READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, &
	234	highvg_vert, highwsubs_vert, &
	235	highpt_lsa, highq_lsa, &
	236	highpt_subs, highq_subs
[1239]	237
[1249]	238	IF ( ierrn /= 0 ) THEN
[1239]	239	message_string = 'errors in file LSF_DATA'
[1299]	240	CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
[1239]	241	ENDIF
	242
[1241]	243
[1239]	244	DO k = nzb, nzt+1
[1249]	245	IF ( highheight < zu(k) ) THEN
[1239]	246	lowheight = highheight
	247	lowug_vert = highug_vert
	248	lowvg_vert = highvg_vert
	249	lowwsubs_vert = highwsubs_vert
[1365]	250	lowpt_lsa = highpt_lsa
	251	lowq_lsa = highq_lsa
	252	lowpt_subs = highpt_subs
	253	lowq_subs = highq_subs
[1239]	254
	255	ierrn = 0
[1365]	256	READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, &
	257	highvg_vert, highwsubs_vert, &
	258	highpt_lsa, highq_lsa, &
	259	highpt_subs, highq_subs
[1239]	260
[1249]	261	IF ( ierrn /= 0 ) THEN
[1365]	262	WRITE( message_string, * ) 'zu(nzt+1) = ', zu(nzt+1), 'm ', &
	263	'is higher than the maximum height in LSF_DATA which ',&
	264	'is ', lowheight, 'm. Interpolation on PALM ', &
	265	'grid is not possible.'
	266	CALL message( 'ls_forcing', 'PA0395', 1, 2, 0, 6, 0 )
[1239]	267	ENDIF
	268
	269	ENDIF
	270
	271	!
	272	!-- Interpolation of prescribed profiles in space
	273	fac = (highheight-zu(k))/(highheight - lowheight)
	274
[1365]	275	ug_vert(k,nt) = faclowug_vert + (1.0_wp-fac)highug_vert
	276	vg_vert(k,nt) = faclowvg_vert + (1.0_wp-fac)highvg_vert
	277	wsubs_vert(k,nt) = faclowwsubs_vert + (1.0_wp-fac)highwsubs_vert
[1239]	278
[1365]	279	pt_lsa(k,nt) = faclowpt_lsa + (1.0_wp-fac)highpt_lsa
	280	q_lsa(k,nt) = faclowq_lsa + (1.0_wp-fac)highq_lsa
	281	pt_subs(k,nt) = faclowpt_subs + (1.0_wp-fac)highpt_subs
	282	q_subs(k,nt) = faclowq_subs + (1.0_wp-fac)highq_subs
	283
[1239]	284	ENDDO
	285
	286	ENDDO
	287
[1299]	288	!
	289	!-- Large scale vertical velocity has to be zero at the surface
[1353]	290	wsubs_vert(nzb,:) = 0.0_wp
[1299]	291
[1249]	292	IF ( time_vert(1) > end_time ) THEN
[1365]	293	WRITE ( message_string, * ) 'Time dependent large scale profile ', &
	294	'forcing from&LSF_DATA sets in after end of ' , &
[1249]	295	'simulation - lsf_vert is set to FALSE'
[1239]	296	CALL message( 'ls_forcing', 'PA0373', 0, 0, 0, 6, 0 )
	297	lsf_vert = .FALSE.
	298	ENDIF
	299
	300	CLOSE( finput )
	301
	302
	303	END SUBROUTINE init_ls_forcing
	304
	305
	306	SUBROUTINE ls_forcing_surf ( time )
	307
[1320]	308	USE arrays_3d, &
	309	ONLY: p_surf, pt_surf, q_surf, qsws, qsws_surf, shf, shf_surf, &
	310	time_surf, time_vert, ug, ug_vert, vg, vg_vert
[1239]	311
[1320]	312	USE control_parameters, &
	313	ONLY: bc_q_b, ibc_pt_b, ibc_q_b, pt_surface, q_surface, &
	314	surface_pressure
	315
	316	USE kinds
	317
[1239]	318	IMPLICIT NONE
	319
[1365]	320	INTEGER(iwp) :: nt !:
[1239]	321
[1320]	322	REAL(wp) :: fac !:
	323	REAL(wp), INTENT(in) :: time !:
	324
[1239]	325	!
	326	!-- Interpolation in time of LSF_DATA at the surface
[1365]	327	nt = 1
	328	DO WHILE ( time > time_surf(nt) )
	329	nt = nt + 1
[1239]	330	ENDDO
[1365]	331	IF ( time /= time_surf(nt) ) THEN
	332	nt = nt - 1
[1239]	333	ENDIF
	334
[1365]	335	fac = ( time -time_surf(nt) ) / ( time_surf(nt+1) - time_surf(nt) )
[1239]	336
[1276]	337	IF ( ibc_pt_b == 0 ) THEN
	338	!
	339	!-- In case of Dirichlet boundary condition shf must not
	340	!-- be set - it is calculated via MOST in prandtl_fluxes
[1365]	341	pt_surface = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
[1276]	342
	343	ELSEIF ( ibc_pt_b == 1 ) THEN
	344	!
	345	!-- In case of Neumann boundary condition pt_surface is needed for
	346	!-- calculation of reference density
[1365]	347	shf = shf_surf(nt) + fac * ( shf_surf(nt+1) - shf_surf(nt) )
	348	pt_surface = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
[1276]	349
	350	ENDIF
	351
	352	IF ( ibc_q_b == 0 ) THEN
	353	!
	354	!-- In case of Dirichlet boundary condition qsws must not
	355	!-- be set - it is calculated via MOST in prandtl_fluxes
[1365]	356	q_surface = q_surf(nt) + fac * ( q_surf(nt+1) - q_surf(nt) )
[1276]	357
[1299]	358	ELSEIF ( ibc_q_b == 1 ) THEN
[1276]	359
[1365]	360	qsws = qsws_surf(nt) + fac * ( qsws_surf(nt+1) - qsws_surf(nt) )
[1276]	361
	362	ENDIF
	363
[1365]	364	surface_pressure = p_surf(nt) + fac * ( p_surf(nt+1) - p_surf(nt) )
[1239]	365
	366	END SUBROUTINE ls_forcing_surf
	367
	368
	369	SUBROUTINE ls_forcing_vert ( time )
	370
[1320]	371	USE arrays_3d, &
	372	ONLY: time_vert, ug, ug_vert, vg, vg_vert, w_subs, wsubs_vert
[1239]	373
[1320]	374	USE control_parameters, &
	375	ONLY: large_scale_subsidence
	376
	377	USE kinds
	378
[1239]	379	IMPLICIT NONE
	380
[1365]	381	INTEGER(iwp) :: nt !:
[1239]	382
[1320]	383	REAL(wp) :: fac !:
	384	REAL(wp), INTENT(in) :: time !:
	385
[1239]	386	!
	387	!-- Interpolation in time of LSF_DATA for ug, vg and w_subs
[1365]	388	nt = 1
	389	DO WHILE ( time > time_vert(nt) )
	390	nt = nt + 1
[1239]	391	ENDDO
[1365]	392	IF ( time /= time_vert(nt) ) THEN
	393	nt = nt - 1
[1239]	394	ENDIF
	395
[1365]	396	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
[1239]	397
[1365]	398	ug = ug_vert(:,nt) + fac * ( ug_vert(:,nt+1) - ug_vert(:,nt) )
	399	vg = vg_vert(:,nt) + fac * ( vg_vert(:,nt+1) - vg_vert(:,nt) )
[1239]	400
[1249]	401	IF ( large_scale_subsidence ) THEN
[1365]	402	w_subs = wsubs_vert(:,nt) &
	403	+ fac * ( wsubs_vert(:,nt+1) - wsubs_vert(:,nt) )
[1239]	404	ENDIF
	405
	406	END SUBROUTINE ls_forcing_vert
	407
	408
[1365]	409	!------------------------------------------------------------------------------!
	410	! Call for all grid points
	411	!------------------------------------------------------------------------------!
	412	SUBROUTINE ls_advec ( time, prog_var )
	413
	414	USE arrays_3d, &
	415	ONLY: pt_lsa, pt_subs, q_lsa, q_subs, tend, time_vert
	416
	417	USE control_parameters, &
	418	ONLY: large_scale_subsidence, use_subsidence_tendencies
	419
	420	USE indices
	421
	422	USE kinds
	423
	424	IMPLICIT NONE
	425
	426	CHARACTER (LEN=*) :: prog_var !:
	427
	428	REAL(wp), INTENT(in) :: time !:
	429	REAL(wp) :: fac !:
	430
	431	INTEGER(iwp) :: i !:
	432	INTEGER(iwp) :: j !:
	433	INTEGER(iwp) :: k !:
	434	INTEGER(iwp) :: nt !:
	435
	436	!
	437	!-- Interpolation in time of LSF_DATA
	438	nt = 1
	439	DO WHILE ( time > time_vert(nt) )
	440	nt = nt + 1
	441	ENDDO
	442	IF ( time /= time_vert(nt) ) THEN
	443	nt = nt - 1
	444	ENDIF
	445
	446	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
	447
	448	!
	449	!-- Add horizontal large scale advection tendencies of pt and q
	450	SELECT CASE ( prog_var )
	451
	452	CASE ( 'pt' )
	453
	454	DO i = nxl, nxr
	455	DO j = nys, nyn
	456	DO k = nzb_u_inner(j,i)+1, nzt
	457	tend(k,j,i) = tend(k,j,i) + pt_lsa(k,nt) &
	458	+ fac * ( pt_lsa(k,nt+1) - pt_lsa(k,nt) )
	459	ENDDO
	460	ENDDO
	461	ENDDO
	462
	463	CASE ( 'q' )
	464
	465	DO i = nxl, nxr
	466	DO j = nys, nyn
	467	DO k = nzb_u_inner(j,i)+1, nzt
	468	tend(k,j,i) = tend(k,j,i) + q_lsa(k,nt) &
	469	+ fac * ( q_lsa(k,nt+1) - q_lsa(k,nt) )
	470	ENDDO
	471	ENDDO
	472	ENDDO
	473
	474	END SELECT
	475
	476	!
	477	!-- Subsidence of pt and q with prescribed subsidence tendencies
	478	IF ( large_scale_subsidence .AND. use_subsidence_tendencies ) THEN
	479
	480	SELECT CASE ( prog_var )
	481
	482	CASE ( 'pt' )
	483
	484	DO i = nxl, nxr
	485	DO j = nys, nyn
	486	DO k = nzb_u_inner(j,i)+1, nzt
	487	tend(k,j,i) = tend(k,j,i) + pt_subs(k,nt) + fac * &
	488	( pt_subs(k,nt+1) - pt_subs(k,nt) )
	489	ENDDO
	490	ENDDO
	491	ENDDO
	492
	493	CASE ( 'q' )
	494
	495	DO i = nxl, nxr
	496	DO j = nys, nyn
	497	DO k = nzb_u_inner(j,i)+1, nzt
	498	tend(k,j,i) = tend(k,j,i) + q_subs(k,nt) + fac * &
	499	( q_subs(k,nt+1) - q_subs(k,nt) )
	500	ENDDO
	501	ENDDO
	502	ENDDO
	503
	504	END SELECT
	505
	506	ENDIF
	507
	508	END SUBROUTINE ls_advec
	509
	510
	511	!------------------------------------------------------------------------------!
	512	! Call for grid point i,j
	513	!------------------------------------------------------------------------------!
	514	SUBROUTINE ls_advec_ij ( i, j, time, prog_var )
	515
	516	USE arrays_3d, &
	517	ONLY: pt_lsa, pt_subs, q_lsa, q_subs, tend, time_vert
	518
	519	USE control_parameters, &
	520	ONLY: large_scale_subsidence, use_subsidence_tendencies
	521
	522	USE indices
	523
	524	USE kinds
	525
	526	IMPLICIT NONE
	527
	528	CHARACTER (LEN=*) :: prog_var !:
	529
	530	REAL(wp), INTENT(in) :: time !:
	531	REAL(wp) :: fac !:
	532
	533	INTEGER(iwp) :: i !:
	534	INTEGER(iwp) :: j !:
	535	INTEGER(iwp) :: k !:
	536	INTEGER(iwp) :: nt !:
	537
	538	!
	539	!-- Interpolation in time of LSF_DATA
	540	nt = 1
	541	DO WHILE ( time > time_vert(nt) )
	542	nt = nt + 1
	543	ENDDO
	544	IF ( time /= time_vert(nt) ) THEN
	545	nt = nt - 1
	546	ENDIF
	547
	548	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
	549
	550	!
	551	!-- Add horizontal large scale advection tendencies of pt and q
	552	SELECT CASE ( prog_var )
	553
	554	CASE ( 'pt' )
	555
	556	DO k = nzb_u_inner(j,i)+1, nzt
	557	tend(k,j,i) = tend(k,j,i) + pt_lsa(k,nt) &
	558	+ fac * ( pt_lsa(k,nt+1) - pt_lsa(k,nt) )
	559	ENDDO
	560
	561	CASE ( 'q' )
	562
	563	DO k = nzb_u_inner(j,i)+1, nzt
	564	tend(k,j,i) = tend(k,j,i) + q_lsa(k,nt) &
	565	+ fac * ( q_lsa(k,nt+1) - q_lsa(k,nt) )
	566	ENDDO
	567
	568	END SELECT
	569
	570	!
	571	!-- Subsidence of pt and q with prescribed profiles
	572	IF ( large_scale_subsidence .AND. use_subsidence_tendencies ) THEN
	573
	574	SELECT CASE ( prog_var )
	575
	576	CASE ( 'pt' )
	577
	578	DO k = nzb_u_inner(j,i)+1, nzt
	579	tend(k,j,i) = tend(k,j,i) + pt_subs(k,nt) + fac * &
	580	( pt_subs(k,nt+1) - pt_subs(k,nt) )
	581	ENDDO
	582
	583	CASE ( 'q' )
	584
	585	DO k = nzb_u_inner(j,i)+1, nzt
	586	tend(k,j,i) = tend(k,j,i) + q_subs(k,nt) + fac * &
	587	( q_subs(k,nt+1) - q_subs(k,nt) )
	588	ENDDO
	589
	590	END SELECT
	591
	592	ENDIF
	593
	594	END SUBROUTINE ls_advec_ij
	595
	596
[1239]	597	END MODULE ls_forcing_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |