Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |