Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |