Home

Context Navigation

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

Last change on this file since 4755 was 4652, checked in by raasch, 4 years ago
routine posix_calls_from_fortran merged into posix_interface_mod
Property svn:keywords set to `Id`
File size: 44.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |