Home

Context Navigation

source: palm/trunk/SOURCE/ls_forcing_mod.f90 @ 2065

Last change on this file since 2065 was 2038, checked in by knoop, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 22.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |