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

Last change on this file since 4069 was 4069, checked in by Giersch, 2 years ago

Bugfix for masked output, compiler warning removed, test case for wind turbine model revised

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