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

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

file headers updated for the next release 3.5

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