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

Last change on this file since 4178 was 4128, checked in by gronemeier, 2 years ago

Bugfix for opening the parameter file (unit 11): return error message if file was not found.

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