Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |