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

Last change on this file since 1359 was 1359, checked in by hoffmann, 10 years ago

new Lagrangian particle structure integrated

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