source: palm/tags/release-3.4a/SOURCE/init_dvrp.f90 @ 343

Last change on this file since 343 was 139, checked in by raasch, 16 years ago

New:
---

Plant canopy model of Watanabe (2004,BLM 112,307-341) added.
It can be switched on by the inipar parameter plant_canopy.
The inipar parameter canopy_mode can be used to prescribe a
plant canopy type. The default case is a homogeneous plant
canopy. Heterogeneous distributions of the leaf area
density and the canopy drag coefficient can be defined in the
new routine user_init_plant_canopy (user_interface).
The inipar parameters lad_surface, lad_vertical_gradient and
lad_vertical_gradient_level can be used in order to
prescribe the vertical profile of leaf area density. The
inipar parameter drag_coefficient determines the canopy
drag coefficient.
Finally, the inipar parameter pch_index determines the
index of the upper boundary of the plant canopy.

Allow new case bc_uv_t = 'dirichlet_0' for channel flow.

For unknown variables (CASE DEFAULT) call new subroutine user_data_output_dvrp

Pressure boundary conditions for vertical walls added to the multigrid solver.
They are applied using new wall flag arrays (wall_flags_..) which are defined
for each grid level. New argument gls added to routine user_init_grid
(user_interface).

Frequence of sorting particles can be controlled with new particles_par
parameter dt_sort_particles. Sorting is moved from the SGS timestep loop in
advec_particles after the end of this loop.

advec_particles, check_parameters, data_output_dvrp, header, init_3d_model, init_grid, init_particles, init_pegrid, modules, package_parin, parin, plant_canopy_model, read_var_list, read_3d_binary, user_interface, write_var_list, write_3d_binary

Changed:


Redefine initial nzb_local as the actual total size of topography (later the
extent of topography in nzb_local is reduced by 1dx at the E topography walls
and by 1dy at the N topography walls to form the basis for nzb_s_inner);
for consistency redefine 'single_building' case.

Vertical profiles now based on nzb_s_inner; they are divided by
ngp_2dh_s_inner (scalars, procucts of scalars) and ngp_2dh (staggered velocity
components and their products, procucts of scalars and velocity components),
respectively.

Allow two instead of one digit to specify isosurface and slicer variables.

Status of 3D-volume NetCDF data file only depends on switch netcdf_64bit_3d (check_open)

prognostic_equations include the respective wall_*flux in the parameter list of
calls of diffusion_s. Same as before, only the values of wall_heatflux(0:4)
can be assigned. At present, wall_humidityflux, wall_qflux, wall_salinityflux,
and wall_scalarflux are kept zero. diffusion_s uses the respective wall_*flux
instead of wall_heatflux. This update serves two purposes:

  • it avoids errors in calculations with humidity/scalar/salinity and prescribed

non-zero wall_heatflux,

  • it prepares PALM for a possible assignment of wall fluxes of

humidity/scalar/salinity in a future release.

buoyancy, check_open, data_output_dvrp, diffusion_s, diffusivities, flow_statistics, header, init_3d_model, init_dvrp, init_grid, modules, prognostic_equations

Errors:


Bugfix: summation of sums_l_l in diffusivities.

Several bugfixes in the ocean part: Initial density rho is calculated
(init_ocean). Error in initializing u_init and v_init removed
(check_parameters). Calculation of density flux now starts from
nzb+1 (production_e).

Bugfix: pleft/pright changed to pnorth/psouth in sendrecv of particle tail
numbers along y, small bugfixes in the SGS part (advec_particles)

Bugfix: model_string needed a default value (combine_plot_fields)

Bugfix: wavenumber calculation for even nx in routines maketri (poisfft)

Bugfix: assignment of fluxes at walls

Bugfix: absolute value of f must be used when calculating the Blackadar mixing length (init_1d_model)

advec_particles, check_parameters, combine_plot_fields, diffusion_s, diffusivities, init_ocean, init_1d_model, poisfft, production_e

  • Property svn:keywords set to Id
File size: 20.6 KB
Line 
1  SUBROUTINE init_dvrp
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7! TEST: print* statements
8! ToDo: checking of mode_dvrp for legal values is not correct
9!
10! Former revisions:
11! -----------------
12! $Id: init_dvrp.f90 139 2007-11-29 09:37:41Z maronga $
13!
14! 130 2007-11-13 14:08:40Z letzel
15! allow two instead of one digit to specify isosurface and slicer variables
16! Test output of isosurface on camera file
17!
18! 82 2007-04-16 15:40:52Z raasch
19! Preprocessor strings for different linux clusters changed to "lc",
20! routine local_flush is used for buffer flushing
21!
22! 17 2007-02-19 01:57:39Z raasch
23! dvrp_output_local activated for all streams
24!
25! 13 2007-02-14 12:15:07Z raasch
26! RCS Log replace by Id keyword, revision history cleaned up
27!
28! Revision 1.12  2006/02/23 12:30:22  raasch
29! ebene renamed section, pl.. replaced by do..,
30!
31! Revision 1.1  2000/04/27 06:24:39  raasch
32! Initial revision
33!
34!
35! Description:
36! ------------
37! Initializing actions needed when using dvrp-software
38!------------------------------------------------------------------------------!
39#if defined( __dvrp_graphics )
40
41    USE arrays_3d
42    USE DVRP
43    USE dvrp_variables
44    USE grid_variables
45    USE indices
46    USE pegrid
47    USE control_parameters
48
49    IMPLICIT NONE
50
51    CHARACTER (LEN=2)  ::  section_chr
52    CHARACTER (LEN=80) ::  dvrp_file_local
53    INTEGER ::  i, j, k, l, m, pn, tv, vn
54    LOGICAL ::  allocated
55    REAL    ::  center(3), distance
56
57    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
58
59    TYPE(CSTRING), SAVE ::  dvrp_directory_c, dvrp_file_c, &
60                            dvrp_file_local_c,dvrp_host_c, &
61                            dvrp_password_c, dvrp_username_c, name_c
62
63!
64!-- Set the maximum time the program can be suspended on user request (by
65!-- dvrp steering). This variable is defined in module DVRP.
66    DVRP_MAX_SUSPEND_TIME = 7200
67
68!
69!-- Allocate array holding the names and limits of the steering variables
70!-- (must have the same number of elements as array mode_dvrp!)
71    ALLOCATE( steering_dvrp(10) )
72
73!
74!-- Check, if output parameters are given and/or allowed
75!-- and set default-values, where necessary
76    IF ( dvrp_username == ' ' )  THEN
77       IF ( myid == 0 )  THEN
78          PRINT*, '+++ init_dvrp: dvrp_username is undefined'
79          CALL local_stop
80       ENDIF
81    ENDIF
82
83    IF ( dvrp_output /= 'ftp'  .AND.  dvrp_output /= 'rtsp'  .AND. &
84         dvrp_output /= 'local' )  THEN
85       IF ( myid == 0 )  THEN
86          PRINT*, '+++ init_dvrp: dvrp_output="', dvrp_output, '" not allowed'
87          CALL local_stop
88       ENDIF
89    ENDIF
90
91    IF ( dvrp_directory == 'default' )  THEN
92       dvrp_directory = TRIM( dvrp_username ) // '/' // TRIM( run_identifier )
93    ENDIF
94
95    IF ( dvrp_output /= 'local' )  THEN
96       IF ( dvrp_file /= 'default'  .AND.  dvrp_file /= '/dev/null' )  THEN
97          IF ( myid == 0 )  THEN
98             PRINT*, '+++ init_dvrp: dvrp_file="', dvrp_file, '" not allowed'
99             CALL local_stop
100          ENDIF
101       ENDIF
102    ENDIF
103
104!
105!-- Strings are assigned to strings of special type which have a CHAR( 0 )
106!-- (C end-of-character symbol) at their end. This is needed when strings are
107!-- passed to C routines.
108    dvrp_directory_c = dvrp_directory
109    dvrp_file_c      = dvrp_file
110    dvrp_host_c      = dvrp_host
111    dvrp_password_c  = dvrp_password
112    dvrp_username_c  = dvrp_username
113
114!
115!-- Loop over all output modes choosed
116    m = 1
117    allocated = .FALSE.
118    DO WHILE ( mode_dvrp(m) /= ' ' )
119   
120!
121!--    Check, if mode is allowed
122       IF ( mode_dvrp(m)(1:10) /= 'isosurface'  .AND. &
123            mode_dvrp(m)(1:6)  /= 'slicer'      .AND. &
124            mode_dvrp(m)(1:9)  /= 'particles' )  THEN
125
126          IF ( myid == 0 )  THEN
127             PRINT*, '+++ init_dvrp: mode_dvrp="', mode_dvrp, '" not allowed'
128          ENDIF
129          CALL local_stop
130
131       ENDIF
132   
133!
134!--    Camera position must be computed and written on file when no dvrp-output
135!--    has been generated so far (in former runs)
136!       IF ( dvrp_filecount == 0 )  THEN
137!
138!--       Compute center of domain and distance of camera from center
139          center(1) = ( nx + 1.0 ) * dx * 0.5 * superelevation_x
140          center(2) = ( ny + 1.0 ) * dy * 0.5 * superelevation_y
141          center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5 * superelevation
142          distance  = 1.5 * MAX( ( nx + 1.0 ) * dx * superelevation_x, &
143                                 ( ny + 1.0 ) * dy * superelevation_y, &
144                                 ( zu(nz_do3d) - zu(nzb) ) * superelevation )
145
146!
147!--       Write camera position on file
148          CALL DVRP_INIT( m-1, 0 )
149
150!
151!--       Create filename for camera
152          IF ( dvrp_output == 'rtsp' )  THEN
153
154    WRITE ( 9, * ) '***  vor dvrp_output_rtsp'
155    CALL local_flush( 9 )
156
157             dvrp_file   = TRIM( mode_dvrp(m) ) // '/camera.dvr'
158             dvrp_file_c = dvrp_file
159             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
160                                    dvrp_password_c, dvrp_directory_c, &
161                                    dvrp_file_c )
162    WRITE ( 9, * ) '***  nach dvrp_output_rtsp'
163    CALL local_flush( 9 )
164
165          ELSEIF ( dvrp_output == 'ftp' )  THEN
166
167             dvrp_file   = TRIM( mode_dvrp(m) ) // '.camera.dvr'
168             dvrp_file_c = dvrp_file
169!             CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
170!                                   dvrp_password_c, dvrp_directory_c,    &
171!                                   dvrp_file_c )
172
173          ELSE
174
175             IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
176                dvrp_file_local   = TRIM( mode_dvrp(m) ) // '.camera.dvr'
177                dvrp_file_local_c = dvrp_file_local
178             ELSE
179                dvrp_file_local_c = dvrp_file_c
180             ENDIF
181             CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
182
183          ENDIF
184
185          CALL DVRP_CAMERA( m-1, center, distance )
186    WRITE ( 9, * ) '***  #1'
187    CALL local_flush( 9 )
188
189!
190!--       Define bounding box material and create a bounding box
191          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.5, 0.5, 0.5, 0.0 )
192          CALL DVRP_BOUNDINGBOX( m-1, 1, 0.01, 0.0, 0.0, 0.0,    &
193                                 (nx+1) * dx * superelevation_x, &
194                                 (ny+1) * dy * superelevation_y, &
195                                 zu(nz_do3d) * superelevation )
196
197          CALL DVRP_VISUALIZE( m-1, 0, 0 )
198          CALL DVRP_EXIT( m-1 )
199    WRITE ( 9, * ) '***  #2'
200    CALL local_flush( 9 )
201
202
203!
204!--       Write topography isosurface on file
205          CALL DVRP_INIT( m-1, 0 )
206
207!
208!--       Create filename for buildings
209          IF ( dvrp_output == 'rtsp' )  THEN
210
211             dvrp_file   = TRIM( mode_dvrp(m) ) // '/buildings.dvr'
212             dvrp_file_c = dvrp_file
213             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
214                                    dvrp_password_c, dvrp_directory_c, &
215                                    dvrp_file_c )
216    WRITE ( 9, * ) '***  #3'
217    CALL local_flush( 9 )
218
219          ELSEIF ( dvrp_output == 'ftp' )  THEN
220
221             dvrp_file   = TRIM( mode_dvrp(m) ) // '.buildings.dvr'
222             dvrp_file_c = dvrp_file
223!             CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
224!                                   dvrp_password_c, dvrp_directory_c,    &
225!                                   dvrp_file_c )
226
227          ELSE
228
229             IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
230                dvrp_file_local   = TRIM( mode_dvrp(m) ) // '.buildings.dvr'
231                dvrp_file_local_c = dvrp_file_local
232             ELSE
233                dvrp_file_local_c = dvrp_file_c
234             ENDIF
235             CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
236
237          ENDIF
238
239!
240!--       Determine local gridpoint coordinates
241          IF ( .NOT. allocated )  THEN
242             ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
243                       zcoor_dvrp(nzb:nz_do3d) )
244             allocated = .TRUE.
245
246             DO  i = nxl, nxr+1
247                xcoor_dvrp(i) = i * dx * superelevation_x
248             ENDDO
249             DO  j = nys, nyn+1
250                ycoor_dvrp(j) = j * dy * superelevation_y
251             ENDDO
252             zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
253             nx_dvrp    = nxr+1 - nxl + 1
254             ny_dvrp    = nyn+1 - nys + 1
255             nz_dvrp    = nz_do3d - nzb + 1
256          ENDIF
257
258!
259!--       Define the grid used by dvrp
260          CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
261                          ycoor_dvrp, zcoor_dvrp )
262          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.8, 0.7, 0.6, 0.0 )
263    WRITE ( 9, * ) '***  #4'
264    CALL local_flush( 9 )
265
266!
267!--       Compute and plot isosurface in dvr-format
268          ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
269          local_pf = 0.0
270          DO  i = nxl, nxr+1
271             DO  j = nys, nyn+1
272                IF ( nzb_s_inner(j,i) > 0 )  THEN
273                      local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0
274                   ENDIF
275             ENDDO
276          ENDDO
277    WRITE ( 9, * ) '***  #4.1'
278    CALL local_flush( 9 )
279          CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
280                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
281    WRITE ( 9, * ) '***  #4.2'
282    CALL local_flush( 9 )
283          CALL DVRP_THRESHOLD( m-1, 1.0 )
284    WRITE ( 9, * ) '***  #4.3'
285    CALL local_flush( 9 )
286          CALL DVRP_VISUALIZE( m-1, 1, 0 )
287    WRITE ( 9, * ) '***  #4.4'
288    CALL local_flush( 9 )
289
290          DEALLOCATE( local_pf )
291
292          CALL DVRP_EXIT( m-1 )
293    WRITE ( 9, * ) '***  #5'
294    CALL local_flush( 9 )
295
296!
297!--       Write the surface isosurface on file
298          CALL DVRP_INIT( m-1, 0 )
299
300!
301!--       Create filename for surface
302          IF ( dvrp_output == 'rtsp' )  THEN
303
304             dvrp_file   = TRIM( mode_dvrp(m) ) // '/surface.dvr'
305             dvrp_file_c = dvrp_file
306             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
307                                    dvrp_password_c, dvrp_directory_c, &
308                                    dvrp_file_c )
309    WRITE ( 9, * ) '***  #6'
310    CALL local_flush( 9 )
311
312          ELSEIF ( dvrp_output == 'ftp' )  THEN
313
314             dvrp_file   = TRIM( mode_dvrp(m) ) // '.surface.dvr'
315             dvrp_file_c = dvrp_file
316!             CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
317!                                   dvrp_password_c, dvrp_directory_c,    &
318!                                   dvrp_file_c )
319
320          ELSE
321
322             IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
323                dvrp_file_local   = TRIM( mode_dvrp(m) ) // '.surface.dvr'
324                dvrp_file_local_c = dvrp_file_local
325             ELSE
326                dvrp_file_local_c = dvrp_file_c
327             ENDIF
328             CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
329
330          ENDIF
331
332!
333!--       Determine local gridpoint coordinates
334          IF ( .NOT. allocated )  THEN
335             ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
336                       zcoor_dvrp(nzb:nz_do3d) )
337             allocated = .TRUE.
338
339             DO  i = nxl, nxr+1
340                xcoor_dvrp(i) = i * dx * superelevation_x
341             ENDDO
342             DO  j = nys, nyn+1
343                ycoor_dvrp(j) = j * dy * superelevation_y
344             ENDDO
345             zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
346             nx_dvrp    = nxr+1 - nxl + 1
347             ny_dvrp    = nyn+1 - nys + 1
348             nz_dvrp    = nz_do3d - nzb + 1
349          ENDIF
350
351!
352!--       Define the grid used by dvrp
353          CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
354                          ycoor_dvrp, zcoor_dvrp )
355          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.6, 0.0, 0.0 )
356    WRITE ( 9, * ) '***  #7'
357    CALL local_flush( 9 )
358
359!
360!--       Compute and plot isosurface in dvr-format
361          ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
362          local_pf = 0.0
363          local_pf(:,:,0) = 1.0
364
365          CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
366                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
367          CALL DVRP_THRESHOLD( m-1, 1.0 )
368          CALL DVRP_VISUALIZE( m-1, 1, 0 )
369
370          DEALLOCATE( local_pf )
371
372          CALL DVRP_EXIT( m-1 )
373    WRITE ( 9, * ) '***  #8'
374    CALL local_flush( 9 )
375
376   
377!       ENDIF
378
379
380!
381!--    Initialize dvrp for all dvrp-calls during the run
382       CALL DVRP_INIT( m-1, 0 )
383
384!
385!--    Preliminary definition of filename for dvrp-output
386       IF ( dvrp_output == 'rtsp' )  THEN
387
388!
389!--       First initialize parameters for possible interactive steering.
390!--       Every parameter has to be passed to the respective stream.
391          pn = 1
392!
393!--       Initialize threshold counter needed for initialization of the
394!--       isosurface steering variables
395          tv = 0
396
397          DO WHILE ( mode_dvrp(pn) /= ' ' )
398
399             IF ( mode_dvrp(pn)(1:10) == 'isosurface' )  THEN
400
401                READ ( mode_dvrp(pn), '(10X,I2)' )  vn
402                steering_dvrp(pn)%name = do3d(0,vn)
403                tv = tv + 1
404
405                IF ( do3d(0,vn)(1:1) == 'w' )  THEN
406                   steering_dvrp(pn)%min  = -4.0
407                   steering_dvrp(pn)%max  =  5.0
408                ELSE
409                   steering_dvrp(pn)%min  = 288.0
410                   steering_dvrp(pn)%max  = 292.0
411                ENDIF
412
413                name_c = TRIM( do3d(0,vn) )
414    WRITE ( 9, * ) '***  #9'
415    CALL local_flush( 9 )
416                CALL DVRP_STEERING_INIT( m-1, name_c, steering_dvrp(pn)%min, &
417                                         steering_dvrp(pn)%max, threshold(tv) )
418    WRITE ( 9, * ) '***  #10'
419    CALL local_flush( 9 )
420
421             ELSEIF ( mode_dvrp(pn)(1:6) == 'slicer' )  THEN
422
423                READ ( mode_dvrp(pn), '(6X,I2)' )  vn
424                steering_dvrp(pn)%name = do2d(0,vn)
425                name_c = TRIM( do2d(0,vn) )
426
427                l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
428                section_chr = do2d(0,vn)(l-1:l)
429                SELECT CASE ( section_chr )
430                   CASE ( 'xy' )
431                      steering_dvrp(pn)%imin   = 0
432                      steering_dvrp(pn)%imax   = nz_do3d
433                      slicer_position_dvrp(pn) = section(1,1)
434                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
435                                               steering_dvrp(pn)%imin, &
436                                               steering_dvrp(pn)%imax, &
437                                               slicer_position_dvrp(pn) )
438                   CASE ( 'xz' )
439                      steering_dvrp(pn)%imin   = 0
440                      steering_dvrp(pn)%imax   = ny
441                      slicer_position_dvrp(pn) = section(1,2)
442                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
443                                               steering_dvrp(pn)%imin, &
444                                               steering_dvrp(pn)%imax, &
445                                               slicer_position_dvrp(pn) )
446                   CASE ( 'yz' )
447                      steering_dvrp(pn)%imin = 0
448                      steering_dvrp(pn)%imax = nx
449                      slicer_position_dvrp(pn) = section(1,3)
450                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
451                                               steering_dvrp(pn)%imin, &
452                                               steering_dvrp(pn)%imax, &
453                                               slicer_position_dvrp(pn) )
454                END SELECT
455
456             ENDIF
457
458             pn = pn + 1
459
460          ENDDO
461
462    WRITE ( 9, * ) '***  #11'
463    CALL local_flush( 9 )
464
465          dvrp_file = TRIM( mode_dvrp(m) ) // '/*****.dvr'
466          dvrp_file_c = dvrp_file
467          CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
468                                 dvrp_password_c, dvrp_directory_c, &
469                                 dvrp_file_c )
470    WRITE ( 9, * ) '***  #12'
471    CALL local_flush( 9 )
472
473       ELSEIF ( dvrp_output == 'ftp' )  THEN
474
475          dvrp_file   = TRIM( mode_dvrp(m) ) // '.%05d.dvr'
476          dvrp_file_c = dvrp_file
477!          CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
478!                                dvrp_password_c, dvrp_directory_c, dvrp_file_c )
479
480       ELSE
481
482          IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
483             dvrp_file_local   = TRIM( mode_dvrp(m) ) // '_%05d.dvr'
484             dvrp_file_local_c = dvrp_file_local
485          ELSE
486             dvrp_file_local_c = dvrp_file_c
487          ENDIF
488          CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
489
490       ENDIF
491
492!       dvrp_file = TRIM( mode_dvrp(m) ) // '.%05d.dvr' // CHAR( 0 )
493!       dvrp_file = TRIM( mode_dvrp(m) ) // '/*****.dvr' // CHAR( 0 )
494!       dvrp_file = '/dev/null' // CHAR( 0 )
495!       CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host, dvrp_username, dvrp_password, &
496!                             dvrp_directory, dvrp_file )
497!       CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host, dvrp_username, dvrp_password, &
498!                              dvrp_directory, dvrp_file )
499!       CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file )
500
501!
502!--    Determine local gridpoint coordinates
503       IF ( .NOT. allocated )  THEN
504          ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
505                    zcoor_dvrp(nzb:nz_do3d) )
506          allocated = .TRUE.
507
508          DO  i = nxl, nxr+1
509             xcoor_dvrp(i) = i * dx * superelevation_x
510          ENDDO
511          DO  j = nys, nyn+1
512             ycoor_dvrp(j) = j * dy * superelevation_y
513          ENDDO
514          zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
515          nx_dvrp    = nxr+1 - nxl + 1
516          ny_dvrp    = nyn+1 - nys + 1
517          nz_dvrp    = nz_do3d - nzb + 1
518       ENDIF
519
520!
521!--    Define the grid used by dvrp
522    WRITE ( 9, * ) '***  #13'
523    CALL local_flush( 9 )
524
525       CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, ycoor_dvrp, &
526                       zcoor_dvrp )
527    WRITE ( 9, * ) '***  #14'
528    CALL local_flush( 9 )
529
530
531       m = m + 1
532
533    ENDDO
534
535#endif
536 END SUBROUTINE init_dvrp
537
538 
539 SUBROUTINE init_dvrp_logging
540
541!------------------------------------------------------------------------------!
542! Description:
543! ------------
544! Initializes logging events for time measurement with dvrp software
545! and splits one PE from the global communicator in case that dvrp output
546! shall be done by one single PE.
547!------------------------------------------------------------------------------!
548#if defined( __dvrp_graphics )
549
550    USE dvrp_variables
551    USE pegrid
552
553    IMPLICIT NONE
554
555    CHARACTER (LEN=4) ::  chr
556    INTEGER           ::  idummy
557
558!
559!-- Initialize logging of calls by DVRP graphic software
560    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_INIT'
561    CALL local_flush( 9 )
562    CALL DVRP_LOG_INIT( 'DVRP_LOG' // CHAR( 0 ), 0 )
563    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_INIT'
564    CALL local_flush( 9 )
565
566!
567!-- User-defined logging events: #1 (total time needed by PALM)
568    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_SYMBOL'
569    CALL local_flush( 9 )
570    CALL DVRP_LOG_SYMBOL( 1, 'PALM_total' // CHAR( 0 ) )
571    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_SYMBOL'
572    CALL local_flush( 9 )
573    CALL DVRP_LOG_SYMBOL( 2, 'PALM_timestep' // CHAR( 0 ) )
574    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_EVENT'
575    CALL local_flush( 9 )
576    CALL DVRP_LOG_EVENT( 1, 1 )
577    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_EVENT'
578    CALL local_flush( 9 )
579
580#if defined( __parallel )
581!
582!-- Find out, if dvrp output shall be done by a dedicated PE
583    CALL local_getenv( 'use_seperate_pe_for_dvrp_output', 31, chr, idummy )
584    IF ( chr == 'true' )  THEN
585       use_seperate_pe_for_dvrp_output = .TRUE.
586    WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_SPLIT'
587    CALL local_flush( 9 )
588       CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
589    WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_SPLIT'
590    CALL local_flush( 9 )
591       CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
592    ENDIF
593#endif
594
595#endif
596 END SUBROUTINE init_dvrp_logging
597
598
599 SUBROUTINE close_dvrp
600
601!------------------------------------------------------------------------------!
602! Description:
603! ------------
604! Exit of dvrp software and finish dvrp logging
605!------------------------------------------------------------------------------!
606#if defined( __dvrp_graphics )
607
608    USE control_parameters
609    USE dvrp
610    USE dvrp_variables
611
612    INTEGER ::  m
613
614!
615!-- If required, close dvrp-software and logging of dvrp-calls
616    IF ( dt_dvrp /= 9999999.9 )  THEN
617       m = 1
618       DO WHILE ( mode_dvrp(m) /= ' ' )
619          CALL DVRP_EXIT( m-1 )
620          m = m + 1
621       ENDDO
622       CALL DVRP_LOG_EVENT( -1, 1 )   ! Logging of total cpu-time used by PALM
623       IF ( use_seperate_pe_for_dvrp_output )  THEN
624          CALL DVRP_SPLIT_EXIT( 1 )      ! Argument 0: reduced output
625       ELSE
626          CALL DVRP_LOG_EXIT( 1 )        ! Argument 0: reduced output
627       ENDIF
628    ENDIF
629
630#endif
631 END SUBROUTINE close_dvrp
Note: See TracBrowser for help on using the repository browser.