Home

Context Navigation

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

Last change on this file since 3036 was 2964, checked in by Giersch, 7 years ago
Bugfix in the calculation of fixed number of output time levels for parallel netcdf output, error message related to reading sky view factors revised
Property svn:keywords set to `Id`
File size: 43.0 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |