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

Last change on this file since 267 was 263, checked in by heinze, 16 years ago

Output of NetCDF messages with aid of message handling routine.

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