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

Last change on this file since 2957 was 2957, checked in by Giersch, 3 years ago

Sky view factors will always be read from file now in case of automatic restarts, corrected error message in case of writing sky view factors

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