source: palm/tags/release-3.7a/SOURCE/close_file.f90 @ 1320

Last change on this file since 1320 was 449, checked in by raasch, 14 years ago

branch revision comments from Marcus (rev 410) replaced by normal revision comments

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