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

Last change on this file since 1552 was 1552, checked in by maronga, 7 years ago

last commit documented

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