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

Last change on this file since 110 was 110, checked in by raasch, 16 years ago

New:
---
Allows runs for a coupled atmosphere-ocean LES,
coupling frequency is controlled by new d3par-parameter dt_coupling,
the coupling mode (atmosphere_to_ocean or ocean_to_atmosphere) for the
respective processes is read from environment variable coupling_mode,
which is set by the mpiexec-command,
communication between the two models is done using the intercommunicator
comm_inter,
local files opened by the ocean model get the additional suffic "_O".
Assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean.

A momentum flux can be set as top boundary condition using the new
inipar parameter top_momentumflux_u|v.

Non-cyclic boundary conditions can be used along all horizontal directions.

Quantities w*p* and w"e can be output as vertical profiles.

Initial profiles are reset to constant profiles in case that initializing_actions /= 'set_constant_profiles'. (init_rankine)

Optionally calculate km and kh from initial TKE e_init.

Changed:


Remaining variables iran changed to iran_part (advec_particles, init_particles).

In case that the presure solver is not called for every Runge-Kutta substep
(call_psolver_at_all_substeps = .F.), it is called after the first substep
instead of the last. In that case, random perturbations are also added to the
velocity field after the first substep.

Initialization of km,kh = 0.00001 for ocean = .T. (for ocean = .F. it remains 0.01).

Allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of cloud_physics = .T.).

Errors:


Bugs from code parts for non-cyclic boundary conditions are removed: loops for
u and v are starting from index nxlu, nysv, respectively. The radiation boundary
condition is used for every Runge-Kutta substep. Velocity phase speeds for
the radiation boundary conditions are calculated for the first Runge-Kutta
substep only and reused for the further substeps. New arrays c_u, c_v, and c_w
are defined for this purpose. Several index errors are removed from the
radiation boundary condition code parts. Upper bounds for calculating
u_0 and v_0 (in production_e) are nxr+1 and nyn+1 because otherwise these
values are not available in case of non-cyclic boundary conditions.

+dots_num_palm in module user, +module netcdf_control in user_init (both in user_interface)

Bugfix: wrong sign removed from the buoyancy production term in the case use_reference = .T. (production_e)

Bugfix: Error message concerning output of particle concentration (pc) modified (check_parameters).

Bugfix: Rayleigh damping for ocean fixed.

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