source: palm/tags/release-3.2/SOURCE/parin.f90 @ 4109

Last change on this file since 4109 was 77, checked in by raasch, 17 years ago

New:
---

particle reflection from vertical walls implemented, particle SGS model adjusted to walls

Wall functions for vertical walls now include diabatic conditions. New subroutines wall_fluxes, wall_fluxes_e. New 4D-array rif_wall.

new d3par-parameter netcdf_64bit_3d to switch on 64bit offset only for 3D files

new d3par-parameter dt_max to define the maximum value for the allowed timestep

new inipar-parameter loop_optimization to control the loop optimization method

new inipar-parameter pt_refrence. If given, this value is used as the reference that in buoyancy terms (otherwise, the instantaneous horizontally averaged temperature is used).

new user interface user_advec_particles

new initializing action "by_user" calls user_init_3d_model and allows the initial setting of all 3d arrays

topography height informations are stored on arrays zu_s_inner and zw_w_inner and output to the 2d/3d NetCDF files

samples added to the user interface which show how to add user-define time series quantities.

calculation/output of precipitation amount, precipitation rate and z0 (by setting "pra*", "prr*", "z0*" with data_output). The time interval on which the precipitation amount is defined is set by new d3par-parameter precipitation_amount_interval

unit 9 opened for debug output (file DEBUG_<pe#>)

Makefile, advec_particles, average_3d_data, buoyancy, calc_precipitation, check_open, check_parameters, data_output_2d, diffusion_e, diffusion_u, diffusion_v, diffusion_w, diffusivities, header, impact_of_latent_heat, init_particles, init_3d_model, modules, netcdf, parin, production_e, read_var_list, read_3d_binary, sum_up_3d_data, user_interface, write_var_list, write_3d_binary

New: wall_fluxes

Changed:


General revision of non-cyclic horizontal boundary conditions: radiation boundary conditions are now used instead of Neumann conditions at the outflow (calculation needs velocity values for t-dt, which are stored on new arrays u_m_l, u_m_r, etc.), calculation of mean outflow is not needed any more, volume flow control is added for the outflow boundary (currently only for the north boundary!!), additional gridpoints along x and y (uxrp, vynp) are not needed any more, routine "boundary_conds" now operates on timelevel t+dt and is not split in two parts (main, uvw_outflow) any more, Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary conditions for all 2d-arrays that are handled by exchange_horiz_2d

The FFT-method for solving the Poisson-equation is now working with Neumann boundary conditions both at the bottom and the top. This requires adjustments of the tridiagonal coefficients and subtracting the horizontally averaged mean from the vertical velocity field.

+age_m in particle_type

Particles-package is now part of the default code ("-p particles" is not needed any more).

Move call of user_actions( 'after_integration' ) below increment of times
and counters. user_actions is now called for each statistic region and has as an argument the number of the respective region (sr)

d3par-parameter data_output_ts removed. Timeseries output for "profil" removed. Timeseries are now switched on by dt_dots. Timeseries data is collected in flow_statistics.

Initial velocities at nzb+1 are regarded for volume flow control in case they have been set zero before (to avoid small timesteps); see new internal parameters u/v_nzb_p1_for_vfc.

q is not allowed to become negative (prognostic_equations).

poisfft_init is only called if fft-solver is switched on (init_pegrid).

d3par-parameter moisture renamed to humidity.

Subversion global revision number is read from mrun and added to the run description header and to the run control (_rc) file.

vtk directives removed from main program.

The uitility routine interpret_config reads PALM environment variables from NAMELIST instead using the system call GETENV.

advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, asselin_filter, check_parameters, coriolis, data_output_dvrp, data_output_ptseries, data_output_ts, data_output_2d, data_output_3d, diffusion_u, diffusion_v, exchange_horiz, exchange_horiz_2d, flow_statistics, header, init_grid, init_particles, init_pegrid, init_rankine, init_pt_anomaly, init_1d_model, init_3d_model, modules, palm, package_parin, parin, poisfft, poismg, prandtl_fluxes, pres, production_e, prognostic_equations, read_var_list, read_3d_binary, sor, swap_timelevel, time_integration, write_var_list, write_3d_binary

Errors:


Bugfix: preset of tendencies te_em, te_um, te_vm in init_1d_model

Bugfix in sample for reading user defined data from restart file (user_init)

Bugfix in setting diffusivities for cases with the outflow damping layer extending over more than one subdomain (init_3d_model)

Check for possible negative humidities in the initial humidity profile.

in Makefile, default suffixes removed from the suffix list to avoid calling of m2c in
# case of .mod files

Makefile
check_parameters, init_1d_model, init_3d_model, user_interface

  • Property svn:keywords set to Id
File size: 10.3 KB
Line 
1 SUBROUTINE parin
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: parin.f90 77 2007-03-29 04:26:56Z suehring $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! +dt_max, netcdf_64bit_3d, precipitation_amount_interval in d3par,
14! +loop_optimization, pt_reference in inipar, -data_output_ts,
15! moisture renamed humidity
16!
17! 20 2007-02-26 00:12:32Z raasch
18! +top_heatflux, use_top_fluxes in inipar
19!
20! -netcdf_64bit_3d
21!
22! 3 2007-02-13 11:30:58Z raasch
23! +netcdf_64bit_3d in d3par,
24! RCS Log replace by Id keyword, revision history cleaned up
25!
26! Revision 1.57  2007/02/11 13:11:22  raasch
27! Values of environment variables are now read from file ENVPAR instead of
28! reading them with a system call, + NAMELIST envpar
29!
30! Revision 1.1  1997/07/24 11:22:50  raasch
31! Initial revision
32!
33!
34! Description:
35! ------------
36! This subroutine reads variables controling the run from the NAMELIST files
37!------------------------------------------------------------------------------!
38
39    USE arrays_3d
40    USE averaging
41    USE control_parameters
42    USE grid_variables
43    USE indices
44    USE model_1d
45    USE pegrid
46    USE profil_parameter
47    USE statistics
48
49    IMPLICIT NONE
50
51    INTEGER ::  idum
52
53
54    NAMELIST /inipar/  adjust_mixing_length, alpha_surface, bc_e_b, bc_lr, &
55                       bc_ns, bc_p_b, bc_p_t, bc_pt_b, bc_pt_t, bc_q_b, &
56                       bc_q_t,bc_s_b, bc_s_t, bc_uv_b, bc_uv_t, &
57                       building_height, building_length_x, building_length_y, &
58                       building_wall_left, building_wall_south, &
59                       cloud_droplets, cloud_physics, conserve_volume_flow, &
60                       cut_spline_overshoot, damp_level_1d, dissipation_1d, &
61                       dt, dt_pr_1d, dt_run_control_1d, dx, dy, dz, dz_max, &
62                       dz_stretch_factor, dz_stretch_level, e_min, &
63                       end_time_1d, fft_method, galilei_transformation, &
64                       grid_matching, humidity, inflow_disturbance_begin, &
65                       inflow_disturbance_end, initializing_actions, &
66                       km_constant, km_damp_max, long_filter_factor, &
67                       loop_optimization, mixing_length_1d, &
68                       momentum_advec, netcdf_precision, npex, npey, nsor_ini, &
69                       nx, ny, nz, omega, outflow_damping_width, &
70                       overshoot_limit_e, &
71                       overshoot_limit_pt, overshoot_limit_u, &
72                       overshoot_limit_v, overshoot_limit_w, passive_scalar, &
73                       phi, prandtl_layer, precipitation, pt_reference, &
74                       pt_surface, pt_surface_initial_change, &
75                       pt_vertical_gradient, pt_vertical_gradient_level, &
76                       q_surface, q_surface_initial_change, &
77                       q_vertical_gradient, q_vertical_gradient_level, &
78                       radiation, random_generator, random_heatflux, rif_max, &
79                       rif_min, roughness_length, scalar_advec, &
80                       statistic_regions, surface_heatflux, surface_pressure, &
81                       surface_scalarflux, surface_waterflux, s_surface, &
82                       s_surface_initial_change, s_vertical_gradient, &
83                       s_vertical_gradient_level, top_heatflux, &
84                       timestep_scheme, topography, ug_surface, &
85                       ug_vertical_gradient, ug_vertical_gradient_level, &
86                       ups_limit_e, ups_limit_pt, ups_limit_u, ups_limit_v, &
87                       ups_limit_w, use_surface_fluxes, use_top_fluxes, &
88                       use_ug_for_galilei_tr, use_upstream_for_tke, &
89                       vg_surface, vg_vertical_gradient, &
90                       vg_vertical_gradient_level, wall_adjustment, &
91                       wall_heatflux
92
93
94    NAMELIST /d3par/   averaging_interval,  averaging_interval_pr, &
95                       call_psolver_at_all_substeps, cfl_factor, &
96                       create_disturbances, cross_normalized_x, &
97                       cross_normalized_y, cross_profiles, cross_ts_uymax, &
98                       cross_ts_uymin, cross_xtext, cycle_mg, data_output, &
99                       data_output_format, data_output_pr, &
100                       data_output_2d_on_each_pe, disturbance_amplitude, &
101                       disturbance_energy_limit, disturbance_level_b, &
102                       disturbance_level_t, do2d_at_begin, do3d_at_begin, &
103                       do3d_compress, do3d_comp_prec, dt, dt_averaging_input, &
104                       dt_averaging_input_pr, dt_data_output, &
105                       dt_data_output_av, dt_disturb, dt_dopr, &
106                       dt_dopr_listing, dt_dots, dt_do2d_xy, dt_do2d_xz, &
107                       dt_do2d_yz, dt_do3d, dt_max, dt_restart, dt_run_control,&
108                       end_time, force_print_header, mg_cycles, &
109                       mg_switch_to_pe0_level, netcdf_64bit, netcdf_64bit_3d, &
110                       ngsrb, normalizing_region, nsor, nz_do3d, omega_sor, &
111                       prandtl_number, precipitation_amount_interval, &
112                       profile_columns, profile_rows, psolver, &
113                       rayleigh_damping_factor, rayleigh_damping_height, &
114                       residual_limit, restart_time, section_xy, section_xz, &
115                       section_yz, skip_time_data_output, &
116                       skip_time_data_output_av, skip_time_dopr, &
117                       skip_time_dosp, skip_time_do2d_xy, skip_time_do2d_xz, &
118                       skip_time_do2d_yz, skip_time_do3d, &
119                       termination_time_needed, use_prior_plot1d_parameters, &
120                       z_max_do1d, z_max_do1d_normalized, z_max_do2d
121
122
123    NAMELIST /envpar/  host, maximum_cpu_time_allowed, revision, &
124                       run_identifier, tasks_per_node, write_binary
125
126
127#if defined( __parallel )
128!
129!-- Preliminary determination of processor-id which is needed here to open the
130!-- input files belonging to the corresponding processor and to produce
131!-- messages by PE0 only (myid and myid_char are later determined in
132!-- init_pegrid)
133    CALL MPI_COMM_RANK( comm_palm, myid, ierr )
134    WRITE (myid_char,'(''_'',I4.4)')  myid
135!
136!-- Since on IBM machines the process rank may be changed when the final
137!-- communicator is defined, save the preliminary processor-id for opening
138!-- the binary output file for restarts (unit 14), because otherwise
139!-- a mismatch occurs when reading this file in the next job
140    myid_char_14 = myid_char
141#endif
142
143!
144!-- Open the NAMELIST-file which is send with this job
145    CALL check_open( 11 )
146
147!
148!-- Read the control parameters for initialization.
149!-- The namelist "inipar" must be provided in the NAMELIST-file. If this is
150!-- not the case and the file contains - instead of "inipar" - any other
151!-- namelist, a read error is created on t3e and control is transferred
152!-- to the statement with label 10. Therefore, on t3e machines one can not
153!-- distinguish between errors produced by a wrong "inipar" namelist or
154!-- because this namelist is totally missing.
155    READ ( 11, inipar, ERR=10, END=11 )
156    GOTO 12
157 10 IF ( myid == 0 )  THEN
158       PRINT*, '+++ parin: errors in \$inipar'
159       PRINT*, '           or no \$inipar-namelist found (CRAY-machines only)' 
160    ENDIF
161    CALL local_stop
162 11 IF ( myid == 0 )  THEN
163       PRINT*, '+++ parin: no \$inipar-namelist found'
164    ENDIF
165    CALL local_stop
166
167!
168!-- If required, read control parameters from restart file (produced by
169!-- a prior run)
170 12 IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
171
172       CALL read_var_list
173!
174!--    Increment the run count
175       runnr = runnr + 1
176
177    ELSE
178!
179!--    This is not a restart job.
180!--    Check, if the grid point numbers are well defined.
181       IF ( nx <= 0 )  THEN
182          IF ( myid == 0 )  THEN
183             PRINT*, '+++ parin: no value or wrong value given for nx: nx=', nx
184          ENDIF
185          CALL local_stop
186       ENDIF
187       IF ( ny <= 0 )  THEN
188          IF ( myid == 0 )  THEN
189             PRINT*, '+++ parin: no value or wrong value given for ny: ny=', ny
190          ENDIF
191          CALL local_stop
192       ENDIF
193       IF ( nz <= 0 )  THEN
194          IF ( myid == 0 )  THEN
195             PRINT*, '+++ parin: no value or wrong value given for nz: nz=', nz
196          ENDIF
197          CALL local_stop
198       ENDIF
199
200!
201!--    Allocate arrays which will be already initialized in init_pegrid or
202!--    check_parameters. During restart jobs, these arrays will be allocated
203!--    in read_var_list. All other arrays are allocated in init_3d_model.
204       ALLOCATE( ug(0:nz+1), vg(0:nz+1), &
205                 pt_init(0:nz+1), q_init(0:nz+1), u_init(0:nz+1), &
206                 v_init(0:nz+1),                                  &
207                 hom(0:nz+1,2,var_hom,0:statistic_regions) )
208       hom = 0.0
209
210    ENDIF
211
212!
213!-- Definition of names of areas used for computing statistics. They must
214!-- be defined at this place, because they are allowed to be redefined by
215!-- the user in user_parin.
216    region = 'total domain'
217
218!
219!-- Read runtime parameters given by the user for this run (namelist "d3par").
220!-- The namelist "d3par" can be omitted. In that case, default values are
221!-- used for the parameters.
222    READ ( 11, d3par, END=20 )
223
224!
225!-- Read control parameters for optionally used model software packages
226 20 CALL package_parin
227
228!
229!-- Read user-defined variables
230    CALL user_parin
231
232!
233!-- NAMELIST-file is not needed anymore
234    CALL close_file( 11 )
235
236!
237!-- Read values of environment variables (this NAMELIST file is generated by
238!-- mrun)
239    OPEN ( 90, FILE='ENVPAR', STATUS='OLD', FORM='FORMATTED', ERR=30 )
240    READ ( 90, envpar, ERR=31, END=32 )
241    CLOSE ( 90 )
242    RETURN
243
244 30 IF ( myid == 0 )  THEN
245       PRINT*, '+++ parin: WARNING: local file ENVPAR not found'
246       PRINT*, '           some variables for steering may not be properly set'
247    ENDIF
248    RETURN
249
250 31 IF ( myid == 0 )  THEN
251       PRINT*, '+++ parin: WARNING: errors in local file ENVPAR'
252       PRINT*, '           some variables for steering may not be properly set'
253    ENDIF
254    RETURN
255
256 32 IF ( myid == 0 )  THEN
257       PRINT*, '+++ parin: WARNING: no envpar-NAMELIST found in local file ', &
258                           'ENVPAR'
259       PRINT*, '           some variables for steering may not be properly set'
260    ENDIF
261
262 END SUBROUTINE parin
Note: See TracBrowser for help on using the repository browser.