Home

Context Navigation

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

Last change on this file since 3967 was 3967, checked in by gronemeier, 5 years ago
Save binary data of virtual measurements within separate folder
Property svn:keywords set to `Id`
File size: 49.0 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |