Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |