Home

Context Navigation

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

Last change on this file since 1982 was 1975, checked in by gronemeier, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 44.8 KB

Rev	Line
[1682]	1	!> @file check_open.f90
[1036]	2	!--------------------------------------------------------------------------------!
	3	! This file is part of PALM.
	4	!
	5	! PALM is free software: you can redistribute it and/or modify it under the terms
	6	! of the GNU General Public License as published by the Free Software Foundation,
	7	! either version 3 of the License, or (at your option) any later version.
	8	!
	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	10	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	11	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	12	!
[1804]	13	! You should have received a copy of the GNU fGeneral Public License along with
[1036]	14	! PALM. If not, see <http://www.gnu.org/licenses/>.
	15	!
[1818]	16	! Copyright 1997-2016 Leibniz Universitaet Hannover
[1036]	17	!--------------------------------------------------------------------------------!
	18	!
[247]	19	! Current revisions:
[1]	20	! -----------------
[1805]	21	!
[1975]	22	!
[1321]	23	! Former revisions:
	24	! -----------------
	25	! $Id: check_open.f90 1975 2016-07-26 08:50:30Z suehring $
	26	!
[1975]	27	! 1974 2016-07-26 08:43:25Z gronemeier
	28	! Bugfix: MPI barriers after deleting non-extendable files must only be called
	29	! in case of parallel I/O
	30	!
[1958]	31	! 1957 2016-07-07 10:43:48Z suehring
	32	! flight module added
	33	!
[1805]	34	! 1804 2016-04-05 16:30:18Z maronga
	35	! Removed code for parameter file check (__check)
	36	!
[1784]	37	! 1783 2016-03-06 18:36:17Z raasch
	38	! name change of netcdf routines and module + related changes
	39	!
[1780]	40	! 1779 2016-03-03 08:01:28Z raasch
	41	! coupling_char is trimmed at every place it occurs, because it can have
	42	! different length now
	43	!
[1746]	44	! 1745 2016-02-05 13:06:51Z gronemeier
	45	! Bugfix: added MPI barrier after deleting existing non-extendable file by PE0
	46	!
[1683]	47	! 1682 2015-10-07 23:56:08Z knoop
	48	! Code annotations made doxygen readable
	49	!
[1552]	50	! 1551 2015-03-03 14:18:16Z maronga
	51	! Removed redundant output for combine_plot_fields
	52	!
[1469]	53	! 1468 2014-09-24 14:06:57Z maronga
	54	! Adapted for use on up to 6-digit processor cores
	55	! Added file unit 117 (PROGRESS)
	56	!
[1360]	57	! 1359 2014-04-11 17:15:14Z hoffmann
	58	! Format of particle exchange statistics extended to reasonable numbers of
	59	! particles.
	60	!
[1354]	61	! 1353 2014-04-08 15:21:23Z heinze
	62	! REAL constants provided with KIND-attribute,
	63	! declaration for unused variables xkoor, ykoor, zkoor removed
	64	!
[1329]	65	! 1327 2014-03-21 11:00:16Z raasch
	66	! parts concerning iso2d and avs output removed
	67	!
[1321]	68	! 1320 2014-03-20 08:40:49Z raasch
[1320]	69	! ONLY-attribute added to USE-statements,
	70	! kind-parameters added to all INTEGER and REAL declaration statements,
	71	! kinds are defined in new module kinds,
	72	! old module precision_kind is removed,
	73	! revision history before 2012 removed,
	74	! comment fields (!:) to be used for variable explanations added to
	75	! all variable declaration statements
[1]	76	!
[1107]	77	! 1106 2013-03-04 05:31:38Z raasch
	78	! array_kind renamed precision_kind
	79	!
[1093]	80	! 1092 2013-02-02 11:24:22Z raasch
	81	! unused variables removed
	82	!
[1037]	83	! 1036 2012-10-22 13:43:42Z raasch
	84	! code put under GPL (PALM 3.9)
	85	!
[1035]	86	! 1031 2012-10-19 14:35:30Z raasch
	87	! netCDF4 without parallel file support implemented,
	88	! opening of netCDF files are done by new routines create_netcdf_file and
	89	! open_write_netcdf_file
	90	!
[965]	91	! 964 2012-07-26 09:14:24Z raasch
	92	! old profil-units (40:49) removed,
	93	! append feature removed from unit 14
	94	!
[850]	95	! 849 2012-03-15 10:35:09Z raasch
	96	! comment changed
	97	!
[810]	98	! 809 2012-01-30 13:32:58Z maronga
	99	! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives
	100	!
[808]	101	! 807 2012-01-25 11:53:51Z maronga
	102	! New cpp directive "__check" implemented which is used by check_namelist_files
	103	!
[1]	104	! Revision 1.1 1997/08/11 06:10:55 raasch
	105	! Initial revision
	106	!
	107	!
	108	! Description:
	109	! ------------
[1682]	110	!> Check if file unit is open. If not, open file and, if necessary, write a
	111	!> header or start other initializing actions, respectively.
[1]	112	!------------------------------------------------------------------------------!
[1682]	113	SUBROUTINE check_open( file_id )
	114
[1]	115
[1320]	116	USE arrays_3d, &
	117	ONLY: zu
	118
	119	USE control_parameters, &
[1327]	120	ONLY: avs_data_file, coupling_char, data_output_2d_on_each_pe, host, &
[1783]	121	max_masks, message_string, mid, nz_do3d, openfile, &
[1320]	122	return_addres, return_username, run_description_header, runnr
	123
	124	USE grid_variables, &
	125	ONLY: dx, dy
	126
	127	USE indices, &
[1551]	128	ONLY: nbgp, nx, nxl, nxr, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
[1320]	129
	130	USE kinds
	131
[1783]	132	#if defined( __netcdf )
	133	USE NETCDF
	134	#endif
[1320]	135
[1783]	136	USE netcdf_interface, &
[1957]	137	ONLY: id_set_fl, id_set_mask, id_set_pr, id_set_prt, id_set_pts, &
	138	id_set_sp, id_set_ts, id_set_xy, id_set_xz, id_set_yz, &
	139	id_set_3d, nc_stat, netcdf_create_file, netcdf_data_format, &
	140	netcdf_define_header, netcdf_handle_error, netcdf_open_write_file
[1783]	141
[1320]	142	USE particle_attributes, &
	143	ONLY: max_number_of_particle_groups, number_of_particle_groups, &
	144	particle_groups
	145
[1]	146	USE pegrid
	147
[1320]	148	USE profil_parameter, &
	149	ONLY: cross_ts_numbers, cross_ts_number_count
	150
	151	USE statistics, &
	152	ONLY: region, statistic_regions
	153
	154
[1]	155	IMPLICIT NONE
	156
[1682]	157	CHARACTER (LEN=2) :: mask_char !<
	158	CHARACTER (LEN=2) :: suffix !<
	159	CHARACTER (LEN=20) :: xtext = 'time in s' !<
	160	CHARACTER (LEN=30) :: filename !<
	161	CHARACTER (LEN=40) :: avs_coor_file !<
	162	CHARACTER (LEN=40) :: avs_coor_file_localname !<
	163	CHARACTER (LEN=40) :: avs_data_file_localname !<
	164	CHARACTER (LEN=80) :: rtext !<
	165	CHARACTER (LEN=100) :: avs_coor_file_catalog !<
	166	CHARACTER (LEN=100) :: avs_data_file_catalog !<
	167	CHARACTER (LEN=100) :: batch_scp !<
	168	CHARACTER (LEN=100) :: line !<
	169	CHARACTER (LEN=400) :: command !<
[1]	170
[1682]	171	INTEGER(iwp) :: av !<
	172	INTEGER(iwp) :: numline = 1 !<
	173	INTEGER(iwp) :: cranz !<
	174	INTEGER(iwp) :: file_id !<
	175	INTEGER(iwp) :: i !<
	176	INTEGER(iwp) :: iaddres !<
	177	INTEGER(iwp) :: iusern !<
	178	INTEGER(iwp) :: j !<
	179	INTEGER(iwp) :: k !<
	180	INTEGER(iwp) :: legpos = 1 !<
	181	INTEGER(iwp) :: timodex = 1 !<
[1320]	182
[1682]	183	INTEGER(iwp), DIMENSION(10) :: klist !<
[1]	184
[1682]	185	LOGICAL :: avs_coor_file_found = .FALSE. !<
	186	LOGICAL :: avs_data_file_found = .FALSE. !<
	187	LOGICAL :: datleg = .TRUE. !<
	188	LOGICAL :: get_filenames !<
	189	LOGICAL :: grid = .TRUE. !<
	190	LOGICAL :: netcdf_extend !<
	191	LOGICAL :: rand = .TRUE. !<
	192	LOGICAL :: swap = .TRUE. !<
	193	LOGICAL :: twoxa = .TRUE. !<
	194	LOGICAL :: twoya = .TRUE. !<
[1]	195
[1682]	196	REAL(wp) :: ansx = -999.999_wp !<
	197	REAL(wp) :: ansy = -999.999_wp !<
	198	REAL(wp) :: gwid = 0.1_wp !<
	199	REAL(wp) :: rlegfak = 1.5_wp !<
	200	REAL(wp) :: sizex = 250.0_wp !<
	201	REAL(wp) :: sizey = 40.0_wp !<
	202	REAL(wp) :: texfac = 1.5_wp !<
[1]	203
[1682]	204	REAL(wp), DIMENSION(:), ALLOCATABLE :: eta !<
	205	REAL(wp), DIMENSION(:), ALLOCATABLE :: ho !<
	206	REAL(wp), DIMENSION(:), ALLOCATABLE :: hu !<
[1353]	207
[1]	208
	209
[1320]	210	NAMELIST /RAHMEN/ numline, cranz, datleg, rtext, swap
	211	NAMELIST /CROSS/ ansx, ansy, grid, gwid, klist, legpos, &
	212	rand, rlegfak, sizex, sizey, texfac, &
[1]	213	timodex, twoxa, twoya, xtext
	214
	215
	216	!
	217	!-- Immediate return if file already open
	218	IF ( openfile(file_id)%opened ) RETURN
	219
	220	!
	221	!-- Only certain files are allowed to be re-opened
	222	!-- NOTE: some of the other files perhaps also could be re-opened, but it
	223	!-- has not been checked so far, if it works!
	224	IF ( openfile(file_id)%opened_before ) THEN
	225	SELECT CASE ( file_id )
[1468]	226	CASE ( 13, 14, 21, 22, 23, 80:85, 117 )
[1]	227	IF ( file_id == 14 .AND. openfile(file_id)%opened_before ) THEN
[1320]	228	message_string = 're-open of unit ' // &
[274]	229	'14 is not verified. Please check results!'
[247]	230	CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )
[1]	231	ENDIF
[143]	232
[1]	233	CASE DEFAULT
[1320]	234	WRITE( message_string, * ) 're-opening of file-id ', file_id, &
[274]	235	' is not allowed'
[247]	236	CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )
	237
[1]	238	RETURN
[143]	239
[1]	240	END SELECT
	241	ENDIF
	242
	243	!
	244	!-- Check if file may be opened on the relevant PE
	245	SELECT CASE ( file_id )
	246
[1468]	247	CASE ( 15, 16, 17, 18, 19, 50:59, 81:84, 104:105, 107, 109, 117 )
[410]	248
[493]	249	IF ( myid /= 0 ) THEN
[1320]	250	WRITE( message_string, * ) 'opening file-id ',file_id, &
[493]	251	' not allowed for PE ',myid
	252	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
	253	ENDIF
	254
[564]	255	CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks )
[493]	256
[1031]	257	IF ( netcdf_data_format < 5 ) THEN
[247]	258
[410]	259	IF ( myid /= 0 ) THEN
[1320]	260	WRITE( message_string, * ) 'opening file-id ',file_id, &
[410]	261	' not allowed for PE ',myid
	262	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
	263	ENDIF
	264
[493]	265	ENDIF
[1]	266
	267	CASE ( 21, 22, 23 )
	268
	269	IF ( .NOT. data_output_2d_on_each_pe ) THEN
	270	IF ( myid /= 0 ) THEN
[1320]	271	WRITE( message_string, * ) 'opening file-id ',file_id, &
[247]	272	' not allowed for PE ',myid
[277]	273	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
[247]	274	END IF
[1]	275	ENDIF
	276
[1327]	277	CASE ( 27, 28, 29, 31, 33, 71:73, 90:99 )
[1]	278
	279	!
	280	!-- File-ids that are used temporarily in other routines
[1320]	281	WRITE( message_string, * ) 'opening file-id ',file_id, &
[274]	282	' is not allowed since it is used otherwise'
[247]	283	CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
	284
[1]	285	END SELECT
	286
	287	!
	288	!-- Open relevant files
	289	SELECT CASE ( file_id )
	290
	291	CASE ( 11 )
	292
[1779]	293	OPEN ( 11, FILE='PARIN'//TRIM( coupling_char ), FORM='FORMATTED', &
[102]	294	STATUS='OLD' )
[1]	295
	296	CASE ( 13 )
	297
	298	IF ( myid_char == '' ) THEN
[1779]	299	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//myid_char, &
[102]	300	FORM='UNFORMATTED', STATUS='OLD' )
[1]	301	ELSE
[143]	302	!
[1468]	303	!-- First opening of unit 13 openes file _000000 on all PEs because
	304	!-- only this file contains the global variables
[143]	305	IF ( .NOT. openfile(file_id)%opened_before ) THEN
[1779]	306	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_000000', &
[143]	307	FORM='UNFORMATTED', STATUS='OLD' )
	308	ELSE
[1779]	309	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'// &
	310	myid_char, FORM='UNFORMATTED', STATUS='OLD' )
[143]	311	ENDIF
[1]	312	ENDIF
	313
	314	CASE ( 14 )
	315
	316	IF ( myid_char == '' ) THEN
[1779]	317	OPEN ( 14, FILE='BINOUT'//TRIM( coupling_char )//myid_char, &
[102]	318	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	319	ELSE
	320	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
[1779]	321	CALL local_system( 'mkdir BINOUT' // TRIM( coupling_char ) )
[1]	322	ENDIF
[1804]	323	#if defined( __parallel )
[1]	324	!
	325	!-- Set a barrier in order to allow that all other processors in the
	326	!-- directory created by PE0 can open their file
	327	CALL MPI_BARRIER( comm2d, ierr )
	328	#endif
[1320]	329	OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
[887]	330	FORM='UNFORMATTED' )
[1]	331	ENDIF
	332
	333	CASE ( 15 )
	334
[1779]	335	OPEN ( 15, FILE='RUN_CONTROL'//TRIM( coupling_char ), &
	336	FORM='FORMATTED' )
[1]	337
	338	CASE ( 16 )
	339
[1779]	340	OPEN ( 16, FILE='LIST_PROFIL'//TRIM( coupling_char ), &
	341	FORM='FORMATTED' )
[1]	342
	343	CASE ( 17 )
	344
[1779]	345	OPEN ( 17, FILE='LIST_PROFIL_1D'//TRIM( coupling_char ), &
	346	FORM='FORMATTED' )
[1]	347
	348	CASE ( 18 )
	349
[1779]	350	OPEN ( 18, FILE='CPU_MEASURES'//TRIM( coupling_char ), &
	351	FORM='FORMATTED' )
[1]	352
	353	CASE ( 19 )
	354
[1779]	355	OPEN ( 19, FILE='HEADER'//TRIM( coupling_char ), FORM='FORMATTED' )
[1]	356
	357	CASE ( 20 )
	358
	359	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
[1779]	360	CALL local_system( 'mkdir DATA_LOG' // TRIM( coupling_char ) )
[1]	361	ENDIF
	362	IF ( myid_char == '' ) THEN
[1779]	363	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_000000', &
[102]	364	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	365	ELSE
[1804]	366	#if defined( __parallel )
[1]	367	!
	368	!-- Set a barrier in order to allow that all other processors in the
	369	!-- directory created by PE0 can open their file
	370	CALL MPI_BARRIER( comm2d, ierr )
	371	#endif
[1779]	372	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'// &
	373	myid_char, FORM='UNFORMATTED', POSITION='APPEND' )
[1]	374	ENDIF
	375
	376	CASE ( 21 )
	377
	378	IF ( data_output_2d_on_each_pe ) THEN
[1320]	379	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
[102]	380	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	381	ELSE
[1779]	382	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char ), &
[102]	383	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	384	ENDIF
	385
	386	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
	387	!
	388	!-- Output for combine_plot_fields
	389	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
[667]	390	WRITE (21) -nbgp, nx+nbgp, -nbgp, ny+nbgp ! total array size
[1]	391	WRITE (21) 0, nx+1, 0, ny+1 ! output part
	392	ENDIF
	393	!
	394	!-- Determine and write ISO2D coordiante header
	395	ALLOCATE( eta(0:ny+1), ho(0:nx+1), hu(0:nx+1) )
[1353]	396	hu = 0.0_wp
[1]	397	ho = (ny+1) * dy
	398	DO i = 1, ny
[1353]	399	eta(i) = REAL( i ) / ( ny + 1.0_wp )
[1]	400	ENDDO
[1353]	401	eta(0) = 0.0_wp
	402	eta(ny+1) = 1.0_wp
[1]	403
	404	WRITE (21) dx,eta,hu,ho
	405	DEALLOCATE( eta, ho, hu )
	406
	407	ENDIF
	408
	409	CASE ( 22 )
	410
	411	IF ( data_output_2d_on_each_pe ) THEN
[1320]	412	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
[102]	413	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	414	ELSE
[1779]	415	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char ), &
	416	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	417	ENDIF
	418
	419	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
	420	!
	421	!-- Output for combine_plot_fields
	422	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
[667]	423	WRITE (22) -nbgp, nx+nbgp, 0, nz+1 ! total array size
[1]	424	WRITE (22) 0, nx+1, 0, nz+1 ! output part
	425	ENDIF
	426	!
[1327]	427	!-- Determine and write ISO2D coordinate header
[1]	428	ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) )
[1353]	429	hu = 0.0_wp
[1]	430	ho = zu(nz+1)
	431	DO i = 1, nz
	432	eta(i) = REAL( zu(i) ) / zu(nz+1)
	433	ENDDO
[1353]	434	eta(0) = 0.0_wp
	435	eta(nz+1) = 1.0_wp
[1]	436
	437	WRITE (22) dx,eta,hu,ho
	438	DEALLOCATE( eta, ho, hu )
	439
	440	ENDIF
	441
	442	CASE ( 23 )
	443
	444	IF ( data_output_2d_on_each_pe ) THEN
[1320]	445	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
[102]	446	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	447	ELSE
[1779]	448	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char ), &
	449	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	450	ENDIF
	451
	452	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
	453	!
	454	!-- Output for combine_plot_fields
	455	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
[667]	456	WRITE (23) -nbgp, ny+nbgp, 0, nz+1 ! total array size
[1]	457	WRITE (23) 0, ny+1, 0, nz+1 ! output part
	458	ENDIF
	459	!
	460	!-- Determine and write ISO2D coordiante header
	461	ALLOCATE( eta(0:nz+1), ho(0:ny+1), hu(0:ny+1) )
[1353]	462	hu = 0.0_wp
[1]	463	ho = zu(nz+1)
	464	DO i = 1, nz
	465	eta(i) = REAL( zu(i) ) / zu(nz+1)
	466	ENDDO
[1353]	467	eta(0) = 0.0_wp
	468	eta(nz+1) = 1.0_wp
[1]	469
	470	WRITE (23) dx,eta,hu,ho
	471	DEALLOCATE( eta, ho, hu )
	472
	473	ENDIF
	474
	475	CASE ( 30 )
	476
[1320]	477	OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
[102]	478	FORM='UNFORMATTED' )
[1]	479	!
	480	!-- Write coordinate file for AVS
	481	IF ( myid == 0 ) THEN
	482	#if defined( __parallel )
	483	!
	484	!-- Specifications for combine_plot_fields
[1551]	485	WRITE ( 30 ) -nbgp,nx+nbgp,-nbgp,ny+nbgp
[1327]	486	WRITE ( 30 ) 0,nx+1,0,ny+1,0,nz_do3d
[1]	487	#endif
	488	ENDIF
	489
	490	CASE ( 50:59 )
	491
	492	IF ( statistic_regions == 0 .AND. file_id == 50 ) THEN
	493	suffix = ''
	494	ELSE
	495	WRITE ( suffix, '(''_'',I1)' ) file_id - 50
	496	ENDIF
[1320]	497	OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// &
	498	TRIM( suffix ), &
[102]	499	FORM='FORMATTED', RECL=496 )
[1]	500	!
	501	!-- Write PROFIL parameter file for output of time series
	502	!-- NOTE: To be on the safe side, this output is done at the beginning of
	503	!-- the model run (in case of collapse) and it is repeated in
	504	!-- close_file, then, however, with value ranges for the coordinate
	505	!-- systems
	506	!
	507	!-- Firstly determine the number of the coordinate systems to be drawn
	508	cranz = 0
	509	DO j = 1, 10
	510	IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1
	511	ENDDO
[1320]	512	rtext = '\1.0 ' // TRIM( run_description_header ) // ' ' // &
[1]	513	TRIM( region( file_id - 50 ) )
	514	!
	515	!-- Write RAHMEN parameter
[1320]	516	OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// &
	517	TRIM( suffix ), &
[102]	518	FORM='FORMATTED', DELIM='APOSTROPHE' )
[1]	519	WRITE ( 90, RAHMEN )
	520	!
	521	!-- Determine and write CROSS parameters for the individual coordinate
	522	!-- systems
	523	DO j = 1, 10
	524	k = cross_ts_number_count(j)
	525	IF ( k /= 0 ) THEN
	526	!
	527	!-- Store curve numbers, colours and line style
	528	klist(1:k) = cross_ts_numbers(1:k,j)
	529	klist(k+1:10) = 999999
	530	!
	531	!-- Write CROSS parameter
	532	WRITE ( 90, CROSS )
	533
	534	ENDIF
	535	ENDDO
	536
	537	CLOSE ( 90 )
	538	!
	539	!-- Write all labels at the top of the data file, but only during the
	540	!-- first run of a sequence of jobs. The following jobs copy the time
	541	!-- series data to the bottom of that file.
	542	IF ( runnr == 0 ) THEN
[1320]	543	WRITE ( file_id, 5000 ) TRIM( run_description_header ) // &
[1]	544	' ' // TRIM( region( file_id - 50 ) )
	545	ENDIF
	546
	547
	548	CASE ( 80 )
	549
	550	IF ( myid_char == '' ) THEN
[105]	551	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
[102]	552	FORM='FORMATTED', POSITION='APPEND' )
[1]	553	ELSE
	554	IF ( myid == 0 .AND. .NOT. openfile(80)%opened_before ) THEN
[1779]	555	CALL local_system( 'mkdir PARTICLE_INFOS' // &
	556	TRIM( coupling_char ) )
[1]	557	ENDIF
[1804]	558	#if defined( __parallel )
[1]	559	!
	560	!-- Set a barrier in order to allow that thereafter all other
	561	!-- processors in the directory created by PE0 can open their file.
	562	!-- WARNING: The following barrier will lead to hanging jobs, if
	563	!-- check_open is first called from routine
	564	!-- allocate_prt_memory!
	565	IF ( .NOT. openfile(80)%opened_before ) THEN
	566	CALL MPI_BARRIER( comm2d, ierr )
	567	ENDIF
	568	#endif
[1320]	569	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
	570	myid_char, &
[102]	571	FORM='FORMATTED', POSITION='APPEND' )
[1]	572	ENDIF
	573
	574	IF ( .NOT. openfile(80)%opened_before ) THEN
	575	WRITE ( 80, 8000 ) TRIM( run_description_header )
	576	ENDIF
	577
	578	CASE ( 81 )
	579
[1779]	580	OPEN ( 81, FILE='PLOTSP_X_PAR'//TRIM( coupling_char ), &
	581	FORM='FORMATTED', DELIM='APOSTROPHE', RECL=1500, &
	582	POSITION='APPEND' )
[1]	583
	584	CASE ( 82 )
	585
[1779]	586	OPEN ( 82, FILE='PLOTSP_X_DATA'//TRIM( coupling_char ), &
	587	FORM='FORMATTED', POSITION = 'APPEND' )
[1]	588
	589	CASE ( 83 )
	590
[1779]	591	OPEN ( 83, FILE='PLOTSP_Y_PAR'//TRIM( coupling_char ), &
	592	FORM='FORMATTED', DELIM='APOSTROPHE', RECL=1500, &
	593	POSITION='APPEND' )
[1]	594
	595	CASE ( 84 )
	596
[1779]	597	OPEN ( 84, FILE='PLOTSP_Y_DATA'//TRIM( coupling_char ), &
	598	FORM='FORMATTED', POSITION='APPEND' )
[1]	599
	600	CASE ( 85 )
	601
	602	IF ( myid_char == '' ) THEN
[1320]	603	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
[102]	604	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	605	ELSE
	606	IF ( myid == 0 .AND. .NOT. openfile(85)%opened_before ) THEN
[1779]	607	CALL local_system( 'mkdir PARTICLE_DATA' // &
	608	TRIM( coupling_char ) )
[1]	609	ENDIF
[1804]	610	#if defined( __parallel )
[1]	611	!
	612	!-- Set a barrier in order to allow that thereafter all other
	613	!-- processors in the directory created by PE0 can open their file
	614	CALL MPI_BARRIER( comm2d, ierr )
	615	#endif
[1320]	616	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
	617	myid_char, &
[102]	618	FORM='UNFORMATTED', POSITION='APPEND' )
[1]	619	ENDIF
	620
	621	IF ( .NOT. openfile(85)%opened_before ) THEN
	622	WRITE ( 85 ) run_description_header
	623	!
	624	!-- Attention: change version number whenever the output format on
[849]	625	!-- unit 85 is changed (see also in routine
	626	!-- lpm_data_output_particles)
[1359]	627	rtext = 'data format version 3.1'
[1]	628	WRITE ( 85 ) rtext
[1320]	629	WRITE ( 85 ) number_of_particle_groups, &
[1]	630	max_number_of_particle_groups
	631	WRITE ( 85 ) particle_groups
[1359]	632	WRITE ( 85 ) nxl, nxr, nys, nyn, nzb, nzt, nbgp
[1]	633	ENDIF
	634
	635	#if defined( __netcdf )
	636	CASE ( 101, 111 )
	637	!
	638	!-- Set filename depending on unit number
	639	IF ( file_id == 101 ) THEN
[1779]	640	filename = 'DATA_2D_XY_NETCDF' // TRIM( coupling_char )
[1]	641	av = 0
	642	ELSE
[1779]	643	filename = 'DATA_2D_XY_AV_NETCDF' // TRIM( coupling_char )
[1]	644	av = 1
	645	ENDIF
	646	!
[1031]	647	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	648	!-- be opened for extension, if its dimensions and variables match the
	649	!-- actual run.
	650	INQUIRE( FILE=filename, EXIST=netcdf_extend )
	651	IF ( netcdf_extend ) THEN
	652	!
[1031]	653	!-- Open an existing netCDF file for output
[1783]	654	CALL netcdf_open_write_file( filename, id_set_xy(av), .TRUE., 20 )
[1]	655	!
	656	!-- Read header information and set all ids. If there is a mismatch
	657	!-- between the previuos and the actual run, netcdf_extend is returned
	658	!-- as .FALSE.
[1783]	659	CALL netcdf_define_header( 'xy', netcdf_extend, av )
[1]	660
	661	!
	662	!-- Remove the local file, if it can not be extended
	663	IF ( .NOT. netcdf_extend ) THEN
	664	nc_stat = NF90_CLOSE( id_set_xy(av) )
[1783]	665	CALL netcdf_handle_error( 'check_open', 21 )
[493]	666	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
[1804]	667	#if defined( __parallel )
[1745]	668	!
	669	!-- Set a barrier in order to assure that PE0 deleted the old file
[1974]	670	!-- before any other processor tries to open a new file.
	671	!-- Barrier is only needed in case of parallel I/O
	672	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
[1745]	673	#endif
[1]	674	ENDIF
	675
[1745]	676	ENDIF
[1]	677
	678	IF ( .NOT. netcdf_extend ) THEN
	679	!
[1031]	680	!-- Create a new netCDF output file with requested netCDF format
[1783]	681	CALL netcdf_create_file( filename, id_set_xy(av), .TRUE., 22 )
[493]	682
	683	!
[1]	684	!-- Define the header
[1783]	685	CALL netcdf_define_header( 'xy', netcdf_extend, av )
[1]	686
[493]	687	!
[1031]	688	!-- In case of parallel netCDF output, create flag file which tells
[493]	689	!-- combine_plot_fields that nothing is to do.
[1031]	690	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
[493]	691	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
	692	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
	693	CLOSE( 99 )
	694	ENDIF
	695
[1]	696	ENDIF
	697
	698	CASE ( 102, 112 )
	699	!
	700	!-- Set filename depending on unit number
	701	IF ( file_id == 102 ) THEN
[1779]	702	filename = 'DATA_2D_XZ_NETCDF' // TRIM( coupling_char )
[1]	703	av = 0
	704	ELSE
[1779]	705	filename = 'DATA_2D_XZ_AV_NETCDF' // TRIM( coupling_char )
[1]	706	av = 1
	707	ENDIF
	708	!
[1031]	709	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	710	!-- be opened for extension, if its dimensions and variables match the
	711	!-- actual run.
	712	INQUIRE( FILE=filename, EXIST=netcdf_extend )
	713
	714	IF ( netcdf_extend ) THEN
	715	!
[1031]	716	!-- Open an existing netCDF file for output
[1783]	717	CALL netcdf_open_write_file( filename, id_set_xz(av), .TRUE., 23 )
[1]	718	!
	719	!-- Read header information and set all ids. If there is a mismatch
	720	!-- between the previuos and the actual run, netcdf_extend is returned
	721	!-- as .FALSE.
[1783]	722	CALL netcdf_define_header( 'xz', netcdf_extend, av )
[1]	723
	724	!
	725	!-- Remove the local file, if it can not be extended
	726	IF ( .NOT. netcdf_extend ) THEN
	727	nc_stat = NF90_CLOSE( id_set_xz(av) )
[1783]	728	CALL netcdf_handle_error( 'check_open', 24 )
[493]	729	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
[1804]	730	#if defined( __parallel )
[1745]	731	!
	732	!-- Set a barrier in order to assure that PE0 deleted the old file
	733	!-- before any other processor tries to open a new file
[1974]	734	!-- Barrier is only needed in case of parallel I/O
	735	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
[1745]	736	#endif
[1]	737	ENDIF
	738
[1745]	739	ENDIF
[1]	740
	741	IF ( .NOT. netcdf_extend ) THEN
	742	!
[1031]	743	!-- Create a new netCDF output file with requested netCDF format
[1783]	744	CALL netcdf_create_file( filename, id_set_xz(av), .TRUE., 25 )
[493]	745
	746	!
[1]	747	!-- Define the header
[1783]	748	CALL netcdf_define_header( 'xz', netcdf_extend, av )
[1]	749
[493]	750	!
[1031]	751	!-- In case of parallel netCDF output, create flag file which tells
[493]	752	!-- combine_plot_fields that nothing is to do.
[1031]	753	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
[493]	754	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
	755	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
	756	CLOSE( 99 )
	757	ENDIF
	758
[1]	759	ENDIF
	760
	761	CASE ( 103, 113 )
	762	!
	763	!-- Set filename depending on unit number
	764	IF ( file_id == 103 ) THEN
[1779]	765	filename = 'DATA_2D_YZ_NETCDF' // TRIM( coupling_char )
[1]	766	av = 0
	767	ELSE
[1779]	768	filename = 'DATA_2D_YZ_AV_NETCDF' // TRIM( coupling_char )
[1]	769	av = 1
	770	ENDIF
	771	!
[1031]	772	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	773	!-- be opened for extension, if its dimensions and variables match the
	774	!-- actual run.
	775	INQUIRE( FILE=filename, EXIST=netcdf_extend )
	776
	777	IF ( netcdf_extend ) THEN
	778	!
[1031]	779	!-- Open an existing netCDF file for output
[1783]	780	CALL netcdf_open_write_file( filename, id_set_yz(av), .TRUE., 26 )
[1]	781	!
	782	!-- Read header information and set all ids. If there is a mismatch
	783	!-- between the previuos and the actual run, netcdf_extend is returned
	784	!-- as .FALSE.
[1783]	785	CALL netcdf_define_header( 'yz', netcdf_extend, av )
[1]	786
	787	!
	788	!-- Remove the local file, if it can not be extended
	789	IF ( .NOT. netcdf_extend ) THEN
	790	nc_stat = NF90_CLOSE( id_set_yz(av) )
[1783]	791	CALL netcdf_handle_error( 'check_open', 27 )
[493]	792	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
[1804]	793	#if defined( __parallel )
[1745]	794	!
	795	!-- Set a barrier in order to assure that PE0 deleted the old file
	796	!-- before any other processor tries to open a new file
[1974]	797	!-- Barrier is only needed in case of parallel I/O
	798	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
[1745]	799	#endif
[1]	800	ENDIF
	801
[1745]	802	ENDIF
[1]	803
	804	IF ( .NOT. netcdf_extend ) THEN
	805	!
[1031]	806	!-- Create a new netCDF output file with requested netCDF format
[1783]	807	CALL netcdf_create_file( filename, id_set_yz(av), .TRUE., 28 )
[493]	808
	809	!
[1]	810	!-- Define the header
[1783]	811	CALL netcdf_define_header( 'yz', netcdf_extend, av )
[1]	812
[493]	813	!
[1031]	814	!-- In case of parallel netCDF output, create flag file which tells
[493]	815	!-- combine_plot_fields that nothing is to do.
[1031]	816	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
[493]	817	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
	818	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
	819	CLOSE( 99 )
	820	ENDIF
	821
[1]	822	ENDIF
	823
	824	CASE ( 104 )
	825	!
[102]	826	!-- Set filename
[1779]	827	filename = 'DATA_1D_PR_NETCDF' // TRIM( coupling_char )
[102]	828
	829	!
[1031]	830	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	831	!-- be opened for extension, if its variables match the actual run.
[102]	832	INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]	833
	834	IF ( netcdf_extend ) THEN
	835	!
[1031]	836	!-- Open an existing netCDF file for output
[1783]	837	CALL netcdf_open_write_file( filename, id_set_pr, .FALSE., 29 )
[1]	838	!
	839	!-- Read header information and set all ids. If there is a mismatch
	840	!-- between the previuos and the actual run, netcdf_extend is returned
	841	!-- as .FALSE.
[1783]	842	CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
[1]	843
	844	!
	845	!-- Remove the local file, if it can not be extended
	846	IF ( .NOT. netcdf_extend ) THEN
	847	nc_stat = NF90_CLOSE( id_set_pr )
[1783]	848	CALL netcdf_handle_error( 'check_open', 30 )
[102]	849	CALL local_system( 'rm ' // TRIM( filename ) )
[1]	850	ENDIF
	851
	852	ENDIF
	853
	854	IF ( .NOT. netcdf_extend ) THEN
	855	!
[1031]	856	!-- Create a new netCDF output file with requested netCDF format
[1783]	857	CALL netcdf_create_file( filename, id_set_pr, .FALSE., 31 )
[1]	858	!
	859	!-- Define the header
[1783]	860	CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
[1]	861
	862	ENDIF
	863
	864	CASE ( 105 )
	865	!
[102]	866	!-- Set filename
[1779]	867	filename = 'DATA_1D_TS_NETCDF' // TRIM( coupling_char )
[102]	868
	869	!
[1031]	870	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	871	!-- be opened for extension, if its variables match the actual run.
[102]	872	INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]	873
	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_ts, .FALSE., 32 )
[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( 'ts', netcdf_extend, 0 )
[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_ts )
[1783]	888	CALL netcdf_handle_error( 'check_open', 33 )
[102]	889	CALL local_system( 'rm ' // TRIM( filename ) )
[1]	890	ENDIF
	891
	892	ENDIF
	893
	894	IF ( .NOT. netcdf_extend ) THEN
	895	!
[1031]	896	!-- Create a new netCDF output file with requested netCDF format
[1783]	897	CALL netcdf_create_file( filename, id_set_ts, .FALSE., 34 )
[1]	898	!
	899	!-- Define the header
[1783]	900	CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
[1]	901
	902	ENDIF
	903
	904
	905	CASE ( 106, 116 )
	906	!
	907	!-- Set filename depending on unit number
	908	IF ( file_id == 106 ) THEN
[1779]	909	filename = 'DATA_3D_NETCDF' // TRIM( coupling_char )
[1]	910	av = 0
	911	ELSE
[1779]	912	filename = 'DATA_3D_AV_NETCDF' // TRIM( coupling_char )
[1]	913	av = 1
	914	ENDIF
	915	!
[1031]	916	!-- Inquire, if there is a netCDF file from a previous run. This should
[1]	917	!-- be opened for extension, if its dimensions and variables match the
	918	!-- actual run.
	919	INQUIRE( FILE=filename, EXIST=netcdf_extend )
	920
	921	IF ( netcdf_extend ) THEN
	922	!
[1031]	923	!-- Open an existing netCDF file for output
[1783]	924	CALL netcdf_open_write_file( filename, id_set_3d(av), .TRUE., 35 )
[1]	925	!
	926	!-- Read header information and set all ids. If there is a mismatch
	927	!-- between the previuos and the actual run, netcdf_extend is returned
	928	!-- as .FALSE.
[1783]	929	CALL netcdf_define_header( '3d', netcdf_extend, av )
[1]	930
	931	!
	932	!-- Remove the local file, if it can not be extended
	933	IF ( .NOT. netcdf_extend ) THEN
	934	nc_stat = NF90_CLOSE( id_set_3d(av) )
[1783]	935	CALL netcdf_handle_error( 'check_open', 36 )
[1745]	936	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
[1804]	937	#if defined( __parallel )
[1745]	938	!
	939	!-- Set a barrier in order to assure that PE0 deleted the old file
	940	!-- before any other processor tries to open a new file
[1974]	941	!-- Barrier is only needed in case of parallel I/O
	942	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
[1745]	943	#endif
[1]	944	ENDIF
	945
[1745]	946	ENDIF
[1]	947
	948	IF ( .NOT. netcdf_extend ) THEN
	949	!
[1031]	950	!-- Create a new netCDF output file with requested netCDF format
[1783]	951	CALL netcdf_create_file( filename, id_set_3d(av), .TRUE., 37 )
[493]	952
	953	!
[1]	954	!-- Define the header
[1783]	955	CALL netcdf_define_header( '3d', netcdf_extend, av )
[1]	956
[493]	957	!
[1031]	958	!-- In case of parallel netCDF output, create flag file which tells
[493]	959	!-- combine_plot_fields that nothing is to do.
[1031]	960	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
[493]	961	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
	962	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
	963	CLOSE( 99 )
	964	ENDIF
	965
[1]	966	ENDIF
	967
	968
	969	CASE ( 107 )
	970	!
[102]	971	!-- Set filename
[1779]	972	filename = 'DATA_1D_SP_NETCDF' // TRIM( coupling_char )
[102]	973
	974	!
[1031]	975	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	976	!-- be opened for extension, if its variables match the actual run.
[102]	977	INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]	978
	979	IF ( netcdf_extend ) THEN
	980	!
[1031]	981	!-- Open an existing netCDF file for output
[1783]	982	CALL netcdf_open_write_file( filename, id_set_sp, .FALSE., 38 )
[263]	983
[1]	984	!
	985	!-- Read header information and set all ids. If there is a mismatch
	986	!-- between the previuos and the actual run, netcdf_extend is returned
	987	!-- as .FALSE.
[1783]	988	CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
[1]	989
	990	!
	991	!-- Remove the local file, if it can not be extended
	992	IF ( .NOT. netcdf_extend ) THEN
	993	nc_stat = NF90_CLOSE( id_set_sp )
[1783]	994	CALL netcdf_handle_error( 'check_open', 39 )
[102]	995	CALL local_system( 'rm ' // TRIM( filename ) )
[1]	996	ENDIF
	997
	998	ENDIF
	999
	1000	IF ( .NOT. netcdf_extend ) THEN
	1001	!
[1031]	1002	!-- Create a new netCDF output file with requested netCDF format
[1783]	1003	CALL netcdf_create_file( filename, id_set_sp, .FALSE., 40 )
[1]	1004	!
	1005	!-- Define the header
[1783]	1006	CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
[1]	1007
	1008	ENDIF
	1009
	1010
	1011	CASE ( 108 )
	1012
	1013	IF ( myid_char == '' ) THEN
[1779]	1014	filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char )
[1]	1015	ELSE
[1320]	1016	filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
[105]	1017	myid_char
[1]	1018	ENDIF
	1019	!
[1031]	1020	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	1021	!-- be opened for extension, if its variables match the actual run.
	1022	INQUIRE( FILE=filename, EXIST=netcdf_extend )
	1023
	1024	IF ( netcdf_extend ) THEN
	1025	!
[1031]	1026	!-- Open an existing netCDF file for output
[1783]	1027	CALL netcdf_open_write_file( filename, id_set_prt, .FALSE., 41 )
[1]	1028	!
	1029	!-- Read header information and set all ids. If there is a mismatch
	1030	!-- between the previuos and the actual run, netcdf_extend is returned
	1031	!-- as .FALSE.
[1783]	1032	CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
[1]	1033
	1034	!
	1035	!-- Remove the local file, if it can not be extended
	1036	IF ( .NOT. netcdf_extend ) THEN
	1037	nc_stat = NF90_CLOSE( id_set_prt )
[1783]	1038	CALL netcdf_handle_error( 'check_open', 42 )
[1745]	1039	CALL local_system( 'rm ' // TRIM( filename ) )
[1]	1040	ENDIF
	1041
	1042	ENDIF
	1043
	1044	IF ( .NOT. netcdf_extend ) THEN
	1045
	1046	!
	1047	!-- For runs on multiple processors create the subdirectory
	1048	IF ( myid_char /= '' ) THEN
[1320]	1049	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) &
[1]	1050	THEN ! needs modification in case of non-extendable sets
[1320]	1051	CALL local_system( 'mkdir DATA_PRT_NETCDF' // &
[105]	1052	TRIM( coupling_char ) // '/' )
[1]	1053	ENDIF
[1804]	1054	#if defined( __parallel )
[807]	1055	!
[1]	1056	!-- Set a barrier in order to allow that all other processors in the
	1057	!-- directory created by PE0 can open their file
	1058	CALL MPI_BARRIER( comm2d, ierr )
	1059	#endif
	1060	ENDIF
	1061
	1062	!
[1031]	1063	!-- Create a new netCDF output file with requested netCDF format
[1783]	1064	CALL netcdf_create_file( filename, id_set_prt, .FALSE., 43 )
[519]	1065
	1066	!
[1]	1067	!-- Define the header
[1783]	1068	CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
[1]	1069
	1070	ENDIF
	1071
	1072	CASE ( 109 )
	1073	!
[102]	1074	!-- Set filename
[1779]	1075	filename = 'DATA_1D_PTS_NETCDF' // TRIM( coupling_char )
[102]	1076
	1077	!
[1031]	1078	!-- Inquire, if there is a netCDF file from a previuos run. This should
[1]	1079	!-- be opened for extension, if its variables match the actual run.
[102]	1080	INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1]	1081
	1082	IF ( netcdf_extend ) THEN
	1083	!
[1031]	1084	!-- Open an existing netCDF file for output
[1783]	1085	CALL netcdf_open_write_file( filename, id_set_pts, .FALSE., 393 )
[1]	1086	!
	1087	!-- Read header information and set all ids. If there is a mismatch
	1088	!-- between the previuos and the actual run, netcdf_extend is returned
	1089	!-- as .FALSE.
[1783]	1090	CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
[1]	1091
	1092	!
	1093	!-- Remove the local file, if it can not be extended
	1094	IF ( .NOT. netcdf_extend ) THEN
	1095	nc_stat = NF90_CLOSE( id_set_pts )
[1783]	1096	CALL netcdf_handle_error( 'check_open', 394 )
[102]	1097	CALL local_system( 'rm ' // TRIM( filename ) )
[1]	1098	ENDIF
	1099
	1100	ENDIF
	1101
	1102	IF ( .NOT. netcdf_extend ) THEN
	1103	!
[1031]	1104	!-- Create a new netCDF output file with requested netCDF format
[1783]	1105	CALL netcdf_create_file( filename, id_set_pts, .FALSE., 395 )
[1]	1106	!
	1107	!-- Define the header
[1783]	1108	CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
[1]	1109
	1110	ENDIF
[410]	1111
[1468]	1112
	1113	!
	1114	!-- Progress file that is used by the PALM watchdog
	1115	CASE ( 117 )
	1116
[1779]	1117	OPEN ( 117, FILE='PROGRESS'//TRIM( coupling_char ), &
	1118	STATUS='REPLACE', FORM='FORMATTED' )
[1957]	1119	!
	1120	!-- nc-file for virtual flight measurements
	1121	CASE ( 199 )
	1122	!
	1123	!-- Set filename
	1124	filename = 'DATA_1D_FL_NETCDF' // TRIM( coupling_char )
[1468]	1125
[1957]	1126	!
	1127	!-- Inquire, if there is a netCDF file from a previuos run. This should
	1128	!-- be opened for extension, if its variables match the actual run.
	1129	INQUIRE( FILE=filename, EXIST=netcdf_extend )
[1468]	1130
[1957]	1131	IF ( netcdf_extend ) THEN
	1132	!
	1133	!-- Open an existing netCDF file for output
	1134	CALL netcdf_open_write_file( filename, id_set_fl, .FALSE., 532 )
	1135	!
	1136	!-- Read header information and set all ids. If there is a mismatch
	1137	!-- between the previuos and the actual run, netcdf_extend is returned
	1138	!-- as .FALSE.
	1139	CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
	1140
	1141	!
	1142	!-- Remove the local file, if it can not be extended
	1143	IF ( .NOT. netcdf_extend ) THEN
	1144	nc_stat = NF90_CLOSE( id_set_fl )
	1145	CALL netcdf_handle_error( 'check_open', 533 )
	1146	CALL local_system( 'rm ' // TRIM( filename ) )
	1147	ENDIF
	1148
	1149	ENDIF
	1150
	1151	IF ( .NOT. netcdf_extend ) THEN
	1152	!
	1153	!-- Create a new netCDF output file with requested netCDF format
	1154	CALL netcdf_create_file( filename, id_set_fl, .FALSE., 534 )
	1155	!
	1156	!-- Define the header
	1157	CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
	1158
	1159	ENDIF
	1160
	1161
[564]	1162	CASE ( 201:200+2*max_masks )
[410]	1163	!
	1164	!-- Set filename depending on unit number
[564]	1165	IF ( file_id <= 200+max_masks ) THEN
	1166	mid = file_id - 200
[410]	1167	WRITE ( mask_char,'(I2.2)') mid
[1779]	1168	filename = 'DATA_MASK_' // mask_char // '_NETCDF' // &
	1169	TRIM( coupling_char )
[410]	1170	av = 0
	1171	ELSE
[564]	1172	mid = file_id - (200+max_masks)
[410]	1173	WRITE ( mask_char,'(I2.2)') mid
[1320]	1174	filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // &
[1779]	1175	TRIM( coupling_char )
[410]	1176	av = 1
	1177	ENDIF
	1178	!
[1031]	1179	!-- Inquire, if there is a netCDF file from a previuos run. This should
[410]	1180	!-- be opened for extension, if its dimensions and variables match the
	1181	!-- actual run.
	1182	INQUIRE( FILE=filename, EXIST=netcdf_extend )
	1183
	1184	IF ( netcdf_extend ) THEN
	1185	!
[1031]	1186	!-- Open an existing netCDF file for output
[1783]	1187	CALL netcdf_open_write_file( filename, id_set_mask(mid,av), &
[1031]	1188	.TRUE., 456 )
[410]	1189	!
	1190	!-- Read header information and set all ids. If there is a mismatch
	1191	!-- between the previuos and the actual run, netcdf_extend is returned
	1192	!-- as .FALSE.
[1783]	1193	CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
[1]	1194
[410]	1195	!
	1196	!-- Remove the local file, if it can not be extended
	1197	IF ( .NOT. netcdf_extend ) THEN
	1198	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
[1783]	1199	CALL netcdf_handle_error( 'check_open', 457 )
[410]	1200	CALL local_system('rm ' // TRIM( filename ) )
	1201	ENDIF
[1]	1202
[410]	1203	ENDIF
	1204
	1205	IF ( .NOT. netcdf_extend ) THEN
[1]	1206	!
[1031]	1207	!-- Create a new netCDF output file with requested netCDF format
[1783]	1208	CALL netcdf_create_file( filename, id_set_mask(mid,av), .TRUE., 458 )
[493]	1209	!
[410]	1210	!-- Define the header
[1783]	1211	CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
[410]	1212
	1213	ENDIF
	1214
	1215
	1216	#else
	1217
[564]	1218	CASE ( 101:109, 111:113, 116, 201:200+2*max_masks )
[410]	1219
	1220	!
[1]	1221	!-- Nothing is done in case of missing netcdf support
	1222	RETURN
	1223
	1224	#endif
	1225
	1226	CASE DEFAULT
	1227
[247]	1228	WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
[277]	1229	CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
[1]	1230
	1231	END SELECT
	1232
	1233	!
	1234	!-- Set open flag
	1235	openfile(file_id)%opened = .TRUE.
	1236
	1237	!
	1238	!-- Formats
[1320]	1239	3300 FORMAT ('#'/ &
	1240	'coord 1 file=',A,' filetype=unformatted'/ &
	1241	'coord 2 file=',A,' filetype=unformatted skip=',I6/ &
	1242	'coord 3 file=',A,' filetype=unformatted skip=',I6/ &
[1]	1243	'#')
	1244	4000 FORMAT ('# ',A)
[1320]	1245	5000 FORMAT ('# ',A/ &
	1246	'#1 E'/'#2 E'/'#3 dt'/'#4 u'/'#5 th*'/'#6 umax'/'#7 vmax'/ &
	1247	'#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
	1248	'#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/ &
[1]	1249	'#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
[1320]	1250	8000 FORMAT (A/ &
[1359]	1251	' step time # of parts lPE sent/recv rPE sent/recv ',&
	1252	'sPE sent/recv nPE sent/recv max # of parts '/ &
	1253	109('-'))
[1]	1254
	1255	END SUBROUTINE check_open

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |