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

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

last commit documented

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