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

Last change on this file since 1320 was 1320, checked in by raasch, 10 years ago

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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