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

Last change on this file since 2906 was 2906, checked in by Giersch, 4 years ago

new procedure for reading/writing svf data, initialization of local variable ids

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