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

Last change on this file since 564 was 564, checked in by helmke, 11 years ago

several changes for an unlimited output of mask data and message IDs changed

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