Home

Context Navigation

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

Last change on this file since 4847 was 4845, checked in by raasch, 4 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

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 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.
8	!
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.
12	!
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/>.
15	!
16	! Copyright 1997-2021 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! -----------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: dynamics_mod.f90 4845 2021-01-18 11:15:37Z raasch $
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
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
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
38	! Enable 3D data output also with 64-bit precision
39	!
40	! 4760 2020-10-26 13:26:47Z schwenkel
41	! Implement relative humidity as diagnostic output quantity
42	!
43	! 4731 2020-10-07 13:25:11Z schwenkel
44	! Move exchange_horiz from time_integration to modules
45	!
46	! 4627 2020-07-26 10:14:44Z raasch
47	! bugfix for r4626
48	!
49	! 4626 2020-07-26 09:49:48Z raasch
50	! file re-formatted to follow the PALM coding standard
51	!
52	! 4517 2020-05-03 14:29:30Z raasch
53	! added restart with MPI-IO for reading local arrays
54	!
55	! 4505 2020-04-20 15:37:15Z schwenkel
56	! Add flag for saturation check
57	!
58	! 4495 2020-04-13 20:11:20Z resler
59	! restart data handling with MPI-IO added
60	!
61	! 4360 2020-01-07 11:25:50Z suehring
62	! Bugfix for last commit.
63	!
64	! 4359 2019-12-30 13:36:50Z suehring
65	! Refine post-initialization check for realistically inital values of mixing ratio. Give an error
66	! message for faulty initial values, but only a warning in a restart run.
67	!
68	! 4347 2019-12-18 13:18:33Z suehring
69	! Implement post-initialization check for realistically inital values of mixing ratio
70	!
71	! 4281 2019-10-29 15:15:39Z schwenkel
72	! Moved boundary conditions in dynamics module
73	!
74	! 4097 2019-07-15 11:59:11Z suehring
75	! Avoid overlong lines - limit is 132 characters per line
76	!
77	! 4047 2019-06-21 18:58:09Z knoop
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
88	USE arrays_3d, &
89	ONLY: diss, &
90	diss_p, &
91	dzu, &
92	e, &
93	e_p, &
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, &
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, &
102	zu
103
104	USE basic_constants_and_equations_mod, &
105	ONLY: magnus, &
106	rd_d_rv
107
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, &
121	constant_diffusion, &
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, &
141	rans_mode, &
142	rans_tke_e, &
143	tsc
144
145	USE exchange_horiz_mod, &
146	ONLY: exchange_horiz
147
148
149	USE grid_variables, &
150	ONLY: ddx, &
151	ddy, &
152	dx, &
153	dy
154
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, &
168	nzt
169
170	USE kinds
171
172	USE pegrid
173
174	USE pmc_interface, &
175	ONLY : nesting_mode
176
177	! USE restart_data_mpi_io_mod, &
178	! ONLY:
179
180	USE surface_mod, &
181	ONLY : bc_h
182
183
184	IMPLICIT NONE
185
186	LOGICAL :: dynamics_module_enabled = .FALSE. !<
187
188	SAVE
189
190	PRIVATE
191
192	!
193	!-- Public functions
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, &
220	dynamics_last_actions
221
222	!
223	!-- Public parameters, constants and initial values
224	PUBLIC &
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
290	INTERFACE dynamics_boundary_conditions
291	MODULE PROCEDURE dynamics_boundary_conditions
292	END INTERFACE dynamics_boundary_conditions
293
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
315	MODULE PROCEDURE dynamics_rrd_global_ftn
316	MODULE PROCEDURE dynamics_rrd_global_mpi
317	END INTERFACE dynamics_rrd_global
318
319	INTERFACE dynamics_rrd_local
320	MODULE PROCEDURE dynamics_rrd_local_ftn
321	MODULE PROCEDURE dynamics_rrd_local_mpi
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
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
350
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
354
355	NAMELIST /dynamics_parameters/ switch_off_module
356
357
358	!
359	!-- For the time beeing (unless the dynamics module is further developed), set default module
360	!-- switch to true.
361	dynamics_module_enabled = .TRUE.
362
363	!
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 )
367
368	!
369	!-- Action depending on the READ status
370	IF ( io_status == 0 ) THEN
371	!
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	!
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 )
382
383	ENDIF
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
406	INTEGER(iwp), INTENT(IN) :: dots_max
407
408	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
409	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
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
431	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
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
480	!--------------------------------------------------------------------------------------------------!
481	!
482	! Description:
483	! ------------
484	!> Initialize module-specific masked output
485	!--------------------------------------------------------------------------------------------------!
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
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
538
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
544	REAL(wp) :: rh_check = 9999999.9_wp !< relative humidity
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
548
549	!
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
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
555	!-- the saturation moisture. This case a warning is given.
556	IF ( humidity .AND. .NOT. neutral .AND. check_realistic_q ) THEN
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
567	IF ( q(k,j,i) > 1.02_wp * q_s ) THEN
568	realistic_q = .FALSE.
569	rh_check = q(k,j,i) / q_s * 100.0_wp
570	height = zu(k)
571	ENDIF
572	ENDDO
573	ENDDO
574	ENDDO
575	!
576	!-- Since the check is performed locally, merge the logical flag from all mpi ranks,
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)
580	CALL MPI_ALLREDUCE( rh_check, rh_min, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
581	CALL MPI_ALLREDUCE( height, min_height, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
582	#endif
583
584	IF ( .NOT. realistic_q .AND. &
585	TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
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'
588	CALL message( 'dynamic_init_checks', 'PA0697', 2, 2, 0, 6, 0 )
589	ELSEIF ( .NOT. realistic_q .AND. &
590	TRIM( initializing_actions ) == 'read_restart_data' ) THEN
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'
593	CALL message( 'dynamic_init_checks', 'PA0697', 0, 1, 0, 6, 0 )
594	ENDIF
595	ENDIF
596
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'/)
657	110 FORMAT (//1X,78('#') &
658	//' User-defined variables and actions:'/ &
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
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
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
747	!
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	!--------------------------------------------------------------------------------------------------!
816	SUBROUTINE dynamics_exchange_horiz( location )
817
818	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
819
820	SELECT CASE ( location )
821
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
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
874	INTEGER(iwp), INTENT(IN) :: i_omp_start !< first loop index of i-loop in prognostic_equations
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
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
935	IF ( .NOT. child_domain .AND. .NOT. nesting_offline .AND. &
936	TRIM(coupling_mode) /= 'vnested_fine' ) THEN
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.
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.
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	!
993	!-- Boundary conditions for total water content, bottom and top boundary (see also temperature)
994	IF ( humidity ) THEN
995	!
996	!-- Surface conditions for constant_humidity_flux
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
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	!
1032	!-- Boundary conditions for scalar, bottom and top boundary (see also temperature)
1033	IF ( passive_scalar ) THEN
1034	!
1035	!-- Surface conditions for constant_humidity_flux
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
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	!
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.
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	!
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.
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.
1100	!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
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.
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.
1131	IF ( bc_radiation_s ) THEN
1132	u_p(:,-1,:) = u(:,0,:)
1133	v_p(:,0,:) = v(:,1,:)
1134	w_p(:,-1,:) = w(:,0,:)
1135	ENDIF
1136
1137	IF ( bc_radiation_n ) THEN
1138	u_p(:,ny+1,:) = u(:,ny,:)
1139	v_p(:,ny+1,:) = v(:,ny,:)
1140	w_p(:,ny+1,:) = w(:,ny,:)
1141	ENDIF
1142
1143	IF ( bc_radiation_l ) THEN
1144	u_p(:,:,0) = u(:,:,1)
1145	v_p(:,:,-1) = v(:,:,0)
1146	w_p(:,:,-1) = w(:,:,0)
1147	ENDIF
1148
1149	IF ( bc_radiation_r ) THEN
1150	u_p(:,:,nx+1) = u(:,:,nx)
1151	v_p(:,:,nx+1) = v(:,:,nx)
1152	w_p(:,:,nx+1) = w(:,:,nx)
1153	ENDIF
1154
1155	END SUBROUTINE dynamics_boundary_conditions
1156
1157
1158	!--------------------------------------------------------------------------------------------------!
1159	! Description:
1160	! ------------
1161	!> Swap timelevels of module-specific array pointers
1162	!--------------------------------------------------------------------------------------------------!
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	! ------------
1209	!> Sum up and time-average module-specific output quantities as well as allocate the array necessary
1210	!> for storing the average.
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	! ------------
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.
1259	!> Allowed values for grid are "zu" and "zw".
1260	!--------------------------------------------------------------------------------------------------!
1261	SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, &
1262	nzt_do, fill_value )
1263
1264
1265	CHARACTER (LEN=*) :: grid !<
1266	CHARACTER (LEN=*), INTENT(IN) :: mode !< either 'xy', 'xz' or 'yz'
1267	CHARACTER (LEN=*) :: variable !<
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	! ------------
1307	!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
1308	!> indices (i,j,k).
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
1326	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
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	! ------------
1380	!> Read module-specific global restart data (Fortran binary format).
1381	!--------------------------------------------------------------------------------------------------!
1382	SUBROUTINE dynamics_rrd_global_ftn( found )
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
1402	END SUBROUTINE dynamics_rrd_global_ftn
1403
1404
1405	!--------------------------------------------------------------------------------------------------!
1406	! Description:
1407	! ------------
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	! ------------
1421	!> Read module-specific local restart data arrays (Fortran binary format).
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	!--------------------------------------------------------------------------------------------------!
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 )
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.
1452	IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf + &
1453	tmp_2d(nys_on_file,nxl_on_file) + &
1454	tmp_3d(nzb,nys_on_file,nxl_on_file) < 0.0 ) CONTINUE
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
1471	END SUBROUTINE dynamics_rrd_local_ftn
1472
1473
1474	!--------------------------------------------------------------------------------------------------!
1475	! Description:
1476	! ------------
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	! ------------
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
1530	END MODULE dynamics_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |