Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |