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

Last change on this file since 2000 was 2000, checked in by knoop, 5 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.