source: palm/trunk/SOURCE/model_1d_mod.f90 @ 4180

Last change on this file since 4180 was 4180, checked in by scharf, 2 years ago

removed comments in 'Former revisions' section that are older than 01.01.2019

  • Property svn:keywords set to Id
File size: 40.8 KB
Line 
1!> @file model_1d_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
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-2019 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: model_1d_mod.f90 4180 2019-08-21 14:37:54Z scharf $
27! Modularization of all bulk cloud physics code components
28!
29!
30! Description:
31! ------------
32!> 1D-model to initialize the 3D-arrays.
33!> The temperature profile is set as steady and a corresponding steady solution
34!> of the wind profile is being computed.
35!> All subroutines required can be found within this file.
36!>
37!> @todo harmonize code with new surface_layer_fluxes module
38!> @bug 1D model crashes when using small grid spacings in the order of 1 m
39!> @fixme option "as_in_3d_model" seems to be an inappropriate option because
40!>        the 1D model uses different turbulence closure approaches at least if
41!>        the 3D model is set to LES-mode.
42!------------------------------------------------------------------------------!
43 MODULE model_1d_mod
44
45    USE arrays_3d,                                                             &
46        ONLY:  dd2zu, ddzu, ddzw, dzu, dzw, pt_init, q_init, ug, u_init,       &
47               vg, v_init, zu
48
49    USE basic_constants_and_equations_mod,                                     &
50        ONLY:  g, kappa, pi
51   
52    USE control_parameters,                                                    &
53        ONLY:  constant_diffusion, constant_flux_layer, dissipation_1d, f,     &
54               humidity, ibc_e_b, intermediate_timestep_count,                 &
55               intermediate_timestep_count_max, km_constant,                   &
56               message_string, mixing_length_1d, prandtl_number,               &
57               roughness_length, run_description_header, simulated_time_chr,   &
58               timestep_scheme, tsc, z0h_factor
59
60    USE indices,                                                               &
61        ONLY:  nzb, nzb_diff, nzt
62   
63    USE kinds
64
65    USE pegrid,                                                                &
66        ONLY:  myid
67       
68
69    IMPLICIT NONE
70
71    INTEGER(iwp) ::  current_timestep_number_1d = 0  !< current timestep number (1d-model)
72    INTEGER(iwp) ::  damp_level_ind_1d               !< lower grid index of damping layer (1d-model)
73
74    LOGICAL ::  run_control_header_1d = .FALSE.  !< flag for output of run control header (1d-model)
75    LOGICAL ::  stop_dt_1d = .FALSE.             !< termination flag, used in case of too small timestep (1d-model)
76
77    REAL(wp) ::  alpha_buoyancy                !< model constant according to Koblitz (2013)
78    REAL(wp) ::  c_0 = 0.416179145_wp          !< = 0.03^0.25; model constant according to Koblitz (2013)
79    REAL(wp) ::  c_1 = 1.52_wp                 !< model constant according to Koblitz (2013)
80    REAL(wp) ::  c_2 = 1.83_wp                 !< model constant according to Koblitz (2013)
81    REAL(wp) ::  c_3                           !< model constant
82    REAL(wp) ::  c_mu                          !< model constant
83    REAL(wp) ::  damp_level_1d = -1.0_wp       !< namelist parameter
84    REAL(wp) ::  dt_1d = 60.0_wp               !< dynamic timestep (1d-model)
85    REAL(wp) ::  dt_max_1d = 300.0_wp          !< timestep limit (1d-model)
86    REAL(wp) ::  dt_pr_1d = 9999999.9_wp       !< namelist parameter
87    REAL(wp) ::  dt_run_control_1d = 60.0_wp   !< namelist parameter
88    REAL(wp) ::  end_time_1d = 864000.0_wp     !< namelist parameter
89    REAL(wp) ::  lambda                        !< maximum mixing length
90    REAL(wp) ::  qs1d                          !< characteristic humidity scale (1d-model)
91    REAL(wp) ::  simulated_time_1d = 0.0_wp    !< updated simulated time (1d-model)
92    REAL(wp) ::  sig_diss = 2.95_wp            !< model constant according to Koblitz (2013)
93    REAL(wp) ::  sig_e = 2.95_wp               !< model constant according to Koblitz (2013)
94    REAL(wp) ::  time_pr_1d = 0.0_wp           !< updated simulated time for profile output (1d-model)
95    REAL(wp) ::  time_run_control_1d = 0.0_wp  !< updated simulated time for run-control output (1d-model)
96    REAL(wp) ::  ts1d                          !< characteristic temperature scale (1d-model)
97    REAL(wp) ::  us1d                          !< friction velocity (1d-model)
98    REAL(wp) ::  usws1d                        !< u-component of the momentum flux (1d-model)
99    REAL(wp) ::  vsws1d                        !< v-component of the momentum flux (1d-model)
100    REAL(wp) ::  z01d                          !< roughness length for momentum (1d-model)
101    REAL(wp) ::  z0h1d                         !< roughness length for scalars (1d-model)
102
103    REAL(wp), DIMENSION(:), ALLOCATABLE ::  diss1d   !< tke dissipation rate (1d-model)
104    REAL(wp), DIMENSION(:), ALLOCATABLE ::  diss1d_p !< prognostic value of tke dissipation rate (1d-model)
105    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e1d      !< tke (1d-model)
106    REAL(wp), DIMENSION(:), ALLOCATABLE ::  e1d_p    !< prognostic value of tke (1d-model)
107    REAL(wp), DIMENSION(:), ALLOCATABLE ::  kh1d     !< turbulent diffusion coefficient for heat (1d-model)
108    REAL(wp), DIMENSION(:), ALLOCATABLE ::  km1d     !< turbulent diffusion coefficient for momentum (1d-model)
109    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d      !< mixing length for turbulent diffusion coefficients (1d-model)
110    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d_init !< initial mixing length (1d-model)
111    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d_diss !< mixing length for dissipation (1d-model)
112    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rif1d    !< Richardson flux number (1d-model)
113    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_diss  !< tendency of diss (1d-model)
114    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_dissm !< weighted tendency of diss for previous sub-timestep (1d-model)
115    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_e     !< tendency of e (1d-model)
116    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_em    !< weighted tendency of e for previous sub-timestep (1d-model)
117    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_u     !< tendency of u (1d-model)
118    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_um    !< weighted tendency of u for previous sub-timestep (1d-model)
119    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_v     !< tendency of v (1d-model)
120    REAL(wp), DIMENSION(:), ALLOCATABLE ::  te_vm    !< weighted tendency of v for previous sub-timestep (1d-model)
121    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u1d      !< u-velocity component (1d-model)
122    REAL(wp), DIMENSION(:), ALLOCATABLE ::  u1d_p    !< prognostic value of u-velocity component (1d-model)
123    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v1d      !< v-velocity component (1d-model)
124    REAL(wp), DIMENSION(:), ALLOCATABLE ::  v1d_p    !< prognostic value of v-velocity component (1d-model)
125
126!
127!-- Initialize 1D model
128    INTERFACE init_1d_model
129       MODULE PROCEDURE init_1d_model
130    END INTERFACE init_1d_model
131
132!
133!-- Print profiles
134    INTERFACE print_1d_model
135       MODULE PROCEDURE print_1d_model
136    END INTERFACE print_1d_model
137
138!
139!-- Print run control information
140    INTERFACE run_control_1d
141       MODULE PROCEDURE run_control_1d
142    END INTERFACE run_control_1d
143
144!
145!-- Main procedure
146    INTERFACE time_integration_1d
147       MODULE PROCEDURE time_integration_1d
148    END INTERFACE time_integration_1d
149
150!
151!-- Calculate time step
152    INTERFACE timestep_1d
153       MODULE PROCEDURE timestep_1d
154    END INTERFACE timestep_1d
155
156    SAVE
157
158    PRIVATE
159!
160!-- Public interfaces
161    PUBLIC  init_1d_model
162
163!
164!-- Public variables
165    PUBLIC  damp_level_1d, damp_level_ind_1d, diss1d, dt_pr_1d,                &
166            dt_run_control_1d, e1d, end_time_1d, kh1d, km1d, l1d, rif1d, u1d,  &
167            us1d, usws1d, v1d, vsws1d
168
169
170    CONTAINS
171
172 SUBROUTINE init_1d_model
173 
174    USE grid_variables,                                                        &
175        ONLY:  dx, dy
176
177    IMPLICIT NONE
178
179    CHARACTER (LEN=9) ::  time_to_string  !< function to transform time from real to character string
180
181    INTEGER(iwp) ::  k  !< loop index
182
183!
184!-- Allocate required 1D-arrays
185    ALLOCATE( diss1d(nzb:nzt+1), diss1d_p(nzb:nzt+1),                          &
186              e1d(nzb:nzt+1), e1d_p(nzb:nzt+1), kh1d(nzb:nzt+1),               &
187              km1d(nzb:nzt+1), l1d(nzb:nzt+1), l1d_init(nzb:nzt+1),            &
188              l1d_diss(nzb:nzt+1), rif1d(nzb:nzt+1), te_diss(nzb:nzt+1),       &
189              te_dissm(nzb:nzt+1), te_e(nzb:nzt+1),                            &
190              te_em(nzb:nzt+1), te_u(nzb:nzt+1), te_um(nzb:nzt+1),             &
191              te_v(nzb:nzt+1), te_vm(nzb:nzt+1), u1d(nzb:nzt+1),               &
192              u1d_p(nzb:nzt+1),  v1d(nzb:nzt+1), v1d_p(nzb:nzt+1) )
193
194!
195!-- Initialize arrays
196    IF ( constant_diffusion )  THEN
197       km1d = km_constant
198       kh1d = km_constant / prandtl_number
199    ELSE
200       diss1d = 0.0_wp; diss1d_p = 0.0_wp
201       e1d = 0.0_wp; e1d_p = 0.0_wp
202       kh1d = 0.0_wp; km1d = 0.0_wp
203       rif1d = 0.0_wp
204!
205!--    Compute the mixing length
206       l1d_init(nzb) = 0.0_wp
207
208       IF ( TRIM( mixing_length_1d ) == 'blackadar' )  THEN
209!
210!--       Blackadar mixing length
211          IF ( f /= 0.0_wp )  THEN
212             lambda = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) /        &
213                               ABS( f ) + 1E-10_wp
214          ELSE
215             lambda = 30.0_wp
216          ENDIF
217
218          DO  k = nzb+1, nzt+1
219             l1d_init(k) = kappa * zu(k) / ( 1.0_wp + kappa * zu(k) / lambda )
220          ENDDO
221
222       ELSEIF ( TRIM( mixing_length_1d ) == 'as_in_3d_model' )  THEN
223!
224!--       Use the same mixing length as in 3D model (LES-mode)
225          !> @todo rename (delete?) this option
226          !>  As the mixing length is different between RANS and LES mode, it
227          !>  must be distinguished here between these modes. For RANS mode,
228          !>  the mixing length is calculated accoding to Blackadar, which is
229          !>  the other option at this point.
230          !>  Maybe delete this option entirely (not appropriate in LES case)
231          !>  2018-03-20, gronemeier
232          DO  k = nzb+1, nzt
233             l1d_init(k)  = ( dx * dy * dzw(k) )**0.33333333333333_wp
234          ENDDO
235          l1d_init(nzt+1) = l1d_init(nzt)
236
237       ENDIF
238    ENDIF
239    l1d      = l1d_init
240    l1d_diss = l1d_init
241    u1d      = u_init
242    u1d_p    = u_init
243    v1d      = v_init
244    v1d_p    = v_init
245
246!
247!-- Set initial horizontal velocities at the lowest grid levels to a very small
248!-- value in order to avoid too small time steps caused by the diffusion limit
249!-- in the initial phase of a run (at k=1, dz/2 occurs in the limiting formula!)
250    u1d(0:1)   = 0.1_wp
251    u1d_p(0:1) = 0.1_wp
252    v1d(0:1)   = 0.1_wp
253    v1d_p(0:1) = 0.1_wp
254
255!
256!-- For u*, theta* and the momentum fluxes plausible values are set
257    IF ( constant_flux_layer )  THEN
258       us1d = 0.1_wp   ! without initial friction the flow would not change
259    ELSE
260       diss1d(nzb+1) = 0.001_wp
261       e1d(nzb+1)  = 1.0_wp
262       km1d(nzb+1) = 1.0_wp
263       us1d = 0.0_wp
264    ENDIF
265    ts1d = 0.0_wp
266    usws1d = 0.0_wp
267    vsws1d = 0.0_wp
268    z01d  = roughness_length
269    z0h1d = z0h_factor * z01d
270    IF ( humidity )  qs1d = 0.0_wp
271
272!
273!-- Tendencies must be preset in order to avoid runtime errors
274    te_diss  = 0.0_wp
275    te_dissm = 0.0_wp
276    te_e  = 0.0_wp
277    te_em = 0.0_wp
278    te_um = 0.0_wp
279    te_vm = 0.0_wp
280
281!
282!-- Set model constant
283    IF ( dissipation_1d == 'as_in_3d_model' )  c_0 = 0.1_wp
284    c_mu = c_0**4
285
286!
287!-- Set start time in hh:mm:ss - format
288    simulated_time_chr = time_to_string( simulated_time_1d )
289
290!
291!-- Integrate the 1D-model equations using the Runge-Kutta scheme
292    CALL time_integration_1d
293
294
295 END SUBROUTINE init_1d_model
296
297
298
299!------------------------------------------------------------------------------!
300! Description:
301! ------------
302!> Runge-Kutta time differencing scheme for the 1D-model.
303!------------------------------------------------------------------------------!
304 
305 SUBROUTINE time_integration_1d
306
307    IMPLICIT NONE
308
309    CHARACTER (LEN=9) ::  time_to_string  !< function to transform time from real to character string
310
311    INTEGER(iwp) ::  k  !< loop index
312
313    REAL(wp) ::  a            !< auxiliary variable
314    REAL(wp) ::  b            !< auxiliary variable
315    REAL(wp) ::  dpt_dz       !< vertical temperature gradient
316    REAL(wp) ::  flux         !< vertical temperature gradient
317    REAL(wp) ::  kmzm         !< Km(z-dz/2)
318    REAL(wp) ::  kmzp         !< Km(z+dz/2)
319    REAL(wp) ::  l_stable     !< mixing length for stable case
320    REAL(wp) ::  pt_0         !< reference temperature
321    REAL(wp) ::  uv_total     !< horizontal wind speed
322
323!
324!-- Determine the time step at the start of a 1D-simulation and
325!-- determine and printout quantities used for run control
326    dt_1d = 0.01_wp
327    CALL run_control_1d
328
329!
330!-- Start of time loop
331    DO  WHILE ( simulated_time_1d < end_time_1d  .AND.  .NOT. stop_dt_1d )
332
333!
334!--    Depending on the timestep scheme, carry out one or more intermediate
335!--    timesteps
336
337       intermediate_timestep_count = 0
338       DO  WHILE ( intermediate_timestep_count < &
339                   intermediate_timestep_count_max )
340
341          intermediate_timestep_count = intermediate_timestep_count + 1
342
343          CALL timestep_scheme_steering
344
345!
346!--       Compute all tendency terms. If a constant-flux layer is simulated,
347!--       k starts at nzb+2.
348          DO  k = nzb_diff, nzt
349
350             kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
351             kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
352!
353!--          u-component
354             te_u(k) =  f * ( v1d(k) - vg(k) ) + ( &
355                              kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) &
356                            - kmzm * ( u1d(k) - u1d(k-1) ) * ddzu(k)   &
357                                                 ) * ddzw(k)
358!
359!--          v-component
360             te_v(k) = -f * ( u1d(k) - ug(k) ) + (                     &
361                              kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) &
362                            - kmzm * ( v1d(k) - v1d(k-1) ) * ddzu(k)   &
363                                                 ) * ddzw(k)
364          ENDDO
365          IF ( .NOT. constant_diffusion )  THEN
366             DO  k = nzb_diff, nzt
367!
368!--             TKE and dissipation rate
369                kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
370                kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
371                IF ( .NOT. humidity )  THEN
372                   pt_0 = pt_init(k)
373                   flux =  ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
374                ELSE
375                   pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
376                   flux = ( ( pt_init(k+1) - pt_init(k-1) ) +                  &
377                            0.61_wp * ( pt_init(k+1) * q_init(k+1) -           &
378                                        pt_init(k-1) * q_init(k-1)   )         &
379                          ) * dd2zu(k)
380                ENDIF
381
382!
383!--             Calculate dissipation rate if no prognostic equation is used for
384!--             dissipation rate
385                IF ( dissipation_1d == 'detering' )  THEN
386                   diss1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
387                ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
388                   diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) &
389                               ) * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
390                ENDIF
391!
392!--             TKE
393                te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2&
394                                    + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2&
395                                    )                                          &
396                                    - g / pt_0 * kh1d(k) * flux                &
397                                    +            (                             &
398                                     kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1)  &
399                                   - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k)    &
400                                                 ) * ddzw(k) / sig_e           &
401                                   - diss1d(k)
402
403                IF ( dissipation_1d == 'prognostic' )  THEN
404!
405!--                dissipation rate
406                   IF ( rif1d(k) >= 0.0_wp )  THEN
407                      alpha_buoyancy = 1.0_wp - l1d(k) / lambda
408                   ELSE
409                      alpha_buoyancy = 1.0_wp - ( 1.0_wp + ( c_2 - 1.0_wp )    &
410                                                         / ( c_2 - c_1    ) )  &
411                                              * l1d(k) / lambda
412                   ENDIF
413                   c_3 = ( c_1 - c_2 ) * alpha_buoyancy + 1.0_wp
414                   te_diss(k) = ( km1d(k) *                                    &
415                                  ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2  &
416                                  + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2  &
417                                  ) * ( c_1 + (c_2 - c_1) * l1d(k) / lambda )  &
418                                  - g / pt_0 * kh1d(k) * flux * c_3            &
419                                  - c_2 * diss1d(k)                            &
420                                ) * diss1d(k) / ( e1d(k) + 1.0E-20_wp )        &
421                                + (   kmzp * ( diss1d(k+1) - diss1d(k) )       &
422                                           * ddzu(k+1)                         &
423                                    - kmzm * ( diss1d(k) - diss1d(k-1) )       &
424                                           * ddzu(k)                           &
425                                  ) * ddzw(k) / sig_diss
426
427                ENDIF
428
429             ENDDO
430          ENDIF
431
432!
433!--       Tendency terms at the top of the constant-flux layer.
434!--       Finite differences of the momentum fluxes are computed using half the
435!--       normal grid length (2.0*ddzw(k)) for the sake of enhanced accuracy
436          IF ( constant_flux_layer )  THEN
437
438             k = nzb+1
439             kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
440             kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
441             IF ( .NOT. humidity )  THEN
442                pt_0 = pt_init(k)
443                flux =  ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
444             ELSE
445                pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
446                flux = ( ( pt_init(k+1) - pt_init(k-1) ) +                     &
447                         0.61_wp * ( pt_init(k+1) * q_init(k+1) -              &
448                                     pt_init(k-1) * q_init(k-1)   )            &
449                       ) * dd2zu(k)
450             ENDIF
451
452!
453!--          Calculate dissipation rate if no prognostic equation is used for
454!--          dissipation rate
455             IF ( dissipation_1d == 'detering' )  THEN
456                diss1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
457             ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
458                diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) )  &
459                            * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
460             ENDIF
461
462!
463!--          u-component
464             te_u(k) = f * ( v1d(k) - vg(k) ) + (                              &
465                       kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) + usws1d       &
466                                                ) * 2.0_wp * ddzw(k)
467!
468!--          v-component
469             te_v(k) = -f * ( u1d(k) - ug(k) ) + (                             &
470                       kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) + vsws1d       &
471                                                 ) * 2.0_wp * ddzw(k)
472!
473!--          TKE
474             IF ( .NOT. dissipation_1d == 'prognostic' )  THEN
475                !> @query why integrate over 2dz
476                !>   Why is it allowed to integrate over two delta-z for e
477                !>   while for u and v it is not?
478                !>   2018-04-23, gronemeier
479                te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2&
480                                    + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2&
481                                    )                                          &
482                                    - g / pt_0 * kh1d(k) * flux                &
483                                    +           (                              &
484                                     kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1)  &
485                                   - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k)    &
486                                                 ) * ddzw(k) / sig_e           &
487                                   - diss1d(k)
488             ENDIF
489
490          ENDIF
491
492!
493!--       Prognostic equations for all 1D variables
494          DO  k = nzb+1, nzt
495
496             u1d_p(k) = u1d(k) + dt_1d * ( tsc(2) * te_u(k) + &
497                                           tsc(3) * te_um(k) )
498             v1d_p(k) = v1d(k) + dt_1d * ( tsc(2) * te_v(k) + &
499                                           tsc(3) * te_vm(k) )
500
501          ENDDO
502          IF ( .NOT. constant_diffusion )  THEN
503
504             DO  k = nzb+1, nzt
505                e1d_p(k) = e1d(k) + dt_1d * ( tsc(2) * te_e(k) + &
506                                              tsc(3) * te_em(k) )
507             ENDDO
508
509!
510!--          Eliminate negative TKE values, which can result from the
511!--          integration due to numerical inaccuracies. In such cases the TKE
512!--          value is reduced to 10 percent of its old value.
513             WHERE ( e1d_p < 0.0_wp )  e1d_p = 0.1_wp * e1d
514
515             IF ( dissipation_1d == 'prognostic' )  THEN
516                DO  k = nzb+1, nzt
517                   diss1d_p(k) = diss1d(k) + dt_1d * ( tsc(2) * te_diss(k) + &
518                                                       tsc(3) * te_dissm(k) )
519                ENDDO
520                WHERE ( diss1d_p < 0.0_wp )  diss1d_p = 0.1_wp * diss1d
521             ENDIF
522          ENDIF
523
524!
525!--       Calculate tendencies for the next Runge-Kutta step
526          IF ( timestep_scheme(1:5) == 'runge' ) THEN
527             IF ( intermediate_timestep_count == 1 )  THEN
528
529                DO  k = nzb+1, nzt
530                   te_um(k) = te_u(k)
531                   te_vm(k) = te_v(k)
532                ENDDO
533
534                IF ( .NOT. constant_diffusion )  THEN
535                   DO k = nzb+1, nzt
536                      te_em(k) = te_e(k)
537                   ENDDO
538                   IF ( dissipation_1d == 'prognostic' )  THEN
539                      DO k = nzb+1, nzt
540                         te_dissm(k) = te_diss(k)
541                      ENDDO
542                   ENDIF
543                ENDIF
544
545             ELSEIF ( intermediate_timestep_count < &
546                         intermediate_timestep_count_max )  THEN
547
548                DO  k = nzb+1, nzt
549                   te_um(k) = -9.5625_wp * te_u(k) + 5.3125_wp * te_um(k)
550                   te_vm(k) = -9.5625_wp * te_v(k) + 5.3125_wp * te_vm(k)
551                ENDDO
552
553                IF ( .NOT. constant_diffusion )  THEN
554                   DO k = nzb+1, nzt
555                      te_em(k) = -9.5625_wp * te_e(k) + 5.3125_wp * te_em(k)
556                   ENDDO
557                   IF ( dissipation_1d == 'prognostic' )  THEN
558                      DO k = nzb+1, nzt
559                         te_dissm(k) = -9.5625_wp * te_diss(k)  &
560                                     +  5.3125_wp * te_dissm(k)
561                      ENDDO
562                   ENDIF
563                ENDIF
564
565             ENDIF
566          ENDIF
567
568!
569!--       Boundary conditions for the prognostic variables.
570!--       At the top boundary (nzt+1) u, v, e, and diss keep their initial
571!--       values (ug(nzt+1), vg(nzt+1), 0, 0).
572!--       At the bottom boundary, Dirichlet condition is used for u and v (0)
573!--       and Neumann condition for e and diss (e(nzb)=e(nzb+1)).
574          u1d_p(nzb) = 0.0_wp
575          v1d_p(nzb) = 0.0_wp
576
577!
578!--       Swap the time levels in preparation for the next time step.
579          u1d  = u1d_p
580          v1d  = v1d_p
581          IF ( .NOT. constant_diffusion )  THEN
582             e1d  = e1d_p
583             IF ( dissipation_1d == 'prognostic' )  THEN
584                diss1d = diss1d_p
585             ENDIF
586          ENDIF
587
588!
589!--       Compute diffusion quantities
590          IF ( .NOT. constant_diffusion )  THEN
591
592!
593!--          First compute the vertical fluxes in the constant-flux layer
594             IF ( constant_flux_layer )  THEN
595!
596!--             Compute theta* using Rif numbers of the previous time step
597                IF ( rif1d(nzb+1) >= 0.0_wp )  THEN
598!
599!--                Stable stratification
600                   ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) /          &
601                          ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * rif1d(nzb+1) * &
602                                          ( zu(nzb+1) - z0h1d ) / zu(nzb+1)    &
603                          )
604                ELSE
605!
606!--                Unstable stratification
607                   a = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) )
608                   b = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) /                 &
609                       zu(nzb+1) * z0h1d )
610
611                   ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) /          &
612                          LOG( (a-1.0_wp) / (a+1.0_wp) *                       &
613                               (b+1.0_wp) / (b-1.0_wp) )
614                ENDIF
615
616             ENDIF    ! constant_flux_layer
617             !> @todo combine if clauses
618             !>   The previous and following if clauses can be combined into a
619             !>   single clause
620             !>   2018-04-23, gronemeier
621!
622!--          Compute the Richardson-flux numbers,
623!--          first at the top of the constant-flux layer using u* of the
624!--          previous time step (+1E-30, if u* = 0), then in the remaining area.
625!--          There the rif-numbers of the previous time step are used.
626
627             IF ( constant_flux_layer )  THEN
628                IF ( .NOT. humidity )  THEN
629                   pt_0 = pt_init(nzb+1)
630                   flux = ts1d
631                ELSE
632                   pt_0 = pt_init(nzb+1) * ( 1.0_wp + 0.61_wp * q_init(nzb+1) )
633                   flux = ts1d + 0.61_wp * pt_init(k) * qs1d
634                ENDIF
635                rif1d(nzb+1) = zu(nzb+1) * kappa * g * flux / &
636                               ( pt_0 * ( us1d**2 + 1E-30_wp ) )
637             ENDIF
638
639             DO  k = nzb_diff, nzt
640                IF ( .NOT. humidity )  THEN
641                   pt_0 = pt_init(k)
642                   flux = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
643                ELSE
644                   pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) )
645                   flux = ( ( pt_init(k+1) - pt_init(k-1) )                    &
646                            + 0.61_wp                                          &
647                            * (   pt_init(k+1) * q_init(k+1)                   &
648                                - pt_init(k-1) * q_init(k-1) )                 &
649                          ) * dd2zu(k)
650                ENDIF
651                IF ( rif1d(k) >= 0.0_wp )  THEN
652                   rif1d(k) = g / pt_0 * flux /                                &
653                              (  ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2     &
654                               + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2     &
655                               + 1E-30_wp                                      &
656                              )
657                ELSE
658                   rif1d(k) = g / pt_0 * flux /                                &
659                              (  ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2     &
660                               + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2     &
661                               + 1E-30_wp                                      &
662                              ) * ( 1.0_wp - 16.0_wp * rif1d(k) )**0.25_wp
663                ENDIF
664             ENDDO
665!
666!--          Richardson-numbers must remain restricted to a realistic value
667!--          range. It is exceeded excessively for very small velocities
668!--          (u,v --> 0).
669             WHERE ( rif1d < -5.0_wp )  rif1d = -5.0_wp
670             WHERE ( rif1d > 1.0_wp )  rif1d = 1.0_wp
671
672!
673!--          Compute u* from the absolute velocity value
674             IF ( constant_flux_layer )  THEN
675                uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
676
677                IF ( rif1d(nzb+1) >= 0.0_wp )  THEN
678!
679!--                Stable stratification
680                   us1d = kappa * uv_total / (                                 &
681                             LOG( zu(nzb+1) / z01d ) + 5.0_wp * rif1d(nzb+1) * &
682                                              ( zu(nzb+1) - z01d ) / zu(nzb+1) &
683                                             )
684                ELSE
685!
686!--                Unstable stratification
687                   a = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) ) )
688                   b = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) /  &
689                                                     zu(nzb+1) * z01d ) )
690                   us1d = kappa * uv_total / (                                 &
691                              LOG( (1.0_wp+b) / (1.0_wp-b) * (1.0_wp-a) /      &
692                                   (1.0_wp+a) ) +                              &
693                              2.0_wp * ( ATAN( b ) - ATAN( a ) )               &
694                                             )
695                ENDIF
696
697!
698!--             Compute the momentum fluxes for the diffusion terms
699                usws1d  = - u1d(nzb+1) / uv_total * us1d**2
700                vsws1d  = - v1d(nzb+1) / uv_total * us1d**2
701
702!
703!--             Boundary condition for the turbulent kinetic energy and
704!--             dissipation rate at the top of the constant-flux layer.
705!--             Additional Neumann condition de/dz = 0 at nzb is set to ensure
706!--             compatibility with the 3D model.
707                IF ( ibc_e_b == 2 )  THEN
708                   e1d(nzb+1) = ( us1d / c_0 )**2
709                ENDIF
710                IF ( dissipation_1d == 'prognostic' )  THEN
711                   e1d(nzb+1) = ( us1d / c_0 )**2
712                   diss1d(nzb+1) = us1d**3 / ( kappa * zu(nzb+1) )
713                   diss1d(nzb) = diss1d(nzb+1)
714                ENDIF
715                e1d(nzb) = e1d(nzb+1)
716
717                IF ( humidity ) THEN
718!
719!--                Compute q*
720                   IF ( rif1d(nzb+1) >= 0.0_wp )  THEN
721!
722!--                   Stable stratification
723                      qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) /         &
724                          ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * rif1d(nzb+1) * &
725                                          ( zu(nzb+1) - z0h1d ) / zu(nzb+1)    &
726                          )
727                   ELSE
728!
729!--                   Unstable stratification
730                      a = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) )
731                      b = SQRT( 1.0_wp - 16.0_wp * rif1d(nzb+1) /              &
732                                         zu(nzb+1) * z0h1d )
733                      qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) /         &
734                             LOG( (a-1.0_wp) / (a+1.0_wp) *                    &
735                                  (b+1.0_wp) / (b-1.0_wp) )
736                   ENDIF
737                ELSE
738                   qs1d = 0.0_wp
739                ENDIF
740
741             ENDIF   !  constant_flux_layer
742
743!
744!--          Compute the diabatic mixing length. The unstable stratification
745!--          must not be considered for l1d (km1d) as it is already considered
746!--          in the dissipation of TKE via l1d_diss. Otherwise, km1d would be
747!--          too large.
748             IF ( dissipation_1d /= 'prognostic' )  THEN
749                IF ( mixing_length_1d == 'blackadar' )  THEN
750                   DO  k = nzb+1, nzt
751                      IF ( rif1d(k) >= 0.0_wp )  THEN
752                         l1d(k) = l1d_init(k) / ( 1.0_wp + 5.0_wp * rif1d(k) )
753                         l1d_diss(k) = l1d(k)
754                      ELSE
755                         l1d(k) = l1d_init(k)
756                         l1d_diss(k) = l1d_init(k) *                           &
757                                       SQRT( 1.0_wp - 16.0_wp * rif1d(k) )
758                      ENDIF
759                   ENDDO
760                ELSEIF ( mixing_length_1d == 'as_in_3d_model' )  THEN
761                   DO  k = nzb+1, nzt
762                      dpt_dz = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
763                      IF ( dpt_dz > 0.0_wp )  THEN
764                         l_stable = 0.76_wp * SQRT( e1d(k) )                   &
765                                  / SQRT( g / pt_init(k) * dpt_dz ) + 1E-5_wp
766                      ELSE
767                         l_stable = l1d_init(k)
768                      ENDIF
769                      l1d(k) = MIN( l1d_init(k), l_stable )
770                      l1d_diss(k) = l1d(k)
771                   ENDDO
772                ENDIF
773             ELSE
774                DO  k = nzb+1, nzt
775                   l1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) )                   &
776                          / ( diss1d(k) + 1.0E-30_wp )
777                ENDDO
778             ENDIF
779
780!
781!--          Compute the diffusion coefficients for momentum via the
782!--          corresponding Prandtl-layer relationship and according to
783!--          Prandtl-Kolmogorov, respectively
784             IF ( constant_flux_layer )  THEN
785                IF ( rif1d(nzb+1) >= 0.0_wp )  THEN
786                   km1d(nzb+1) = us1d * kappa * zu(nzb+1) /                    &
787                                 ( 1.0_wp + 5.0_wp * rif1d(nzb+1) )
788                ELSE
789                   km1d(nzb+1) = us1d * kappa * zu(nzb+1) *                    &
790                                 ( 1.0_wp - 16.0_wp * rif1d(nzb+1) )**0.25_wp
791                ENDIF
792             ENDIF
793
794             IF ( dissipation_1d == 'prognostic' )  THEN
795                DO  k = nzb_diff, nzt
796                   km1d(k) = c_mu * e1d(k)**2 / ( diss1d(k) + 1.0E-30_wp )
797                ENDDO
798             ELSE
799                DO  k = nzb_diff, nzt
800                   km1d(k) = c_0 * SQRT( e1d(k) ) * l1d(k)
801                ENDDO
802             ENDIF
803
804!
805!--          Add damping layer
806             DO  k = damp_level_ind_1d+1, nzt+1
807                km1d(k) = 1.1_wp * km1d(k-1)
808                km1d(k) = MIN( km1d(k), 10.0_wp )
809             ENDDO
810
811!
812!--          Compute the diffusion coefficient for heat via the relationship
813!--          kh = phim / phih * km
814             DO  k = nzb+1, nzt
815                IF ( rif1d(k) >= 0.0_wp )  THEN
816                   kh1d(k) = km1d(k)
817                ELSE
818                   kh1d(k) = km1d(k) * ( 1.0_wp - 16.0_wp * rif1d(k) )**0.25_wp
819                ENDIF
820             ENDDO
821
822          ENDIF   ! .NOT. constant_diffusion
823
824       ENDDO   ! intermediate step loop
825
826!
827!--    Increment simulated time and output times
828       current_timestep_number_1d = current_timestep_number_1d + 1
829       simulated_time_1d          = simulated_time_1d + dt_1d
830       simulated_time_chr         = time_to_string( simulated_time_1d )
831       time_pr_1d                 = time_pr_1d          + dt_1d
832       time_run_control_1d        = time_run_control_1d + dt_1d
833
834!
835!--    Determine and print out quantities for run control
836       IF ( time_run_control_1d >= dt_run_control_1d )  THEN
837          CALL run_control_1d
838          time_run_control_1d = time_run_control_1d - dt_run_control_1d
839       ENDIF
840
841!
842!--    Profile output on file
843       IF ( time_pr_1d >= dt_pr_1d )  THEN
844          CALL print_1d_model
845          time_pr_1d = time_pr_1d - dt_pr_1d
846       ENDIF
847
848!
849!--    Determine size of next time step
850       CALL timestep_1d
851
852    ENDDO   ! time loop
853
854
855 END SUBROUTINE time_integration_1d
856
857
858!------------------------------------------------------------------------------!
859! Description:
860! ------------
861!> Compute and print out quantities for run control of the 1D model.
862!------------------------------------------------------------------------------!
863 
864 SUBROUTINE run_control_1d
865
866
867    IMPLICIT NONE
868
869    INTEGER(iwp) ::  k     !< loop index
870   
871    REAL(wp) ::  alpha     !< angle of wind vector at top of constant-flux layer
872    REAL(wp) ::  energy    !< kinetic energy
873    REAL(wp) ::  umax      !< maximum of u
874    REAL(wp) ::  uv_total  !< horizontal wind speed
875    REAL(wp) ::  vmax      !< maximum of v
876
877!
878!-- Output
879    IF ( myid == 0 )  THEN
880!
881!--    If necessary, write header
882       IF ( .NOT. run_control_header_1d )  THEN
883          CALL check_open( 15 )
884          WRITE ( 15, 100 )
885          run_control_header_1d = .TRUE.
886       ENDIF
887
888!
889!--    Compute control quantities
890!--    grid level nzp is excluded due to mirror boundary condition
891       umax = 0.0_wp; vmax = 0.0_wp; energy = 0.0_wp
892       DO  k = nzb+1, nzt+1
893          umax = MAX( ABS( umax ), ABS( u1d(k) ) )
894          vmax = MAX( ABS( vmax ), ABS( v1d(k) ) )
895          energy = energy + 0.5_wp * ( u1d(k)**2 + v1d(k)**2 )
896       ENDDO
897       energy = energy / REAL( nzt - nzb + 1, KIND=wp )
898
899       uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
900       IF ( ABS( v1d(nzb+1) ) < 1.0E-5_wp )  THEN
901          alpha = ACOS( SIGN( 1.0_wp , u1d(nzb+1) ) )
902       ELSE
903          alpha = ACOS( u1d(nzb+1) / uv_total )
904          IF ( v1d(nzb+1) <= 0.0_wp )  alpha = 2.0_wp * pi - alpha
905       ENDIF
906       alpha = alpha / ( 2.0_wp * pi ) * 360.0_wp
907
908       WRITE ( 15, 101 )  current_timestep_number_1d, simulated_time_chr, &
909                          dt_1d, umax, vmax, us1d, alpha, energy
910!
911!--    Write buffer contents to disc immediately
912       FLUSH( 15 )
913
914    ENDIF
915
916!
917!-- formats
918100 FORMAT (///'1D run control output:'/ &
919              &'------------------------------'// &
920           &'ITER.   HH:MM:SS    DT      UMAX   VMAX    U*   ALPHA   ENERG.'/ &
921           &'-------------------------------------------------------------')
922101 FORMAT (I7,1X,A9,1X,F6.2,2X,F6.2,1X,F6.2,1X,F6.3,2X,F5.1,2X,F7.2)
923
924
925 END SUBROUTINE run_control_1d
926
927
928
929!------------------------------------------------------------------------------!
930! Description:
931! ------------
932!> Compute the time step w.r.t. the diffusion criterion
933!------------------------------------------------------------------------------!
934 
935 SUBROUTINE timestep_1d
936
937    IMPLICIT NONE
938
939    INTEGER(iwp) ::  k    !< loop index
940
941    REAL(wp) ::  dt_diff  !< time step accorind to diffusion criterion
942    REAL(wp) ::  dt_old   !< previous time step
943    REAL(wp) ::  fac      !< factor of criterion
944    REAL(wp) ::  value    !< auxiliary variable
945
946!
947!-- Save previous time step
948    dt_old = dt_1d
949
950!
951!-- Compute the currently feasible time step according to the diffusion
952!-- criterion. At nzb+1 the half grid length is used.
953    fac = 0.125
954    dt_diff = dt_max_1d
955    DO  k = nzb+2, nzt
956       value   = fac * dzu(k) * dzu(k) / ( km1d(k) + 1E-20_wp )
957       dt_diff = MIN( value, dt_diff )
958    ENDDO
959    value   = fac * zu(nzb+1) * zu(nzb+1) / ( km1d(nzb+1) + 1E-20_wp )
960    dt_1d = MIN( value, dt_diff )
961
962!
963!-- Limit the new time step to a maximum of 10 times the previous time step
964    dt_1d = MIN( dt_old * 10.0_wp, dt_1d )
965
966!
967!-- Set flag when the time step becomes too small
968    IF ( dt_1d < ( 1.0E-15_wp * dt_max_1d ) )  THEN
969       stop_dt_1d = .TRUE.
970
971       WRITE( message_string, * ) 'timestep has exceeded the lower limit&',    &
972                                  'dt_1d = ',dt_1d,' s   simulation stopped!'
973       CALL message( 'timestep_1d', 'PA0192', 1, 2, 0, 6, 0 )
974       
975    ENDIF
976
977 END SUBROUTINE timestep_1d
978
979
980
981!------------------------------------------------------------------------------!
982! Description:
983! ------------
984!> List output of profiles from the 1D-model
985!------------------------------------------------------------------------------!
986 
987 SUBROUTINE print_1d_model
988
989    IMPLICIT NONE
990
991    INTEGER(iwp) ::  k  !< loop parameter
992
993    LOGICAL, SAVE :: write_first = .TRUE. !< flag for writing header
994
995
996    IF ( myid == 0 )  THEN
997!
998!--    Open list output file for profiles from the 1D-model
999       CALL check_open( 17 )
1000
1001!
1002!--    Write Header
1003       IF ( write_first )  THEN
1004          WRITE ( 17, 100 )  TRIM( run_description_header )
1005          write_first = .FALSE.
1006       ENDIF
1007
1008!
1009!--    Write the values
1010       WRITE ( 17, 104 )  TRIM( simulated_time_chr )
1011       WRITE ( 17, 101 )
1012       WRITE ( 17, 102 )
1013       WRITE ( 17, 101 )
1014       DO  k = nzt+1, nzb, -1
1015          WRITE ( 17, 103)  k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), &
1016                            rif1d(k), km1d(k), kh1d(k), l1d(k), diss1d(k)
1017       ENDDO
1018       WRITE ( 17, 101 )
1019       WRITE ( 17, 102 )
1020       WRITE ( 17, 101 )
1021
1022!
1023!--    Write buffer contents to disc immediately
1024       FLUSH( 17 )
1025
1026    ENDIF
1027
1028!
1029!-- Formats
1030100 FORMAT ('# ',A/'#',10('-')/'# 1d-model profiles')
1031104 FORMAT (//'# Time: ',A)
1032101 FORMAT ('#',111('-'))
1033102 FORMAT ('#  k     zu      u          v          pt         e          ',   &
1034            'rif        Km         Kh         l          diss   ')
1035103 FORMAT (1X,I4,1X,F7.1,9(1X,E10.3))
1036
1037
1038 END SUBROUTINE print_1d_model
1039
1040
1041 END MODULE
Note: See TracBrowser for help on using the repository browser.