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

Last change on this file since 4850 was 4845, checked in by raasch, 3 years ago

maximum phase velocities are alwasy used for radiation boundary conditions, parameter use_cmax removed

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