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

Last change on this file since 1353 was 1353, checked in by heinze, 10 years ago

REAL constants provided with KIND-attribute

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