Home

Context Navigation

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

Last change on this file since 1433 was 1360, checked in by hoffmann, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 40.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |