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

Last change on this file since 2604 was 2516, checked in by suehring, 7 years ago

document changes

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