Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |