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

Last change on this file since 4069 was 4069, checked in by Giersch, 23 months ago

Bugfix for masked output, compiler warning removed, test case for wind turbine model revised

  • Property svn:keywords set to Id
File size: 8.6 KB
Line 
1!> @file close_file.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! 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-2019 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: close_file.f90 4069 2019-07-01 14:05:51Z Giersch $
27! Masked output running index mid has been introduced as a local variable to
28! avoid runtime error (Loop variable has been modified) in time_integration
29!
30! 3655 2019-01-07 16:51:22Z knoop
31! unused variables and format statements removed
32!
33! 3045 2018-05-28 07:55:41Z Giersch
34! z_max_do2d removed and output case 108 disabled
35!
36! 2718 2018-01-02 08:49:38Z maronga
37! Corrected "Former revisions" section
38!
39! 2696 2017-12-14 17:12:51Z kanani
40! Change in file header (GPL part)
41!
42! 2300 2017-06-29 13:31:14Z raasch
43! -host
44!
45! 2277 2017-06-12 10:47:51Z kanani
46! Removed unused variables do2d_xy_n, do2d_xz_n, do2d_yz_n, do3d_avs_n
47!
48! 2101 2017-01-05 16:42:31Z suehring
49!
50! 2000 2016-08-20 18:09:15Z knoop
51! Forced header and separation lines into 80 columns
52!
53! 1992 2016-08-12 15:14:59Z suehring
54! -Close file containing flight data
55! -Some tabs removed.
56!
57! 1783 2016-03-06 18:36:17Z raasch
58! name change of netcdf routines and module + related changes
59!
60! 1682 2015-10-07 23:56:08Z knoop
61! Code annotations made doxygen readable
62!
63! 1327 2014-03-21 11:00:16Z raasch
64! parts concerning iso2d and avs output removed
65!
66! 1320 2014-03-20 08:40:49Z raasch
67! ONLY-attribute added to USE-statements,
68! kind-parameters added to all INTEGER and REAL declaration statements,
69! kinds are defined in new module kinds,
70! revision history before 2012 removed,
71! comment fields (!:) to be used for variable explanations added to
72! all variable declaration statements
73!
74! 1092 2013-02-02 11:24:22Z raasch
75! unused variables removed
76!
77! 1036 2012-10-22 13:43:42Z raasch
78! code put under GPL (PALM 3.9)
79!
80! 1031 2012-10-19 14:35:30Z raasch
81! netCDF4 without parallel file support implemented
82!
83! 964 2012-07-26 09:14:24Z raasch
84! old profil-units (40:49) and respective code removed
85!
86! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
87! Initial revision
88!
89!
90! Description:
91! ------------
92!> Close specified file or all open files, if "0" has been given as the
93!> calling argument. In that case, execute last actions for certain unit
94!> numbers, if required.
95!------------------------------------------------------------------------------!
96 SUBROUTINE close_file( file_id )
97 
98
99    USE control_parameters,                                                    &
100        ONLY:  max_masks, openfile
101               
102    USE kinds
103   
104#if defined( __netcdf )
105    USE NETCDF
106#endif
107
108    USE netcdf_interface,                                                      &
109        ONLY:  id_set_mask, id_set_pr, id_set_pts, id_set_sp,                  &
110               id_set_ts, id_set_xy, id_set_xz, id_set_yz, id_set_3d,          &
111               id_set_fl, nc_stat, netcdf_data_format, netcdf_handle_error
112               
113    USE pegrid                                           
114
115    IMPLICIT NONE
116
117    CHARACTER (LEN=10)  ::  datform = 'lit_endian' !<
118    CHARACTER (LEN=80)  ::  title                  !<
119
120    INTEGER(iwp) ::  av           !<
121    INTEGER(iwp) ::  dimx         !<
122    INTEGER(iwp) ::  dimy         !<
123    INTEGER(iwp) ::  fid          !<
124    INTEGER(iwp) ::  file_id      !<
125    INTEGER(iwp) ::  mid          !< masked output running index
126    INTEGER(iwp) ::  planz        !<
127
128    LOGICAL ::  checkuf = .TRUE.  !<
129    LOGICAL ::  datleg = .TRUE.   !<
130    LOGICAL ::  dbp = .FALSE.     !<
131
132    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dbp, planz,               &
133                       title
134    NAMELIST /RAHMEN/  datleg
135
136!
137!-- Close specified unit number (if opened) and set a flag that it has
138!-- been opened one time at least
139    IF ( file_id /= 0 )  THEN
140       IF ( openfile(file_id)%opened )  THEN
141          CLOSE ( file_id )
142          openfile(file_id)%opened        = .FALSE.
143          openfile(file_id)%opened_before = .TRUE.
144       ENDIF
145       RETURN
146    ENDIF
147
148!
149!-- Close all open unit numbers
150    DO  fid = 1, 200+2*max_masks
151
152       IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before )  THEN
153!
154!--       Last actions for certain unit numbers
155          SELECT CASE ( fid )
156
157#if defined( __netcdf )
158             CASE ( 101 )
159
160                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
161                   nc_stat = NF90_CLOSE( id_set_xy(0) )
162                   CALL netcdf_handle_error( 'close_file', 44 )
163                ENDIF
164
165             CASE ( 102 )
166
167                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
168                   nc_stat = NF90_CLOSE( id_set_xz(0) )
169                   CALL netcdf_handle_error( 'close_file', 45 )
170                ENDIF
171
172             CASE ( 103 )
173
174                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
175                   nc_stat = NF90_CLOSE( id_set_yz(0) )
176                   CALL netcdf_handle_error( 'close_file', 46 )
177                ENDIF
178
179             CASE ( 104 )
180
181                IF ( myid == 0 )  THEN
182                   nc_stat = NF90_CLOSE( id_set_pr )
183                   CALL netcdf_handle_error( 'close_file', 47 )
184                ENDIF
185
186             CASE ( 105 )
187
188                IF ( myid == 0 )  THEN
189                   nc_stat = NF90_CLOSE( id_set_ts )
190                   CALL netcdf_handle_error( 'close_file', 48 )
191                ENDIF
192
193             CASE ( 106 )
194
195                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
196                   nc_stat = NF90_CLOSE( id_set_3d(0) )
197                   CALL netcdf_handle_error( 'close_file', 49 )
198                ENDIF
199
200             CASE ( 107 )
201
202                IF ( myid == 0 )  THEN
203                   nc_stat = NF90_CLOSE( id_set_sp )
204                   CALL netcdf_handle_error( 'close_file', 50 )
205                ENDIF
206
207!
208!--           Currently disabled
209!             CASE ( 108 )
210
211!                nc_stat = NF90_CLOSE( id_set_prt )
212!                CALL netcdf_handle_error( 'close_file', 51 )
213
214             CASE ( 109 ) 
215
216                nc_stat = NF90_CLOSE( id_set_pts )
217                CALL netcdf_handle_error( 'close_file', 412 )
218
219             CASE ( 111 )
220
221                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
222                   nc_stat = NF90_CLOSE( id_set_xy(1) )
223                   CALL netcdf_handle_error( 'close_file', 52 )
224                ENDIF
225
226             CASE ( 112 )
227
228                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
229                   nc_stat = NF90_CLOSE( id_set_xz(1) )
230                   CALL netcdf_handle_error( 'close_file', 352 )
231                ENDIF
232
233             CASE ( 113 )
234
235                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
236                   nc_stat = NF90_CLOSE( id_set_yz(1) )
237                   CALL netcdf_handle_error( 'close_file', 353 )
238                ENDIF
239
240             CASE ( 116 )
241
242                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
243                   nc_stat = NF90_CLOSE( id_set_3d(1) )
244                   CALL netcdf_handle_error( 'close_file', 353 )
245                ENDIF
246
247             CASE ( 199 )
248
249                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
250                   nc_stat = NF90_CLOSE( id_set_fl )
251                   CALL netcdf_handle_error( 'close_file', 353 )
252                ENDIF
253
254             CASE ( 201:200+2*max_masks )
255
256                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
257!
258!--                decompose fid into mid and av
259                   IF ( fid <= 200+max_masks )  THEN
260                      mid = fid - 200
261                      av = 0
262                   ELSE
263                      mid = fid - (200+max_masks)
264                      av = 1
265                   ENDIF
266                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
267                   CALL netcdf_handle_error( 'close_file', 459 )
268
269                ENDIF
270
271#endif
272
273          END SELECT
274!
275!--       Close file
276          IF ( openfile(fid)%opened )  CLOSE ( fid )
277
278       ENDIF
279
280    ENDDO
281
282 END SUBROUTINE close_file
Note: See TracBrowser for help on using the repository browser.