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

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