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

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

Initial repository layout and content

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