Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |