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

Last change on this file since 4573 was 4546, checked in by raasch, 5 years ago

Variables iran and iran_part completely removed, added I/O of parallel random numbers to restart file, file re-formatted to follow the PALM coding standard

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