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

Last change on this file since 1413 was 1360, checked in by hoffmann, 11 years ago

last commit documented

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