source: palm/tags/release-3.2a/SOURCE/modules.f90 @ 3984

Last change on this file since 3984 was 83, checked in by raasch, 17 years ago

New:
---

Changed:


PALM can be generally installed on any kind of Linux-, IBM-AIX-, or NEC-SX-system by adding appropriate settings to the configuration file.

Scripts are also running under the public domain ksh.

All system relevant compile and link options as well as the host identifier (local_host) are specified in the configuration file.

Filetransfer by ftp removed (options -f removed from mrun and mbuild).

Call of (system-)FLUSH routine moved to new routine local_flush.

return_addres and return_username are read from ENVPAR-NAMELIST-file instead of using local_getenv.

Preprocessor strings for different linux clusters changed to "lc", some preprocessor directives renamed (new: intel_openmp_bug), preprocessor directives for old systems removed

advec_particles, check_open, cpu_log, cpu_statistics, data_output_dvrp, flow_statistics, header, init_dvrp, init_particles, init_1d_model, init_dvrp, init_pegrid, local_getenv, local_system, local_tremain, local_tremain_ini, modules, palm, parin, run_control

new:
local_flush

mbuild, mrun

Errors:


  • Property svn:keywords set to Id
File size: 45.2 KB
Line 
1 MODULE advection
2
3
4!------------------------------------------------------------------------------!
5! Actual revisions:
6! -----------------
7!
8!
9! Former revisions:
10! -----------------
11! $Id: modules.f90 83 2007-04-19 16:27:07Z hellstea $
12!
13! 82 2007-04-16 15:40:52Z raasch
14! +return_addres, return_username
15! Cpp-directive lcmuk renamed lc
16!
17! 75 2007-03-22 09:54:05Z raasch
18! +arrays precipitation_amount, precipitation_rate, precipitation_rate_av,
19! rif_wall, z0_av, +arrays u_m_l, u_m_r, etc. for radiation boundary conditions,
20! +loop_optimization, netcdf_64bit_3d, zu_s_inner, zw_w_inner, id_var_zusi_*,
21! id_var_zwwi_*, ts_value, u_nzb_p1_for_vfc, v_nzb_p1_for_vfc, pt_reference,
22! use_pt_reference, precipitation_amount_interval, revision
23! +age_m in particle_type, moisture renamed humidity,
24! -data_output_ts, dots_n, uvmean_outflow, uxrp, vynp,
25! arrays dots_label and dots_unit now dimensioned with dots_max,
26! setting of palm version moved to main program
27!
28! 37 2007-03-01 08:33:54Z raasch
29! +constant_top_heatflux, top_heatflux, use_top_fluxes, +arrays for top fluxes,
30! +nzt_diff, default of bc_pt_t renamed "initial_gradient"
31! Bugfix: p is not a pointer
32!
33! RCS Log replace by Id keyword, revision history cleaned up
34!
35! Revision 1.95  2007/02/11 13:18:30  raasch
36! version 3.1b (last under RCS control)
37!
38! Revision 1.1  1997/07/24 11:21:26  raasch
39! Initial revision
40!
41!
42! Description:
43! ------------
44! Definition of variables for special advection schemes
45!------------------------------------------------------------------------------!
46
47    REAL ::  spl_gamma_x, spl_gamma_y
48
49    REAL, DIMENSION(:), ALLOCATABLE   ::  aex, bex, dex, eex, spl_z_x, spl_z_y
50    REAL, DIMENSION(:,:), ALLOCATABLE ::  spl_tri_x, spl_tri_y, spl_tri_zu, &
51                                          spl_tri_zw
52
53    SAVE
54
55 END MODULE advection
56
57
58
59
60 MODULE array_kind
61
62!------------------------------------------------------------------------------!
63! Description:
64! ------------
65! Definition of type parameters (used for the definition of single or double
66! precision variables)
67!------------------------------------------------------------------------------!
68
69    INTEGER, PARAMETER ::  dpk = SELECTED_REAL_KIND( 12 ), &
70                           spk = SELECTED_REAL_KIND( 6 )
71
72    SAVE
73
74 END MODULE array_kind
75
76
77
78
79 MODULE arrays_3d
80
81!------------------------------------------------------------------------------!
82! Description:
83! ------------
84! Definition of all arrays defined on the computational grid
85!------------------------------------------------------------------------------!
86
87    USE array_kind
88
89    REAL, DIMENSION(:), ALLOCATABLE ::                                         &
90          ddzu, dd2zu, dzu, ddzw, dzw, km_damp_x, km_damp_y, l_grid, pt_init,  &
91          q_init, rdf, ug, u_init, u_nzb_p1_for_vfc, vg, v_init,               &
92          v_nzb_p1_for_vfc, zu, zw
93
94    REAL, DIMENSION(:,:), ALLOCATABLE ::                                       &
95          dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg, pt_slope_ref, qs, ts, us, z0
96
97    REAL, DIMENSION(:,:), ALLOCATABLE, TARGET ::                               &
98          qsws_1, qsws_2, qswst_1, qswst_2, rif_1, rif_2, shf_1, shf_2,        &
99          tswst_1, tswst_2, usws_1, usws_2, vsws_1, vsws_2
100
101    REAL, DIMENSION(:,:), POINTER ::                                           &
102          qsws, qsws_m, qswst, qswst_m, rif, rif_m, shf, shf_m, tswst,         &
103          tswst_m, usws, usws_m, vsws, vsws_m
104
105    REAL, DIMENSION(:,:,:), ALLOCATABLE ::                                     &
106          d, diss, l_wall, tend, u_m_l, u_m_n, u_m_r, u_m_s, v_m_l, v_m_n,     &
107          v_m_r, v_m_s, w_m_l, w_m_n, w_m_r, w_m_s
108
109    REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                             &
110          ql_v, ql_vp
111
112    REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::                             &
113          e_1, e_2, e_3, kh_1, kh_2, km_1, km_2, p, pt_1, pt_2, pt_3, q_1,     &
114          q_2, q_3, ql_1, ql_2, u_1, u_2, u_3, v_1, v_2, v_3, vpt_1, vpt_2,    &
115          w_1, w_2, w_3
116
117    REAL, DIMENSION(:,:,:), POINTER ::                                         &
118          e, e_m, e_p, kh, kh_m, km, km_m, pt, pt_m, pt_p, q, q_m, q_p, ql,    &
119          ql_c, te_m, tpt_m, tq_m, tu_m, tv_m, tw_m, u, u_m, u_p, v, v_m, v_p, &
120          vpt, vpt_m, w, w_m, w_p
121
122    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  rif_wall
123
124    SAVE
125
126 END MODULE arrays_3d
127
128
129
130
131 MODULE averaging
132
133!------------------------------------------------------------------------------!
134! Description:
135! ------------
136! Definition of variables needed for time-averaging of 2d/3d data
137!------------------------------------------------------------------------------!
138
139    REAL, DIMENSION(:,:), ALLOCATABLE ::  lwp_av, precipitation_rate_av, &
140                                          ts_av, us_av, z0_av
141
142    REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
143          e_av, p_av, pc_av, pr_av, pt_av, q_av, ql_av, ql_c_av, ql_v_av, &
144          ql_vp_av, qv_av, s_av, u_av, v_av, vpt_av, w_av
145
146 END MODULE averaging
147
148
149
150
151 MODULE cloud_parameters
152
153!------------------------------------------------------------------------------!
154! Description:
155! ------------
156! Definition of variables and constants for cloud physics
157!------------------------------------------------------------------------------!
158
159    REAL  ::  b_cond, cp = 1005.0, diff_coeff_l = 0.23E-4,                     &
160              effective_coll_efficiency, l_d_cp, l_d_r, l_d_rv, l_v = 2.5E+06, &
161              mass_of_solute, molecular_weight_of_solute,                      &
162              prec_time_const = 0.001, ql_crit = 0.0005, rho_l = 1.0E3,        &
163              r_d = 287.0, r_v = 461.51, rho_surface,                          &
164              thermal_conductivity_l = 2.43E-2
165
166    REAL, DIMENSION(:), ALLOCATABLE :: hydro_press, pt_d_t, t_d_pt
167
168    REAL, DIMENSION(:,:), ALLOCATABLE ::  precipitation_amount, &
169                                          precipitation_rate
170
171    SAVE
172
173 END MODULE cloud_parameters
174
175
176
177
178 MODULE constants
179
180!------------------------------------------------------------------------------!
181! Description:
182! ------------
183! Definition of general constants
184!------------------------------------------------------------------------------!
185
186    REAL    ::  pi = 3.141592654
187
188    SAVE
189
190 END MODULE constants
191
192
193
194
195 MODULE control_parameters
196
197!------------------------------------------------------------------------------!
198! Description:
199! ------------
200! Definition of parameters for program control
201!------------------------------------------------------------------------------!
202
203    TYPE plot_precision
204       CHARACTER (LEN=6) ::  variable
205       INTEGER           ::  precision
206    END TYPE plot_precision
207
208    TYPE(plot_precision), DIMENSION(100) ::  plot_3d_precision =               &
209                        (/ plot_precision( 'u', 2 ), plot_precision( 'v', 2 ), &
210                           plot_precision( 'w', 2 ), plot_precision( 'p', 5 ), &
211                           plot_precision( 'pt', 2 ),                          &
212                           ( plot_precision( ' ', 1 ), i9 = 1,95 ) /)
213
214    TYPE file_status
215       LOGICAL ::  opened, opened_before
216    END TYPE file_status
217
218    TYPE(file_status), DIMENSION(200) :: openfile = file_status(.FALSE.,.FALSE.)
219
220
221    CHARACTER (LEN=1)   ::  cycle_mg = 'w', timestep_reason = ' '
222    CHARACTER (LEN=5)   ::  write_binary = 'false'
223    CHARACTER (LEN=6)   ::  grid_matching = 'match'
224    CHARACTER (LEN=8)   ::  run_date, run_time
225    CHARACTER (LEN=9)   ::  simulated_time_chr
226    CHARACTER (LEN=12)  ::  version = ' ', revision = ' '
227    CHARACTER (LEN=16)  ::  loop_optimization = 'default', &
228                            momentum_advec = 'pw-scheme', &
229                            psolver = 'poisfft', &
230                            scalar_advec = 'pw-scheme'
231    CHARACTER (LEN=20)  ::  bc_e_b = 'neumann', bc_lr = 'cyclic', &
232                            bc_ns = 'cyclic', bc_p_b = 'neumann', &
233                            bc_p_t = 'dirichlet', bc_pt_b = 'dirichlet', &
234                            bc_pt_t = 'initial_gradient', &
235                            bc_q_b = 'dirichlet', bc_q_t = 'neumann', &
236                            bc_s_b = 'dirichlet', bc_s_t = 'neumann', &
237                            bc_uv_b = 'dirichlet', bc_uv_t = 'dirichlet', &
238                            dissipation_1d = 'as_in_3d_model', &
239                            fft_method = 'system-specific', &
240                            mixing_length_1d = 'as_in_3d_model', &
241                            random_generator = 'numerical-recipes', &
242                            return_addres, return_username, &
243                            timestep_scheme = 'runge-kutta-3'
244    CHARACTER (LEN=40)  ::  avs_data_file, topography = 'flat'
245    CHARACTER (LEN=64)  ::  host
246    CHARACTER (LEN=80)  ::  log_message, run_identifier
247    CHARACTER (LEN=100) ::  initializing_actions = ' ', run_description_header
248
249    CHARACTER (LEN=7),  DIMENSION(100) ::  do3d_comp_prec = ' '
250    CHARACTER (LEN=10), DIMENSION(10)  ::  data_output_format = ' '
251    CHARACTER (LEN=10), DIMENSION(100) ::  data_output = ' ',    &
252                                           data_output_pr = ' ', &
253                                           data_output_user = ' ', doav = ' '
254    CHARACTER (LEN=20), DIMENSION(10)  ::  netcdf_precision = ' '
255
256    CHARACTER (LEN=10), DIMENSION(0:1,100) ::  do2d = ' ', do3d = ' '
257
258    INTEGER ::  average_count_pr = 0, average_count_sp = 0, &
259                average_count_3d = 0, current_timestep_number = 0, &
260                dist_range = 0, disturbance_level_ind_b, &
261                disturbance_level_ind_t, doav_n = 0, dopr_n = 0, &
262                dopr_time_count = 0, dopts_time_count = 0, &
263                dosp_time_count = 0, dots_time_count = 0, &
264                do2d_xy_n = 0, do2d_xz_n = 0, do2d_yz_n = 0, do3d_avs_n = 0, &
265                dvrp_filecount = 0, dz_stretch_level_index, gamma_mg, &
266                grid_level, ibc_e_b, ibc_p_b, ibc_p_t, ibc_pt_b, ibc_pt_t, &
267                ibc_q_b, ibc_q_t, ibc_uv_b, ibc_uv_t, &
268                inflow_disturbance_begin = -1, inflow_disturbance_end = -1, &
269                intermediate_timestep_count, intermediate_timestep_count_max, &
270                iran = -1234567, last_dt_change = 0, maximum_grid_level, &
271                mgcycles = 0, mg_cycles = -1, mg_switch_to_pe0_level = 0, &
272                ngsrb = 2, nsor = 20, nsor_ini = 100, n_sor, &
273                normalizing_region = 0, nz_do1d, nz_do3d = -9999, &
274                outflow_damping_width = -1, prt_time_count = 0, runnr = 0, &
275                skip_do_avs = 0, timestep_count = 0
276
277    INTEGER ::  dist_nxl(0:1), dist_nxr(0:1), dist_nyn(0:1), dist_nys(0:1), &
278                do2d_no(0:1) = 0, do2d_xy_time_count(0:1), &
279                do2d_xz_time_count(0:1), do2d_yz_time_count(0:1), &
280                do3d_no(0:1) = 0, do3d_time_count(0:1), &
281                pt_vertical_gradient_level_ind(10) = -9999, &
282                q_vertical_gradient_level_ind(10) = -9999, &
283                section(100,3), section_xy(100) = -9999, &
284                section_xz(100) = -9999, section_yz(100) = -9999, &
285                ug_vertical_gradient_level_ind(10) = -9999, &
286                vg_vertical_gradient_level_ind(10) = -9999
287
288    INTEGER, DIMENSION(:), ALLOCATABLE ::  grid_level_count
289
290    LOGICAL ::  adjust_mixing_length = .FALSE., avs_output = .FALSE., &
291                call_psolver_at_all_substeps = .TRUE., &
292                cloud_droplets = .FALSE., cloud_physics = .FALSE., &
293                conserve_volume_flow = .FALSE., constant_diffusion = .FALSE., &
294                constant_heatflux = .TRUE., constant_top_heatflux = .TRUE., &
295                constant_waterflux = .TRUE., create_disturbances = .TRUE., &
296                cut_spline_overshoot = .TRUE., &
297                data_output_2d_on_each_pe = .TRUE., do2d_at_begin = .FALSE., &
298                do3d_at_begin = .FALSE., do3d_compress = .FALSE., &
299                do_sum = .FALSE., dt_changed = .FALSE., dt_fixed = .FALSE., &
300                disturbance_created = .FALSE., &
301                first_call_advec_particles = .TRUE., &
302                force_print_header = .FALSE., galilei_transformation = .FALSE.,&
303                humidity = .FALSE., inflow_l = .FALSE., inflow_n = .FALSE., &
304                inflow_r = .FALSE., inflow_s = .FALSE., iso2d_output = .FALSE.,&
305                mg_switch_to_pe0 = .FALSE., &
306                netcdf_output = .FALSE., netcdf_64bit = .FALSE., &
307                netcdf_64bit_3d = .TRUE., &
308                outflow_l = .FALSE., outflow_n = .FALSE., outflow_r = .FALSE., &
309                outflow_s = .FALSE., passive_scalar = .FALSE., &
310                prandtl_layer = .TRUE., precipitation = .FALSE., &
311                profil_output = .FALSE., radiation = .FALSE., &
312                random_heatflux = .FALSE., run_control_header = .FALSE., &
313                sloping_surface = .FALSE., stop_dt = .FALSE., &
314                terminate_run = .FALSE., use_prior_plot1d_parameters = .FALSE.,&
315                use_pt_reference = .FALSE., use_surface_fluxes = .FALSE., &
316                use_top_fluxes = .FALSE., use_ug_for_galilei_tr = .TRUE., &
317                use_upstream_for_tke = .FALSE., wall_adjustment = .TRUE.
318
319    LOGICAL ::  data_output_xy(0:1) = .FALSE., data_output_xz(0:1) = .FALSE., &
320                data_output_yz(0:1) = .FALSE.
321
322    REAL ::  advected_distance_x = 0.0, advected_distance_y = 0.0, &
323             alpha_surface = 0.0, asselin_filter_factor = 0.1, &
324             averaging_interval = 0.0, averaging_interval_pr = 9999999.9, &
325             averaging_interval_sp = 9999999.9, bc_pt_t_val, bc_q_t_val, &
326             building_height = 50.0, building_length_x = 50.0, &
327             building_length_y = 50.0, building_wall_left = 9999999.9, &
328             building_wall_south = 9999999.9, cfl_factor = -1.0, &
329             cos_alpha_surface, disturbance_amplitude = 0.25, &
330             disturbance_energy_limit = 0.01, disturbance_level_b = -1.0, &
331             disturbance_level_t = -1.0, dt = -1.0, dt_averaging_input = 0.0, &
332             dt_averaging_input_pr = 9999999.9, dt_data_output = 9999999.9, &
333             dt_data_output_av = 9999999.9, dt_disturb = 9999999.9, &
334             dt_dopr = 9999999.9, dt_dopr_listing = 9999999.9, &
335             dt_dopts = 9999999.9, dt_dosp = 9999999.9, dt_dots = 9999999.9, &
336             dt_do2d_xy = 9999999.9, dt_do2d_xz = 9999999.9, &
337             dt_do2d_yz = 9999999.9, dt_do3d = 9999999.9, dt_dvrp = 9999999.9, &
338             dt_max = 20.0, dt_prel = 9999999.9, dt_restart = 9999999.9, &
339             dt_run_control = 60.0, dt_3d = -1.0, dz = -1.0, &
340             dz_max = 9999999.9, dz_stretch_factor = 1.08, &
341             dz_stretch_level = 100000.0, e_min = 0.0, end_time = 0.0, &
342             f = 0.0, fs = 0.0, g = 9.81, kappa = 0.4, km_constant = -1.0, &
343             km_damp_max = -1.0, long_filter_factor = 0.0, &
344             maximum_cpu_time_allowed = 0.0, molecular_viscosity = 1.461E-5, &
345             old_dt = 1.0E-10, omega = 7.29212E-5, omega_sor = 1.8, &
346             overshoot_limit_e = 0.0, overshoot_limit_pt = 0.0, &
347             overshoot_limit_u = 0.0, overshoot_limit_v = 0.0, &
348             overshoot_limit_w = 0.0, particle_maximum_age = 9999999.9, &
349             phi = 55.0, prandtl_number = 1.0, &
350             precipitation_amount_interval = 9999999.9, &
351             pt_reference = 9999999.9, &
352             pt_slope_offset = 0.0, pt_surface = 300.0, &
353             pt_surface_initial_change = 0.0, q_surface = 0.0, &
354             q_surface_initial_change = 0.0, rayleigh_damping_factor = -1.0, &
355             rayleigh_damping_height = -1.0, residual_limit = 1.0E-4, &
356             restart_time = 9999999.9, rif_max = 1.0, rif_min = -5.0, &
357             roughness_length = 0.1, simulated_time = 0.0, &
358             simulated_time_at_begin, sin_alpha_surface, &
359             skip_time_data_output = 0.0, skip_time_data_output_av = 9999999.9,&
360             skip_time_dopr = 9999999.9, skip_time_dosp = 9999999.9, &
361             skip_time_do2d_xy = 9999999.9, skip_time_do2d_xz = 9999999.9, &
362             skip_time_do2d_yz = 9999999.9, skip_time_do3d = 9999999.9, &
363             surface_heatflux = 9999999.9, surface_pressure = 1013.25, &
364             surface_scalarflux = 0.0, surface_waterflux = 0.0, &
365             s_surface = 0.0, s_surface_initial_change = 0.0, &
366             termination_time_needed = -1.0, time_disturb = 0.0, &
367             time_dopr = 0.0, time_dopr_av = 0.0, time_dopr_listing = 0.0, &
368             time_dopts = 0.0, time_dosp = 0.0, time_dosp_av = 0.0, &
369             time_dots = 0.0, time_do2d_xy = 0.0, time_do2d_xz = 0.0, &
370             time_do2d_yz = 0.0, time_do3d = 0.0, time_do_av = 0.0, &
371             time_do_sla = 0.0, time_dvrp = 0.0, time_prel = 0.0, &
372             time_restart = 9999999.9, time_run_control = 0.0, &
373             top_heatflux = 9999999.9, ug_surface = 0.0, u_gtrans = 0.0, &
374             ups_limit_e = 0.0, ups_limit_pt = 0.0, ups_limit_u = 0.0, &
375             ups_limit_v = 0.0, ups_limit_w = 0.0, vg_surface = 0.0, &
376             v_gtrans = 0.0, wall_adjustment_factor = 1.8, z_max_do1d = -1.0, &
377             z_max_do1d_normalized = -1.0, z_max_do2d = -1.0
378
379    REAL ::  do2d_xy_last_time(0:1) = -1.0, do2d_xz_last_time(0:1) = -1.0, &
380             do2d_yz_last_time(0:1) = -1.0, pt_vertical_gradient(10) = 0.0, &
381             pt_vertical_gradient_level(10) = -1.0, &
382             q_vertical_gradient(10) = 0.0, &
383             q_vertical_gradient_level(10) = -1.0, &
384             s_vertical_gradient(10) = 0.0, &
385             s_vertical_gradient_level(10) = -1.0, threshold(20) = 0.0, &
386             tsc(10) = (/ 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /), &
387             ug_vertical_gradient(10) = 0.0, &
388             ug_vertical_gradient_level(10) = -1.0, &
389             vg_vertical_gradient(10) = 0.0, &
390             vg_vertical_gradient_level(10) = -1.0, &
391             volume_flow(1:2) = 0.0, volume_flow_area(1:2) = 0.0, &
392             volume_flow_initial(1:2) = 0.0, wall_heatflux(0:4) = 0.0
393
394
395    SAVE
396
397 END MODULE control_parameters
398
399
400
401
402 MODULE cpulog
403
404!------------------------------------------------------------------------------!
405! Description:
406! ------------
407! Definition of variables for cpu-time measurements
408!------------------------------------------------------------------------------!
409
410    REAL ::  initial_wallclock_time
411
412    TYPE logpoint
413       REAL               ::  isum, ivect, mean, mtime, mtimevec, sum, vector
414       INTEGER            ::  counts
415       CHARACTER (LEN=20) ::  place
416    END TYPE logpoint
417
418    TYPE(logpoint), DIMENSION(100) ::  log_point = logpoint( 0.0, 0.0, 0.0,   &
419                                       0.0, 0.0, 0.0, 0.0, 0, ' ' ),          &
420                                       log_point_s = logpoint( 0.0, 0.0, 0.0, &
421                                       0.0, 0.0, 0.0, 0.0, 0, ' ' )
422
423    SAVE
424
425 END MODULE cpulog
426
427
428
429
430 MODULE dvrp_variables
431
432!------------------------------------------------------------------------------!
433! Description:
434! ------------
435! Definition of variables used with dvrp-software
436!------------------------------------------------------------------------------!
437
438    CHARACTER (LEN=10) ::  dvrp_output = 'rtsp'
439
440    CHARACTER (LEN=20), DIMENSION(10) ::  mode_dvrp = &
441                                     (/ ( '                    ', i9 = 1,10 ) /)
442
443    CHARACTER (LEN=80) ::  dvrp_directory = 'default',                    &
444                           dvrp_file      = 'default',                    &
445                           dvrp_host      = 'origin.rvs.uni-hannover.de', &
446                           dvrp_password  = '********',                   &
447                           dvrp_username  = ' '
448
449    INTEGER ::  dvrp_colourtable_entries = 4, islice_dvrp, nx_dvrp, ny_dvrp, &
450                nz_dvrp
451
452    INTEGER, DIMENSION(10) ::  slicer_position_dvrp
453
454    LOGICAL ::  cyclic_dvrp = .FALSE., lock_steering_update = .FALSE., &
455                use_seperate_pe_for_dvrp_output = .FALSE.
456
457    REAL    ::  superelevation = 1.0, superelevation_x = 1.0, &
458                superelevation_y = 1.0
459
460#if defined( __decalpha )
461    REAL, DIMENSION(2,10)  ::  slicer_range_limits_dvrp = (/ &
462                                -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
463                                -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
464                                -1.0, 1.0, -1.0, 1.0 /)
465
466    REAL, DIMENSION(2,100) ::  interval_values_dvrp, interval_h_dvrp =       &
467                               (/ 270.0, 225.0, 225.0, 180.0, 70.0, 25.0,    &
468                                  25.0, -25.0, ( 0.0, i9 = 1, 192 ) /),      &
469                               interval_l_dvrp = 0.5, interval_s_dvrp = 1.0, &
470                               interval_a_dvrp = 0.0
471#else
472    REAL, DIMENSION(2,10)  ::  slicer_range_limits_dvrp
473
474    REAL, DIMENSION(2,100) ::  interval_values_dvrp, interval_h_dvrp,        &
475                               interval_l_dvrp = 0.5, interval_s_dvrp = 1.0, &
476                               interval_a_dvrp = 0.0
477
478    DATA  slicer_range_limits_dvrp / -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
479                                     -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
480                                     -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
481                                     -1.0, 1.0 /
482
483    DATA  interval_h_dvrp / 270.0, 225.0, 225.0, 180.0, 70.0, 25.0, &
484                            25.0, -25.0, 192 * 0.0 /
485#endif
486
487    REAL, DIMENSION(:), ALLOCATABLE ::  xcoor_dvrp, ycoor_dvrp, zcoor_dvrp
488
489    TYPE steering
490       CHARACTER (LEN=20) ::  name
491       REAL               ::  min, max
492       INTEGER            ::  imin, imax
493    END TYPE steering
494
495    TYPE(steering), DIMENSION(:), ALLOCATABLE ::  steering_dvrp
496
497    SAVE
498
499 END MODULE dvrp_variables
500
501
502
503
504 MODULE grid_variables
505
506!------------------------------------------------------------------------------!
507! Description:
508! ------------
509! Definition of grid spacings
510!------------------------------------------------------------------------------!
511
512    REAL ::  ddx, ddx2, dx = 1.0, dx2, ddy, ddy2, dy = 1.0, dy2
513
514    REAL, DIMENSION(:), ALLOCATABLE ::  ddx2_mg, ddy2_mg
515
516    REAL, DIMENSION(:,:), ALLOCATABLE ::  fwxm, fwxp, fwym, fwyp, fxm, fxp,   &
517                                          fym, fyp, wall_e_x, wall_e_y,       &
518                                          wall_u, wall_v, wall_w_x, wall_w_y, &
519                                          zu_s_inner, zw_w_inner
520
521    SAVE
522
523 END MODULE grid_variables
524
525
526
527
528 MODULE indices
529
530!------------------------------------------------------------------------------!
531! Description:
532! ------------
533! Definition of array bounds and number of gridpoints
534!------------------------------------------------------------------------------!
535
536    INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxr, nxra, nny, ny = 0, nya,  &
537                nyn, nyna, nys, nnz, nz = 0, nza, nzb, nzb_diff, nzt, nzta,    &
538                nzt_diff
539
540    INTEGER, DIMENSION(:), ALLOCATABLE ::                                      &
541                ngp_2dh, ngp_3d, ngp_3d_inner,                                 &
542                nnx_pe, nny_pe, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg
543
544    INTEGER, DIMENSION(:,:), ALLOCATABLE ::                                    &
545                ngp_2dh_outer, mg_loc_ind, nzb_diff_s_inner, nzb_diff_s_outer, &
546                nzb_diff_u, nzb_diff_v, nzb_inner, nzb_outer, nzb_s_inner,     &
547                nzb_s_outer, nzb_u_inner, nzb_u_outer, nzb_v_inner,            &
548                nzb_v_outer, nzb_w_inner, nzb_w_outer, nzb_2d
549
550    SAVE
551
552 END MODULE indices
553
554
555
556
557 MODULE interfaces
558
559!------------------------------------------------------------------------------!
560! Description:
561! ------------
562! Interfaces for special subroutines which use optional parameters
563!------------------------------------------------------------------------------!
564
565    INTERFACE
566
567       SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
568
569          USE cpulog
570
571          CHARACTER (LEN=*)           ::  modus, place
572          CHARACTER (LEN=*), OPTIONAL ::  barrierwait
573          TYPE(logpoint)              ::  log_event
574
575       END SUBROUTINE cpu_log
576
577    END INTERFACE
578
579
580
581    INTERFACE
582
583       SUBROUTINE global_min_max ( i1, i2, j1, j2, k1, k2, feld, mode, wert, &
584                                   wert_ijk, wert1, wert1_ijk )
585          CHARACTER (LEN=*), INTENT(IN) ::  mode
586          INTEGER, INTENT(IN)           ::  i1, i2, j1, j2, k1, k2
587          INTEGER                       ::  wert_ijk(3)
588          INTEGER, OPTIONAL             ::  wert1_ijk(3)
589          REAL                          ::  wert
590          REAL, OPTIONAL                ::  wert1
591          REAL, INTENT(IN)              ::  feld(i1:i2,j1:j2,k1:k2)
592
593       END SUBROUTINE global_min_max
594
595    END INTERFACE
596
597    SAVE
598
599 END MODULE interfaces
600
601
602
603 MODULE pointer_interfaces
604
605!------------------------------------------------------------------------------!
606! Description:
607! ------------
608! Interfaces for subroutines with pointer arguments called in
609! prognostic_equations
610!------------------------------------------------------------------------------!
611
612    INTERFACE
613
614       SUBROUTINE advec_s_bc( sk, sk_char )
615
616          CHARACTER (LEN=*), INTENT(IN)   ::  sk_char
617          REAL, DIMENSION(:,:,:), POINTER ::  sk
618
619       END SUBROUTINE advec_s_bc
620
621    END INTERFACE
622
623
624    SAVE
625
626 END MODULE pointer_interfaces
627
628
629
630
631 MODULE model_1d
632
633!------------------------------------------------------------------------------!
634! Description:
635! ------------
636! Definition of variables for the 1D-model
637!------------------------------------------------------------------------------!
638
639    INTEGER ::  current_timestep_number_1d = 0, damp_level_ind_1d, &
640                last_dt_change_1d = 0 
641
642    LOGICAL ::  run_control_header_1d = .FALSE., stop_dt_1d = .FALSE. 
643
644    REAL ::     damp_level_1d = -1.0, dt_1d = 60.0, dt_max_1d = 300.0, &
645                dt_pr_1d = 9999999.9, dt_run_control_1d = 60.0, &
646                end_time_1d = 864000.0, old_dt_1d = 1.0E-10, &
647                qs1d, simulated_time_1d = 0.0, time_pr_1d = 0.0, &
648                time_run_control_1d = 0.0, ts1d, us1d, usws1d, usws1d_m, &
649                vsws1d, vsws1d_m, z01d
650
651
652    REAL, DIMENSION(:), ALLOCATABLE ::  e1d, e1d_m, e1d_p, kh1d, kh1d_m, km1d, &
653                                        km1d_m, l_black, l1d, l1d_m, rif1d,    &
654                                        te_e, te_em, te_u, te_um, te_v, te_vm, &
655                                        u1d, u1d_m, u1d_p, v1d, v1d_m, v1d_p
656
657    SAVE
658
659 END MODULE model_1d
660
661
662
663
664 MODULE netcdf_control
665
666!------------------------------------------------------------------------------!
667! Description:
668! ------------
669! Definition of parameters and variables for netcdf control.
670!------------------------------------------------------------------------------!
671
672#if defined( __netcdf )
673    USE netcdf
674#endif
675
676    INTEGER, PARAMETER ::  dopr_norm_num = 7, dopts_num = 26, dots_max = 100, &
677                           replace_num = 6
678
679    INTEGER ::  dots_num = 22
680
681    CHARACTER, DIMENSION( replace_num ) :: &
682                           replace_char = (/ '''', '"', '*', '/', '(', ')' /), &
683                           replace_by   = (/ 'p' , 'p', 's', 'o', '_', '_' /)
684
685    CHARACTER (LEN=6), DIMENSION(dopr_norm_num) ::  dopr_norm_names =   &
686         (/ 'wpt0  ', 'ws2   ', 'tsw2  ', 'ws3   ', 'ws2tsw', 'wstsw2', &
687            'z_i   ' /)
688
689    CHARACTER (LEN=6), DIMENSION(dopr_norm_num) ::  dopr_norm_longnames = &
690         (/ 'wpt0  ', 'w*2   ', 't*w2  ', 'w*3   ', 'w*2t*w', 'w*t*w2',   &
691            'z_i   ' /)
692
693    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label = &
694          (/ 'tnpt   ', 'x_     ', 'y_     ', 'z_     ', 'z_abs  ', 'u      ', &
695             'v      ', 'w      ', 'u"     ', 'v"     ', 'w"     ', 'npt_up ', &
696             'w_up   ', 'w_down ', 'npt_max', 'npt_min', 'x*2    ', 'y*2    ', &
697             'z*2    ', 'u*2    ', 'v*2    ', 'w*2    ', 'u"2    ', 'v"2    ', &
698             'w"2    ', 'npt*2  ' /)
699
700    CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit = &
701          (/ 'number ', 'm      ', 'm      ', 'm      ', 'm      ', 'm/s    ', &
702             'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'm/s    ', 'number ', &
703             'm/s    ', 'm/s    ', 'number ', 'number ', 'm2     ', 'm2     ', &
704             'm2     ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', 'm2/s2  ', &
705             'm2/s2  ', 'number2' /)
706
707    CHARACTER (LEN=7), DIMENSION(dots_max) :: dots_label = &
708          (/ 'E      ', 'E*     ', 'dt     ', 'u*     ', 'th*    ', 'umax   ', &
709             'vmax   ', 'wmax   ', 'div_new', 'div_old', 'z_i_wpt', 'z_i_pt ', &
710             'w*     ', 'w"pt"0 ', 'w"pt"  ', 'wpt    ', 'pt(0)  ', 'pt(zp) ', &
711             'splptx ', 'splpty ', 'splptz ', 'mo_L   ',                       &
712             ( 'unknown', i9 = 1, 78) /)
713
714    CHARACTER (LEN=7), DIMENSION(dots_max) :: dots_unit = &
715          (/ 'm2/s2  ', 'm2/s2  ', 's      ', 'm/s    ', 'K      ', 'm/s    ', &
716             'm/s    ', 'm/s    ', 's-1    ', 's-1    ', 'm      ', 'm      ', &
717             'm/s    ', 'K m/s  ', 'K m/s  ', 'k m/s  ', 'K      ', 'K      ', &
718             '%      ', '%      ', '%      ', 'm      ',                       &
719             ( 'unknown', i9 = 1, 78 ) /)
720
721    CHARACTER (LEN=7), DIMENSION(100) ::  dopr_unit = 'unknown'
722
723    CHARACTER (LEN=7), DIMENSION(0:1,100) ::  do2d_unit, do3d_unit
724
725    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_names = &
726          (/ 'pt_age          ', 'pt_dvrp_size    ', 'pt_origin_x     ', &
727             'pt_origin_y     ', 'pt_origin_z     ', 'pt_radius       ', &
728             'pt_speed_x      ', 'pt_speed_y      ', 'pt_speed_z      ', &
729             'pt_weight_factor', 'pt_x            ', 'pt_y            ', &
730             'pt_z            ', 'pt_color        ', 'pt_group        ', &
731             'pt_tailpoints   ', 'pt_tail_id      ', 'pt_density_ratio', &
732             'pt_exp_arg      ', 'pt_exp_term     ', 'not_used        ', &
733             'not_used        ', 'not_used        ', 'not_used        ', &
734             'not_used        ' /)
735
736    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_units = &
737          (/ 'seconds         ', 'meters          ', 'meters          ', &
738             'meters          ', 'meters          ', 'meters          ', &
739             'm/s             ', 'm/s             ', 'm/s             ', &
740             'factor          ', 'meters          ', 'meters          ', &
741             'meters          ', 'none            ', 'none            ', &
742             'none            ', 'none            ', 'ratio           ', &
743             'none            ', 'none            ', 'not_used        ', &
744             'not_used        ', 'not_used        ', 'not_used        ', &
745             'not_used        ' /)
746
747    INTEGER ::  id_dim_prtnum, id_dim_time_pr, id_dim_time_prt, &
748                id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, &
749                id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, id_set_pr, &
750                id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_var_prtnum, &
751                id_var_rnop_prt, id_var_time_pr, id_var_time_prt, &
752                id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
753                id_var_y_sp, id_var_zu_sp, id_var_zw_sp, nc_stat
754
755    INTEGER, DIMENSION(0:1) ::  id_dim_time_xy, id_dim_time_xz, &
756                id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
757                id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
758                id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
759                id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
760                id_dim_y_3d, id_dim_yv_3d, id_dim_zu_xy, id_dim_zu1_xy, &
761                id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
762                id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
763                id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
764                id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
765                id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
766                id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
767                id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
768                id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
769                id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zusi_xy, &
770                id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &
771                id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, &
772                id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
773
774    INTEGER, DIMENSION(10)  ::  id_var_dospx, id_var_dospy, nc_precision 
775    INTEGER, DIMENSION(20)  ::  id_var_prt
776    INTEGER, DIMENSION(dopr_norm_num) ::  id_var_norm_dopr
777
778    INTEGER, DIMENSION(dopts_num,0:10) ::  id_var_dopts
779    INTEGER, DIMENSION(0:1,100)        ::  id_var_do2d, id_var_do3d
780    INTEGER, DIMENSION(100,0:9)        ::  id_dim_z_pr, id_var_dopr, &
781                                           id_var_z_pr
782    INTEGER, DIMENSION(dots_max,0:9)   ::  id_var_dots
783
784
785    SAVE
786
787 END MODULE netcdf_control
788
789
790
791 MODULE particle_attributes
792
793!------------------------------------------------------------------------------!
794! Description:
795! ------------
796! Definition of variables used to compute particle transport
797!------------------------------------------------------------------------------!
798
799    USE array_kind
800
801    CHARACTER (LEN=15)  ::  bc_par_lr = 'cyclic',  bc_par_ns = 'cyclic', &
802                            bc_par_b  = 'reflect', bc_par_t  = 'absorb'
803
804#if defined( __parallel )
805    INTEGER ::  mpi_particle_type
806#endif
807    INTEGER ::  ibc_par_lr, ibc_par_ns, ibc_par_b, ibc_par_t,                  &
808                iran_part = -1234567, maximum_number_of_particles = 1000,      &
809                maximum_number_of_tailpoints = 100,                            &
810                maximum_number_of_tails = 0,                                   &
811                number_of_initial_particles = 0, number_of_particles = 0,      &
812                number_of_particle_groups = 1, number_of_tails = 0,            &
813                number_of_initial_tails = 0, particles_per_point = 1,          &
814                particle_file_count = 0, skip_particles_for_tail = 100,        &
815                total_number_of_particles, total_number_of_tails = 0
816
817    INTEGER, PARAMETER ::  max_number_of_particle_groups = 10
818
819    INTEGER, DIMENSION(:), ALLOCATABLE     ::  new_tail_id
820    INTEGER, DIMENSION(:,:,:), ALLOCATABLE ::  prt_count, prt_start_index
821
822    LOGICAL ::  particle_advection = .FALSE., random_start_position = .FALSE., &
823                read_particles_from_restartfile = .TRUE.,                      &
824                uniform_particles = .TRUE., use_particle_tails = .FALSE.,      &
825                use_sgs_for_particles = .FALSE.,                               &
826                vertical_particle_advection = .TRUE.,                          &
827                write_particle_statistics = .FALSE.
828    LOGICAL, DIMENSION(:), ALLOCATABLE ::  particle_mask, tail_mask
829
830    REAL    ::  c_0 = 3.0, dt_min_part = 0.0002,                               &
831                dt_write_particle_data = 9999999.9, dvrp_psize = 9999999.9,    &
832                end_time_prel = 9999999.9, initial_weighting_factor = 1.0,     &
833                maximum_tailpoint_age = 100000.0,                              &
834                minimum_tailpoint_distance = 0.0,                              &
835                particle_advection_start = 0.0, sgs_wfu_part = 0.3333333,      &
836                sgs_wfv_part = 0.3333333, sgs_wfw_part = 0.3333333,            &
837                time_write_particle_data = 0.0
838
839    REAL, DIMENSION(max_number_of_particle_groups) ::  &
840                density_ratio = 9999999.9, pdx = 9999999.9, pdy = 9999999.9, &
841                pdz = 9999999.9, psb = 9999999.9, psl = 9999999.9,           &
842                psn = 9999999.9, psr = 9999999.9, pss = 9999999.9,           &
843                pst = 9999999.9, radius = 9999999.9
844
845    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  particle_tail_coordinates
846
847
848    TYPE particle_type
849       SEQUENCE
850       REAL    ::  age, age_m, dt_sum, dvrp_psize, e_m, origin_x, origin_y, &
851                   origin_z, radius, speed_x, speed_x_sgs, speed_y,         &
852                   speed_y_sgs, speed_z, speed_z_sgs, weight_factor, x, y, z
853       INTEGER ::  color, group, tailpoints, tail_id
854    END TYPE particle_type
855
856    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  initial_particles, &
857                                                       particles
858
859    TYPE particle_groups_type
860       SEQUENCE
861       REAL    ::  density_ratio, radius, exp_arg, exp_term
862    END TYPE particle_groups_type
863
864    TYPE(particle_groups_type), DIMENSION(max_number_of_particle_groups) ::&
865                   particle_groups
866
867    SAVE
868
869 END MODULE particle_attributes
870
871
872
873
874
875 MODULE pegrid
876
877!------------------------------------------------------------------------------!
878! Description:
879! ------------
880! Definition of variables which define processor topology and the exchange of
881! ghost point layers. This modules must be placed in all routines which contain
882! MPI-calls.
883!------------------------------------------------------------------------------!
884
885#if defined( __parallel )
886#if defined( __lc )
887    USE MPI
888#else
889    INCLUDE "mpif.h"
890#endif
891#endif
892    CHARACTER(LEN=5)       ::  myid_char = '', myid_char_14 = ''
893    INTEGER                ::  myid=0, npex = -1, npey = -1, numprocs = 1, &
894                               tasks_per_node = -9999, threads_per_task = 1
895
896#if defined( __parallel )
897    INTEGER ::  comm1dx, comm1dy, comm2d, comm_palm, ierr, myidx, myidy,       &
898                ndim = 2, ngp_y, pleft, pnorth, pright, psouth,                &
899                sendrecvcount_xy, sendrecvcount_yz, sendrecvcount_zx,          &
900                sendrecvcount_zyd, sendrecvcount_yxd,                          &
901                type_x, type_x_int, ibuf(12), pcoord(2), pdims(2),             &
902                status(MPI_STATUS_SIZE)
903
904    INTEGER, DIMENSION(:), ALLOCATABLE ::  ngp_yz, type_xz
905
906    LOGICAL ::  reorder = .TRUE.
907    LOGICAL, DIMENSION(2) ::  cyclic = (/ .TRUE. , .TRUE. /), &
908                              remain_dims
909#endif
910
911    SAVE
912
913 END MODULE pegrid
914
915
916
917
918 MODULE profil_parameter
919
920!------------------------------------------------------------------------------!
921! Description:
922! ------------
923! Definition of variables which control PROFIL-output
924!------------------------------------------------------------------------------!
925
926    INTEGER, PARAMETER ::  crmax = 100
927
928    CHARACTER (LEN=10), DIMENSION(100) ::  dopr_label = ' '
929
930    CHARACTER (LEN=10), DIMENSION(crmax) ::  cross_normalized_x = ' ', &
931                                             cross_normalized_y = ' '
932
933    CHARACTER (LEN=20), DIMENSION(20) ::  cross_ts_profiles = &
934                           (/ ' E E*               ', ' dt                 ', &
935                              ' u* w*              ', ' th*                ', &
936                              ' umax vmax wmax     ', ' div_old div_new    ', &
937                              ' z_i_wpt z_i_pt     ', ' w"pt"0 w"pt" wpt   ', &
938                              ' pt(0) pt(zp)       ', ' splux spluy spluz  ', &
939                              ' L                  ',                         &
940                            ( '                    ', i9 = 1, 9 ) /)
941
942    CHARACTER (LEN=40), DIMENSION(crmax) ::  cross_xtext = &
943                           (/ 'windspeed in ms>->1         ', &
944                              'pot. temperature in K       ', &
945                              'heat flux in K ms>->1       ', &
946                              'momentum flux in m>2s>2     ', &
947                              'eddy diffusivity in m>2s>->1', &
948                              'mixing length in m          ', &
949                            ( '                            ', i9 = 1, 94 ) /)
950
951    CHARACTER (LEN=100), DIMENSION(crmax) ::  cross_profiles = &
952                           (/ ' u v                           ', &
953                              ' pt                            ', &
954                              ' w"pt" w*pt* w*pt*BC wpt wptBC ', &
955                              ' w"u" w*u* wu w"v" w*v* wv     ', &
956                              ' km kh                         ', &
957                              ' l                             ', &
958                         ( '                               ', i9 = 1, 94 ) /)
959
960    INTEGER ::  profile_columns = 3, profile_rows = 2, profile_number = 0
961
962    INTEGER ::  cross_linecolors(100,crmax) = 1, &
963                cross_linestyles(100,crmax) = 0, &
964                cross_profile_numbers(100,crmax) = 0, &
965                cross_pnc_local(crmax), cross_profile_number_count(crmax) = 0, &
966                cross_ts_numbers(crmax,crmax) = 0, &
967                cross_ts_number_count(crmax) = 0, dopr_crossindex(100) = 0, &
968                dopr_index(100) = 0, dopr_initial_index(100) = 0, &
969                dots_crossindex(100) = 0, dots_index(100) = 0, &
970                linecolors(10) = (/ 2, 3, 4,  5, 7, 8, 12, 15, 16, 23 /), &
971                linestyles(11) = (/ 0, 7, 3, 10, 4, 1,  9,  2,  5,  8, 6 /)
972               
973
974    REAL ::  cross_normx_factor(100,crmax) = 1.0, &
975             cross_normy_factor(100,crmax) = 1.0, &
976             cross_ts_uymax(20) = &
977                             (/ 999.999, 999.999, 999.999, 999.999, 999.999,   &
978                                999.999, 999.999, 999.999, 999.999, 999.999,   &
979                                999.999, 999.999, 999.999, 999.999, 999.999,   &
980                                999.999, 999.999, 999.999, 999.999, 999.999 /),&
981             cross_ts_uymax_computed(20) = 999.999, &
982             cross_ts_uymin(20) = &
983                             (/ 999.999, 999.999, 999.999,  -5.000, 999.999,   &
984                                999.999,   0.000, 999.999, 999.999, 999.999,   &
985                                999.999, 999.999, 999.999, 999.999, 999.999,   &
986                                999.999, 999.999, 999.999, 999.999, 999.999 /),&
987             cross_ts_uymin_computed(20) = 999.999, &
988             cross_uxmax(crmax) = 0.0, cross_uxmax_computed(crmax) = -1.0, &
989             cross_uxmax_normalized(crmax) = 0.0, &
990             cross_uxmax_normalized_computed(crmax) = -1.0, &
991             cross_uxmin(crmax) = 0.0, cross_uxmin_computed(crmax) =  1.0, &
992             cross_uxmin_normalized(crmax) = 0.0, &
993             cross_uxmin_normalized_computed(crmax) = 1.0, &
994             cross_uymax(crmax), cross_uymin(crmax)
995
996    SAVE
997
998 END MODULE profil_parameter
999
1000
1001
1002
1003 MODULE spectrum
1004
1005!------------------------------------------------------------------------------!
1006! Description:
1007! ------------
1008! Definition of quantities used for computing spectra
1009!------------------------------------------------------------------------------!
1010
1011    CHARACTER (LEN=6),  DIMENSION(1:5) ::  header_char = (/ 'PS(u) ', 'PS(v) ',&
1012                                           'PS(w) ', 'PS(pt)', 'PS(q) ' /)
1013    CHARACTER (LEN=2),  DIMENSION(10)  ::  spectra_direction = 'x'
1014    CHARACTER (LEN=10), DIMENSION(10)  ::  data_output_sp  = ' '
1015    CHARACTER (LEN=25), DIMENSION(1:5) ::  utext_char =                    &
1016                                           (/ '-power spectrum of u     ', &
1017                                              '-power spectrum of v     ', &
1018                                              '-power spectrum of w     ', &
1019                                              '-power spectrum of ^1185 ', &
1020                                              '-power spectrum of q     ' /)
1021    CHARACTER (LEN=39), DIMENSION(1:5) ::  ytext_char =                        &
1022                                 (/ 'k ^2236 ^2566^2569<u(k) in m>2s>->2    ', &
1023                                    'k ^2236 ^2566^2569<v(k) in m>2s>->2    ', &
1024                                    'k ^2236 ^2566^2569<w(k) in m>2s>->2    ', &
1025                                    'k ^2236 ^2566^2569<^1185(k) in m>2s>->2', &
1026                                    'k ^2236 ^2566^2569<q(k) in m>2s>->2    ' /)
1027
1028    INTEGER ::  klist_x = 0, klist_y = 0, n_sp_x = 0, n_sp_y = 0
1029
1030    INTEGER ::  comp_spectra_level(10) = 999999,                   &
1031                lstyles(10) = (/ 0, 7, 3, 10, 1, 4, 9, 2, 6, 8 /), &
1032                plot_spectra_level(10) = 999999
1033
1034    REAL    ::  time_to_start_sp = 0.0
1035
1036    SAVE
1037
1038 END MODULE spectrum
1039
1040
1041
1042
1043 MODULE statistics
1044
1045!------------------------------------------------------------------------------!
1046! Description:
1047! ------------
1048! Definition of statistical quantities, e.g. global sums
1049!------------------------------------------------------------------------------!
1050
1051    CHARACTER (LEN=40) ::  region(0:9)
1052    INTEGER ::  statistic_regions = 0, var_hom = 80, var_sum = 80, var_ts = 100
1053    INTEGER ::  u_max_ijk(3), v_max_ijk(3), w_max_ijk(3)
1054    LOGICAL ::  flow_statistics_called = .FALSE.
1055    REAL ::     u_max, v_max, w_max
1056    REAL, DIMENSION(:), ALLOCATABLE       ::  sums_divnew_l, sums_divold_l
1057    REAL, DIMENSION(:,:), ALLOCATABLE     ::  sums, sums_wsts_bc_l, ts_value
1058    REAL, DIMENSION(:,:,:), ALLOCATABLE   ::  hom_sum, rmask, spectrum_x, &
1059                                              spectrum_y, sums_l, sums_l_l, &
1060                                              sums_up_fraction_l
1061    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom
1062
1063    SAVE
1064
1065 END MODULE statistics
1066
1067
1068
1069
1070 MODULE transpose_indices
1071
1072!------------------------------------------------------------------------------!
1073! Description:
1074! ------------
1075! Definition of indices for transposed arrays
1076!------------------------------------------------------------------------------!
1077
1078    INTEGER ::  nxl_y, nxl_yd, nxl_z, nxr_y, nxr_ya, nxr_yd, nxr_yda, nxr_z, &
1079                nxr_za, nyn_x, nyn_xa, nyn_z, nyn_za, nys_x, nys_z, nzb_x,   &
1080                nzb_y, nzb_yd, nzt_x, nzt_xa, nzt_y, nzt_ya, nzt_yd, nzt_yda
1081               
1082
1083    SAVE
1084
1085 END MODULE transpose_indices
Note: See TracBrowser for help on using the repository browser.