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

Last change on this file since 600 was 600, checked in by raasch, 13 years ago

New:
---

Changed:


Parameters moved from d3par to inipar: call_psolver_at_all_substeps,
cfl_factor, cycle_mg, mg_cycles,mg_switch_to_pe0_level, ngsrb, nsor,
omega_sor, prandtl_number, psolver, rayleigh_damping_factor,
rayleigh_damping_height, residual_limit (parin, read_var_list, write_var_list)

Due to this change, in routine skip_var_list (end of file read_var_list.f90),
variable ldum is replaced by cdum(LEN=1), because otherwise read errors (too
few data on file) would appear due to one of the additional parameters
(cycle_mg, which is a string of one single character) which are now stored
on the restart file.

Weblink to error message database changed to new trac server (message)

Errors:


Bugfix concerning check of cross-section levels on netcdf-files to be
extended (xz,yz) (netcdf)

Bugfix in opening of cross section netcdf-files (parallel opening with
netcdf4 only works for netcdf_data_format > 2) (check_open)

Default values of surface_scalarflux and surface_waterflux changed from 0.0
to 9999999.9. Giving the parameter the default values means, that the
respective surface fluxes are calculated by the MO-relations, so the old default
value did not allow to set the surface fluxes to zero explicitly.

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