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

Last change on this file since 3930 was 3812, checked in by gronemeier, 6 years ago

Open binary surface output data within separate folder

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