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

Last change on this file since 1025 was 965, checked in by raasch, 12 years ago

last commit documented

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