source: palm/trunk/SOURCE/check_open.f90 @ 400

Last change on this file since 400 was 392, checked in by raasch, 15 years ago

New:
---

Adapted for machine lck
(mrun, mbuild, subjob)

bc_lr/bc_ns in most subroutines replaced by LOGICAL variables bc_lr_cyc,
bc_ns_cyc for speed optimization
(check_parameters, diffusion_u, diffusion_v, diffusion_w, modules)

Additional timestep criterion in case of simulations with plant canopy (timestep)

Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
(check_parameters)

Clipping of dvrp output implemented. Default colourtable for particles
implemented, particle attributes (color, dvrp_size) can be set with new
parameters particle_color, particle_dvrpsize, color_interval,
dvrpsize_interval (init_dvrp, data_output_dvrp, modules, user_data_output_dvrp).
Slicer attributes (dvrp) are set with new routine set_slicer_attributes_dvrp
and are controlled with existing parameters slicer_range_limits.
(set_slicer_attributes_dvrp)

Ocean atmosphere coupling allows to use independent precursor runs in order
to account for different spin-up times. The time when coupling has to be
started is given by new inipar parameter coupling_start_time. The precursor
ocean run has to be started using new mrun option "-y" in order to add
appendix "_O" to all output files.
(check_for_restart, check_parameters, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, header, init_coupling, modules, mrun,
parin, read_var_list, surface_coupler, time_integration, write_var_list)

Polygon reduction for topography and ground plate isosurface. Reduction level
for buildings can be chosen with parameter cluster_size. (init_dvrp)

External pressure gradient (check_parameters, header, init_3d_model, modules,
parin, prognostic_equations, read_var_list, write_var_list)

New topography case 'single_street_canyon' (header, init_grid, modules, parin,
read_var_list, user_check_parameters, user_header, user_init_grid, write_var_list)

Option to predefine a target bulk velocity for conserve_volume_flow
(check_parameters, header, init_3d_model, modules, parin, read_var_list,
write_var_list)

Option for user defined 2D data output in xy cross sections at z=nzb+1
(data_output_2d, user_data_output_2d)

xy cross section output of surface heatfluxes (latent, sensible)
(average_3d_data, check_parameters, data_output_2d, modules, read_3d_binary,
sum_up_3d_data, write_3d_binary)

average_3d_data, check_for_restart, check_parameters, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, init_coupling, init_dvrp, init_grid, init_3d_model, header, mbuild, modules, mrun, package_parin, parin, prognostic_equations, read_3d_binary, read_var_list, subjob, surface_coupler, timestep, time_integration, user_check_parameters, user_data_output_2d, user_data_output_dvrp, user_header, user_init_grid, write_3d_binary, write_var_list

New: set_particle_attributes, set_slicer_attributes_dvrp

Changed:


lcmuk changed to lc to avoid problems with Intel compiler on sgi-ice
(poisfft)

For extended NetCDF files, the updated title attribute includes an update of
time_average_text where appropriate. (netcdf)

In case of restart runs without extension, initial profiles are not written
to NetCDF-file anymore. (data_output_profiles, modules, read_var_list, write_var_list)

Small change in formatting of the message handling routine concering the output in the
job protocoll. (message)

initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
independent of turbulent_inflow (check_parameters, header, init_3d_model)

2 NetCDF error numbers changed. (data_output_3d)

A Link to the website appendix_a.html is printed for further information
about the possible errors. (message)

Temperature gradient criterion for estimating the boundary layer height
replaced by the gradient criterion of Sullivan et al. (1998). (flow_statistics)

NetCDF unit attribute in timeseries output in case of statistic regions added
(netcdf)

Output of NetCDF messages with aid of message handling routine.
(check_open, close_file, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, netcdf, output_particles_netcdf)

Output of messages replaced by message handling routine.
(advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart,
check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp,
data_output_profiles, data_output_spectra, fft_xy, flow_statistics, header,
init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
netcdf, parin, plant_canopy_model, poisfft_hybrid, poismg, read_3d_binary,
read_var_list, surface_coupler, temperton_fft, timestep, user_actions,
user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy,
user_parin, user_read_restart_data, user_spectra )

Maximum number of tails is calculated from maximum number of particles and
skip_particles_for_tail (init_particles)

Value of vertical_particle_advection may differ for each particle group
(advec_particles, header, modules)

First constant in array den also defined as type double. (eqn_state_seawater)

Parameter dvrp_psize moved from particles_par to dvrp_graphics_par. (package_parin)

topography_grid_convention moved from userpar to inipar (check_parameters,
header, parin, read_var_list, user_check_parameters, user_header,
user_init_grid, user_parin, write_var_list)

Default value of grid_matching changed to strict.

Adjustments for runs on lcxt4 (necessary due to an software update on CRAY) and
for coupled runs on ibmy (mrun, subjob)

advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, check_parameters, close_file, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, message, mrun, netcdf, output_particles_netcdf, package_parin, parin, plant_canopy_model, poisfft, poisfft_hybrid, poismg, read_3d_binary, read_var_list, sort_particles, subjob, user_check_parameters, user_header, user_init_grid, user_parin, surface_coupler, temperton_fft, timestep, user_actions, user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy, user_parin, user_read_restart_data, user_spectra, write_var_list

Errors:


Bugfix: Initial hydrostatic pressure profile in case of ocean runs is now
calculated in 5 iteration steps. (init_ocean)

Bugfix: wrong sign in buoyancy production of ocean part in case of not using
the reference density (only in 3D routine production_e) (production_e)

Bugfix: output of averaged 2d/3d quantities requires that an avaraging
interval has been set, respective error message is included (check_parameters)

Bugfix: Output on unit 14 only if requested by write_binary.
(user_last_actions)

Bugfix to avoid zero division by km_neutral (production_e)

Bugfix for extended NetCDF files: In order to avoid 'data mode' errors if
updated attributes are larger than their original size, NF90_PUT_ATT is called
in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
possible performance loss; an alternative strategy would be to ensure equal
attribute size in a job chain. (netcdf)

Bugfix: correction of initial volume flow for non-flat topography (init_3d_model)
Bugfix: zero initialization of arrays within buildings for 'cyclic_fill' (init_3d_model)

Bugfix: to_be_resorted => s_av for time-averaged scalars (data_output_2d, data_output_3d)

Bugfix: error in formatting the output (message)

Bugfix: avoid that ngp_2dh_s_inner becomes zero (init_3_model)

Typographical error: unit of wpt in dots_unit (modules)

Bugfix: error in check, if particles moved further than one subdomain length.
This check must not be applied for newly released particles. (advec_particles)

Bugfix: several tail counters are initialized, particle_tail_coordinates is
only written to file if its third index is > 0, arrays for tails are allocated
with a minimum size of 10 tails if there is no tail initially (init_particles,
advec_particles)

Bugfix: pressure included for profile output (check_parameters)

Bugfix: Type of count and count_rate changed to default INTEGER on NEC machines
(cpu_log)

Bugfix: output if particle time series only if particle advection is switched
on. (time_integration)

Bugfix: qsws was calculated in case of constant heatflux = .FALSE. (prandtl_fluxes)

Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0) (data_output_2d)

Typographical errors (netcdf)

If the inversion height calculated by the prerun is zero, inflow_damping_height
must be explicitly specified (init_3d_model)

Small bugfix concerning 3d 64bit netcdf output format (header)

Bugfix: dt_fixed removed from the restart file, because otherwise, no change
from a fixed to a variable timestep would be possible in restart runs.
(read_var_list, write_var_list)

Bugfix: initial setting of time_coupling in coupled restart runs (time_integration)

advec_particles, check_parameters, cpu_log, data_output_2d, data_output_3d, header, init_3d_model, init_particles, init_ocean, modules, netcdf, prandtl_fluxes, production_e, read_var_list, time_integration, user_last_actions, write_var_list

  • Property svn:keywords set to Id
File size: 46.2 KB
RevLine 
[247]1SUBROUTINE check_open( file_id )
[1]2
3!------------------------------------------------------------------------------!
[247]4! Current revisions:
[1]5! -----------------
[392]6!
[1]7!
8! Former revisions:
9! -----------------
[3]10! $Id: check_open.f90 392 2009-09-24 10:39:14Z letzel $
[77]11!
[392]12! 277 2009-03-31 09:13:47Z heinze
13! Output of NetCDF messages with aid of message handling routine.
14! Output of messages replaced by message handling routine
15!
[198]16! 146 2008-01-17 13:08:34Z raasch
17! First opening of unit 13 openes file _0000 on all PEs (parallel version)
18! because only this file contains the global variables,
19! myid_char_14 removed
20!
[139]21! 120 2007-10-17 11:54:43Z raasch
22! Status of 3D-volume NetCDF data file only depends on switch netcdf_64bit_3d
23!
[110]24! 105 2007-08-08 07:12:55Z raasch
25! Different filenames are used in case of a coupled simulation,
26! coupling_char added to all relevant filenames
27!
[83]28! 82 2007-04-16 15:40:52Z raasch
29! Call of local_getenv removed, preprocessor directives for old systems removed
30!
[77]31! 46 2007-03-05 06:00:47Z raasch
32! +netcdf_64bit_3d to switch on 64bit offset only for 3D files
33!
[3]34! RCS Log replace by Id keyword, revision history cleaned up
35!
[1]36! Revision 1.44  2006/08/22 13:48:34  raasch
37! xz and yz cross sections now up to nzt+1
38!
39! Revision 1.1  1997/08/11 06:10:55  raasch
40! Initial revision
41!
42!
43! Description:
44! ------------
45! Check if file unit is open. If not, open file and, if necessary, write a
46! header or start other initializing actions, respectively.
47!------------------------------------------------------------------------------!
48
49    USE array_kind
50    USE arrays_3d
51    USE control_parameters
52    USE grid_variables
53    USE indices
54    USE netcdf_control
55    USE particle_attributes
56    USE pegrid
57    USE profil_parameter
58    USE statistics
59
60    IMPLICIT NONE
61
62    CHARACTER (LEN=2)   ::  suffix
[82]63    CHARACTER (LEN=20)  ::  xtext = 'time in s'
[1]64    CHARACTER (LEN=30)  ::  filename
65    CHARACTER (LEN=40)  ::  avs_coor_file, avs_coor_file_localname, &
66                            avs_data_file_localname
67    CHARACTER (LEN=80)  ::  rtext
68    CHARACTER (LEN=100) ::  avs_coor_file_catalog, avs_data_file_catalog, &
69                            batch_scp, zeile
70    CHARACTER (LEN=400) ::  command
71
72    INTEGER ::  av, anzzeile = 1, cranz, file_id, i, iaddres, ierr1, iusern, &
73                j, k, legpos = 1, timodex = 1
74    INTEGER, DIMENSION(10) ::  cucol, klist, lstyle
75
76    LOGICAL ::  avs_coor_file_found = .FALSE., avs_data_file_found = .FALSE., &
77                datleg = .TRUE., get_filenames, grid = .TRUE., netcdf_extend, &
78                rand = .TRUE., swap = .TRUE., twoxa = .TRUE., twoya = .TRUE.
79
80    REAL ::  ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak = 1.5, &
81             sizex = 250.0, sizey = 40.0, texfac = 1.5
82
83    REAL, DIMENSION(:), ALLOCATABLE      ::  eta, ho, hu
84    REAL(spk), DIMENSION(:), ALLOCATABLE ::  xkoor, ykoor, zkoor 
85
86
87    NAMELIST /RAHMEN/  anzzeile, cranz, datleg, rtext, swap
88    NAMELIST /CROSS/   ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
89                       rand, rlegfak, sizex, sizey, texfac, &
90                       timodex, twoxa, twoya, xtext
91                       
92
93!
94!-- Immediate return if file already open
95    IF ( openfile(file_id)%opened )  RETURN
96
97!
98!-- Only certain files are allowed to be re-opened
99!-- NOTE: some of the other files perhaps also could be re-opened, but it
100!--       has not been checked so far, if it works!
101    IF ( openfile(file_id)%opened_before )  THEN
102       SELECT CASE ( file_id )
[143]103          CASE ( 13, 14, 21, 22, 23, 80:85 )
[1]104             IF ( file_id == 14 .AND. openfile(file_id)%opened_before )  THEN
[247]105                message_string = 're-open of unit ' // &
[274]106                                 '14 is not verified. Please check results!'
[247]107                CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )       
[1]108             ENDIF
[143]109
[1]110          CASE DEFAULT
[247]111             WRITE( message_string, * ) 're-opening of file-id ', file_id, &
[274]112                                        ' is not allowed'
[247]113             CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )   
114               
[1]115             RETURN
[143]116
[1]117       END SELECT
118    ENDIF
119
120!
121!-- Check if file may be opened on the relevant PE
122    SELECT CASE ( file_id )
123
124       CASE ( 15, 16, 17, 18, 19, 40:49, 50:59, 81:84, 101:107, 109, 111:113, &
125              116 )
[247]126         
[1]127          IF ( myid /= 0 )  THEN
[247]128             WRITE( message_string, * ) 'opening file-id ',file_id, &
129                                        ' not allowed for PE ',myid
[277]130             CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
[1]131          ENDIF
132
133       CASE ( 21, 22, 23 )
134
135          IF ( .NOT.  data_output_2d_on_each_pe )  THEN
136             IF ( myid /= 0 )  THEN
[247]137                WRITE( message_string, * ) 'opening file-id ',file_id, &
138                                           ' not allowed for PE ',myid
[277]139                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
[247]140             END IF
[1]141          ENDIF
142
143       CASE ( 27, 28, 29, 31, 32, 33, 71:73, 90:99 )
144
145!
146!--       File-ids that are used temporarily in other routines
[247]147          WRITE( message_string, * ) 'opening file-id ',file_id, &
[274]148                                    ' is not allowed since it is used otherwise'
[247]149          CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 ) 
150         
[1]151    END SELECT
152
153!
154!-- Open relevant files
155    SELECT CASE ( file_id )
156
157       CASE ( 11 )
158
[102]159          OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
160                     STATUS='OLD' )
[1]161
162       CASE ( 13 )
163
164          IF ( myid_char == '' )  THEN
[102]165             OPEN ( 13, FILE='BININ'//coupling_char//myid_char, &
166                        FORM='UNFORMATTED', STATUS='OLD' )
[1]167          ELSE
[143]168!
169!--          First opening of unit 13 openes file _0000 on all PEs because only
170!--          this file contains the global variables
171             IF ( .NOT. openfile(file_id)%opened_before )  THEN
172                OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_0000',&
173                           FORM='UNFORMATTED', STATUS='OLD' )
174             ELSE
175                OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'//myid_char,&
176                           FORM='UNFORMATTED', STATUS='OLD' )
177             ENDIF
[1]178          ENDIF
179
180       CASE ( 14 )
181
182          IF ( myid_char == '' )  THEN
[102]183             OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, &
184                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]185          ELSE
186             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
[102]187                CALL local_system( 'mkdir  BINOUT' // coupling_char )
[1]188             ENDIF
189#if defined( __parallel )
190!
191!--          Set a barrier in order to allow that all other processors in the
192!--          directory created by PE0 can open their file
193             CALL MPI_BARRIER( comm2d, ierr )
194#endif
[146]195             OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
[102]196                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]197          ENDIF
198
199       CASE ( 15 )
200
[102]201          OPEN ( 15, FILE='RUN_CONTROL'//coupling_char, FORM='FORMATTED' )
[1]202
203       CASE ( 16 )
204
[102]205          OPEN ( 16, FILE='LIST_PROFIL'//coupling_char, FORM='FORMATTED' )
[1]206
207       CASE ( 17 )
208
[102]209          OPEN ( 17, FILE='LIST_PROFIL_1D'//coupling_char, FORM='FORMATTED' )
[1]210
211       CASE ( 18 )
212
[102]213          OPEN ( 18, FILE='CPU_MEASURES'//coupling_char, FORM='FORMATTED' )
[1]214
215       CASE ( 19 )
216
[102]217          OPEN ( 19, FILE='HEADER'//coupling_char, FORM='FORMATTED' )
[1]218
219       CASE ( 20 )
220
221          IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
[102]222             CALL local_system( 'mkdir  DATA_LOG' // coupling_char )
[1]223          ENDIF
224          IF ( myid_char == '' )  THEN
[105]225             OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', &
[102]226                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]227          ELSE
228#if defined( __parallel )
229!
230!--          Set a barrier in order to allow that all other processors in the
231!--          directory created by PE0 can open their file
232             CALL MPI_BARRIER( comm2d, ierr )
233#endif
[105]234             OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'//myid_char,&
[102]235                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]236          ENDIF
237
238       CASE ( 21 )
239
240          IF ( data_output_2d_on_each_pe )  THEN
[105]241             OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
[102]242                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]243          ELSE
[102]244             OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, &
245                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]246          ENDIF
247
248          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
249!
250!--          Output for combine_plot_fields
251             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
252                WRITE (21)  -1, nx+1, -1, ny+1    ! total array size
253                WRITE (21)   0, nx+1,  0, ny+1    ! output part
254             ENDIF
255!
256!--          Determine and write ISO2D coordiante header
257             ALLOCATE( eta(0:ny+1), ho(0:nx+1), hu(0:nx+1) )
258             hu = 0.0
259             ho = (ny+1) * dy
260             DO  i = 1, ny
261                eta(i) = REAL( i ) / ( ny + 1.0 )
262             ENDDO
263             eta(0)    = 0.0
264             eta(ny+1) = 1.0
265
266             WRITE (21)  dx,eta,hu,ho
267             DEALLOCATE( eta, ho, hu )
268
269!
270!--          Create output file for local parameters
271             IF ( iso2d_output )  THEN
[102]272                OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, &
273                           FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]274                openfile(27)%opened = .TRUE.
275             ENDIF
276
277          ENDIF
278
279       CASE ( 22 )
280
281          IF ( data_output_2d_on_each_pe )  THEN
[105]282             OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
[102]283                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]284          ELSE
[102]285             OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', &
[1]286                        POSITION='APPEND' )
287          ENDIF
288
289          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
290!
291!--          Output for combine_plot_fields
292             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
293                WRITE (22)  -1, nx+1, 0, nz+1    ! total array size
294                WRITE (22)   0, nx+1, 0, nz+1    ! output part
295             ENDIF
296!
297!--          Determine and write ISO2D coordiante header
298             ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) )
299             hu = 0.0
300             ho = zu(nz+1)
301             DO  i = 1, nz
302                eta(i) = REAL( zu(i) ) / zu(nz+1)
303             ENDDO
304             eta(0)    = 0.0
305             eta(nz+1) = 1.0
306
307             WRITE (22)  dx,eta,hu,ho
308             DEALLOCATE( eta, ho, hu )
309!
310!--          Create output file for local parameters
[102]311             OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, &
312                        FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]313             openfile(28)%opened = .TRUE.
314
315          ENDIF
316
317       CASE ( 23 )
318
319          IF ( data_output_2d_on_each_pe )  THEN
[105]320             OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
[102]321                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]322          ELSE
[102]323             OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', &
[1]324                        POSITION='APPEND' )
325          ENDIF
326
327          IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
328!
329!--          Output for combine_plot_fields
330             IF ( data_output_2d_on_each_pe  .AND.  myid_char /= '' )  THEN
331                WRITE (23)  -1, ny+1, 0, nz+1    ! total array size
332                WRITE (23)   0, ny+1, 0, nz+1    ! output part
333             ENDIF
334!
335!--          Determine and write ISO2D coordiante header
336             ALLOCATE( eta(0:nz+1), ho(0:ny+1), hu(0:ny+1) )
337             hu = 0.0
338             ho = zu(nz+1)
339             DO  i = 1, nz
340                eta(i) = REAL( zu(i) ) / zu(nz+1)
341             ENDDO
342             eta(0)    = 0.0
343             eta(nz+1) = 1.0
344
345             WRITE (23)  dx,eta,hu,ho
346             DEALLOCATE( eta, ho, hu )
347!
348!--          Create output file for local parameters
[102]349             OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, &
350                        FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]351             openfile(29)%opened = .TRUE.
352
353          ENDIF
354
355       CASE ( 30 )
356
[105]357          OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
[102]358                     FORM='UNFORMATTED' )
[1]359!
360!--       Write coordinate file for AVS
361          IF ( myid == 0 )  THEN
362#if defined( __parallel )
363!
364!--          Specifications for combine_plot_fields
365             IF ( .NOT. do3d_compress )  THEN
366                WRITE ( 30 )  -1,nx+1,-1,ny+1,0,nz_do3d
367                WRITE ( 30 )  0,nx+1,0,ny+1,0,nz_do3d
368             ENDIF
369#endif
370!
371!--          Write coordinate file for AVS:
372!--          First determine file names (including cyle numbers) of AVS files on
373!--          target machine (to which the files are to be transferred).
374!--          Therefore path information has to be obtained first.
375             IF ( avs_output )  THEN
[82]376                iaddres = LEN_TRIM( return_addres )
377                iusern  = LEN_TRIM( return_username )
[1]378
379                OPEN ( 3, FILE='OUTPUT_FILE_CONNECTIONS', FORM='FORMATTED' )
380                DO  WHILE ( .NOT. avs_coor_file_found  .OR. &
381                            .NOT. avs_data_file_found )
382
383                   READ ( 3, '(A)', END=1 )  zeile
384
385                   SELECT CASE ( zeile(1:11) )
386
387                      CASE ( 'PLOT3D_COOR' )
388                         READ ( 3, '(A/A)' )  avs_coor_file_catalog, &
389                                              avs_coor_file_localname
390                         avs_coor_file_found = .TRUE.
391
392                      CASE ( 'PLOT3D_DATA' )
393                         READ ( 3, '(A/A)' )  avs_data_file_catalog, &
394                                              avs_data_file_localname
395                         avs_data_file_found = .TRUE.
396
397                      CASE DEFAULT
398                         READ ( 3, '(A/A)' )  zeile, zeile
399
400                   END SELECT
401
402                ENDDO
403!
404!--             Now the cycle numbers on the remote machine must be obtained
405!--             using batch_scp
406       1        CLOSE ( 3 )
407                IF ( .NOT. avs_coor_file_found  .OR. &
408                     .NOT. avs_data_file_found )  THEN
[274]409                   message_string= 'no filename for AVS-data-file ' //       &
410                                   'found in MRUN-config-file' //            &
[247]411                                   ' &filename in FLD-file set to "unknown"'
412                   CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 )
[1]413
414                   avs_coor_file = 'unknown'
415                   avs_data_file = 'unknown'
416                ELSE
417                   get_filenames = .TRUE.
418                   IF ( TRIM( host ) == 'hpmuk'  .OR.  &
419                        TRIM( host ) == 'lcmuk' )  THEN
420                      batch_scp = '/home/raasch/pub/batch_scp'
421                   ELSEIF ( TRIM( host ) == 'nech' )  THEN
422                      batch_scp = '/ipf/b/b323011/pub/batch_scp'
423                   ELSEIF ( TRIM( host ) == 'ibmh'  .OR.  &
424                            TRIM( host ) == 'ibmb' )  THEN
425                      batch_scp = '/home/h/niksiraa/pub/batch_scp'
426                   ELSEIF ( TRIM( host ) == 't3eb' )  THEN
427                      batch_scp = '/home/nhbksira/pub/batch_scp'
428                   ELSE
[247]429                      message_string= 'no path for batch_scp on host "' // &
430                                       TRIM( host ) // '"'
431                      CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 )
[1]432                      get_filenames = .FALSE.
433                   ENDIF
434
435                   IF ( get_filenames )  THEN
436!
437!--                   Determine the coordinate file name.
438!--                   /etc/passwd serves as Dummy-Datei, because it is not
439!--                   really transferred.
440                      command = TRIM( batch_scp ) // ' -n -u ' // &
[82]441                         return_username(1:iusern) // ' ' // &
[1]442                         return_addres(1:iaddres) // ' /etc/passwd "' // &
443                         TRIM( avs_coor_file_catalog ) // '" ' // &
444                         TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME'
445
446                      CALL local_system( command )
447                      OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
448                      READ ( 3, '(A)' )  avs_coor_file
449                      CLOSE ( 3 )
450!
451!--                   Determine the data file name
452                      command = TRIM( batch_scp ) // ' -n -u ' // &
[82]453                         return_username(1:iusern) // ' ' // &
[1]454                         return_addres(1:iaddres) // ' /etc/passwd "' // &
455                         TRIM( avs_data_file_catalog ) // '" ' // &
456                         TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME'
457
458                      CALL local_system( command )
459                      OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
460                      READ ( 3, '(A)' )  avs_data_file
461                      CLOSE ( 3 )
462
463                   ELSE
464
465                      avs_coor_file = 'unknown'
466                      avs_data_file = 'unknown'
467
468                   ENDIF
469
470                ENDIF
471
472!
473!--             Output of the coordinate file description for FLD-file
474                OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' )
475                openfile(33)%opened = .TRUE.
476                WRITE ( 33, 3300 )  TRIM( avs_coor_file ), &
477                                    TRIM( avs_coor_file ), (nx+2)*4, &
478                                    TRIM( avs_coor_file ), (nx+2)*4+(ny+2)*4
479           
480
481                ALLOCATE( xkoor(0:nx+1), ykoor(0:ny+1), zkoor(0:nz_do3d) )
482                DO  i = 0, nx+1
483                   xkoor(i) = i * dx
484                ENDDO
485                DO  j = 0, ny+1
486                   ykoor(j) = j * dy
487                ENDDO
488                DO  k = 0, nz_do3d
489                   zkoor(k) = zu(k)
490                ENDDO
491
492!
493!--             Create and write on AVS coordinate file
494                OPEN ( 31, FILE='PLOT3D_COOR', FORM='UNFORMATTED' )
495                openfile(31)%opened = .TRUE.
496
497                WRITE (31)  xkoor, ykoor, zkoor
498                DEALLOCATE( xkoor, ykoor, zkoor )
499
500!
501!--             Create FLD file (being written on in close_file)
502                OPEN ( 32, FILE='PLOT3D_FLD', FORM='FORMATTED' )
503                openfile(32)%opened = .TRUE.
504
505!
506!--             Create flag file for compressed 3D output,
507!--             influences output commands in mrun
508                IF ( do3d_compress )  THEN
509                   OPEN ( 3, FILE='PLOT3D_COMPRESSED', FORM='FORMATTED' )
510                   WRITE ( 3, '(1X)' )
511                   CLOSE ( 3 )
512                ENDIF
513
514             ENDIF
515
516          ENDIF
517
518!
519!--       In case of data compression output of the coordinates of the
520!--       corresponding partial array of a PE only once at the top of the file
521          IF ( avs_output  .AND.  do3d_compress )  THEN
522             WRITE ( 30 )  nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
523          ENDIF
524
525       CASE ( 40:49 )
526
527          IF ( statistic_regions == 0  .AND.  file_id == 40 )  THEN
528             suffix = ''
529          ELSE
530             WRITE ( suffix, '(''_'',I1)' )  file_id - 40
531          ENDIF
[105]532          OPEN ( file_id, FILE='PLOT1D_DATA'//TRIM( coupling_char )// &
533                               TRIM( suffix ),                        &
[102]534                          FORM='FORMATTED' )
[1]535!
536!--       Write contents comments at the top of the file
537          WRITE ( file_id, 4000 )  TRIM( run_description_header ) // '    ' // &
538                                   TRIM( region( file_id - 40 ) )
539
540       CASE ( 50:59 )
541
542          IF ( statistic_regions == 0  .AND.  file_id == 50 )  THEN
543             suffix = ''
544          ELSE
545             WRITE ( suffix, '(''_'',I1)' )  file_id - 50
546          ENDIF
[105]547          OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// &
548                               TRIM( suffix ),                        &
[102]549                          FORM='FORMATTED', RECL=496 )
[1]550!
551!--       Write PROFIL parameter file for output of time series
552!--       NOTE: To be on the safe side, this output is done at the beginning of
553!--             the model run (in case of collapse) and it is repeated in
554!--             close_file, then, however, with value ranges for the coordinate
555!--             systems
556!
557!--       Firstly determine the number of the coordinate systems to be drawn
558          cranz = 0
559          DO  j = 1, 10
560             IF ( cross_ts_number_count(j) /= 0 )  cranz = cranz+1
561          ENDDO
562          rtext = '\1.0 ' // TRIM( run_description_header ) // '    ' // &
563                  TRIM( region( file_id - 50 ) )
564!
565!--       Write RAHMEN parameter
[105]566          OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// &
567                           TRIM( suffix ),                      &
[102]568                     FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]569          WRITE ( 90, RAHMEN )
570!
571!--       Determine and write CROSS parameters for the individual coordinate
572!--       systems
573          DO  j = 1, 10
574             k = cross_ts_number_count(j)
575             IF ( k /= 0 )  THEN
576!
577!--             Store curve numbers, colours and line style
578                klist(1:k) = cross_ts_numbers(1:k,j)
579                klist(k+1:10) = 999999
580                cucol(1:k) = linecolors(1:k)
581                lstyle(1:k) = linestyles(1:k)
582!
583!--             Write CROSS parameter
584                WRITE ( 90, CROSS )
585
586             ENDIF
587          ENDDO
588
589          CLOSE ( 90 )
590!
591!--       Write all labels at the top of the data file, but only during the
592!--       first run of a sequence of jobs. The following jobs copy the time
593!--       series data to the bottom of that file.
594          IF ( runnr == 0 )  THEN
595             WRITE ( file_id, 5000 )  TRIM( run_description_header ) // &
596                                      '    ' // TRIM( region( file_id - 50 ) )
597          ENDIF
598
599
600       CASE ( 80 )
601
602          IF ( myid_char == '' )  THEN
[105]603             OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
[102]604                        FORM='FORMATTED', POSITION='APPEND' )
[1]605          ELSE
606             IF ( myid == 0  .AND.  .NOT. openfile(80)%opened_before )  THEN
[102]607                CALL local_system( 'mkdir  PARTICLE_INFOS' // coupling_char )
[1]608             ENDIF
609#if defined( __parallel )
610!
611!--          Set a barrier in order to allow that thereafter all other
612!--          processors in the directory created by PE0 can open their file.
613!--          WARNING: The following barrier will lead to hanging jobs, if
614!--                   check_open is first called from routine
615!--                   allocate_prt_memory!
616             IF ( .NOT. openfile(80)%opened_before )  THEN
617                CALL MPI_BARRIER( comm2d, ierr )
618             ENDIF
619#endif
[105]620             OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
621                             myid_char,                                     &
[102]622                        FORM='FORMATTED', POSITION='APPEND' )
[1]623          ENDIF
624
625          IF ( .NOT. openfile(80)%opened_before )  THEN
626             WRITE ( 80, 8000 )  TRIM( run_description_header )
627          ENDIF
628
629       CASE ( 81 )
630
[102]631             OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', &
[1]632                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
633
634       CASE ( 82 )
635
[102]636             OPEN ( 82, FILE='PLOTSP_X_DATA'//coupling_char, FORM='FORMATTED', &
[1]637                        POSITION = 'APPEND' )
638
639       CASE ( 83 )
640
[102]641             OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', &
[1]642                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
643
644       CASE ( 84 )
645
[102]646             OPEN ( 84, FILE='PLOTSP_Y_DATA'//coupling_char, FORM='FORMATTED', &
[1]647                        POSITION='APPEND' )
648
649       CASE ( 85 )
650
651          IF ( myid_char == '' )  THEN
[105]652             OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
[102]653                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]654          ELSE
655             IF ( myid == 0  .AND.  .NOT. openfile(85)%opened_before )  THEN
[102]656                CALL local_system( 'mkdir  PARTICLE_DATA' // coupling_char )
[1]657             ENDIF
658#if defined( __parallel )
659!
660!--          Set a barrier in order to allow that thereafter all other
661!--          processors in the directory created by PE0 can open their file
662             CALL MPI_BARRIER( comm2d, ierr )
663#endif
[105]664             OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
665                        myid_char,                                         &
[102]666                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]667          ENDIF
668
669          IF ( .NOT. openfile(85)%opened_before )  THEN
670             WRITE ( 85 )  run_description_header
671!
672!--          Attention: change version number whenever the output format on
673!--                     unit 85 is changed (see also in routine advec_particles)
674             rtext = 'data format version 3.0'
675             WRITE ( 85 )  rtext
676             WRITE ( 85 )  number_of_particle_groups, &
677                           max_number_of_particle_groups
678             WRITE ( 85 )  particle_groups
679          ENDIF
680
681#if defined( __netcdf )
682       CASE ( 101, 111 )
683!
684!--       Set filename depending on unit number
685          IF ( file_id == 101 )  THEN
[102]686             filename = 'DATA_2D_XY_NETCDF' // coupling_char
[1]687             av = 0
688          ELSE
[102]689             filename = 'DATA_2D_XY_AV_NETCDF' // coupling_char
[1]690             av = 1
691          ENDIF
692!
693!--       Inquire, if there is a NetCDF file from a previuos run. This should
694!--       be opened for extension, if its dimensions and variables match the
695!--       actual run.
696          INQUIRE( FILE=filename, EXIST=netcdf_extend )
697
698          IF ( netcdf_extend )  THEN
699!
700!--          Open an existing NetCDF file for output
701             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xy(av) )
[263]702
703             CALL handle_netcdf_error( 'check_open', 20 )
[1]704!
705!--          Read header information and set all ids. If there is a mismatch
706!--          between the previuos and the actual run, netcdf_extend is returned
707!--          as .FALSE.
708             CALL define_netcdf_header( 'xy', netcdf_extend, av )
709
710!
711!--          Remove the local file, if it can not be extended
712             IF ( .NOT. netcdf_extend )  THEN
713                nc_stat = NF90_CLOSE( id_set_xy(av) )
[263]714                CALL handle_netcdf_error( 'check_open', 21 )
[1]715                CALL local_system( 'rm ' // TRIM( filename ) )
716             ENDIF
717
718          ENDIF         
719
720          IF ( .NOT. netcdf_extend )  THEN
721!
722!--          Create a new NetCDF output file
723             IF ( netcdf_64bit )  THEN
724#if defined( __netcdf_64bit )
725                nc_stat = NF90_CREATE( filename,                               &
726                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
727                                       id_set_xy(av) )
728#else
[274]729                message_string = 'NetCDF: no 64-bit offset allowed ' // &
730                                 'on this machine'
[247]731                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
732
[1]733                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
734#endif
735             ELSE
736                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
737             ENDIF
[263]738             CALL handle_netcdf_error( 'check_open', 22 )
[1]739!
740!--          Define the header
741             CALL define_netcdf_header( 'xy', netcdf_extend, av )
742
743          ENDIF
744
745       CASE ( 102, 112 )
746!
747!--       Set filename depending on unit number
748          IF ( file_id == 102 )  THEN
[102]749             filename = 'DATA_2D_XZ_NETCDF' // coupling_char
[1]750             av = 0
751          ELSE
[102]752             filename = 'DATA_2D_XZ_AV_NETCDF' // coupling_char
[1]753             av = 1
754          ENDIF
755!
756!--       Inquire, if there is a NetCDF file from a previuos run. This should
757!--       be opened for extension, if its dimensions and variables match the
758!--       actual run.
759          INQUIRE( FILE=filename, EXIST=netcdf_extend )
760
761          IF ( netcdf_extend )  THEN
762!
763!--          Open an existing NetCDF file for output
764             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xz(av) )
[263]765             CALL handle_netcdf_error( 'check_open', 23 )
[1]766!
767!--          Read header information and set all ids. If there is a mismatch
768!--          between the previuos and the actual run, netcdf_extend is returned
769!--          as .FALSE.
770             CALL define_netcdf_header( 'xz', netcdf_extend, av )
771
772!
773!--          Remove the local file, if it can not be extended
774             IF ( .NOT. netcdf_extend )  THEN
775                nc_stat = NF90_CLOSE( id_set_xz(av) )
[263]776                CALL handle_netcdf_error( 'check_open', 24 )
[1]777                CALL local_system( 'rm ' // TRIM( filename ) )
778             ENDIF
779
780          ENDIF         
781
782          IF ( .NOT. netcdf_extend )  THEN
783!
784!--          Create a new NetCDF output file
785             IF ( netcdf_64bit )  THEN
786#if defined( __netcdf_64bit )
787                nc_stat = NF90_CREATE( filename,                               &
788                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
789                                       id_set_xz(av) )
790#else
[274]791                message_string = 'NetCDF: no 64-bit offset allowed ' // & 
792                                 'on this machine'
[247]793                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
794         
[1]795                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
796#endif
797             ELSE
798                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
799             ENDIF
[263]800             CALL handle_netcdf_error( 'check_open', 25 )
[1]801!
802!--          Define the header
803             CALL define_netcdf_header( 'xz', netcdf_extend, av )
804
805          ENDIF
806
807       CASE ( 103, 113 )
808!
809!--       Set filename depending on unit number
810          IF ( file_id == 103 )  THEN
[102]811             filename = 'DATA_2D_YZ_NETCDF' // coupling_char
[1]812             av = 0
813          ELSE
[102]814             filename = 'DATA_2D_YZ_AV_NETCDF' // coupling_char
[1]815             av = 1
816          ENDIF
817!
818!--       Inquire, if there is a NetCDF file from a previuos run. This should
819!--       be opened for extension, if its dimensions and variables match the
820!--       actual run.
821          INQUIRE( FILE=filename, EXIST=netcdf_extend )
822
823          IF ( netcdf_extend )  THEN
824!
825!--          Open an existing NetCDF file for output
826             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_yz(av) )
[263]827             CALL handle_netcdf_error( 'check_open', 26 )
[1]828!
829!--          Read header information and set all ids. If there is a mismatch
830!--          between the previuos and the actual run, netcdf_extend is returned
831!--          as .FALSE.
832             CALL define_netcdf_header( 'yz', netcdf_extend, av )
833
834!
835!--          Remove the local file, if it can not be extended
836             IF ( .NOT. netcdf_extend )  THEN
837                nc_stat = NF90_CLOSE( id_set_yz(av) )
[263]838                CALL handle_netcdf_error( 'check_open', 27 )
[1]839                CALL local_system( 'rm ' // TRIM( filename ) )
840             ENDIF
841
842          ENDIF         
843
844          IF ( .NOT. netcdf_extend )  THEN
845!
846!--          Create a new NetCDF output file
847             IF ( netcdf_64bit )  THEN
848#if defined( __netcdf_64bit )
849                nc_stat = NF90_CREATE( filename,                               &
850                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET), &
851                                       id_set_yz(av) )
852#else
[274]853                message_string = 'NetCDF: no 64-bit offset allowed ' // & 
854                                 'on this machine'
[247]855                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
856               
[1]857                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
858#endif
859             ELSE
860                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
861             ENDIF
[263]862             CALL handle_netcdf_error( 'check_open', 28 )
[1]863!
864!--          Define the header
865             CALL define_netcdf_header( 'yz', netcdf_extend, av )
866
867          ENDIF
868
869       CASE ( 104 )
870!
[102]871!--       Set filename
872          filename = 'DATA_1D_PR_NETCDF' // coupling_char
873
874!
[1]875!--       Inquire, if there is a NetCDF file from a previuos run. This should
876!--       be opened for extension, if its variables match the actual run.
[102]877          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]878
879          IF ( netcdf_extend )  THEN
880!
881!--          Open an existing NetCDF file for output
[102]882             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_pr )
[263]883             CALL handle_netcdf_error( 'check_open', 29 )
[1]884!
885!--          Read header information and set all ids. If there is a mismatch
886!--          between the previuos and the actual run, netcdf_extend is returned
887!--          as .FALSE.
888             CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
889
890!
891!--          Remove the local file, if it can not be extended
892             IF ( .NOT. netcdf_extend )  THEN
893                nc_stat = NF90_CLOSE( id_set_pr )
[263]894                CALL handle_netcdf_error( 'check_open', 30 )
[102]895                CALL local_system( 'rm ' // TRIM( filename ) )
[1]896             ENDIF
897
898          ENDIF         
899
900          IF ( .NOT. netcdf_extend )  THEN
901!
902!--          Create a new NetCDF output file
903             IF ( netcdf_64bit )  THEN
904#if defined( __netcdf_64bit )
[102]905                nc_stat = NF90_CREATE( filename,                               &
[1]906                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
907                                       id_set_pr )
[247]908#else
[274]909                message_string = 'NetCDF: no 64-bit offset allowed ' // & 
910                                 'on this machine'
[247]911                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
912               
[102]913                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pr )
[1]914#endif
915             ELSE
[102]916                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pr )
[1]917             ENDIF
[263]918             CALL handle_netcdf_error( 'check_open', 31 )
[1]919!
920!--          Define the header
921             CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
922
923          ENDIF
924
925       CASE ( 105 )
926!
[102]927!--       Set filename
928          filename = 'DATA_1D_TS_NETCDF' // coupling_char
929
930!
[1]931!--       Inquire, if there is a NetCDF file from a previuos run. This should
932!--       be opened for extension, if its variables match the actual run.
[102]933          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]934
935          IF ( netcdf_extend )  THEN
936!
937!--          Open an existing NetCDF file for output
[102]938             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_ts )
[263]939             CALL handle_netcdf_error( 'check_open', 32 )
[1]940!
941!--          Read header information and set all ids. If there is a mismatch
942!--          between the previuos and the actual run, netcdf_extend is returned
943!--          as .FALSE.
944             CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
945
946!
947!--          Remove the local file, if it can not be extended
948             IF ( .NOT. netcdf_extend )  THEN
949                nc_stat = NF90_CLOSE( id_set_ts )
[263]950                CALL handle_netcdf_error( 'check_open', 33 )
[102]951                CALL local_system( 'rm ' // TRIM( filename ) )
[1]952             ENDIF
953
954          ENDIF         
955
956          IF ( .NOT. netcdf_extend )  THEN
957!
958!--          Create a new NetCDF output file
959             IF ( netcdf_64bit )  THEN
960#if defined( __netcdf_64bit )
[102]961                nc_stat = NF90_CREATE( filename,                               &
[1]962                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
963                                       id_set_ts )
[247]964#else
[274]965                message_string = 'NetCDF: no 64-bit offset allowed ' // &
966                                 'on this machine'
[247]967                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
968               
[102]969                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_ts )
[1]970#endif
971             ELSE
[102]972                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_ts )
[1]973             ENDIF
[263]974             CALL handle_netcdf_error( 'check_open', 34 )
[1]975!
976!--          Define the header
977             CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
978
979          ENDIF
980
981
982       CASE ( 106, 116 )
983!
984!--       Set filename depending on unit number
985          IF ( file_id == 106 )  THEN
[102]986             filename = 'DATA_3D_NETCDF' // coupling_char
[1]987             av = 0
988          ELSE
[102]989             filename = 'DATA_3D_AV_NETCDF' // coupling_char
[1]990             av = 1
991          ENDIF
992!
993!--       Inquire, if there is a NetCDF file from a previuos run. This should
994!--       be opened for extension, if its dimensions and variables match the
995!--       actual run.
996          INQUIRE( FILE=filename, EXIST=netcdf_extend )
997
998          IF ( netcdf_extend )  THEN
999!
1000!--          Open an existing NetCDF file for output
1001             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_3d(av) )
[263]1002             CALL handle_netcdf_error( 'check_open', 35 )
[1]1003!
1004!--          Read header information and set all ids. If there is a mismatch
1005!--          between the previuos and the actual run, netcdf_extend is returned
1006!--          as .FALSE.
1007             CALL define_netcdf_header( '3d', netcdf_extend, av )
1008
1009!
1010!--          Remove the local file, if it can not be extended
1011             IF ( .NOT. netcdf_extend )  THEN
1012                nc_stat = NF90_CLOSE( id_set_3d(av) )
[263]1013                CALL handle_netcdf_error( 'check_open', 36 )
[1]1014                CALL local_system('rm ' // TRIM( filename ) )
1015             ENDIF
1016
1017          ENDIF         
1018
1019          IF ( .NOT. netcdf_extend )  THEN
1020!
1021!--          Create a new NetCDF output file
[120]1022             IF ( netcdf_64bit_3d )  THEN
[1]1023#if defined( __netcdf_64bit )
1024                nc_stat = NF90_CREATE( filename,                               &
1025                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1026                                       id_set_3d(av) )
[247]1027#else
[274]1028                message_string = 'NetCDF: no 64-bit offset allowed ' // &
1029                                 'on this machine'
[247]1030                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
1031               
[1]1032                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
1033#endif
1034             ELSE
1035                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
1036             ENDIF
[263]1037             CALL handle_netcdf_error( 'check_open', 37 )
[1]1038!
1039!--          Define the header
1040             CALL define_netcdf_header( '3d', netcdf_extend, av )
1041
1042          ENDIF
1043
1044
1045       CASE ( 107 )
1046!
[102]1047!--       Set filename
1048          filename = 'DATA_1D_SP_NETCDF' // coupling_char
1049
1050!
[1]1051!--       Inquire, if there is a NetCDF file from a previuos run. This should
1052!--       be opened for extension, if its variables match the actual run.
[102]1053          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]1054
1055          IF ( netcdf_extend )  THEN
1056!
1057!--          Open an existing NetCDF file for output
[102]1058             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_sp )
[263]1059             CALL handle_netcdf_error( 'check_open', 38 )
1060
[1]1061!
1062!--          Read header information and set all ids. If there is a mismatch
1063!--          between the previuos and the actual run, netcdf_extend is returned
1064!--          as .FALSE.
1065             CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
1066
1067!
1068!--          Remove the local file, if it can not be extended
1069             IF ( .NOT. netcdf_extend )  THEN
1070                nc_stat = NF90_CLOSE( id_set_sp )
[263]1071                CALL handle_netcdf_error( 'check_open', 39 )
[102]1072                CALL local_system( 'rm ' // TRIM( filename ) )
[1]1073             ENDIF
1074
1075          ENDIF         
1076
1077          IF ( .NOT. netcdf_extend )  THEN
1078!
1079!--          Create a new NetCDF output file
1080             IF ( netcdf_64bit )  THEN
1081#if defined( __netcdf_64bit )
[102]1082                nc_stat = NF90_CREATE( filename,                               &
[1]1083                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1084                                       id_set_sp )
[247]1085#else
[274]1086                message_string = 'NetCDF: no 64-bit offset allowed ' // & 
1087                                 'on this machine'
[247]1088                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
1089               
[102]1090                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_sp )
[1]1091#endif
1092             ELSE
[102]1093                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_sp )
[1]1094             ENDIF
[263]1095             CALL handle_netcdf_error( 'check_open', 40 )
[1]1096!
1097!--          Define the header
1098             CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
1099
1100          ENDIF
1101
1102
1103       CASE ( 108 )
1104
1105          IF ( myid_char == '' )  THEN
[102]1106             filename = 'DATA_PRT_NETCDF' // coupling_char
[1]1107          ELSE
[105]1108             filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
1109                        myid_char
[1]1110          ENDIF
1111!
1112!--       Inquire, if there is a NetCDF file from a previuos run. This should
1113!--       be opened for extension, if its variables match the actual run.
1114          INQUIRE( FILE=filename, EXIST=netcdf_extend )
1115
1116          IF ( netcdf_extend )  THEN
1117!
1118!--          Open an existing NetCDF file for output
1119             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_prt )
[263]1120             CALL handle_netcdf_error( 'check_open', 41 )
[1]1121!
1122!--          Read header information and set all ids. If there is a mismatch
1123!--          between the previuos and the actual run, netcdf_extend is returned
1124!--          as .FALSE.
1125             CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
1126
1127!
1128!--          Remove the local file, if it can not be extended
1129             IF ( .NOT. netcdf_extend )  THEN
1130                nc_stat = NF90_CLOSE( id_set_prt )
[263]1131                CALL handle_netcdf_error( 'check_open', 42 )
[1]1132                CALL local_system( 'rm ' // filename )
1133             ENDIF
1134
1135          ENDIF         
1136
1137          IF ( .NOT. netcdf_extend )  THEN
1138
1139!
1140!--          For runs on multiple processors create the subdirectory
1141             IF ( myid_char /= '' )  THEN
1142                IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before ) &
1143                THEN    ! needs modification in case of non-extendable sets
[102]1144                   CALL local_system( 'mkdir  DATA_PRT_NETCDF' // &
[105]1145                                       TRIM( coupling_char ) // '/' )
[1]1146                ENDIF
1147#if defined( __parallel )
1148!
1149!--             Set a barrier in order to allow that all other processors in the
1150!--             directory created by PE0 can open their file
1151                CALL MPI_BARRIER( comm2d, ierr )
1152#endif
1153             ENDIF
1154
1155!
1156!--          Create a new NetCDF output file
1157             IF ( netcdf_64bit )  THEN
1158#if defined( __netcdf_64bit )
1159                nc_stat = NF90_CREATE( filename,                               &
1160                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1161                                       id_set_prt )
1162#else
[274]1163                message_string = 'NetCDF: no 64-bit offset allowed ' // & 
1164                                 'on this machine'
[247]1165                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
1166               
[1]1167                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
1168#endif
1169             ELSE
1170                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
1171             ENDIF
[263]1172             CALL handle_netcdf_error( 'check_open', 43 ) 
[1]1173
1174!
1175!--          Define the header
1176             CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
1177
1178          ENDIF
1179
1180       CASE ( 109 )
1181!
[102]1182!--       Set filename
1183          filename = 'DATA_1D_PTS_NETCDF' // coupling_char
1184
1185!
[1]1186!--       Inquire, if there is a NetCDF file from a previuos run. This should
1187!--       be opened for extension, if its variables match the actual run.
[102]1188          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]1189
1190          IF ( netcdf_extend )  THEN
1191!
1192!--          Open an existing NetCDF file for output
[102]1193             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_pts )
[263]1194             CALL handle_netcdf_error( 'check_open', 393 )
[1]1195!
1196!--          Read header information and set all ids. If there is a mismatch
1197!--          between the previuos and the actual run, netcdf_extend is returned
1198!--          as .FALSE.
1199             CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
1200
1201!
1202!--          Remove the local file, if it can not be extended
1203             IF ( .NOT. netcdf_extend )  THEN
1204                nc_stat = NF90_CLOSE( id_set_pts )
[263]1205                CALL handle_netcdf_error( 'check_open', 394 )
[102]1206                CALL local_system( 'rm ' // TRIM( filename ) )
[1]1207             ENDIF
1208
1209          ENDIF         
1210
1211          IF ( .NOT. netcdf_extend )  THEN
1212!
1213!--          Create a new NetCDF output file
1214             IF ( netcdf_64bit )  THEN
1215#if defined( __netcdf_64bit )
[102]1216                nc_stat = NF90_CREATE( filename,                               &
[1]1217                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1218                                       id_set_pts )
1219#else
[274]1220                message_string = 'NetCDF: no 64-bit offset allowed ' // & 
1221                                 'on this machine'
[247]1222                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
1223               
[102]1224                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pts )
[1]1225#endif
1226             ELSE
[102]1227                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pts )
[1]1228             ENDIF
[263]1229             CALL handle_netcdf_error( 'check_open', 395 )
[1]1230!
1231!--          Define the header
1232             CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
1233
1234          ENDIF
1235#else
1236
1237       CASE ( 101:109, 111:113, 116 )
1238
1239!
1240!--       Nothing is done in case of missing netcdf support
1241          RETURN
1242
1243#endif
1244
1245       CASE DEFAULT
1246
[247]1247          WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
[277]1248          CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
[1]1249
1250    END SELECT
1251
1252!
1253!-- Set open flag
1254    openfile(file_id)%opened = .TRUE.
1255
1256!
1257!-- Formats
12583300 FORMAT ('#'/                                                   &
1259             'coord 1  file=',A,'  filetype=unformatted'/           &
1260             'coord 2  file=',A,'  filetype=unformatted  skip=',I6/ &
1261             'coord 3  file=',A,'  filetype=unformatted  skip=',I6/ &
1262             '#')
12634000 FORMAT ('# ',A)
12645000 FORMAT ('# ',A/                                                          &
1265             '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/     &
1266             '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
1267             '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/     &
1268             '#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
12698000 FORMAT (A/                                                            &
1270             '  step    time  # of parts   lPE sent/recv  rPE sent/recv  ',&
1271             'sPE sent/recv  nPE sent/recv  max # of parts'/               &
1272             103('-'))
1273
1274 END SUBROUTINE check_open
Note: See TracBrowser for help on using the repository browser.