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

Last change on this file since 810 was 810, checked in by maronga, 12 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 56.8 KB
RevLine 
[247]1SUBROUTINE check_open( file_id )
[1]2
3!------------------------------------------------------------------------------!
[247]4! Current revisions:
[1]5! -----------------
6!
[810]7!
[1]8! Former revisions:
9! -----------------
[3]10! $Id: check_open.f90 810 2012-01-30 13:40:12Z maronga $
[810]11!
12! 809 2012-01-30 13:32:58Z maronga
13! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives
14!
[808]15! 807 2012-01-25 11:53:51Z maronga
16! New cpp directive "__check" implemented which is used by check_namelist_files
17!
[766]18! Bugfix concerning opening of 3D files in restart runs in case of netCDF4
[77]19!
[668]20! 667 2010-12-23 12:06:00Z suehring/gryschka
21! Output of total array size was adapted to nbgp.
22!
[601]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!
[565]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!
[520]31! 519 2010-03-19 05:30:02Z raasch
32! NetCDF4 support for particle data
33!
[494]34! 493 2010-03-01 08:30:24Z raasch
35! NetCDF4 support (parallel output)
36!
[449]37! 410 2009-12-04 17:05:40Z letzel
38! masked data output
39!
[392]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!
[198]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!
[139]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!
[110]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!
[83]56! 82 2007-04-16 15:40:52Z raasch
57! Call of local_getenv removed, preprocessor directives for old systems removed
58!
[77]59! 46 2007-03-05 06:00:47Z raasch
60! +netcdf_64bit_3d to switch on 64bit offset only for 3D files
61!
[3]62! RCS Log replace by Id keyword, revision history cleaned up
63!
[1]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
[410]90    CHARACTER (LEN=2)   ::  mask_char, suffix
[82]91    CHARACTER (LEN=20)  ::  xtext = 'time in s'
[1]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
[809]125#if ! defined ( __check )
[1]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 )
[143]132          CASE ( 13, 14, 21, 22, 23, 80:85 )
[1]133             IF ( file_id == 14 .AND. openfile(file_id)%opened_before )  THEN
[247]134                message_string = 're-open of unit ' // &
[274]135                                 '14 is not verified. Please check results!'
[247]136                CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )       
[1]137             ENDIF
[143]138
[1]139          CASE DEFAULT
[247]140             WRITE( message_string, * ) 're-opening of file-id ', file_id, &
[274]141                                        ' is not allowed'
[247]142             CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )   
143               
[1]144             RETURN
[143]145
[1]146       END SELECT
147    ENDIF
[807]148#endif
[1]149
150!
151!-- Check if file may be opened on the relevant PE
152    SELECT CASE ( file_id )
153
[493]154       CASE ( 15, 16, 17, 18, 19, 40:49, 50:59, 81:84, 104:105, 107, 109 )
[410]155             
[493]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
[564]162       CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks )
[493]163
164          IF ( netcdf_data_format < 3 )  THEN
[247]165         
[410]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             
[493]172          ENDIF
[1]173
174       CASE ( 21, 22, 23 )
175
176          IF ( .NOT.  data_output_2d_on_each_pe )  THEN
177             IF ( myid /= 0 )  THEN
[247]178                WRITE( message_string, * ) 'opening file-id ',file_id, &
179                                           ' not allowed for PE ',myid
[277]180                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
[247]181             END IF
[1]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
[247]188          WRITE( message_string, * ) 'opening file-id ',file_id, &
[274]189                                    ' is not allowed since it is used otherwise'
[247]190          CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 ) 
191         
[1]192    END SELECT
193
194!
195!-- Open relevant files
196    SELECT CASE ( file_id )
197
198       CASE ( 11 )
199
[807]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
[102]214          OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
215                     STATUS='OLD' )
[807]216#endif
[1]217
218       CASE ( 13 )
219
220          IF ( myid_char == '' )  THEN
[102]221             OPEN ( 13, FILE='BININ'//coupling_char//myid_char, &
222                        FORM='UNFORMATTED', STATUS='OLD' )
[1]223          ELSE
[143]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
[1]234          ENDIF
235
236       CASE ( 14 )
237
238          IF ( myid_char == '' )  THEN
[102]239             OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, &
240                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]241          ELSE
242             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
[102]243                CALL local_system( 'mkdir  BINOUT' // coupling_char )
[1]244             ENDIF
[809]245#if defined( __parallel ) && ! defined ( __check )
[1]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
[146]251             OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
[102]252                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]253          ENDIF
254
255       CASE ( 15 )
256
[102]257          OPEN ( 15, FILE='RUN_CONTROL'//coupling_char, FORM='FORMATTED' )
[1]258
259       CASE ( 16 )
260
[102]261          OPEN ( 16, FILE='LIST_PROFIL'//coupling_char, FORM='FORMATTED' )
[1]262
263       CASE ( 17 )
264
[102]265          OPEN ( 17, FILE='LIST_PROFIL_1D'//coupling_char, FORM='FORMATTED' )
[1]266
267       CASE ( 18 )
268
[102]269          OPEN ( 18, FILE='CPU_MEASURES'//coupling_char, FORM='FORMATTED' )
[1]270
271       CASE ( 19 )
272
[102]273          OPEN ( 19, FILE='HEADER'//coupling_char, FORM='FORMATTED' )
[1]274
275       CASE ( 20 )
276
277          IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
[102]278             CALL local_system( 'mkdir  DATA_LOG' // coupling_char )
[1]279          ENDIF
280          IF ( myid_char == '' )  THEN
[105]281             OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', &
[102]282                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]283          ELSE
[809]284#if defined( __parallel ) && ! defined ( __check )
[1]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
[105]290             OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'//myid_char,&
[102]291                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]292          ENDIF
293
294       CASE ( 21 )
295
296          IF ( data_output_2d_on_each_pe )  THEN
[105]297             OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
[102]298                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]299          ELSE
[102]300             OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, &
301                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]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
[667]308                WRITE (21)  -nbgp, nx+nbgp, -nbgp, ny+nbgp    ! total array size
[1]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
[102]328                OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, &
329                           FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]330                openfile(27)%opened = .TRUE.
331             ENDIF
332
333          ENDIF
334
335       CASE ( 22 )
336
337          IF ( data_output_2d_on_each_pe )  THEN
[105]338             OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
[102]339                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]340          ELSE
[102]341             OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', &
[1]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
[667]349                WRITE (22)  -nbgp, nx+nbgp, 0, nz+1    ! total array size
[1]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
[102]367             OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, &
368                        FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]369             openfile(28)%opened = .TRUE.
370
371          ENDIF
372
373       CASE ( 23 )
374
375          IF ( data_output_2d_on_each_pe )  THEN
[105]376             OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
[102]377                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]378          ELSE
[102]379             OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', &
[1]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
[667]387                WRITE (23)  -nbgp, ny+nbgp, 0, nz+1    ! total array size
[1]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
[102]405             OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, &
406                        FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]407             openfile(29)%opened = .TRUE.
408
409          ENDIF
410
411       CASE ( 30 )
412
[105]413          OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
[102]414                     FORM='UNFORMATTED' )
[1]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
[667]422                WRITE ( 30 )  -nbgp,nx+nbgp,-nbgp,ny+nbgp, 0 ,nz_do3d
[1]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
[82]432                iaddres = LEN_TRIM( return_addres )
433                iusern  = LEN_TRIM( return_username )
[1]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
[274]465                   message_string= 'no filename for AVS-data-file ' //       &
466                                   'found in MRUN-config-file' //            &
[247]467                                   ' &filename in FLD-file set to "unknown"'
468                   CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 )
[1]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
[247]485                      message_string= 'no path for batch_scp on host "' // &
486                                       TRIM( host ) // '"'
487                      CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 )
[1]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 ' // &
[82]497                         return_username(1:iusern) // ' ' // &
[1]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 ' // &
[82]509                         return_username(1:iusern) // ' ' // &
[1]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 ), &
[667]533                                    TRIM( avs_coor_file ), (nx+2*nbgp)*4, &
534                                    TRIM( avs_coor_file ), (nx+2*nbgp)*4+(ny+2*nbgp)*4
[1]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
[667]578             WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb, nz_do3d
[1]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
[105]588          OPEN ( file_id, FILE='PLOT1D_DATA'//TRIM( coupling_char )// &
589                               TRIM( suffix ),                        &
[102]590                          FORM='FORMATTED' )
[1]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
[105]603          OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// &
604                               TRIM( suffix ),                        &
[102]605                          FORM='FORMATTED', RECL=496 )
[1]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
[105]622          OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// &
623                           TRIM( suffix ),                      &
[102]624                     FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]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
[105]659             OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
[102]660                        FORM='FORMATTED', POSITION='APPEND' )
[1]661          ELSE
662             IF ( myid == 0  .AND.  .NOT. openfile(80)%opened_before )  THEN
[102]663                CALL local_system( 'mkdir  PARTICLE_INFOS' // coupling_char )
[1]664             ENDIF
[809]665#if defined( __parallel ) && ! defined ( __check )
[1]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
[105]676             OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
677                             myid_char,                                     &
[102]678                        FORM='FORMATTED', POSITION='APPEND' )
[1]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
[102]687             OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', &
[1]688                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
689
690       CASE ( 82 )
691
[102]692             OPEN ( 82, FILE='PLOTSP_X_DATA'//coupling_char, FORM='FORMATTED', &
[1]693                        POSITION = 'APPEND' )
694
695       CASE ( 83 )
696
[102]697             OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', &
[1]698                        DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
699
700       CASE ( 84 )
701
[102]702             OPEN ( 84, FILE='PLOTSP_Y_DATA'//coupling_char, FORM='FORMATTED', &
[1]703                        POSITION='APPEND' )
704
705       CASE ( 85 )
706
707          IF ( myid_char == '' )  THEN
[105]708             OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
[102]709                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]710          ELSE
711             IF ( myid == 0  .AND.  .NOT. openfile(85)%opened_before )  THEN
[102]712                CALL local_system( 'mkdir  PARTICLE_DATA' // coupling_char )
[1]713             ENDIF
[809]714#if defined( __parallel ) && ! defined ( __check )
[1]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
[105]720             OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
721                        myid_char,                                         &
[102]722                        FORM='UNFORMATTED', POSITION='APPEND' )
[1]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 advec_particles)
730             rtext = 'data format version 3.0'
731             WRITE ( 85 )  rtext
732             WRITE ( 85 )  number_of_particle_groups, &
733                           max_number_of_particle_groups
734             WRITE ( 85 )  particle_groups
735          ENDIF
736
737#if defined( __netcdf )
738       CASE ( 101, 111 )
739!
740!--       Set filename depending on unit number
741          IF ( file_id == 101 )  THEN
[102]742             filename = 'DATA_2D_XY_NETCDF' // coupling_char
[1]743             av = 0
744          ELSE
[102]745             filename = 'DATA_2D_XY_AV_NETCDF' // coupling_char
[1]746             av = 1
747          ENDIF
748!
749!--       Inquire, if there is a NetCDF file from a previuos run. This should
750!--       be opened for extension, if its dimensions and variables match the
751!--       actual run.
752          INQUIRE( FILE=filename, EXIST=netcdf_extend )
753
754          IF ( netcdf_extend )  THEN
755!
[493]756!--          Open an existing NetCDF file for output
[600]757             IF ( netcdf_data_format < 3 )  THEN
758                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xy(av) )
759             ELSE
[493]760#if defined( __netcdf4 )
[600]761                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xy(av), &
762                                     COMM = comm2d, INFO = MPI_INFO_NULL )
[493]763#endif
[600]764             ENDIF
[263]765
766             CALL handle_netcdf_error( 'check_open', 20 )
[1]767!
768!--          Read header information and set all ids. If there is a mismatch
769!--          between the previuos and the actual run, netcdf_extend is returned
770!--          as .FALSE.
771             CALL define_netcdf_header( 'xy', netcdf_extend, av )
772
773!
774!--          Remove the local file, if it can not be extended
775             IF ( .NOT. netcdf_extend )  THEN
776                nc_stat = NF90_CLOSE( id_set_xy(av) )
[263]777                CALL handle_netcdf_error( 'check_open', 21 )
[493]778                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
[1]779             ENDIF
780
781          ENDIF         
782
783          IF ( .NOT. netcdf_extend )  THEN
784!
[493]785!--          Create a new NetCDF output file with requested NetCDF format
786             IF ( netcdf_data_format == 1 )  THEN
787!
788!--             Classic NetCDF format
789                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
790
791             ELSEIF ( netcdf_data_format == 2 )  THEN
792!
793!--             64bit-offset format
[1]794                nc_stat = NF90_CREATE( filename,                               &
795                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
796                                       id_set_xy(av) )
[247]797
[493]798#if defined( __netcdf4 )
799             ELSEIF ( netcdf_data_format == 3 )  THEN
800!
801!--             NetCDF4/HDF5 format
802                nc_stat = NF90_CREATE( filename,                               &
803                                       OR( NF90_NOCLOBBER, NF90_NETCDF4 ),     &
804                                       id_set_xy(av), COMM = comm2d,           &
805                                       INFO = MPI_INFO_NULL )
806
807             ELSEIF ( netcdf_data_format == 4 )  THEN
808!
809!--             NetCDF4/HDF5 format with classic model flag
810                nc_stat = NF90_CREATE( filename,                               &
811                                       OR( NF90_NOCLOBBER,                     &
812                                        OR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), &
813                                       id_set_xy(av), COMM = comm2d,           &
814                                       INFO = MPI_INFO_NULL )
[1]815#endif
816             ENDIF
[493]817
[263]818             CALL handle_netcdf_error( 'check_open', 22 )
[493]819
[1]820!
821!--          Define the header
822             CALL define_netcdf_header( 'xy', netcdf_extend, av )
823
[493]824!
825!--          In case of parallel NetCDF output, create flag file which tells
826!--          combine_plot_fields that nothing is to do.
827             IF ( myid == 0  .AND.  netcdf_data_format > 2 )  THEN
828                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
829                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
830                CLOSE( 99 )
831             ENDIF
832
[1]833          ENDIF
834
835       CASE ( 102, 112 )
836!
837!--       Set filename depending on unit number
838          IF ( file_id == 102 )  THEN
[102]839             filename = 'DATA_2D_XZ_NETCDF' // coupling_char
[1]840             av = 0
841          ELSE
[102]842             filename = 'DATA_2D_XZ_AV_NETCDF' // coupling_char
[1]843             av = 1
844          ENDIF
845!
846!--       Inquire, if there is a NetCDF file from a previuos run. This should
847!--       be opened for extension, if its dimensions and variables match the
848!--       actual run.
849          INQUIRE( FILE=filename, EXIST=netcdf_extend )
850
851          IF ( netcdf_extend )  THEN
852!
[600]853!--          Open an existing NetCDF file for output
854             IF ( netcdf_data_format < 3 )  THEN
855                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xz(av) )
856             ELSE
[493]857#if defined( __netcdf4 )
[600]858                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xz(av), &
859                                     COMM = comm2d, INFO = MPI_INFO_NULL )
[493]860#endif
[600]861             ENDIF
862
[263]863             CALL handle_netcdf_error( 'check_open', 23 )
[1]864!
865!--          Read header information and set all ids. If there is a mismatch
866!--          between the previuos and the actual run, netcdf_extend is returned
867!--          as .FALSE.
868             CALL define_netcdf_header( 'xz', netcdf_extend, av )
869
870!
871!--          Remove the local file, if it can not be extended
872             IF ( .NOT. netcdf_extend )  THEN
873                nc_stat = NF90_CLOSE( id_set_xz(av) )
[263]874                CALL handle_netcdf_error( 'check_open', 24 )
[493]875                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
[1]876             ENDIF
877
878          ENDIF         
879
880          IF ( .NOT. netcdf_extend )  THEN
881!
[493]882!--          Create a new NetCDF output file with requested NetCDF format
883             IF ( netcdf_data_format == 1 )  THEN
884!
885!--             Classic NetCDF format
886                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
887
888             ELSEIF ( netcdf_data_format == 2 )  THEN
889!
890!--             64bit-offset format
[1]891                nc_stat = NF90_CREATE( filename,                               &
892                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
893                                       id_set_xz(av) )
[493]894
895#if defined( __netcdf4 )
896             ELSEIF ( netcdf_data_format == 3 )  THEN
897!
898!--             NetCDF4/HDF5 format
899                nc_stat = NF90_CREATE( filename,                               &
900                                       OR( NF90_NOCLOBBER, NF90_NETCDF4 ),     &
901                                       id_set_xz(av), COMM = comm2d,           &
902                                       INFO = MPI_INFO_NULL )
903
904             ELSEIF ( netcdf_data_format == 4 )  THEN
905!
906!--             NetCDF4/HDF5 format with classic model flag
907                nc_stat = NF90_CREATE( filename,                               &
908                                       OR( NF90_NOCLOBBER,                     &
909                                        OR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), &
910                                       id_set_xz(av), COMM = comm2d,           &
911                                       INFO = MPI_INFO_NULL )
[1]912#endif
913             ENDIF
[493]914
[263]915             CALL handle_netcdf_error( 'check_open', 25 )
[493]916
[1]917!
918!--          Define the header
919             CALL define_netcdf_header( 'xz', netcdf_extend, av )
920
[493]921!
922!--          In case of parallel NetCDF output, create flag file which tells
923!--          combine_plot_fields that nothing is to do.
924             IF ( myid == 0  .AND.  netcdf_data_format > 2 )  THEN
925                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
926                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
927                CLOSE( 99 )
928             ENDIF
929
[1]930          ENDIF
931
932       CASE ( 103, 113 )
933!
934!--       Set filename depending on unit number
935          IF ( file_id == 103 )  THEN
[102]936             filename = 'DATA_2D_YZ_NETCDF' // coupling_char
[1]937             av = 0
938          ELSE
[102]939             filename = 'DATA_2D_YZ_AV_NETCDF' // coupling_char
[1]940             av = 1
941          ENDIF
942!
943!--       Inquire, if there is a NetCDF file from a previuos run. This should
944!--       be opened for extension, if its dimensions and variables match the
945!--       actual run.
946          INQUIRE( FILE=filename, EXIST=netcdf_extend )
947
948          IF ( netcdf_extend )  THEN
949!
[600]950!--          Open an existing NetCDF file for output
951             IF ( netcdf_data_format < 3 )  THEN
952                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_yz(av) )
953             ELSE
[493]954#if defined( __netcdf4 )
[600]955                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_yz(av), &
956                                     COMM = comm2d, INFO = MPI_INFO_NULL )
[493]957#endif
[600]958             ENDIF
[667]959             
[263]960             CALL handle_netcdf_error( 'check_open', 26 )
[1]961!
962!--          Read header information and set all ids. If there is a mismatch
963!--          between the previuos and the actual run, netcdf_extend is returned
964!--          as .FALSE.
965             CALL define_netcdf_header( 'yz', netcdf_extend, av )
966
967!
968!--          Remove the local file, if it can not be extended
969             IF ( .NOT. netcdf_extend )  THEN
970                nc_stat = NF90_CLOSE( id_set_yz(av) )
[263]971                CALL handle_netcdf_error( 'check_open', 27 )
[493]972                IF ( myid == 0 )  CALL local_system( 'rm ' // TRIM( filename ) )
[1]973             ENDIF
974
975          ENDIF         
976
977          IF ( .NOT. netcdf_extend )  THEN
978!
[493]979!--          Create a new NetCDF output file with requested NetCDF format
980             IF ( netcdf_data_format == 1 )  THEN
981!
982!--             Classic NetCDF format
983                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
984
985             ELSEIF ( netcdf_data_format == 2 )  THEN
986!
987!--             64bit-offset format
[1]988                nc_stat = NF90_CREATE( filename,                               &
[493]989                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
[1]990                                       id_set_yz(av) )
[493]991
992#if defined( __netcdf4 )
993             ELSEIF ( netcdf_data_format == 3 )  THEN
994!
995!--             NetCDF4/HDF5 format
996                nc_stat = NF90_CREATE( filename,                               &
997                                       OR( NF90_NOCLOBBER, NF90_NETCDF4 ),     &
998                                       id_set_yz(av), COMM = comm2d,           &
999                                       INFO = MPI_INFO_NULL )
1000
1001             ELSEIF ( netcdf_data_format == 4 )  THEN
1002!
1003!--             NetCDF4/HDF5 format with classic model flag
1004                nc_stat = NF90_CREATE( filename,                               &
1005                                       OR( NF90_NOCLOBBER,                     &
1006                                        OR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), &
1007                                       id_set_yz(av), COMM = comm2d,           &
1008                                       INFO = MPI_INFO_NULL )
[1]1009#endif
1010             ENDIF
[493]1011
[263]1012             CALL handle_netcdf_error( 'check_open', 28 )
[493]1013
[1]1014!
1015!--          Define the header
1016             CALL define_netcdf_header( 'yz', netcdf_extend, av )
1017
[493]1018!
1019!--          In case of parallel NetCDF output, create flag file which tells
1020!--          combine_plot_fields that nothing is to do.
1021             IF ( myid == 0  .AND.  netcdf_data_format > 2 )  THEN
1022                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
1023                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
1024                CLOSE( 99 )
1025             ENDIF
1026
[1]1027          ENDIF
1028
1029       CASE ( 104 )
1030!
[102]1031!--       Set filename
1032          filename = 'DATA_1D_PR_NETCDF' // coupling_char
1033
1034!
[1]1035!--       Inquire, if there is a NetCDF file from a previuos run. This should
1036!--       be opened for extension, if its variables match the actual run.
[102]1037          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]1038
1039          IF ( netcdf_extend )  THEN
1040!
1041!--          Open an existing NetCDF file for output
[102]1042             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_pr )
[263]1043             CALL handle_netcdf_error( 'check_open', 29 )
[1]1044!
1045!--          Read header information and set all ids. If there is a mismatch
1046!--          between the previuos and the actual run, netcdf_extend is returned
1047!--          as .FALSE.
1048             CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
1049
1050!
1051!--          Remove the local file, if it can not be extended
1052             IF ( .NOT. netcdf_extend )  THEN
1053                nc_stat = NF90_CLOSE( id_set_pr )
[263]1054                CALL handle_netcdf_error( 'check_open', 30 )
[102]1055                CALL local_system( 'rm ' // TRIM( filename ) )
[1]1056             ENDIF
1057
1058          ENDIF         
1059
1060          IF ( .NOT. netcdf_extend )  THEN
1061!
1062!--          Create a new NetCDF output file
[493]1063             IF ( netcdf_data_format > 1 )  THEN
[102]1064                nc_stat = NF90_CREATE( filename,                               &
[1]1065                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1066                                       id_set_pr )
1067             ELSE
[102]1068                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pr )
[1]1069             ENDIF
[263]1070             CALL handle_netcdf_error( 'check_open', 31 )
[1]1071!
1072!--          Define the header
1073             CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
1074
1075          ENDIF
1076
1077       CASE ( 105 )
1078!
[102]1079!--       Set filename
1080          filename = 'DATA_1D_TS_NETCDF' // coupling_char
1081
1082!
[1]1083!--       Inquire, if there is a NetCDF file from a previuos run. This should
1084!--       be opened for extension, if its variables match the actual run.
[102]1085          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]1086
1087          IF ( netcdf_extend )  THEN
1088!
1089!--          Open an existing NetCDF file for output
[102]1090             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_ts )
[263]1091             CALL handle_netcdf_error( 'check_open', 32 )
[1]1092!
1093!--          Read header information and set all ids. If there is a mismatch
1094!--          between the previuos and the actual run, netcdf_extend is returned
1095!--          as .FALSE.
1096             CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
1097
1098!
1099!--          Remove the local file, if it can not be extended
1100             IF ( .NOT. netcdf_extend )  THEN
1101                nc_stat = NF90_CLOSE( id_set_ts )
[263]1102                CALL handle_netcdf_error( 'check_open', 33 )
[102]1103                CALL local_system( 'rm ' // TRIM( filename ) )
[1]1104             ENDIF
1105
1106          ENDIF         
1107
1108          IF ( .NOT. netcdf_extend )  THEN
1109!
1110!--          Create a new NetCDF output file
[493]1111             IF ( netcdf_data_format > 1 )  THEN
[102]1112                nc_stat = NF90_CREATE( filename,                               &
[1]1113                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1114                                       id_set_ts )
1115             ELSE
[102]1116                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_ts )
[1]1117             ENDIF
[263]1118             CALL handle_netcdf_error( 'check_open', 34 )
[1]1119!
1120!--          Define the header
1121             CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
1122
1123          ENDIF
1124
1125
1126       CASE ( 106, 116 )
1127!
1128!--       Set filename depending on unit number
1129          IF ( file_id == 106 )  THEN
[102]1130             filename = 'DATA_3D_NETCDF' // coupling_char
[1]1131             av = 0
1132          ELSE
[102]1133             filename = 'DATA_3D_AV_NETCDF' // coupling_char
[1]1134             av = 1
1135          ENDIF
1136!
[493]1137!--       Inquire, if there is a NetCDF file from a previous run. This should
[1]1138!--       be opened for extension, if its dimensions and variables match the
1139!--       actual run.
1140          INQUIRE( FILE=filename, EXIST=netcdf_extend )
1141
1142          IF ( netcdf_extend )  THEN
1143!
[493]1144!--          Open an existing NetCDF file for output
[765]1145             IF ( netcdf_data_format < 3 )  THEN
1146                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_3d(av) )
1147             ELSE
[493]1148#if defined( __netcdf4 )
[765]1149                nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_3d(av), &
1150                                     COMM = comm2d, INFO = MPI_INFO_NULL )
[493]1151#endif
[765]1152             ENDIF
[263]1153             CALL handle_netcdf_error( 'check_open', 35 )
[1]1154!
1155!--          Read header information and set all ids. If there is a mismatch
1156!--          between the previuos and the actual run, netcdf_extend is returned
1157!--          as .FALSE.
1158             CALL define_netcdf_header( '3d', netcdf_extend, av )
1159
1160!
1161!--          Remove the local file, if it can not be extended
1162             IF ( .NOT. netcdf_extend )  THEN
1163                nc_stat = NF90_CLOSE( id_set_3d(av) )
[263]1164                CALL handle_netcdf_error( 'check_open', 36 )
[1]1165                CALL local_system('rm ' // TRIM( filename ) )
1166             ENDIF
1167
1168          ENDIF         
1169
1170          IF ( .NOT. netcdf_extend )  THEN
1171!
[493]1172!--          Create a new NetCDF output file with requested NetCDF format
1173             IF ( netcdf_data_format == 1 )  THEN
1174!
1175!--             Classic NetCDF format
1176                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
1177
1178             ELSEIF ( netcdf_data_format == 2 )  THEN
1179!
1180!--             64bit-offset format
[1]1181                nc_stat = NF90_CREATE( filename,                               &
1182                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1183                                       id_set_3d(av) )
[493]1184
1185#if defined( __netcdf4 )
1186             ELSEIF ( netcdf_data_format == 3 )  THEN
1187!
1188!--             NetCDF4/HDF5 format
1189                nc_stat = NF90_CREATE( filename,                               &
1190                                       OR( NF90_NOCLOBBER, NF90_NETCDF4 ),     &
1191                                       id_set_3d(av), COMM = comm2d,           &
1192                                       INFO = MPI_INFO_NULL )
1193
1194             ELSEIF ( netcdf_data_format == 4 )  THEN
1195!
1196!--             NetCDF4/HDF5 format with classic model flag
1197                nc_stat = NF90_CREATE( filename,                               &
1198                                       OR( NF90_NOCLOBBER,                     &
1199                                        OR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), &
1200                                       id_set_3d(av), COMM = comm2d,           &
1201                                       INFO = MPI_INFO_NULL )
[1]1202#endif
1203             ENDIF
[493]1204
[263]1205             CALL handle_netcdf_error( 'check_open', 37 )
[493]1206
[1]1207!
1208!--          Define the header
1209             CALL define_netcdf_header( '3d', netcdf_extend, av )
1210
[493]1211!
1212!--          In case of parallel NetCDF output, create flag file which tells
1213!--          combine_plot_fields that nothing is to do.
1214             IF ( myid == 0  .AND.  netcdf_data_format > 2 )  THEN
1215                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
1216                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
1217                CLOSE( 99 )
1218             ENDIF
1219
[1]1220          ENDIF
1221
1222
1223       CASE ( 107 )
1224!
[102]1225!--       Set filename
1226          filename = 'DATA_1D_SP_NETCDF' // coupling_char
1227
1228!
[1]1229!--       Inquire, if there is a NetCDF file from a previuos run. This should
1230!--       be opened for extension, if its variables match the actual run.
[102]1231          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]1232
1233          IF ( netcdf_extend )  THEN
1234!
1235!--          Open an existing NetCDF file for output
[102]1236             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_sp )
[263]1237             CALL handle_netcdf_error( 'check_open', 38 )
1238
[1]1239!
1240!--          Read header information and set all ids. If there is a mismatch
1241!--          between the previuos and the actual run, netcdf_extend is returned
1242!--          as .FALSE.
1243             CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
1244
1245!
1246!--          Remove the local file, if it can not be extended
1247             IF ( .NOT. netcdf_extend )  THEN
1248                nc_stat = NF90_CLOSE( id_set_sp )
[263]1249                CALL handle_netcdf_error( 'check_open', 39 )
[102]1250                CALL local_system( 'rm ' // TRIM( filename ) )
[1]1251             ENDIF
1252
1253          ENDIF         
1254
1255          IF ( .NOT. netcdf_extend )  THEN
1256!
1257!--          Create a new NetCDF output file
[493]1258             IF ( netcdf_data_format > 1 )  THEN
[102]1259                nc_stat = NF90_CREATE( filename,                               &
[1]1260                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1261                                       id_set_sp )
1262             ELSE
[102]1263                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_sp )
[1]1264             ENDIF
[263]1265             CALL handle_netcdf_error( 'check_open', 40 )
[1]1266!
1267!--          Define the header
1268             CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
1269
1270          ENDIF
1271
1272
1273       CASE ( 108 )
1274
1275          IF ( myid_char == '' )  THEN
[102]1276             filename = 'DATA_PRT_NETCDF' // coupling_char
[1]1277          ELSE
[105]1278             filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
1279                        myid_char
[1]1280          ENDIF
1281!
1282!--       Inquire, if there is a NetCDF file from a previuos run. This should
1283!--       be opened for extension, if its variables match the actual run.
1284          INQUIRE( FILE=filename, EXIST=netcdf_extend )
1285
1286          IF ( netcdf_extend )  THEN
1287!
1288!--          Open an existing NetCDF file for output
1289             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_prt )
[263]1290             CALL handle_netcdf_error( 'check_open', 41 )
[1]1291!
1292!--          Read header information and set all ids. If there is a mismatch
1293!--          between the previuos and the actual run, netcdf_extend is returned
1294!--          as .FALSE.
1295             CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
1296
1297!
1298!--          Remove the local file, if it can not be extended
1299             IF ( .NOT. netcdf_extend )  THEN
1300                nc_stat = NF90_CLOSE( id_set_prt )
[263]1301                CALL handle_netcdf_error( 'check_open', 42 )
[1]1302                CALL local_system( 'rm ' // filename )
1303             ENDIF
1304
1305          ENDIF         
1306
1307          IF ( .NOT. netcdf_extend )  THEN
1308
1309!
1310!--          For runs on multiple processors create the subdirectory
1311             IF ( myid_char /= '' )  THEN
1312                IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before ) &
1313                THEN    ! needs modification in case of non-extendable sets
[102]1314                   CALL local_system( 'mkdir  DATA_PRT_NETCDF' // &
[105]1315                                       TRIM( coupling_char ) // '/' )
[1]1316                ENDIF
[809]1317#if defined( __parallel ) && ! defined ( __check )
[807]1318!
[1]1319!--             Set a barrier in order to allow that all other processors in the
1320!--             directory created by PE0 can open their file
1321                CALL MPI_BARRIER( comm2d, ierr )
1322#endif
1323             ENDIF
1324
1325!
[519]1326!--          Create a new NetCDF output file with requested NetCDF format
1327             IF ( netcdf_data_format == 1 )  THEN
1328!
1329!--             Classic NetCDF format
1330                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
1331
1332             ELSEIF ( netcdf_data_format == 2 )  THEN
1333!
1334!--             64bit-offset format
[1]1335                nc_stat = NF90_CREATE( filename,                               &
1336                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1337                                       id_set_prt )
[519]1338
1339#if defined( __netcdf4 )
1340             ELSEIF ( netcdf_data_format == 3 )  THEN
1341!
1342!--             NetCDF4/HDF5 format, but no parallel output into a single file!
1343                nc_stat = NF90_CREATE( filename,                               &
1344                                       OR( NF90_NOCLOBBER, NF90_NETCDF4 ),     &
1345                                       id_set_prt )
1346
1347             ELSEIF ( netcdf_data_format == 4 )  THEN
1348!
1349!--             NetCDF4/HDF5 format with classic model flag, but no parallel
1350!--             output into a single file!
1351                nc_stat = NF90_CREATE( filename,                               &
1352                                       OR( NF90_NOCLOBBER,                     &
1353                                        OR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), &
1354                                       id_set_prt )
1355#endif
[1]1356             ENDIF
[667]1357             
[263]1358             CALL handle_netcdf_error( 'check_open', 43 ) 
[1]1359
1360!
1361!--          Define the header
1362             CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
1363
1364          ENDIF
1365
1366       CASE ( 109 )
1367!
[102]1368!--       Set filename
1369          filename = 'DATA_1D_PTS_NETCDF' // coupling_char
1370
1371!
[1]1372!--       Inquire, if there is a NetCDF file from a previuos run. This should
1373!--       be opened for extension, if its variables match the actual run.
[102]1374          INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]1375
1376          IF ( netcdf_extend )  THEN
1377!
1378!--          Open an existing NetCDF file for output
[102]1379             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_pts )
[263]1380             CALL handle_netcdf_error( 'check_open', 393 )
[1]1381!
1382!--          Read header information and set all ids. If there is a mismatch
1383!--          between the previuos and the actual run, netcdf_extend is returned
1384!--          as .FALSE.
1385             CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
1386
1387!
1388!--          Remove the local file, if it can not be extended
1389             IF ( .NOT. netcdf_extend )  THEN
1390                nc_stat = NF90_CLOSE( id_set_pts )
[263]1391                CALL handle_netcdf_error( 'check_open', 394 )
[102]1392                CALL local_system( 'rm ' // TRIM( filename ) )
[1]1393             ENDIF
1394
1395          ENDIF         
1396
1397          IF ( .NOT. netcdf_extend )  THEN
1398!
1399!--          Create a new NetCDF output file
[493]1400             IF ( netcdf_data_format > 1 )  THEN
[102]1401                nc_stat = NF90_CREATE( filename,                               &
[1]1402                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1403                                       id_set_pts )
1404             ELSE
[102]1405                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pts )
[1]1406             ENDIF
[263]1407             CALL handle_netcdf_error( 'check_open', 395 )
[1]1408!
1409!--          Define the header
1410             CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
1411
1412          ENDIF
[410]1413
[564]1414       CASE ( 201:200+2*max_masks )
[410]1415!
1416!--       Set filename depending on unit number
[564]1417          IF ( file_id <= 200+max_masks )  THEN
1418             mid = file_id - 200
[410]1419             WRITE ( mask_char,'(I2.2)')  mid
1420             filename = 'DATA_MASK_' // mask_char // '_NETCDF' // coupling_char
1421             av = 0
1422          ELSE
[564]1423             mid = file_id - (200+max_masks)
[410]1424             WRITE ( mask_char,'(I2.2)')  mid
1425             filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // &
1426                  coupling_char
1427             av = 1
1428          ENDIF
1429!
1430!--       Inquire, if there is a NetCDF file from a previuos run. This should
1431!--       be opened for extension, if its dimensions and variables match the
1432!--       actual run.
1433          INQUIRE( FILE=filename, EXIST=netcdf_extend )
1434
1435          IF ( netcdf_extend )  THEN
1436!
1437!--          Open an existing NetCDF file for output
1438#if defined( __netcdf4 )
[493]1439             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_mask(mid,av), &
1440                                  COMM = comm2d, INFO = MPI_INFO_NULL )
[1]1441#else
[410]1442             nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_mask(mid,av) )
1443#endif
[564]1444             CALL handle_netcdf_error( 'check_open', 456 )
[410]1445!
1446!--          Read header information and set all ids. If there is a mismatch
1447!--          between the previuos and the actual run, netcdf_extend is returned
1448!--          as .FALSE.
1449             CALL define_netcdf_header( 'ma', netcdf_extend, file_id )
[1]1450
[410]1451!
1452!--          Remove the local file, if it can not be extended
1453             IF ( .NOT. netcdf_extend )  THEN
1454                nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
[564]1455                CALL handle_netcdf_error( 'check_open', 457 )
[410]1456                CALL local_system('rm ' // TRIM( filename ) )
1457             ENDIF
[1]1458
[410]1459          ENDIF         
1460
1461          IF ( .NOT. netcdf_extend )  THEN
[1]1462!
[493]1463!--          Create a new NetCDF output file with requested NetCDF format
1464             IF ( netcdf_data_format == 1 )  THEN
1465!
1466!--             Classic NetCDF format
1467                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, &
1468                                       id_set_mask(mid,av) )
[410]1469
[493]1470             ELSEIF ( netcdf_data_format == 2 )  THEN
1471!
1472!--             64bit-offset format
1473                nc_stat = NF90_CREATE( filename,                               &
1474                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
1475                                       id_set_mask(mid,av) )
[410]1476
1477
1478#if defined( __netcdf4 )
[493]1479             ELSEIF ( netcdf_data_format == 3 )  THEN
1480!
1481!--             NetCDF4/HDF5 format
1482                nc_stat = NF90_CREATE( filename,                               &
1483                                       OR( NF90_NOCLOBBER, NF90_NETCDF4 ),     &
1484                                       id_set_mask(mid,av), COMM = comm2d,     &
1485                                       INFO = MPI_INFO_NULL )
[410]1486
[493]1487             ELSEIF ( netcdf_data_format == 4 )  THEN
1488!
1489!--             NetCDF4/HDF5 format with classic model flag
1490                nc_stat = NF90_CREATE( filename,                               &
1491                                       OR( NF90_NOCLOBBER,                     &
1492                                        OR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), &
1493                                       id_set_mask(mid,av), COMM = comm2d,     &
1494                                       INFO = MPI_INFO_NULL )
[410]1495#endif
[493]1496             ENDIF
[410]1497
[564]1498             CALL handle_netcdf_error( 'check_open', 458 )
[410]1499!
1500!--          Define the header
1501             CALL define_netcdf_header( 'ma', netcdf_extend, file_id )
1502
1503          ENDIF
1504
1505
1506#else
1507
[564]1508       CASE ( 101:109, 111:113, 116, 201:200+2*max_masks )
[410]1509
1510!
[1]1511!--       Nothing is done in case of missing netcdf support
1512          RETURN
1513
1514#endif
1515
1516       CASE DEFAULT
1517
[247]1518          WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
[277]1519          CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
[1]1520
1521    END SELECT
1522
1523!
1524!-- Set open flag
1525    openfile(file_id)%opened = .TRUE.
1526
1527!
1528!-- Formats
15293300 FORMAT ('#'/                                                   &
1530             'coord 1  file=',A,'  filetype=unformatted'/           &
1531             'coord 2  file=',A,'  filetype=unformatted  skip=',I6/ &
1532             'coord 3  file=',A,'  filetype=unformatted  skip=',I6/ &
1533             '#')
15344000 FORMAT ('# ',A)
15355000 FORMAT ('# ',A/                                                          &
1536             '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/     &
1537             '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
1538             '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/     &
1539             '#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
15408000 FORMAT (A/                                                            &
1541             '  step    time  # of parts   lPE sent/recv  rPE sent/recv  ',&
1542             'sPE sent/recv  nPE sent/recv  max # of parts'/               &
1543             103('-'))
1544
1545 END SUBROUTINE check_open
Note: See TracBrowser for help on using the repository browser.