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

Last change on this file since 2512 was 2512, checked in by raasch, 4 years ago

upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny; no output if redundant ghost layer data to NetCDF files

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