Home

Context Navigation

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

Last change on this file since 2569 was 2516, checked in by suehring, 7 years ago
document changes
Property svn:keywords set to `Id`
File size: 41.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |