source: palm/trunk/SOURCE/dynamics_mod.f90

Last change on this file was 4851, checked in by gronemeier, 5 months 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 banzhafs $
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
653100 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.