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

Last change on this file since 1310 was 1310, checked in by raasch, 7 years ago

update of GPL copyright

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