source: palm/trunk/SOURCE/prognostic_equations.f90 @ 30

Last change on this file since 30 was 19, checked in by raasch, 18 years ago

preliminary version of modified boundary conditions at top

  • Property svn:keywords set to Id
File size: 53.5 KB
Line 
1 MODULE prognostic_equations_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Calculation of e, q, and pt extended for gridpoint nzt,
7! handling of given temperature/humidity/scalar fluxes at top surface
8!
9! Former revisions:
10! -----------------
11! $Id: prognostic_equations.f90 19 2007-02-23 04:53:48Z raasch $
12! RCS Log replace by Id keyword, revision history cleaned up
13!
14! Revision 1.21  2006/08/04 15:01:07  raasch
15! upstream scheme can be forced to be used for tke (use_upstream_for_tke)
16! regardless of the timestep scheme used for the other quantities,
17! new argument diss in call of diffusion_e
18!
19! Revision 1.1  2000/04/13 14:56:27  schroeter
20! Initial revision
21!
22!
23! Description:
24! ------------
25! Solving the prognostic equations.
26!------------------------------------------------------------------------------!
27
28    USE arrays_3d
29    USE control_parameters
30    USE cpulog
31    USE grid_variables
32    USE indices
33    USE interfaces
34    USE pegrid
35    USE pointer_interfaces
36    USE statistics
37
38    USE advec_s_pw_mod
39    USE advec_s_up_mod
40    USE advec_u_pw_mod
41    USE advec_u_up_mod
42    USE advec_v_pw_mod
43    USE advec_v_up_mod
44    USE advec_w_pw_mod
45    USE advec_w_up_mod
46    USE buoyancy_mod
47    USE calc_precipitation_mod
48    USE calc_radiation_mod
49    USE coriolis_mod
50    USE diffusion_e_mod
51    USE diffusion_s_mod
52    USE diffusion_u_mod
53    USE diffusion_v_mod
54    USE diffusion_w_mod
55    USE impact_of_latent_heat_mod
56    USE production_e_mod
57    USE user_actions_mod
58
59
60    PRIVATE
61    PUBLIC prognostic_equations, prognostic_equations_fast, &
62           prognostic_equations_vec
63
64    INTERFACE prognostic_equations
65       MODULE PROCEDURE prognostic_equations
66    END INTERFACE prognostic_equations
67
68    INTERFACE prognostic_equations_fast
69       MODULE PROCEDURE prognostic_equations_fast
70    END INTERFACE prognostic_equations_fast
71
72    INTERFACE prognostic_equations_vec
73       MODULE PROCEDURE prognostic_equations_vec
74    END INTERFACE prognostic_equations_vec
75
76
77 CONTAINS
78
79
80 SUBROUTINE prognostic_equations
81
82!------------------------------------------------------------------------------!
83! Version with single loop optimization
84!
85! (Optimized over each single prognostic equation.)
86!------------------------------------------------------------------------------!
87
88    IMPLICIT NONE
89
90    CHARACTER (LEN=9) ::  time_to_string
91    INTEGER ::  i, j, k
92    REAL    ::  sat, sbt
93
94!
95!-- Calculate those variables needed in the tendency terms which need
96!-- global communication
97    CALL calc_mean_pt_profile( pt, 4 )
98    IF ( moisture )  CALL calc_mean_pt_profile( vpt, 44 )
99
100!
101!-- u-velocity component
102    CALL cpu_log( log_point(5), 'u-equation', 'start' )
103
104!
105!-- u-tendency terms with communication
106    IF ( momentum_advec == 'ups-scheme' )  THEN
107       tend = 0.0
108       CALL advec_u_ups
109    ENDIF
110
111!
112!-- u-tendency terms with no communication
113    DO  i = nxl, nxr+uxrp
114       DO  j = nys, nyn
115!
116!--       Tendency terms
117          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
118             tend(:,j,i) = 0.0
119             CALL advec_u_pw( i, j )
120          ELSE
121             IF ( momentum_advec /= 'ups-scheme' )  THEN
122                tend(:,j,i) = 0.0
123                CALL advec_u_up( i, j )
124             ENDIF
125          ENDIF
126          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
127             CALL diffusion_u( i, j, ddzu, ddzw, km_m, km_damp_y, tend, u_m,   &
128                               usws_m, v_m, w_m, z0 )
129          ELSE
130             CALL diffusion_u( i, j, ddzu, ddzw, km, km_damp_y, tend, u, usws, &
131                               v, w, z0 )
132          ENDIF
133          CALL coriolis( i, j, 1 )
134          IF ( sloping_surface )  CALL buoyancy( i, j, pt, 1, 4 )
135          CALL user_actions( i, j, 'u-tendency' )
136
137!
138!--       Prognostic equation for u-velocity component
139          DO  k = nzb_u_inner(j,i)+1, nzt
140             u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) +    &
141                          dt_3d * (                                            &
142                                   tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
143                                 - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx    &
144                                  ) -                                          &
145                           tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
146          ENDDO
147
148!
149!--       Calculate tendencies for the next Runge-Kutta step
150          IF ( timestep_scheme(1:5) == 'runge' )  THEN
151             IF ( intermediate_timestep_count == 1 )  THEN
152                DO  k = nzb_u_inner(j,i)+1, nzt
153                   tu_m(k,j,i) = tend(k,j,i)
154                ENDDO
155             ELSEIF ( intermediate_timestep_count < &
156                      intermediate_timestep_count_max )  THEN
157                DO  k = nzb_u_inner(j,i)+1, nzt
158                   tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
159                ENDDO
160             ENDIF
161          ENDIF
162
163       ENDDO
164    ENDDO
165
166    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
167
168!
169!-- v-velocity component
170    CALL cpu_log( log_point(6), 'v-equation', 'start' )
171
172!
173!-- v-tendency terms with communication
174    IF ( momentum_advec == 'ups-scheme' )  THEN
175       tend = 0.0
176       CALL advec_v_ups
177    ENDIF
178
179!
180!-- v-tendency terms with no communication
181    DO  i = nxl, nxr
182       DO  j = nys, nyn+vynp
183!
184!--       Tendency terms
185          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
186             tend(:,j,i) = 0.0
187             CALL advec_v_pw( i, j )
188          ELSE
189             IF ( momentum_advec /= 'ups-scheme' )  THEN
190                tend(:,j,i) = 0.0
191                CALL advec_v_up( i, j )
192             ENDIF
193          ENDIF
194          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
195             CALL diffusion_v( i, j, ddzu, ddzw, km_m, km_damp_x, tend, u_m, &
196                               v_m, vsws_m, w_m, z0 )
197          ELSE
198             CALL diffusion_v( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v,  &
199                               vsws, w, z0 )
200          ENDIF
201          CALL coriolis( i, j, 2 )
202          CALL user_actions( i, j, 'v-tendency' )
203
204!
205!--       Prognostic equation for v-velocity component
206          DO  k = nzb_v_inner(j,i)+1, nzt
207             v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) +    &
208                          dt_3d * (                                            &
209                                   tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
210                                 - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy    &
211                                  ) -                                          &
212                          tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
213          ENDDO
214
215!
216!--       Calculate tendencies for the next Runge-Kutta step
217          IF ( timestep_scheme(1:5) == 'runge' )  THEN
218             IF ( intermediate_timestep_count == 1 )  THEN
219                DO  k = nzb_v_inner(j,i)+1, nzt
220                   tv_m(k,j,i) = tend(k,j,i)
221                ENDDO
222             ELSEIF ( intermediate_timestep_count < &
223                      intermediate_timestep_count_max )  THEN
224                DO  k = nzb_v_inner(j,i)+1, nzt
225                   tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
226                ENDDO
227             ENDIF
228          ENDIF
229
230       ENDDO
231    ENDDO
232
233    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
234
235!
236!-- w-velocity component
237    CALL cpu_log( log_point(7), 'w-equation', 'start' )
238
239!
240!-- w-tendency terms with communication
241    IF ( momentum_advec == 'ups-scheme' )  THEN
242       tend = 0.0
243       CALL advec_w_ups
244    ENDIF
245
246!
247!-- w-tendency terms with no communication
248    DO  i = nxl, nxr
249       DO  j = nys, nyn
250!
251!--       Tendency terms
252          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
253             tend(:,j,i) = 0.0
254             CALL advec_w_pw( i, j )
255          ELSE
256             IF ( momentum_advec /= 'ups-scheme' )  THEN
257                tend(:,j,i) = 0.0
258                CALL advec_w_up( i, j )
259             ENDIF
260          ENDIF
261          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
262             CALL diffusion_w( i, j, ddzu, ddzw, km_m, km_damp_x, km_damp_y,  &
263                               tend, u_m, v_m, w_m, z0 )
264          ELSE
265             CALL diffusion_w( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y,    &
266                               tend, u, v, w, z0 )
267          ENDIF
268          CALL coriolis( i, j, 3 )
269          IF ( .NOT. moisture )  THEN
270             CALL buoyancy( i, j, pt, 3, 4 )
271          ELSE
272             CALL buoyancy( i, j, vpt, 3, 44 )
273          ENDIF
274          CALL user_actions( i, j, 'w-tendency' )
275
276!
277!--       Prognostic equation for w-velocity component
278          DO  k = nzb_w_inner(j,i)+1, nzt-1
279             w_p(k,j,i) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) +    &
280                          dt_3d * (                                            &
281                                   tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
282                              - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
283                                  ) -                                          &
284                          tsc(5) * rdf(k) * w(k,j,i)
285          ENDDO
286
287!
288!--       Calculate tendencies for the next Runge-Kutta step
289          IF ( timestep_scheme(1:5) == 'runge' )  THEN
290             IF ( intermediate_timestep_count == 1 )  THEN
291                DO  k = nzb_w_inner(j,i)+1, nzt-1
292                   tw_m(k,j,i) = tend(k,j,i)
293                ENDDO
294             ELSEIF ( intermediate_timestep_count < &
295                      intermediate_timestep_count_max )  THEN
296                DO  k = nzb_w_inner(j,i)+1, nzt-1
297                   tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
298                ENDDO
299             ENDIF
300          ENDIF
301
302       ENDDO
303    ENDDO
304
305    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
306
307!
308!-- potential temperature
309    CALL cpu_log( log_point(13), 'pt-equation', 'start' )
310
311!
312!-- pt-tendency terms with communication
313    IF ( scalar_advec == 'bc-scheme' )  THEN
314!
315!--    Bott-Chlond scheme always uses Euler time step. Thus:
316       sat = 1.0
317       sbt = 1.0
318       tend = 0.0
319       CALL advec_s_bc( pt, 'pt' )
320    ELSE
321       sat = tsc(1)
322       sbt = tsc(2)
323       IF ( tsc(2) /= 2.0  .AND.  scalar_advec == 'ups-scheme' )  THEN
324          tend = 0.0
325          CALL advec_s_ups( pt, 'pt' )
326       ENDIF
327    ENDIF
328         
329!
330!-- pt-tendency terms with no communication
331    DO  i = nxl, nxr
332       DO  j = nys, nyn
333!
334!--       Tendency terms
335          IF ( scalar_advec == 'bc-scheme' )  THEN
336             CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, tend )
337          ELSE
338             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
339                tend(:,j,i) = 0.0
340                CALL advec_s_pw( i, j, pt )
341             ELSE
342                IF ( scalar_advec /= 'ups-scheme' )  THEN
343                   tend(:,j,i) = 0.0
344                   CALL advec_s_up( i, j, pt )
345                ENDIF
346             ENDIF
347             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
348             THEN
349                CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, &
350                                  tswst_m, tend )
351             ELSE
352                CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, tend )
353             ENDIF
354          ENDIF
355
356!
357!--       If required compute heating/cooling due to long wave radiation
358!--       processes
359          IF ( radiation )  THEN
360             CALL calc_radiation( i, j )
361          ENDIF
362
363!
364!--       If required compute impact of latent heat due to precipitation
365          IF ( precipitation )  THEN
366             CALL impact_of_latent_heat( i, j )
367          ENDIF
368          CALL user_actions( i, j, 'pt-tendency' )
369
370!
371!--       Prognostic equation for potential temperature
372          DO  k = nzb_s_inner(j,i)+1, nzt
373             pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + &
374                           dt_3d * (                                           &
375                                     sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
376                                   ) -                                         &
377                           tsc(5) * rdf(k) * ( pt(k,j,i) - pt_init(k) )
378          ENDDO
379
380!
381!--       Calculate tendencies for the next Runge-Kutta step
382          IF ( timestep_scheme(1:5) == 'runge' )  THEN
383             IF ( intermediate_timestep_count == 1 )  THEN
384                DO  k = nzb_s_inner(j,i)+1, nzt
385                   tpt_m(k,j,i) = tend(k,j,i)
386                ENDDO
387             ELSEIF ( intermediate_timestep_count < &
388                      intermediate_timestep_count_max )  THEN
389                DO  k = nzb_s_inner(j,i)+1, nzt
390                   tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)
391                ENDDO
392             ENDIF
393          ENDIF
394
395       ENDDO
396    ENDDO
397
398    CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
399
400!
401!-- If required, compute prognostic equation for total water content / scalar
402    IF ( moisture  .OR.  passive_scalar )  THEN
403
404       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
405
406!
407!--    Scalar/q-tendency terms with communication
408       IF ( scalar_advec == 'bc-scheme' )  THEN
409!
410!--       Bott-Chlond scheme always uses Euler time step. Thus:
411          sat = 1.0
412          sbt = 1.0
413          tend = 0.0
414          CALL advec_s_bc( q, 'q' )
415       ELSE
416          sat = tsc(1)
417          sbt = tsc(2)
418          IF ( tsc(2) /= 2.0 )  THEN
419             IF ( scalar_advec == 'ups-scheme' )  THEN
420                tend = 0.0
421                CALL advec_s_ups( q, 'q' )
422             ENDIF
423          ENDIF
424       ENDIF
425
426!
427!--    Scalar/q-tendency terms with no communication
428       DO  i = nxl, nxr
429          DO  j = nys, nyn
430!
431!--          Tendency-terms
432             IF ( scalar_advec == 'bc-scheme' )  THEN
433                CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, tend )
434             ELSE
435                IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) THEN
436                   tend(:,j,i) = 0.0
437                   CALL advec_s_pw( i, j, q )
438                ELSE
439                   IF ( scalar_advec /= 'ups-scheme' )  THEN
440                      tend(:,j,i) = 0.0
441                      CALL advec_s_up( i, j, q )
442                   ENDIF
443                ENDIF
444                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
445                THEN
446                   CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, &
447                                     qswst_m, tend )
448                ELSE
449                   CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, &
450                                     tend )
451                ENDIF
452             ENDIF
453       
454!
455!--          If required compute decrease of total water content due to
456!--          precipitation
457             IF ( precipitation )  THEN
458                CALL calc_precipitation( i, j )
459             ENDIF
460             CALL user_actions( i, j, 'q-tendency' )
461
462!
463!--          Prognostic equation for total water content / scalar
464             DO  k = nzb_s_inner(j,i)+1, nzt
465                q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) +       &
466                             dt_3d * (                                         &
467                                      sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
468                                     ) -                                       &
469                             tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
470             ENDDO
471
472!
473!--          Calculate tendencies for the next Runge-Kutta step
474             IF ( timestep_scheme(1:5) == 'runge' )  THEN
475                IF ( intermediate_timestep_count == 1 )  THEN
476                   DO  k = nzb_s_inner(j,i)+1, nzt
477                      tq_m(k,j,i) = tend(k,j,i)
478                   ENDDO
479                ELSEIF ( intermediate_timestep_count < &
480                         intermediate_timestep_count_max )  THEN
481                   DO  k = nzb_s_inner(j,i)+1, nzt
482                      tq_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tq_m(k,j,i)
483                   ENDDO
484                ENDIF
485             ENDIF
486
487          ENDDO
488       ENDDO
489
490       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
491
492    ENDIF
493
494!
495!-- If required, compute prognostic equation for turbulent kinetic
496!-- energy (TKE)
497    IF ( .NOT. constant_diffusion )  THEN
498
499       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
500
501!
502!--    TKE-tendency terms with communication
503       CALL production_e_init
504       IF ( .NOT. use_upstream_for_tke )  THEN
505          IF ( scalar_advec == 'bc-scheme' )  THEN
506!
507!--          Bott-Chlond scheme always uses Euler time step. Thus:
508             sat = 1.0
509             sbt = 1.0
510             tend = 0.0
511             CALL advec_s_bc( e, 'e' )
512          ELSE
513             sat = tsc(1)
514             sbt = tsc(2)
515             IF ( tsc(2) /= 2.0 )  THEN
516                IF ( scalar_advec == 'ups-scheme' )  THEN
517                   tend = 0.0
518                   CALL advec_s_ups( e, 'e' )
519                ENDIF
520             ENDIF
521          ENDIF
522       ENDIF
523
524!
525!--    TKE-tendency terms with no communication
526       DO  i = nxl, nxr
527          DO  j = nys, nyn
528!
529!--          Tendency-terms
530             IF ( scalar_advec == 'bc-scheme'  .AND.  &
531                  .NOT. use_upstream_for_tke )  THEN
532                IF ( .NOT. moisture )  THEN
533                   CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
534                                     l_grid, pt, rif, tend, zu )
535                ELSE
536                   CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
537                                     l_grid, vpt, rif, tend, zu )
538                ENDIF
539             ELSE
540                IF ( use_upstream_for_tke )  THEN
541                   tend(:,j,i) = 0.0
542                   CALL advec_s_up( i, j, e )
543                ELSE
544                   IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
545                   THEN
546                      tend(:,j,i) = 0.0
547                      CALL advec_s_pw( i, j, e )
548                   ELSE
549                      IF ( scalar_advec /= 'ups-scheme' )  THEN
550                         tend(:,j,i) = 0.0
551                         CALL advec_s_up( i, j, e )
552                      ENDIF
553                   ENDIF
554                ENDIF
555                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
556                THEN
557                   IF ( .NOT. moisture )  THEN
558                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
559                                        km_m, l_grid, pt_m, rif_m, tend, zu )
560                   ELSE
561                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
562                                        km_m, l_grid, vpt_m, rif_m, tend, zu )
563                   ENDIF
564                ELSE
565                   IF ( .NOT. moisture )  THEN
566                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
567                                        l_grid, pt, rif, tend, zu )
568                   ELSE
569                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
570                                        l_grid, vpt, rif, tend, zu )
571                   ENDIF
572                ENDIF
573             ENDIF
574             CALL production_e( i, j )
575             CALL user_actions( i, j, 'e-tendency' )
576
577!
578!--          Prognostic equation for TKE.
579!--          Eliminate negative TKE values, which can occur due to numerical
580!--          reasons in the course of the integration. In such cases the old TKE
581!--          value is reduced by 90%.
582             DO  k = nzb_s_inner(j,i)+1, nzt
583                e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * e(k,j,i) +       &
584                             dt_3d * (                                         &
585                                      sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) &
586                                     )
587                IF ( e_p(k,j,i) < 0.0 )  e_p(k,j,i) = 0.1 * e(k,j,i)
588             ENDDO
589
590!
591!--          Calculate tendencies for the next Runge-Kutta step
592             IF ( timestep_scheme(1:5) == 'runge' )  THEN
593                IF ( intermediate_timestep_count == 1 )  THEN
594                   DO  k = nzb_s_inner(j,i)+1, nzt
595                      te_m(k,j,i) = tend(k,j,i)
596                   ENDDO
597                ELSEIF ( intermediate_timestep_count < &
598                         intermediate_timestep_count_max )  THEN
599                   DO  k = nzb_s_inner(j,i)+1, nzt
600                      te_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * te_m(k,j,i)
601                   ENDDO
602                ENDIF
603             ENDIF
604
605          ENDDO
606       ENDDO
607
608       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
609
610    ENDIF
611
612
613 END SUBROUTINE prognostic_equations
614
615
616 SUBROUTINE prognostic_equations_fast
617
618!------------------------------------------------------------------------------!
619! Version with one optimized loop over all equations. It is only allowed to
620! be called for the standard Piascek-Williams advection scheme.
621!
622! The call of this subroutine is embedded in two DO loops over i and j, thus
623! communication between CPUs is not allowed in this subroutine.
624!
625! (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
626!------------------------------------------------------------------------------!
627
628    IMPLICIT NONE
629
630    CHARACTER (LEN=9) ::  time_to_string
631    INTEGER ::  i, j, k
632
633
634!
635!-- Time measurement can only be performed for the whole set of equations
636    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
637
638
639!
640!-- Calculate those variables needed in the tendency terms which need
641!-- global communication
642    CALL calc_mean_pt_profile( pt, 4 )
643    IF ( moisture )  CALL calc_mean_pt_profile( vpt, 44 )
644    IF ( .NOT. constant_diffusion )  CALL production_e_init
645
646
647!
648!-- Loop over all prognostic equations
649!$OMP PARALLEL private (i,j,k)
650!$OMP DO
651    DO  i = nxl, nxr+uxrp       ! Additional levels for non cyclic boundary
652       DO  j = nys, nyn+vynp    ! conditions are included
653!
654!--       Tendency terms for u-velocity component
655          IF ( j < nyn+1 )  THEN
656
657             tend(:,j,i) = 0.0
658             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
659                CALL advec_u_pw( i, j )
660             ELSE
661                CALL advec_u_up( i, j )
662             ENDIF
663             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
664             THEN
665                CALL diffusion_u( i, j, ddzu, ddzw, km_m, km_damp_y, tend,  &
666                                  u_m, usws_m, v_m, w_m, z0 )
667             ELSE
668                CALL diffusion_u( i, j, ddzu, ddzw, km, km_damp_y, tend, u, &
669                                  usws, v, w, z0 )
670             ENDIF
671             CALL coriolis( i, j, 1 )
672             IF ( sloping_surface )  CALL buoyancy( i, j, pt, 1, 4 )
673             CALL user_actions( i, j, 'u-tendency' )
674
675!
676!--          Prognostic equation for u-velocity component
677             DO  k = nzb_u_inner(j,i)+1, nzt
678                u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + &
679                             dt_3d * (                                         &
680                                   tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
681                                 - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx    &
682                                     ) -                                       &
683                             tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
684             ENDDO
685
686!
687!--          Calculate tendencies for the next Runge-Kutta step
688             IF ( timestep_scheme(1:5) == 'runge' )  THEN
689                IF ( intermediate_timestep_count == 1 )  THEN
690                   DO  k = nzb_u_inner(j,i)+1, nzt
691                      tu_m(k,j,i) = tend(k,j,i)
692                   ENDDO
693                ELSEIF ( intermediate_timestep_count < &
694                         intermediate_timestep_count_max )  THEN
695                   DO  k = nzb_u_inner(j,i)+1, nzt
696                      tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
697                   ENDDO
698                ENDIF
699             ENDIF
700
701          ENDIF
702
703!
704!--       Tendency terms for v-velocity component
705          IF ( i < nxr+1 )  THEN
706
707             tend(:,j,i) = 0.0
708             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
709                CALL advec_v_pw( i, j )
710             ELSE
711                CALL advec_v_up( i, j )
712             ENDIF
713             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
714             THEN
715                CALL diffusion_v( i, j, ddzu, ddzw, km_m, km_damp_x, tend,     &
716                                  u_m, v_m, vsws_m, w_m, z0 )
717             ELSE
718                CALL diffusion_v( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v, &
719                                  vsws, w, z0 )
720             ENDIF
721             CALL coriolis( i, j, 2 )
722             CALL user_actions( i, j, 'v-tendency' )
723
724!
725!--          Prognostic equation for v-velocity component
726             DO  k = nzb_v_inner(j,i)+1, nzt
727                v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + &
728                             dt_3d * (                                         &
729                                   tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
730                                 - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy    &
731                                     ) -                                       &
732                             tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
733             ENDDO
734
735!
736!--          Calculate tendencies for the next Runge-Kutta step
737             IF ( timestep_scheme(1:5) == 'runge' )  THEN
738                IF ( intermediate_timestep_count == 1 )  THEN
739                   DO  k = nzb_v_inner(j,i)+1, nzt
740                      tv_m(k,j,i) = tend(k,j,i)
741                   ENDDO
742                ELSEIF ( intermediate_timestep_count < &
743                         intermediate_timestep_count_max )  THEN
744                   DO  k = nzb_v_inner(j,i)+1, nzt
745                      tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
746                   ENDDO
747                ENDIF
748             ENDIF
749
750          ENDIF
751
752!
753!--       Tendency terms for w-velocity component
754          IF ( i < nxr+1  .AND.  j < nyn+1 )  THEN
755
756             tend(:,j,i) = 0.0
757             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
758                CALL advec_w_pw( i, j )
759             ELSE
760                CALL advec_w_up( i, j )
761             ENDIF
762             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
763             THEN
764                CALL diffusion_w( i, j, ddzu, ddzw, km_m, km_damp_x,          &
765                                  km_damp_y, tend, u_m, v_m, w_m, z0 )
766             ELSE
767                CALL diffusion_w( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y, &
768                                  tend, u, v, w, z0 )
769             ENDIF
770             CALL coriolis( i, j, 3 )
771             IF ( .NOT. moisture )  THEN
772                CALL buoyancy( i, j, pt, 3, 4 )
773             ELSE
774                CALL buoyancy( i, j, vpt, 3, 44 )
775             ENDIF
776             CALL user_actions( i, j, 'w-tendency' )
777
778!
779!--          Prognostic equation for w-velocity component
780             DO  k = nzb_w_inner(j,i)+1, nzt-1
781                w_p(k,j,i) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + &
782                             dt_3d * (                                         &
783                                   tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
784                              - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
785                                     ) -                                       &
786                             tsc(5) * rdf(k) * w(k,j,i)
787             ENDDO
788
789!
790!--          Calculate tendencies for the next Runge-Kutta step
791             IF ( timestep_scheme(1:5) == 'runge' )  THEN
792                IF ( intermediate_timestep_count == 1 )  THEN
793                   DO  k = nzb_w_inner(j,i)+1, nzt-1
794                      tw_m(k,j,i) = tend(k,j,i)
795                   ENDDO
796                ELSEIF ( intermediate_timestep_count < &
797                         intermediate_timestep_count_max )  THEN
798                   DO  k = nzb_w_inner(j,i)+1, nzt-1
799                      tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
800                   ENDDO
801                ENDIF
802             ENDIF
803
804!
805!--          Tendency terms for potential temperature
806             tend(:,j,i) = 0.0
807             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
808                CALL advec_s_pw( i, j, pt )
809             ELSE
810                CALL advec_s_up( i, j, pt )
811             ENDIF
812             IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' ) &
813             THEN
814                CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, &
815                                  tswst_m, tend )
816             ELSE
817                CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, tend )
818             ENDIF
819
820!
821!--          If required compute heating/cooling due to long wave radiation
822!--          processes
823             IF ( radiation )  THEN
824                CALL calc_radiation( i, j )
825             ENDIF
826
827!
828!--          If required compute impact of latent heat due to precipitation
829             IF ( precipitation )  THEN
830                CALL impact_of_latent_heat( i, j )
831             ENDIF
832             CALL user_actions( i, j, 'pt-tendency' )
833
834!
835!--          Prognostic equation for potential temperature
836             DO  k = nzb_s_inner(j,i)+1, nzt
837                pt_p(k,j,i) = ( 1.0-tsc(1) ) * pt_m(k,j,i) + tsc(1)*pt(k,j,i) +&
838                              dt_3d * (                                        &
839                                  tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
840                                      ) -                                      &
841                              tsc(5) * rdf(k) * ( pt(k,j,i) - pt_init(k) )
842             ENDDO
843
844!
845!--          Calculate tendencies for the next Runge-Kutta step
846             IF ( timestep_scheme(1:5) == 'runge' )  THEN
847                IF ( intermediate_timestep_count == 1 )  THEN
848                   DO  k = nzb_s_inner(j,i)+1, nzt
849                      tpt_m(k,j,i) = tend(k,j,i)
850                   ENDDO
851                ELSEIF ( intermediate_timestep_count < &
852                         intermediate_timestep_count_max )  THEN
853                   DO  k = nzb_s_inner(j,i)+1, nzt
854                      tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + &
855                                      5.3125 * tpt_m(k,j,i)
856                   ENDDO
857                ENDIF
858             ENDIF
859
860!
861!--          If required, compute prognostic equation for total water content /
862!--          scalar
863             IF ( moisture  .OR.  passive_scalar )  THEN
864
865!
866!--             Tendency-terms for total water content / scalar
867                tend(:,j,i) = 0.0
868                IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' ) &
869                THEN
870                   CALL advec_s_pw( i, j, q )
871                ELSE
872                   CALL advec_s_up( i, j, q )
873                ENDIF
874                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
875                THEN
876                   CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, &
877                                     qswst_m, tend )
878                ELSE
879                   CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, &
880                                     tend )
881                ENDIF
882       
883!
884!--             If required compute decrease of total water content due to
885!--             precipitation
886                IF ( precipitation )  THEN
887                   CALL calc_precipitation( i, j )
888                ENDIF
889                CALL user_actions( i, j, 'q-tendency' )
890
891!
892!--             Prognostic equation for total water content / scalar
893                DO  k = nzb_s_inner(j,i)+1, nzt
894                   q_p(k,j,i) = ( 1.0-tsc(1) ) * q_m(k,j,i) + tsc(1)*q(k,j,i) +&
895                                dt_3d * (                                      &
896                                   tsc(2) * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
897                                        ) -                                    &
898                                tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
899                ENDDO
900
901!
902!--             Calculate tendencies for the next Runge-Kutta step
903                IF ( timestep_scheme(1:5) == 'runge' )  THEN
904                   IF ( intermediate_timestep_count == 1 )  THEN
905                      DO  k = nzb_s_inner(j,i)+1, nzt
906                         tq_m(k,j,i) = tend(k,j,i)
907                      ENDDO
908                   ELSEIF ( intermediate_timestep_count < &
909                            intermediate_timestep_count_max )  THEN
910                      DO  k = nzb_s_inner(j,i)+1, nzt
911                         tq_m(k,j,i) = -9.5625 * tend(k,j,i) + &
912                                        5.3125 * tq_m(k,j,i)
913                      ENDDO
914                   ENDIF
915                ENDIF
916
917             ENDIF
918
919!
920!--          If required, compute prognostic equation for turbulent kinetic
921!--          energy (TKE)
922             IF ( .NOT. constant_diffusion )  THEN
923
924!
925!--             Tendency-terms for TKE
926                tend(:,j,i) = 0.0
927                IF ( ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  &
928                     .AND.  .NOT. use_upstream_for_tke )  THEN
929                   CALL advec_s_pw( i, j, e )
930                ELSE
931                   CALL advec_s_up( i, j, e )
932                ENDIF
933                IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )&
934                THEN
935                   IF ( .NOT. moisture )  THEN
936                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
937                                        km_m, l_grid, pt_m, rif_m, tend, zu )
938                   ELSE
939                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
940                                        km_m, l_grid, vpt_m, rif_m, tend, zu )
941                   ENDIF
942                ELSE
943                   IF ( .NOT. moisture )  THEN
944                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
945                                        l_grid, pt, rif, tend, zu )
946                   ELSE
947                      CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
948                                        l_grid, vpt, rif, tend, zu )
949                   ENDIF
950                ENDIF
951                CALL production_e( i, j )
952                CALL user_actions( i, j, 'e-tendency' )
953
954!
955!--             Prognostic equation for TKE.
956!--             Eliminate negative TKE values, which can occur due to numerical
957!--             reasons in the course of the integration. In such cases the old
958!--             TKE value is reduced by 90%.
959                DO  k = nzb_s_inner(j,i)+1, nzt
960                   e_p(k,j,i) = ( 1.0-tsc(1) ) * e_m(k,j,i) + tsc(1)*e(k,j,i) +&
961                                dt_3d * (                                      &
962                                   tsc(2) * tend(k,j,i) + tsc(3) * te_m(k,j,i) &
963                                        )
964                   IF ( e_p(k,j,i) < 0.0 )  e_p(k,j,i) = 0.1 * e(k,j,i)
965                ENDDO
966
967!
968!--             Calculate tendencies for the next Runge-Kutta step
969                IF ( timestep_scheme(1:5) == 'runge' )  THEN
970                   IF ( intermediate_timestep_count == 1 )  THEN
971                      DO  k = nzb_s_inner(j,i)+1, nzt
972                         te_m(k,j,i) = tend(k,j,i)
973                      ENDDO
974                   ELSEIF ( intermediate_timestep_count < &
975                            intermediate_timestep_count_max )  THEN
976                      DO  k = nzb_s_inner(j,i)+1, nzt
977                         te_m(k,j,i) = -9.5625 * tend(k,j,i) + &
978                                        5.3125 * te_m(k,j,i)
979                      ENDDO
980                   ENDIF
981                ENDIF
982
983             ENDIF   ! TKE equation
984
985          ENDIF   ! Gridpoints excluding the non-cyclic wall
986
987       ENDDO
988    ENDDO
989!$OMP END PARALLEL
990
991    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
992
993
994 END SUBROUTINE prognostic_equations_fast
995
996
997 SUBROUTINE prognostic_equations_vec
998
999!------------------------------------------------------------------------------!
1000! Version for vector machines
1001!------------------------------------------------------------------------------!
1002
1003    IMPLICIT NONE
1004
1005    CHARACTER (LEN=9) ::  time_to_string
1006    INTEGER ::  i, j, k
1007    REAL    ::  sat, sbt
1008
1009!
1010!-- Calculate those variables needed in the tendency terms which need
1011!-- global communication
1012    CALL calc_mean_pt_profile( pt, 4 )
1013    IF ( moisture )  CALL calc_mean_pt_profile( vpt, 44 )
1014
1015!
1016!-- u-velocity component
1017    CALL cpu_log( log_point(5), 'u-equation', 'start' )
1018
1019!
1020!-- u-tendency terms with communication
1021    IF ( momentum_advec == 'ups-scheme' )  THEN
1022       tend = 0.0
1023       CALL advec_u_ups
1024    ENDIF
1025
1026!
1027!-- u-tendency terms with no communication
1028    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
1029       tend = 0.0
1030       CALL advec_u_pw
1031    ELSE
1032       IF ( momentum_advec /= 'ups-scheme' )  THEN
1033          tend = 0.0
1034          CALL advec_u_up
1035       ENDIF
1036    ENDIF
1037    IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
1038       CALL diffusion_u( ddzu, ddzw, km_m, km_damp_y, tend, u_m, usws_m, v_m, &
1039                         w_m, z0 )
1040    ELSE
1041       CALL diffusion_u( ddzu, ddzw, km, km_damp_y, tend, u, usws, v, w, z0 )
1042    ENDIF
1043    CALL coriolis( 1 )
1044    IF ( sloping_surface )  CALL buoyancy( pt, 1, 4 )
1045    CALL user_actions( 'u-tendency' )
1046
1047!
1048!-- Prognostic equation for u-velocity component
1049    DO  i = nxl, nxr+uxrp
1050       DO  j = nys, nyn
1051          DO  k = nzb_u_inner(j,i)+1, nzt
1052             u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) +    &
1053                          dt_3d * (                                            &
1054                                   tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
1055                                 - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx    &
1056                                  ) -                                          &
1057                          tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
1058          ENDDO
1059       ENDDO
1060    ENDDO
1061
1062!
1063!-- Calculate tendencies for the next Runge-Kutta step
1064    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1065       IF ( intermediate_timestep_count == 1 )  THEN
1066          DO  i = nxl, nxr+uxrp
1067             DO  j = nys, nyn
1068                DO  k = nzb_u_inner(j,i)+1, nzt
1069                   tu_m(k,j,i) = tend(k,j,i)
1070                ENDDO
1071             ENDDO
1072          ENDDO
1073       ELSEIF ( intermediate_timestep_count < &
1074                intermediate_timestep_count_max )  THEN
1075          DO  i = nxl, nxr+uxrp
1076             DO  j = nys, nyn
1077                DO  k = nzb_u_inner(j,i)+1, nzt
1078                   tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
1079                ENDDO
1080             ENDDO
1081          ENDDO
1082       ENDIF
1083    ENDIF
1084
1085    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
1086
1087!
1088!-- v-velocity component
1089    CALL cpu_log( log_point(6), 'v-equation', 'start' )
1090
1091!
1092!-- v-tendency terms with communication
1093    IF ( momentum_advec == 'ups-scheme' )  THEN
1094       tend = 0.0
1095       CALL advec_v_ups
1096    ENDIF
1097
1098!
1099!-- v-tendency terms with no communication
1100    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
1101       tend = 0.0
1102       CALL advec_v_pw
1103    ELSE
1104       IF ( momentum_advec /= 'ups-scheme' )  THEN
1105          tend = 0.0
1106          CALL advec_v_up
1107       ENDIF
1108    ENDIF
1109    IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
1110       CALL diffusion_v( ddzu, ddzw, km_m, km_damp_x, tend, u_m, v_m, vsws_m, &
1111                         w_m, z0 )
1112    ELSE
1113       CALL diffusion_v( ddzu, ddzw, km, km_damp_x, tend, u, v, vsws, w, z0 )
1114    ENDIF
1115    CALL coriolis( 2 )
1116    CALL user_actions( 'v-tendency' )
1117
1118!
1119!-- Prognostic equation for v-velocity component
1120    DO  i = nxl, nxr
1121       DO  j = nys, nyn+vynp
1122          DO  k = nzb_v_inner(j,i)+1, nzt
1123             v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) +    &
1124                          dt_3d * (                                            &
1125                                   tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
1126                                 - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy    &
1127                                  ) -                                          &
1128                          tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
1129          ENDDO
1130       ENDDO
1131    ENDDO
1132
1133!
1134!-- Calculate tendencies for the next Runge-Kutta step
1135    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1136       IF ( intermediate_timestep_count == 1 )  THEN
1137          DO  i = nxl, nxr
1138             DO  j = nys, nyn+vynp
1139                DO  k = nzb_v_inner(j,i)+1, nzt
1140                   tv_m(k,j,i) = tend(k,j,i)
1141                ENDDO
1142             ENDDO
1143          ENDDO
1144       ELSEIF ( intermediate_timestep_count < &
1145                intermediate_timestep_count_max )  THEN
1146          DO  i = nxl, nxr
1147             DO  j = nys, nyn+vynp
1148                DO  k = nzb_v_inner(j,i)+1, nzt
1149                   tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
1150                ENDDO
1151             ENDDO
1152          ENDDO
1153       ENDIF
1154    ENDIF
1155
1156    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
1157
1158!
1159!-- w-velocity component
1160    CALL cpu_log( log_point(7), 'w-equation', 'start' )
1161
1162!
1163!-- w-tendency terms with communication
1164    IF ( momentum_advec == 'ups-scheme' )  THEN
1165       tend = 0.0
1166       CALL advec_w_ups
1167    ENDIF
1168
1169!
1170!-- w-tendency terms with no communication
1171    IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
1172       tend = 0.0
1173       CALL advec_w_pw
1174    ELSE
1175       IF ( momentum_advec /= 'ups-scheme' )  THEN
1176          tend = 0.0
1177          CALL advec_w_up
1178       ENDIF
1179    ENDIF
1180    IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
1181       CALL diffusion_w( ddzu, ddzw, km_m, km_damp_x, km_damp_y, tend, u_m, &
1182                         v_m, w_m, z0 )
1183    ELSE
1184       CALL diffusion_w( ddzu, ddzw, km, km_damp_x, km_damp_y, tend, u, v, w, &
1185                         z0 )
1186    ENDIF
1187    CALL coriolis( 3 )
1188    IF ( .NOT. moisture )  THEN
1189       CALL buoyancy( pt, 3, 4 )
1190    ELSE
1191       CALL buoyancy( vpt, 3, 44 )
1192    ENDIF
1193    CALL user_actions( 'w-tendency' )
1194
1195!
1196!-- Prognostic equation for w-velocity component
1197    DO  i = nxl, nxr
1198       DO  j = nys, nyn
1199          DO  k = nzb_w_inner(j,i)+1, nzt-1
1200             w_p(k,j,i) = ( 1-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) +      &
1201                          dt_3d * (                                            &
1202                                   tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
1203                              - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
1204                                  ) -                                          &
1205                          tsc(5) * rdf(k) * w(k,j,i)
1206          ENDDO
1207       ENDDO
1208    ENDDO
1209
1210!
1211!-- Calculate tendencies for the next Runge-Kutta step
1212    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1213       IF ( intermediate_timestep_count == 1 )  THEN
1214          DO  i = nxl, nxr
1215             DO  j = nys, nyn
1216                DO  k = nzb_w_inner(j,i)+1, nzt-1
1217                   tw_m(k,j,i) = tend(k,j,i)
1218                ENDDO
1219             ENDDO
1220          ENDDO
1221       ELSEIF ( intermediate_timestep_count < &
1222                intermediate_timestep_count_max )  THEN
1223          DO  i = nxl, nxr
1224             DO  j = nys, nyn
1225                DO  k = nzb_w_inner(j,i)+1, nzt-1
1226                   tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
1227                ENDDO
1228             ENDDO
1229          ENDDO
1230       ENDIF
1231    ENDIF
1232
1233    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
1234
1235!
1236!-- potential temperature
1237    CALL cpu_log( log_point(13), 'pt-equation', 'start' )
1238
1239!
1240!-- pt-tendency terms with communication
1241    IF ( scalar_advec == 'bc-scheme' )  THEN
1242!
1243!--    Bott-Chlond scheme always uses Euler time step. Thus:
1244       sat = 1.0
1245       sbt = 1.0
1246       tend = 0.0
1247       CALL advec_s_bc( pt, 'pt' )
1248    ELSE
1249       sat = tsc(1)
1250       sbt = tsc(2)
1251       IF ( tsc(2) /= 2.0  .AND.  scalar_advec == 'ups-scheme' )  THEN
1252          tend = 0.0
1253          CALL advec_s_ups( pt, 'pt' )
1254       ENDIF
1255    ENDIF
1256         
1257!
1258!-- pt-tendency terms with no communication
1259    IF ( scalar_advec == 'bc-scheme' )  THEN
1260       CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, tend )
1261    ELSE
1262       IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
1263          tend = 0.0
1264          CALL advec_s_pw( pt )
1265       ELSE
1266          IF ( scalar_advec /= 'ups-scheme' )  THEN
1267             tend = 0.0
1268             CALL advec_s_up( pt )
1269          ENDIF
1270       ENDIF
1271       IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
1272          CALL diffusion_s( ddzu, ddzw, kh_m, pt_m, shf_m, tswst_m, tend )
1273       ELSE
1274          CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, tend )
1275       ENDIF
1276    ENDIF
1277
1278!
1279!-- If required compute heating/cooling due to long wave radiation
1280!-- processes
1281    IF ( radiation )  THEN
1282       CALL calc_radiation
1283    ENDIF
1284
1285!
1286!-- If required compute impact of latent heat due to precipitation
1287    IF ( precipitation )  THEN
1288       CALL impact_of_latent_heat
1289    ENDIF
1290    CALL user_actions( 'pt-tendency' )
1291
1292!
1293!-- Prognostic equation for potential temperature
1294    DO  i = nxl, nxr
1295       DO  j = nys, nyn
1296          DO  k = nzb_s_inner(j,i)+1, nzt
1297             pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) +       &
1298                           dt_3d * (                                           &
1299                                     sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
1300                                   ) -                                         &
1301                           tsc(5) * rdf(k) * ( pt(k,j,i) - pt_init(k) )
1302          ENDDO
1303       ENDDO
1304    ENDDO
1305
1306!
1307!-- Calculate tendencies for the next Runge-Kutta step
1308    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1309       IF ( intermediate_timestep_count == 1 )  THEN
1310          DO  i = nxl, nxr
1311             DO  j = nys, nyn
1312                DO  k = nzb_s_inner(j,i)+1, nzt
1313                   tpt_m(k,j,i) = tend(k,j,i)
1314                ENDDO
1315             ENDDO
1316          ENDDO
1317       ELSEIF ( intermediate_timestep_count < &
1318                intermediate_timestep_count_max )  THEN
1319          DO  i = nxl, nxr
1320             DO  j = nys, nyn
1321                DO  k = nzb_s_inner(j,i)+1, nzt
1322                   tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)
1323                ENDDO
1324             ENDDO
1325          ENDDO
1326       ENDIF
1327    ENDIF
1328
1329    CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
1330
1331!
1332!-- If required, compute prognostic equation for total water content / scalar
1333    IF ( moisture  .OR.  passive_scalar )  THEN
1334
1335       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
1336
1337!
1338!--    Scalar/q-tendency terms with communication
1339       IF ( scalar_advec == 'bc-scheme' )  THEN
1340!
1341!--       Bott-Chlond scheme always uses Euler time step. Thus:
1342          sat = 1.0
1343          sbt = 1.0
1344          tend = 0.0
1345          CALL advec_s_bc( q, 'q' )
1346       ELSE
1347          sat = tsc(1)
1348          sbt = tsc(2)
1349          IF ( tsc(2) /= 2.0 )  THEN
1350             IF ( scalar_advec == 'ups-scheme' )  THEN
1351                tend = 0.0
1352                CALL advec_s_ups( q, 'q' )
1353             ENDIF
1354          ENDIF
1355       ENDIF
1356
1357!
1358!--    Scalar/q-tendency terms with no communication
1359       IF ( scalar_advec == 'bc-scheme' )  THEN
1360          CALL diffusion_s( ddzu, ddzw, kh, q, qsws, qswst, tend )
1361       ELSE
1362          IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
1363             tend = 0.0
1364             CALL advec_s_pw( q )
1365          ELSE
1366             IF ( scalar_advec /= 'ups-scheme' )  THEN
1367                tend = 0.0
1368                CALL advec_s_up( q )
1369             ENDIF
1370          ENDIF
1371          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
1372             CALL diffusion_s( ddzu, ddzw, kh_m, q_m, qsws_m, qswst_m, tend )
1373          ELSE
1374             CALL diffusion_s( ddzu, ddzw, kh, q, qsws, qswst, tend )
1375          ENDIF
1376       ENDIF
1377       
1378!
1379!--    If required compute decrease of total water content due to
1380!--    precipitation
1381       IF ( precipitation )  THEN
1382          CALL calc_precipitation
1383       ENDIF
1384       CALL user_actions( 'q-tendency' )
1385
1386!
1387!--    Prognostic equation for total water content / scalar
1388       DO  i = nxl, nxr
1389          DO  j = nys, nyn
1390             DO  k = nzb_s_inner(j,i)+1, nzt
1391                q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) +       &
1392                             dt_3d * (                                         &
1393                                      sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
1394                                     ) -                                       &
1395                             tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
1396             ENDDO
1397          ENDDO
1398       ENDDO
1399
1400!
1401!--    Calculate tendencies for the next Runge-Kutta step
1402       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1403          IF ( intermediate_timestep_count == 1 )  THEN
1404             DO  i = nxl, nxr
1405                DO  j = nys, nyn
1406                   DO  k = nzb_s_inner(j,i)+1, nzt
1407                      tq_m(k,j,i) = tend(k,j,i)
1408                   ENDDO
1409                ENDDO
1410             ENDDO
1411          ELSEIF ( intermediate_timestep_count < &
1412                   intermediate_timestep_count_max )  THEN
1413             DO  i = nxl, nxr
1414                DO  j = nys, nyn
1415                   DO  k = nzb_s_inner(j,i)+1, nzt
1416                      tq_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tq_m(k,j,i)
1417                   ENDDO
1418                ENDDO
1419             ENDDO
1420          ENDIF
1421       ENDIF
1422
1423       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
1424
1425    ENDIF
1426
1427!
1428!-- If required, compute prognostic equation for turbulent kinetic
1429!-- energy (TKE)
1430    IF ( .NOT. constant_diffusion )  THEN
1431
1432       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
1433
1434!
1435!--    TKE-tendency terms with communication
1436       CALL production_e_init
1437       IF ( .NOT. use_upstream_for_tke )  THEN
1438          IF ( scalar_advec == 'bc-scheme' )  THEN
1439!
1440!--          Bott-Chlond scheme always uses Euler time step. Thus:
1441             sat = 1.0
1442             sbt = 1.0
1443             tend = 0.0
1444             CALL advec_s_bc( e, 'e' )
1445          ELSE
1446             sat = tsc(1)
1447             sbt = tsc(2)
1448             IF ( tsc(2) /= 2.0 )  THEN
1449                IF ( scalar_advec == 'ups-scheme' )  THEN
1450                   tend = 0.0
1451                   CALL advec_s_ups( e, 'e' )
1452                ENDIF
1453             ENDIF
1454          ENDIF
1455       ENDIF
1456
1457!
1458!--    TKE-tendency terms with no communication
1459       IF ( scalar_advec == 'bc-scheme'  .AND.  .NOT. use_upstream_for_tke )  &
1460       THEN
1461          IF ( .NOT. moisture )  THEN
1462             CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, pt, &
1463                               rif, tend, zu )
1464          ELSE
1465             CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, &
1466                               rif, tend, zu )
1467          ENDIF
1468       ELSE
1469          IF ( use_upstream_for_tke )  THEN
1470             tend = 0.0
1471             CALL advec_s_up( e )
1472          ELSE
1473             IF ( tsc(2) == 2.0  .OR.  timestep_scheme(1:5) == 'runge' )  THEN
1474                tend = 0.0
1475                CALL advec_s_pw( e )
1476             ELSE
1477                IF ( scalar_advec /= 'ups-scheme' )  THEN
1478                   tend = 0.0
1479                   CALL advec_s_up( e )
1480                ENDIF
1481             ENDIF
1482          ENDIF
1483          IF ( tsc(2) == 2.0  .AND.  timestep_scheme(1:8) == 'leapfrog' )  THEN
1484             IF ( .NOT. moisture )  THEN
1485                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, &
1486                                  pt_m, rif_m, tend, zu )
1487             ELSE
1488                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, &
1489                                  vpt_m, rif_m, tend, zu )
1490             ENDIF
1491          ELSE
1492             IF ( .NOT. moisture )  THEN
1493                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, pt, &
1494                                  rif, tend, zu )
1495             ELSE
1496                CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, &
1497                                  rif, tend, zu )
1498             ENDIF
1499          ENDIF
1500       ENDIF
1501       CALL production_e
1502       CALL user_actions( 'e-tendency' )
1503
1504!
1505!--    Prognostic equation for TKE.
1506!--    Eliminate negative TKE values, which can occur due to numerical
1507!--    reasons in the course of the integration. In such cases the old TKE
1508!--    value is reduced by 90%.
1509       DO  i = nxl, nxr
1510          DO  j = nys, nyn
1511             DO  k = nzb_s_inner(j,i)+1, nzt
1512                e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * e(k,j,i) +       &
1513                             dt_3d * (                                         &
1514                                      sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) &
1515                                     )
1516                IF ( e_p(k,j,i) < 0.0 )  e_p(k,j,i) = 0.1 * e(k,j,i)
1517             ENDDO
1518          ENDDO
1519       ENDDO
1520
1521!
1522!--    Calculate tendencies for the next Runge-Kutta step
1523       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1524          IF ( intermediate_timestep_count == 1 )  THEN
1525             DO  i = nxl, nxr
1526                DO  j = nys, nyn
1527                   DO  k = nzb_s_inner(j,i)+1, nzt
1528                      te_m(k,j,i) = tend(k,j,i)
1529                   ENDDO
1530                ENDDO
1531             ENDDO
1532          ELSEIF ( intermediate_timestep_count < &
1533                   intermediate_timestep_count_max )  THEN
1534             DO  i = nxl, nxr
1535                DO  j = nys, nyn
1536                   DO  k = nzb_s_inner(j,i)+1, nzt
1537                      te_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * te_m(k,j,i)
1538                   ENDDO
1539                ENDDO
1540             ENDDO
1541          ENDIF
1542       ENDIF
1543
1544       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
1545
1546    ENDIF
1547
1548
1549 END SUBROUTINE prognostic_equations_vec
1550
1551
1552 END MODULE prognostic_equations_mod
Note: See TracBrowser for help on using the repository browser.