source: palm/trunk/SOURCE/read_var_list.f90 @ 208

Last change on this file since 208 was 198, checked in by raasch, 16 years ago

file headers updated for the next release 3.5

  • Property svn:keywords set to Id
File size: 28.4 KB
Line 
1 SUBROUTINE read_var_list
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: read_var_list.f90 198 2008-09-17 08:55:28Z raasch $
11!
12! 173 2008-05-23 20:39:38Z raasch
13! +cthf, leaf_surface_concentration, scalar_exchange_coefficient
14! +numprocs_previous_run, hor_index_bounds_previous_run, inflow_damping_factor,
15! inflow_damping_height, inflow_damping_width, mean_inflow_profiles,
16! recycling_width, turbulent_inflow,
17! -cross_ts_*, npex, npey,
18! hom_sum, volume_flow_area, volume_flow_initial moved from
19! read_3d_binary to here,
20! routines read_parts_of_var_list and skip_var_list added at the end
21!
22! 138 2007-11-28 10:03:58Z letzel
23! +canopy_mode, drag_coefficient, lad, lad_surface, lad_vertical_gradient,
24! lad_vertical_gradient_level, lad_vertical_gradient_level_ind, pch_index,
25! plant_canopy, time_sort_particles
26!
27! 102 2007-07-27 09:09:17Z raasch
28! +time_coupling, top_momentumflux_u|v
29!
30! 95 2007-06-02 16:48:38Z raasch
31! +bc_sa_t, ocean, sa_init, sa_surface, sa_vertical_gradient,
32! sa_vertical_gradient_level, bottom/top_salinity_flux
33!
34! 87 2007-05-22 15:46:47Z raasch
35! +max_pr_user (version 3.1), var_hom renamed pr_palm
36!
37! 75 2007-03-22 09:54:05Z raasch
38! +loop_optimization, pt_reference, moisture renamed humidity
39!
40! 20 2007-02-26 00:12:32Z raasch
41! +top_heatflux, use_top_fluxes
42!
43! RCS Log replace by Id keyword, revision history cleaned up
44!
45! Revision 1.34  2006/08/22 14:14:27  raasch
46! +dz_max
47!
48! Revision 1.1  1998/03/18 20:18:48  raasch
49! Initial revision
50!
51!
52! Description:
53! ------------
54! Reading values of global control variables from restart-file (binary format)
55!------------------------------------------------------------------------------!
56
57    USE arrays_3d
58    USE averaging
59    USE control_parameters
60    USE grid_variables
61    USE indices
62    USE model_1d
63    USE particle_attributes
64    USE pegrid
65    USE profil_parameter
66    USE statistics
67
68    IMPLICIT NONE
69
70    CHARACTER (LEN=10) ::  binary_version, version_on_file
71    CHARACTER (LEN=30) ::  variable_chr
72
73
74    CALL check_open( 13 )
75
76!
77!-- Make version number check first
78    READ ( 13 )  version_on_file
79    binary_version = '3.2'
80    IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
81       IF ( myid == 0 )  THEN
82          PRINT*, '+++ read_var_list: version mismatch concerning control', &
83                  ' variables'
84          PRINT*, '                   version on file    = "', &
85                  TRIM( version_on_file ), '"'
86          PRINT*, '                   version on program = "', &
87                  TRIM( binary_version ), '"'
88       ENDIF
89       CALL local_stop
90    ENDIF
91
92!
93!-- Read number of PEs and horizontal index bounds of all PEs used in previous
94!-- run
95    READ ( 13 )  variable_chr
96    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
97       PRINT*, '+++ read_var_list: numprocs not found in data from prior run', &
98                    ' on PE ', myid
99       CALL local_stop
100    ENDIF
101    READ ( 13 )  numprocs_previous_run
102
103    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
104       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
105    ENDIF
106
107    READ ( 13 )  variable_chr
108    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
109       PRINT*, '+++ read_var_list: hor_index_bounds not found in data from ', &
110                    'prior run on PE ', myid
111       CALL local_stop
112    ENDIF
113    READ ( 13 )  hor_index_bounds_previous_run
114
115!
116!-- Read vertical number of gridpoints and number of different areas used
117!-- for computing statistics. Allocate arrays depending on these values,
118!-- which are needed for the following read instructions.
119    READ ( 13 )  variable_chr
120    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
121       PRINT*, '+++ read_var_list: nz not found in data from prior run on PE ',&
122               myid
123       CALL local_stop
124    ENDIF
125    READ ( 13 )  nz
126
127    READ ( 13 )  variable_chr
128    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
129       PRINT*, '+++ read_var_list: max_pr_user not found in data from ', &
130                    'prior run on PE ', myid
131       CALL local_stop
132    ENDIF
133    READ ( 13 )  max_pr_user    ! This value is checked against the number of
134                                ! user profiles given for the current run
135                                ! in routine user_parin (it has to match)
136
137    READ ( 13 )  variable_chr
138    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
139       PRINT*, '+++ read_var_list: statistic_regions not found in data from ', &
140                    'prior run on PE ', myid
141       CALL local_stop
142    ENDIF
143    READ ( 13 )  statistic_regions
144    IF ( .NOT. ALLOCATED( ug ) )  THEN
145       ALLOCATE( lad(0:nz+1), ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),    &
146                 v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),        &
147                 sa_init(0:nz+1),                                        &
148                 hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),  &
149                 hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
150    ENDIF
151
152!
153!-- Now read all control parameters:
154!-- Caution: When the following read instructions have been changed, the
155!-- -------  version number stored in the variable binary_version has to be
156!--          increased. The same changes must also be done in write_var_list.
157    READ ( 13 )  variable_chr
158    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
159
160       SELECT CASE ( TRIM( variable_chr ) )
161
162          CASE ( 'adjust_mixing_length' )
163             READ ( 13 )  adjust_mixing_length
164          CASE ( 'advected_distance_x' )
165             READ ( 13 )  advected_distance_x
166          CASE ( 'advected_distance_y' )
167             READ ( 13 )  advected_distance_y
168          CASE ( 'alpha_surface' )
169             READ ( 13 )  alpha_surface
170          CASE ( 'average_count_pr' )
171             READ ( 13 )  average_count_pr
172          CASE ( 'average_count_sp' )
173             READ ( 13 )  average_count_sp
174          CASE ( 'average_count_3d' )
175             READ ( 13 )  average_count_3d
176          CASE ( 'bc_e_b' )
177             READ ( 13 )  bc_e_b
178          CASE ( 'bc_lr' )
179             READ ( 13 )  bc_lr
180          CASE ( 'bc_ns' )
181             READ ( 13 )  bc_ns
182          CASE ( 'bc_p_b' )
183             READ ( 13 )  bc_p_b
184          CASE ( 'bc_p_t' )
185             READ ( 13 )  bc_p_t
186          CASE ( 'bc_pt_b' )
187             READ ( 13 )  bc_pt_b
188          CASE ( 'bc_pt_t' )
189             READ ( 13 )  bc_pt_t
190          CASE ( 'bc_pt_t_val' )
191             READ ( 13 )  bc_pt_t_val
192          CASE ( 'bc_q_b' )
193             READ ( 13 )  bc_q_b
194          CASE ( 'bc_q_t' )
195             READ ( 13 )  bc_q_t
196          CASE ( 'bc_q_t_val' )
197             READ ( 13 )  bc_q_t_val
198          CASE ( 'bc_s_b' )
199             READ ( 13 )  bc_s_b
200          CASE ( 'bc_s_t' )
201             READ ( 13 )  bc_s_t
202          CASE ( 'bc_sa_t' )
203             READ ( 13 )  bc_sa_t
204          CASE ( 'bc_uv_b' )
205             READ ( 13 )  bc_uv_b
206          CASE ( 'bc_uv_t' )
207             READ ( 13 )  bc_uv_t
208          CASE ( 'bottom_salinityflux' )
209             READ ( 13 )  bottom_salinityflux
210          CASE ( 'building_height' )
211             READ ( 13 )  building_height
212          CASE ( 'building_length_x' )
213             READ ( 13 )  building_length_x
214          CASE ( 'building_length_y' )
215             READ ( 13 )  building_length_y
216          CASE ( 'building_wall_left' )
217             READ ( 13 )  building_wall_left
218          CASE ( 'building_wall_south' )
219             READ ( 13 )  building_wall_south
220          CASE ( 'canopy_mode' )
221             READ ( 13 )  canopy_mode
222          CASE ( 'cloud_droplets' )
223             READ ( 13 )  cloud_droplets
224          CASE ( 'cloud_physics' )
225             READ ( 13 )  cloud_physics
226          CASE ( 'conserve_volume_flow' )
227             READ ( 13 )  conserve_volume_flow
228          CASE ( 'cthf' )
229             READ ( 13 )  cthf
230          CASE ( 'current_timestep_number' )
231             READ ( 13 )  current_timestep_number
232          CASE ( 'cut_spline_overshoot' )
233             READ ( 13 )  cut_spline_overshoot
234          CASE ( 'damp_level_1d' )
235             READ ( 13 )  damp_level_1d
236          CASE ( 'dissipation_1d' )
237             READ ( 13 )  dissipation_1d
238          CASE ( 'drag_coefficient' )
239             READ ( 13 )  drag_coefficient
240          CASE ( 'dt_fixed' )
241             READ ( 13 )  dt_fixed
242          CASE ( 'dt_pr_1d' )
243             READ ( 13 )  dt_pr_1d
244          CASE ( 'dt_run_control_1d' )
245             READ ( 13 )  dt_run_control_1d
246          CASE ( 'dt_3d' )
247             READ ( 13 )  dt_3d
248          CASE ( 'dvrp_filecount' )
249             READ ( 13 )  dvrp_filecount
250          CASE ( 'dx' )
251             READ ( 13 )  dx
252          CASE ( 'dy' )
253             READ ( 13 )  dy
254          CASE ( 'dz' )
255             READ ( 13 )  dz
256          CASE ( 'dz_max' )
257             READ ( 13 )  dz_max
258          CASE ( 'dz_stretch_factor' )
259             READ ( 13 )  dz_stretch_factor
260          CASE ( 'dz_stretch_level' )
261             READ ( 13 )  dz_stretch_level
262          CASE ( 'e_min' )
263             READ ( 13 )  e_min
264          CASE ( 'end_time_1d' )
265             READ ( 13 )  end_time_1d
266          CASE ( 'fft_method' )
267             READ ( 13 )  fft_method
268          CASE ( 'first_call_advec_particles' )
269             READ ( 13 )  first_call_advec_particles
270          CASE ( 'galilei_transformation' )
271             READ ( 13 )  galilei_transformation
272          CASE ( 'grid_matching' )
273             READ ( 13 )  grid_matching
274          CASE ( 'hom' )
275             READ ( 13 )  hom
276          CASE ( 'hom_sum' )
277             READ ( 13 )  hom_sum
278          CASE ( 'humidity' )
279             READ ( 13 )  humidity
280          CASE ( 'inflow_damping_factor' )
281             IF ( .NOT. ALLOCATED( inflow_damping_factor ) )  THEN
282                ALLOCATE( inflow_damping_factor(0:nz+1) )
283             ENDIF
284             READ ( 13 )  inflow_damping_factor
285          CASE ( 'inflow_damping_height' )
286             READ ( 13 )  inflow_damping_height
287          CASE ( 'inflow_damping_width' )
288             READ ( 13 )  inflow_damping_width
289          CASE ( 'inflow_disturbance_begin' )
290             READ ( 13 )  inflow_disturbance_begin
291          CASE ( 'inflow_disturbance_end' )
292             READ ( 13 )  inflow_disturbance_end
293          CASE ( 'km_constant' )
294             READ ( 13 )  km_constant
295          CASE ( 'km_damp_max' )
296             READ ( 13 )  km_damp_max
297          CASE ( 'lad' )
298             READ ( 13 )  lad
299          CASE ( 'lad_surface' )
300             READ ( 13 )  lad_surface
301          CASE ( 'lad_vertical_gradient' )
302             READ ( 13 )  lad_vertical_gradient
303          CASE ( 'lad_vertical_gradient_level' )
304             READ ( 13 )  lad_vertical_gradient_level
305          CASE ( 'lad_vertical_gradient_level_in' )
306             READ ( 13 )  lad_vertical_gradient_level_ind
307          CASE ( 'last_dt_change' )
308             READ ( 13 )  last_dt_change
309          CASE ( 'leaf_surface_concentration' )
310             READ ( 13 )  leaf_surface_concentration
311          CASE ( 'long_filter_factor' )
312             READ ( 13 )  long_filter_factor
313          CASE ( 'loop_optimization' )
314             READ ( 13 )  loop_optimization
315          CASE ( 'mean_inflow_profiles' )
316             IF ( .NOT. ALLOCATED( mean_inflow_profiles ) )  THEN
317                ALLOCATE( mean_inflow_profiles(0:nz+1,5) )
318             ENDIF
319             READ ( 13 )  mean_inflow_profiles
320          CASE ( 'mixing_length_1d' )
321             READ ( 13 )  mixing_length_1d
322          CASE ( 'momentum_advec' )
323             READ ( 13 )  momentum_advec
324          CASE ( 'netcdf_precision' )
325             READ ( 13 )  netcdf_precision
326          CASE ( 'nsor_ini' )
327             READ ( 13 )  nsor_ini
328          CASE ( 'nx' )
329             READ ( 13 )  nx
330             nx_on_file = nx
331          CASE ( 'ny' )
332             READ ( 13 )  ny
333             ny_on_file = ny
334          CASE ( 'ocean' )
335             READ ( 13 )  ocean
336          CASE ( 'old_dt' )
337             READ ( 13 )  old_dt
338          CASE ( 'omega' )
339             READ ( 13 )  omega
340          CASE ( 'outflow_damping_width' )
341             READ ( 13 )  outflow_damping_width
342          CASE ( 'overshoot_limit_e' )
343             READ ( 13 )  overshoot_limit_e
344          CASE ( 'overshoot_limit_pt' )
345             READ ( 13 )  overshoot_limit_pt
346          CASE ( 'overshoot_limit_u' )
347             READ ( 13 )  overshoot_limit_u
348          CASE ( 'overshoot_limit_v' )
349             READ ( 13 )  overshoot_limit_v
350          CASE ( 'overshoot_limit_w' )
351             READ ( 13 )  overshoot_limit_w
352          CASE ( 'passive_scalar' )
353             READ ( 13 )  passive_scalar
354          CASE ( 'pch_index' )
355             READ ( 13 )  pch_index
356          CASE ( 'phi' )
357             READ ( 13 )  phi
358          CASE ( 'plant_canopy' )
359             READ ( 13 )  plant_canopy
360          CASE ( 'prandtl_layer' )
361             READ ( 13 )  prandtl_layer
362          CASE ( 'precipitation' )
363             READ ( 13 ) precipitation
364          CASE ( 'pt_init' )
365             READ ( 13 )  pt_init
366          CASE ( 'pt_reference' )
367             READ ( 13 )  pt_reference
368          CASE ( 'pt_surface' )
369             READ ( 13 )  pt_surface
370          CASE ( 'pt_surface_initial_change' )
371             READ ( 13 )  pt_surface_initial_change
372          CASE ( 'pt_vertical_gradient' )
373             READ ( 13 )  pt_vertical_gradient
374          CASE ( 'pt_vertical_gradient_level' )
375             READ ( 13 )  pt_vertical_gradient_level
376          CASE ( 'pt_vertical_gradient_level_ind' )
377             READ ( 13 )  pt_vertical_gradient_level_ind
378          CASE ( 'q_init' )
379             READ ( 13 )  q_init
380          CASE ( 'q_surface' )
381             READ ( 13 )  q_surface
382          CASE ( 'q_surface_initial_change' )
383             READ ( 13 )  q_surface_initial_change
384          CASE ( 'q_vertical_gradient' )
385             READ ( 13 )  q_vertical_gradient
386          CASE ( 'q_vertical_gradient_level' )
387             READ ( 13 )  q_vertical_gradient_level
388          CASE ( 'q_vertical_gradient_level_ind' )
389             READ ( 13 )  q_vertical_gradient_level_ind
390          CASE ( 'radiation' )
391             READ ( 13 )  radiation
392          CASE ( 'random_generator' )
393             READ ( 13 )  random_generator
394          CASE ( 'random_heatflux' )
395             READ ( 13 )  random_heatflux
396          CASE ( 'recycling_width' )
397             READ ( 13 )  recycling_width
398          CASE ( 'rif_max' )
399             READ ( 13 )  rif_max
400          CASE ( 'rif_min' )
401             READ ( 13 )  rif_min
402          CASE ( 'roughness_length' )
403             READ ( 13 )  roughness_length
404          CASE ( 'runnr' )
405             READ ( 13 )  runnr
406          CASE ( 'sa_init' )
407             READ ( 13 )  sa_init
408          CASE ( 'sa_surface' )
409             READ ( 13 )  sa_surface
410          CASE ( 'sa_vertical_gradient' )
411             READ ( 13 )  sa_vertical_gradient
412          CASE ( 'sa_vertical_gradient_level' )
413             READ ( 13 )  sa_vertical_gradient_level
414          CASE ( 'scalar_advec' )
415             READ ( 13 )  scalar_advec
416          CASE ( 'scalar_exchange_coefficient' )
417             READ ( 13 )  scalar_exchange_coefficient
418          CASE ( 'simulated_time' )
419             READ ( 13 )  simulated_time
420          CASE ( 'surface_heatflux' )
421             READ ( 13 )  surface_heatflux
422          CASE ( 'surface_pressure' )
423             READ ( 13 )  surface_pressure
424          CASE ( 'surface_scalarflux' )
425             READ ( 13 )  surface_scalarflux             
426          CASE ( 'surface_waterflux' )
427             READ ( 13 )  surface_waterflux             
428          CASE ( 's_surface' )
429             READ ( 13 )  s_surface
430          CASE ( 's_surface_initial_change' )
431             READ ( 13 )  s_surface_initial_change
432          CASE ( 's_vertical_gradient' )
433             READ ( 13 )  s_vertical_gradient
434          CASE ( 's_vertical_gradient_level' )
435             READ ( 13 )  s_vertical_gradient_level
436          CASE ( 'time_coupling' )
437             READ ( 13 )  time_coupling
438          CASE ( 'time_disturb' )
439             READ ( 13 )  time_disturb
440          CASE ( 'time_dopr' )
441             READ ( 13 )  time_dopr
442          CASE ( 'time_dopr_av' )
443             READ ( 13 )  time_dopr_av
444          CASE ( 'time_dopr_listing' )
445             READ ( 13 )  time_dopr_listing
446          CASE ( 'time_dopts' )
447             READ ( 13 )  time_dopts
448          CASE ( 'time_dosp' )
449             READ ( 13 )  time_dosp
450          CASE ( 'time_dots' )
451             READ ( 13 )  time_dots
452          CASE ( 'time_do2d_xy' )
453             READ ( 13 )  time_do2d_xy
454          CASE ( 'time_do2d_xz' )
455             READ ( 13 )  time_do2d_xz
456          CASE ( 'time_do2d_yz' )
457             READ ( 13 )  time_do2d_yz
458          CASE ( 'time_do3d' )
459             READ ( 13 )  time_do3d
460          CASE ( 'time_do_av' )
461             READ ( 13 )  time_do_av
462          CASE ( 'time_do_sla' )
463             READ ( 13 )  time_do_sla
464          CASE ( 'time_dvrp' )
465             READ ( 13 )  time_dvrp
466          CASE ( 'time_restart' )
467             READ ( 13 )  time_restart
468          CASE ( 'time_run_control' )
469             READ ( 13 )  time_run_control
470          CASE ( 'time_sort_particles' )
471             READ ( 13 )  time_sort_particles
472          CASE ( 'timestep_scheme' )
473             READ ( 13 )  timestep_scheme
474          CASE ( 'topography' )
475             READ ( 13 )  topography
476          CASE ( 'top_heatflux' )
477             READ ( 13 )  top_heatflux
478          CASE ( 'top_momentumflux_u' )
479             READ ( 13 )  top_momentumflux_u
480          CASE ( 'top_momentumflux_v' )
481             READ ( 13 )  top_momentumflux_v
482          CASE ( 'top_salinityflux' )
483             READ ( 13 )  top_salinityflux
484          CASE ( 'tsc' )
485             READ ( 13 )  tsc
486          CASE ( 'turbulent_inflow' )
487             READ ( 13 )  turbulent_inflow
488          CASE ( 'u_init' )
489             READ ( 13 )  u_init
490          CASE ( 'u_max' )
491             READ ( 13 )  u_max
492          CASE ( 'u_max_ijk' )
493             READ ( 13 )  u_max_ijk
494          CASE ( 'ug' )
495             READ ( 13 )  ug
496          CASE ( 'ug_surface' )
497             READ ( 13 )  ug_surface
498          CASE ( 'ug_vertical_gradient' )
499             READ ( 13 )  ug_vertical_gradient
500          CASE ( 'ug_vertical_gradient_level' )
501             READ ( 13 )  ug_vertical_gradient_level
502          CASE ( 'ug_vertical_gradient_level_ind' )
503             READ ( 13 )  ug_vertical_gradient_level_ind
504          CASE ( 'ups_limit_e' )
505             READ ( 13 )  ups_limit_e
506          CASE ( 'ups_limit_pt' )
507             READ ( 13 )  ups_limit_pt
508          CASE ( 'ups_limit_u' )
509             READ ( 13 )  ups_limit_u
510          CASE ( 'ups_limit_v' )
511             READ ( 13 )  ups_limit_v
512          CASE ( 'ups_limit_w' )
513             READ ( 13 )  ups_limit_w
514          CASE ( 'use_surface_fluxes' )
515             READ ( 13 )  use_surface_fluxes
516          CASE ( 'use_top_fluxes' )
517             READ ( 13 )  use_top_fluxes
518          CASE ( 'use_ug_for_galilei_tr' )
519             READ ( 13 )  use_ug_for_galilei_tr
520          CASE ( 'use_upstream_for_tke' )
521             READ ( 13 )  use_upstream_for_tke
522          CASE ( 'v_init' )
523             READ ( 13 )  v_init
524          CASE ( 'v_max' )
525             READ ( 13 )  v_max
526          CASE ( 'v_max_ijk' )
527             READ ( 13 )  v_max_ijk
528          CASE ( 'vg' )
529             READ ( 13 )  vg
530          CASE ( 'vg_surface' )
531             READ ( 13 )  vg_surface
532          CASE ( 'vg_vertical_gradient' )
533             READ ( 13 )  vg_vertical_gradient
534          CASE ( 'vg_vertical_gradient_level' )
535             READ ( 13 )  vg_vertical_gradient_level
536          CASE ( 'vg_vertical_gradient_level_ind' )
537             READ ( 13 )  vg_vertical_gradient_level_ind
538          CASE ( 'volume_flow_area' )
539             READ ( 13 )  volume_flow_area
540          CASE ( 'volume_flow_initial' )
541             READ ( 13 )  volume_flow_initial
542          CASE ( 'wall_adjustment' )
543             READ ( 13 )  wall_adjustment
544          CASE ( 'w_max' )
545             READ ( 13 )  w_max
546          CASE ( 'w_max_ijk' )
547             READ ( 13 )  w_max_ijk
548
549          CASE DEFAULT
550             PRINT*, '+++ read_var_list: unknown variable named "', &
551                     TRIM( variable_chr ), '" found in'
552             PRINT*, '                   data from prior run on PE ', myid
553             CALL local_stop
554        END SELECT
555!
556!--    Read next string
557       READ ( 13 )  variable_chr
558
559    ENDDO
560
561
562 END SUBROUTINE read_var_list
563
564
565
566 SUBROUTINE read_parts_of_var_list
567
568!------------------------------------------------------------------------------!
569! Description:
570! ------------
571! Skipping the global control variables from restart-file (binary format)
572! except some informations needed when reading restart data from a previous
573! run which used a smaller total domain or/and a different domain decomposition.
574!------------------------------------------------------------------------------!
575
576    USE arrays_3d
577    USE control_parameters
578    USE indices
579    USE pegrid
580    USE statistics
581
582    IMPLICIT NONE
583
584    CHARACTER (LEN=10) ::  version_on_file
585    CHARACTER (LEN=30) ::  variable_chr
586
587    INTEGER ::  idum, max_pr_user_on_file, nz_on_file, &
588                statistic_regions_on_file, tmp_mpru, tmp_sr
589
590    REAL, DIMENSION(:,:,:),   ALLOCATABLE ::  hom_sum_on_file
591    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
592
593
594    CALL check_open( 13 )
595
596    WRITE (9,*) 'rpovl: after check open 13'
597    CALL local_flush( 9 )
598    READ ( 13 )  version_on_file
599
600!
601!-- Read number of PEs and horizontal index bounds of all PEs used in previous
602!-- run
603    READ ( 13 )  variable_chr
604    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
605       PRINT*, '+++ read_parts_of_var_list: numprocs not found in data from ', &
606                    'prior run on PE ', myid
607       CALL local_stop
608    ENDIF
609    READ ( 13 )  numprocs_previous_run
610
611    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
612       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
613    ENDIF
614
615    READ ( 13 )  variable_chr
616    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
617       PRINT*, '+++ read_parts_of_var_list: hor_index_bounds not found in da', &
618                    'ta from prior run on PE ', myid
619       CALL local_stop
620    ENDIF
621    READ ( 13 )  hor_index_bounds_previous_run
622
623!
624!-- Read vertical number of gridpoints and number of different areas used
625!-- for computing statistics. Allocate arrays depending on these values,
626!-- which are needed for the following read instructions.
627    READ ( 13 )  variable_chr
628    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
629       PRINT*, '+++ read_parts_of_var_list: nz not found in restart data file'
630       CALL local_stop
631    ENDIF
632    READ ( 13 )  nz_on_file
633    IF ( nz_on_file /= nz )  THEN
634       IF ( myid == 0 )  THEN
635          PRINT*, '+++ read_parts_of_var_list: mismatch concerning number of', &
636                       ' gridpoints along z'
637          PRINT*, '                   nz on file    = "', nz_on_file, '"'
638          PRINT*, '                   nz from run   = "', nz, '"'
639       ENDIF
640       CALL local_stop
641    ENDIF
642
643    READ ( 13 )  variable_chr
644    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
645       PRINT*, '+++ read_parts_of_var_list: max_pr_user not found in restart', &
646                    ' data file'
647       CALL local_stop
648    ENDIF
649    READ ( 13 )  max_pr_user_on_file
650    IF ( max_pr_user_on_file /= max_pr_user )  THEN
651       IF ( myid == 0 )  THEN
652          PRINT*, '+++ read_parts_of_var_list: number of user profiles on res', &
653                       'tart data file differs from the current run'
654          PRINT*, '                   max_pr_user on file    = "', &
655                  max_pr_user_on_file, '"'
656          PRINT*, '                   max_pr_user from run   = "', &
657                  max_pr_user, '"'
658       ENDIF
659       tmp_mpru = MIN( max_pr_user_on_file, max_pr_user )
660    ELSE
661       tmp_mpru = max_pr_user
662    ENDIF
663
664    READ ( 13 )  variable_chr
665    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
666       PRINT*, '+++ read_parts_of_var_list: statistic_regions not found in ', &
667                    'restart data file'
668       CALL local_stop
669    ENDIF
670    READ ( 13 )  statistic_regions_on_file
671    IF ( statistic_regions_on_file /= statistic_regions )  THEN
672       IF ( myid == 0 )  THEN
673          PRINT*, '+++ read_parts_of_var_list: WARNING: statistic regions on', &
674                       ' restart data file differ from the current run'
675          PRINT*, '                            statistic regions on file    = "', &
676                  statistic_regions_on_file, '"'
677          PRINT*, '                            statistic regions from run   = "', &
678                  statistic_regions, '"'
679          PRINT*, '                            statistic data may be lost!'
680       ENDIF
681       tmp_sr = MIN( statistic_regions_on_file, statistic_regions )
682    ELSE
683       tmp_sr = statistic_regions
684    ENDIF
685
686
687!
688!-- Now read and check some control parameters and skip the rest
689!-- The total domain of the pre-run must not be smaller than the subdomain
690!-- of the current run, because the mapping of data from the pre-run does
691!-- not work for this case.
692    WRITE (9,*) 'wpovl: begin reading variables'
693    CALL local_flush( 9 )
694    READ ( 13 )  variable_chr
695
696    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
697
698       SELECT CASE ( TRIM( variable_chr ) )
699
700          CASE ( 'average_count_pr' )
701             READ ( 13 )  average_count_pr
702             IF ( average_count_pr /= 0  .AND.  myid == 0 )  THEN
703                PRINT*, '+++ read_parts_of_var_list:'
704                PRINT*, '    WARNING: inflow profiles not temporally averaged.'
705                PRINT*, '    Averaging will be done now using ', &
706                        average_count_pr, ' samples.'
707             ENDIF
708
709          CASE ( 'hom' )
710             ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file, &
711                       0:statistic_regions_on_file) )
712             READ ( 13 )  hom_on_file
713             hom(:,:,1:pr_palm+tmp_mpru,0:tmp_sr) = &
714                          hom_on_file(:,:,1:pr_palm+tmp_mpru,0:tmp_sr)
715             DEALLOCATE( hom_on_file )
716
717          CASE ( 'hom_sum' )
718             ALLOCATE( hom_sum_on_file(0:nz+1,pr_palm+max_pr_user_on_file, &
719                       0:statistic_regions_on_file) )
720             READ ( 13 )  hom_sum_on_file
721             hom_sum(:,1:pr_palm+tmp_mpru,0:tmp_sr) = &
722                          hom_sum_on_file(:,1:pr_palm+tmp_mpru,0:tmp_sr)
723             DEALLOCATE( hom_sum_on_file )
724
725          CASE ( 'nx' )
726             READ ( 13 )  nx_on_file
727             IF ( nx_on_file < ( nxr - nxl ) )  THEN
728                PRINT*, '+++ read_parts_of_var_list: total domain along x on', &
729                             ' restart file is smaller than current subdomain'
730                PRINT*, '                            nx on file = ', nx_on_file
731                PRINT*, '                            nxr - nxl  = ', nxr - nxl
732                CALL local_stop
733             ENDIF
734
735          CASE ( 'ny' )
736             READ ( 13 )  ny_on_file
737             IF ( ny_on_file < ( nyn - nys ) )  THEN
738                PRINT*, '+++ read_parts_of_var_list: total domain along y on', &
739                             ' restart file is smaller than current subdomain'
740                PRINT*, '                            ny on file = ', ny_on_file
741                PRINT*, '                            nyn - nys  = ', nyn - nys
742                CALL local_stop
743             ENDIF
744
745
746          CASE DEFAULT
747
748             READ ( 13 )  idum
749
750       END SELECT
751
752       READ ( 13 )  variable_chr
753
754    ENDDO
755
756!
757!-- Calculate the temporal average of vertical profiles, if neccessary
758    IF ( average_count_pr /= 0 )  THEN
759       hom_sum = hom_sum / REAL( average_count_pr )
760    ENDIF
761
762
763 END SUBROUTINE read_parts_of_var_list
764
765
766
767 SUBROUTINE skip_var_list
768
769!------------------------------------------------------------------------------!
770! Description:
771! ------------
772! Skipping the global control variables from restart-file (binary format)
773!------------------------------------------------------------------------------!
774
775    IMPLICIT NONE
776
777    CHARACTER (LEN=10) ::  version_on_file
778    CHARACTER (LEN=30) ::  variable_chr
779
780    INTEGER ::  idum
781
782
783    WRITE (9,*) 'skipvl #1'
784    CALL local_flush( 9 )
785    READ ( 13 )  version_on_file
786
787    WRITE (9,*) 'skipvl before variable_chr'
788    CALL local_flush( 9 )
789    READ ( 13 )  variable_chr
790    WRITE (9,*) 'skipvl after variable_chr'
791    CALL local_flush( 9 )
792
793    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
794
795    WRITE (9,*) 'skipvl chr = ', variable_chr
796    CALL local_flush( 9 )
797       READ ( 13 )  idum
798       READ ( 13 )  variable_chr
799
800    ENDDO
801    WRITE (9,*) 'skipvl last'
802    CALL local_flush( 9 )
803
804
805 END SUBROUTINE skip_var_list
Note: See TracBrowser for help on using the repository browser.