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

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

update of GPL copyright

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