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

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

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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