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

Last change on this file since 4517 was 4444, checked in by raasch, 4 years ago

bugfix: cpp-directives for serial mode added

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