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

Last change on this file since 3710 was 3705, checked in by suehring, 5 years ago

last commit documented

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