Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |