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

Last change on this file since 255 was 247, checked in by heinze, 16 years ago

Output of messages replaced by message handling routin

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