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

Last change on this file since 4058 was 3967, checked in by gronemeier, 5 years ago

Save binary data of virtual measurements within separate folder

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