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

Last change on this file since 1036 was 1036, checked in by raasch, 9 years ago

code has been put under the GNU General Public License (v3)

  • Property svn:keywords set to Id
File size: 11.5 KB
Line 
1 SUBROUTINE close_file( file_id )
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: close_file.f90 1036 2012-10-22 13:43:42Z raasch $
27!
28! 1031 2012-10-19 14:35:30Z raasch
29! netCDF4 without parallel file support implemented
30!
31! 964 2012-07-26 09:14:24Z raasch
32! old profil-units (40:49) and respective code removed
33!
34! 564 2010-09-30 13:18:59Z helmke
35! start number of mask output files changed to 201, netcdf message identifiers
36! of masked output changed
37!
38! 493 2010-03-01 08:30:24Z raasch
39! Adjustments for NetCDF parallel data output
40!
41! 410 2009-12-04 17:05:40Z letzel
42! masked data output
43!
44! 263 2009-03-18 12:26:04Z heinze
45! Output of NetCDF messages with aid of message handling routine.
46!
47! Feb. 2007
48! RCS Log replace by Id keyword, revision history cleaned up
49!
50! Revision 1.10  2006/08/22 13:50:01  raasch
51! xz and yz cross sections now up to nzt+1
52!
53! Revision 1.1  2001/01/02 17:23:41  raasch
54! Initial revision
55!
56! Last revision before renaming subroutine  2001/01/01  raasch
57! Subroutine name changed from close_files to close_file. Closing of a single
58! file is allowed by passing its file-id as an argument. Variable openfile now
59! is of type file_status and contains a flag which indicates if a file has
60! been opened before. Old revision remarks deleted.
61!
62! Revision 1.13 (close_files) 2000/12/20 09:10:24  letzel
63! All comments translated into English.
64!
65! Revision 1.12 (close_files) 1999/03/02 09:22:46  raasch
66! FLD-Header fuer komprimierte 3D-Daten
67!
68! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
69! Initial revision
70!
71!
72! Description:
73! ------------
74! Close specified file or all open files, if "0" has been given as the
75! calling argument. In that case, execute last actions for certain unit
76! numbers, if required.
77!------------------------------------------------------------------------------!
78
79    USE control_parameters
80    USE grid_variables
81    USE indices
82    USE netcdf_control
83    USE pegrid
84    USE profil_parameter
85    USE statistics
86
87    IMPLICIT NONE
88
89    CHARACTER (LEN=2)   ::  suffix
90    CHARACTER (LEN=10)  ::  datform = 'lit_endian'
91    CHARACTER (LEN=80)  ::  rtext, title
92
93    INTEGER ::  av, anzzeile, dimx, dimy, &
94                fid, file_id, j, k, planz
95
96    LOGICAL ::  checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., swap
97
98    REAL ::  sizex, sizey, yright
99
100    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dp, planz, &
101                       title
102    NAMELIST /RAHMEN/  anzzeile, datleg, rtext, swap
103
104!
105!-- Close specified unit number (if opened) and set a flag that it has
106!-- been opened one time at least
107    IF ( file_id /= 0 )  THEN
108       IF ( openfile(file_id)%opened )  THEN
109          CLOSE ( file_id )
110          openfile(file_id)%opened        = .FALSE.
111          openfile(file_id)%opened_before = .TRUE.
112       ENDIF
113       RETURN
114    ENDIF
115
116!
117!-- Close all open unit numbers
118    DO  fid = 1, 200+2*max_masks
119
120       IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before )  THEN
121!
122!--       Last actions for certain unit numbers
123          SELECT CASE ( fid )
124
125             CASE ( 21 )
126!
127!--             Write ISO2D global parameters
128                IF ( myid == 0  .AND.  iso2d_output )  THEN
129                   planz  = do2d_xy_n
130                   dimx   = nx + 2
131                   dimy   = ny + 2
132                   sizex  = 100.0
133                   sizey  = 100.0
134                   title  = run_description_header
135                   yright = ( ny + 1.0 ) * dy
136                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
137                      checkuf = .FALSE.; dp = .TRUE.
138                   ENDIF
139                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
140                      datform = 'big_endian'
141                   ENDIF
142                   OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
143                              DELIM='APOSTROPHE' )
144                   WRITE ( 90, GLOBAL )
145                   CLOSE ( 90 )
146                ENDIF
147
148             CASE ( 22 )
149!
150!--             Write ISO2D global parameters
151                IF ( myid == 0 )  THEN
152                   planz  = do2d_xz_n
153                   dimx   = nx + 2
154                   dimy   = nz + 2
155                   sizex  = 100.0
156                   sizey  =  65.0
157                   title  = run_description_header
158                   yright = z_max_do2d
159                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
160                      checkuf = .FALSE.; dp = .TRUE.
161                   ENDIF
162                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
163                      datform = 'big_endian'
164                   ENDIF
165                   OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
166                              DELIM='APOSTROPHE' )
167                   WRITE ( 90, GLOBAL )
168                   CLOSE ( 90 )
169                ENDIF
170
171             CASE ( 23 )
172!
173!--             Write ISO2D global parameters
174                IF ( myid == 0 )  THEN
175                   planz  = do2d_yz_n
176                   dimx   = ny + 2
177                   dimy   = nz + 2
178                   sizex  = 100.0
179                   sizey  =  65.0
180                   title  = run_description_header
181                   yright = z_max_do2d
182                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
183                      checkuf = .FALSE.; dp = .TRUE.
184                   ENDIF
185                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
186                      datform = 'big_endian'
187                   ENDIF
188                   OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
189                              DELIM='APOSTROPHE' )
190                   WRITE ( 90, GLOBAL )
191                   CLOSE ( 90 )
192                ENDIF
193
194             CASE ( 32 )
195!
196!--             Write header for FLD-file
197                IF ( do3d_compress )  THEN
198                   WRITE ( 32, 3200)  ' compressed ',                       &
199                                      TRIM( run_description_header ), nx+2, &
200                                      ny+2, nz_do3d+1, do3d_avs_n
201                ELSE
202                   WRITE ( 32, 3200)  ' ', TRIM( run_description_header ), &
203                                      nx+2, ny+2, nz_do3d+1, do3d_avs_n
204                ENDIF
205
206#if defined( __netcdf )
207             CASE ( 101 )
208
209                IF ( netcdf_output  .AND.  &
210                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
211                   nc_stat = NF90_CLOSE( id_set_xy(0) )
212                   CALL handle_netcdf_error( 'close_file', 44 )
213                ENDIF
214
215             CASE ( 102 )
216
217                IF ( netcdf_output  .AND.  &
218                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
219                   nc_stat = NF90_CLOSE( id_set_xz(0) )
220                   CALL handle_netcdf_error( 'close_file', 45 )
221                ENDIF
222
223             CASE ( 103 )
224
225                IF ( netcdf_output  .AND.  &
226                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
227                   nc_stat = NF90_CLOSE( id_set_yz(0) )
228                   CALL handle_netcdf_error( 'close_file', 46 )
229                ENDIF
230
231             CASE ( 104 )
232
233                IF ( myid == 0  .AND.  netcdf_output )  THEN
234                   nc_stat = NF90_CLOSE( id_set_pr )
235                   CALL handle_netcdf_error( 'close_file', 47 )
236                ENDIF
237
238             CASE ( 105 )
239
240                IF ( myid == 0  .AND.  netcdf_output )  THEN
241                   nc_stat = NF90_CLOSE( id_set_ts )
242                   CALL handle_netcdf_error( 'close_file', 48 )
243                ENDIF
244
245             CASE ( 106 )
246
247                IF ( netcdf_output  .AND.  &
248                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
249                   nc_stat = NF90_CLOSE( id_set_3d(0) )
250                   CALL handle_netcdf_error( 'close_file', 49 )
251                ENDIF
252
253             CASE ( 107 )
254
255                IF ( myid == 0  .AND.  netcdf_output )  THEN
256                   nc_stat = NF90_CLOSE( id_set_sp )
257                   CALL handle_netcdf_error( 'close_file', 50 )
258                ENDIF
259
260             CASE ( 108 )
261
262                IF (  netcdf_output )  THEN
263                   nc_stat = NF90_CLOSE( id_set_prt )
264                   CALL handle_netcdf_error( 'close_file', 51 )
265                ENDIF
266
267             CASE ( 109 ) 
268
269                IF (  netcdf_output )  THEN
270                   nc_stat = NF90_CLOSE( id_set_pts )
271                   CALL handle_netcdf_error( 'close_file', 412 )
272                ENDIF
273
274             CASE ( 111 )
275
276                IF ( netcdf_output  .AND.  &
277                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
278                   nc_stat = NF90_CLOSE( id_set_xy(1) )
279                   CALL handle_netcdf_error( 'close_file', 52 )
280                ENDIF
281
282             CASE ( 112 )
283
284                IF ( netcdf_output  .AND.  &
285                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
286                   nc_stat = NF90_CLOSE( id_set_xz(1) )
287                   CALL handle_netcdf_error( 'close_file', 352 )
288                ENDIF
289
290             CASE ( 113 )
291
292                IF ( netcdf_output  .AND.  &
293                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
294                   nc_stat = NF90_CLOSE( id_set_yz(1) )
295                   CALL handle_netcdf_error( 'close_file', 353 )
296                ENDIF
297
298             CASE ( 116 )
299
300                IF ( netcdf_output  .AND.  &
301                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
302                   nc_stat = NF90_CLOSE( id_set_3d(1) )
303                   CALL handle_netcdf_error( 'close_file', 353 )
304                ENDIF
305
306             CASE ( 201:200+2*max_masks )
307             
308                IF ( netcdf_output  .AND.  &
309                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
310!
311!--                decompose fid into mid and av
312                   IF ( fid <= 200+max_masks )  THEN
313                      mid = fid - 200
314                      av = 0
315                   ELSE
316                      mid = fid - (200+max_masks)
317                      av = 1
318                   ENDIF
319                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
320                   CALL handle_netcdf_error( 'close_file', 459 )
321               
322                ENDIF
323
324#endif
325
326          END SELECT
327!
328!--       Close file
329          IF ( openfile(fid)%opened )  CLOSE ( fid )
330
331       ENDIF
332
333    ENDDO
334
335!
336!-- Formats
3373200 FORMAT ('# AVS',A,'field file'/ &
338             '#'/                &
339             '# ',A/             &
340             'ndim=3'/           &
341             'dim1=',I5/         &
342             'dim2=',I5/         &
343             'dim3=',I5/         &
344             'nspace=3'/         &
345             'veclen=',I5/       &
346             'data=xdr_float'/   &
347             'field=rectilinear')
3484000 FORMAT ('time averaged over',F7.1,' s')
349
350
351 END SUBROUTINE close_file
Note: See TracBrowser for help on using the repository browser.