Home

Context Navigation

check_open.f90 @ 1327

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

Changed:

-s real64 removed (.mrun.config.hlrnIII)
-r8 removed (.mrun.config.imuk)
deleted: .mrun.config.imuk_ice2_netcdf4 .mrun.config.imuk_hlrn

REAL constants defined as wp-kind in modules

"baroclinicity" renamed "baroclinity", "ocean version" replaced by
"ocean mode"

code parts concerning old output formats "iso2d" and "avs" removed.
netCDF is the only remaining output format.

Errors:

bugfix: duplicate error message 56 removed

Property svn:keywords set to Id

File size: 40.3 KB

Line
1	SUBROUTINE check_open( 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	! parts concerning iso2d and avs output removed
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: check_open.f90 1327 2014-03-21 11:00:16Z raasch $
27	!
28	! 1320 2014-03-20 08:40:49Z raasch
29	! ONLY-attribute added to USE-statements,
30	! kind-parameters added to all INTEGER and REAL declaration statements,
31	! kinds are defined in new module kinds,
32	! old module precision_kind is removed,
33	! revision history before 2012 removed,
34	! comment fields (!:) to be used for variable explanations added to
35	! all variable declaration statements
36	!
37	! 1106 2013-03-04 05:31:38Z raasch
38	! array_kind renamed precision_kind
39	!
40	! 1092 2013-02-02 11:24:22Z raasch
41	! unused variables removed
42	!
43	! 1036 2012-10-22 13:43:42Z raasch
44	! code put under GPL (PALM 3.9)
45	!
46	! 1031 2012-10-19 14:35:30Z raasch
47	! netCDF4 without parallel file support implemented,
48	! opening of netCDF files are done by new routines create_netcdf_file and
49	! open_write_netcdf_file
50	!
51	! 964 2012-07-26 09:14:24Z raasch
52	! old profil-units (40:49) removed,
53	! append feature removed from unit 14
54	!
55	! 849 2012-03-15 10:35:09Z raasch
56	! comment changed
57	!
58	! 809 2012-01-30 13:32:58Z maronga
59	! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives
60	!
61	! 807 2012-01-25 11:53:51Z maronga
62	! New cpp directive "__check" implemented which is used by check_namelist_files
63	!
64	! Revision 1.1 1997/08/11 06:10:55 raasch
65	! Initial revision
66	!
67	!
68	! Description:
69	! ------------
70	! Check if file unit is open. If not, open file and, if necessary, write a
71	! header or start other initializing actions, respectively.
72	!------------------------------------------------------------------------------!
73
74	USE arrays_3d, &
75	ONLY: zu
76
77	USE control_parameters, &
78	ONLY: avs_data_file, coupling_char, data_output_2d_on_each_pe, host, &
79	message_string, mid, netcdf_data_format, nz_do3d, openfile, &
80	return_addres, return_username, run_description_header, runnr
81
82	USE grid_variables, &
83	ONLY: dx, dy
84
85	USE indices, &
86	ONLY: nbgp, nx, nxlg, nxrg, ny, nyng, nysg, nz, nzb
87
88	USE kinds
89
90	USE netcdf_control
91
92	USE particle_attributes, &
93	ONLY: max_number_of_particle_groups, number_of_particle_groups, &
94	particle_groups
95
96	USE pegrid
97
98	USE profil_parameter, &
99	ONLY: cross_ts_numbers, cross_ts_number_count
100
101	USE statistics, &
102	ONLY: region, statistic_regions
103
104
105	IMPLICIT NONE
106
107	CHARACTER (LEN=2) :: mask_char !:
108	CHARACTER (LEN=2) :: suffix !:
109	CHARACTER (LEN=20) :: xtext = 'time in s' !:
110	CHARACTER (LEN=30) :: filename !:
111	CHARACTER (LEN=40) :: avs_coor_file !:
112	CHARACTER (LEN=40) :: avs_coor_file_localname !:
113	CHARACTER (LEN=40) :: avs_data_file_localname !:
114	CHARACTER (LEN=80) :: rtext !:
115	CHARACTER (LEN=100) :: avs_coor_file_catalog !:
116	CHARACTER (LEN=100) :: avs_data_file_catalog !:
117	CHARACTER (LEN=100) :: batch_scp !:
118	CHARACTER (LEN=100) :: line !:
119	CHARACTER (LEN=400) :: command !:
120
121	INTEGER(iwp) :: av !:
122	INTEGER(iwp) :: numline = 1 !:
123	INTEGER(iwp) :: cranz !:
124	INTEGER(iwp) :: file_id !:
125	INTEGER(iwp) :: i !:
126	INTEGER(iwp) :: iaddres !:
127	INTEGER(iwp) :: iusern !:
128	INTEGER(iwp) :: j !:
129	INTEGER(iwp) :: k !:
130	INTEGER(iwp) :: legpos = 1 !:
131	INTEGER(iwp) :: timodex = 1 !:
132
133	INTEGER(iwp), DIMENSION(10) :: klist !:
134
135	LOGICAL :: avs_coor_file_found = .FALSE. !:
136	LOGICAL :: avs_data_file_found = .FALSE. !:
137	LOGICAL :: datleg = .TRUE. !:
138	LOGICAL :: get_filenames !:
139	LOGICAL :: grid = .TRUE. !:
140	LOGICAL :: netcdf_extend !:
141	LOGICAL :: rand = .TRUE. !:
142	LOGICAL :: swap = .TRUE. !:
143	LOGICAL :: twoxa = .TRUE. !:
144	LOGICAL :: twoya = .TRUE. !:
145
146	REAL(wp) :: ansx = -999.999 !:
147	REAL(wp) :: ansy = -999.999 !:
148	REAL(wp) :: gwid = 0.1 !:
149	REAL(wp) :: rlegfak = 1.5 !:
150	REAL(wp) :: sizex = 250.0 !:
151	REAL(wp) :: sizey = 40.0 !:
152	REAL(wp) :: texfac = 1.5 !:
153
154	REAL(wp), DIMENSION(:), ALLOCATABLE :: eta !:
155	REAL(wp), DIMENSION(:), ALLOCATABLE :: ho !:
156	REAL(wp), DIMENSION(:), ALLOCATABLE :: hu !:
157
158	REAL(sp), DIMENSION(:), ALLOCATABLE :: xkoor !:
159	REAL(sp), DIMENSION(:), ALLOCATABLE :: ykoor !:
160	REAL(sp), DIMENSION(:), ALLOCATABLE :: zkoor !:
161
162
163	NAMELIST /RAHMEN/ numline, cranz, datleg, rtext, swap
164	NAMELIST /CROSS/ ansx, ansy, grid, gwid, klist, legpos, &
165	rand, rlegfak, sizex, sizey, texfac, &
166	timodex, twoxa, twoya, xtext
167
168
169	!
170	!-- Immediate return if file already open
171	IF ( openfile(file_id)%opened ) RETURN
172
173	#if ! defined ( __check )
174	!
175	!-- Only certain files are allowed to be re-opened
176	!-- NOTE: some of the other files perhaps also could be re-opened, but it
177	!-- has not been checked so far, if it works!
178	IF ( openfile(file_id)%opened_before ) THEN
179	SELECT CASE ( file_id )
180	CASE ( 13, 14, 21, 22, 23, 80:85 )
181	IF ( file_id == 14 .AND. openfile(file_id)%opened_before ) THEN
182	message_string = 're-open of unit ' // &
183	'14 is not verified. Please check results!'
184	CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )
185	ENDIF
186
187	CASE DEFAULT
188	WRITE( message_string, * ) 're-opening of file-id ', file_id, &
189	' is not allowed'
190	CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )
191
192	RETURN
193
194	END SELECT
195	ENDIF
196	#endif
197
198	!
199	!-- Check if file may be opened on the relevant PE
200	SELECT CASE ( file_id )
201
202	CASE ( 15, 16, 17, 18, 19, 50:59, 81:84, 104:105, 107, 109 )
203
204	IF ( myid /= 0 ) THEN
205	WRITE( message_string, * ) 'opening file-id ',file_id, &
206	' not allowed for PE ',myid
207	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
208	ENDIF
209
210	CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks )
211
212	IF ( netcdf_data_format < 5 ) THEN
213
214	IF ( myid /= 0 ) THEN
215	WRITE( message_string, * ) 'opening file-id ',file_id, &
216	' not allowed for PE ',myid
217	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
218	ENDIF
219
220	ENDIF
221
222	CASE ( 21, 22, 23 )
223
224	IF ( .NOT. data_output_2d_on_each_pe ) THEN
225	IF ( myid /= 0 ) THEN
226	WRITE( message_string, * ) 'opening file-id ',file_id, &
227	' not allowed for PE ',myid
228	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
229	END IF
230	ENDIF
231
232	CASE ( 27, 28, 29, 31, 33, 71:73, 90:99 )
233
234	!
235	!-- File-ids that are used temporarily in other routines
236	WRITE( message_string, * ) 'opening file-id ',file_id, &
237	' is not allowed since it is used otherwise'
238	CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
239
240	END SELECT
241
242	!
243	!-- Open relevant files
244	SELECT CASE ( file_id )
245
246	CASE ( 11 )
247
248	#if defined ( __check )
249	!
250	!-- In case of a prior parameter file check, the p3d data is stored in
251	!-- PARIN, while the p3df is stored in PARINF. This only applies to
252	!-- check_namelist_files!
253	IF ( check_restart == 2 ) THEN
254	OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED', &
255	STATUS='OLD' )
256	ELSE
257	OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
258	STATUS='OLD' )
259	END IF
260	#else
261
262	OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
263	STATUS='OLD' )
264	#endif
265
266	CASE ( 13 )
267
268	IF ( myid_char == '' ) THEN
269	OPEN ( 13, FILE='BININ'//coupling_char//myid_char, &
270	FORM='UNFORMATTED', STATUS='OLD' )
271	ELSE
272	!
273	!-- First opening of unit 13 openes file _0000 on all PEs because only
274	!-- this file contains the global variables
275	IF ( .NOT. openfile(file_id)%opened_before ) THEN
276	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_0000', &
277	FORM='UNFORMATTED', STATUS='OLD' )
278	ELSE
279	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'//myid_char,&
280	FORM='UNFORMATTED', STATUS='OLD' )
281	ENDIF
282	ENDIF
283
284	CASE ( 14 )
285
286	IF ( myid_char == '' ) THEN
287	OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, &
288	FORM='UNFORMATTED', POSITION='APPEND' )
289	ELSE
290	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
291	CALL local_system( 'mkdir BINOUT' // coupling_char )
292	ENDIF
293	#if defined( __parallel ) && ! defined ( __check )
294	!
295	!-- Set a barrier in order to allow that all other processors in the
296	!-- directory created by PE0 can open their file
297	CALL MPI_BARRIER( comm2d, ierr )
298	#endif
299	OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
300	FORM='UNFORMATTED' )
301	ENDIF
302
303	CASE ( 15 )
304
305	OPEN ( 15, FILE='RUN_CONTROL'//coupling_char, FORM='FORMATTED' )
306
307	CASE ( 16 )
308
309	OPEN ( 16, FILE='LIST_PROFIL'//coupling_char, FORM='FORMATTED' )
310
311	CASE ( 17 )
312
313	OPEN ( 17, FILE='LIST_PROFIL_1D'//coupling_char, FORM='FORMATTED' )
314
315	CASE ( 18 )
316
317	OPEN ( 18, FILE='CPU_MEASURES'//coupling_char, FORM='FORMATTED' )
318
319	CASE ( 19 )
320
321	OPEN ( 19, FILE='HEADER'//coupling_char, FORM='FORMATTED' )
322
323	CASE ( 20 )
324
325	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
326	CALL local_system( 'mkdir DATA_LOG' // coupling_char )
327	ENDIF
328	IF ( myid_char == '' ) THEN
329	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', &
330	FORM='UNFORMATTED', POSITION='APPEND' )
331	ELSE
332	#if defined( __parallel ) && ! defined ( __check )
333	!
334	!-- Set a barrier in order to allow that all other processors in the
335	!-- directory created by PE0 can open their file
336	CALL MPI_BARRIER( comm2d, ierr )
337	#endif
338	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'//myid_char,&
339	FORM='UNFORMATTED', POSITION='APPEND' )
340	ENDIF
341
342	CASE ( 21 )
343
344	IF ( data_output_2d_on_each_pe ) THEN
345	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
346	FORM='UNFORMATTED', POSITION='APPEND' )
347	ELSE
348	OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, &
349	FORM='UNFORMATTED', POSITION='APPEND' )
350	ENDIF
351
352	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
353	!
354	!-- Output for combine_plot_fields
355	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
356	WRITE (21) -nbgp, nx+nbgp, -nbgp, ny+nbgp ! total array size
357	WRITE (21) 0, nx+1, 0, ny+1 ! output part
358	ENDIF
359	!
360	!-- Determine and write ISO2D coordiante header
361	ALLOCATE( eta(0:ny+1), ho(0:nx+1), hu(0:nx+1) )
362	hu = 0.0
363	ho = (ny+1) * dy
364	DO i = 1, ny
365	eta(i) = REAL( i ) / ( ny + 1.0 )
366	ENDDO
367	eta(0) = 0.0
368	eta(ny+1) = 1.0
369
370	WRITE (21) dx,eta,hu,ho
371	DEALLOCATE( eta, ho, hu )
372
373	ENDIF
374
375	CASE ( 22 )
376
377	IF ( data_output_2d_on_each_pe ) THEN
378	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
379	FORM='UNFORMATTED', POSITION='APPEND' )
380	ELSE
381	OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', &
382	POSITION='APPEND' )
383	ENDIF
384
385	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
386	!
387	!-- Output for combine_plot_fields
388	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
389	WRITE (22) -nbgp, nx+nbgp, 0, nz+1 ! total array size
390	WRITE (22) 0, nx+1, 0, nz+1 ! output part
391	ENDIF
392	!
393	!-- Determine and write ISO2D coordinate header
394	ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) )
395	hu = 0.0
396	ho = zu(nz+1)
397	DO i = 1, nz
398	eta(i) = REAL( zu(i) ) / zu(nz+1)
399	ENDDO
400	eta(0) = 0.0
401	eta(nz+1) = 1.0
402
403	WRITE (22) dx,eta,hu,ho
404	DEALLOCATE( eta, ho, hu )
405
406	ENDIF
407
408	CASE ( 23 )
409
410	IF ( data_output_2d_on_each_pe ) THEN
411	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
412	FORM='UNFORMATTED', POSITION='APPEND' )
413	ELSE
414	OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', &
415	POSITION='APPEND' )
416	ENDIF
417
418	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
419	!
420	!-- Output for combine_plot_fields
421	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
422	WRITE (23) -nbgp, ny+nbgp, 0, nz+1 ! total array size
423	WRITE (23) 0, ny+1, 0, nz+1 ! output part
424	ENDIF
425	!
426	!-- Determine and write ISO2D coordiante header
427	ALLOCATE( eta(0:nz+1), ho(0:ny+1), hu(0:ny+1) )
428	hu = 0.0
429	ho = zu(nz+1)
430	DO i = 1, nz
431	eta(i) = REAL( zu(i) ) / zu(nz+1)
432	ENDDO
433	eta(0) = 0.0
434	eta(nz+1) = 1.0
435
436	WRITE (23) dx,eta,hu,ho
437	DEALLOCATE( eta, ho, hu )
438
439	ENDIF
440
441	CASE ( 30 )
442
443	OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
444	FORM='UNFORMATTED' )
445	!
446	!-- Write coordinate file for AVS
447	IF ( myid == 0 ) THEN
448	#if defined( __parallel )
449	!
450	!-- Specifications for combine_plot_fields
451	WRITE ( 30 ) -nbgp,nx+nbgp,-nbgp,ny+nbgp, 0 ,nz_do3d
452	WRITE ( 30 ) 0,nx+1,0,ny+1,0,nz_do3d
453	#endif
454	ENDIF
455
456	CASE ( 50:59 )
457
458	IF ( statistic_regions == 0 .AND. file_id == 50 ) THEN
459	suffix = ''
460	ELSE
461	WRITE ( suffix, '(''_'',I1)' ) file_id - 50
462	ENDIF
463	OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// &
464	TRIM( suffix ), &
465	FORM='FORMATTED', RECL=496 )
466	!
467	!-- Write PROFIL parameter file for output of time series
468	!-- NOTE: To be on the safe side, this output is done at the beginning of
469	!-- the model run (in case of collapse) and it is repeated in
470	!-- close_file, then, however, with value ranges for the coordinate
471	!-- systems
472	!
473	!-- Firstly determine the number of the coordinate systems to be drawn
474	cranz = 0
475	DO j = 1, 10
476	IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1
477	ENDDO
478	rtext = '\1.0 ' // TRIM( run_description_header ) // ' ' // &
479	TRIM( region( file_id - 50 ) )
480	!
481	!-- Write RAHMEN parameter
482	OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// &
483	TRIM( suffix ), &
484	FORM='FORMATTED', DELIM='APOSTROPHE' )
485	WRITE ( 90, RAHMEN )
486	!
487	!-- Determine and write CROSS parameters for the individual coordinate
488	!-- systems
489	DO j = 1, 10
490	k = cross_ts_number_count(j)
491	IF ( k /= 0 ) THEN
492	!
493	!-- Store curve numbers, colours and line style
494	klist(1:k) = cross_ts_numbers(1:k,j)
495	klist(k+1:10) = 999999
496	!
497	!-- Write CROSS parameter
498	WRITE ( 90, CROSS )
499
500	ENDIF
501	ENDDO
502
503	CLOSE ( 90 )
504	!
505	!-- Write all labels at the top of the data file, but only during the
506	!-- first run of a sequence of jobs. The following jobs copy the time
507	!-- series data to the bottom of that file.
508	IF ( runnr == 0 ) THEN
509	WRITE ( file_id, 5000 ) TRIM( run_description_header ) // &
510	' ' // TRIM( region( file_id - 50 ) )
511	ENDIF
512
513
514	CASE ( 80 )
515
516	IF ( myid_char == '' ) THEN
517	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
518	FORM='FORMATTED', POSITION='APPEND' )
519	ELSE
520	IF ( myid == 0 .AND. .NOT. openfile(80)%opened_before ) THEN
521	CALL local_system( 'mkdir PARTICLE_INFOS' // coupling_char )
522	ENDIF
523	#if defined( __parallel ) && ! defined ( __check )
524	!
525	!-- Set a barrier in order to allow that thereafter all other
526	!-- processors in the directory created by PE0 can open their file.
527	!-- WARNING: The following barrier will lead to hanging jobs, if
528	!-- check_open is first called from routine
529	!-- allocate_prt_memory!
530	IF ( .NOT. openfile(80)%opened_before ) THEN
531	CALL MPI_BARRIER( comm2d, ierr )
532	ENDIF
533	#endif
534	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
535	myid_char, &
536	FORM='FORMATTED', POSITION='APPEND' )
537	ENDIF
538
539	IF ( .NOT. openfile(80)%opened_before ) THEN
540	WRITE ( 80, 8000 ) TRIM( run_description_header )
541	ENDIF
542
543	CASE ( 81 )
544
545	OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', &
546	DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
547
548	CASE ( 82 )
549
550	OPEN ( 82, FILE='PLOTSP_X_DATA'//coupling_char, FORM='FORMATTED', &
551	POSITION = 'APPEND' )
552
553	CASE ( 83 )
554
555	OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', &
556	DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
557
558	CASE ( 84 )
559
560	OPEN ( 84, FILE='PLOTSP_Y_DATA'//coupling_char, FORM='FORMATTED', &
561	POSITION='APPEND' )
562
563	CASE ( 85 )
564
565	IF ( myid_char == '' ) THEN
566	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
567	FORM='UNFORMATTED', POSITION='APPEND' )
568	ELSE
569	IF ( myid == 0 .AND. .NOT. openfile(85)%opened_before ) THEN
570	CALL local_system( 'mkdir PARTICLE_DATA' // coupling_char )
571	ENDIF
572	#if defined( __parallel ) && ! defined ( __check )
573	!
574	!-- Set a barrier in order to allow that thereafter all other
575	!-- processors in the directory created by PE0 can open their file
576	CALL MPI_BARRIER( comm2d, ierr )
577	#endif
578	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
579	myid_char, &
580	FORM='UNFORMATTED', POSITION='APPEND' )
581	ENDIF
582
583	IF ( .NOT. openfile(85)%opened_before ) THEN
584	WRITE ( 85 ) run_description_header
585	!
586	!-- Attention: change version number whenever the output format on
587	!-- unit 85 is changed (see also in routine
588	!-- lpm_data_output_particles)
589	rtext = 'data format version 3.0'
590	WRITE ( 85 ) rtext
591	WRITE ( 85 ) number_of_particle_groups, &
592	max_number_of_particle_groups
593	WRITE ( 85 ) particle_groups
594	ENDIF
595
596	#if defined( __netcdf )
597	CASE ( 101, 111 )
598	!
599	!-- Set filename depending on unit number
600	IF ( file_id == 101 ) THEN
601	filename = 'DATA_2D_XY_NETCDF' // coupling_char
602	av = 0
603	ELSE
604	filename = 'DATA_2D_XY_AV_NETCDF' // coupling_char
605	av = 1
606	ENDIF
607	!
608	!-- Inquire, if there is a netCDF file from a previuos run. This should
609	!-- be opened for extension, if its dimensions and variables match the
610	!-- actual run.
611	INQUIRE( FILE=filename, EXIST=netcdf_extend )
612
613	IF ( netcdf_extend ) THEN
614	!
615	!-- Open an existing netCDF file for output
616	CALL open_write_netcdf_file( filename, id_set_xy(av), .TRUE., 20 )
617	!
618	!-- Read header information and set all ids. If there is a mismatch
619	!-- between the previuos and the actual run, netcdf_extend is returned
620	!-- as .FALSE.
621	CALL define_netcdf_header( 'xy', netcdf_extend, av )
622
623	!
624	!-- Remove the local file, if it can not be extended
625	IF ( .NOT. netcdf_extend ) THEN
626	nc_stat = NF90_CLOSE( id_set_xy(av) )
627	CALL handle_netcdf_error( 'check_open', 21 )
628	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
629	ENDIF
630
631	ENDIF
632
633	IF ( .NOT. netcdf_extend ) THEN
634	!
635	!-- Create a new netCDF output file with requested netCDF format
636	CALL create_netcdf_file( filename, id_set_xy(av), .TRUE., 22 )
637
638	!
639	!-- Define the header
640	CALL define_netcdf_header( 'xy', netcdf_extend, av )
641
642	!
643	!-- In case of parallel netCDF output, create flag file which tells
644	!-- combine_plot_fields that nothing is to do.
645	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
646	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
647	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
648	CLOSE( 99 )
649	ENDIF
650
651	ENDIF
652
653	CASE ( 102, 112 )
654	!
655	!-- Set filename depending on unit number
656	IF ( file_id == 102 ) THEN
657	filename = 'DATA_2D_XZ_NETCDF' // coupling_char
658	av = 0
659	ELSE
660	filename = 'DATA_2D_XZ_AV_NETCDF' // coupling_char
661	av = 1
662	ENDIF
663	!
664	!-- Inquire, if there is a netCDF file from a previuos run. This should
665	!-- be opened for extension, if its dimensions and variables match the
666	!-- actual run.
667	INQUIRE( FILE=filename, EXIST=netcdf_extend )
668
669	IF ( netcdf_extend ) THEN
670	!
671	!-- Open an existing netCDF file for output
672	CALL open_write_netcdf_file( filename, id_set_xz(av), .TRUE., 23 )
673	!
674	!-- Read header information and set all ids. If there is a mismatch
675	!-- between the previuos and the actual run, netcdf_extend is returned
676	!-- as .FALSE.
677	CALL define_netcdf_header( 'xz', netcdf_extend, av )
678
679	!
680	!-- Remove the local file, if it can not be extended
681	IF ( .NOT. netcdf_extend ) THEN
682	nc_stat = NF90_CLOSE( id_set_xz(av) )
683	CALL handle_netcdf_error( 'check_open', 24 )
684	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
685	ENDIF
686
687	ENDIF
688
689	IF ( .NOT. netcdf_extend ) THEN
690	!
691	!-- Create a new netCDF output file with requested netCDF format
692	CALL create_netcdf_file( filename, id_set_xz(av), .TRUE., 25 )
693
694	!
695	!-- Define the header
696	CALL define_netcdf_header( 'xz', netcdf_extend, av )
697
698	!
699	!-- In case of parallel netCDF output, create flag file which tells
700	!-- combine_plot_fields that nothing is to do.
701	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
702	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
703	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
704	CLOSE( 99 )
705	ENDIF
706
707	ENDIF
708
709	CASE ( 103, 113 )
710	!
711	!-- Set filename depending on unit number
712	IF ( file_id == 103 ) THEN
713	filename = 'DATA_2D_YZ_NETCDF' // coupling_char
714	av = 0
715	ELSE
716	filename = 'DATA_2D_YZ_AV_NETCDF' // coupling_char
717	av = 1
718	ENDIF
719	!
720	!-- Inquire, if there is a netCDF file from a previuos run. This should
721	!-- be opened for extension, if its dimensions and variables match the
722	!-- actual run.
723	INQUIRE( FILE=filename, EXIST=netcdf_extend )
724
725	IF ( netcdf_extend ) THEN
726	!
727	!-- Open an existing netCDF file for output
728	CALL open_write_netcdf_file( filename, id_set_yz(av), .TRUE., 26 )
729	!
730	!-- Read header information and set all ids. If there is a mismatch
731	!-- between the previuos and the actual run, netcdf_extend is returned
732	!-- as .FALSE.
733	CALL define_netcdf_header( 'yz', netcdf_extend, av )
734
735	!
736	!-- Remove the local file, if it can not be extended
737	IF ( .NOT. netcdf_extend ) THEN
738	nc_stat = NF90_CLOSE( id_set_yz(av) )
739	CALL handle_netcdf_error( 'check_open', 27 )
740	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
741	ENDIF
742
743	ENDIF
744
745	IF ( .NOT. netcdf_extend ) THEN
746	!
747	!-- Create a new netCDF output file with requested netCDF format
748	CALL create_netcdf_file( filename, id_set_yz(av), .TRUE., 28 )
749
750	!
751	!-- Define the header
752	CALL define_netcdf_header( 'yz', netcdf_extend, av )
753
754	!
755	!-- In case of parallel netCDF output, create flag file which tells
756	!-- combine_plot_fields that nothing is to do.
757	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
758	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
759	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
760	CLOSE( 99 )
761	ENDIF
762
763	ENDIF
764
765	CASE ( 104 )
766	!
767	!-- Set filename
768	filename = 'DATA_1D_PR_NETCDF' // coupling_char
769
770	!
771	!-- Inquire, if there is a netCDF file from a previuos run. This should
772	!-- be opened for extension, if its variables match the actual run.
773	INQUIRE( FILE=filename, EXIST=netcdf_extend )
774
775	IF ( netcdf_extend ) THEN
776	!
777	!-- Open an existing netCDF file for output
778	CALL open_write_netcdf_file( filename, id_set_pr, .FALSE., 29 )
779	!
780	!-- Read header information and set all ids. If there is a mismatch
781	!-- between the previuos and the actual run, netcdf_extend is returned
782	!-- as .FALSE.
783	CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
784
785	!
786	!-- Remove the local file, if it can not be extended
787	IF ( .NOT. netcdf_extend ) THEN
788	nc_stat = NF90_CLOSE( id_set_pr )
789	CALL handle_netcdf_error( 'check_open', 30 )
790	CALL local_system( 'rm ' // TRIM( filename ) )
791	ENDIF
792
793	ENDIF
794
795	IF ( .NOT. netcdf_extend ) THEN
796	!
797	!-- Create a new netCDF output file with requested netCDF format
798	CALL create_netcdf_file( filename, id_set_pr, .FALSE., 31 )
799	!
800	!-- Define the header
801	CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
802
803	ENDIF
804
805	CASE ( 105 )
806	!
807	!-- Set filename
808	filename = 'DATA_1D_TS_NETCDF' // coupling_char
809
810	!
811	!-- Inquire, if there is a netCDF file from a previuos run. This should
812	!-- be opened for extension, if its variables match the actual run.
813	INQUIRE( FILE=filename, EXIST=netcdf_extend )
814
815	IF ( netcdf_extend ) THEN
816	!
817	!-- Open an existing netCDF file for output
818	CALL open_write_netcdf_file( filename, id_set_ts, .FALSE., 32 )
819	!
820	!-- Read header information and set all ids. If there is a mismatch
821	!-- between the previuos and the actual run, netcdf_extend is returned
822	!-- as .FALSE.
823	CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
824
825	!
826	!-- Remove the local file, if it can not be extended
827	IF ( .NOT. netcdf_extend ) THEN
828	nc_stat = NF90_CLOSE( id_set_ts )
829	CALL handle_netcdf_error( 'check_open', 33 )
830	CALL local_system( 'rm ' // TRIM( filename ) )
831	ENDIF
832
833	ENDIF
834
835	IF ( .NOT. netcdf_extend ) THEN
836	!
837	!-- Create a new netCDF output file with requested netCDF format
838	CALL create_netcdf_file( filename, id_set_ts, .FALSE., 34 )
839	!
840	!-- Define the header
841	CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
842
843	ENDIF
844
845
846	CASE ( 106, 116 )
847	!
848	!-- Set filename depending on unit number
849	IF ( file_id == 106 ) THEN
850	filename = 'DATA_3D_NETCDF' // coupling_char
851	av = 0
852	ELSE
853	filename = 'DATA_3D_AV_NETCDF' // coupling_char
854	av = 1
855	ENDIF
856	!
857	!-- Inquire, if there is a netCDF file from a previous run. This should
858	!-- be opened for extension, if its dimensions and variables match the
859	!-- actual run.
860	INQUIRE( FILE=filename, EXIST=netcdf_extend )
861
862	IF ( netcdf_extend ) THEN
863	!
864	!-- Open an existing netCDF file for output
865	CALL open_write_netcdf_file( filename, id_set_3d(av), .TRUE., 35 )
866	!
867	!-- Read header information and set all ids. If there is a mismatch
868	!-- between the previuos and the actual run, netcdf_extend is returned
869	!-- as .FALSE.
870	CALL define_netcdf_header( '3d', netcdf_extend, av )
871
872	!
873	!-- Remove the local file, if it can not be extended
874	IF ( .NOT. netcdf_extend ) THEN
875	nc_stat = NF90_CLOSE( id_set_3d(av) )
876	CALL handle_netcdf_error( 'check_open', 36 )
877	CALL local_system('rm ' // TRIM( filename ) )
878	ENDIF
879
880	ENDIF
881
882	IF ( .NOT. netcdf_extend ) THEN
883	!
884	!-- Create a new netCDF output file with requested netCDF format
885	CALL create_netcdf_file( filename, id_set_3d(av), .TRUE., 37 )
886
887	!
888	!-- Define the header
889	CALL define_netcdf_header( '3d', netcdf_extend, av )
890
891	!
892	!-- In case of parallel netCDF output, create flag file which tells
893	!-- combine_plot_fields that nothing is to do.
894	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
895	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
896	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
897	CLOSE( 99 )
898	ENDIF
899
900	ENDIF
901
902
903	CASE ( 107 )
904	!
905	!-- Set filename
906	filename = 'DATA_1D_SP_NETCDF' // coupling_char
907
908	!
909	!-- Inquire, if there is a netCDF file from a previuos run. This should
910	!-- be opened for extension, if its variables match the actual run.
911	INQUIRE( FILE=filename, EXIST=netcdf_extend )
912
913	IF ( netcdf_extend ) THEN
914	!
915	!-- Open an existing netCDF file for output
916	CALL open_write_netcdf_file( filename, id_set_sp, .FALSE., 38 )
917
918	!
919	!-- Read header information and set all ids. If there is a mismatch
920	!-- between the previuos and the actual run, netcdf_extend is returned
921	!-- as .FALSE.
922	CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
923
924	!
925	!-- Remove the local file, if it can not be extended
926	IF ( .NOT. netcdf_extend ) THEN
927	nc_stat = NF90_CLOSE( id_set_sp )
928	CALL handle_netcdf_error( 'check_open', 39 )
929	CALL local_system( 'rm ' // TRIM( filename ) )
930	ENDIF
931
932	ENDIF
933
934	IF ( .NOT. netcdf_extend ) THEN
935	!
936	!-- Create a new netCDF output file with requested netCDF format
937	CALL create_netcdf_file( filename, id_set_sp, .FALSE., 40 )
938	!
939	!-- Define the header
940	CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
941
942	ENDIF
943
944
945	CASE ( 108 )
946
947	IF ( myid_char == '' ) THEN
948	filename = 'DATA_PRT_NETCDF' // coupling_char
949	ELSE
950	filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
951	myid_char
952	ENDIF
953	!
954	!-- Inquire, if there is a netCDF file from a previuos run. This should
955	!-- be opened for extension, if its variables match the actual run.
956	INQUIRE( FILE=filename, EXIST=netcdf_extend )
957
958	IF ( netcdf_extend ) THEN
959	!
960	!-- Open an existing netCDF file for output
961	CALL open_write_netcdf_file( filename, id_set_prt, .FALSE., 41 )
962	!
963	!-- Read header information and set all ids. If there is a mismatch
964	!-- between the previuos and the actual run, netcdf_extend is returned
965	!-- as .FALSE.
966	CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
967
968	!
969	!-- Remove the local file, if it can not be extended
970	IF ( .NOT. netcdf_extend ) THEN
971	nc_stat = NF90_CLOSE( id_set_prt )
972	CALL handle_netcdf_error( 'check_open', 42 )
973	CALL local_system( 'rm ' // filename )
974	ENDIF
975
976	ENDIF
977
978	IF ( .NOT. netcdf_extend ) THEN
979
980	!
981	!-- For runs on multiple processors create the subdirectory
982	IF ( myid_char /= '' ) THEN
983	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) &
984	THEN ! needs modification in case of non-extendable sets
985	CALL local_system( 'mkdir DATA_PRT_NETCDF' // &
986	TRIM( coupling_char ) // '/' )
987	ENDIF
988	#if defined( __parallel ) && ! defined ( __check )
989	!
990	!-- Set a barrier in order to allow that all other processors in the
991	!-- directory created by PE0 can open their file
992	CALL MPI_BARRIER( comm2d, ierr )
993	#endif
994	ENDIF
995
996	!
997	!-- Create a new netCDF output file with requested netCDF format
998	CALL create_netcdf_file( filename, id_set_prt, .FALSE., 43 )
999
1000	!
1001	!-- Define the header
1002	CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
1003
1004	ENDIF
1005
1006	CASE ( 109 )
1007	!
1008	!-- Set filename
1009	filename = 'DATA_1D_PTS_NETCDF' // coupling_char
1010
1011	!
1012	!-- Inquire, if there is a netCDF file from a previuos run. This should
1013	!-- be opened for extension, if its variables match the actual run.
1014	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1015
1016	IF ( netcdf_extend ) THEN
1017	!
1018	!-- Open an existing netCDF file for output
1019	CALL open_write_netcdf_file( filename, id_set_pts, .FALSE., 393 )
1020	!
1021	!-- Read header information and set all ids. If there is a mismatch
1022	!-- between the previuos and the actual run, netcdf_extend is returned
1023	!-- as .FALSE.
1024	CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
1025
1026	!
1027	!-- Remove the local file, if it can not be extended
1028	IF ( .NOT. netcdf_extend ) THEN
1029	nc_stat = NF90_CLOSE( id_set_pts )
1030	CALL handle_netcdf_error( 'check_open', 394 )
1031	CALL local_system( 'rm ' // TRIM( filename ) )
1032	ENDIF
1033
1034	ENDIF
1035
1036	IF ( .NOT. netcdf_extend ) THEN
1037	!
1038	!-- Create a new netCDF output file with requested netCDF format
1039	CALL create_netcdf_file( filename, id_set_pts, .FALSE., 395 )
1040	!
1041	!-- Define the header
1042	CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
1043
1044	ENDIF
1045
1046	CASE ( 201:200+2*max_masks )
1047	!
1048	!-- Set filename depending on unit number
1049	IF ( file_id <= 200+max_masks ) THEN
1050	mid = file_id - 200
1051	WRITE ( mask_char,'(I2.2)') mid
1052	filename = 'DATA_MASK_' // mask_char // '_NETCDF' // coupling_char
1053	av = 0
1054	ELSE
1055	mid = file_id - (200+max_masks)
1056	WRITE ( mask_char,'(I2.2)') mid
1057	filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // &
1058	coupling_char
1059	av = 1
1060	ENDIF
1061	!
1062	!-- Inquire, if there is a netCDF file from a previuos run. This should
1063	!-- be opened for extension, if its dimensions and variables match the
1064	!-- actual run.
1065	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1066
1067	IF ( netcdf_extend ) THEN
1068	!
1069	!-- Open an existing netCDF file for output
1070	CALL open_write_netcdf_file( filename, id_set_mask(mid,av), &
1071	.TRUE., 456 )
1072	!
1073	!-- Read header information and set all ids. If there is a mismatch
1074	!-- between the previuos and the actual run, netcdf_extend is returned
1075	!-- as .FALSE.
1076	CALL define_netcdf_header( 'ma', netcdf_extend, file_id )
1077
1078	!
1079	!-- Remove the local file, if it can not be extended
1080	IF ( .NOT. netcdf_extend ) THEN
1081	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
1082	CALL handle_netcdf_error( 'check_open', 457 )
1083	CALL local_system('rm ' // TRIM( filename ) )
1084	ENDIF
1085
1086	ENDIF
1087
1088	IF ( .NOT. netcdf_extend ) THEN
1089	!
1090	!-- Create a new netCDF output file with requested netCDF format
1091	CALL create_netcdf_file( filename, id_set_mask(mid,av), .TRUE., 458 )
1092	!
1093	!-- Define the header
1094	CALL define_netcdf_header( 'ma', netcdf_extend, file_id )
1095
1096	ENDIF
1097
1098
1099	#else
1100
1101	CASE ( 101:109, 111:113, 116, 201:200+2*max_masks )
1102
1103	!
1104	!-- Nothing is done in case of missing netcdf support
1105	RETURN
1106
1107	#endif
1108
1109	CASE DEFAULT
1110
1111	WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
1112	CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
1113
1114	END SELECT
1115
1116	!
1117	!-- Set open flag
1118	openfile(file_id)%opened = .TRUE.
1119
1120	!
1121	!-- Formats
1122	3300 FORMAT ('#'/ &
1123	'coord 1 file=',A,' filetype=unformatted'/ &
1124	'coord 2 file=',A,' filetype=unformatted skip=',I6/ &
1125	'coord 3 file=',A,' filetype=unformatted skip=',I6/ &
1126	'#')
1127	4000 FORMAT ('# ',A)
1128	5000 FORMAT ('# ',A/ &
1129	'#1 E'/'#2 E'/'#3 dt'/'#4 u'/'#5 th*'/'#6 umax'/'#7 vmax'/ &
1130	'#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
1131	'#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/ &
1132	'#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
1133	8000 FORMAT (A/ &
1134	' step time # of parts lPE sent/recv rPE sent/recv ', &
1135	'sPE sent/recv nPE sent/recv max # of parts'/ &
1136	103('-'))
1137
1138	END SUBROUTINE check_open

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: palm/trunk/SOURCE/check_open.f90 @ 1327

Download in other formats: