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

Last change on this file since 3183 was 3159, checked in by sward, 6 years ago

Added multi agent system

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