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

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