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

Last change on this file since 287 was 277, checked in by heinze, 16 years ago

Change of arguments in message calls whenever there are errors induced by MPI-ABORT

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