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

Last change on this file since 2997 was 2964, checked in by Giersch, 7 years ago

Bugfix in the calculation of fixed number of output time levels for parallel netcdf output, error message related to reading sky view factors revised

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