Home

Context Navigation

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

Last change on this file since 1320 was 1320, checked in by raasch, 11 years ago
ONLY-attribute added to USE-statements, kind-parameters added to all INTEGER and REAL declaration statements, kinds are defined in new module kinds, old module precision_kind is removed, revision history before 2012 removed, comment fields (!:) to be used for variable explanations added to all variable declaration statements
Property svn:keywords set to `Id`
File size: 47.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |