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

Last change on this file since 449 was 449, checked in by raasch, 14 years ago

branch revision comments from Marcus (rev 410) replaced by normal revision comments

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