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

Last change on this file since 754 was 565, checked in by helmke, 14 years ago

last commit documented

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