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

Last change on this file since 3812 was 3812, checked in by gronemeier, 2 years ago

Open binary surface output data within separate folder

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