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

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

last commit documented

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