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

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

New flag files allow to force unscheduled termination/restarts of batch jobs, progress output is made for batch runs, small adjustments for lxce6 and lccrayh/lccrayb

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