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

Last change on this file since 1322 was 1321, checked in by raasch, 10 years ago

last commit documented

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