source: palm/tags/release-3.2a/SOURCE/check_open.f90 @ 3452

Last change on this file since 3452 was 83, checked in by raasch, 17 years ago

New:
---

Changed:


PALM can be generally installed on any kind of Linux-, IBM-AIX-, or NEC-SX-system by adding appropriate settings to the configuration file.

Scripts are also running under the public domain ksh.

All system relevant compile and link options as well as the host identifier (local_host) are specified in the configuration file.

Filetransfer by ftp removed (options -f removed from mrun and mbuild).

Call of (system-)FLUSH routine moved to new routine local_flush.

return_addres and return_username are read from ENVPAR-NAMELIST-file instead of using local_getenv.

Preprocessor strings for different linux clusters changed to "lc", some preprocessor directives renamed (new: intel_openmp_bug), preprocessor directives for old systems removed

advec_particles, check_open, cpu_log, cpu_statistics, data_output_dvrp, flow_statistics, header, init_dvrp, init_particles, init_1d_model, init_dvrp, init_pegrid, local_getenv, local_system, local_tremain, local_tremain_ini, modules, palm, parin, run_control

new:
local_flush

mbuild, mrun

Errors:


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