Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |