Home

Context Navigation

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

Last change on this file since 2675 was 2669, checked in by raasch, 7 years ago
file attributes and activation strings in .palm.iofiles revised, file extensions for nesting, masked output, wind turbine data, etc. changed
Property svn:keywords set to `Id`
File size: 40.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |