source: palm/tags/release-3.5/SOURCE/close_file.f90 @ 4417

Last change on this file since 4417 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

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