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

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

Code adjusted according to coding standards, renamed namelists, error messages revised until PA0347, output CASE 108 disabled

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