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

Last change on this file since 4180 was 4180, checked in by scharf, 5 years ago

removed comments in 'Former revisions' section that are older than 01.01.2019

  • Property svn:keywords set to Id
File size: 7.1 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 4180 2019-08-21 14:37:54Z scharf $
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!
34! Description:
35! ------------
36!> Close specified file or all open files, if "0" has been given as the
37!> calling argument. In that case, execute last actions for certain unit
38!> numbers, if required.
39!------------------------------------------------------------------------------!
40 SUBROUTINE close_file( file_id )
41 
42
43    USE control_parameters,                                                    &
44        ONLY:  max_masks, openfile
45               
46    USE kinds
47   
48#if defined( __netcdf )
49    USE NETCDF
50#endif
51
52    USE netcdf_interface,                                                      &
53        ONLY:  id_set_mask, id_set_pr, id_set_pts, id_set_sp,                  &
54               id_set_ts, id_set_xy, id_set_xz, id_set_yz, id_set_3d,          &
55               id_set_fl, nc_stat, netcdf_data_format, netcdf_handle_error
56               
57    USE pegrid                                           
58
59    IMPLICIT NONE
60
61    CHARACTER (LEN=10)  ::  datform = 'lit_endian' !<
62    CHARACTER (LEN=80)  ::  title                  !<
63
64    INTEGER(iwp) ::  av           !<
65    INTEGER(iwp) ::  dimx         !<
66    INTEGER(iwp) ::  dimy         !<
67    INTEGER(iwp) ::  fid          !<
68    INTEGER(iwp) ::  file_id      !<
69    INTEGER(iwp) ::  mid          !< masked output running index
70    INTEGER(iwp) ::  planz        !<
71
72    LOGICAL ::  checkuf = .TRUE.  !<
73    LOGICAL ::  datleg = .TRUE.   !<
74    LOGICAL ::  dbp = .FALSE.     !<
75
76    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dbp, planz,               &
77                       title
78    NAMELIST /RAHMEN/  datleg
79
80!
81!-- Close specified unit number (if opened) and set a flag that it has
82!-- been opened one time at least
83    IF ( file_id /= 0 )  THEN
84       IF ( openfile(file_id)%opened )  THEN
85          CLOSE ( file_id )
86          openfile(file_id)%opened        = .FALSE.
87          openfile(file_id)%opened_before = .TRUE.
88       ENDIF
89       RETURN
90    ENDIF
91
92!
93!-- Close all open unit numbers
94    DO  fid = 1, 200+2*max_masks
95
96       IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before )  THEN
97!
98!--       Last actions for certain unit numbers
99          SELECT CASE ( fid )
100
101#if defined( __netcdf )
102             CASE ( 101 )
103
104                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
105                   nc_stat = NF90_CLOSE( id_set_xy(0) )
106                   CALL netcdf_handle_error( 'close_file', 44 )
107                ENDIF
108
109             CASE ( 102 )
110
111                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
112                   nc_stat = NF90_CLOSE( id_set_xz(0) )
113                   CALL netcdf_handle_error( 'close_file', 45 )
114                ENDIF
115
116             CASE ( 103 )
117
118                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
119                   nc_stat = NF90_CLOSE( id_set_yz(0) )
120                   CALL netcdf_handle_error( 'close_file', 46 )
121                ENDIF
122
123             CASE ( 104 )
124
125                IF ( myid == 0 )  THEN
126                   nc_stat = NF90_CLOSE( id_set_pr )
127                   CALL netcdf_handle_error( 'close_file', 47 )
128                ENDIF
129
130             CASE ( 105 )
131
132                IF ( myid == 0 )  THEN
133                   nc_stat = NF90_CLOSE( id_set_ts )
134                   CALL netcdf_handle_error( 'close_file', 48 )
135                ENDIF
136
137             CASE ( 106 )
138
139                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
140                   nc_stat = NF90_CLOSE( id_set_3d(0) )
141                   CALL netcdf_handle_error( 'close_file', 49 )
142                ENDIF
143
144             CASE ( 107 )
145
146                IF ( myid == 0 )  THEN
147                   nc_stat = NF90_CLOSE( id_set_sp )
148                   CALL netcdf_handle_error( 'close_file', 50 )
149                ENDIF
150
151!
152!--           Currently disabled
153!             CASE ( 108 )
154
155!                nc_stat = NF90_CLOSE( id_set_prt )
156!                CALL netcdf_handle_error( 'close_file', 51 )
157
158             CASE ( 109 ) 
159
160                nc_stat = NF90_CLOSE( id_set_pts )
161                CALL netcdf_handle_error( 'close_file', 412 )
162
163             CASE ( 111 )
164
165                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
166                   nc_stat = NF90_CLOSE( id_set_xy(1) )
167                   CALL netcdf_handle_error( 'close_file', 52 )
168                ENDIF
169
170             CASE ( 112 )
171
172                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
173                   nc_stat = NF90_CLOSE( id_set_xz(1) )
174                   CALL netcdf_handle_error( 'close_file', 352 )
175                ENDIF
176
177             CASE ( 113 )
178
179                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
180                   nc_stat = NF90_CLOSE( id_set_yz(1) )
181                   CALL netcdf_handle_error( 'close_file', 353 )
182                ENDIF
183
184             CASE ( 116 )
185
186                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
187                   nc_stat = NF90_CLOSE( id_set_3d(1) )
188                   CALL netcdf_handle_error( 'close_file', 353 )
189                ENDIF
190
191             CASE ( 199 )
192
193                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
194                   nc_stat = NF90_CLOSE( id_set_fl )
195                   CALL netcdf_handle_error( 'close_file', 353 )
196                ENDIF
197
198             CASE ( 201:200+2*max_masks )
199
200                IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
201!
202!--                decompose fid into mid and av
203                   IF ( fid <= 200+max_masks )  THEN
204                      mid = fid - 200
205                      av = 0
206                   ELSE
207                      mid = fid - (200+max_masks)
208                      av = 1
209                   ENDIF
210                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
211                   CALL netcdf_handle_error( 'close_file', 459 )
212
213                ENDIF
214
215#endif
216
217          END SELECT
218!
219!--       Close file
220          IF ( openfile(fid)%opened )  CLOSE ( fid )
221
222       ENDIF
223
224    ENDDO
225
226 END SUBROUTINE close_file
Note: See TracBrowser for help on using the repository browser.