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

Last change on this file since 1804 was 1804, checked in by maronga, 5 years ago

removed parameter file check. update of mrungui for compilation with qt5

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