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

Last change on this file since 1496 was 1329, checked in by raasch, 10 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 8.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 1329 2014-03-21 11:09:15Z maronga $
27!
28! 1327 2014-03-21 11:00:16Z raasch
29! parts concerning iso2d and avs output removed
30!
31! 1320 2014-03-20 08:40:49Z raasch
32! ONLY-attribute added to USE-statements,
33! kind-parameters added to all INTEGER and REAL declaration statements,
34! kinds are defined in new module kinds,
35! revision history before 2012 removed,
36! comment fields (!:) to be used for variable explanations added to
37! all variable declaration statements
38!
39! 1092 2013-02-02 11:24:22Z raasch
40! unused variables removed
41!
42! 1036 2012-10-22 13:43:42Z raasch
43! code put under GPL (PALM 3.9)
44!
45! 1031 2012-10-19 14:35:30Z raasch
46! netCDF4 without parallel file support implemented
47!
48! 964 2012-07-26 09:14:24Z raasch
49! old profil-units (40:49) and respective code removed
50!
51! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
52! Initial revision
53!
54!
55! Description:
56! ------------
57! Close specified file or all open files, if "0" has been given as the
58! calling argument. In that case, execute last actions for certain unit
59! numbers, if required.
60!------------------------------------------------------------------------------!
61
62    USE control_parameters,                                                    &
63        ONLY:  do2d_xz_n, do2d_xy_n, do2d_yz_n, do3d_avs_n,                    &
64               host, max_masks, mid, netcdf_data_format,                       &
65               nz_do3d, openfile, run_description_header,       &
66               z_max_do2d
67               
68    USE grid_variables,                                                        &
69        ONLY:  dy
70       
71    USE indices,                                                               &
72        ONLY:  nx, ny, nz
73       
74    USE kinds
75   
76    USE netcdf_control
77               
78    USE pegrid                                           
79
80    IMPLICIT NONE
81
82    CHARACTER (LEN=10)  ::  datform = 'lit_endian' !:
83    CHARACTER (LEN=80)  ::  title                  !:
84
85    INTEGER(iwp) ::  av           !:
86    INTEGER(iwp) ::  dimx         !:
87    INTEGER(iwp) ::  dimy         !:
88    INTEGER(iwp) ::  fid          !:
89    INTEGER(iwp) ::  file_id      !:
90    INTEGER(iwp) ::  planz        !:
91
92    LOGICAL ::  checkuf = .TRUE.  !:
93    LOGICAL ::  datleg = .TRUE.   !:
94    LOGICAL ::  dbp = .FALSE.     !:
95
96    REAL(wp) ::  sizex            !:
97    REAL(wp) ::  sizey            !:
98    REAL(wp) ::  yright           !:
99
100    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dbp, planz,               &
101                       title
102    NAMELIST /RAHMEN/  datleg
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#if defined( __netcdf )
126             CASE ( 101 )
127
128                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
129                   nc_stat = NF90_CLOSE( id_set_xy(0) )
130                   CALL handle_netcdf_error( 'close_file', 44 )
131                ENDIF
132
133             CASE ( 102 )
134
135                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
136                   nc_stat = NF90_CLOSE( id_set_xz(0) )
137                   CALL handle_netcdf_error( 'close_file', 45 )
138                ENDIF
139
140             CASE ( 103 )
141
142                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
143                   nc_stat = NF90_CLOSE( id_set_yz(0) )
144                   CALL handle_netcdf_error( 'close_file', 46 )
145                ENDIF
146
147             CASE ( 104 )
148
149                IF ( myid == 0 )  THEN
150                   nc_stat = NF90_CLOSE( id_set_pr )
151                   CALL handle_netcdf_error( 'close_file', 47 )
152                ENDIF
153
154             CASE ( 105 )
155
156                IF ( myid == 0 )  THEN
157                   nc_stat = NF90_CLOSE( id_set_ts )
158                   CALL handle_netcdf_error( 'close_file', 48 )
159                ENDIF
160
161             CASE ( 106 )
162
163                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
164                   nc_stat = NF90_CLOSE( id_set_3d(0) )
165                   CALL handle_netcdf_error( 'close_file', 49 )
166                ENDIF
167
168             CASE ( 107 )
169
170                IF ( myid == 0 )  THEN
171                   nc_stat = NF90_CLOSE( id_set_sp )
172                   CALL handle_netcdf_error( 'close_file', 50 )
173                ENDIF
174
175             CASE ( 108 )
176
177                nc_stat = NF90_CLOSE( id_set_prt )
178                CALL handle_netcdf_error( 'close_file', 51 )
179
180             CASE ( 109 ) 
181
182                nc_stat = NF90_CLOSE( id_set_pts )
183                CALL handle_netcdf_error( 'close_file', 412 )
184
185             CASE ( 111 )
186
187                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
188                   nc_stat = NF90_CLOSE( id_set_xy(1) )
189                   CALL handle_netcdf_error( 'close_file', 52 )
190                ENDIF
191
192             CASE ( 112 )
193
194                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
195                   nc_stat = NF90_CLOSE( id_set_xz(1) )
196                   CALL handle_netcdf_error( 'close_file', 352 )
197                ENDIF
198
199             CASE ( 113 )
200
201                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
202                   nc_stat = NF90_CLOSE( id_set_yz(1) )
203                   CALL handle_netcdf_error( 'close_file', 353 )
204                ENDIF
205
206             CASE ( 116 )
207
208                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
209                   nc_stat = NF90_CLOSE( id_set_3d(1) )
210                   CALL handle_netcdf_error( 'close_file', 353 )
211                ENDIF
212
213             CASE ( 201:200+2*max_masks )
214             
215                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
216!
217!--                decompose fid into mid and av
218                   IF ( fid <= 200+max_masks )  THEN
219                      mid = fid - 200
220                      av = 0
221                   ELSE
222                      mid = fid - (200+max_masks)
223                      av = 1
224                   ENDIF
225                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
226                   CALL handle_netcdf_error( 'close_file', 459 )
227               
228                ENDIF
229
230#endif
231
232          END SELECT
233!
234!--       Close file
235          IF ( openfile(fid)%opened )  CLOSE ( fid )
236
237       ENDIF
238
239    ENDDO
240
241!
242!-- Formats
2433200 FORMAT ('# AVS',A,'field file'/                                           &
244             '#'/                                                              &
245             '# ',A/                                                           &
246             'ndim=3'/                                                         &
247             'dim1=',I5/                                                       &
248             'dim2=',I5/                                                       &
249             'dim3=',I5/                                                       &
250             'nspace=3'/                                                       &
251             'veclen=',I5/                                                     &
252             'data=xdr_float'/                                                 &
253             'field=rectilinear')
2544000 FORMAT ('time averaged over',F7.1,' s')
255
256
257 END SUBROUTINE close_file
Note: See TracBrowser for help on using the repository browser.