Home

Context Navigation

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

Last change on this file since 3523 was 3421, checked in by gronemeier, 6 years ago
new surface-data output; renamed output variables (pt to theta, rho_air to rho, rho_ocean to rho_sea_water)
Property svn:keywords set to `Id`
File size: 39.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |