Home

Context Navigation

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

Last change on this file since 2864 was 2718, checked in by maronga, 7 years ago
deleting of deprecated files; headers updated where needed
Property svn:keywords set to `Id`
File size: 40.9 KB

Line
1	!> @file check_open.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: check_open.f90 2718 2018-01-02 08:49:38Z suehring $
27	! Corrected "Former revisions" section
28	!
29	! 2696 2017-12-14 17:12:51Z kanani
30	! Change in file header (GPL part)
31	!
32	! 2669 2017-12-06 16:03:27Z raasch
33	! file name extension for masked data files is changed to "_M##" and is now
34	! appended at the end of the filename,
35	! file ids not used any more have been removed
36	!
37	! 2516 2017-10-04 11:03:04Z suehring
38	! Remove tabs
39	!
40	! 2514 2017-10-04 09:52:37Z suehring
41	! upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny
42	! no output of ghost layer data
43	! iso2d-related parts removed
44	!
45	! 2300 2017-06-29 13:31:14Z raasch
46	! -host
47	!
48	! 2298 2017-06-29 09:28:18Z raasch
49	! -return_addres, return_username, avs_coor_file_..., avs_data_file_...,
50	! cross_ts_numbers, cross_ts_number_count
51	!
52	! 2101 2017-01-05 16:42:31Z suehring
53	!
54	! 2063 2016-11-10 17:14:35Z raasch
55	! bugfix: opening of PROGRESS file moved out of the NetCDF block
56	!
57	! 2040 2016-10-26 16:58:09Z gronemeier
58	! Removed open of file 'PLOTTS_DATA' ( CASE(50:59) ) as it is no longer needed
59	!
60	! 2000 2016-08-20 18:09:15Z knoop
61	! Forced header and separation lines into 80 columns
62	!
63	! 1988 2016-08-10 14:49:06Z gronemeier
64	! informative message added if files cannot be opened in newly created directory
65	!
66	! 1986 2016-08-10 14:07:17Z gronemeier
67	! Bugfix: check if output can be opened in newly created directory. If not
68	! wait one second and try again.
69	!
70	! 1974 2016-07-26 08:43:25Z gronemeier
71	! Bugfix: MPI barriers after deleting non-extendable files must only be called
72	! in case of parallel I/O
73	!
74	! 1957 2016-07-07 10:43:48Z suehring
75	! flight module added
76	!
77	! 1804 2016-04-05 16:30:18Z maronga
78	! Removed code for parameter file check (__check)
79	!
80	! 1783 2016-03-06 18:36:17Z raasch
81	! name change of netcdf routines and module + related changes
82	!
83	! 1779 2016-03-03 08:01:28Z raasch
84	! coupling_char is trimmed at every place it occurs, because it can have
85	! different length now
86	!
87	! 1745 2016-02-05 13:06:51Z gronemeier
88	! Bugfix: added MPI barrier after deleting existing non-extendable file by PE0
89	!
90	! 1682 2015-10-07 23:56:08Z knoop
91	! Code annotations made doxygen readable
92	!
93	! 1551 2015-03-03 14:18:16Z maronga
94	! Removed redundant output for combine_plot_fields
95	!
96	! 1468 2014-09-24 14:06:57Z maronga
97	! Adapted for use on up to 6-digit processor cores
98	! Added file unit 117 (PROGRESS)
99	!
100	! 1359 2014-04-11 17:15:14Z hoffmann
101	! Format of particle exchange statistics extended to reasonable numbers of
102	! particles.
103	!
104	! 1353 2014-04-08 15:21:23Z heinze
105	! REAL constants provided with KIND-attribute,
106	! declaration for unused variables xkoor, ykoor, zkoor removed
107	!
108	! 1327 2014-03-21 11:00:16Z raasch
109	! parts concerning iso2d and avs output removed
110	!
111	! 1320 2014-03-20 08:40:49Z raasch
112	! ONLY-attribute added to USE-statements,
113	! kind-parameters added to all INTEGER and REAL declaration statements,
114	! kinds are defined in new module kinds,
115	! old module precision_kind is removed,
116	! revision history before 2012 removed,
117	! comment fields (!:) to be used for variable explanations added to
118	! all variable declaration statements
119	!
120	! 1106 2013-03-04 05:31:38Z raasch
121	! array_kind renamed precision_kind
122	!
123	! 1092 2013-02-02 11:24:22Z raasch
124	! unused variables removed
125	!
126	! 1036 2012-10-22 13:43:42Z raasch
127	! code put under GPL (PALM 3.9)
128	!
129	! 1031 2012-10-19 14:35:30Z raasch
130	! netCDF4 without parallel file support implemented,
131	! opening of netCDF files are done by new routines create_netcdf_file and
132	! open_write_netcdf_file
133	!
134	! 964 2012-07-26 09:14:24Z raasch
135	! old profil-units (40:49) removed,
136	! append feature removed from unit 14
137	!
138	! 849 2012-03-15 10:35:09Z raasch
139	! comment changed
140	!
141	! 809 2012-01-30 13:32:58Z maronga
142	! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives
143	!
144	! 807 2012-01-25 11:53:51Z maronga
145	! New cpp directive "__check" implemented which is used by check_namelist_files
146	!
147	! Revision 1.1 1997/08/11 06:10:55 raasch
148	! Initial revision
149	!
150	!
151	! Description:
152	! ------------
153	!> Check if file unit is open. If not, open file and, if necessary, write a
154	!> header or start other initializing actions, respectively.
155	!------------------------------------------------------------------------------!
156	SUBROUTINE check_open( file_id )
157
158
159	USE arrays_3d, &
160	ONLY: zu
161
162	USE control_parameters, &
163	ONLY: coupling_char, data_output_2d_on_each_pe, max_masks, &
164	message_string, mid, nz_do3d, openfile, run_description_header, &
165	runnr
166
167	USE grid_variables, &
168	ONLY: dx, dy
169
170	USE indices, &
171	ONLY: nbgp, nx, nxl, nxr, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
172
173	USE kinds
174
175	#if defined( __netcdf )
176	USE NETCDF
177	#endif
178
179	USE netcdf_interface, &
180	ONLY: id_set_fl, id_set_mask, id_set_pr, id_set_prt, id_set_pts, &
181	id_set_sp, id_set_ts, id_set_xy, id_set_xz, id_set_yz, &
182	id_set_3d, nc_stat, netcdf_create_file, netcdf_data_format, &
183	netcdf_define_header, netcdf_handle_error, netcdf_open_write_file
184
185	USE particle_attributes, &
186	ONLY: max_number_of_particle_groups, number_of_particle_groups, &
187	particle_groups
188
189	USE pegrid
190
191	USE posix_calls_from_fortran, &
192	ONLY: fortran_sleep
193
194
195	IMPLICIT NONE
196
197	CHARACTER (LEN=4) :: mask_char !<
198	CHARACTER (LEN=2) :: suffix !<
199	CHARACTER (LEN=30) :: filename !<
200	CHARACTER (LEN=80) :: rtext !<
201	CHARACTER (LEN=100) :: line !<
202
203	INTEGER(iwp) :: av !<
204	INTEGER(iwp) :: file_id !<
205	INTEGER(iwp) :: i !<
206	INTEGER(iwp) :: ioerr !< IOSTAT flag for IO-commands ( 0 = no error )
207	INTEGER(iwp) :: j !<
208	INTEGER(iwp) :: k !<
209
210	LOGICAL :: netcdf_extend !<
211
212	!
213	!-- Immediate return if file already open
214	IF ( openfile(file_id)%opened ) RETURN
215
216	!
217	!-- Only certain files are allowed to be re-opened
218	!-- NOTE: some of the other files perhaps also could be re-opened, but it
219	!-- has not been checked so far, if it works!
220	IF ( openfile(file_id)%opened_before ) THEN
221	SELECT CASE ( file_id )
222	CASE ( 13, 14, 21, 22, 23, 80, 85, 117 )
223	IF ( file_id == 14 .AND. openfile(file_id)%opened_before ) THEN
224	message_string = 're-open of unit ' // &
225	'14 is not verified. Please check results!'
226	CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )
227	ENDIF
228
229	CASE DEFAULT
230	WRITE( message_string, * ) 're-opening of file-id ', file_id, &
231	' is not allowed'
232	CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )
233
234	RETURN
235
236	END SELECT
237	ENDIF
238
239	!
240	!-- Check if file may be opened on the relevant PE
241	SELECT CASE ( file_id )
242
243	CASE ( 15, 16, 17, 18, 19, 50:59, 104:105, 107, 109, 117 )
244
245	IF ( myid /= 0 ) THEN
246	WRITE( message_string, * ) 'opening file-id ',file_id, &
247	' not allowed for PE ',myid
248	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
249	ENDIF
250
251	CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks )
252
253	IF ( netcdf_data_format < 5 ) THEN
254
255	IF ( myid /= 0 ) THEN
256	WRITE( message_string, * ) 'opening file-id ',file_id, &
257	' not allowed for PE ',myid
258	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
259	ENDIF
260
261	ENDIF
262
263	CASE ( 21, 22, 23 )
264
265	IF ( .NOT. data_output_2d_on_each_pe ) THEN
266	IF ( myid /= 0 ) THEN
267	WRITE( message_string, * ) 'opening file-id ',file_id, &
268	' not allowed for PE ',myid
269	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
270	END IF
271	ENDIF
272
273	CASE ( 90:99 )
274
275	!
276	!-- File-ids that are used temporarily in other routines
277	WRITE( message_string, * ) 'opening file-id ',file_id, &
278	' is not allowed since it is used otherwise'
279	CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
280
281	END SELECT
282
283	!
284	!-- Open relevant files
285	SELECT CASE ( file_id )
286
287	CASE ( 11 )
288
289	OPEN ( 11, FILE='PARIN'//TRIM( coupling_char ), FORM='FORMATTED', &
290	STATUS='OLD' )
291
292	CASE ( 13 )
293
294	IF ( myid_char == '' ) THEN
295	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//myid_char, &
296	FORM='UNFORMATTED', STATUS='OLD' )
297	ELSE
298	!
299	!-- First opening of unit 13 openes file _000000 on all PEs because
300	!-- only this file contains the global variables
301	IF ( .NOT. openfile(file_id)%opened_before ) THEN
302	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_000000', &
303	FORM='UNFORMATTED', STATUS='OLD' )
304	ELSE
305	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'// &
306	myid_char, FORM='UNFORMATTED', STATUS='OLD' )
307	ENDIF
308	ENDIF
309
310	CASE ( 14 )
311
312	IF ( myid_char == '' ) THEN
313	OPEN ( 14, FILE='BINOUT'//TRIM( coupling_char )//myid_char, &
314	FORM='UNFORMATTED', POSITION='APPEND' )
315	ELSE
316	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
317	CALL local_system( 'mkdir BINOUT' // TRIM( coupling_char ) )
318	ENDIF
319	#if defined( __parallel )
320	!
321	!-- Set a barrier in order to allow that all other processors in the
322	!-- directory created by PE0 can open their file
323	CALL MPI_BARRIER( comm2d, ierr )
324	#endif
325	ioerr = 1
326	DO WHILE ( ioerr /= 0 )
327	OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
328	FORM='UNFORMATTED', IOSTAT=ioerr )
329	IF ( ioerr /= 0 ) THEN
330	WRITE( 9, * ) '*** could not open "BINOUT'// &
331	TRIM(coupling_char)//'/'//myid_char// &
332	'"! Trying again in 1 sec.'
333	CALL fortran_sleep( 1 )
334	ENDIF
335	ENDDO
336
337	ENDIF
338
339	CASE ( 15 )
340
341	OPEN ( 15, FILE='RUN_CONTROL'//TRIM( coupling_char ), &
342	FORM='FORMATTED' )
343
344	CASE ( 16 )
345
346	OPEN ( 16, FILE='LIST_PROFIL'//TRIM( coupling_char ), &
347	FORM='FORMATTED' )
348
349	CASE ( 17 )
350
351	OPEN ( 17, FILE='LIST_PROFIL_1D'//TRIM( coupling_char ), &
352	FORM='FORMATTED' )
353
354	CASE ( 18 )
355
356	OPEN ( 18, FILE='CPU_MEASURES'//TRIM( coupling_char ), &
357	FORM='FORMATTED' )
358
359	CASE ( 19 )
360
361	OPEN ( 19, FILE='HEADER'//TRIM( coupling_char ), FORM='FORMATTED' )
362
363	CASE ( 20 )
364
365	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
366	CALL local_system( 'mkdir DATA_LOG' // TRIM( coupling_char ) )
367	ENDIF
368	IF ( myid_char == '' ) THEN
369	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_000000', &
370	FORM='UNFORMATTED', POSITION='APPEND' )
371	ELSE
372	#if defined( __parallel )
373	!
374	!-- Set a barrier in order to allow that all other processors in the
375	!-- directory created by PE0 can open their file
376	CALL MPI_BARRIER( comm2d, ierr )
377	#endif
378	ioerr = 1
379	DO WHILE ( ioerr /= 0 )
380	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'// &
381	myid_char, FORM='UNFORMATTED', POSITION='APPEND', &
382	IOSTAT=ioerr )
383	IF ( ioerr /= 0 ) THEN
384	WRITE( 9, * ) '*** could not open "DATA_LOG'// &
385	TRIM( coupling_char )//'/'//myid_char// &
386	'"! Trying again in 1 sec.'
387	CALL fortran_sleep( 1 )
388	ENDIF
389	ENDDO
390
391	ENDIF
392
393	CASE ( 21 )
394
395	IF ( data_output_2d_on_each_pe ) THEN
396	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
397	FORM='UNFORMATTED', POSITION='APPEND' )
398	ELSE
399	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char ), &
400	FORM='UNFORMATTED', POSITION='APPEND' )
401	ENDIF
402
403	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
404	!
405	!-- Write index bounds of total domain for combine_plot_fields
406	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
407	WRITE (21) 0, nx, 0, ny
408	ENDIF
409
410	ENDIF
411
412	CASE ( 22 )
413
414	IF ( data_output_2d_on_each_pe ) THEN
415	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
416	FORM='UNFORMATTED', POSITION='APPEND' )
417	ELSE
418	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char ), &
419	FORM='UNFORMATTED', POSITION='APPEND' )
420	ENDIF
421
422	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
423	!
424	!-- Write index bounds of total domain for combine_plot_fields
425	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
426	WRITE (22) 0, nx, 0, nz+1 ! output part
427	ENDIF
428
429	ENDIF
430
431	CASE ( 23 )
432
433	IF ( data_output_2d_on_each_pe ) THEN
434	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
435	FORM='UNFORMATTED', POSITION='APPEND' )
436	ELSE
437	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char ), &
438	FORM='UNFORMATTED', POSITION='APPEND' )
439	ENDIF
440
441	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
442	!
443	!-- Write index bounds of total domain for combine_plot_fields
444	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
445	WRITE (23) 0, ny, 0, nz+1 ! output part
446	ENDIF
447
448	ENDIF
449
450	CASE ( 30 )
451
452	OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
453	FORM='UNFORMATTED' )
454	!
455	!-- Specifications for combine_plot_fields
456	IF ( myid == 0 ) THEN
457	#if defined( __parallel )
458	WRITE ( 30 ) 0, nx, 0, ny, 0, nz_do3d
459	#endif
460	ENDIF
461
462	CASE ( 80 )
463
464	IF ( myid_char == '' ) THEN
465	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
466	FORM='FORMATTED', POSITION='APPEND' )
467	ELSE
468	IF ( myid == 0 .AND. .NOT. openfile(80)%opened_before ) THEN
469	CALL local_system( 'mkdir PARTICLE_INFOS' // &
470	TRIM( coupling_char ) )
471	ENDIF
472	#if defined( __parallel )
473	!
474	!-- Set a barrier in order to allow that thereafter all other
475	!-- processors in the directory created by PE0 can open their file.
476	!-- WARNING: The following barrier will lead to hanging jobs, if
477	!-- check_open is first called from routine
478	!-- allocate_prt_memory!
479	IF ( .NOT. openfile(80)%opened_before ) THEN
480	CALL MPI_BARRIER( comm2d, ierr )
481	ENDIF
482	#endif
483	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
484	myid_char, &
485	FORM='FORMATTED', POSITION='APPEND' )
486	ENDIF
487
488	IF ( .NOT. openfile(80)%opened_before ) THEN
489	WRITE ( 80, 8000 ) TRIM( run_description_header )
490	ENDIF
491
492	CASE ( 85 )
493
494	IF ( myid_char == '' ) THEN
495	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
496	FORM='UNFORMATTED', POSITION='APPEND' )
497	ELSE
498	IF ( myid == 0 .AND. .NOT. openfile(85)%opened_before ) THEN
499	CALL local_system( 'mkdir PARTICLE_DATA' // &
500	TRIM( coupling_char ) )
501	ENDIF
502	#if defined( __parallel )
503	!
504	!-- Set a barrier in order to allow that thereafter all other
505	!-- processors in the directory created by PE0 can open their file
506	CALL MPI_BARRIER( comm2d, ierr )
507	#endif
508	ioerr = 1
509	DO WHILE ( ioerr /= 0 )
510	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
511	myid_char, &
512	FORM='UNFORMATTED', POSITION='APPEND', IOSTAT=ioerr )
513	IF ( ioerr /= 0 ) THEN
514	WRITE( 9, * ) '*** could not open "PARTICLE_DATA'// &
515	TRIM( coupling_char )//'/'//myid_char// &
516	'"! Trying again in 1 sec.'
517	CALL fortran_sleep( 1 )
518	ENDIF
519	ENDDO
520
521	ENDIF
522
523	IF ( .NOT. openfile(85)%opened_before ) THEN
524	WRITE ( 85 ) run_description_header
525	!
526	!-- Attention: change version number whenever the output format on
527	!-- unit 85 is changed (see also in routine
528	!-- lpm_data_output_particles)
529	rtext = 'data format version 3.1'
530	WRITE ( 85 ) rtext
531	WRITE ( 85 ) number_of_particle_groups, &
532	max_number_of_particle_groups
533	WRITE ( 85 ) particle_groups
534	WRITE ( 85 ) nxl, nxr, nys, nyn, nzb, nzt, nbgp
535	ENDIF
536
537	!
538	!-- Progress file that is used by the PALM watchdog
539	CASE ( 117 )
540
541	OPEN ( 117, FILE='PROGRESS'//TRIM( coupling_char ), &
542	STATUS='REPLACE', FORM='FORMATTED' )
543
544	#if defined( __netcdf )
545	CASE ( 101, 111 )
546	!
547	!-- Set filename depending on unit number
548	IF ( file_id == 101 ) THEN
549	filename = 'DATA_2D_XY_NETCDF' // TRIM( coupling_char )
550	av = 0
551	ELSE
552	filename = 'DATA_2D_XY_AV_NETCDF' // TRIM( coupling_char )
553	av = 1
554	ENDIF
555	!
556	!-- Inquire, if there is a netCDF file from a previuos run. This should
557	!-- be opened for extension, if its dimensions and variables match the
558	!-- actual run.
559	INQUIRE( FILE=filename, EXIST=netcdf_extend )
560	IF ( netcdf_extend ) THEN
561	!
562	!-- Open an existing netCDF file for output
563	CALL netcdf_open_write_file( filename, id_set_xy(av), .TRUE., 20 )
564	!
565	!-- Read header information and set all ids. If there is a mismatch
566	!-- between the previuos and the actual run, netcdf_extend is returned
567	!-- as .FALSE.
568	CALL netcdf_define_header( 'xy', netcdf_extend, av )
569
570	!
571	!-- Remove the local file, if it can not be extended
572	IF ( .NOT. netcdf_extend ) THEN
573	nc_stat = NF90_CLOSE( id_set_xy(av) )
574	CALL netcdf_handle_error( 'check_open', 21 )
575	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
576	#if defined( __parallel )
577	!
578	!-- Set a barrier in order to assure that PE0 deleted the old file
579	!-- before any other processor tries to open a new file.
580	!-- Barrier is only needed in case of parallel I/O
581	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
582	#endif
583	ENDIF
584
585	ENDIF
586
587	IF ( .NOT. netcdf_extend ) THEN
588	!
589	!-- Create a new netCDF output file with requested netCDF format
590	CALL netcdf_create_file( filename, id_set_xy(av), .TRUE., 22 )
591
592	!
593	!-- Define the header
594	CALL netcdf_define_header( 'xy', netcdf_extend, av )
595
596	!
597	!-- In case of parallel netCDF output, create flag file which tells
598	!-- combine_plot_fields that nothing is to do.
599	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
600	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
601	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
602	CLOSE( 99 )
603	ENDIF
604
605	ENDIF
606
607	CASE ( 102, 112 )
608	!
609	!-- Set filename depending on unit number
610	IF ( file_id == 102 ) THEN
611	filename = 'DATA_2D_XZ_NETCDF' // TRIM( coupling_char )
612	av = 0
613	ELSE
614	filename = 'DATA_2D_XZ_AV_NETCDF' // TRIM( coupling_char )
615	av = 1
616	ENDIF
617	!
618	!-- Inquire, if there is a netCDF file from a previuos run. This should
619	!-- be opened for extension, if its dimensions and variables match the
620	!-- actual run.
621	INQUIRE( FILE=filename, EXIST=netcdf_extend )
622
623	IF ( netcdf_extend ) THEN
624	!
625	!-- Open an existing netCDF file for output
626	CALL netcdf_open_write_file( filename, id_set_xz(av), .TRUE., 23 )
627	!
628	!-- Read header information and set all ids. If there is a mismatch
629	!-- between the previuos and the actual run, netcdf_extend is returned
630	!-- as .FALSE.
631	CALL netcdf_define_header( 'xz', netcdf_extend, av )
632
633	!
634	!-- Remove the local file, if it can not be extended
635	IF ( .NOT. netcdf_extend ) THEN
636	nc_stat = NF90_CLOSE( id_set_xz(av) )
637	CALL netcdf_handle_error( 'check_open', 24 )
638	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
639	#if defined( __parallel )
640	!
641	!-- Set a barrier in order to assure that PE0 deleted the old file
642	!-- before any other processor tries to open a new file
643	!-- Barrier is only needed in case of parallel I/O
644	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
645	#endif
646	ENDIF
647
648	ENDIF
649
650	IF ( .NOT. netcdf_extend ) THEN
651	!
652	!-- Create a new netCDF output file with requested netCDF format
653	CALL netcdf_create_file( filename, id_set_xz(av), .TRUE., 25 )
654
655	!
656	!-- Define the header
657	CALL netcdf_define_header( 'xz', netcdf_extend, av )
658
659	!
660	!-- In case of parallel netCDF output, create flag file which tells
661	!-- combine_plot_fields that nothing is to do.
662	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
663	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
664	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
665	CLOSE( 99 )
666	ENDIF
667
668	ENDIF
669
670	CASE ( 103, 113 )
671	!
672	!-- Set filename depending on unit number
673	IF ( file_id == 103 ) THEN
674	filename = 'DATA_2D_YZ_NETCDF' // TRIM( coupling_char )
675	av = 0
676	ELSE
677	filename = 'DATA_2D_YZ_AV_NETCDF' // TRIM( coupling_char )
678	av = 1
679	ENDIF
680	!
681	!-- Inquire, if there is a netCDF file from a previuos run. This should
682	!-- be opened for extension, if its dimensions and variables match the
683	!-- actual run.
684	INQUIRE( FILE=filename, EXIST=netcdf_extend )
685
686	IF ( netcdf_extend ) THEN
687	!
688	!-- Open an existing netCDF file for output
689	CALL netcdf_open_write_file( filename, id_set_yz(av), .TRUE., 26 )
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 netcdf_define_header( 'yz', 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_yz(av) )
700	CALL netcdf_handle_error( 'check_open', 27 )
701	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
702	#if defined( __parallel )
703	!
704	!-- Set a barrier in order to assure that PE0 deleted the old file
705	!-- before any other processor tries to open a new file
706	!-- Barrier is only needed in case of parallel I/O
707	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
708	#endif
709	ENDIF
710
711	ENDIF
712
713	IF ( .NOT. netcdf_extend ) THEN
714	!
715	!-- Create a new netCDF output file with requested netCDF format
716	CALL netcdf_create_file( filename, id_set_yz(av), .TRUE., 28 )
717
718	!
719	!-- Define the header
720	CALL netcdf_define_header( 'yz', netcdf_extend, av )
721
722	!
723	!-- In case of parallel netCDF output, create flag file which tells
724	!-- combine_plot_fields that nothing is to do.
725	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
726	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
727	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
728	CLOSE( 99 )
729	ENDIF
730
731	ENDIF
732
733	CASE ( 104 )
734	!
735	!-- Set filename
736	filename = 'DATA_1D_PR_NETCDF' // TRIM( coupling_char )
737
738	!
739	!-- Inquire, if there is a netCDF file from a previuos run. This should
740	!-- be opened for extension, if its variables match the actual run.
741	INQUIRE( FILE=filename, EXIST=netcdf_extend )
742
743	IF ( netcdf_extend ) THEN
744	!
745	!-- Open an existing netCDF file for output
746	CALL netcdf_open_write_file( filename, id_set_pr, .FALSE., 29 )
747	!
748	!-- Read header information and set all ids. If there is a mismatch
749	!-- between the previuos and the actual run, netcdf_extend is returned
750	!-- as .FALSE.
751	CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
752
753	!
754	!-- Remove the local file, if it can not be extended
755	IF ( .NOT. netcdf_extend ) THEN
756	nc_stat = NF90_CLOSE( id_set_pr )
757	CALL netcdf_handle_error( 'check_open', 30 )
758	CALL local_system( 'rm ' // TRIM( filename ) )
759	ENDIF
760
761	ENDIF
762
763	IF ( .NOT. netcdf_extend ) THEN
764	!
765	!-- Create a new netCDF output file with requested netCDF format
766	CALL netcdf_create_file( filename, id_set_pr, .FALSE., 31 )
767	!
768	!-- Define the header
769	CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
770
771	ENDIF
772
773	CASE ( 105 )
774	!
775	!-- Set filename
776	filename = 'DATA_1D_TS_NETCDF' // TRIM( coupling_char )
777
778	!
779	!-- Inquire, if there is a netCDF file from a previuos run. This should
780	!-- be opened for extension, if its variables match the actual run.
781	INQUIRE( FILE=filename, EXIST=netcdf_extend )
782
783	IF ( netcdf_extend ) THEN
784	!
785	!-- Open an existing netCDF file for output
786	CALL netcdf_open_write_file( filename, id_set_ts, .FALSE., 32 )
787	!
788	!-- Read header information and set all ids. If there is a mismatch
789	!-- between the previuos and the actual run, netcdf_extend is returned
790	!-- as .FALSE.
791	CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
792
793	!
794	!-- Remove the local file, if it can not be extended
795	IF ( .NOT. netcdf_extend ) THEN
796	nc_stat = NF90_CLOSE( id_set_ts )
797	CALL netcdf_handle_error( 'check_open', 33 )
798	CALL local_system( 'rm ' // TRIM( filename ) )
799	ENDIF
800
801	ENDIF
802
803	IF ( .NOT. netcdf_extend ) THEN
804	!
805	!-- Create a new netCDF output file with requested netCDF format
806	CALL netcdf_create_file( filename, id_set_ts, .FALSE., 34 )
807	!
808	!-- Define the header
809	CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
810
811	ENDIF
812
813
814	CASE ( 106, 116 )
815	!
816	!-- Set filename depending on unit number
817	IF ( file_id == 106 ) THEN
818	filename = 'DATA_3D_NETCDF' // TRIM( coupling_char )
819	av = 0
820	ELSE
821	filename = 'DATA_3D_AV_NETCDF' // TRIM( coupling_char )
822	av = 1
823	ENDIF
824	!
825	!-- Inquire, if there is a netCDF file from a previous run. This should
826	!-- be opened for extension, if its dimensions and variables match the
827	!-- actual run.
828	INQUIRE( FILE=filename, EXIST=netcdf_extend )
829
830	IF ( netcdf_extend ) THEN
831	!
832	!-- Open an existing netCDF file for output
833	CALL netcdf_open_write_file( filename, id_set_3d(av), .TRUE., 35 )
834	!
835	!-- Read header information and set all ids. If there is a mismatch
836	!-- between the previuos and the actual run, netcdf_extend is returned
837	!-- as .FALSE.
838	CALL netcdf_define_header( '3d', netcdf_extend, av )
839
840	!
841	!-- Remove the local file, if it can not be extended
842	IF ( .NOT. netcdf_extend ) THEN
843	nc_stat = NF90_CLOSE( id_set_3d(av) )
844	CALL netcdf_handle_error( 'check_open', 36 )
845	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
846	#if defined( __parallel )
847	!
848	!-- Set a barrier in order to assure that PE0 deleted the old file
849	!-- before any other processor tries to open a new file
850	!-- Barrier is only needed in case of parallel I/O
851	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
852	#endif
853	ENDIF
854
855	ENDIF
856
857	IF ( .NOT. netcdf_extend ) THEN
858	!
859	!-- Create a new netCDF output file with requested netCDF format
860	CALL netcdf_create_file( filename, id_set_3d(av), .TRUE., 37 )
861
862	!
863	!-- Define the header
864	CALL netcdf_define_header( '3d', netcdf_extend, av )
865
866	!
867	!-- In case of parallel netCDF output, create flag file which tells
868	!-- combine_plot_fields that nothing is to do.
869	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
870	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
871	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
872	CLOSE( 99 )
873	ENDIF
874
875	ENDIF
876
877
878	CASE ( 107 )
879	!
880	!-- Set filename
881	filename = 'DATA_1D_SP_NETCDF' // TRIM( coupling_char )
882
883	!
884	!-- Inquire, if there is a netCDF file from a previuos run. This should
885	!-- be opened for extension, if its variables match the actual run.
886	INQUIRE( FILE=filename, EXIST=netcdf_extend )
887
888	IF ( netcdf_extend ) THEN
889	!
890	!-- Open an existing netCDF file for output
891	CALL netcdf_open_write_file( filename, id_set_sp, .FALSE., 38 )
892
893	!
894	!-- Read header information and set all ids. If there is a mismatch
895	!-- between the previuos and the actual run, netcdf_extend is returned
896	!-- as .FALSE.
897	CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
898
899	!
900	!-- Remove the local file, if it can not be extended
901	IF ( .NOT. netcdf_extend ) THEN
902	nc_stat = NF90_CLOSE( id_set_sp )
903	CALL netcdf_handle_error( 'check_open', 39 )
904	CALL local_system( 'rm ' // TRIM( filename ) )
905	ENDIF
906
907	ENDIF
908
909	IF ( .NOT. netcdf_extend ) THEN
910	!
911	!-- Create a new netCDF output file with requested netCDF format
912	CALL netcdf_create_file( filename, id_set_sp, .FALSE., 40 )
913	!
914	!-- Define the header
915	CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
916
917	ENDIF
918
919
920	CASE ( 108 )
921
922	IF ( myid_char == '' ) THEN
923	filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char )
924	ELSE
925	filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
926	myid_char
927	ENDIF
928	!
929	!-- Inquire, if there is a netCDF file from a previuos run. This should
930	!-- be opened for extension, if its variables match the actual run.
931	INQUIRE( FILE=filename, EXIST=netcdf_extend )
932
933	IF ( netcdf_extend ) THEN
934	!
935	!-- Open an existing netCDF file for output
936	CALL netcdf_open_write_file( filename, id_set_prt, .FALSE., 41 )
937	!
938	!-- Read header information and set all ids. If there is a mismatch
939	!-- between the previuos and the actual run, netcdf_extend is returned
940	!-- as .FALSE.
941	CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
942
943	!
944	!-- Remove the local file, if it can not be extended
945	IF ( .NOT. netcdf_extend ) THEN
946	nc_stat = NF90_CLOSE( id_set_prt )
947	CALL netcdf_handle_error( 'check_open', 42 )
948	CALL local_system( 'rm ' // TRIM( filename ) )
949	ENDIF
950
951	ENDIF
952
953	IF ( .NOT. netcdf_extend ) THEN
954
955	!
956	!-- For runs on multiple processors create the subdirectory
957	IF ( myid_char /= '' ) THEN
958	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) &
959	THEN ! needs modification in case of non-extendable sets
960	CALL local_system( 'mkdir DATA_PRT_NETCDF' // &
961	TRIM( coupling_char ) // '/' )
962	ENDIF
963	#if defined( __parallel )
964	!
965	!-- Set a barrier in order to allow that all other processors in the
966	!-- directory created by PE0 can open their file
967	CALL MPI_BARRIER( comm2d, ierr )
968	#endif
969	ENDIF
970
971	!
972	!-- Create a new netCDF output file with requested netCDF format
973	CALL netcdf_create_file( filename, id_set_prt, .FALSE., 43 )
974
975	!
976	!-- Define the header
977	CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
978
979	ENDIF
980
981	CASE ( 109 )
982	!
983	!-- Set filename
984	filename = 'DATA_1D_PTS_NETCDF' // TRIM( coupling_char )
985
986	!
987	!-- Inquire, if there is a netCDF file from a previuos run. This should
988	!-- be opened for extension, if its variables match the actual run.
989	INQUIRE( FILE=filename, EXIST=netcdf_extend )
990
991	IF ( netcdf_extend ) THEN
992	!
993	!-- Open an existing netCDF file for output
994	CALL netcdf_open_write_file( filename, id_set_pts, .FALSE., 393 )
995	!
996	!-- Read header information and set all ids. If there is a mismatch
997	!-- between the previuos and the actual run, netcdf_extend is returned
998	!-- as .FALSE.
999	CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
1000
1001	!
1002	!-- Remove the local file, if it can not be extended
1003	IF ( .NOT. netcdf_extend ) THEN
1004	nc_stat = NF90_CLOSE( id_set_pts )
1005	CALL netcdf_handle_error( 'check_open', 394 )
1006	CALL local_system( 'rm ' // TRIM( filename ) )
1007	ENDIF
1008
1009	ENDIF
1010
1011	IF ( .NOT. netcdf_extend ) THEN
1012	!
1013	!-- Create a new netCDF output file with requested netCDF format
1014	CALL netcdf_create_file( filename, id_set_pts, .FALSE., 395 )
1015	!
1016	!-- Define the header
1017	CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
1018
1019	ENDIF
1020
1021	!
1022	!-- nc-file for virtual flight measurements
1023	CASE ( 199 )
1024	!
1025	!-- Set filename
1026	filename = 'DATA_1D_FL_NETCDF' // TRIM( coupling_char )
1027
1028	!
1029	!-- Inquire, if there is a netCDF file from a previuos run. This should
1030	!-- be opened for extension, if its variables match the actual run.
1031	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1032
1033	IF ( netcdf_extend ) THEN
1034	!
1035	!-- Open an existing netCDF file for output
1036	CALL netcdf_open_write_file( filename, id_set_fl, .FALSE., 532 )
1037	!
1038	!-- Read header information and set all ids. If there is a mismatch
1039	!-- between the previuos and the actual run, netcdf_extend is returned
1040	!-- as .FALSE.
1041	CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
1042
1043	!
1044	!-- Remove the local file, if it can not be extended
1045	IF ( .NOT. netcdf_extend ) THEN
1046	nc_stat = NF90_CLOSE( id_set_fl )
1047	CALL netcdf_handle_error( 'check_open', 533 )
1048	CALL local_system( 'rm ' // TRIM( filename ) )
1049	ENDIF
1050
1051	ENDIF
1052
1053	IF ( .NOT. netcdf_extend ) THEN
1054	!
1055	!-- Create a new netCDF output file with requested netCDF format
1056	CALL netcdf_create_file( filename, id_set_fl, .FALSE., 534 )
1057	!
1058	!-- Define the header
1059	CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
1060
1061	ENDIF
1062
1063
1064	CASE ( 201:200+2*max_masks )
1065	!
1066	!-- Set filename depending on unit number
1067	IF ( file_id <= 200+max_masks ) THEN
1068	mid = file_id - 200
1069	WRITE ( mask_char,'(A2,I2.2)') '_M', mid
1070	filename = 'DATA_MASK_NETCDF' // TRIM( coupling_char ) // &
1071	mask_char
1072	av = 0
1073	ELSE
1074	mid = file_id - (200+max_masks)
1075	WRITE ( mask_char,'(A2,I2.2)') '_M', mid
1076	filename = 'DATA_MASK_AV_NETCDF' // TRIM( coupling_char ) // &
1077	mask_char
1078	av = 1
1079	ENDIF
1080	!
1081	!-- Inquire, if there is a netCDF file from a previuos run. This should
1082	!-- be opened for extension, if its dimensions and variables match the
1083	!-- actual run.
1084	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1085
1086	IF ( netcdf_extend ) THEN
1087	!
1088	!-- Open an existing netCDF file for output
1089	CALL netcdf_open_write_file( filename, id_set_mask(mid,av), &
1090	.TRUE., 456 )
1091	!
1092	!-- Read header information and set all ids. If there is a mismatch
1093	!-- between the previuos and the actual run, netcdf_extend is returned
1094	!-- as .FALSE.
1095	CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
1096
1097	!
1098	!-- Remove the local file, if it can not be extended
1099	IF ( .NOT. netcdf_extend ) THEN
1100	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
1101	CALL netcdf_handle_error( 'check_open', 457 )
1102	CALL local_system('rm ' // TRIM( filename ) )
1103	ENDIF
1104
1105	ENDIF
1106
1107	IF ( .NOT. netcdf_extend ) THEN
1108	!
1109	!-- Create a new netCDF output file with requested netCDF format
1110	CALL netcdf_create_file( filename, id_set_mask(mid,av), .TRUE., 458 )
1111	!
1112	!-- Define the header
1113	CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
1114
1115	ENDIF
1116
1117
1118	#else
1119
1120	CASE ( 101:109, 111:113, 116, 201:200+2*max_masks )
1121
1122	!
1123	!-- Nothing is done in case of missing netcdf support
1124	RETURN
1125
1126	#endif
1127
1128	CASE DEFAULT
1129
1130	WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
1131	CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
1132
1133	END SELECT
1134
1135	!
1136	!-- Set open flag
1137	openfile(file_id)%opened = .TRUE.
1138
1139	!
1140	!-- Formats
1141	3300 FORMAT ('#'/ &
1142	'coord 1 file=',A,' filetype=unformatted'/ &
1143	'coord 2 file=',A,' filetype=unformatted skip=',I6/ &
1144	'coord 3 file=',A,' filetype=unformatted skip=',I6/ &
1145	'#')
1146	4000 FORMAT ('# ',A)
1147	5000 FORMAT ('# ',A/ &
1148	'#1 E'/'#2 E'/'#3 dt'/'#4 u'/'#5 th*'/'#6 umax'/'#7 vmax'/ &
1149	'#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
1150	'#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/ &
1151	'#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
1152	8000 FORMAT (A/ &
1153	' step time # of parts lPE sent/recv rPE sent/recv ',&
1154	'sPE sent/recv nPE sent/recv max # of parts '/ &
1155	109('-'))
1156
1157	END SUBROUTINE check_open

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |