Home

Context Navigation

dynamics_mod.f90 @ 4856

Last change on this file since 4856 was 4851, checked in by gronemeier, 4 years ago
bugfix: deactivated header output (dynamics_mod); change: formatting clean-up (synthetic_turbulence_generator_mod)
Property svn:keywords set to `Id`
File size: 54.2 KB

Rev	Line
[4047]	1	!> @file dynamics_mod.f90
	2	!--------------------------------------------------------------------------------------------------!
	3	! This file is part of the PALM model system.
	4	!
[4626]	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.
[4047]	8	!
[4626]	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.
[4047]	12	!
[4626]	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/>.
[4047]	15	!
[4828]	16	! Copyright 1997-2021 Leibniz Universitaet Hannover
[4047]	17	!--------------------------------------------------------------------------------------------------!
	18	!
	19	! Current revisions:
	20	! -----------------
[4626]	21	!
	22	!
[4047]	23	! Former revisions:
	24	! -----------------
	25	! $Id: dynamics_mod.f90 4851 2021-01-22 09:25:05Z raasch $
[4851]	26	! bugfix: deactivated header output
	27	!
	28	! 4845 2021-01-18 11:15:37Z raasch
[4845]	29	! radiation boundary condition always uses maximum phase velocity, respective code for calculating
	30	! the phase velocity is removed
	31	!
	32	! 4843 2021-01-15 15:22:11Z raasch
[4843]	33	! local namelist parameter added to switch off the module although the respective module namelist
	34	! appears in the namelist file
	35	!
	36	! 4842 2021-01-14 10:42:28Z raasch
[4842]	37	! reading of namelist file and actions in case of namelist errors revised so that statement labels
	38	! and goto statements are not required any more
	39	!
	40	! 4828 2021-01-05 11:21:41Z Giersch
[4768]	41	! Enable 3D data output also with 64-bit precision
	42	!
	43	! 4760 2020-10-26 13:26:47Z schwenkel
[4757]	44	! Implement relative humidity as diagnostic output quantity
	45	!
	46	! 4731 2020-10-07 13:25:11Z schwenkel
[4731]	47	! Move exchange_horiz from time_integration to modules
	48	!
	49	! 4627 2020-07-26 10:14:44Z raasch
[4627]	50	! bugfix for r4626
	51	!
	52	! 4626 2020-07-26 09:49:48Z raasch
[4626]	53	! file re-formatted to follow the PALM coding standard
	54	!
	55	! 4517 2020-05-03 14:29:30Z raasch
[4517]	56	! added restart with MPI-IO for reading local arrays
[4626]	57	!
[4517]	58	! 4505 2020-04-20 15:37:15Z schwenkel
[4505]	59	! Add flag for saturation check
[4626]	60	!
[4505]	61	! 4495 2020-04-13 20:11:20Z resler
[4495]	62	! restart data handling with MPI-IO added
[4626]	63	!
[4495]	64	! 4360 2020-01-07 11:25:50Z suehring
[4360]	65	! Bugfix for last commit.
[4626]	66	!
[4360]	67	! 4359 2019-12-30 13:36:50Z suehring
[4358]	68	! Refine post-initialization check for realistically inital values of mixing ratio. Give an error
[4626]	69	! message for faulty initial values, but only a warning in a restart run.
	70	!
[4358]	71	! 4347 2019-12-18 13:18:33Z suehring
[4347]	72	! Implement post-initialization check for realistically inital values of mixing ratio
[4626]	73	!
[4347]	74	! 4281 2019-10-29 15:15:39Z schwenkel
[4281]	75	! Moved boundary conditions in dynamics module
[4626]	76	!
[4281]	77	! 4097 2019-07-15 11:59:11Z suehring
[4097]	78	! Avoid overlong lines - limit is 132 characters per line
	79	!
	80	! 4047 2019-06-21 18:58:09Z knoop
[4047]	81	! Initial introduction of the dynamics module with only dynamics_swap_timelevel implemented
	82	!
	83	!
	84	! Description:
	85	! ------------
	86	!> This module contains the dynamics of PALM.
	87	!--------------------------------------------------------------------------------------------------!
	88	MODULE dynamics_mod
	89
	90
[4626]	91	USE arrays_3d, &
[4845]	92	ONLY: diss, &
[4731]	93	diss_p, &
[4626]	94	dzu, &
[4731]	95	e, &
	96	e_p, &
[4626]	97	exner, &
	98	hyp, &
	99	pt, pt_1, pt_2, pt_init, pt_p, &
	100	q, q_1, q_2, q_p, &
	101	s, s_1, s_2, s_p, &
[4845]	102	u, u_1, u_2, u_init, u_p, &
	103	v, v_1, v_2, v_p, v_init, &
	104	w, w_1, w_2, w_p, &
[4757]	105	zu
[4047]	106
[4347]	107	USE basic_constants_and_equations_mod, &
	108	ONLY: magnus, &
	109	rd_d_rv
	110
[4626]	111	USE control_parameters, &
	112	ONLY: bc_dirichlet_l, &
	113	bc_dirichlet_s, &
	114	bc_radiation_l, &
	115	bc_radiation_n, &
	116	bc_radiation_r, &
	117	bc_radiation_s, &
	118	bc_pt_t_val, &
	119	bc_q_t_val, &
	120	bc_s_t_val, &
	121	check_realistic_q, &
	122	child_domain, &
	123	coupling_mode, &
[4731]	124	constant_diffusion, &
[4626]	125	dt_3d, &
	126	humidity, &
	127	ibc_pt_b, &
	128	ibc_pt_t, &
	129	ibc_q_b, &
	130	ibc_q_t, &
	131	ibc_s_b, &
	132	ibc_s_t, &
	133	ibc_uv_b, &
	134	ibc_uv_t, &
	135	initializing_actions, &
	136	intermediate_timestep_count, &
	137	length, &
	138	message_string, &
	139	nesting_offline, &
	140	neutral, &
	141	nudging, &
	142	passive_scalar, &
	143	restart_string, &
[4731]	144	rans_mode, &
	145	rans_tke_e, &
[4845]	146	tsc
[4047]	147
[4731]	148	USE exchange_horiz_mod, &
	149	ONLY: exchange_horiz
	150
	151
[4626]	152	USE grid_variables, &
	153	ONLY: ddx, &
	154	ddy, &
	155	dx, &
[4281]	156	dy
	157
[4626]	158	USE indices, &
	159	ONLY: nbgp, &
	160	nx, &
	161	nxl, &
	162	nxlg, &
	163	nxr, &
	164	nxrg, &
	165	ny, &
	166	nys, &
	167	nysg, &
	168	nyn, &
	169	nyng, &
	170	nzb, &
[4047]	171	nzt
	172
	173	USE kinds
	174
[4281]	175	USE pegrid
	176
[4626]	177	USE pmc_interface, &
[4281]	178	ONLY : nesting_mode
	179
[4495]	180	! USE restart_data_mpi_io_mod, &
	181	! ONLY:
	182
[4626]	183	USE surface_mod, &
[4281]	184	ONLY : bc_h
	185
	186
[4047]	187	IMPLICIT NONE
	188
	189	LOGICAL :: dynamics_module_enabled = .FALSE. !<
	190
	191	SAVE
	192
	193	PRIVATE
	194
	195	!
	196	!-- Public functions
[4626]	197	PUBLIC &
	198	dynamics_parin, &
	199	dynamics_check_parameters, &
	200	dynamics_check_data_output_ts, &
	201	dynamics_check_data_output_pr, &
	202	dynamics_check_data_output, &
	203	dynamics_init_masks, &
	204	dynamics_define_netcdf_grid, &
	205	dynamics_init_arrays, &
	206	dynamics_init, &
	207	dynamics_init_checks, &
	208	dynamics_header, &
	209	dynamics_actions, &
	210	dynamics_non_advective_processes, &
	211	dynamics_exchange_horiz, &
	212	dynamics_prognostic_equations, &
	213	dynamics_boundary_conditions, &
	214	dynamics_swap_timelevel, &
	215	dynamics_3d_data_averaging, &
	216	dynamics_data_output_2d, &
	217	dynamics_data_output_3d, &
	218	dynamics_statistics, &
	219	dynamics_rrd_global, &
	220	dynamics_rrd_local, &
	221	dynamics_wrd_global, &
	222	dynamics_wrd_local, &
[4047]	223	dynamics_last_actions
	224
	225	!
	226	!-- Public parameters, constants and initial values
[4626]	227	PUBLIC &
[4047]	228	dynamics_module_enabled
	229
	230	INTERFACE dynamics_parin
	231	MODULE PROCEDURE dynamics_parin
	232	END INTERFACE dynamics_parin
	233
	234	INTERFACE dynamics_check_parameters
	235	MODULE PROCEDURE dynamics_check_parameters
	236	END INTERFACE dynamics_check_parameters
	237
	238	INTERFACE dynamics_check_data_output_ts
	239	MODULE PROCEDURE dynamics_check_data_output_ts
	240	END INTERFACE dynamics_check_data_output_ts
	241
	242	INTERFACE dynamics_check_data_output_pr
	243	MODULE PROCEDURE dynamics_check_data_output_pr
	244	END INTERFACE dynamics_check_data_output_pr
	245
	246	INTERFACE dynamics_check_data_output
	247	MODULE PROCEDURE dynamics_check_data_output
	248	END INTERFACE dynamics_check_data_output
	249
	250	INTERFACE dynamics_init_masks
	251	MODULE PROCEDURE dynamics_init_masks
	252	END INTERFACE dynamics_init_masks
	253
	254	INTERFACE dynamics_define_netcdf_grid
	255	MODULE PROCEDURE dynamics_define_netcdf_grid
	256	END INTERFACE dynamics_define_netcdf_grid
	257
	258	INTERFACE dynamics_init_arrays
	259	MODULE PROCEDURE dynamics_init_arrays
	260	END INTERFACE dynamics_init_arrays
	261
	262	INTERFACE dynamics_init
	263	MODULE PROCEDURE dynamics_init
	264	END INTERFACE dynamics_init
	265
	266	INTERFACE dynamics_init_checks
	267	MODULE PROCEDURE dynamics_init_checks
	268	END INTERFACE dynamics_init_checks
	269
	270	INTERFACE dynamics_header
	271	MODULE PROCEDURE dynamics_header
	272	END INTERFACE dynamics_header
	273
	274	INTERFACE dynamics_actions
	275	MODULE PROCEDURE dynamics_actions
	276	MODULE PROCEDURE dynamics_actions_ij
	277	END INTERFACE dynamics_actions
	278
	279	INTERFACE dynamics_non_advective_processes
	280	MODULE PROCEDURE dynamics_non_advective_processes
	281	MODULE PROCEDURE dynamics_non_advective_processes_ij
	282	END INTERFACE dynamics_non_advective_processes
	283
	284	INTERFACE dynamics_exchange_horiz
	285	MODULE PROCEDURE dynamics_exchange_horiz
	286	END INTERFACE dynamics_exchange_horiz
	287
	288	INTERFACE dynamics_prognostic_equations
	289	MODULE PROCEDURE dynamics_prognostic_equations
	290	MODULE PROCEDURE dynamics_prognostic_equations_ij
	291	END INTERFACE dynamics_prognostic_equations
	292
[4281]	293	INTERFACE dynamics_boundary_conditions
	294	MODULE PROCEDURE dynamics_boundary_conditions
	295	END INTERFACE dynamics_boundary_conditions
	296
[4047]	297	INTERFACE dynamics_swap_timelevel
	298	MODULE PROCEDURE dynamics_swap_timelevel
	299	END INTERFACE dynamics_swap_timelevel
	300
	301	INTERFACE dynamics_3d_data_averaging
	302	MODULE PROCEDURE dynamics_3d_data_averaging
	303	END INTERFACE dynamics_3d_data_averaging
	304
	305	INTERFACE dynamics_data_output_2d
	306	MODULE PROCEDURE dynamics_data_output_2d
	307	END INTERFACE dynamics_data_output_2d
	308
	309	INTERFACE dynamics_data_output_3d
	310	MODULE PROCEDURE dynamics_data_output_3d
	311	END INTERFACE dynamics_data_output_3d
	312
	313	INTERFACE dynamics_statistics
	314	MODULE PROCEDURE dynamics_statistics
	315	END INTERFACE dynamics_statistics
	316
	317	INTERFACE dynamics_rrd_global
[4495]	318	MODULE PROCEDURE dynamics_rrd_global_ftn
	319	MODULE PROCEDURE dynamics_rrd_global_mpi
[4047]	320	END INTERFACE dynamics_rrd_global
	321
	322	INTERFACE dynamics_rrd_local
[4517]	323	MODULE PROCEDURE dynamics_rrd_local_ftn
	324	MODULE PROCEDURE dynamics_rrd_local_mpi
[4047]	325	END INTERFACE dynamics_rrd_local
	326
	327	INTERFACE dynamics_wrd_global
	328	MODULE PROCEDURE dynamics_wrd_global
	329	END INTERFACE dynamics_wrd_global
	330
	331	INTERFACE dynamics_wrd_local
	332	MODULE PROCEDURE dynamics_wrd_local
	333	END INTERFACE dynamics_wrd_local
	334
	335	INTERFACE dynamics_last_actions
	336	MODULE PROCEDURE dynamics_last_actions
	337	END INTERFACE dynamics_last_actions
	338
	339
	340	CONTAINS
	341
	342
	343	!--------------------------------------------------------------------------------------------------!
	344	! Description:
	345	! ------------
	346	!> Read module-specific namelist
	347	!--------------------------------------------------------------------------------------------------!
	348	SUBROUTINE dynamics_parin
	349
[4842]	350	CHARACTER(LEN=100) :: line !< dummy string that contains the current line of the parameter
	351	!< file
	352	INTEGER(iwp) :: io_status !< status after reading the namelist file
[4047]	353
[4843]	354	LOGICAL :: switch_off_module = .FALSE. !< local namelist parameter to switch off the module
	355	!< although the respective module namelist appears in
	356	!< the namelist file
[4851]	357
[4843]	358	NAMELIST /dynamics_parameters/ switch_off_module
[4047]	359
[4843]	360
[4047]	361	!
[4843]	362	!-- For the time beeing (unless the dynamics module is further developed), set default module
	363	!-- switch to true.
[4047]	364	dynamics_module_enabled = .TRUE.
	365
[4843]	366	!
[4842]	367	!-- Move to the beginning of the namelist file and try to find and read the namelist.
	368	REWIND( 11 )
	369	READ( 11, dynamics_parameters, IOSTAT=io_status )
[4047]	370
[4842]	371	!
	372	!-- Action depending on the READ status
[4843]	373	IF ( io_status == 0 ) THEN
[4842]	374	!
[4843]	375	!-- dynamics_parameters namelist was found and read correctly.
	376	IF ( .NOT. switch_off_module ) dynamics_module_enabled = .TRUE.
	377
	378	ELSEIF ( io_status > 0 ) THEN
	379	!
[4842]	380	!-- dynamics_parameters namelist was found, but contained errors. Print an error message
	381	!-- including the line that caused the problem.
	382	BACKSPACE( 11 )
	383	READ( 11 , '(A)') line
	384	CALL parin_fail_message( 'dynamics_parameters', line )
[4047]	385
[4842]	386	ENDIF
[4047]	387
	388	END SUBROUTINE dynamics_parin
	389
	390
	391	!--------------------------------------------------------------------------------------------------!
	392	! Description:
	393	! ------------
	394	!> Check control parameters and deduce further quantities.
	395	!--------------------------------------------------------------------------------------------------!
	396	SUBROUTINE dynamics_check_parameters
	397
	398
	399	END SUBROUTINE dynamics_check_parameters
	400
	401
	402	!--------------------------------------------------------------------------------------------------!
	403	! Description:
	404	! ------------
	405	!> Set module-specific timeseries units and labels
	406	!--------------------------------------------------------------------------------------------------!
	407	SUBROUTINE dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
	408
[4627]	409	INTEGER(iwp), INTENT(IN) :: dots_max
	410
[4626]	411	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
	412	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
[4047]	413
	414	INTEGER(iwp), INTENT(INOUT) :: dots_num
	415
	416	!
	417	!-- Next line is to avoid compiler warning about unused variables. Please remove.
	418	IF ( dots_num == 0 .OR. dots_label(1)(1:1) == ' ' .OR. dots_unit(1)(1:1) == ' ' ) CONTINUE
	419
	420
	421	END SUBROUTINE dynamics_check_data_output_ts
	422
	423
	424	!--------------------------------------------------------------------------------------------------!
	425	! Description:
	426	! ------------
	427	!> Set the unit of module-specific profile output quantities. For those variables not recognized,
	428	!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
	429	!> is not defined and leads to a program abort.
	430	!--------------------------------------------------------------------------------------------------!
	431	SUBROUTINE dynamics_check_data_output_pr( variable, var_count, unit, dopr_unit )
	432
	433
[4626]	434	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
[4047]	435	CHARACTER (LEN=*) :: unit !<
	436	CHARACTER (LEN=*) :: variable !<
	437
	438	INTEGER(iwp) :: var_count !<
	439
	440	!
	441	!-- Next line is to avoid compiler warning about unused variables. Please remove.
	442	IF ( unit(1:1) == ' ' .OR. dopr_unit(1:1) == ' ' .OR. var_count == 0 ) CONTINUE
	443
	444	SELECT CASE ( TRIM( variable ) )
	445
	446	! CASE ( 'var_name' )
	447
	448	CASE DEFAULT
	449	unit = 'illegal'
	450
	451	END SELECT
	452
	453
	454	END SUBROUTINE dynamics_check_data_output_pr
	455
	456
	457	!--------------------------------------------------------------------------------------------------!
	458	! Description:
	459	! ------------
	460	!> Set the unit of module-specific output quantities. For those variables not recognized,
	461	!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
	462	!< is not defined and leads to a program abort.
	463	!--------------------------------------------------------------------------------------------------!
	464	SUBROUTINE dynamics_check_data_output( variable, unit )
	465
	466
	467	CHARACTER (LEN=*) :: unit !<
	468	CHARACTER (LEN=*) :: variable !<
	469
	470	SELECT CASE ( TRIM( variable ) )
	471
	472	! CASE ( 'u2' )
	473
	474	CASE DEFAULT
	475	unit = 'illegal'
	476
	477	END SELECT
	478
	479
	480	END SUBROUTINE dynamics_check_data_output
	481
	482
[4626]	483	!--------------------------------------------------------------------------------------------------!
[4047]	484	!
	485	! Description:
	486	! ------------
	487	!> Initialize module-specific masked output
[4626]	488	!--------------------------------------------------------------------------------------------------!
[4047]	489	SUBROUTINE dynamics_init_masks( variable, unit )
	490
	491
	492	CHARACTER (LEN=*) :: unit !<
	493	CHARACTER (LEN=*) :: variable !<
	494
	495
	496	SELECT CASE ( TRIM( variable ) )
	497
	498	! CASE ( 'u2' )
	499
	500	CASE DEFAULT
	501	unit = 'illegal'
	502
	503	END SELECT
	504
	505
	506	END SUBROUTINE dynamics_init_masks
	507
	508
	509	!--------------------------------------------------------------------------------------------------!
	510	! Description:
	511	! ------------
	512	!> Initialize module-specific arrays
	513	!--------------------------------------------------------------------------------------------------!
	514	SUBROUTINE dynamics_init_arrays
	515
	516
	517	END SUBROUTINE dynamics_init_arrays
	518
	519
	520	!--------------------------------------------------------------------------------------------------!
	521	! Description:
	522	! ------------
	523	!> Execution of module-specific initializing actions
	524	!--------------------------------------------------------------------------------------------------!
	525	SUBROUTINE dynamics_init
	526
	527
	528	END SUBROUTINE dynamics_init
	529
	530
	531	!--------------------------------------------------------------------------------------------------!
	532	! Description:
	533	! ------------
	534	!> Perform module-specific post-initialization checks
	535	!--------------------------------------------------------------------------------------------------!
	536	SUBROUTINE dynamics_init_checks
	537
[4347]	538	INTEGER(iwp) :: i !< loop index in x-direction
	539	INTEGER(iwp) :: j !< loop index in y-direction
	540	INTEGER(iwp) :: k !< loop index in z-direction
[4047]	541
[4347]	542	LOGICAL :: realistic_q = .TRUE. !< flag indicating realistic mixing ratios
	543
	544	REAL(wp) :: e_s !< saturation water vapor pressure
	545	REAL(wp) :: q_s !< saturation mixing ratio
	546	REAL(wp) :: t_l !< actual temperature
[4760]	547	REAL(wp) :: rh_check = 9999999.9_wp !< relative humidity
[4757]	548	REAL(wp) :: rh_min = 9999999.9_wp !< max relative humidity
	549	REAL(wp) :: height = 9999999.9_wp !< height of supersaturated regions
	550	REAL(wp) :: min_height = 9999999.9_wp !< height of supersaturated regions
[4347]	551
	552	!
[4626]	553	!-- Check for realistic initial mixing ratio. This must be in a realistic phyiscial range and must
	554	!-- not exceed the saturation mixing ratio by more than 2 percent. Please note, the check is
	555	!-- performed for each grid point (not just for a vertical profile), in order to cover also
[4358]	556	!-- three-dimensional initialization. Note, this check gives an error only for the initial run not
	557	!-- for a restart run. In case there are no cloud physics considered, the mixing ratio can exceed
[4626]	558	!-- the saturation moisture. This case a warning is given.
[4505]	559	IF ( humidity .AND. .NOT. neutral .AND. check_realistic_q ) THEN
[4347]	560	DO i = nxl, nxr
	561	DO j = nys, nyn
	562	DO k = nzb+1, nzt
	563	!
	564	!-- Calculate actual temperature, water vapor saturation pressure, and based on this
	565	!-- the saturation mixing ratio.
	566	t_l = exner(k) * pt(k,j,i)
	567	e_s = magnus( t_l )
	568	q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
	569
[4757]	570	IF ( q(k,j,i) > 1.02_wp * q_s ) THEN
	571	realistic_q = .FALSE.
[4760]	572	rh_check = q(k,j,i) / q_s * 100.0_wp
[4757]	573	height = zu(k)
	574	ENDIF
[4347]	575	ENDDO
	576	ENDDO
	577	ENDDO
	578	!
[4626]	579	!-- Since the check is performed locally, merge the logical flag from all mpi ranks,
[4347]	580	!-- in order to do not print the error message multiple times.
	581	#if defined( __parallel )
	582	CALL MPI_ALLREDUCE( MPI_IN_PLACE, realistic_q, 1, MPI_LOGICAL, MPI_LAND, comm2d, ierr)
[4760]	583	CALL MPI_ALLREDUCE( rh_check, rh_min, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
[4757]	584	CALL MPI_ALLREDUCE( height, min_height, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
[4347]	585	#endif
	586
[4358]	587	IF ( .NOT. realistic_q .AND. &
	588	TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
[4757]	589	WRITE( message_string, * ) 'The initial mixing ratio exceeds the saturation mixing' // &
	590	'ratio, with rh =', rh_min, '% in a height of', min_height, 'm for the first time'
[4347]	591	CALL message( 'dynamic_init_checks', 'PA0697', 2, 2, 0, 6, 0 )
[4358]	592	ELSEIF ( .NOT. realistic_q .AND. &
	593	TRIM( initializing_actions ) == 'read_restart_data' ) THEN
[4757]	594	WRITE( message_string, * ) 'The initial mixing ratio exceeds the saturation mixing' // &
	595	'ratio, with rh =', rh_min, '% in a height of', min_height, 'm for the first time'
[4358]	596	CALL message( 'dynamic_init_checks', 'PA0697', 0, 1, 0, 6, 0 )
[4347]	597	ENDIF
	598	ENDIF
	599
[4047]	600	END SUBROUTINE dynamics_init_checks
	601
	602
	603	!--------------------------------------------------------------------------------------------------!
	604	! Description:
	605	! ------------
	606	!> Set the grids on which module-specific output quantities are defined. Allowed values for
	607	!> grid_x are "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw".
	608	!--------------------------------------------------------------------------------------------------!
	609	SUBROUTINE dynamics_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
	610
	611
	612	CHARACTER (LEN=*) :: grid_x !<
	613	CHARACTER (LEN=*) :: grid_y !<
	614	CHARACTER (LEN=*) :: grid_z !<
	615	CHARACTER (LEN=*) :: variable !<
	616
	617	LOGICAL :: found !<
	618
	619
	620	SELECT CASE ( TRIM( variable ) )
	621
	622	! CASE ( 'u2' )
	623
	624	CASE DEFAULT
	625	found = .FALSE.
	626	grid_x = 'none'
	627	grid_y = 'none'
	628	grid_z = 'none'
	629
	630	END SELECT
	631
	632
	633	END SUBROUTINE dynamics_define_netcdf_grid
	634
	635
	636	!--------------------------------------------------------------------------------------------------!
	637	! Description:
	638	! ------------
	639	!> Print a header with module-specific information.
	640	!--------------------------------------------------------------------------------------------------!
	641	SUBROUTINE dynamics_header( io )
	642
	643
[4851]	644	INTEGER(iwp) :: io !< output-file id
[4047]	645
	646	!
[4851]	647	!-- Write dynamics module header
	648	!-- NOTE: Deactivated because no relevant information to write so far
	649	IF ( .FALSE. ) WRITE ( io, 100 )
[4047]	650
	651	!
	652	!-- Format-descriptors
[4851]	653	100 FORMAT (//' Dynamics module information:'/ &
[4047]	654	' -----------------------------------'//)
	655
	656	END SUBROUTINE dynamics_header
	657
	658
	659	!--------------------------------------------------------------------------------------------------!
	660	! Description:
	661	! ------------
	662	!> Execute module-specific actions for all grid points
	663	!--------------------------------------------------------------------------------------------------!
	664	SUBROUTINE dynamics_actions( location )
	665
	666
	667	CHARACTER (LEN=*) :: location !<
	668
	669	! INTEGER(iwp) :: i !<
	670	! INTEGER(iwp) :: j !<
	671	! INTEGER(iwp) :: k !<
	672
	673	!
	674	!-- Here the user-defined actions follow
[4626]	675	!-- No calls for single grid points are allowed at locations before and after the timestep, since
	676	!-- these calls are not within an i,j-loop
[4047]	677	SELECT CASE ( location )
	678
	679	CASE ( 'before_timestep' )
	680
	681
	682	CASE ( 'before_prognostic_equations' )
	683
	684
	685	CASE ( 'after_integration' )
	686
	687
	688	CASE ( 'after_timestep' )
	689
	690
	691	CASE ( 'u-tendency' )
	692
	693
	694	CASE ( 'v-tendency' )
	695
	696
	697	CASE ( 'w-tendency' )
	698
	699
	700	CASE ( 'pt-tendency' )
	701
	702
	703	CASE ( 'sa-tendency' )
	704
	705
	706	CASE ( 'e-tendency' )
	707
	708
	709	CASE ( 'q-tendency' )
	710
	711
	712	CASE ( 's-tendency' )
	713
	714
	715	CASE DEFAULT
	716	CONTINUE
	717
	718	END SELECT
	719
	720	END SUBROUTINE dynamics_actions
	721
	722
	723	!--------------------------------------------------------------------------------------------------!
	724	! Description:
	725	! ------------
	726	!> Execute module-specific actions for grid point i,j
	727	!--------------------------------------------------------------------------------------------------!
	728	SUBROUTINE dynamics_actions_ij( i, j, location )
	729
	730
	731	CHARACTER (LEN=*) :: location
	732
	733	INTEGER(iwp) :: i
	734	INTEGER(iwp) :: j
	735
	736	!
	737	!-- Here the user-defined actions follow
	738	SELECT CASE ( location )
	739
	740	CASE ( 'u-tendency' )
	741
[4626]	742	!
[4047]	743	!-- Next line is to avoid compiler warning about unused variables. Please remove.
	744	IF ( i + j < 0 ) CONTINUE
	745
	746	CASE ( 'v-tendency' )
	747
	748
	749	CASE ( 'w-tendency' )
	750
	751
	752	CASE ( 'pt-tendency' )
	753
	754
	755	CASE ( 'sa-tendency' )
	756
	757
	758	CASE ( 'e-tendency' )
	759
	760
	761	CASE ( 'q-tendency' )
	762
	763
	764	CASE ( 's-tendency' )
	765
	766
	767	CASE DEFAULT
	768	CONTINUE
	769
	770	END SELECT
	771
	772	END SUBROUTINE dynamics_actions_ij
	773
	774
	775	!--------------------------------------------------------------------------------------------------!
	776	! Description:
	777	! ------------
	778	!> Compute module-specific non-advective processes for all grid points
	779	!--------------------------------------------------------------------------------------------------!
	780	SUBROUTINE dynamics_non_advective_processes
	781
	782
	783
	784	END SUBROUTINE dynamics_non_advective_processes
	785
	786
	787	!--------------------------------------------------------------------------------------------------!
	788	! Description:
	789	! ------------
	790	!> Compute module-specific non-advective processes for grid points i,j
	791	!--------------------------------------------------------------------------------------------------!
	792	SUBROUTINE dynamics_non_advective_processes_ij( i, j )
	793
	794
	795	INTEGER(iwp) :: i !<
	796	INTEGER(iwp) :: j !<
	797
	798	!
	799	!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
	800	IF ( i + j < 0 ) CONTINUE
	801
	802
	803	END SUBROUTINE dynamics_non_advective_processes_ij
	804
	805
	806	!--------------------------------------------------------------------------------------------------!
	807	! Description:
	808	! ------------
	809	!> Perform module-specific horizontal boundary exchange
	810	!--------------------------------------------------------------------------------------------------!
[4731]	811	SUBROUTINE dynamics_exchange_horiz( location )
[4047]	812
[4731]	813	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
[4047]	814
[4731]	815	SELECT CASE ( location )
[4047]	816
[4731]	817	CASE ( 'before_prognostic_equation' )
	818
	819	CASE ( 'after_prognostic_equation' )
	820
	821	CALL exchange_horiz( u_p, nbgp )
	822	CALL exchange_horiz( v_p, nbgp )
	823	CALL exchange_horiz( w_p, nbgp )
	824	CALL exchange_horiz( pt_p, nbgp )
	825	IF ( .NOT. constant_diffusion ) CALL exchange_horiz( e_p, nbgp )
	826	IF ( rans_tke_e ) CALL exchange_horiz( diss_p, nbgp )
	827	IF ( humidity ) CALL exchange_horiz( q_p, nbgp )
	828	IF ( passive_scalar ) CALL exchange_horiz( s_p, nbgp )
	829
	830	CASE ( 'after_anterpolation' )
	831
	832	CALL exchange_horiz( u, nbgp )
	833	CALL exchange_horiz( v, nbgp )
	834	CALL exchange_horiz( w, nbgp )
	835	IF ( .NOT. neutral ) CALL exchange_horiz( pt, nbgp )
	836	IF ( humidity ) CALL exchange_horiz( q, nbgp )
	837	IF ( passive_scalar ) CALL exchange_horiz( s, nbgp )
	838	IF ( .NOT. constant_diffusion ) CALL exchange_horiz( e, nbgp )
	839	IF ( .NOT. constant_diffusion .AND. rans_mode .AND. rans_tke_e ) THEN
	840	CALL exchange_horiz( diss, nbgp )
	841	ENDIF
	842
	843	END SELECT
	844
[4047]	845	END SUBROUTINE dynamics_exchange_horiz
	846
	847
	848	!--------------------------------------------------------------------------------------------------!
	849	! Description:
	850	! ------------
	851	!> Compute module-specific prognostic equations for all grid points
	852	!--------------------------------------------------------------------------------------------------!
	853	SUBROUTINE dynamics_prognostic_equations
	854
	855
	856
	857	END SUBROUTINE dynamics_prognostic_equations
	858
	859
	860	!--------------------------------------------------------------------------------------------------!
	861	! Description:
	862	! ------------
	863	!> Compute module-specific prognostic equations for grid point i,j
	864	!--------------------------------------------------------------------------------------------------!
	865	SUBROUTINE dynamics_prognostic_equations_ij( i, j, i_omp_start, tn )
	866
	867
	868	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
[4626]	869	INTEGER(iwp), INTENT(IN) :: i_omp_start !< first loop index of i-loop in prognostic_equations
[4047]	870	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
	871	INTEGER(iwp), INTENT(IN) :: tn !< task number of openmp task
	872
	873	!
	874	!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
	875	IF ( i + j + i_omp_start + tn < 0 ) CONTINUE
	876
	877	END SUBROUTINE dynamics_prognostic_equations_ij
	878
	879
[4281]	880	!--------------------------------------------------------------------------------------------------!
	881	! Description:
	882	! ------------
	883	!> Compute boundary conditions of dynamics model
	884	!--------------------------------------------------------------------------------------------------!
	885	SUBROUTINE dynamics_boundary_conditions
	886
	887	IMPLICIT NONE
	888
	889	INTEGER(iwp) :: i !< grid index x direction
	890	INTEGER(iwp) :: j !< grid index y direction
	891	INTEGER(iwp) :: k !< grid index z direction
	892	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
	893	INTEGER(iwp) :: m !< running index surface elements
	894
	895	!
	896	!-- Bottom boundary
	897	IF ( ibc_uv_b == 1 ) THEN
	898	u_p(nzb,:,:) = u_p(nzb+1,:,:)
	899	v_p(nzb,:,:) = v_p(nzb+1,:,:)
	900	ENDIF
	901	!
	902	!-- Set zero vertical velocity at topography top (l=0), or bottom (l=1) in case
	903	!-- of downward-facing surfaces.
	904	DO l = 0, 1
	905	!$OMP PARALLEL DO PRIVATE( i, j, k )
	906	!$ACC PARALLEL LOOP PRIVATE(i, j, k) &
	907	!$ACC PRESENT(bc_h, w_p)
	908	DO m = 1, bc_h(l)%ns
	909	i = bc_h(l)%i(m)
	910	j = bc_h(l)%j(m)
	911	k = bc_h(l)%k(m)
	912	w_p(k+bc_h(l)%koff,j,i) = 0.0_wp
	913	ENDDO
	914	ENDDO
	915
	916	!
	917	!-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings.
	918	IF ( ibc_uv_t == 0 ) THEN
	919	!$ACC KERNELS PRESENT(u_p, v_p, u_init, v_init)
	920	u_p(nzt+1,:,:) = u_init(nzt+1)
	921	v_p(nzt+1,:,:) = v_init(nzt+1)
	922	!$ACC END KERNELS
	923	ELSEIF ( ibc_uv_t == 1 ) THEN
	924	u_p(nzt+1,:,:) = u_p(nzt,:,:)
	925	v_p(nzt+1,:,:) = v_p(nzt,:,:)
	926	ENDIF
	927
	928	!
	929	!-- Vertical nesting: Vertical velocity not zero at the top of the fine grid
[4626]	930	IF ( .NOT. child_domain .AND. .NOT. nesting_offline .AND. &
	931	TRIM(coupling_mode) /= 'vnested_fine' ) THEN
[4281]	932	!$ACC KERNELS PRESENT(w_p)
	933	w_p(nzt:nzt+1,:,:) = 0.0_wp !< nzt is not a prognostic level (but cf. pres)
	934	!$ACC END KERNELS
	935	ENDIF
	936
	937	!
	938	!-- Temperature at bottom and top boundary.
[4626]	939	!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by the sea surface temperature
	940	!-- of the coupled ocean model.
[4281]	941	!-- Dirichlet
	942	IF ( .NOT. neutral ) THEN
	943	IF ( ibc_pt_b == 0 ) THEN
	944	DO l = 0, 1
	945	!$OMP PARALLEL DO PRIVATE( i, j, k )
	946	DO m = 1, bc_h(l)%ns
	947	i = bc_h(l)%i(m)
	948	j = bc_h(l)%j(m)
	949	k = bc_h(l)%k(m)
	950	pt_p(k+bc_h(l)%koff,j,i) = pt(k+bc_h(l)%koff,j,i)
	951	ENDDO
	952	ENDDO
	953	!
	954	!-- Neumann, zero-gradient
	955	ELSEIF ( ibc_pt_b == 1 ) THEN
	956	DO l = 0, 1
	957	!$OMP PARALLEL DO PRIVATE( i, j, k )
	958	!$ACC PARALLEL LOOP PRIVATE(i, j, k) &
	959	!$ACC PRESENT(bc_h, pt_p)
	960	DO m = 1, bc_h(l)%ns
	961	i = bc_h(l)%i(m)
	962	j = bc_h(l)%j(m)
	963	k = bc_h(l)%k(m)
	964	pt_p(k+bc_h(l)%koff,j,i) = pt_p(k,j,i)
	965	ENDDO
	966	ENDDO
	967	ENDIF
	968
	969	!
	970	!-- Temperature at top boundary
	971	IF ( ibc_pt_t == 0 ) THEN
	972	pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
	973	!
	974	!-- In case of nudging adjust top boundary to pt which is
	975	!-- read in from NUDGING-DATA
	976	IF ( nudging ) THEN
	977	pt_p(nzt+1,:,:) = pt_init(nzt+1)
	978	ENDIF
	979	ELSEIF ( ibc_pt_t == 1 ) THEN
	980	pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
	981	ELSEIF ( ibc_pt_t == 2 ) THEN
	982	!$ACC KERNELS PRESENT(pt_p, dzu)
	983	pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
	984	!$ACC END KERNELS
	985	ENDIF
	986	ENDIF
	987	!
[4626]	988	!-- Boundary conditions for total water content, bottom and top boundary (see also temperature)
[4281]	989	IF ( humidity ) THEN
	990	!
	991	!-- Surface conditions for constant_humidity_flux
[4626]	992	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
	993	!-- belongs to the atmospheric grid point, therefore, set q_p at k-1
[4281]	994	IF ( ibc_q_b == 0 ) THEN
	995
	996	DO l = 0, 1
	997	!$OMP PARALLEL DO PRIVATE( i, j, k )
	998	DO m = 1, bc_h(l)%ns
	999	i = bc_h(l)%i(m)
	1000	j = bc_h(l)%j(m)
	1001	k = bc_h(l)%k(m)
	1002	q_p(k+bc_h(l)%koff,j,i) = q(k+bc_h(l)%koff,j,i)
	1003	ENDDO
	1004	ENDDO
	1005
	1006	ELSE
	1007
	1008	DO l = 0, 1
	1009	!$OMP PARALLEL DO PRIVATE( i, j, k )
	1010	DO m = 1, bc_h(l)%ns
	1011	i = bc_h(l)%i(m)
	1012	j = bc_h(l)%j(m)
	1013	k = bc_h(l)%k(m)
	1014	q_p(k+bc_h(l)%koff,j,i) = q_p(k,j,i)
	1015	ENDDO
	1016	ENDDO
	1017	ENDIF
	1018	!
	1019	!-- Top boundary
	1020	IF ( ibc_q_t == 0 ) THEN
	1021	q_p(nzt+1,:,:) = q(nzt+1,:,:)
	1022	ELSEIF ( ibc_q_t == 1 ) THEN
	1023	q_p(nzt+1,:,:) = q_p(nzt,:,:) + bc_q_t_val * dzu(nzt+1)
	1024	ENDIF
	1025	ENDIF
	1026	!
[4626]	1027	!-- Boundary conditions for scalar, bottom and top boundary (see also temperature)
[4281]	1028	IF ( passive_scalar ) THEN
	1029	!
	1030	!-- Surface conditions for constant_humidity_flux
[4626]	1031	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
	1032	!-- belongs to the atmospheric grid point, therefore, set s_p at k-1
[4281]	1033	IF ( ibc_s_b == 0 ) THEN
	1034
	1035	DO l = 0, 1
	1036	!$OMP PARALLEL DO PRIVATE( i, j, k )
	1037	DO m = 1, bc_h(l)%ns
	1038	i = bc_h(l)%i(m)
	1039	j = bc_h(l)%j(m)
	1040	k = bc_h(l)%k(m)
	1041	s_p(k+bc_h(l)%koff,j,i) = s(k+bc_h(l)%koff,j,i)
	1042	ENDDO
	1043	ENDDO
	1044
	1045	ELSE
	1046
	1047	DO l = 0, 1
	1048	!$OMP PARALLEL DO PRIVATE( i, j, k )
	1049	DO m = 1, bc_h(l)%ns
	1050	i = bc_h(l)%i(m)
	1051	j = bc_h(l)%j(m)
	1052	k = bc_h(l)%k(m)
	1053	s_p(k+bc_h(l)%koff,j,i) = s_p(k,j,i)
	1054	ENDDO
	1055	ENDDO
	1056	ENDIF
	1057	!
	1058	!-- Top boundary condition
	1059	IF ( ibc_s_t == 0 ) THEN
	1060	s_p(nzt+1,:,:) = s(nzt+1,:,:)
	1061	ELSEIF ( ibc_s_t == 1 ) THEN
	1062	s_p(nzt+1,:,:) = s_p(nzt,:,:)
	1063	ELSEIF ( ibc_s_t == 2 ) THEN
	1064	s_p(nzt+1,:,:) = s_p(nzt,:,:) + bc_s_t_val * dzu(nzt+1)
	1065	ENDIF
	1066
	1067	ENDIF
	1068	!
[4626]	1069	!-- In case of inflow or nest boundary at the south boundary the boundary for v is at nys and in
	1070	!-- case of inflow or nest boundary at the left boundary the boundary for u is at nxl. Since in
	1071	!-- prognostic_equations (cache optimized version) these levels are handled as a prognostic level,
	1072	!-- boundary values have to be restored here.
[4281]	1073	IF ( bc_dirichlet_s ) THEN
	1074	v_p(:,nys,:) = v_p(:,nys-1,:)
	1075	ELSEIF ( bc_dirichlet_l ) THEN
	1076	u_p(:,:,nxl) = u_p(:,:,nxl-1)
	1077	ENDIF
	1078
	1079	!
[4626]	1080	!-- The same restoration for u at i=nxl and v at j=nys as above must be made in case of nest
	1081	!-- boundaries. This must not be done in case of vertical nesting mode as in that case the lateral
	1082	!-- boundaries are actually cyclic.
	1083	!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
[4281]	1084	IF ( nesting_mode /= 'vertical' .OR. nesting_offline ) THEN
	1085	IF ( bc_dirichlet_s ) THEN
	1086	v_p(:,nys,:) = v_p(:,nys-1,:)
	1087	ENDIF
	1088	IF ( bc_dirichlet_l ) THEN
	1089	u_p(:,:,nxl) = u_p(:,:,nxl-1)
	1090	ENDIF
	1091	ENDIF
	1092
	1093	!
	1094	!-- Lateral boundary conditions for scalar quantities at the outflow.
[4626]	1095	!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
[4281]	1096	IF ( bc_radiation_s ) THEN
	1097	pt_p(:,nys-1,:) = pt_p(:,nys,:)
	1098	IF ( humidity ) THEN
	1099	q_p(:,nys-1,:) = q_p(:,nys,:)
	1100	ENDIF
	1101	IF ( passive_scalar ) s_p(:,nys-1,:) = s_p(:,nys,:)
	1102	ELSEIF ( bc_radiation_n ) THEN
	1103	pt_p(:,nyn+1,:) = pt_p(:,nyn,:)
	1104	IF ( humidity ) THEN
	1105	q_p(:,nyn+1,:) = q_p(:,nyn,:)
	1106	ENDIF
	1107	IF ( passive_scalar ) s_p(:,nyn+1,:) = s_p(:,nyn,:)
	1108	ELSEIF ( bc_radiation_l ) THEN
	1109	pt_p(:,:,nxl-1) = pt_p(:,:,nxl)
	1110	IF ( humidity ) THEN
	1111	q_p(:,:,nxl-1) = q_p(:,:,nxl)
	1112	ENDIF
	1113	IF ( passive_scalar ) s_p(:,:,nxl-1) = s_p(:,:,nxl)
	1114	ELSEIF ( bc_radiation_r ) THEN
	1115	pt_p(:,:,nxr+1) = pt_p(:,:,nxr)
	1116	IF ( humidity ) THEN
	1117	q_p(:,:,nxr+1) = q_p(:,:,nxr)
	1118	ENDIF
	1119	IF ( passive_scalar ) s_p(:,:,nxr+1) = s_p(:,:,nxr)
	1120	ENDIF
	1121
	1122	!
	1123	!-- Radiation boundary conditions for the velocities at the respective outflow.
[4845]	1124	!-- The phase velocity is set to the maximum phase velocity that ensures numerical
	1125	!-- stability (CFL-condition), i.e. a Courant number of one is assumed.
[4281]	1126	IF ( bc_radiation_s ) THEN
[4845]	1127	u_p(:,-1,:) = u(:,0,:)
	1128	v_p(:,0,:) = v(:,1,:)
	1129	w_p(:,-1,:) = w(:,0,:)
[4281]	1130	ENDIF
	1131
	1132	IF ( bc_radiation_n ) THEN
[4845]	1133	u_p(:,ny+1,:) = u(:,ny,:)
	1134	v_p(:,ny+1,:) = v(:,ny,:)
	1135	w_p(:,ny+1,:) = w(:,ny,:)
[4281]	1136	ENDIF
	1137
	1138	IF ( bc_radiation_l ) THEN
[4845]	1139	u_p(:,:,0) = u(:,:,1)
	1140	v_p(:,:,-1) = v(:,:,0)
	1141	w_p(:,:,-1) = w(:,:,0)
[4281]	1142	ENDIF
	1143
	1144	IF ( bc_radiation_r ) THEN
[4845]	1145	u_p(:,:,nx+1) = u(:,:,nx)
	1146	v_p(:,:,nx+1) = v(:,:,nx)
	1147	w_p(:,:,nx+1) = w(:,:,nx)
	1148	ENDIF
[4281]	1149
[4845]	1150	END SUBROUTINE dynamics_boundary_conditions
[4281]	1151
	1152
[4626]	1153	!--------------------------------------------------------------------------------------------------!
[4047]	1154	! Description:
	1155	! ------------
	1156	!> Swap timelevels of module-specific array pointers
[4626]	1157	!--------------------------------------------------------------------------------------------------!
[4047]	1158	SUBROUTINE dynamics_swap_timelevel ( mod_count )
	1159
	1160
	1161	INTEGER, INTENT(IN) :: mod_count
	1162
	1163
	1164	SELECT CASE ( mod_count )
	1165
	1166	CASE ( 0 )
	1167
	1168	u => u_1; u_p => u_2
	1169	v => v_1; v_p => v_2
	1170	w => w_1; w_p => w_2
	1171	IF ( .NOT. neutral ) THEN
	1172	pt => pt_1; pt_p => pt_2
	1173	ENDIF
	1174	IF ( humidity ) THEN
	1175	q => q_1; q_p => q_2
	1176	ENDIF
	1177	IF ( passive_scalar ) THEN
	1178	s => s_1; s_p => s_2
	1179	ENDIF
	1180
	1181	CASE ( 1 )
	1182
	1183	u => u_2; u_p => u_1
	1184	v => v_2; v_p => v_1
	1185	w => w_2; w_p => w_1
	1186	IF ( .NOT. neutral ) THEN
	1187	pt => pt_2; pt_p => pt_1
	1188	ENDIF
	1189	IF ( humidity ) THEN
	1190	q => q_2; q_p => q_1
	1191	ENDIF
	1192	IF ( passive_scalar ) THEN
	1193	s => s_2; s_p => s_1
	1194	ENDIF
	1195
	1196	END SELECT
	1197
	1198	END SUBROUTINE dynamics_swap_timelevel
	1199
	1200
	1201	!--------------------------------------------------------------------------------------------------!
	1202	! Description:
	1203	! ------------
[4626]	1204	!> Sum up and time-average module-specific output quantities as well as allocate the array necessary
	1205	!> for storing the average.
[4047]	1206	!--------------------------------------------------------------------------------------------------!
	1207	SUBROUTINE dynamics_3d_data_averaging( mode, variable )
	1208
	1209
	1210	CHARACTER (LEN=*) :: mode !<
	1211	CHARACTER (LEN=*) :: variable !<
	1212
	1213
	1214	IF ( mode == 'allocate' ) THEN
	1215
	1216	SELECT CASE ( TRIM( variable ) )
	1217
	1218	! CASE ( 'u2' )
	1219
	1220	CASE DEFAULT
	1221	CONTINUE
	1222
	1223	END SELECT
	1224
	1225	ELSEIF ( mode == 'sum' ) THEN
	1226
	1227	SELECT CASE ( TRIM( variable ) )
	1228
	1229	! CASE ( 'u2' )
	1230
	1231	CASE DEFAULT
	1232	CONTINUE
	1233
	1234	END SELECT
	1235
	1236	ELSEIF ( mode == 'average' ) THEN
	1237
	1238	SELECT CASE ( TRIM( variable ) )
	1239
	1240	! CASE ( 'u2' )
	1241
	1242	END SELECT
	1243
	1244	ENDIF
	1245
	1246	END SUBROUTINE dynamics_3d_data_averaging
	1247
	1248
	1249	!--------------------------------------------------------------------------------------------------!
	1250	! Description:
	1251	! ------------
[4626]	1252	!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
	1253	!> indices (i,j,k) and sets the grid on which it is defined.
[4047]	1254	!> Allowed values for grid are "zu" and "zw".
	1255	!--------------------------------------------------------------------------------------------------!
[4626]	1256	SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, &
	1257	nzt_do, fill_value )
[4047]	1258
	1259
[4626]	1260	CHARACTER (LEN=*) :: grid !<
[4047]	1261	CHARACTER (LEN=*), INTENT(IN) :: mode !< either 'xy', 'xz' or 'yz'
[4626]	1262	CHARACTER (LEN=*) :: variable !<
[4047]	1263
	1264	INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data
	1265	! INTEGER(iwp) :: i !< grid index along x-direction
	1266	! INTEGER(iwp) :: j !< grid index along y-direction
	1267	! INTEGER(iwp) :: k !< grid index along z-direction
	1268	! INTEGER(iwp) :: m !< running index surface elements
	1269	INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb)
	1270	INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1)
	1271
	1272	LOGICAL :: found !<
	1273	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
	1274
	1275	REAL(wp), INTENT(IN) :: fill_value
	1276
	1277	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
	1278
	1279	!
	1280	!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
	1281	IF ( two_d .AND. av + LEN( mode ) + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 ) CONTINUE
	1282
	1283	found = .TRUE.
	1284
	1285	SELECT CASE ( TRIM( variable ) )
	1286
	1287	! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
	1288
	1289	CASE DEFAULT
	1290	found = .FALSE.
	1291	grid = 'none'
	1292
	1293	END SELECT
	1294
	1295
	1296	END SUBROUTINE dynamics_data_output_2d
	1297
	1298
	1299	!--------------------------------------------------------------------------------------------------!
	1300	! Description:
	1301	! ------------
[4626]	1302	!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
	1303	!> indices (i,j,k).
[4047]	1304	!--------------------------------------------------------------------------------------------------!
	1305	SUBROUTINE dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
	1306
	1307
	1308	CHARACTER (LEN=*) :: variable !<
	1309
	1310	INTEGER(iwp) :: av !<
	1311	! INTEGER(iwp) :: i !<
	1312	! INTEGER(iwp) :: j !<
	1313	! INTEGER(iwp) :: k !<
	1314	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
	1315	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
	1316
	1317	LOGICAL :: found !<
	1318
	1319	REAL(wp), INTENT(IN) :: fill_value !< value for the _FillValue attribute
	1320
[4768]	1321	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
[4047]	1322
	1323	!
	1324	!-- Next line is to avoid compiler warning about unused variables. Please remove.
	1325	IF ( av + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 ) CONTINUE
	1326
	1327
	1328	found = .TRUE.
	1329
	1330	SELECT CASE ( TRIM( variable ) )
	1331
	1332	! CASE ( 'u2' )
	1333
	1334	CASE DEFAULT
	1335	found = .FALSE.
	1336
	1337	END SELECT
	1338
	1339
	1340	END SUBROUTINE dynamics_data_output_3d
	1341
	1342
	1343	!--------------------------------------------------------------------------------------------------!
	1344	! Description:
	1345	! ------------
	1346	!> Calculation of module-specific statistics, i.e. horizontally averaged profiles and time series.
	1347	!> This is called for every statistic region sr, but at least for the region "total domain" (sr=0).
	1348	!--------------------------------------------------------------------------------------------------!
	1349	SUBROUTINE dynamics_statistics( mode, sr, tn )
	1350
	1351
	1352	CHARACTER (LEN=*) :: mode !<
	1353	! INTEGER(iwp) :: i !<
	1354	! INTEGER(iwp) :: j !<
	1355	! INTEGER(iwp) :: k !<
	1356	INTEGER(iwp) :: sr !<
	1357	INTEGER(iwp) :: tn !<
	1358
	1359	!
	1360	!-- Next line is to avoid compiler warning about unused variables. Please remove.
	1361	IF ( sr == 0 .OR. tn == 0 ) CONTINUE
	1362
	1363	IF ( mode == 'profiles' ) THEN
	1364
	1365	ELSEIF ( mode == 'time_series' ) THEN
	1366
	1367	ENDIF
	1368
	1369	END SUBROUTINE dynamics_statistics
	1370
	1371
	1372	!--------------------------------------------------------------------------------------------------!
	1373	! Description:
	1374	! ------------
[4495]	1375	!> Read module-specific global restart data (Fortran binary format).
[4047]	1376	!--------------------------------------------------------------------------------------------------!
[4495]	1377	SUBROUTINE dynamics_rrd_global_ftn( found )
[4047]	1378
	1379	LOGICAL, INTENT(OUT) :: found
	1380
	1381
	1382	found = .TRUE.
	1383
	1384
	1385	SELECT CASE ( restart_string(1:length) )
	1386
	1387	CASE ( 'global_paramter' )
	1388	! READ ( 13 ) global_parameter
	1389
	1390	CASE DEFAULT
	1391
	1392	found = .FALSE.
	1393
	1394	END SELECT
	1395
	1396
[4495]	1397	END SUBROUTINE dynamics_rrd_global_ftn
[4047]	1398
	1399
	1400	!--------------------------------------------------------------------------------------------------!
	1401	! Description:
	1402	! ------------
[4495]	1403	!> Read module-specific global restart data (MPI-IO).
	1404	!--------------------------------------------------------------------------------------------------!
	1405	SUBROUTINE dynamics_rrd_global_mpi
	1406
	1407	! CALL rrd_mpi_io( 'global_parameter', global_parameter )
	1408	CONTINUE
	1409
	1410	END SUBROUTINE dynamics_rrd_global_mpi
	1411
	1412
	1413	!--------------------------------------------------------------------------------------------------!
	1414	! Description:
	1415	! ------------
[4517]	1416	!> Read module-specific local restart data arrays (Fortran binary format).
[4047]	1417	!> Subdomain index limits on file are given by nxl_on_file, etc.
	1418	!> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the subdomain on file (f)
	1419	!> to the subdomain of the current PE (c). They have been calculated in routine rrd_local.
	1420	!--------------------------------------------------------------------------------------------------!
[4626]	1421	SUBROUTINE dynamics_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, &
	1422	nync, nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, &
	1423	found )
[4047]	1424
	1425
	1426	INTEGER(iwp) :: k !<
	1427	INTEGER(iwp) :: nxlc !<
	1428	INTEGER(iwp) :: nxlf !<
	1429	INTEGER(iwp) :: nxl_on_file !<
	1430	INTEGER(iwp) :: nxrc !<
	1431	INTEGER(iwp) :: nxrf !<
	1432	INTEGER(iwp) :: nxr_on_file !<
	1433	INTEGER(iwp) :: nync !<
	1434	INTEGER(iwp) :: nynf !<
	1435	INTEGER(iwp) :: nyn_on_file !<
	1436	INTEGER(iwp) :: nysc !<
	1437	INTEGER(iwp) :: nysf !<
	1438	INTEGER(iwp) :: nys_on_file !<
	1439
	1440	LOGICAL, INTENT(OUT) :: found
	1441
	1442	REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !<
	1443	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
	1444
	1445	!
	1446	!-- Next line is to avoid compiler warning about unused variables. Please remove.
[4626]	1447	IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf + &
	1448	tmp_2d(nys_on_file,nxl_on_file) + &
[4097]	1449	tmp_3d(nzb,nys_on_file,nxl_on_file) < 0.0 ) CONTINUE
[4047]	1450	!
	1451	!-- Here the reading of user-defined restart data follows:
	1452	!-- Sample for user-defined output
	1453
	1454	found = .TRUE.
	1455
	1456	SELECT CASE ( restart_string(1:length) )
	1457
	1458	! CASE ( 'u2_av' )
	1459
	1460	CASE DEFAULT
	1461
	1462	found = .FALSE.
	1463
	1464	END SELECT
	1465
[4517]	1466	END SUBROUTINE dynamics_rrd_local_ftn
[4047]	1467
	1468
	1469	!--------------------------------------------------------------------------------------------------!
	1470	! Description:
	1471	! ------------
[4517]	1472	!> Read module-specific local restart data arrays (MPI-IO).
	1473	!--------------------------------------------------------------------------------------------------!
	1474	SUBROUTINE dynamics_rrd_local_mpi
	1475
	1476	IMPLICIT NONE
	1477
	1478	! LOGICAL :: array_found !<
	1479
	1480
	1481	! CALL rd_mpi_io_check_array( 'u2_av' , found = array_found )
	1482	! IF ( array_found ) THEN
	1483	! IF ( .NOT. ALLOCATED( u2_av ) ) ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	1484	! CALL rrd_mpi_io( 'u2_av', u2_av )
	1485	! ENDIF
	1486
	1487	CONTINUE
	1488
	1489	END SUBROUTINE dynamics_rrd_local_mpi
	1490
	1491
	1492
	1493	!--------------------------------------------------------------------------------------------------!
	1494	! Description:
	1495	! ------------
[4047]	1496	!> Writes global module-specific restart data into binary file(s) for restart runs.
	1497	!--------------------------------------------------------------------------------------------------!
	1498	SUBROUTINE dynamics_wrd_global
	1499
	1500
	1501	END SUBROUTINE dynamics_wrd_global
	1502
	1503
	1504	!--------------------------------------------------------------------------------------------------!
	1505	! Description:
	1506	! ------------
	1507	!> Writes processor specific and module-specific restart data into binary file(s) for restart runs.
	1508	!--------------------------------------------------------------------------------------------------!
	1509	SUBROUTINE dynamics_wrd_local
	1510
	1511
	1512	END SUBROUTINE dynamics_wrd_local
	1513
	1514
	1515	!--------------------------------------------------------------------------------------------------!
	1516	! Description:
	1517	! ------------
	1518	!> Execute module-specific actions at the very end of the program.
	1519	!--------------------------------------------------------------------------------------------------!
	1520	SUBROUTINE dynamics_last_actions
	1521
	1522
	1523	END SUBROUTINE dynamics_last_actions
	1524
[4627]	1525	END MODULE dynamics_mod

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

Context Navigation

source: palm/trunk/SOURCE/dynamics_mod.f90 @ 4856

Download in other formats: