Home

Context Navigation

virtual_flight_mod.f90 @ 4851

Last change on this file since 4851 was 4843, checked in by raasch, 4 years ago
local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates
Property svn:keywords set to `Id`
File size: 46.1 KB

Rev	Line
[1957]	1	!> @file virtual_flights_mod.f90
[4497]	2	!--------------------------------------------------------------------------------------------------!
[2696]	3	! This file is part of the PALM model system.
[1957]	4	!
[4497]	5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
	6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
	7	! (at your option) any later version.
[1957]	8	!
[4497]	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
	10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
	11	! Public License for more details.
[1957]	12	!
[4497]	13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
	14	! <http://www.gnu.org/licenses/>.
[1957]	15	!
[4828]	16	! Copyright 1997-2021 Leibniz Universitaet Hannover
[4497]	17	!--------------------------------------------------------------------------------------------------!
[1957]	18	!
[4497]	19	!
[1957]	20	! Current revisions:
[4497]	21	! -----------------
[4842]	22	!
	23	!
[1957]	24	! Former revisions:
	25	! -----------------
	26	! $Id: virtual_flight_mod.f90 4843 2021-01-15 15:22:11Z gronemeier $
[4843]	27	! local namelist parameter added to switch off the module although the respective module namelist
	28	! appears in the namelist file
	29	!
	30	! 4842 2021-01-14 10:42:28Z raasch
[4842]	31	! reading of namelist file and actions in case of namelist errors revised so that statement labels
	32	! and goto statements are not required any more
	33	!
	34	! 4828 2021-01-05 11:21:41Z Giersch
[4541]	35	! Bugfix, use time_since_reference_point instead of simulated_time
[4842]	36	!
[4541]	37	! 4535 2020-05-15 12:07:23Z raasch
[4535]	38	! bugfix for restart data format query
[4842]	39	!
[4535]	40	! 4522 2020-05-06 14:17:05Z suehring
[4522]	41	! Modularize user_init_flight in order to provide an explicit interface.
[4842]	42	!
[4522]	43	! 4497 2020-04-15 10:20:51Z raasch
[4497]	44	! file re-formatted to follow the PALM coding standard
	45	!
	46	!
	47	! 4495 2020-04-13 20:11:20Z raasch
[4495]	48	! restart data handling with MPI-IO added
[4842]	49	!
[4495]	50	! 4360 2020-01-07 11:25:50Z suehring
[4182]	51	! Corrected "Former revisions" section
[4497]	52	!
[4182]	53	! 4004 2019-05-24 11:32:38Z suehring
[4004]	54	! Allow variable start- and end locations also in return mode
[4497]	55	!
[4004]	56	! 3885 2019-04-11 11:29:34Z kanani
[4497]	57	! Changes related to global restructuring of location messages and introduction of additional
	58	! debug messages
	59	!
[3885]	60	! 3655 2019-01-07 16:51:22Z knoop
[3547]	61	! variables documented
[4497]	62	!
[4182]	63	! 1957 2016-07-07 10:43:48Z suehring
	64	! Initial revision
[2716]	65	!
[1957]	66	! Description:
	67	! ------------
	68	!> Module for virtual flight measurements.
[2271]	69	!> @todo Err msg PA0438: flight can be inside topography -> extra check?
[4497]	70	!--------------------------------------------------------------------------------------------------!
[1957]	71	MODULE flight_mod
[4497]	72
[4495]	73	USE control_parameters, &
[4497]	74	ONLY: debug_output, &
	75	fl_max, num_leg, &
	76	num_var_fl, &
	77	num_var_fl_user, &
	78	restart_data_format_output, &
	79	virtual_flight
	80
[1957]	81	USE kinds
	82
[4495]	83	USE restart_data_mpi_io_mod, &
	84	ONLY: rd_mpi_io_check_array, rrd_mpi_io_global_array, wrd_mpi_io_global_array
	85
[4522]	86	USE user_init_flight_mod, &
	87	ONLY: user_init_flight
[4495]	88
[4522]	89
[4497]	90	CHARACTER(LEN=6), DIMENSION(fl_max) :: leg_mode = 'cyclic' !< flight mode through the model domain, either 'cyclic' or
	91	!<'return'
[1957]	92
	93	INTEGER(iwp) :: l !< index for flight leg
	94	INTEGER(iwp) :: var_index !< index for measured variable
	95
[4497]	96	LOGICAL, DIMENSION(:), ALLOCATABLE :: cyclic_leg !< flag to identify fly mode
[1957]	97
	98	REAL(wp) :: flight_end = 9999999.9_wp !< end time of virtual flight
	99	REAL(wp) :: flight_begin = 0.0_wp !< end time of virtual flight
	100
[4497]	101	REAL(wp), DIMENSION(fl_max) :: flight_angle = 45.0_wp !< angle determining the horizontal flight direction
	102	REAL(wp), DIMENSION(fl_max) :: flight_level = 100.0_wp !< flight level
	103	REAL(wp), DIMENSION(fl_max) :: max_elev_change = 0.0_wp !< maximum elevation change for the respective flight leg
	104	REAL(wp), DIMENSION(fl_max) :: rate_of_climb = 0.0_wp !< rate of climb or descent
	105	REAL(wp), DIMENSION(fl_max) :: speed_agl = 25.0_wp !< absolute horizontal flight speed above ground level (agl)
	106	REAL(wp), DIMENSION(fl_max) :: x_start = 999999999.0_wp !< start x position
	107	REAL(wp), DIMENSION(fl_max) :: x_end = 999999999.0_wp !< end x position
	108	REAL(wp), DIMENSION(fl_max) :: y_start = 999999999.0_wp !< start y position
	109	REAL(wp), DIMENSION(fl_max) :: y_end = 999999999.0_wp !< end y position
[1957]	110
[4497]	111	REAL(wp), DIMENSION(:), ALLOCATABLE :: u_agl !< u-component of flight speed
	112	REAL(wp), DIMENSION(:), ALLOCATABLE :: v_agl !< v-component of flight speed
	113	REAL(wp), DIMENSION(:), ALLOCATABLE :: w_agl !< w-component of flight speed
	114	REAL(wp), DIMENSION(:), ALLOCATABLE :: x_pos !< aircraft x-position
	115	REAL(wp), DIMENSION(:), ALLOCATABLE :: y_pos !< aircraft y-position
	116	REAL(wp), DIMENSION(:), ALLOCATABLE :: z_pos !< aircraft z-position
[1957]	117
[4497]	118	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sensor_l !< measured data on local PE
	119	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sensor !< measured data
[1957]	120
	121	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_u !< dummy array for possibly user-defined quantities
	122
	123	SAVE
	124
	125	PRIVATE
	126
	127	INTERFACE flight_header
	128	MODULE PROCEDURE flight_header
	129	END INTERFACE flight_header
[4497]	130
[1957]	131	INTERFACE flight_init
	132	MODULE PROCEDURE flight_init
	133	END INTERFACE flight_init
	134
	135	INTERFACE flight_init_output
	136	MODULE PROCEDURE flight_init_output
	137	END INTERFACE flight_init_output
	138
	139	INTERFACE flight_check_parameters
	140	MODULE PROCEDURE flight_check_parameters
	141	END INTERFACE flight_check_parameters
	142
	143	INTERFACE flight_parin
	144	MODULE PROCEDURE flight_parin
	145	END INTERFACE flight_parin
	146
	147	INTERFACE interpolate_xyz
	148	MODULE PROCEDURE interpolate_xyz
	149	END INTERFACE interpolate_xyz
	150
	151	INTERFACE flight_measurement
	152	MODULE PROCEDURE flight_measurement
	153	END INTERFACE flight_measurement
[4497]	154
	155	INTERFACE flight_rrd_global
[4495]	156	MODULE PROCEDURE flight_rrd_global_ftn
	157	MODULE PROCEDURE flight_rrd_global_mpi
[2894]	158	END INTERFACE flight_rrd_global
[1957]	159
[4497]	160	INTERFACE flight_wrd_global
	161	MODULE PROCEDURE flight_wrd_global
	162	END INTERFACE flight_wrd_global
	163
[1957]	164	!
	165	!-- Private interfaces
[4497]	166	PRIVATE flight_check_parameters, &
	167	flight_init_output, &
	168	interpolate_xyz
[1957]	169	!
	170	!-- Public interfaces
[4497]	171	PUBLIC flight_init, &
	172	flight_header, &
	173	flight_parin, &
	174	flight_measurement, &
	175	flight_wrd_global, &
	176	flight_rrd_global
[1957]	177	!
	178	!-- Public variables
[4497]	179	PUBLIC fl_max, &
	180	sensor, &
	181	x_pos, &
	182	y_pos, &
	183	z_pos
[1957]	184
	185	CONTAINS
	186
[4497]	187	!--------------------------------------------------------------------------------------------------!
[1957]	188	! Description:
	189	! ------------
	190	!> Header output for flight module.
[4497]	191	!--------------------------------------------------------------------------------------------------!
	192	SUBROUTINE flight_header ( io )
[1957]	193
	194
[4497]	195	IMPLICIT NONE
[1957]	196
[4497]	197	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
[1957]	198
[4497]	199	WRITE ( io, 1 )
	200	WRITE ( io, 2 )
	201	WRITE ( io, 3 ) num_leg
	202	WRITE ( io, 4 ) flight_begin
	203	WRITE ( io, 5 ) flight_end
	204
	205	DO l=1, num_leg
	206	WRITE ( io, 6 ) l
	207	WRITE ( io, 7 ) speed_agl(l)
	208	WRITE ( io, 8 ) flight_level(l)
	209	WRITE ( io, 9 ) max_elev_change(l)
	210	WRITE ( io, 10 ) rate_of_climb(l)
	211	WRITE ( io, 11 ) leg_mode(l)
	212	ENDDO
	213
	214
	215	1 FORMAT (' Virtual flights: ----------------' )
	216	2 FORMAT (' Output every timestep' )
	217	3 FORMAT (' Number of flight legs:', I3 )
	218	4 FORMAT (' Begin of measurements:', F10.1 , ' s' )
	219	5 FORMAT (' End of measurements:', F10.1 , ' s' )
	220	6 FORMAT (' Leg', I3/, ' ------' )
	221	7 FORMAT (' Flight speed : ', F5.1, ' m/s' )
	222	8 FORMAT (' Flight level : ', F5.1, ' m' )
	223	9 FORMAT (' Maximum elevation change: ', F5.1, ' m/s' )
	224	10 FORMAT (' Rate of climb / descent : ', F5.1, ' m/s' )
	225	11 FORMAT (' Leg mode : ', A/ )
	226
	227	END SUBROUTINE flight_header
	228
	229	!--------------------------------------------------------------------------------------------------!
[1957]	230	! Description:
	231	! ------------
	232	!> Reads the namelist flight_par.
[4497]	233	!--------------------------------------------------------------------------------------------------!
	234	SUBROUTINE flight_parin
[1957]	235
[4497]	236	IMPLICIT NONE
[1957]	237
[4842]	238	CHARACTER(LEN=100) :: line !< dummy string that contains the current line of the parameter file
[2932]	239
[4842]	240	INTEGER(iwp) :: io_status !< status after reading the namelist file
[4497]	241
[4843]	242	LOGICAL :: switch_off_module = .FALSE. !< local namelist parameter to switch off the module
	243	!< although the respective module namelist appears in
	244	!< the namelist file
[4497]	245
[4843]	246	NAMELIST /virtual_flight_parameters/ flight_angle, &
	247	flight_begin, &
	248	flight_end, &
	249	flight_level, &
	250	leg_mode, &
	251	max_elev_change, &
	252	rate_of_climb, &
	253	speed_agl, &
	254	switch_off_module, &
	255	x_end, &
	256	x_start, &
	257	y_end, &
	258	y_start
[1957]	259
[4843]	260
[1957]	261	!
[4842]	262	!-- Move to the beginning of the namelist file and try to find and read the namelist.
	263	REWIND( 11 )
	264	READ( 11, virtual_flight_parameters, IOSTAT=io_status )
[2932]	265
	266	!
[4842]	267	!-- Action depending on the READ status
	268	IF ( io_status == 0 ) THEN
[2932]	269	!
[4842]	270	!-- virtual_flight_parameters namelist was found and read correctly. Set switch that virtual
	271	!-- flights are carried out.
[4843]	272	IF ( .NOT. switch_off_module ) virtual_flight = .TRUE.
[4497]	273
[4842]	274	ELSEIF ( io_status > 0 ) THEN
[1957]	275	!
[4842]	276	!-- virtual_flight_parameters namelist was found, but contained errors. Print an error message
	277	!-- including the line that caused the problem.
	278	BACKSPACE( 11 )
	279	READ( 11 , '(A)' ) line
	280	CALL parin_fail_message( 'virtual_flight_parameters', line )
[1957]	281
[4842]	282	ENDIF
[2563]	283
[4842]	284	END SUBROUTINE flight_parin
[3246]	285
	286
[4497]	287	!--------------------------------------------------------------------------------------------------!
[1957]	288	! Description:
	289	! ------------
[4497]	290	!> Inititalization of required arrays, number of legs and flags. Moreover, initialize flight speed
	291	!> and -direction, as well as start positions.
	292	!--------------------------------------------------------------------------------------------------!
	293	SUBROUTINE flight_init
[1957]	294
[4497]	295	USE basic_constants_and_equations_mod, &
	296	ONLY: pi
[1957]	297
[4497]	298	USE control_parameters, &
	299	ONLY: initializing_actions
[3885]	300
[4497]	301	USE indices, &
	302	ONLY: nxlg, &
	303	nxrg, &
	304	nysg, &
	305	nyng, &
	306	nzb, &
	307	nzt
[3885]	308
[4497]	309	IMPLICIT NONE
	310
	311	REAL(wp) :: distance !< distance between start and end position of a flight leg
	312
	313
	314	IF ( debug_output ) CALL debug_message( 'flight_init', 'start' )
[1957]	315	!
[4497]	316	!-- Determine the number of flight legs
	317	l = 1
	318	DO WHILE ( x_start(l) /= 999999999.0_wp .AND. l <= SIZE(x_start) )
	319	l = l + 1
	320	ENDDO
	321	num_leg = l-1
[1957]	322	!
[4497]	323	!-- Check for proper parameter settings
	324	CALL flight_check_parameters
[1957]	325	!
[4497]	326	!-- Allocate and initialize logical array for flight pattern
	327	ALLOCATE( cyclic_leg(1:num_leg) )
[1957]	328	!
[4497]	329	!-- Initialize flags for cyclic/return legs
	330	DO l = 1, num_leg
	331	cyclic_leg(l) = MERGE( .TRUE., .FALSE., TRIM( leg_mode(l) ) == 'cyclic' )
	332	ENDDO
[1957]	333	!
[4497]	334	!-- Allocate and initialize arraxs for flight position and speed. In case of restart runs these data
	335	!-- are read by the routine read_flight_restart_data instead.
	336	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
	337
	338	ALLOCATE( x_pos(1:num_leg), y_pos(1:num_leg ), z_pos(1:num_leg) )
[1957]	339	!
[4497]	340	!-- Inititalize x-, y-, and z-positions with initial start position
	341	x_pos(1:num_leg) = x_start(1:num_leg)
	342	y_pos(1:num_leg) = y_start(1:num_leg)
	343	z_pos(1:num_leg) = flight_level(1:num_leg)
[1957]	344	!
[4497]	345	!-- Allocate arrays for flight-speed components
	346	ALLOCATE( u_agl(1:num_leg), &
	347	v_agl(1:num_leg), &
	348	w_agl(1:num_leg) )
[1957]	349	!
[4497]	350	!-- Inititalize u-, v- and w-component.
	351	DO l = 1, num_leg
[1957]	352	!
[4497]	353	!-- In case of return-legs, the flight direction, i.e. the horizontal flight-speed components,
	354	!-- are derived from the given start/end positions.
	355	IF ( .NOT. cyclic_leg(l) ) THEN
	356	distance = SQRT( ( x_end(l) - x_start(l) )2 + ( y_end(l) - y_start(l) )2 )
	357	u_agl(l) = speed_agl(l) * ( x_end(l) - x_start(l) ) / distance
	358	v_agl(l) = speed_agl(l) * ( y_end(l) - y_start(l) ) / distance
	359	w_agl(l) = rate_of_climb(l)
[1957]	360	!
[4497]	361	!-- In case of cyclic-legs, flight direction is directly derived from the given flight angle.
	362	ELSE
	363	u_agl(l) = speed_agl(l) * COS( flight_angle(l) * pi / 180.0_wp )
	364	v_agl(l) = speed_agl(l) * SIN( flight_angle(l) * pi / 180.0_wp )
	365	w_agl(l) = rate_of_climb(l)
	366	ENDIF
[1957]	367
[4497]	368	ENDDO
	369
	370	ENDIF
[1957]	371	!
[4497]	372	!-- Initialized data output
	373	CALL flight_init_output
[1957]	374	!
[4497]	375	!-- Allocate array required for user-defined quantities if necessary.
	376	IF ( num_var_fl_user > 0 ) ALLOCATE( var_u(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1957]	377	!
[4497]	378	!-- Allocate and initialize arrays containing the measured data
	379	ALLOCATE( sensor_l(1:num_var_fl,1:num_leg) )
	380	ALLOCATE( sensor(1:num_var_fl,1:num_leg) )
	381	sensor_l = 0.0_wp
	382	sensor = 0.0_wp
[1957]	383
[4497]	384	IF ( debug_output ) CALL debug_message( 'flight_init', 'end' )
[3885]	385
[4497]	386	END SUBROUTINE flight_init
	387
	388
	389	!--------------------------------------------------------------------------------------------------!
[1957]	390	! Description:
	391	! ------------
	392	!> Initialization of output-variable names and units.
[4497]	393	!--------------------------------------------------------------------------------------------------!
	394	SUBROUTINE flight_init_output
[3274]	395
[4497]	396	USE control_parameters, &
	397	ONLY: cloud_droplets, &
	398	humidity, &
	399	neutral, &
	400	passive_scalar
[3274]	401
[4497]	402	USE bulk_cloud_model_mod, &
	403	ONLY: bulk_cloud_model
[1957]	404
[4497]	405	USE netcdf_interface
	406
	407	IMPLICIT NONE
	408
	409	CHARACTER(LEN=10) :: label_leg !< dummy argument to convert integer to string
	410
	411	INTEGER(iwp) :: i !< loop variable
	412	INTEGER(iwp) :: id_pt !< identifyer for labeling
	413	INTEGER(iwp) :: id_q !< identifyer for labeling
	414	INTEGER(iwp) :: id_ql !< identifyer for labeling
	415	INTEGER(iwp) :: id_s !< identifyer for labeling
	416	INTEGER(iwp) :: id_u = 1 !< identifyer for labeling
	417	INTEGER(iwp) :: id_v = 2 !< identifyer for labeling
	418	INTEGER(iwp) :: id_w = 3 !< identifyer for labeling
	419	INTEGER(iwp) :: k !< index variable
	420
	421	LOGICAL :: init = .TRUE. !< flag to distiquish calls of user_init_flight
[1957]	422	!
[4497]	423	!-- Define output quanities, at least three variables are measured (u,v,w)
	424	num_var_fl = 3
	425	IF ( .NOT. neutral ) THEN
	426	num_var_fl = num_var_fl + 1
	427	id_pt = num_var_fl
	428	ENDIF
	429	IF ( humidity ) THEN
	430	num_var_fl = num_var_fl + 1
	431	id_q = num_var_fl
	432	ENDIF
	433	IF ( bulk_cloud_model .OR. cloud_droplets ) THEN
	434	num_var_fl = num_var_fl + 1
	435	id_ql = num_var_fl
	436	ENDIF
	437	IF ( passive_scalar ) THEN
	438	num_var_fl = num_var_fl + 1
	439	id_s = num_var_fl
	440	ENDIF
[1957]	441	!
[4497]	442	!-- Write output strings for dimensions x, y, z
	443	DO l=1, num_leg
[1957]	444
[4497]	445	IF ( l < 10 ) WRITE( label_leg, '(I1)' ) l
	446	IF ( l >= 10 .AND. l < 100 ) WRITE( label_leg, '(I2)' ) l
	447	IF ( l >= 100 .AND. l < 1000 ) WRITE( label_leg, '(I3)' ) l
[1957]	448
[4497]	449	dofl_dim_label_x(l) = 'x_' // TRIM( label_leg )
	450	dofl_dim_label_y(l) = 'y_' // TRIM( label_leg )
	451	dofl_dim_label_z(l) = 'z_' // TRIM( label_leg )
[1957]	452
[4497]	453	ENDDO
	454
[1957]	455	!
[4497]	456	!-- Call user routine to initialize further variables
	457	CALL user_init_flight( init )
[1957]	458	!
[4497]	459	!-- Write output labels and units for the quanities
	460	k = 1
	461	DO l=1, num_leg
[1957]	462
[4497]	463	IF ( l < 10 ) WRITE( label_leg, '(I1)' ) l
	464	IF ( l >= 10 .AND. l < 100 ) WRITE( label_leg, '(I2)' ) l
	465	IF ( l >= 100 .AND. l < 1000 ) WRITE( label_leg, '(I3)' ) l
	466
	467	label_leg = 'leg_' // TRIM(label_leg)
	468	DO i=1, num_var_fl
	469
	470	IF ( i == id_u ) THEN
	471	dofl_label(k) = TRIM( label_leg ) // '_u'
	472	dofl_unit(k) = 'm/s'
	473	k = k + 1
	474	ELSEIF ( i == id_v ) THEN
	475	dofl_label(k) = TRIM( label_leg ) // '_v'
	476	dofl_unit(k) = 'm/s'
	477	k = k + 1
	478	ELSEIF ( i == id_w ) THEN
	479	dofl_label(k) = TRIM( label_leg ) // '_w'
	480	dofl_unit(k) = 'm/s'
	481	k = k + 1
	482	ELSEIF ( i == id_pt ) THEN
	483	dofl_label(k) = TRIM( label_leg ) // '_theta'
	484	dofl_unit(k) = 'K'
	485	k = k + 1
	486	ELSEIF ( i == id_q ) THEN
	487	dofl_label(k) = TRIM( label_leg ) // '_q'
	488	dofl_unit(k) = 'kg/kg'
	489	k = k + 1
	490	ELSEIF ( i == id_ql ) THEN
	491	dofl_label(k) = TRIM( label_leg ) // '_ql'
	492	dofl_unit(k) = 'kg/kg'
	493	k = k + 1
	494	ELSEIF ( i == id_s ) THEN
	495	dofl_label(k) = TRIM( label_leg ) // '_s'
	496	dofl_unit(k) = 'kg/kg'
	497	k = k + 1
	498	ENDIF
	499	ENDDO
	500
	501	DO i=1, num_var_fl_user
	502	CALL user_init_flight( init, k, i, label_leg )
	503	ENDDO
	504
	505	ENDDO
[1957]	506	!
[4497]	507	!-- Finally, set the total number of flight-output quantities.
	508	num_var_fl = num_var_fl + num_var_fl_user
[1957]	509
[4497]	510	END SUBROUTINE flight_init_output
	511
	512	!--------------------------------------------------------------------------------------------------!
[1957]	513	! Description:
	514	! ------------
[4497]	515	!> This routine calculates the current flight positions and calls the respective interpolation
	516	!> routine to measure the data at the current flight position.
	517	!--------------------------------------------------------------------------------------------------!
	518	SUBROUTINE flight_measurement
[1957]	519
[4497]	520	USE arrays_3d, &
	521	ONLY: ddzu, &
	522	ddzw, &
	523	pt, &
	524	q, &
	525	ql, &
	526	s, &
	527	u, &
	528	v, &
	529	w, &
	530	zu, &
	531	zw
[1957]	532
[4497]	533	USE control_parameters, &
	534	ONLY: cloud_droplets, &
	535	dt_3d, &
	536	humidity, &
	537	neutral, &
	538	passive_scalar, &
[4541]	539	time_since_reference_point
[1957]	540
[4497]	541	USE cpulog, &
	542	ONLY: cpu_log, &
	543	log_point
[1957]	544
[4497]	545	USE grid_variables, &
	546	ONLY: ddx, &
	547	ddy, &
	548	dx, &
	549	dy
[1957]	550
[4497]	551	USE indices, &
	552	ONLY: nx, &
	553	nxl, &
	554	nxr, &
	555	ny, &
	556	nys, &
	557	nyn
[3274]	558
[4497]	559	USE bulk_cloud_model_mod, &
	560	ONLY: bulk_cloud_model
[1957]	561
[4497]	562	USE pegrid
[1957]	563
[4497]	564	IMPLICIT NONE
[1957]	565
[4497]	566	INTEGER(iwp) :: i !< index of current grid box along x
	567	INTEGER(iwp) :: j !< index of current grid box along y
	568	INTEGER(iwp) :: n !< loop variable for number of user-defined output quantities
[1957]	569
[4497]	570	LOGICAL :: on_pe !< flag to check if current flight position is on current PE
	571
	572	REAL(wp) :: x !< distance between left edge of current grid box and flight position
	573	REAL(wp) :: y !< distance between south edge of current grid box and flight position
	574
	575	CALL cpu_log( log_point(65), 'flight_measurement', 'start' )
[1957]	576	!
[4497]	577	!-- Perform flight measurement if start time is reached.
[4541]	578	IF ( time_since_reference_point >= flight_begin .AND. time_since_reference_point <= flight_end ) THEN
[1957]	579
[4497]	580	sensor_l = 0.0_wp
	581	sensor = 0.0_wp
[1957]	582	!
[4497]	583	!-- Loop over all flight legs
	584	DO l = 1, num_leg
[1957]	585	!
[4497]	586	!-- Update location for each leg
	587	x_pos(l) = x_pos(l) + u_agl(l) * dt_3d
	588	y_pos(l) = y_pos(l) + v_agl(l) * dt_3d
	589	z_pos(l) = z_pos(l) + w_agl(l) * dt_3d
[1957]	590	!
[4497]	591	!-- Check if location must be modified for return legs.
	592	!-- Carry out horizontal reflection if required.
	593	IF ( .NOT. cyclic_leg(l) ) THEN
[4004]	594
[4497]	595	IF ( x_start(l) <= x_end(l) ) THEN
[1957]	596	!
[4497]	597	!-- Outward flight, i.e. from start to end
	598	IF ( u_agl(l) >= 0.0_wp .AND. x_pos(l) > x_end(l) ) THEN
	599	x_pos(l) = 2.0_wp * x_end(l) - x_pos(l)
	600	u_agl(l) = - u_agl(l)
[1957]	601	!
[4497]	602	!-- Return flight, i.e. from end to start
	603	ELSEIF ( u_agl(l) < 0.0_wp .AND. x_pos(l) < x_start(l) ) THEN
	604	x_pos(l) = 2.0_wp * x_start(l) - x_pos(l)
	605	u_agl(l) = - u_agl(l)
[1957]	606	ENDIF
[4497]	607	ELSE
[1957]	608	!
[4497]	609	!-- Outward flight, i.e. from start to end
	610	IF ( u_agl(l) < 0.0_wp .AND. x_pos(l) < x_end(l) ) THEN
	611	x_pos(l) = 2.0_wp * x_end(l) - x_pos(l)
	612	u_agl(l) = - u_agl(l)
[1957]	613	!
[4497]	614	!-- Return flight, i.e. from end to start
	615	ELSEIF ( u_agl(l) >= 0.0_wp .AND. x_pos(l) > x_start(l) ) THEN
	616	x_pos(l) = 2.0_wp * x_start(l) - x_pos(l)
	617	u_agl(l) = - u_agl(l)
[1957]	618	ENDIF
[4497]	619	ENDIF
	620
	621	IF ( y_start(l) <= y_end(l) ) THEN
[1957]	622	!
[4497]	623	!-- Outward flight, i.e. from start to end
	624	IF ( v_agl(l) >= 0.0_wp .AND. y_pos(l) > y_end(l) ) THEN
	625	y_pos(l) = 2.0_wp * y_end(l) - y_pos(l)
	626	v_agl(l) = - v_agl(l)
[1957]	627	!
[4497]	628	!-- Return flight, i.e. from end to start
	629	ELSEIF ( v_agl(l) < 0.0_wp .AND. y_pos(l) < y_start(l) ) THEN
	630	y_pos(l) = 2.0_wp * y_start(l) - y_pos(l)
	631	v_agl(l) = - v_agl(l)
	632	ENDIF
	633	ELSE
[1957]	634	!
[4497]	635	!-- Outward flight, i.e. from start to end
	636	IF ( v_agl(l) < 0.0_wp .AND. y_pos(l) < y_end(l) ) THEN
	637	y_pos(l) = 2.0_wp * y_end(l) - y_pos(l)
	638	v_agl(l) = - v_agl(l)
[1957]	639	!
[4497]	640	!-- Return flight, i.e. from end to start
	641	ELSEIF ( v_agl(l) >= 0.0_wp .AND. y_pos(l) > y_start(l) ) THEN
	642	y_pos(l) = 2.0_wp * y_start(l) - y_pos(l)
	643	v_agl(l) = - v_agl(l)
[1957]	644	ENDIF
	645	ENDIF
	646	!
[4497]	647	!-- Check if flight position is outside the model domain and apply cyclic conditions if required
	648	ELSEIF ( cyclic_leg(l) ) THEN
[1957]	649	!
[4497]	650	!-- Check if aircraft leaves the model domain at the right boundary
	651	IF ( ( flight_angle(l) >= 0.0_wp .AND. &
	652	flight_angle(l) <= 90.0_wp ) .OR. &
	653	( flight_angle(l) >= 270.0_wp .AND. &
	654	flight_angle(l) <= 360.0_wp ) ) THEN
	655	IF ( x_pos(l) >= ( nx + 0.5_wp ) * dx ) &
	656	x_pos(l) = x_pos(l) - ( nx + 1 ) * dx
[1957]	657	!
[4497]	658	!-- Check if aircraft leaves the model domain at the left boundary
	659	ELSEIF ( flight_angle(l) > 90.0_wp .AND. flight_angle(l) < 270.0_wp ) THEN
	660	IF ( x_pos(l) < -0.5_wp * dx ) &
	661	x_pos(l) = ( nx + 1 ) * dx + x_pos(l)
	662	ENDIF
[1957]	663	!
[4497]	664	!-- Check if aircraft leaves the model domain at the north boundary
	665	IF ( flight_angle(l) >= 0.0_wp .AND. flight_angle(l) <= 180.0_wp ) THEN
	666	IF ( y_pos(l) >= ( ny + 0.5_wp ) * dy ) &
	667	y_pos(l) = y_pos(l) - ( ny + 1 ) * dy
[1957]	668	!
[4497]	669	!-- Check if aircraft leaves the model domain at the south boundary
	670	ELSEIF ( flight_angle(l) > 180.0_wp .AND. flight_angle(l) < 360.0_wp ) THEN
	671	IF ( y_pos(l) < -0.5_wp * dy ) &
	672	y_pos(l) = ( ny + 1 ) * dy + y_pos(l)
	673	ENDIF
[1957]	674
[4497]	675	ENDIF
	676	!
	677	!-- Check if maximum elevation change is already reached. If required reflect vertically.
	678	IF ( rate_of_climb(l) /= 0.0_wp ) THEN
	679	!
	680	!-- First check if aircraft is too high
	681	IF ( w_agl(l) > 0.0_wp .AND. z_pos(l) - flight_level(l) > max_elev_change(l) ) THEN
	682	z_pos(l) = 2.0_wp * ( flight_level(l) + max_elev_change(l) ) - z_pos(l)
	683	w_agl(l) = - w_agl(l)
	684	!
	685	!-- Check if aircraft is too low
	686	ELSEIF ( w_agl(l) < 0.0_wp .AND. z_pos(l) < flight_level(l) ) THEN
	687	z_pos(l) = 2.0_wp * flight_level(l) - z_pos(l)
	688	w_agl(l) = - w_agl(l)
	689	ENDIF
[1957]	690
[4497]	691	ENDIF
[1957]	692	!
[4497]	693	!-- Determine grid indices for flight position along x- and y-direction. Please note, there is
	694	!-- a special treatment for the index along z-direction, which is due to vertical grid stretching.
	695	i = ( x_pos(l) + 0.5_wp * dx ) * ddx
	696	j = ( y_pos(l) + 0.5_wp * dy ) * ddy
[1957]	697	!
[4497]	698	!-- Check if indices are on current PE
	699	on_pe = ( i >= nxl .AND. i <= nxr .AND. j >= nys .AND. j <= nyn )
	700
	701	IF ( on_pe ) THEN
	702
	703	var_index = 1
[1957]	704	!
[4497]	705	!-- Recalculate indices, as u is shifted by -0.5*dx.
	706	i = x_pos(l) * ddx
	707	j = ( y_pos(l) + 0.5_wp * dy ) * ddy
[1957]	708	!
[4497]	709	!-- Calculate distance from left and south grid-box edges.
	710	x = x_pos(l) - ( 0.5_wp - i ) * dx
	711	y = y_pos(l) - j * dy
	712	!
	713	!-- Interpolate u-component onto current flight position.
	714	CALL interpolate_xyz( u, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
	715	var_index = var_index + 1
	716	!
	717	!-- Recalculate indices, as v is shifted by -0.5*dy.
	718	i = ( x_pos(l) + 0.5_wp * dx ) * ddx
	719	j = y_pos(l) * ddy
[1957]	720
[4497]	721	x = x_pos(l) - i * dx
	722	y = y_pos(l) - ( 0.5_wp - j ) * dy
	723	CALL interpolate_xyz( v, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
	724	var_index = var_index + 1
[1957]	725	!
[4497]	726	!-- Interpolate w and scalar quantities. Recalculate indices.
	727	i = ( x_pos(l) + 0.5_wp * dx ) * ddx
	728	j = ( y_pos(l) + 0.5_wp * dy ) * ddy
	729	x = x_pos(l) - i * dx
	730	y = y_pos(l) - j * dy
[1957]	731	!
[4497]	732	!-- Interpolate w-velocity component.
	733	CALL interpolate_xyz( w, zw, ddzw, 0.0_wp, x, y, var_index, j, i )
	734	var_index = var_index + 1
	735	!
	736	!-- Potential temerature
	737	IF ( .NOT. neutral ) THEN
	738	CALL interpolate_xyz( pt, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
[1957]	739	var_index = var_index + 1
[4497]	740	ENDIF
[1957]	741	!
[4497]	742	!-- Humidity
	743	IF ( humidity ) THEN
	744	CALL interpolate_xyz( q, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
	745	var_index = var_index + 1
	746	ENDIF
[1957]	747	!
[4497]	748	!-- Liquid water content
	749	IF ( bulk_cloud_model .OR. cloud_droplets ) THEN
	750	CALL interpolate_xyz( ql, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
	751	var_index = var_index + 1
	752	ENDIF
[1957]	753	!
[4497]	754	!-- Passive scalar
	755	IF ( passive_scalar ) THEN
	756	CALL interpolate_xyz( s, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
	757	var_index = var_index + 1
	758	ENDIF
[1957]	759	!
[4497]	760	!-- Treat user-defined variables if required
	761	DO n = 1, num_var_fl_user
	762	CALL user_flight( var_u, n )
	763	CALL interpolate_xyz( var_u, zu, ddzu, 1.0_wp, x, y, var_index, j, i )
	764	var_index = var_index + 1
	765	ENDDO
	766	ENDIF
[1957]	767
[4497]	768	ENDDO
[1957]	769	!
[4497]	770	!-- Write local data on global array.
[1957]	771	#if defined( __parallel )
[4497]	772	CALL MPI_ALLREDUCE( sensor_l(1,1), sensor(1,1), num_var_fl * num_leg, MPI_REAL, MPI_SUM, &
	773	comm2d, ierr )
[1957]	774	#else
[4497]	775	sensor = sensor_l
[1957]	776	#endif
[4497]	777	ENDIF
[1957]	778
[4497]	779	CALL cpu_log( log_point(65), 'flight_measurement', 'stop' )
[1957]	780
[4497]	781	END SUBROUTINE flight_measurement
	782
	783	!--------------------------------------------------------------------------------------------------!
[1957]	784	! Description:
	785	! ------------
[4497]	786	!> This subroutine bi-linearly interpolates the respective data onto the current flight position.
	787	!--------------------------------------------------------------------------------------------------!
	788	SUBROUTINE interpolate_xyz( var, z_uw, ddz_uw, fac, x, y, var_ind, j, i )
[1957]	789
[4497]	790	USE control_parameters, &
	791	ONLY: dz, &
	792	dz_stretch_level_start
[1957]	793
[4497]	794	USE grid_variables, &
	795	ONLY: dx, &
	796	dy
[1957]	797
[4497]	798	USE indices, &
	799	ONLY: nzb, &
	800	nzt, &
	801	nxlg, &
	802	nxrg, &
	803	nysg, &
	804	nyng
[1957]	805
[4497]	806	IMPLICIT NONE
[1957]	807
[4497]	808	INTEGER(iwp) :: i !< index along x
	809	INTEGER(iwp) :: j !< index along y
	810	INTEGER(iwp) :: k !< index along z
	811	INTEGER(iwp) :: k1 !< dummy variable
	812	INTEGER(iwp) :: var_ind !< index variable for output quantity
[1957]	813
[4497]	814	REAL(wp) :: aa !< dummy argument for horizontal interpolation
	815	REAL(wp) :: bb !< dummy argument for horizontal interpolation
	816	REAL(wp) :: cc !< dummy argument for horizontal interpolation
	817	REAL(wp) :: dd !< dummy argument for horizontal interpolation
	818	REAL(wp) :: gg !< dummy argument for horizontal interpolation
	819	REAL(wp) :: fac !< flag to indentify if quantity is on zu or zw level
	820	REAL(wp) :: var_int !< horizontal interpolated variable at current position
	821	REAL(wp) :: var_int_l !< horizontal interpolated variable at k-level
	822	REAL(wp) :: var_int_u !< horizontal interpolated variable at (k+1)-level
	823	REAL(wp) :: x !< distance between left edge of current grid box and flight position
	824	REAL(wp) :: y !< distance between south edge of current grid box and flight position
	825
	826	REAL(wp), DIMENSION(1:nzt+1) :: ddz_uw !< inverse vertical grid spacing
	827	REAL(wp), DIMENSION(nzb:nzt+1) :: z_uw !< height level
	828
	829	REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< treated quantity
[1957]	830	!
[4497]	831	!-- Calculate interpolation coefficients
	832	aa = x2 + y2
	833	bb = ( dx - x )2 + y2
	834	cc = x2 + ( dy - y )2
	835	dd = ( dx - x )2 + ( dy - y )2
	836	gg = aa + bb + cc + dd
[1957]	837	!
[4497]	838	!-- Obtain vertical index. Special treatment for grid index along z-direction if flight position is
	839	!-- above the vertical grid-stretching level. fac=1 if variable is on scalar grid level, fac=0 for
	840	!-- w-component.
	841	IF ( z_pos(l) < dz_stretch_level_start(1) ) THEN
	842	k = ( z_pos(l) + fac * 0.5_wp * dz(1) ) / dz(1)
	843	ELSE
[1957]	844	!
[4497]	845	!-- Search for k-index
	846	DO k1 = nzb, nzt
	847	IF ( z_pos(l) >= z_uw(k1) .AND. z_pos(l) < z_uw(k1+1) ) THEN
	848	k = k1
	849	EXIT
	850	ENDIF
	851	ENDDO
	852	ENDIF
[1957]	853	!
[4497]	854	!-- (x,y)-interpolation at k-level
	855	var_int_l = ( ( gg - aa ) * var(k,j,i) + &
	856	( gg - bb ) * var(k,j,i+1) + &
	857	( gg - cc ) * var(k,j+1,i) + &
	858	( gg - dd ) * var(k,j+1,i+1) &
	859	) / ( 3.0_wp * gg )
[1957]	860	!
[4497]	861	!-- (x,y)-interpolation on (k+1)-level
	862	var_int_u = ( ( gg - aa ) * var(k+1,j,i) + &
	863	( gg - bb ) * var(k+1,j,i+1) + &
	864	( gg - cc ) * var(k+1,j+1,i) + &
	865	( gg - dd ) * var(k+1,j+1,i+1) &
	866	) / ( 3.0_wp * gg )
[1957]	867	!
[4497]	868	!-- z-interpolation onto current flight postion
	869	var_int = var_int_l + ( z_pos(l) - z_uw(k) ) * ddz_uw(k+1) * (var_int_u - var_int_l )
[1957]	870	!
[4497]	871	!-- Store on local data array
	872	sensor_l(var_ind,l) = var_int
[1957]	873
[4497]	874	END SUBROUTINE interpolate_xyz
[1957]	875
[4497]	876	!--------------------------------------------------------------------------------------------------!
[1957]	877	! Description:
	878	! ------------
	879	!> Perform parameter checks.
[4497]	880	!--------------------------------------------------------------------------------------------------!
	881	SUBROUTINE flight_check_parameters
[1957]	882
[4497]	883	USE arrays_3d, &
	884	ONLY: zu
[1957]	885
[4497]	886	USE control_parameters, &
	887	ONLY: bc_lr_cyc, &
	888	bc_ns_cyc, &
	889	message_string
[1957]	890
[4497]	891	USE grid_variables, &
	892	ONLY: dx, &
	893	dy
	894
	895	USE indices, &
	896	ONLY: nx, &
	897	ny, &
	898	nz
	899
	900	USE netcdf_interface, &
	901	ONLY: netcdf_data_format
	902
	903	IMPLICIT NONE
	904
[1957]	905	!
[4497]	906	!-- Check if start positions are properly set.
	907	DO l = 1, num_leg
	908	IF ( x_start(l) < 0.0_wp .OR. x_start(l) > ( nx + 1 ) * dx ) THEN
	909	message_string = 'Start x position is outside the model domain'
	910	CALL message( 'flight_check_parameters', 'PA0431', 1, 2, 0, 6, 0 )
	911	ENDIF
	912	IF ( y_start(l) < 0.0_wp .OR. y_start(l) > ( ny + 1 ) * dy ) THEN
	913	message_string = 'Start y position is outside the model domain'
	914	CALL message( 'flight_check_parameters', 'PA0432', 1, 2, 0, 6, 0 )
	915	ENDIF
[1957]	916
[4497]	917	ENDDO
[1957]	918	!
[4497]	919	!-- Check for leg mode
	920	DO l = 1, num_leg
[1957]	921	!
[4497]	922	!-- Check if leg mode matches the overall lateral model boundary conditions.
	923	IF ( TRIM( leg_mode(l) ) == 'cyclic' ) THEN
	924	IF ( .NOT. bc_lr_cyc .OR. .NOT. bc_ns_cyc ) THEN
	925	message_string = 'Cyclic flight leg does not match lateral boundary condition'
	926	CALL message( 'flight_check_parameters', 'PA0433', 1, 2, 0, 6, 0 )
	927	ENDIF
[1957]	928	!
[4497]	929	!-- Check if end-positions are inside the model domain in case of return-legs.
	930	ELSEIF ( TRIM( leg_mode(l) ) == 'return' ) THEN
	931	IF ( x_end(l) > ( nx + 1 ) * dx .OR. y_end(l) > ( ny + 1 ) * dx ) THEN
	932	message_string = 'Flight leg or parts of it are outside the model domain'
	933	CALL message( 'flight_check_parameters', 'PA0434', 1, 2, 0, 6, 0 )
[1957]	934	ENDIF
[4497]	935	ELSE
	936	message_string = 'Unknown flight mode'
	937	CALL message( 'flight_check_parameters', 'PA0435', 1, 2, 0, 6, 0 )
	938	ENDIF
[1957]	939
[4497]	940	ENDDO
[1957]	941	!
[4497]	942	!-- Check if given flight object remains inside model domain if a rate of climb / descent is
	943	!-- prescribed.
	944	DO l = 1, num_leg
	945	IF ( flight_level(l) + max_elev_change(l) > zu(nz) .OR. &
	946	flight_level(l) + max_elev_change(l) <= 0.0_wp ) THEN
	947	message_string = 'Flight level is outside the model domain '
	948	CALL message( 'flight_check_parameters', 'PA0438', 1, 2, 0, 6, 0 )
	949	ENDIF
	950	ENDDO
[1957]	951	!
[4497]	952	!-- Check for appropriate NetCDF format. Definition of more than one unlimited dimension is
	953	!-- unfortunately only possible with NetCDF4/HDF5.
	954	IF ( netcdf_data_format <= 2 ) THEN
	955	message_string = 'netcdf_data_format must be > 2'
	956	CALL message( 'flight_check_parameters', 'PA0439', 1, 2, 0, 6, 0 )
	957	ENDIF
[1957]	958
	959
[4497]	960	END SUBROUTINE flight_check_parameters
[2576]	961
[4497]	962
	963	!--------------------------------------------------------------------------------------------------!
[2576]	964	! Description:
	965	! ------------
[4495]	966	!> Read module-specific global restart data (Fortran binary format).
[4497]	967	!--------------------------------------------------------------------------------------------------!
	968	SUBROUTINE flight_rrd_global_ftn( found )
[2576]	969
	970
[4497]	971	USE control_parameters, &
	972	ONLY: length, &
	973	restart_string
[2576]	974
[1957]	975
[4497]	976	IMPLICIT NONE
[2894]	977
[4497]	978	LOGICAL, INTENT(OUT) :: found !< flag indicating if a variable string is found
[2894]	979
	980
[4497]	981	found = .TRUE.
[2894]	982
	983
[4497]	984	SELECT CASE ( restart_string(1:length) )
[1957]	985
[4497]	986	CASE ( 'u_agl' )
	987	IF ( .NOT. ALLOCATED( u_agl ) ) ALLOCATE( u_agl(1:num_leg) )
	988	READ ( 13 ) u_agl
	989	CASE ( 'v_agl' )
	990	IF ( .NOT. ALLOCATED( v_agl ) ) ALLOCATE( v_agl(1:num_leg) )
	991	READ ( 13 ) v_agl
	992	CASE ( 'w_agl' )
	993	IF ( .NOT. ALLOCATED( w_agl ) ) ALLOCATE( w_agl(1:num_leg) )
	994	READ ( 13 ) w_agl
	995	CASE ( 'x_pos' )
	996	IF ( .NOT. ALLOCATED( x_pos ) ) ALLOCATE( x_pos(1:num_leg) )
	997	READ ( 13 ) x_pos
	998	CASE ( 'y_pos' )
	999	IF ( .NOT. ALLOCATED( y_pos ) ) ALLOCATE( y_pos(1:num_leg) )
	1000	READ ( 13 ) y_pos
	1001	CASE ( 'z_pos' )
	1002	IF ( .NOT. ALLOCATED( z_pos ) ) ALLOCATE( z_pos(1:num_leg) )
	1003	READ ( 13 ) z_pos
[2894]	1004
[4497]	1005	CASE DEFAULT
[4495]	1006
[4497]	1007	found = .FALSE.
[4495]	1008
[4497]	1009	END SELECT
	1010
	1011
	1012	END SUBROUTINE flight_rrd_global_ftn
	1013
	1014
	1015
[4495]	1016	!------------------------------------------------------------------------------!
	1017	! Description:
	1018	! ------------
	1019	!> Read module-specific global restart data (MPI-IO).
	1020	!------------------------------------------------------------------------------!
[4497]	1021	SUBROUTINE flight_rrd_global_mpi
[4495]	1022
	1023
[4497]	1024	IMPLICIT NONE
[4495]	1025
[4497]	1026	LOGICAL :: array_found !< flag indicating if respective array is found in restart file
[4495]	1027
	1028
[4497]	1029	CALL rd_mpi_io_check_array( 'u_agl', found = array_found )
	1030	IF ( array_found) THEN
	1031	IF ( .NOT. ALLOCATED( u_agl ) ) ALLOCATE( u_agl(1:num_leg) )
	1032	CALL rrd_mpi_io_global_array( 'u_agl', u_agl )
	1033	ENDIF
	1034	CALL rd_mpi_io_check_array( 'v_agl', found = array_found )
	1035	IF ( array_found) THEN
	1036	IF ( .NOT. ALLOCATED( v_agl ) ) ALLOCATE( v_agl(1:num_leg) )
	1037	CALL rrd_mpi_io_global_array( 'v_agl', v_agl )
	1038	ENDIF
	1039	CALL rd_mpi_io_check_array( 'w_agl', found = array_found )
	1040	IF ( array_found) THEN
	1041	IF ( .NOT. ALLOCATED( w_agl ) ) ALLOCATE( w_agl(1:num_leg) )
	1042	CALL rrd_mpi_io_global_array( 'w_agl', w_agl )
	1043	ENDIF
	1044	CALL rd_mpi_io_check_array( 'x_pos', found = array_found )
	1045	IF ( array_found) THEN
	1046	IF ( .NOT. ALLOCATED( x_pos ) ) ALLOCATE( x_pos(1:num_leg) )
	1047	CALL rrd_mpi_io_global_array( 'x_pos', x_pos )
	1048	ENDIF
	1049	CALL rd_mpi_io_check_array( 'y_pos', found = array_found )
	1050	IF ( array_found) THEN
	1051	IF ( .NOT. ALLOCATED( y_pos ) ) ALLOCATE( y_pos(1:num_leg) )
	1052	CALL rrd_mpi_io_global_array( 'y_pos', y_pos )
	1053	ENDIF
	1054	CALL rd_mpi_io_check_array( 'z_pos', found = array_found )
	1055	IF ( array_found) THEN
	1056	IF ( .NOT. ALLOCATED( z_pos ) ) ALLOCATE( z_pos(1:num_leg) )
	1057	CALL rrd_mpi_io_global_array( 'z_pos', z_pos )
	1058	ENDIF
[4495]	1059
[4497]	1060	END SUBROUTINE flight_rrd_global_mpi
[4495]	1061
[1957]	1062
[4497]	1063	!--------------------------------------------------------------------------------------------------!
[1957]	1064	! Description:
	1065	! ------------
	1066	!> This routine writes the respective restart data.
[4497]	1067	!--------------------------------------------------------------------------------------------------!
	1068	SUBROUTINE flight_wrd_global
[1957]	1069
[2894]	1070
[4497]	1071	IMPLICIT NONE
[2894]	1072
[3182]	1073
[4497]	1074	IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN
[2894]	1075
[4497]	1076	CALL wrd_write_string( 'u_agl' )
	1077	WRITE ( 14 ) u_agl
[2894]	1078
[4497]	1079	CALL wrd_write_string( 'v_agl' )
	1080	WRITE ( 14 ) v_agl
[2894]	1081
[4497]	1082	CALL wrd_write_string( 'w_agl' )
	1083	WRITE ( 14 ) w_agl
[2894]	1084
[4497]	1085	CALL wrd_write_string( 'x_pos' )
	1086	WRITE ( 14 ) x_pos
[4495]	1087
[4497]	1088	CALL wrd_write_string( 'y_pos' )
	1089	WRITE ( 14 ) y_pos
[4495]	1090
[4497]	1091	CALL wrd_write_string( 'z_pos' )
	1092	WRITE ( 14 ) z_pos
[4495]	1093
[4535]	1094	ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN
[4495]	1095
[4497]	1096	CALL wrd_mpi_io_global_array( 'u_agl', u_agl )
	1097	CALL wrd_mpi_io_global_array( 'v_agl', v_agl )
	1098	CALL wrd_mpi_io_global_array( 'w_agl', w_agl )
	1099	CALL wrd_mpi_io_global_array( 'x_pos', x_pos )
	1100	CALL wrd_mpi_io_global_array( 'y_pos', y_pos )
	1101	CALL wrd_mpi_io_global_array( 'z_pos', z_pos )
[4495]	1102
[4497]	1103	ENDIF
[1957]	1104
[4497]	1105	END SUBROUTINE flight_wrd_global
	1106
	1107
[1957]	1108	END MODULE flight_mod

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

Context Navigation

source: palm/trunk/SOURCE/virtual_flight_mod.f90 @ 4851

Download in other formats: