Home

Context Navigation

dynamics_mod.f90 @ 4856

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

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

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

Context Navigation

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

Download in other formats: