Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |