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

Last change on this file since 849 was 849, checked in by raasch, 12 years ago

Changed:


Original routine advec_particles split into several new subroutines and renamed
lpm.
init_particles renamed lpm_init
user_advec_particles renamed user_lpm_advec,
particle_boundary_conds renamed lpm_boundary_conds,
set_particle_attributes renamed lpm_set_attributes,
user_init_particles renamed user_lpm_init,
user_particle_attributes renamed user_lpm_set_attributes
(Makefile, lpm_droplet_collision, lpm_droplet_condensation, init_3d_model, modules, palm, read_var_list, time_integration, write_var_list, deleted: advec_particles, init_particles, particle_boundary_conds, set_particle_attributes, user_advec_particles, user_init_particles, user_particle_attributes, new: lpm, lpm_advec, lpm_boundary_conds, lpm_calc_liquid_water_content, lpm_data_output_particles, lpm_droplet_collision, lpm_drollet_condensation, lpm_exchange_horiz, lpm_extend_particle_array, lpm_extend_tails, lpm_extend_tail_array, lpm_init, lpm_init_sgs_tke, lpm_pack_arrays, lpm_read_restart_file, lpm_release_set, lpm_set_attributes, lpm_sort_arrays, lpm_write_exchange_statistics, lpm_write_restart_file, user_lpm_advec, user_lpm_init, user_lpm_set_attributes

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