Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |