Home

Context Navigation

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

Last change on this file since 4347 was 4347, checked in by suehring, 4 years ago
Check for realistically initial values of mixing ratio implemented. Mixing ratio must not exceed its saturation value, else surface fluxes in the land-surface scheme may become unrealistic. Test cases updated
Property svn:keywords set to `Id`
File size: 58.5 KB

Line
1	!> @file dynamics_mod.f90
2	!--------------------------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2019 Leibniz Universitaet Hannover
18	!--------------------------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: dynamics_mod.f90 4347 2019-12-18 13:18:33Z suehring $
27	! Implement post-initialization check for realistically inital values of mixing ratio
28	!
29	! 4281 2019-10-29 15:15:39Z schwenkel
30	! Moved boundary conditions in dynamics module
31	!
32	! 4097 2019-07-15 11:59:11Z suehring
33	! Avoid overlong lines - limit is 132 characters per line
34	!
35	! 4047 2019-06-21 18:58:09Z knoop
36	! Initial introduction of the dynamics module with only dynamics_swap_timelevel implemented
37	!
38	!
39	! Description:
40	! ------------
41	!> This module contains the dynamics of PALM.
42	!--------------------------------------------------------------------------------------------------!
43	MODULE dynamics_mod
44
45
46	USE arrays_3d, &
47	ONLY: c_u, c_u_m, c_u_m_l, c_v, c_v_m, c_v_m_l, c_w, c_w_m, c_w_m_l, &
48	dzu, &
49	exner, &
50	hyp, &
51	pt, pt_1, pt_2, pt_init, pt_p, &
52	q, q_1, q_2, q_p, &
53	s, s_1, s_2, s_p, &
54	u, u_1, u_2, u_init, u_p, u_m_l, u_m_n, u_m_r, u_m_s, &
55	v, v_1, v_2, v_p, v_init, v_m_l, v_m_n, v_m_r, v_m_s, &
56	w, w_1, w_2, w_p, w_m_l, w_m_n, w_m_r, w_m_s
57
58	USE basic_constants_and_equations_mod, &
59	ONLY: magnus, &
60	rd_d_rv
61
62	USE control_parameters, &
63	ONLY: bc_dirichlet_l, &
64	bc_dirichlet_s, &
65	bc_radiation_l, &
66	bc_radiation_n, &
67	bc_radiation_r, &
68	bc_radiation_s, &
69	bc_pt_t_val, &
70	bc_q_t_val, &
71	bc_s_t_val, &
72	child_domain, &
73	coupling_mode, &
74	dt_3d, &
75	ibc_pt_b, &
76	ibc_pt_t, &
77	ibc_q_b, &
78	ibc_q_t, &
79	ibc_s_b, &
80	ibc_s_t, &
81	ibc_uv_b, &
82	ibc_uv_t, &
83	intermediate_timestep_count, &
84	length, &
85	message_string, &
86	nesting_offline, &
87	nudging, &
88	restart_string, &
89	humidity, &
90	neutral, &
91	passive_scalar, &
92	tsc, &
93	use_cmax
94
95	USE grid_variables, &
96	ONLY: ddx, &
97	ddy, &
98	dx, &
99	dy
100
101	USE indices, &
102	ONLY: nbgp, &
103	nx, &
104	nxl, &
105	nxlg, &
106	nxr, &
107	nxrg, &
108	ny, &
109	nys, &
110	nysg, &
111	nyn, &
112	nyng, &
113	nzb, &
114	nzt
115
116	USE kinds
117
118	USE pegrid
119
120	USE pmc_interface, &
121	ONLY : nesting_mode
122
123	USE surface_mod, &
124	ONLY : bc_h
125
126
127	IMPLICIT NONE
128
129	LOGICAL :: dynamics_module_enabled = .FALSE. !<
130
131	SAVE
132
133	PRIVATE
134
135	!
136	!-- Public functions
137	PUBLIC &
138	dynamics_parin, &
139	dynamics_check_parameters, &
140	dynamics_check_data_output_ts, &
141	dynamics_check_data_output_pr, &
142	dynamics_check_data_output, &
143	dynamics_init_masks, &
144	dynamics_define_netcdf_grid, &
145	dynamics_init_arrays, &
146	dynamics_init, &
147	dynamics_init_checks, &
148	dynamics_header, &
149	dynamics_actions, &
150	dynamics_non_advective_processes, &
151	dynamics_exchange_horiz, &
152	dynamics_prognostic_equations, &
153	dynamics_boundary_conditions, &
154	dynamics_swap_timelevel, &
155	dynamics_3d_data_averaging, &
156	dynamics_data_output_2d, &
157	dynamics_data_output_3d, &
158	dynamics_statistics, &
159	dynamics_rrd_global, &
160	dynamics_rrd_local, &
161	dynamics_wrd_global, &
162	dynamics_wrd_local, &
163	dynamics_last_actions
164
165	!
166	!-- Public parameters, constants and initial values
167	PUBLIC &
168	dynamics_module_enabled
169
170	INTERFACE dynamics_parin
171	MODULE PROCEDURE dynamics_parin
172	END INTERFACE dynamics_parin
173
174	INTERFACE dynamics_check_parameters
175	MODULE PROCEDURE dynamics_check_parameters
176	END INTERFACE dynamics_check_parameters
177
178	INTERFACE dynamics_check_data_output_ts
179	MODULE PROCEDURE dynamics_check_data_output_ts
180	END INTERFACE dynamics_check_data_output_ts
181
182	INTERFACE dynamics_check_data_output_pr
183	MODULE PROCEDURE dynamics_check_data_output_pr
184	END INTERFACE dynamics_check_data_output_pr
185
186	INTERFACE dynamics_check_data_output
187	MODULE PROCEDURE dynamics_check_data_output
188	END INTERFACE dynamics_check_data_output
189
190	INTERFACE dynamics_init_masks
191	MODULE PROCEDURE dynamics_init_masks
192	END INTERFACE dynamics_init_masks
193
194	INTERFACE dynamics_define_netcdf_grid
195	MODULE PROCEDURE dynamics_define_netcdf_grid
196	END INTERFACE dynamics_define_netcdf_grid
197
198	INTERFACE dynamics_init_arrays
199	MODULE PROCEDURE dynamics_init_arrays
200	END INTERFACE dynamics_init_arrays
201
202	INTERFACE dynamics_init
203	MODULE PROCEDURE dynamics_init
204	END INTERFACE dynamics_init
205
206	INTERFACE dynamics_init_checks
207	MODULE PROCEDURE dynamics_init_checks
208	END INTERFACE dynamics_init_checks
209
210	INTERFACE dynamics_header
211	MODULE PROCEDURE dynamics_header
212	END INTERFACE dynamics_header
213
214	INTERFACE dynamics_actions
215	MODULE PROCEDURE dynamics_actions
216	MODULE PROCEDURE dynamics_actions_ij
217	END INTERFACE dynamics_actions
218
219	INTERFACE dynamics_non_advective_processes
220	MODULE PROCEDURE dynamics_non_advective_processes
221	MODULE PROCEDURE dynamics_non_advective_processes_ij
222	END INTERFACE dynamics_non_advective_processes
223
224	INTERFACE dynamics_exchange_horiz
225	MODULE PROCEDURE dynamics_exchange_horiz
226	END INTERFACE dynamics_exchange_horiz
227
228	INTERFACE dynamics_prognostic_equations
229	MODULE PROCEDURE dynamics_prognostic_equations
230	MODULE PROCEDURE dynamics_prognostic_equations_ij
231	END INTERFACE dynamics_prognostic_equations
232
233	INTERFACE dynamics_boundary_conditions
234	MODULE PROCEDURE dynamics_boundary_conditions
235	END INTERFACE dynamics_boundary_conditions
236
237	INTERFACE dynamics_swap_timelevel
238	MODULE PROCEDURE dynamics_swap_timelevel
239	END INTERFACE dynamics_swap_timelevel
240
241	INTERFACE dynamics_3d_data_averaging
242	MODULE PROCEDURE dynamics_3d_data_averaging
243	END INTERFACE dynamics_3d_data_averaging
244
245	INTERFACE dynamics_data_output_2d
246	MODULE PROCEDURE dynamics_data_output_2d
247	END INTERFACE dynamics_data_output_2d
248
249	INTERFACE dynamics_data_output_3d
250	MODULE PROCEDURE dynamics_data_output_3d
251	END INTERFACE dynamics_data_output_3d
252
253	INTERFACE dynamics_statistics
254	MODULE PROCEDURE dynamics_statistics
255	END INTERFACE dynamics_statistics
256
257	INTERFACE dynamics_rrd_global
258	MODULE PROCEDURE dynamics_rrd_global
259	END INTERFACE dynamics_rrd_global
260
261	INTERFACE dynamics_rrd_local
262	MODULE PROCEDURE dynamics_rrd_local
263	END INTERFACE dynamics_rrd_local
264
265	INTERFACE dynamics_wrd_global
266	MODULE PROCEDURE dynamics_wrd_global
267	END INTERFACE dynamics_wrd_global
268
269	INTERFACE dynamics_wrd_local
270	MODULE PROCEDURE dynamics_wrd_local
271	END INTERFACE dynamics_wrd_local
272
273	INTERFACE dynamics_last_actions
274	MODULE PROCEDURE dynamics_last_actions
275	END INTERFACE dynamics_last_actions
276
277
278	CONTAINS
279
280
281	!--------------------------------------------------------------------------------------------------!
282	! Description:
283	! ------------
284	!> Read module-specific namelist
285	!--------------------------------------------------------------------------------------------------!
286	SUBROUTINE dynamics_parin
287
288
289	CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file
290
291	NAMELIST /dynamics_parameters/ &
292	dynamics_module_enabled
293
294	line = ' '
295	!
296	!-- Try to find module-specific namelist
297	REWIND ( 11 )
298	line = ' '
299	DO WHILE ( INDEX( line, '&dynamics_parameters' ) == 0 )
300	READ ( 11, '(A)', END=12 ) line
301	ENDDO
302	BACKSPACE ( 11 )
303
304	!-- Set default module switch to true
305	dynamics_module_enabled = .TRUE.
306
307	!-- Read user-defined namelist
308	READ ( 11, dynamics_parameters, ERR = 10 )
309
310	GOTO 12
311
312	10 BACKSPACE( 11 )
313	READ( 11 , '(A)') line
314	CALL parin_fail_message( 'dynamics_parameters', line )
315
316	12 CONTINUE
317
318	END SUBROUTINE dynamics_parin
319
320
321	!--------------------------------------------------------------------------------------------------!
322	! Description:
323	! ------------
324	!> Check control parameters and deduce further quantities.
325	!--------------------------------------------------------------------------------------------------!
326	SUBROUTINE dynamics_check_parameters
327
328
329	END SUBROUTINE dynamics_check_parameters
330
331
332	!--------------------------------------------------------------------------------------------------!
333	! Description:
334	! ------------
335	!> Set module-specific timeseries units and labels
336	!--------------------------------------------------------------------------------------------------!
337	SUBROUTINE dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
338
339
340	INTEGER(iwp), INTENT(IN) :: dots_max
341	INTEGER(iwp), INTENT(INOUT) :: dots_num
342	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
343	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
344
345	!
346	!-- Next line is to avoid compiler warning about unused variables. Please remove.
347	IF ( dots_num == 0 .OR. dots_label(1)(1:1) == ' ' .OR. dots_unit(1)(1:1) == ' ' ) CONTINUE
348
349
350	END SUBROUTINE dynamics_check_data_output_ts
351
352
353	!--------------------------------------------------------------------------------------------------!
354	! Description:
355	! ------------
356	!> Set the unit of module-specific profile output quantities. For those variables not recognized,
357	!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
358	!> is not defined and leads to a program abort.
359	!--------------------------------------------------------------------------------------------------!
360	SUBROUTINE dynamics_check_data_output_pr( variable, var_count, unit, dopr_unit )
361
362
363	CHARACTER (LEN=*) :: unit !<
364	CHARACTER (LEN=*) :: variable !<
365	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
366
367	INTEGER(iwp) :: var_count !<
368
369	!
370	!-- Next line is to avoid compiler warning about unused variables. Please remove.
371	IF ( unit(1:1) == ' ' .OR. dopr_unit(1:1) == ' ' .OR. var_count == 0 ) CONTINUE
372
373	SELECT CASE ( TRIM( variable ) )
374
375	! CASE ( 'var_name' )
376
377	CASE DEFAULT
378	unit = 'illegal'
379
380	END SELECT
381
382
383	END SUBROUTINE dynamics_check_data_output_pr
384
385
386	!--------------------------------------------------------------------------------------------------!
387	! Description:
388	! ------------
389	!> Set the unit of module-specific output quantities. For those variables not recognized,
390	!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
391	!< is not defined and leads to a program abort.
392	!--------------------------------------------------------------------------------------------------!
393	SUBROUTINE dynamics_check_data_output( variable, unit )
394
395
396	CHARACTER (LEN=*) :: unit !<
397	CHARACTER (LEN=*) :: variable !<
398
399	SELECT CASE ( TRIM( variable ) )
400
401	! CASE ( 'u2' )
402
403	CASE DEFAULT
404	unit = 'illegal'
405
406	END SELECT
407
408
409	END SUBROUTINE dynamics_check_data_output
410
411
412	!------------------------------------------------------------------------------!
413	!
414	! Description:
415	! ------------
416	!> Initialize module-specific masked output
417	!------------------------------------------------------------------------------!
418	SUBROUTINE dynamics_init_masks( variable, unit )
419
420
421	CHARACTER (LEN=*) :: unit !<
422	CHARACTER (LEN=*) :: variable !<
423
424
425	SELECT CASE ( TRIM( variable ) )
426
427	! CASE ( 'u2' )
428
429	CASE DEFAULT
430	unit = 'illegal'
431
432	END SELECT
433
434
435	END SUBROUTINE dynamics_init_masks
436
437
438	!--------------------------------------------------------------------------------------------------!
439	! Description:
440	! ------------
441	!> Initialize module-specific arrays
442	!--------------------------------------------------------------------------------------------------!
443	SUBROUTINE dynamics_init_arrays
444
445
446	END SUBROUTINE dynamics_init_arrays
447
448
449	!--------------------------------------------------------------------------------------------------!
450	! Description:
451	! ------------
452	!> Execution of module-specific initializing actions
453	!--------------------------------------------------------------------------------------------------!
454	SUBROUTINE dynamics_init
455
456
457	END SUBROUTINE dynamics_init
458
459
460	!--------------------------------------------------------------------------------------------------!
461	! Description:
462	! ------------
463	!> Perform module-specific post-initialization checks
464	!--------------------------------------------------------------------------------------------------!
465	SUBROUTINE dynamics_init_checks
466
467	INTEGER(iwp) :: i !< loop index in x-direction
468	INTEGER(iwp) :: j !< loop index in y-direction
469	INTEGER(iwp) :: k !< loop index in z-direction
470
471	LOGICAL :: realistic_q = .TRUE. !< flag indicating realistic mixing ratios
472
473	REAL(wp) :: e_s !< saturation water vapor pressure
474	REAL(wp) :: q_s !< saturation mixing ratio
475	REAL(wp) :: t_l !< actual temperature
476
477	!
478	!-- Check for realistic initial mixing ratio. This must be in a realistic phyiscial range and must
479	!-- not exceed the saturation mixing ratio by more than 2 percent. Please note, the check is
480	!-- performed for each grid point (not just for a vertical profile), in order to cover also
481	!-- three-dimensional initialization.
482	IF ( humidity .AND. .NOT. neutral ) THEN
483	DO i = nxl, nxr
484	DO j = nys, nyn
485	DO k = nzb+1, nzt
486	!
487	!-- Calculate actual temperature, water vapor saturation pressure, and based on this
488	!-- the saturation mixing ratio.
489	t_l = exner(k) * pt(k,j,i)
490	e_s = magnus( t_l )
491	q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
492
493	IF ( q(k,j,i) > 1.02_wp * q_s ) realistic_q = .FALSE.
494	ENDDO
495	ENDDO
496	ENDDO
497	!
498	!-- Since the check is performed locally, merge the logical flag from all mpi ranks,
499	!-- in order to do not print the error message multiple times.
500	#if defined( __parallel )
501	CALL MPI_ALLREDUCE( MPI_IN_PLACE, realistic_q, 1, MPI_LOGICAL, MPI_LAND, comm2d, ierr)
502	#endif
503
504	IF ( .NOT. realistic_q ) THEN
505	message_string = 'The initial mixing ratio exceeds the saturation mixing ratio.'
506	CALL message( 'dynamic_init_checks', 'PA0697', 2, 2, 0, 6, 0 )
507	ENDIF
508	ENDIF
509
510	END SUBROUTINE dynamics_init_checks
511
512
513	!--------------------------------------------------------------------------------------------------!
514	! Description:
515	! ------------
516	!> Set the grids on which module-specific output quantities are defined. Allowed values for
517	!> grid_x are "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw".
518	!--------------------------------------------------------------------------------------------------!
519	SUBROUTINE dynamics_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
520
521
522	CHARACTER (LEN=*) :: grid_x !<
523	CHARACTER (LEN=*) :: grid_y !<
524	CHARACTER (LEN=*) :: grid_z !<
525	CHARACTER (LEN=*) :: variable !<
526
527	LOGICAL :: found !<
528
529
530	SELECT CASE ( TRIM( variable ) )
531
532	! CASE ( 'u2' )
533
534	CASE DEFAULT
535	found = .FALSE.
536	grid_x = 'none'
537	grid_y = 'none'
538	grid_z = 'none'
539
540	END SELECT
541
542
543	END SUBROUTINE dynamics_define_netcdf_grid
544
545
546	!--------------------------------------------------------------------------------------------------!
547	! Description:
548	! ------------
549	!> Print a header with module-specific information.
550	!--------------------------------------------------------------------------------------------------!
551	SUBROUTINE dynamics_header( io )
552
553
554	INTEGER(iwp) :: io !<
555
556	!
557	!-- If no module-specific variables are read from the namelist-file, no information will be printed.
558	IF ( .NOT. dynamics_module_enabled ) THEN
559	WRITE ( io, 100 )
560	RETURN
561	ENDIF
562
563	!
564	!-- Printing the information.
565	WRITE ( io, 110 )
566
567	!
568	!-- Format-descriptors
569	100 FORMAT (//' *** dynamic module disabled'/)
570	110 FORMAT (//1X,78('#') &
571	//' User-defined variables and actions:'/ &
572	' -----------------------------------'//)
573
574	END SUBROUTINE dynamics_header
575
576
577	!--------------------------------------------------------------------------------------------------!
578	! Description:
579	! ------------
580	!> Execute module-specific actions for all grid points
581	!--------------------------------------------------------------------------------------------------!
582	SUBROUTINE dynamics_actions( location )
583
584
585	CHARACTER (LEN=*) :: location !<
586
587	! INTEGER(iwp) :: i !<
588	! INTEGER(iwp) :: j !<
589	! INTEGER(iwp) :: k !<
590
591	!
592	!-- Here the user-defined actions follow
593	!-- No calls for single grid points are allowed at locations before and
594	!-- after the timestep, since these calls are not within an i,j-loop
595	SELECT CASE ( location )
596
597	CASE ( 'before_timestep' )
598
599
600	CASE ( 'before_prognostic_equations' )
601
602
603	CASE ( 'after_integration' )
604
605
606	CASE ( 'after_timestep' )
607
608
609	CASE ( 'u-tendency' )
610
611
612	CASE ( 'v-tendency' )
613
614
615	CASE ( 'w-tendency' )
616
617
618	CASE ( 'pt-tendency' )
619
620
621	CASE ( 'sa-tendency' )
622
623
624	CASE ( 'e-tendency' )
625
626
627	CASE ( 'q-tendency' )
628
629
630	CASE ( 's-tendency' )
631
632
633	CASE DEFAULT
634	CONTINUE
635
636	END SELECT
637
638	END SUBROUTINE dynamics_actions
639
640
641	!--------------------------------------------------------------------------------------------------!
642	! Description:
643	! ------------
644	!> Execute module-specific actions for grid point i,j
645	!--------------------------------------------------------------------------------------------------!
646	SUBROUTINE dynamics_actions_ij( i, j, location )
647
648
649	CHARACTER (LEN=*) :: location
650
651	INTEGER(iwp) :: i
652	INTEGER(iwp) :: j
653
654	!
655	!-- Here the user-defined actions follow
656	SELECT CASE ( location )
657
658	CASE ( 'u-tendency' )
659
660	!-- Next line is to avoid compiler warning about unused variables. Please remove.
661	IF ( i + j < 0 ) CONTINUE
662
663	CASE ( 'v-tendency' )
664
665
666	CASE ( 'w-tendency' )
667
668
669	CASE ( 'pt-tendency' )
670
671
672	CASE ( 'sa-tendency' )
673
674
675	CASE ( 'e-tendency' )
676
677
678	CASE ( 'q-tendency' )
679
680
681	CASE ( 's-tendency' )
682
683
684	CASE DEFAULT
685	CONTINUE
686
687	END SELECT
688
689	END SUBROUTINE dynamics_actions_ij
690
691
692	!--------------------------------------------------------------------------------------------------!
693	! Description:
694	! ------------
695	!> Compute module-specific non-advective processes for all grid points
696	!--------------------------------------------------------------------------------------------------!
697	SUBROUTINE dynamics_non_advective_processes
698
699
700
701	END SUBROUTINE dynamics_non_advective_processes
702
703
704	!--------------------------------------------------------------------------------------------------!
705	! Description:
706	! ------------
707	!> Compute module-specific non-advective processes for grid points i,j
708	!--------------------------------------------------------------------------------------------------!
709	SUBROUTINE dynamics_non_advective_processes_ij( i, j )
710
711
712	INTEGER(iwp) :: i !<
713	INTEGER(iwp) :: j !<
714
715	!
716	!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
717	IF ( i + j < 0 ) CONTINUE
718
719
720	END SUBROUTINE dynamics_non_advective_processes_ij
721
722
723	!--------------------------------------------------------------------------------------------------!
724	! Description:
725	! ------------
726	!> Perform module-specific horizontal boundary exchange
727	!--------------------------------------------------------------------------------------------------!
728	SUBROUTINE dynamics_exchange_horiz
729
730
731
732	END SUBROUTINE dynamics_exchange_horiz
733
734
735	!--------------------------------------------------------------------------------------------------!
736	! Description:
737	! ------------
738	!> Compute module-specific prognostic equations for all grid points
739	!--------------------------------------------------------------------------------------------------!
740	SUBROUTINE dynamics_prognostic_equations
741
742
743
744	END SUBROUTINE dynamics_prognostic_equations
745
746
747	!--------------------------------------------------------------------------------------------------!
748	! Description:
749	! ------------
750	!> Compute module-specific prognostic equations for grid point i,j
751	!--------------------------------------------------------------------------------------------------!
752	SUBROUTINE dynamics_prognostic_equations_ij( i, j, i_omp_start, tn )
753
754
755	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
756	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
757	INTEGER(iwp), INTENT(IN) :: i_omp_start !< first loop index of i-loop in prognostic_equations
758	INTEGER(iwp), INTENT(IN) :: tn !< task number of openmp task
759
760	!
761	!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
762	IF ( i + j + i_omp_start + tn < 0 ) CONTINUE
763
764	END SUBROUTINE dynamics_prognostic_equations_ij
765
766
767	!--------------------------------------------------------------------------------------------------!
768	! Description:
769	! ------------
770	!> Compute boundary conditions of dynamics model
771	!--------------------------------------------------------------------------------------------------!
772	SUBROUTINE dynamics_boundary_conditions
773
774	IMPLICIT NONE
775
776	INTEGER(iwp) :: i !< grid index x direction
777	INTEGER(iwp) :: j !< grid index y direction
778	INTEGER(iwp) :: k !< grid index z direction
779	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
780	INTEGER(iwp) :: m !< running index surface elements
781
782	REAL(wp) :: c_max !< maximum phase velocity allowed by CFL criterion, used for outflow boundary condition
783	REAL(wp) :: denom !< horizontal gradient of velocity component normal to the outflow boundary
784
785	!
786	!-- Bottom boundary
787	IF ( ibc_uv_b == 1 ) THEN
788	u_p(nzb,:,:) = u_p(nzb+1,:,:)
789	v_p(nzb,:,:) = v_p(nzb+1,:,:)
790	ENDIF
791	!
792	!-- Set zero vertical velocity at topography top (l=0), or bottom (l=1) in case
793	!-- of downward-facing surfaces.
794	DO l = 0, 1
795	!$OMP PARALLEL DO PRIVATE( i, j, k )
796	!$ACC PARALLEL LOOP PRIVATE(i, j, k) &
797	!$ACC PRESENT(bc_h, w_p)
798	DO m = 1, bc_h(l)%ns
799	i = bc_h(l)%i(m)
800	j = bc_h(l)%j(m)
801	k = bc_h(l)%k(m)
802	w_p(k+bc_h(l)%koff,j,i) = 0.0_wp
803	ENDDO
804	ENDDO
805
806	!
807	!-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings.
808	IF ( ibc_uv_t == 0 ) THEN
809	!$ACC KERNELS PRESENT(u_p, v_p, u_init, v_init)
810	u_p(nzt+1,:,:) = u_init(nzt+1)
811	v_p(nzt+1,:,:) = v_init(nzt+1)
812	!$ACC END KERNELS
813	ELSEIF ( ibc_uv_t == 1 ) THEN
814	u_p(nzt+1,:,:) = u_p(nzt,:,:)
815	v_p(nzt+1,:,:) = v_p(nzt,:,:)
816	ENDIF
817
818	!
819	!-- Vertical nesting: Vertical velocity not zero at the top of the fine grid
820	IF ( .NOT. child_domain .AND. .NOT. nesting_offline .AND. &
821	TRIM(coupling_mode) /= 'vnested_fine' ) THEN
822	!$ACC KERNELS PRESENT(w_p)
823	w_p(nzt:nzt+1,:,:) = 0.0_wp !< nzt is not a prognostic level (but cf. pres)
824	!$ACC END KERNELS
825	ENDIF
826
827	!
828	!-- Temperature at bottom and top boundary.
829	!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by
830	!-- the sea surface temperature of the coupled ocean model.
831	!-- Dirichlet
832	IF ( .NOT. neutral ) THEN
833	IF ( ibc_pt_b == 0 ) THEN
834	DO l = 0, 1
835	!$OMP PARALLEL DO PRIVATE( i, j, k )
836	DO m = 1, bc_h(l)%ns
837	i = bc_h(l)%i(m)
838	j = bc_h(l)%j(m)
839	k = bc_h(l)%k(m)
840	pt_p(k+bc_h(l)%koff,j,i) = pt(k+bc_h(l)%koff,j,i)
841	ENDDO
842	ENDDO
843	!
844	!-- Neumann, zero-gradient
845	ELSEIF ( ibc_pt_b == 1 ) THEN
846	DO l = 0, 1
847	!$OMP PARALLEL DO PRIVATE( i, j, k )
848	!$ACC PARALLEL LOOP PRIVATE(i, j, k) &
849	!$ACC PRESENT(bc_h, pt_p)
850	DO m = 1, bc_h(l)%ns
851	i = bc_h(l)%i(m)
852	j = bc_h(l)%j(m)
853	k = bc_h(l)%k(m)
854	pt_p(k+bc_h(l)%koff,j,i) = pt_p(k,j,i)
855	ENDDO
856	ENDDO
857	ENDIF
858
859	!
860	!-- Temperature at top boundary
861	IF ( ibc_pt_t == 0 ) THEN
862	pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
863	!
864	!-- In case of nudging adjust top boundary to pt which is
865	!-- read in from NUDGING-DATA
866	IF ( nudging ) THEN
867	pt_p(nzt+1,:,:) = pt_init(nzt+1)
868	ENDIF
869	ELSEIF ( ibc_pt_t == 1 ) THEN
870	pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
871	ELSEIF ( ibc_pt_t == 2 ) THEN
872	!$ACC KERNELS PRESENT(pt_p, dzu)
873	pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
874	!$ACC END KERNELS
875	ENDIF
876	ENDIF
877	!
878	!-- Boundary conditions for total water content,
879	!-- bottom and top boundary (see also temperature)
880	IF ( humidity ) THEN
881	!
882	!-- Surface conditions for constant_humidity_flux
883	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
884	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
885	!-- q_p at k-1
886	IF ( ibc_q_b == 0 ) THEN
887
888	DO l = 0, 1
889	!$OMP PARALLEL DO PRIVATE( i, j, k )
890	DO m = 1, bc_h(l)%ns
891	i = bc_h(l)%i(m)
892	j = bc_h(l)%j(m)
893	k = bc_h(l)%k(m)
894	q_p(k+bc_h(l)%koff,j,i) = q(k+bc_h(l)%koff,j,i)
895	ENDDO
896	ENDDO
897
898	ELSE
899
900	DO l = 0, 1
901	!$OMP PARALLEL DO PRIVATE( i, j, k )
902	DO m = 1, bc_h(l)%ns
903	i = bc_h(l)%i(m)
904	j = bc_h(l)%j(m)
905	k = bc_h(l)%k(m)
906	q_p(k+bc_h(l)%koff,j,i) = q_p(k,j,i)
907	ENDDO
908	ENDDO
909	ENDIF
910	!
911	!-- Top boundary
912	IF ( ibc_q_t == 0 ) THEN
913	q_p(nzt+1,:,:) = q(nzt+1,:,:)
914	ELSEIF ( ibc_q_t == 1 ) THEN
915	q_p(nzt+1,:,:) = q_p(nzt,:,:) + bc_q_t_val * dzu(nzt+1)
916	ENDIF
917	ENDIF
918	!
919	!-- Boundary conditions for scalar,
920	!-- bottom and top boundary (see also temperature)
921	IF ( passive_scalar ) THEN
922	!
923	!-- Surface conditions for constant_humidity_flux
924	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
925	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
926	!-- s_p at k-1
927	IF ( ibc_s_b == 0 ) THEN
928
929	DO l = 0, 1
930	!$OMP PARALLEL DO PRIVATE( i, j, k )
931	DO m = 1, bc_h(l)%ns
932	i = bc_h(l)%i(m)
933	j = bc_h(l)%j(m)
934	k = bc_h(l)%k(m)
935	s_p(k+bc_h(l)%koff,j,i) = s(k+bc_h(l)%koff,j,i)
936	ENDDO
937	ENDDO
938
939	ELSE
940
941	DO l = 0, 1
942	!$OMP PARALLEL DO PRIVATE( i, j, k )
943	DO m = 1, bc_h(l)%ns
944	i = bc_h(l)%i(m)
945	j = bc_h(l)%j(m)
946	k = bc_h(l)%k(m)
947	s_p(k+bc_h(l)%koff,j,i) = s_p(k,j,i)
948	ENDDO
949	ENDDO
950	ENDIF
951	!
952	!-- Top boundary condition
953	IF ( ibc_s_t == 0 ) THEN
954	s_p(nzt+1,:,:) = s(nzt+1,:,:)
955	ELSEIF ( ibc_s_t == 1 ) THEN
956	s_p(nzt+1,:,:) = s_p(nzt,:,:)
957	ELSEIF ( ibc_s_t == 2 ) THEN
958	s_p(nzt+1,:,:) = s_p(nzt,:,:) + bc_s_t_val * dzu(nzt+1)
959	ENDIF
960
961	ENDIF
962	!
963	!-- In case of inflow or nest boundary at the south boundary the boundary for v
964	!-- is at nys and in case of inflow or nest boundary at the left boundary the
965	!-- boundary for u is at nxl. Since in prognostic_equations (cache optimized
966	!-- version) these levels are handled as a prognostic level, boundary values
967	!-- have to be restored here.
968	IF ( bc_dirichlet_s ) THEN
969	v_p(:,nys,:) = v_p(:,nys-1,:)
970	ELSEIF ( bc_dirichlet_l ) THEN
971	u_p(:,:,nxl) = u_p(:,:,nxl-1)
972	ENDIF
973
974	!
975	!-- The same restoration for u at i=nxl and v at j=nys as above must be made
976	!-- in case of nest boundaries. This must not be done in case of vertical nesting
977	!-- mode as in that case the lateral boundaries are actually cyclic.
978	!-- Lateral oundary conditions for TKE and dissipation are set
979	!-- in tcm_boundary_conds.
980	IF ( nesting_mode /= 'vertical' .OR. nesting_offline ) THEN
981	IF ( bc_dirichlet_s ) THEN
982	v_p(:,nys,:) = v_p(:,nys-1,:)
983	ENDIF
984	IF ( bc_dirichlet_l ) THEN
985	u_p(:,:,nxl) = u_p(:,:,nxl-1)
986	ENDIF
987	ENDIF
988
989	!
990	!-- Lateral boundary conditions for scalar quantities at the outflow.
991	!-- Lateral oundary conditions for TKE and dissipation are set
992	!-- in tcm_boundary_conds.
993	IF ( bc_radiation_s ) THEN
994	pt_p(:,nys-1,:) = pt_p(:,nys,:)
995	IF ( humidity ) THEN
996	q_p(:,nys-1,:) = q_p(:,nys,:)
997	ENDIF
998	IF ( passive_scalar ) s_p(:,nys-1,:) = s_p(:,nys,:)
999	ELSEIF ( bc_radiation_n ) THEN
1000	pt_p(:,nyn+1,:) = pt_p(:,nyn,:)
1001	IF ( humidity ) THEN
1002	q_p(:,nyn+1,:) = q_p(:,nyn,:)
1003	ENDIF
1004	IF ( passive_scalar ) s_p(:,nyn+1,:) = s_p(:,nyn,:)
1005	ELSEIF ( bc_radiation_l ) THEN
1006	pt_p(:,:,nxl-1) = pt_p(:,:,nxl)
1007	IF ( humidity ) THEN
1008	q_p(:,:,nxl-1) = q_p(:,:,nxl)
1009	ENDIF
1010	IF ( passive_scalar ) s_p(:,:,nxl-1) = s_p(:,:,nxl)
1011	ELSEIF ( bc_radiation_r ) THEN
1012	pt_p(:,:,nxr+1) = pt_p(:,:,nxr)
1013	IF ( humidity ) THEN
1014	q_p(:,:,nxr+1) = q_p(:,:,nxr)
1015	ENDIF
1016	IF ( passive_scalar ) s_p(:,:,nxr+1) = s_p(:,:,nxr)
1017	ENDIF
1018
1019	!
1020	!-- Radiation boundary conditions for the velocities at the respective outflow.
1021	!-- The phase velocity is either assumed to the maximum phase velocity that
1022	!-- ensures numerical stability (CFL-condition) or calculated after
1023	!-- Orlanski(1976) and averaged along the outflow boundary.
1024	IF ( bc_radiation_s ) THEN
1025
1026	IF ( use_cmax ) THEN
1027	u_p(:,-1,:) = u(:,0,:)
1028	v_p(:,0,:) = v(:,1,:)
1029	w_p(:,-1,:) = w(:,0,:)
1030	ELSEIF ( .NOT. use_cmax ) THEN
1031
1032	c_max = dy / dt_3d
1033
1034	c_u_m_l = 0.0_wp
1035	c_v_m_l = 0.0_wp
1036	c_w_m_l = 0.0_wp
1037
1038	c_u_m = 0.0_wp
1039	c_v_m = 0.0_wp
1040	c_w_m = 0.0_wp
1041
1042	!
1043	!-- Calculate the phase speeds for u, v, and w, first local and then
1044	!-- average along the outflow boundary.
1045	DO k = nzb+1, nzt+1
1046	DO i = nxl, nxr
1047
1048	denom = u_m_s(k,0,i) - u_m_s(k,1,i)
1049
1050	IF ( denom /= 0.0_wp ) THEN
1051	c_u(k,i) = -c_max * ( u(k,0,i) - u_m_s(k,0,i) ) / ( denom * tsc(2) )
1052	IF ( c_u(k,i) < 0.0_wp ) THEN
1053	c_u(k,i) = 0.0_wp
1054	ELSEIF ( c_u(k,i) > c_max ) THEN
1055	c_u(k,i) = c_max
1056	ENDIF
1057	ELSE
1058	c_u(k,i) = c_max
1059	ENDIF
1060
1061	denom = v_m_s(k,1,i) - v_m_s(k,2,i)
1062
1063	IF ( denom /= 0.0_wp ) THEN
1064	c_v(k,i) = -c_max * ( v(k,1,i) - v_m_s(k,1,i) ) / ( denom * tsc(2) )
1065	IF ( c_v(k,i) < 0.0_wp ) THEN
1066	c_v(k,i) = 0.0_wp
1067	ELSEIF ( c_v(k,i) > c_max ) THEN
1068	c_v(k,i) = c_max
1069	ENDIF
1070	ELSE
1071	c_v(k,i) = c_max
1072	ENDIF
1073
1074	denom = w_m_s(k,0,i) - w_m_s(k,1,i)
1075
1076	IF ( denom /= 0.0_wp ) THEN
1077	c_w(k,i) = -c_max * ( w(k,0,i) - w_m_s(k,0,i) ) / ( denom * tsc(2) )
1078	IF ( c_w(k,i) < 0.0_wp ) THEN
1079	c_w(k,i) = 0.0_wp
1080	ELSEIF ( c_w(k,i) > c_max ) THEN
1081	c_w(k,i) = c_max
1082	ENDIF
1083	ELSE
1084	c_w(k,i) = c_max
1085	ENDIF
1086
1087	c_u_m_l(k) = c_u_m_l(k) + c_u(k,i)
1088	c_v_m_l(k) = c_v_m_l(k) + c_v(k,i)
1089	c_w_m_l(k) = c_w_m_l(k) + c_w(k,i)
1090
1091	ENDDO
1092	ENDDO
1093
1094	#if defined( __parallel )
1095	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
1096	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
1097	MPI_SUM, comm1dx, ierr )
1098	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
1099	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
1100	MPI_SUM, comm1dx, ierr )
1101	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
1102	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
1103	MPI_SUM, comm1dx, ierr )
1104	#else
1105	c_u_m = c_u_m_l
1106	c_v_m = c_v_m_l
1107	c_w_m = c_w_m_l
1108	#endif
1109
1110	c_u_m = c_u_m / (nx+1)
1111	c_v_m = c_v_m / (nx+1)
1112	c_w_m = c_w_m / (nx+1)
1113
1114	!
1115	!-- Save old timelevels for the next timestep
1116	IF ( intermediate_timestep_count == 1 ) THEN
1117	u_m_s(:,:,:) = u(:,0:1,:)
1118	v_m_s(:,:,:) = v(:,1:2,:)
1119	w_m_s(:,:,:) = w(:,0:1,:)
1120	ENDIF
1121
1122	!
1123	!-- Calculate the new velocities
1124	DO k = nzb+1, nzt+1
1125	DO i = nxlg, nxrg
1126	u_p(k,-1,i) = u(k,-1,i) - dt_3d * tsc(2) * c_u_m(k) * &
1127	( u(k,-1,i) - u(k,0,i) ) * ddy
1128
1129	v_p(k,0,i) = v(k,0,i) - dt_3d * tsc(2) * c_v_m(k) * &
1130	( v(k,0,i) - v(k,1,i) ) * ddy
1131
1132	w_p(k,-1,i) = w(k,-1,i) - dt_3d * tsc(2) * c_w_m(k) * &
1133	( w(k,-1,i) - w(k,0,i) ) * ddy
1134	ENDDO
1135	ENDDO
1136
1137	!
1138	!-- Bottom boundary at the outflow
1139	IF ( ibc_uv_b == 0 ) THEN
1140	u_p(nzb,-1,:) = 0.0_wp
1141	v_p(nzb,0,:) = 0.0_wp
1142	ELSE
1143	u_p(nzb,-1,:) = u_p(nzb+1,-1,:)
1144	v_p(nzb,0,:) = v_p(nzb+1,0,:)
1145	ENDIF
1146	w_p(nzb,-1,:) = 0.0_wp
1147
1148	!
1149	!-- Top boundary at the outflow
1150	IF ( ibc_uv_t == 0 ) THEN
1151	u_p(nzt+1,-1,:) = u_init(nzt+1)
1152	v_p(nzt+1,0,:) = v_init(nzt+1)
1153	ELSE
1154	u_p(nzt+1,-1,:) = u_p(nzt,-1,:)
1155	v_p(nzt+1,0,:) = v_p(nzt,0,:)
1156	ENDIF
1157	w_p(nzt:nzt+1,-1,:) = 0.0_wp
1158
1159	ENDIF
1160
1161	ENDIF
1162
1163	IF ( bc_radiation_n ) THEN
1164
1165	IF ( use_cmax ) THEN
1166	u_p(:,ny+1,:) = u(:,ny,:)
1167	v_p(:,ny+1,:) = v(:,ny,:)
1168	w_p(:,ny+1,:) = w(:,ny,:)
1169	ELSEIF ( .NOT. use_cmax ) THEN
1170
1171	c_max = dy / dt_3d
1172
1173	c_u_m_l = 0.0_wp
1174	c_v_m_l = 0.0_wp
1175	c_w_m_l = 0.0_wp
1176
1177	c_u_m = 0.0_wp
1178	c_v_m = 0.0_wp
1179	c_w_m = 0.0_wp
1180
1181	!
1182	!-- Calculate the phase speeds for u, v, and w, first local and then
1183	!-- average along the outflow boundary.
1184	DO k = nzb+1, nzt+1
1185	DO i = nxl, nxr
1186
1187	denom = u_m_n(k,ny,i) - u_m_n(k,ny-1,i)
1188
1189	IF ( denom /= 0.0_wp ) THEN
1190	c_u(k,i) = -c_max * ( u(k,ny,i) - u_m_n(k,ny,i) ) / ( denom * tsc(2) )
1191	IF ( c_u(k,i) < 0.0_wp ) THEN
1192	c_u(k,i) = 0.0_wp
1193	ELSEIF ( c_u(k,i) > c_max ) THEN
1194	c_u(k,i) = c_max
1195	ENDIF
1196	ELSE
1197	c_u(k,i) = c_max
1198	ENDIF
1199
1200	denom = v_m_n(k,ny,i) - v_m_n(k,ny-1,i)
1201
1202	IF ( denom /= 0.0_wp ) THEN
1203	c_v(k,i) = -c_max * ( v(k,ny,i) - v_m_n(k,ny,i) ) / ( denom * tsc(2) )
1204	IF ( c_v(k,i) < 0.0_wp ) THEN
1205	c_v(k,i) = 0.0_wp
1206	ELSEIF ( c_v(k,i) > c_max ) THEN
1207	c_v(k,i) = c_max
1208	ENDIF
1209	ELSE
1210	c_v(k,i) = c_max
1211	ENDIF
1212
1213	denom = w_m_n(k,ny,i) - w_m_n(k,ny-1,i)
1214
1215	IF ( denom /= 0.0_wp ) THEN
1216	c_w(k,i) = -c_max * ( w(k,ny,i) - w_m_n(k,ny,i) ) / ( denom * tsc(2) )
1217	IF ( c_w(k,i) < 0.0_wp ) THEN
1218	c_w(k,i) = 0.0_wp
1219	ELSEIF ( c_w(k,i) > c_max ) THEN
1220	c_w(k,i) = c_max
1221	ENDIF
1222	ELSE
1223	c_w(k,i) = c_max
1224	ENDIF
1225
1226	c_u_m_l(k) = c_u_m_l(k) + c_u(k,i)
1227	c_v_m_l(k) = c_v_m_l(k) + c_v(k,i)
1228	c_w_m_l(k) = c_w_m_l(k) + c_w(k,i)
1229
1230	ENDDO
1231	ENDDO
1232
1233	#if defined( __parallel )
1234	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
1235	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
1236	MPI_SUM, comm1dx, ierr )
1237	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
1238	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
1239	MPI_SUM, comm1dx, ierr )
1240	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
1241	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
1242	MPI_SUM, comm1dx, ierr )
1243	#else
1244	c_u_m = c_u_m_l
1245	c_v_m = c_v_m_l
1246	c_w_m = c_w_m_l
1247	#endif
1248
1249	c_u_m = c_u_m / (nx+1)
1250	c_v_m = c_v_m / (nx+1)
1251	c_w_m = c_w_m / (nx+1)
1252
1253	!
1254	!-- Save old timelevels for the next timestep
1255	IF ( intermediate_timestep_count == 1 ) THEN
1256	u_m_n(:,:,:) = u(:,ny-1:ny,:)
1257	v_m_n(:,:,:) = v(:,ny-1:ny,:)
1258	w_m_n(:,:,:) = w(:,ny-1:ny,:)
1259	ENDIF
1260
1261	!
1262	!-- Calculate the new velocities
1263	DO k = nzb+1, nzt+1
1264	DO i = nxlg, nxrg
1265	u_p(k,ny+1,i) = u(k,ny+1,i) - dt_3d * tsc(2) * c_u_m(k) * &
1266	( u(k,ny+1,i) - u(k,ny,i) ) * ddy
1267
1268	v_p(k,ny+1,i) = v(k,ny+1,i) - dt_3d * tsc(2) * c_v_m(k) * &
1269	( v(k,ny+1,i) - v(k,ny,i) ) * ddy
1270
1271	w_p(k,ny+1,i) = w(k,ny+1,i) - dt_3d * tsc(2) * c_w_m(k) * &
1272	( w(k,ny+1,i) - w(k,ny,i) ) * ddy
1273	ENDDO
1274	ENDDO
1275
1276	!
1277	!-- Bottom boundary at the outflow
1278	IF ( ibc_uv_b == 0 ) THEN
1279	u_p(nzb,ny+1,:) = 0.0_wp
1280	v_p(nzb,ny+1,:) = 0.0_wp
1281	ELSE
1282	u_p(nzb,ny+1,:) = u_p(nzb+1,ny+1,:)
1283	v_p(nzb,ny+1,:) = v_p(nzb+1,ny+1,:)
1284	ENDIF
1285	w_p(nzb,ny+1,:) = 0.0_wp
1286
1287	!
1288	!-- Top boundary at the outflow
1289	IF ( ibc_uv_t == 0 ) THEN
1290	u_p(nzt+1,ny+1,:) = u_init(nzt+1)
1291	v_p(nzt+1,ny+1,:) = v_init(nzt+1)
1292	ELSE
1293	u_p(nzt+1,ny+1,:) = u_p(nzt,nyn+1,:)
1294	v_p(nzt+1,ny+1,:) = v_p(nzt,nyn+1,:)
1295	ENDIF
1296	w_p(nzt:nzt+1,ny+1,:) = 0.0_wp
1297
1298	ENDIF
1299
1300	ENDIF
1301
1302	IF ( bc_radiation_l ) THEN
1303
1304	IF ( use_cmax ) THEN
1305	u_p(:,:,0) = u(:,:,1)
1306	v_p(:,:,-1) = v(:,:,0)
1307	w_p(:,:,-1) = w(:,:,0)
1308	ELSEIF ( .NOT. use_cmax ) THEN
1309
1310	c_max = dx / dt_3d
1311
1312	c_u_m_l = 0.0_wp
1313	c_v_m_l = 0.0_wp
1314	c_w_m_l = 0.0_wp
1315
1316	c_u_m = 0.0_wp
1317	c_v_m = 0.0_wp
1318	c_w_m = 0.0_wp
1319
1320	!
1321	!-- Calculate the phase speeds for u, v, and w, first local and then
1322	!-- average along the outflow boundary.
1323	DO k = nzb+1, nzt+1
1324	DO j = nys, nyn
1325
1326	denom = u_m_l(k,j,1) - u_m_l(k,j,2)
1327
1328	IF ( denom /= 0.0_wp ) THEN
1329	c_u(k,j) = -c_max * ( u(k,j,1) - u_m_l(k,j,1) ) / ( denom * tsc(2) )
1330	IF ( c_u(k,j) < 0.0_wp ) THEN
1331	c_u(k,j) = 0.0_wp
1332	ELSEIF ( c_u(k,j) > c_max ) THEN
1333	c_u(k,j) = c_max
1334	ENDIF
1335	ELSE
1336	c_u(k,j) = c_max
1337	ENDIF
1338
1339	denom = v_m_l(k,j,0) - v_m_l(k,j,1)
1340
1341	IF ( denom /= 0.0_wp ) THEN
1342	c_v(k,j) = -c_max * ( v(k,j,0) - v_m_l(k,j,0) ) / ( denom * tsc(2) )
1343	IF ( c_v(k,j) < 0.0_wp ) THEN
1344	c_v(k,j) = 0.0_wp
1345	ELSEIF ( c_v(k,j) > c_max ) THEN
1346	c_v(k,j) = c_max
1347	ENDIF
1348	ELSE
1349	c_v(k,j) = c_max
1350	ENDIF
1351
1352	denom = w_m_l(k,j,0) - w_m_l(k,j,1)
1353
1354	IF ( denom /= 0.0_wp ) THEN
1355	c_w(k,j) = -c_max * ( w(k,j,0) - w_m_l(k,j,0) ) / ( denom * tsc(2) )
1356	IF ( c_w(k,j) < 0.0_wp ) THEN
1357	c_w(k,j) = 0.0_wp
1358	ELSEIF ( c_w(k,j) > c_max ) THEN
1359	c_w(k,j) = c_max
1360	ENDIF
1361	ELSE
1362	c_w(k,j) = c_max
1363	ENDIF
1364
1365	c_u_m_l(k) = c_u_m_l(k) + c_u(k,j)
1366	c_v_m_l(k) = c_v_m_l(k) + c_v(k,j)
1367	c_w_m_l(k) = c_w_m_l(k) + c_w(k,j)
1368
1369	ENDDO
1370	ENDDO
1371
1372	#if defined( __parallel )
1373	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1374	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
1375	MPI_SUM, comm1dy, ierr )
1376	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1377	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
1378	MPI_SUM, comm1dy, ierr )
1379	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1380	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
1381	MPI_SUM, comm1dy, ierr )
1382	#else
1383	c_u_m = c_u_m_l
1384	c_v_m = c_v_m_l
1385	c_w_m = c_w_m_l
1386	#endif
1387
1388	c_u_m = c_u_m / (ny+1)
1389	c_v_m = c_v_m / (ny+1)
1390	c_w_m = c_w_m / (ny+1)
1391
1392	!
1393	!-- Save old timelevels for the next timestep
1394	IF ( intermediate_timestep_count == 1 ) THEN
1395	u_m_l(:,:,:) = u(:,:,1:2)
1396	v_m_l(:,:,:) = v(:,:,0:1)
1397	w_m_l(:,:,:) = w(:,:,0:1)
1398	ENDIF
1399
1400	!
1401	!-- Calculate the new velocities
1402	DO k = nzb+1, nzt+1
1403	DO j = nysg, nyng
1404	u_p(k,j,0) = u(k,j,0) - dt_3d * tsc(2) * c_u_m(k) * &
1405	( u(k,j,0) - u(k,j,1) ) * ddx
1406
1407	v_p(k,j,-1) = v(k,j,-1) - dt_3d * tsc(2) * c_v_m(k) * &
1408	( v(k,j,-1) - v(k,j,0) ) * ddx
1409
1410	w_p(k,j,-1) = w(k,j,-1) - dt_3d * tsc(2) * c_w_m(k) * &
1411	( w(k,j,-1) - w(k,j,0) ) * ddx
1412	ENDDO
1413	ENDDO
1414
1415	!
1416	!-- Bottom boundary at the outflow
1417	IF ( ibc_uv_b == 0 ) THEN
1418	u_p(nzb,:,0) = 0.0_wp
1419	v_p(nzb,:,-1) = 0.0_wp
1420	ELSE
1421	u_p(nzb,:,0) = u_p(nzb+1,:,0)
1422	v_p(nzb,:,-1) = v_p(nzb+1,:,-1)
1423	ENDIF
1424	w_p(nzb,:,-1) = 0.0_wp
1425
1426	!
1427	!-- Top boundary at the outflow
1428	IF ( ibc_uv_t == 0 ) THEN
1429	u_p(nzt+1,:,0) = u_init(nzt+1)
1430	v_p(nzt+1,:,-1) = v_init(nzt+1)
1431	ELSE
1432	u_p(nzt+1,:,0) = u_p(nzt,:,0)
1433	v_p(nzt+1,:,-1) = v_p(nzt,:,-1)
1434	ENDIF
1435	w_p(nzt:nzt+1,:,-1) = 0.0_wp
1436
1437	ENDIF
1438
1439	ENDIF
1440
1441	IF ( bc_radiation_r ) THEN
1442
1443	IF ( use_cmax ) THEN
1444	u_p(:,:,nx+1) = u(:,:,nx)
1445	v_p(:,:,nx+1) = v(:,:,nx)
1446	w_p(:,:,nx+1) = w(:,:,nx)
1447	ELSEIF ( .NOT. use_cmax ) THEN
1448
1449	c_max = dx / dt_3d
1450
1451	c_u_m_l = 0.0_wp
1452	c_v_m_l = 0.0_wp
1453	c_w_m_l = 0.0_wp
1454
1455	c_u_m = 0.0_wp
1456	c_v_m = 0.0_wp
1457	c_w_m = 0.0_wp
1458
1459	!
1460	!-- Calculate the phase speeds for u, v, and w, first local and then
1461	!-- average along the outflow boundary.
1462	DO k = nzb+1, nzt+1
1463	DO j = nys, nyn
1464
1465	denom = u_m_r(k,j,nx) - u_m_r(k,j,nx-1)
1466
1467	IF ( denom /= 0.0_wp ) THEN
1468	c_u(k,j) = -c_max * ( u(k,j,nx) - u_m_r(k,j,nx) ) / ( denom * tsc(2) )
1469	IF ( c_u(k,j) < 0.0_wp ) THEN
1470	c_u(k,j) = 0.0_wp
1471	ELSEIF ( c_u(k,j) > c_max ) THEN
1472	c_u(k,j) = c_max
1473	ENDIF
1474	ELSE
1475	c_u(k,j) = c_max
1476	ENDIF
1477
1478	denom = v_m_r(k,j,nx) - v_m_r(k,j,nx-1)
1479
1480	IF ( denom /= 0.0_wp ) THEN
1481	c_v(k,j) = -c_max * ( v(k,j,nx) - v_m_r(k,j,nx) ) / ( denom * tsc(2) )
1482	IF ( c_v(k,j) < 0.0_wp ) THEN
1483	c_v(k,j) = 0.0_wp
1484	ELSEIF ( c_v(k,j) > c_max ) THEN
1485	c_v(k,j) = c_max
1486	ENDIF
1487	ELSE
1488	c_v(k,j) = c_max
1489	ENDIF
1490
1491	denom = w_m_r(k,j,nx) - w_m_r(k,j,nx-1)
1492
1493	IF ( denom /= 0.0_wp ) THEN
1494	c_w(k,j) = -c_max * ( w(k,j,nx) - w_m_r(k,j,nx) ) / ( denom * tsc(2) )
1495	IF ( c_w(k,j) < 0.0_wp ) THEN
1496	c_w(k,j) = 0.0_wp
1497	ELSEIF ( c_w(k,j) > c_max ) THEN
1498	c_w(k,j) = c_max
1499	ENDIF
1500	ELSE
1501	c_w(k,j) = c_max
1502	ENDIF
1503
1504	c_u_m_l(k) = c_u_m_l(k) + c_u(k,j)
1505	c_v_m_l(k) = c_v_m_l(k) + c_v(k,j)
1506	c_w_m_l(k) = c_w_m_l(k) + c_w(k,j)
1507
1508	ENDDO
1509	ENDDO
1510
1511	#if defined( __parallel )
1512	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1513	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
1514	MPI_SUM, comm1dy, ierr )
1515	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1516	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
1517	MPI_SUM, comm1dy, ierr )
1518	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1519	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
1520	MPI_SUM, comm1dy, ierr )
1521	#else
1522	c_u_m = c_u_m_l
1523	c_v_m = c_v_m_l
1524	c_w_m = c_w_m_l
1525	#endif
1526
1527	c_u_m = c_u_m / (ny+1)
1528	c_v_m = c_v_m / (ny+1)
1529	c_w_m = c_w_m / (ny+1)
1530
1531	!
1532	!-- Save old timelevels for the next timestep
1533	IF ( intermediate_timestep_count == 1 ) THEN
1534	u_m_r(:,:,:) = u(:,:,nx-1:nx)
1535	v_m_r(:,:,:) = v(:,:,nx-1:nx)
1536	w_m_r(:,:,:) = w(:,:,nx-1:nx)
1537	ENDIF
1538
1539	!
1540	!-- Calculate the new velocities
1541	DO k = nzb+1, nzt+1
1542	DO j = nysg, nyng
1543	u_p(k,j,nx+1) = u(k,j,nx+1) - dt_3d * tsc(2) * c_u_m(k) * &
1544	( u(k,j,nx+1) - u(k,j,nx) ) * ddx
1545
1546	v_p(k,j,nx+1) = v(k,j,nx+1) - dt_3d * tsc(2) * c_v_m(k) * &
1547	( v(k,j,nx+1) - v(k,j,nx) ) * ddx
1548
1549	w_p(k,j,nx+1) = w(k,j,nx+1) - dt_3d * tsc(2) * c_w_m(k) * &
1550	( w(k,j,nx+1) - w(k,j,nx) ) * ddx
1551	ENDDO
1552	ENDDO
1553
1554	!
1555	!-- Bottom boundary at the outflow
1556	IF ( ibc_uv_b == 0 ) THEN
1557	u_p(nzb,:,nx+1) = 0.0_wp
1558	v_p(nzb,:,nx+1) = 0.0_wp
1559	ELSE
1560	u_p(nzb,:,nx+1) = u_p(nzb+1,:,nx+1)
1561	v_p(nzb,:,nx+1) = v_p(nzb+1,:,nx+1)
1562	ENDIF
1563	w_p(nzb,:,nx+1) = 0.0_wp
1564
1565	!
1566	!-- Top boundary at the outflow
1567	IF ( ibc_uv_t == 0 ) THEN
1568	u_p(nzt+1,:,nx+1) = u_init(nzt+1)
1569	v_p(nzt+1,:,nx+1) = v_init(nzt+1)
1570	ELSE
1571	u_p(nzt+1,:,nx+1) = u_p(nzt,:,nx+1)
1572	v_p(nzt+1,:,nx+1) = v_p(nzt,:,nx+1)
1573	ENDIF
1574	w_p(nzt:nzt+1,:,nx+1) = 0.0_wp
1575
1576	ENDIF
1577
1578	ENDIF
1579
1580	END SUBROUTINE dynamics_boundary_conditions
1581	!------------------------------------------------------------------------------!
1582	! Description:
1583	! ------------
1584	!> Swap timelevels of module-specific array pointers
1585	!------------------------------------------------------------------------------!
1586	SUBROUTINE dynamics_swap_timelevel ( mod_count )
1587
1588
1589	INTEGER, INTENT(IN) :: mod_count
1590
1591
1592	SELECT CASE ( mod_count )
1593
1594	CASE ( 0 )
1595
1596	u => u_1; u_p => u_2
1597	v => v_1; v_p => v_2
1598	w => w_1; w_p => w_2
1599	IF ( .NOT. neutral ) THEN
1600	pt => pt_1; pt_p => pt_2
1601	ENDIF
1602	IF ( humidity ) THEN
1603	q => q_1; q_p => q_2
1604	ENDIF
1605	IF ( passive_scalar ) THEN
1606	s => s_1; s_p => s_2
1607	ENDIF
1608
1609	CASE ( 1 )
1610
1611	u => u_2; u_p => u_1
1612	v => v_2; v_p => v_1
1613	w => w_2; w_p => w_1
1614	IF ( .NOT. neutral ) THEN
1615	pt => pt_2; pt_p => pt_1
1616	ENDIF
1617	IF ( humidity ) THEN
1618	q => q_2; q_p => q_1
1619	ENDIF
1620	IF ( passive_scalar ) THEN
1621	s => s_2; s_p => s_1
1622	ENDIF
1623
1624	END SELECT
1625
1626	END SUBROUTINE dynamics_swap_timelevel
1627
1628
1629	!--------------------------------------------------------------------------------------------------!
1630	! Description:
1631	! ------------
1632	!> Sum up and time-average module-specific output quantities
1633	!> as well as allocate the array necessary for storing the average.
1634	!--------------------------------------------------------------------------------------------------!
1635	SUBROUTINE dynamics_3d_data_averaging( mode, variable )
1636
1637
1638	CHARACTER (LEN=*) :: mode !<
1639	CHARACTER (LEN=*) :: variable !<
1640
1641
1642	IF ( mode == 'allocate' ) THEN
1643
1644	SELECT CASE ( TRIM( variable ) )
1645
1646	! CASE ( 'u2' )
1647
1648	CASE DEFAULT
1649	CONTINUE
1650
1651	END SELECT
1652
1653	ELSEIF ( mode == 'sum' ) THEN
1654
1655	SELECT CASE ( TRIM( variable ) )
1656
1657	! CASE ( 'u2' )
1658
1659	CASE DEFAULT
1660	CONTINUE
1661
1662	END SELECT
1663
1664	ELSEIF ( mode == 'average' ) THEN
1665
1666	SELECT CASE ( TRIM( variable ) )
1667
1668	! CASE ( 'u2' )
1669
1670	END SELECT
1671
1672	ENDIF
1673
1674
1675	END SUBROUTINE dynamics_3d_data_averaging
1676
1677
1678	!--------------------------------------------------------------------------------------------------!
1679	! Description:
1680	! ------------
1681	!> Resorts the module-specific output quantity with indices (k,j,i) to a
1682	!> temporary array with indices (i,j,k) and sets the grid on which it is defined.
1683	!> Allowed values for grid are "zu" and "zw".
1684	!--------------------------------------------------------------------------------------------------!
1685	SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, &
1686	two_d, nzb_do, nzt_do, fill_value )
1687
1688
1689	CHARACTER (LEN=*) :: grid !<
1690	CHARACTER (LEN=*), INTENT(IN) :: mode !< either 'xy', 'xz' or 'yz'
1691	CHARACTER (LEN=*) :: variable !<
1692
1693	INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data
1694	! INTEGER(iwp) :: i !< grid index along x-direction
1695	! INTEGER(iwp) :: j !< grid index along y-direction
1696	! INTEGER(iwp) :: k !< grid index along z-direction
1697	! INTEGER(iwp) :: m !< running index surface elements
1698	INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb)
1699	INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1)
1700
1701	LOGICAL :: found !<
1702	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
1703
1704	REAL(wp), INTENT(IN) :: fill_value
1705
1706	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
1707
1708	!
1709	!-- Next line is just to avoid compiler warnings about unused variables. You may remove it.
1710	IF ( two_d .AND. av + LEN( mode ) + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 ) CONTINUE
1711
1712	found = .TRUE.
1713
1714	SELECT CASE ( TRIM( variable ) )
1715
1716	! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
1717
1718	CASE DEFAULT
1719	found = .FALSE.
1720	grid = 'none'
1721
1722	END SELECT
1723
1724
1725	END SUBROUTINE dynamics_data_output_2d
1726
1727
1728	!--------------------------------------------------------------------------------------------------!
1729	! Description:
1730	! ------------
1731	!> Resorts the module-specific output quantity with indices (k,j,i)
1732	!> to a temporary array with indices (i,j,k).
1733	!--------------------------------------------------------------------------------------------------!
1734	SUBROUTINE dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1735
1736
1737	CHARACTER (LEN=*) :: variable !<
1738
1739	INTEGER(iwp) :: av !<
1740	! INTEGER(iwp) :: i !<
1741	! INTEGER(iwp) :: j !<
1742	! INTEGER(iwp) :: k !<
1743	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
1744	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
1745
1746	LOGICAL :: found !<
1747
1748	REAL(wp), INTENT(IN) :: fill_value !< value for the _FillValue attribute
1749
1750	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
1751
1752	!
1753	!-- Next line is to avoid compiler warning about unused variables. Please remove.
1754	IF ( av + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 ) CONTINUE
1755
1756
1757	found = .TRUE.
1758
1759	SELECT CASE ( TRIM( variable ) )
1760
1761	! CASE ( 'u2' )
1762
1763	CASE DEFAULT
1764	found = .FALSE.
1765
1766	END SELECT
1767
1768
1769	END SUBROUTINE dynamics_data_output_3d
1770
1771
1772	!--------------------------------------------------------------------------------------------------!
1773	! Description:
1774	! ------------
1775	!> Calculation of module-specific statistics, i.e. horizontally averaged profiles and time series.
1776	!> This is called for every statistic region sr, but at least for the region "total domain" (sr=0).
1777	!--------------------------------------------------------------------------------------------------!
1778	SUBROUTINE dynamics_statistics( mode, sr, tn )
1779
1780
1781	CHARACTER (LEN=*) :: mode !<
1782	! INTEGER(iwp) :: i !<
1783	! INTEGER(iwp) :: j !<
1784	! INTEGER(iwp) :: k !<
1785	INTEGER(iwp) :: sr !<
1786	INTEGER(iwp) :: tn !<
1787
1788	!
1789	!-- Next line is to avoid compiler warning about unused variables. Please remove.
1790	IF ( sr == 0 .OR. tn == 0 ) CONTINUE
1791
1792	IF ( mode == 'profiles' ) THEN
1793
1794	ELSEIF ( mode == 'time_series' ) THEN
1795
1796	ENDIF
1797
1798	END SUBROUTINE dynamics_statistics
1799
1800
1801	!--------------------------------------------------------------------------------------------------!
1802	! Description:
1803	! ------------
1804	!> Read module-specific global restart data.
1805	!--------------------------------------------------------------------------------------------------!
1806	SUBROUTINE dynamics_rrd_global( found )
1807
1808
1809	LOGICAL, INTENT(OUT) :: found
1810
1811
1812	found = .TRUE.
1813
1814
1815	SELECT CASE ( restart_string(1:length) )
1816
1817	CASE ( 'global_paramter' )
1818	! READ ( 13 ) global_parameter
1819
1820	CASE DEFAULT
1821
1822	found = .FALSE.
1823
1824	END SELECT
1825
1826
1827	END SUBROUTINE dynamics_rrd_global
1828
1829
1830	!--------------------------------------------------------------------------------------------------!
1831	! Description:
1832	! ------------
1833	!> Read module-specific processor specific restart data from file(s).
1834	!> Subdomain index limits on file are given by nxl_on_file, etc.
1835	!> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the subdomain on file (f)
1836	!> to the subdomain of the current PE (c). They have been calculated in routine rrd_local.
1837	!--------------------------------------------------------------------------------------------------!
1838	SUBROUTINE dynamics_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
1839	nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found )
1840
1841
1842	INTEGER(iwp) :: k !<
1843	INTEGER(iwp) :: nxlc !<
1844	INTEGER(iwp) :: nxlf !<
1845	INTEGER(iwp) :: nxl_on_file !<
1846	INTEGER(iwp) :: nxrc !<
1847	INTEGER(iwp) :: nxrf !<
1848	INTEGER(iwp) :: nxr_on_file !<
1849	INTEGER(iwp) :: nync !<
1850	INTEGER(iwp) :: nynf !<
1851	INTEGER(iwp) :: nyn_on_file !<
1852	INTEGER(iwp) :: nysc !<
1853	INTEGER(iwp) :: nysf !<
1854	INTEGER(iwp) :: nys_on_file !<
1855
1856	LOGICAL, INTENT(OUT) :: found
1857
1858	REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !<
1859	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
1860
1861	!
1862	!-- Next line is to avoid compiler warning about unused variables. Please remove.
1863	IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf + &
1864	tmp_2d(nys_on_file,nxl_on_file) + &
1865	tmp_3d(nzb,nys_on_file,nxl_on_file) < 0.0 ) CONTINUE
1866	!
1867	!-- Here the reading of user-defined restart data follows:
1868	!-- Sample for user-defined output
1869
1870	found = .TRUE.
1871
1872	SELECT CASE ( restart_string(1:length) )
1873
1874	! CASE ( 'u2_av' )
1875
1876	CASE DEFAULT
1877
1878	found = .FALSE.
1879
1880	END SELECT
1881
1882	END SUBROUTINE dynamics_rrd_local
1883
1884
1885	!--------------------------------------------------------------------------------------------------!
1886	! Description:
1887	! ------------
1888	!> Writes global module-specific restart data into binary file(s) for restart runs.
1889	!--------------------------------------------------------------------------------------------------!
1890	SUBROUTINE dynamics_wrd_global
1891
1892
1893	END SUBROUTINE dynamics_wrd_global
1894
1895
1896	!--------------------------------------------------------------------------------------------------!
1897	! Description:
1898	! ------------
1899	!> Writes processor specific and module-specific restart data into binary file(s) for restart runs.
1900	!--------------------------------------------------------------------------------------------------!
1901	SUBROUTINE dynamics_wrd_local
1902
1903
1904	END SUBROUTINE dynamics_wrd_local
1905
1906
1907	!--------------------------------------------------------------------------------------------------!
1908	! Description:
1909	! ------------
1910	!> Execute module-specific actions at the very end of the program.
1911	!--------------------------------------------------------------------------------------------------!
1912	SUBROUTINE dynamics_last_actions
1913
1914
1915	END SUBROUTINE dynamics_last_actions
1916
1917	END MODULE dynamics_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |