Home

Context Navigation

check_open.f90 @ 141

Last change on this file since 141 was 139, checked in by raasch, 17 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: 45.3 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: