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

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