Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |