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

Last change on this file since 4113 was 4099, checked in by suehring, 5 years ago

Bugfix in opening the parameter file (unit 11) in case of ocean precursor runs

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