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

Last change on this file since 4180 was 4180, checked in by scharf, 5 years ago

removed comments in 'Former revisions' section that are older than 01.01.2019

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