source: palm/trunk/SOURCE/close_file.f90 @ 524

Last change on this file since 524 was 494, checked in by raasch, 15 years ago

last commit documented; configuration example file for netcdf4 added

  • Property svn:keywords set to Id
File size: 20.5 KB
Line 
1 SUBROUTINE close_file( file_id )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: close_file.f90 494 2010-03-01 12:23:32Z raasch $
11!
12! 493 2010-03-01 08:30:24Z raasch
13! Adjustments for NetCDF parallel data output
14!
15! 410 2009-12-04 17:05:40Z letzel
16! masked data output
17!
18! 263 2009-03-18 12:26:04Z heinze
19! Output of NetCDF messages with aid of message handling routine.
20!
21! Feb. 2007
22! RCS Log replace by Id keyword, revision history cleaned up
23!
24! Revision 1.10  2006/08/22 13:50:01  raasch
25! xz and yz cross sections now up to nzt+1
26!
27! Revision 1.1  2001/01/02 17:23:41  raasch
28! Initial revision
29!
30! Last revision before renaming subroutine  2001/01/01  raasch
31! Subroutine name changed from close_files to close_file. Closing of a single
32! file is allowed by passing its file-id as an argument. Variable openfile now
33! is of type file_status and contains a flag which indicates if a file has
34! been opened before. Old revision remarks deleted.
35!
36! Revision 1.13 (close_files) 2000/12/20 09:10:24  letzel
37! All comments translated into English.
38!
39! Revision 1.12 (close_files) 1999/03/02 09:22:46  raasch
40! FLD-Header fuer komprimierte 3D-Daten
41!
42! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
43! Initial revision
44!
45!
46! Description:
47! ------------
48! Close specified file or all open files, if "0" has been given as the
49! calling argument. In that case, execute last actions for certain unit
50! numbers, if required.
51!------------------------------------------------------------------------------!
52
53    USE control_parameters
54    USE grid_variables
55    USE indices
56    USE netcdf_control
57    USE pegrid
58    USE profil_parameter
59    USE statistics
60
61    IMPLICIT NONE
62
63    CHARACTER (LEN=2)   ::  suffix
64    CHARACTER (LEN=10)  ::  datform = 'lit_endian'
65    CHARACTER (LEN=80)  ::  rtext, title, utext = '', xtext = '', ytext = ''
66
67    INTEGER ::  av, anzzeile, cranz, cross_count, cross_numbers, dimx, dimy, &
68                fid, file_id, j, k, legpos = 1, planz, timodex = 1
69    INTEGER, DIMENSION(100) ::  klist, lstyle, cucol
70
71    LOGICAL ::  checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., &
72                grid = .TRUE., rand = .TRUE., swap, twoxa = .TRUE., &
73                twoya = .TRUE.
74
75    REAL    ::  ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak, &
76                sizex, sizey, texfac, utmove = 50.0, uxmax, uxmin, uymax, &
77                uymin, yright
78    REAL, DIMENSION(100) ::  lwid, normx, normy
79
80    NAMELIST /CROSS/   ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
81                       lwid, normx, normy, rand, rlegfak, sizex, sizey, &
82                       texfac, timodex, twoxa, twoya, utext, utmove, uxmax, &
83                       uxmin, uymax, uymin, xtext, ytext
84    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dp, planz, sizex, sizey, &
85                       title, yright
86    NAMELIST /RAHMEN/  anzzeile, cranz, datleg, rtext, swap
87
88!
89!-- Close specified unit number (if opened) and set a flag that it has
90!-- been opened one time at least
91    IF ( file_id /= 0 )  THEN
92       IF ( openfile(file_id)%opened )  THEN
93          CLOSE ( file_id )
94          openfile(file_id)%opened        = .FALSE.
95          openfile(file_id)%opened_before = .TRUE.
96       ENDIF
97       RETURN
98    ENDIF
99
100!
101!-- Close all open unit numbers
102    DO  fid = 1, 160
103
104       IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before )  THEN
105!
106!--       Last actions for certain unit numbers
107          SELECT CASE ( fid )
108
109             CASE ( 21 )
110!
111!--             Write ISO2D global parameters
112                IF ( myid == 0  .AND.  iso2d_output )  THEN
113                   planz  = do2d_xy_n
114                   dimx   = nx + 2
115                   dimy   = ny + 2
116                   sizex  = 100.0
117                   sizey  = 100.0
118                   title  = run_description_header
119                   yright = ( ny + 1.0 ) * dy
120                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
121                      checkuf = .FALSE.; dp = .TRUE.
122                   ENDIF
123                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
124                      datform = 'big_endian'
125                   ENDIF
126                   OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
127                              DELIM='APOSTROPHE' )
128                   WRITE ( 90, GLOBAL )
129                   CLOSE ( 90 )
130                ENDIF
131
132             CASE ( 22 )
133!
134!--             Write ISO2D global parameters
135                IF ( myid == 0 )  THEN
136                   planz  = do2d_xz_n
137                   dimx   = nx + 2
138                   dimy   = nz + 2
139                   sizex  = 100.0
140                   sizey  =  65.0
141                   title  = run_description_header
142                   yright = z_max_do2d
143                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
144                      checkuf = .FALSE.; dp = .TRUE.
145                   ENDIF
146                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
147                      datform = 'big_endian'
148                   ENDIF
149                   OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
150                              DELIM='APOSTROPHE' )
151                   WRITE ( 90, GLOBAL )
152                   CLOSE ( 90 )
153                ENDIF
154
155             CASE ( 23 )
156!
157!--             Write ISO2D global parameters
158                IF ( myid == 0 )  THEN
159                   planz  = do2d_yz_n
160                   dimx   = ny + 2
161                   dimy   = nz + 2
162                   sizex  = 100.0
163                   sizey  =  65.0
164                   title  = run_description_header
165                   yright = z_max_do2d
166                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
167                      checkuf = .FALSE.; dp = .TRUE.
168                   ENDIF
169                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
170                      datform = 'big_endian'
171                   ENDIF
172                   OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
173                              DELIM='APOSTROPHE' )
174                   WRITE ( 90, GLOBAL )
175                   CLOSE ( 90 )
176                ENDIF
177
178             CASE ( 32 )
179!
180!--             Write header for FLD-file
181                IF ( do3d_compress )  THEN
182                   WRITE ( 32, 3200)  ' compressed ',                       &
183                                      TRIM( run_description_header ), nx+2, &
184                                      ny+2, nz_do3d+1, do3d_avs_n
185                ELSE
186                   WRITE ( 32, 3200)  ' ', TRIM( run_description_header ), &
187                                      nx+2, ny+2, nz_do3d+1, do3d_avs_n
188                ENDIF
189
190             CASE ( 40:49 )
191!
192!--             Write PROFIL namelist parameters for 1D profiles.
193!--             First determine, how many crosses are to be drawn.
194                IF ( myid == 0 )  THEN
195                   cross_numbers = 0
196                   DO  j = 1, crmax
197                      IF ( cross_profile_number_count(j) /= 0 )  THEN
198                         cross_numbers = cross_numbers + 1
199                      ENDIF
200                   ENDDO
201
202                   IF ( cross_numbers /= 0 )  THEN
203!
204!--                   Determine remaining RAHMEN parameters
205                      swap = .FALSE.
206                      rtext = '\0.5 ' // TRIM( run_description_header ) // &
207                              '    ' // TRIM( region( fid - 40 ) )
208!
209!--                   Write RAHMEN parameters
210                      IF ( statistic_regions == 0  .AND.  fid == 40 )  THEN
211                         suffix = ''
212                      ELSE
213                         WRITE ( suffix, '(''_'',I1)' )  fid - 40
214                      ENDIF
215                      OPEN ( 90, FILE='PLOT1D_PAR' // TRIM( suffix ), &
216                                 FORM='FORMATTED', DELIM='APOSTROPHE' )
217!
218!--                   Subtitle for crosses with time averaging
219                      IF ( averaging_interval_pr /= 0.0 )  THEN
220                         WRITE ( utext, 4000 )  averaging_interval_pr
221                      ENDIF
222!
223!--                   Determine and write CROSS parameters for each individual
224!--                   cross
225                      cross_count = 0
226                      DO  j = 1, crmax
227                         k = cross_profile_number_count(j)
228                         IF ( k /= 0 )  THEN
229                            cross_count = cross_count + 1
230!
231!--                         Write RAHMEN parameters
232                            IF ( MOD( cross_count-1, &
233                                      profile_rows*profile_columns ) == 0 ) &
234                            THEN
235!
236!--                            Determine number of crosses still to be drawn
237                               cranz = MIN( cross_numbers - cross_count + 1, &
238                                            profile_rows * profile_columns )
239!
240!--                            If the first line cannot be filled with crosses
241!--                            completely, the default number of crosses per
242!--                            line has to be reduced.
243                               IF ( cranz < profile_columns )  THEN
244                                  anzzeile = cranz
245                               ELSE
246                                  anzzeile = profile_columns
247                               ENDIF
248
249                               WRITE ( 90, RAHMEN )
250
251                            ENDIF
252!
253!--                         Store graph numbers
254                            klist(1:k) = cross_profile_numbers(1:k,j)
255                            klist(k+1:100) = 999999
256!
257!--                         Store graph attributes
258                            cucol  = cross_linecolors(:,j)
259                            lstyle = cross_linestyles(:,j)
260                            lwid = 0.6
261!
262!--                         Sizes, text etc.
263                            sizex = 100.0; sizey = 120.0
264                            rlegfak = 0.7; texfac = 1.0
265!
266!--                         Determine range of x-axis values
267                            IF ( cross_normalized_x(j) == ' ' )  THEN
268!
269!--                            Non-normalized profiles
270                               IF ( cross_uxmin(j) == 0.0  .AND. &
271                                    cross_uxmax(j) == 0.0 )  THEN
272                                  uxmin = cross_uxmin_computed(j)
273                                  uxmax = cross_uxmax_computed(j)
274                                  IF ( uxmin == uxmax )  uxmax = uxmin + 1.0
275                               ELSE
276!
277!--                               Values set in check_parameters are used here
278                                  uxmin = cross_uxmin(j); uxmax = cross_uxmax(j)
279                               ENDIF
280                            ELSE
281!
282!--                            Normalized profiles
283                               IF ( cross_uxmin_normalized(j) == 0.0  .AND. &
284                                    cross_uxmax_normalized(j) == 0.0 )  THEN
285                                  uxmin = cross_uxmin_normalized_computed(j)
286                                  uxmax = cross_uxmax_normalized_computed(j)
287                                  IF ( uxmin == uxmax )  uxmax = uxmin + 1.0
288                               ELSE
289!
290!--                               Values set in check_parameters are used here
291                                  uxmin = cross_uxmin_normalized(j)
292                                  uxmax = cross_uxmax_normalized(j)
293                               ENDIF
294                            ENDIF
295!
296!--                         Range of y-axis values
297!--                         may be re-adjusted during normalization if required
298                            uymin = cross_uymin(j); uymax = cross_uymax(j)
299                            ytext = 'height in m'
300!
301!--                         Normalization of the axes
302                            normx = cross_normx_factor(:,j)
303                            normy = cross_normy_factor(:,j)
304!
305!--                         Labelling of the axes
306                            IF ( cross_normalized_x(j) == ' ' )  THEN
307                               xtext = cross_xtext(j)
308                            ELSE
309                               xtext = TRIM( cross_xtext(j) ) // ' / ' // &
310                                       cross_normalized_x(j)
311                            ENDIF
312                            IF ( cross_normalized_y(j) == ' ' )  THEN
313                               ytext = 'height in m'
314                            ELSE
315                               ytext = 'height in m' // ' / ' // &
316                                       cross_normalized_y(j)
317!
318!--                            Determine upper limit of value range
319                               IF ( z_max_do1d_normalized /= -1.0 )  THEN
320                                  uymax = z_max_do1d_normalized
321                               ENDIF
322                            ENDIF
323
324                            WRITE ( 90, CROSS )
325
326                         ENDIF
327                      ENDDO
328
329                      CLOSE ( 90 )
330                   ENDIF
331                ENDIF
332
333             CASE ( 50:59 )
334!
335!--             Write PROFIL namelist parameters for time series
336!--             first determine number of crosses to be drawn
337                IF ( myid == 0 )  THEN
338                   cranz = 0
339                   DO  j = 1, 12
340                      IF ( cross_ts_number_count(j) /= 0 )  cranz = cranz+1
341                   ENDDO
342
343                   IF ( cranz /= 0 )  THEN
344!
345!--                   Determine RAHMEN parameters
346                      anzzeile = 1
347                      swap = .TRUE.
348                      rtext = '\1.0 ' // TRIM( run_description_header ) // &
349                              '    ' // TRIM( region( fid - 50 ) )
350!
351!--                   Write RAHMEN parameters
352                      IF ( statistic_regions == 0  .AND.  fid == 50 )  THEN
353                         suffix = ''
354                      ELSE
355                         WRITE ( suffix, '(''_'',I1)' )  fid - 50
356                      ENDIF
357                      OPEN ( 90, FILE='PLOTTS_PAR' // TRIM( suffix ), &
358                                 FORM='FORMATTED', DELIM='APOSTROPHE' )
359                      WRITE ( 90, RAHMEN )
360!
361!--                   Determine and write CROSS parameters for each individual
362!--                   cross
363                      DO  j = 1, 12
364                         k = cross_ts_number_count(j)
365                         IF ( k /= 0 )  THEN
366!
367!--                         Store graph numbers
368                            klist(1:k) = cross_ts_numbers(1:k,j)
369                            klist(k+1:100) = 999999
370!
371!--                         Store graph attributes
372                            cucol(1:k)  = linecolors(1:k)
373                            lstyle(1:k) = linestyles(1:k)
374                            lwid = 0.4
375!
376!--                         Sizes, text etc.
377                            sizex = 250.0; sizey = 40.0
378                            rlegfak = 1.5; texfac = 1.5
379                            xtext = 'time in s'
380                            ytext = ''
381                            utext = ''
382!
383!--                         Determine range of y-axis values
384                            IF ( cross_ts_uymin(j) == 999.999 )  THEN
385                               uymin = cross_ts_uymin_computed(j)
386                            ELSE
387                               uymin = cross_ts_uymin(j)
388                            ENDIF
389                            IF ( cross_ts_uymax(j) == 999.999 )  THEN
390                               uymax = cross_ts_uymax_computed(j)
391                            ELSE
392                               uymax = cross_ts_uymax(j)
393                            ENDIF
394                            IF ( uymin == uymax )  uymax = uymin + 1.0
395!
396!--                         Range of x-axis values
397                            uxmin = 0.0; uxmax = simulated_time
398!
399!--                         Normalizations
400                            normx = 1.0; normy = 1.0
401
402                            WRITE ( 90, CROSS )
403
404                         ENDIF
405                      ENDDO
406
407                      CLOSE ( 90 )
408                   ENDIF
409                ENDIF
410
411#if defined( __netcdf )
412             CASE ( 101 )
413
414                IF ( netcdf_output  .AND.  &
415                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
416                   nc_stat = NF90_CLOSE( id_set_xy(0) )
417                   CALL handle_netcdf_error( 'close_file', 44 )
418                ENDIF
419
420             CASE ( 102 )
421
422                IF ( netcdf_output  .AND.  &
423                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
424                   nc_stat = NF90_CLOSE( id_set_xz(0) )
425                   CALL handle_netcdf_error( 'close_file', 45 )
426                ENDIF
427
428             CASE ( 103 )
429
430                IF ( netcdf_output  .AND.  &
431                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
432                   nc_stat = NF90_CLOSE( id_set_yz(0) )
433                   CALL handle_netcdf_error( 'close_file', 46 )
434                ENDIF
435
436             CASE ( 104 )
437
438                IF ( myid == 0  .AND.  netcdf_output )  THEN
439                   nc_stat = NF90_CLOSE( id_set_pr )
440                   CALL handle_netcdf_error( 'close_file', 47 )
441                ENDIF
442
443             CASE ( 105 )
444
445                IF ( myid == 0  .AND.  netcdf_output )  THEN
446                   nc_stat = NF90_CLOSE( id_set_ts )
447                   CALL handle_netcdf_error( 'close_file', 48 )
448                ENDIF
449
450             CASE ( 106 )
451
452                IF ( netcdf_output  .AND.  &
453                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
454                   nc_stat = NF90_CLOSE( id_set_3d(0) )
455                   CALL handle_netcdf_error( 'close_file', 49 )
456                ENDIF
457
458             CASE ( 107 )
459
460                IF ( myid == 0  .AND.  netcdf_output )  THEN
461                   nc_stat = NF90_CLOSE( id_set_sp )
462                   CALL handle_netcdf_error( 'close_file', 50 )
463                ENDIF
464
465             CASE ( 108 )
466
467                IF (  netcdf_output )  THEN
468                   nc_stat = NF90_CLOSE( id_set_prt )
469                   CALL handle_netcdf_error( 'close_file', 51 )
470                ENDIF
471
472             CASE ( 109 ) 
473
474                IF (  netcdf_output )  THEN
475                   nc_stat = NF90_CLOSE( id_set_pts )
476                   CALL handle_netcdf_error( 'close_file', 412 )
477                ENDIF
478
479             CASE ( 111 )
480
481                IF ( netcdf_output  .AND.  &
482                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
483                   nc_stat = NF90_CLOSE( id_set_xy(1) )
484                   CALL handle_netcdf_error( 'close_file', 52 )
485                ENDIF
486
487             CASE ( 112 )
488
489                IF ( netcdf_output  .AND.  &
490                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
491                   nc_stat = NF90_CLOSE( id_set_xz(1) )
492                   CALL handle_netcdf_error( 'close_file', 352 )
493                ENDIF
494
495             CASE ( 113 )
496
497                IF ( netcdf_output  .AND.  &
498                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
499                   nc_stat = NF90_CLOSE( id_set_yz(1) )
500                   CALL handle_netcdf_error( 'close_file', 353 )
501                ENDIF
502
503             CASE ( 116 )
504
505                IF ( netcdf_output  .AND.  &
506                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
507                   nc_stat = NF90_CLOSE( id_set_3d(1) )
508                   CALL handle_netcdf_error( 'close_file', 353 )
509                ENDIF
510
511             CASE ( 121:160 )
512             
513                IF ( netcdf_output  .AND.  &
514                     ( myid == 0  .OR.  netcdf_data_format > 2 ) )  THEN
515!
516!--                decompose fid into mid and av
517                   IF ( fid <= 140 )  THEN
518                      mid = fid - 120
519                      av = 0
520                   ELSE
521                      mid = fid - 140
522                      av = 1
523                   ENDIF
524                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
525                   CALL handle_netcdf_error( 'close_file', 9998 )
526               
527                ENDIF
528
529#endif
530
531          END SELECT
532!
533!--       Close file
534          IF ( openfile(fid)%opened )  CLOSE ( fid )
535
536       ENDIF
537
538    ENDDO
539
540!
541!-- Formats
5423200 FORMAT ('# AVS',A,'field file'/ &
543             '#'/                &
544             '# ',A/             &
545             'ndim=3'/           &
546             'dim1=',I5/         &
547             'dim2=',I5/         &
548             'dim3=',I5/         &
549             'nspace=3'/         &
550             'veclen=',I5/       &
551             'data=xdr_float'/   &
552             'field=rectilinear')
5534000 FORMAT ('time averaged over',F7.1,' s')
554
555
556 END SUBROUTINE close_file
Note: See TracBrowser for help on using the repository browser.