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

Last change on this file since 1035 was 1035, checked in by raasch, 11 years ago

revisions r1031 and r1034 documented

  • Property svn:keywords set to Id
File size: 10.8 KB
Line 
1 SUBROUTINE close_file( file_id )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: close_file.f90 1035 2012-10-22 11:42:53Z raasch $
11!
12! 1031 2012-10-19 14:35:30Z raasch
13! netCDF4 without parallel file support implemented
14!
15! 964 2012-07-26 09:14:24Z raasch
16! old profil-units (40:49) and respective code removed
17!
18! 564 2010-09-30 13:18:59Z helmke
19! start number of mask output files changed to 201, netcdf message identifiers
20! of masked output changed
21!
22! 493 2010-03-01 08:30:24Z raasch
23! Adjustments for NetCDF parallel data output
24!
25! 410 2009-12-04 17:05:40Z letzel
26! masked data output
27!
28! 263 2009-03-18 12:26:04Z heinze
29! Output of NetCDF messages with aid of message handling routine.
30!
31! Feb. 2007
32! RCS Log replace by Id keyword, revision history cleaned up
33!
34! Revision 1.10  2006/08/22 13:50:01  raasch
35! xz and yz cross sections now up to nzt+1
36!
37! Revision 1.1  2001/01/02 17:23:41  raasch
38! Initial revision
39!
40! Last revision before renaming subroutine  2001/01/01  raasch
41! Subroutine name changed from close_files to close_file. Closing of a single
42! file is allowed by passing its file-id as an argument. Variable openfile now
43! is of type file_status and contains a flag which indicates if a file has
44! been opened before. Old revision remarks deleted.
45!
46! Revision 1.13 (close_files) 2000/12/20 09:10:24  letzel
47! All comments translated into English.
48!
49! Revision 1.12 (close_files) 1999/03/02 09:22:46  raasch
50! FLD-Header fuer komprimierte 3D-Daten
51!
52! Revision 1.1 (close_files) 1997/08/11 06:11:18  raasch
53! Initial revision
54!
55!
56! Description:
57! ------------
58! Close specified file or all open files, if "0" has been given as the
59! calling argument. In that case, execute last actions for certain unit
60! numbers, if required.
61!------------------------------------------------------------------------------!
62
63    USE control_parameters
64    USE grid_variables
65    USE indices
66    USE netcdf_control
67    USE pegrid
68    USE profil_parameter
69    USE statistics
70
71    IMPLICIT NONE
72
73    CHARACTER (LEN=2)   ::  suffix
74    CHARACTER (LEN=10)  ::  datform = 'lit_endian'
75    CHARACTER (LEN=80)  ::  rtext, title
76
77    INTEGER ::  av, anzzeile, dimx, dimy, &
78                fid, file_id, j, k, planz
79
80    LOGICAL ::  checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., swap
81
82    REAL ::  sizex, sizey, yright
83
84    NAMELIST /GLOBAL/  checkuf, datform, dimx, dimy, dp, planz, &
85                       title
86    NAMELIST /RAHMEN/  anzzeile, datleg, rtext, swap
87
88!
89!-- Close specified unit number (if opened) and set a flag that it has
90!-- been opened one time at least
91    IF ( file_id /= 0 )  THEN
92       IF ( openfile(file_id)%opened )  THEN
93          CLOSE ( file_id )
94          openfile(file_id)%opened        = .FALSE.
95          openfile(file_id)%opened_before = .TRUE.
96       ENDIF
97       RETURN
98    ENDIF
99
100!
101!-- Close all open unit numbers
102    DO  fid = 1, 200+2*max_masks
103
104       IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before )  THEN
105!
106!--       Last actions for certain unit numbers
107          SELECT CASE ( fid )
108
109             CASE ( 21 )
110!
111!--             Write ISO2D global parameters
112                IF ( myid == 0  .AND.  iso2d_output )  THEN
113                   planz  = do2d_xy_n
114                   dimx   = nx + 2
115                   dimy   = ny + 2
116                   sizex  = 100.0
117                   sizey  = 100.0
118                   title  = run_description_header
119                   yright = ( ny + 1.0 ) * dy
120                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
121                      checkuf = .FALSE.; dp = .TRUE.
122                   ENDIF
123                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
124                      datform = 'big_endian'
125                   ENDIF
126                   OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
127                              DELIM='APOSTROPHE' )
128                   WRITE ( 90, GLOBAL )
129                   CLOSE ( 90 )
130                ENDIF
131
132             CASE ( 22 )
133!
134!--             Write ISO2D global parameters
135                IF ( myid == 0 )  THEN
136                   planz  = do2d_xz_n
137                   dimx   = nx + 2
138                   dimy   = nz + 2
139                   sizex  = 100.0
140                   sizey  =  65.0
141                   title  = run_description_header
142                   yright = z_max_do2d
143                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
144                      checkuf = .FALSE.; dp = .TRUE.
145                   ENDIF
146                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
147                      datform = 'big_endian'
148                   ENDIF
149                   OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
150                              DELIM='APOSTROPHE' )
151                   WRITE ( 90, GLOBAL )
152                   CLOSE ( 90 )
153                ENDIF
154
155             CASE ( 23 )
156!
157!--             Write ISO2D global parameters
158                IF ( myid == 0 )  THEN
159                   planz  = do2d_yz_n
160                   dimx   = ny + 2
161                   dimy   = nz + 2
162                   sizex  = 100.0
163                   sizey  =  65.0
164                   title  = run_description_header
165                   yright = z_max_do2d
166                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 't3e' )  THEN
167                      checkuf = .FALSE.; dp = .TRUE.
168                   ENDIF
169                   IF ( host(1:3) == 'ibm'  .OR.  host(1:3) == 'nec' )  THEN
170                      datform = 'big_endian'
171                   ENDIF
172                   OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
173                              DELIM='APOSTROPHE' )
174                   WRITE ( 90, GLOBAL )
175                   CLOSE ( 90 )
176                ENDIF
177
178             CASE ( 32 )
179!
180!--             Write header for FLD-file
181                IF ( do3d_compress )  THEN
182                   WRITE ( 32, 3200)  ' compressed ',                       &
183                                      TRIM( run_description_header ), nx+2, &
184                                      ny+2, nz_do3d+1, do3d_avs_n
185                ELSE
186                   WRITE ( 32, 3200)  ' ', TRIM( run_description_header ), &
187                                      nx+2, ny+2, nz_do3d+1, do3d_avs_n
188                ENDIF
189
190#if defined( __netcdf )
191             CASE ( 101 )
192
193                IF ( netcdf_output  .AND.  &
194                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
195                   nc_stat = NF90_CLOSE( id_set_xy(0) )
196                   CALL handle_netcdf_error( 'close_file', 44 )
197                ENDIF
198
199             CASE ( 102 )
200
201                IF ( netcdf_output  .AND.  &
202                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
203                   nc_stat = NF90_CLOSE( id_set_xz(0) )
204                   CALL handle_netcdf_error( 'close_file', 45 )
205                ENDIF
206
207             CASE ( 103 )
208
209                IF ( netcdf_output  .AND.  &
210                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
211                   nc_stat = NF90_CLOSE( id_set_yz(0) )
212                   CALL handle_netcdf_error( 'close_file', 46 )
213                ENDIF
214
215             CASE ( 104 )
216
217                IF ( myid == 0  .AND.  netcdf_output )  THEN
218                   nc_stat = NF90_CLOSE( id_set_pr )
219                   CALL handle_netcdf_error( 'close_file', 47 )
220                ENDIF
221
222             CASE ( 105 )
223
224                IF ( myid == 0  .AND.  netcdf_output )  THEN
225                   nc_stat = NF90_CLOSE( id_set_ts )
226                   CALL handle_netcdf_error( 'close_file', 48 )
227                ENDIF
228
229             CASE ( 106 )
230
231                IF ( netcdf_output  .AND.  &
232                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
233                   nc_stat = NF90_CLOSE( id_set_3d(0) )
234                   CALL handle_netcdf_error( 'close_file', 49 )
235                ENDIF
236
237             CASE ( 107 )
238
239                IF ( myid == 0  .AND.  netcdf_output )  THEN
240                   nc_stat = NF90_CLOSE( id_set_sp )
241                   CALL handle_netcdf_error( 'close_file', 50 )
242                ENDIF
243
244             CASE ( 108 )
245
246                IF (  netcdf_output )  THEN
247                   nc_stat = NF90_CLOSE( id_set_prt )
248                   CALL handle_netcdf_error( 'close_file', 51 )
249                ENDIF
250
251             CASE ( 109 ) 
252
253                IF (  netcdf_output )  THEN
254                   nc_stat = NF90_CLOSE( id_set_pts )
255                   CALL handle_netcdf_error( 'close_file', 412 )
256                ENDIF
257
258             CASE ( 111 )
259
260                IF ( netcdf_output  .AND.  &
261                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
262                   nc_stat = NF90_CLOSE( id_set_xy(1) )
263                   CALL handle_netcdf_error( 'close_file', 52 )
264                ENDIF
265
266             CASE ( 112 )
267
268                IF ( netcdf_output  .AND.  &
269                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
270                   nc_stat = NF90_CLOSE( id_set_xz(1) )
271                   CALL handle_netcdf_error( 'close_file', 352 )
272                ENDIF
273
274             CASE ( 113 )
275
276                IF ( netcdf_output  .AND.  &
277                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
278                   nc_stat = NF90_CLOSE( id_set_yz(1) )
279                   CALL handle_netcdf_error( 'close_file', 353 )
280                ENDIF
281
282             CASE ( 116 )
283
284                IF ( netcdf_output  .AND.  &
285                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
286                   nc_stat = NF90_CLOSE( id_set_3d(1) )
287                   CALL handle_netcdf_error( 'close_file', 353 )
288                ENDIF
289
290             CASE ( 201:200+2*max_masks )
291             
292                IF ( netcdf_output  .AND.  &
293                     ( myid == 0  .OR.  netcdf_data_format > 4 ) )  THEN
294!
295!--                decompose fid into mid and av
296                   IF ( fid <= 200+max_masks )  THEN
297                      mid = fid - 200
298                      av = 0
299                   ELSE
300                      mid = fid - (200+max_masks)
301                      av = 1
302                   ENDIF
303                   nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
304                   CALL handle_netcdf_error( 'close_file', 459 )
305               
306                ENDIF
307
308#endif
309
310          END SELECT
311!
312!--       Close file
313          IF ( openfile(fid)%opened )  CLOSE ( fid )
314
315       ENDIF
316
317    ENDDO
318
319!
320!-- Formats
3213200 FORMAT ('# AVS',A,'field file'/ &
322             '#'/                &
323             '# ',A/             &
324             'ndim=3'/           &
325             'dim1=',I5/         &
326             'dim2=',I5/         &
327             'dim3=',I5/         &
328             'nspace=3'/         &
329             'veclen=',I5/       &
330             'data=xdr_float'/   &
331             'field=rectilinear')
3324000 FORMAT ('time averaged over',F7.1,' s')
333
334
335 END SUBROUTINE close_file
Note: See TracBrowser for help on using the repository browser.