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

Last change on this file since 3436 was 3421, checked in by gronemeier, 6 years ago

new surface-data output; renamed output variables (pt to theta, rho_air to rho, rho_ocean to rho_sea_water)

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