Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |