Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |