source: palm/trunk/TUTORIALS/cases/dispersion_eulerian_and_lpm_extended/USER_CODE/user_module.f90

Last change on this file was 4843, checked in by raasch, 21 months ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

File size: 46.9 KB
Line 
1!> @file user_module.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!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: user_module.f90 4517 2020-05-03 14:29:30Z raasch $
27! Modified user-interface has been adapted to r4521
28!
29! 4517 2020-05-03 14:29:30Z raasch
30! added restart with MPI-IO for reading local arrays
31!
32! 4504 2020-04-20 12:11:24Z raasch
33! hint for setting rmask arrays added
34!
35! 4497 2020-04-15 10:20:51Z raasch
36! file re-formatted to follow the PALM coding standard
37!
38! 4495 2020-04-13 20:11:20Z raasch
39! restart data handling with MPI-IO added
40!
41! 4360 2020-01-07 11:25:50Z suehring
42! Introduction of wall_flags_total_0, which currently sets bits based on static topography
43! information used in wall_flags_static_0
44!
45! 4329 2019-12-10 15:46:36Z motisi
46! Renamed wall_flags_0 to wall_flags_static_0
47!
48! 4287 2019-11-01 14:50:20Z raasch
49! reading of namelist file and actions in case of namelist errors revised so that statement labels
50! and goto statements are not required any more; this revision also removes a previous bug which
51! appeared when the namelist has been commented out in the namelist file
52!
53! 4182 2019-08-22 15:20:23Z scharf
54! Corrected "Former revisions" section
55!
56! 3986 2019-05-20 14:08:14Z Giersch
57! Redundant integration of control parameters in user_rrd_global removed
58!
59! 3911 2019-04-17 12:26:19Z knoop
60! Bugfix: added before_prognostic_equations case in user_actions
61!
62! 3768 2019-02-27 14:35:58Z raasch
63! variables commented + statements added to avoid compiler warnings about unused variables
64!
65! 3767 2019-02-27 08:18:02Z raasch
66! unused variable for file index removed from rrd-subroutines parameter list
67!
68! 3747 2019-02-16 15:15:23Z gronemeier
69! Add routine user_init_arrays
70!
71! 3703 2019-01-29 16:43:53Z knoop
72! An example for a user defined global variable has been added (Giersch)
73!
74! Revision 1.1  1998/03/24 15:29:04  raasch
75! Initial revision
76!
77!
78! Description:
79! ------------
80!> Declaration of user-defined variables. This module may only be used in the user-defined routines
81!> (contained in user_interface.f90).
82!--------------------------------------------------------------------------------------------------!
83 MODULE user
84
85    USE arrays_3d
86
87    USE control_parameters
88
89    USE cpulog
90
91    USE indices
92
93    USE kinds
94
95    USE pegrid
96
97    USE statistics
98
99    USE surface_mod
100
101    IMPLICIT NONE
102
103    INTEGER(iwp) ::  dots_num_palm      !<
104    INTEGER(iwp) ::  dots_num_user = 0  !<
105    INTEGER(iwp) ::  user_idummy        !<
106
107    LOGICAL ::  user_module_enabled = .FALSE.  !<
108
109    REAL(wp) ::  user_rdummy  !<
110
111!
112!-- Sample for user-defined output
113!    REAL(wp) :: global_parameter  !< user defined global parameter
114!
115!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2      !< user defined array
116!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2_av   !< user defined array
117!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ustvst  !< user defined array
118
119!
120!-- User-defined parameters
121    INTEGER(iwp), DIMENSION(1:3) ::  s_ts_pos_x_ind = 0
122    INTEGER(iwp), DIMENSION(1:3) ::  s_ts_pos_y_ind = 0
123    INTEGER(iwp)                 ::  size_of_pos_array
124
125    REAL(wp)                 ::  emission_stripe_width_y = 0.0_wp
126    REAL(wp), DIMENSION(1:2) ::  emission_stripe_orig_y = 0.0_wp
127    REAL(wp), DIMENSION(1:3) ::  s_ts_pos_x = 0.0
128    REAL(wp), DIMENSION(1:3) ::  s_ts_pos_y = 0.0
129    SAVE
130
131    PRIVATE
132
133!
134!- Public functions
135    PUBLIC                                                                                         &
136       user_actions,                                                                               &
137       user_check_data_output,                                                                     &
138       user_check_data_output_pr,                                                                  &
139       user_check_data_output_ts,                                                                  &
140       user_check_parameters,                                                                      &
141       user_data_output_2d,                                                                        &
142       user_data_output_3d,                                                                        &
143       user_define_netcdf_grid,                                                                    &
144       user_header,                                                                                &
145       user_init,                                                                                  &
146       user_init_arrays,                                                                           &
147       user_last_actions,                                                                          &
148       user_parin,                                                                                 &
149       user_rrd_global,                                                                            &
150       user_rrd_local,                                                                             &
151       user_statistics,                                                                            &
152       user_3d_data_averaging,                                                                     &
153       user_wrd_global,                                                                            &
154       user_wrd_local
155
156
157!
158!- Public parameters, constants and initial values
159   PUBLIC                                                                                          &
160      user_module_enabled
161
162    INTERFACE user_parin
163       MODULE PROCEDURE user_parin
164    END INTERFACE user_parin
165
166    INTERFACE user_check_parameters
167       MODULE PROCEDURE user_check_parameters
168    END INTERFACE user_check_parameters
169
170    INTERFACE user_check_data_output_ts
171       MODULE PROCEDURE user_check_data_output_ts
172    END INTERFACE user_check_data_output_ts
173
174    INTERFACE user_check_data_output_pr
175       MODULE PROCEDURE user_check_data_output_pr
176    END INTERFACE user_check_data_output_pr
177
178    INTERFACE user_check_data_output
179       MODULE PROCEDURE user_check_data_output
180    END INTERFACE user_check_data_output
181
182    INTERFACE user_define_netcdf_grid
183       MODULE PROCEDURE user_define_netcdf_grid
184    END INTERFACE user_define_netcdf_grid
185
186    INTERFACE user_init
187       MODULE PROCEDURE user_init
188    END INTERFACE user_init
189
190    INTERFACE user_init_arrays
191       MODULE PROCEDURE user_init_arrays
192    END INTERFACE user_init_arrays
193
194    INTERFACE user_header
195       MODULE PROCEDURE user_header
196    END INTERFACE user_header
197
198    INTERFACE user_actions
199       MODULE PROCEDURE user_actions
200       MODULE PROCEDURE user_actions_ij
201    END INTERFACE user_actions
202
203    INTERFACE user_3d_data_averaging
204       MODULE PROCEDURE user_3d_data_averaging
205    END INTERFACE user_3d_data_averaging
206
207    INTERFACE user_data_output_2d
208       MODULE PROCEDURE user_data_output_2d
209    END INTERFACE user_data_output_2d
210
211    INTERFACE user_data_output_3d
212       MODULE PROCEDURE user_data_output_3d
213    END INTERFACE user_data_output_3d
214
215    INTERFACE user_statistics
216       MODULE PROCEDURE user_statistics
217    END INTERFACE user_statistics
218
219    INTERFACE user_rrd_global
220       MODULE PROCEDURE user_rrd_global_ftn
221       MODULE PROCEDURE user_rrd_global_mpi
222    END INTERFACE user_rrd_global
223
224    INTERFACE user_rrd_local
225       MODULE PROCEDURE user_rrd_local_ftn
226       MODULE PROCEDURE user_rrd_local_mpi
227    END INTERFACE user_rrd_local
228
229    INTERFACE user_wrd_global
230       MODULE PROCEDURE user_wrd_global
231    END INTERFACE user_wrd_global
232
233    INTERFACE user_wrd_local
234       MODULE PROCEDURE user_wrd_local
235    END INTERFACE user_wrd_local
236
237    INTERFACE user_last_actions
238       MODULE PROCEDURE user_last_actions
239    END INTERFACE user_last_actions
240
241
242 CONTAINS
243
244
245!--------------------------------------------------------------------------------------------------!
246! Description:
247! ------------
248!> Parin for &user_parameters for user module
249!--------------------------------------------------------------------------------------------------!
250 SUBROUTINE user_parin
251
252    CHARACTER (LEN=80) ::  line  !< string containing the last line read from namelist file
253
254    INTEGER(iwp) ::  i          !<
255    INTEGER(iwp) ::  io_status  !< status after reading the namelist file
256    INTEGER(iwp) ::  j          !<
257
258
259    NAMELIST /user_parameters/                                                                     &
260       data_output_masks_user,                                                                     &
261       data_output_pr_user,                                                                        &
262       data_output_user,                                                                           &
263       region,                                                                                     &
264       emission_stripe_orig_y,                                                                     &
265       emission_stripe_width_y,                                                                    &
266       s_ts_pos_x,                                                                                 &
267       s_ts_pos_y
268
269
270!
271!-- Next statement is to avoid compiler warnings about unused variables. Please remove in case
272!-- that you are using them.
273    IF ( dots_num_palm == 0  .OR.  dots_num_user == 0  .OR.  user_idummy == 0  .OR.                &
274         user_rdummy == 0.0_wp )  CONTINUE
275
276!
277!-- Set revision number of this default interface version. It will be checked within the main
278!-- program (palm). Please change the revision number in case that the current revision does not
279!-- match with previous revisions (e.g. if routines have been added/deleted or if parameter lists
280!-- in subroutines have been changed).
281    user_interface_current_revision = 'r4495'
282
283!
284!-- Position the namelist-file at the beginning (it has already been opened in parin), and try to
285!-- read (find) a namelist named "user_parameters".
286    REWIND ( 11 )
287    READ( 11, user_parameters, IOSTAT=io_status )
288
289!
290!-- Actions depending on the READ status
291    IF ( io_status == 0 )  THEN
292!
293!--    User namelist found and correctly read. Set default module switch to true. This activates
294!--    calls of the user-interface subroutines.
295       user_module_enabled = .TRUE.
296
297    ELSEIF ( io_status > 0 )  THEN
298!
299!--    User namelist was found, but contained errors. Print an error message containing the line
300!--    that caused the problem
301       BACKSPACE( 11 )
302       READ( 11 , '(A)') line
303       CALL parin_fail_message( 'user_parameters', line )
304
305    ENDIF
306
307!
308!-- Determine the number of user-defined profiles and append them to the standard data output
309!-- (data_output_pr)
310    IF ( user_module_enabled )  THEN
311       IF ( data_output_pr_user(1) /= ' ' )  THEN
312          i = 1
313          DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
314             i = i + 1
315          ENDDO
316          j = 1
317          DO WHILE ( data_output_pr_user(j) /= ' '  .AND.  j <= 100 )
318             data_output_pr(i) = data_output_pr_user(j)
319             max_pr_user_tmp   = max_pr_user_tmp + 1
320             i = i + 1
321             j = j + 1
322          ENDDO
323       ENDIF
324    ENDIF
325
326
327 END SUBROUTINE user_parin
328
329
330!--------------------------------------------------------------------------------------------------!
331! Description:
332! ------------
333!> Check &userpar control parameters and deduce further quantities.
334!--------------------------------------------------------------------------------------------------!
335 SUBROUTINE user_check_parameters
336
337!
338!-- Here the user may add code to check the validity of further &userpar control parameters or
339!-- deduce further quantities.
340
341
342 END SUBROUTINE user_check_parameters
343
344
345!--------------------------------------------------------------------------------------------------!
346! Description:
347! ------------
348!> Set module-specific timeseries units and labels
349!--------------------------------------------------------------------------------------------------!
350 SUBROUTINE user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
351
352    INTEGER(iwp),      INTENT(IN)     ::  dots_max  !<
353    INTEGER(iwp),      INTENT(INOUT)  ::  dots_num  !<
354
355    CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT)  ::  dots_label  !<
356    CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT)  ::  dots_unit   !<
357
358    INTEGER(iwp)  ::  i
359    CHARACTER(LEN=7)   ::  i_char = ''
360
361!
362!-- Next line is to avoid compiler warning about unused variables. Please remove.
363    IF ( dots_num == 0  .OR.  dots_label(1)(1:1) == ' '  .OR.  dots_unit(1)(1:1) == ' ' )  CONTINUE
364
365!
366!-- Sample for user-defined time series:
367!-- For each time series quantity you have to give a label and a unit, which will be used for the
368!-- NetCDF file. They must not contain more than seven characters. The value of dots_num has to be
369!-- increased by the number of new time series quantities. Its old value has to be stored in
370!-- dots_num_palm. See routine user_statistics on how to calculate and output these quantities.
371
372!    dots_num_palm = dots_num
373
374!    dots_num = dots_num + 1
375!    dots_num_user = dots_num_user + 1
376!    dots_label(dots_num) = 'abs_umx'
377!    dots_unit(dots_num)  = 'm/s'
378
379!    dots_num = dots_num + 1
380!    dots_num_user = dots_num_user + 1
381!    dots_label(dots_num) = 'abs_vmx'
382!    dots_unit(dots_num)  = 'm/s'
383
384!
385!-- Additional timeseries output
386    size_of_pos_array = SIZE(s_ts_pos_x)
387   
388    DO  i = 1, size_of_pos_array
389       WRITE (i_char,'(''_'',I3.3)')  i
390       dots_label(dots_num+i) = 's_pos' // TRIM(i_char)
391       dots_unit(dots_num+i)  = 'kg'
392    ENDDO
393
394    dots_num_palm = dots_num
395    dots_num = dots_num + size_of_pos_array
396
397 END SUBROUTINE user_check_data_output_ts
398
399
400!--------------------------------------------------------------------------------------------------!
401! Description:
402! ------------
403!> Set the unit of user defined profile output quantities. For those variables not recognized by the
404!> user, the parameter unit is set to "illegal", which tells the calling routine that the
405!> output variable is not defined and leads to a program abort.
406!--------------------------------------------------------------------------------------------------!
407 SUBROUTINE user_check_data_output_pr( variable, var_count, unit, dopr_unit )
408
409
410    USE profil_parameter
411
412
413    CHARACTER (LEN=*) ::  unit      !<
414    CHARACTER (LEN=*) ::  variable  !<
415    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
416
417!    INTEGER(iwp) ::  user_pr_index  !<
418    INTEGER(iwp) ::  var_count      !<
419
420!
421!-- Next line is to avoid compiler warning about unused variables. Please remove.
422    IF ( unit(1:1) == ' '  .OR.  dopr_unit(1:1) == ' '  .OR.  var_count == 0 )  CONTINUE
423
424    SELECT CASE ( TRIM( variable ) )
425
426!
427!--    Uncomment and extend the following lines, if necessary.
428!--    Add additional CASE statements depending on the number of quantities for which profiles are
429!--    to be calculated. The respective calculations to be performed have to be added in routine
430!--    user_statistics. The quantities are (internally) identified by a user-profile-number
431!--    (see variable "user_pr_index" below). The first user-profile must be assigned the number
432!--    "pr_palm+1", the second one "pr_palm+2", etc. The respective user-profile-numbers have also
433!--    to be used in routine user_statistics!
434!       CASE ( 'u*v*' )                      ! quantity string as given in data_output_pr_user
435!          user_pr_index = pr_palm + 1
436!          dopr_index(var_count)  = user_pr_index    ! quantities' user-profile-number
437!          dopr_unit = 'm2/s2'  ! quantity unit
438!          unit = dopr_unit
439!          hom(:,2,user_pr_index,:) = SPREAD( zu, 2, statistic_regions+1 )
440!                                            ! grid on which the quantity is defined (use zu or zw)
441!
442
443       CASE DEFAULT
444          unit = 'illegal'
445
446    END SELECT
447
448
449 END SUBROUTINE user_check_data_output_pr
450
451
452!--------------------------------------------------------------------------------------------------!
453! Description:
454! ------------
455!> Set the unit of user defined output quantities. For those variables not recognized by the user,
456!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
457!> is not defined and leads to a program abort.
458!--------------------------------------------------------------------------------------------------!
459 SUBROUTINE user_check_data_output( variable, unit )
460
461
462    CHARACTER (LEN=*) ::  unit      !<
463    CHARACTER (LEN=*) ::  variable  !<
464
465
466    SELECT CASE ( TRIM( variable ) )
467
468!
469!--    Uncomment and extend the following lines, if necessary
470!       CASE ( 'u2' )
471!          unit = 'm2/s2'
472!
473!       CASE ( 'u*v*' )
474!          unit = 'm2/s2'
475!
476       CASE DEFAULT
477          unit = 'illegal'
478
479    END SELECT
480
481
482 END SUBROUTINE user_check_data_output
483
484
485!--------------------------------------------------------------------------------------------------!
486! Description:
487! ------------
488!> Initialize user-defined arrays
489!--------------------------------------------------------------------------------------------------!
490 SUBROUTINE user_init_arrays
491
492
493!    INTEGER(iwp) :: i       !< loop index
494!    INTEGER(iwp) :: j       !< loop index
495!    INTEGER(iwp) :: region  !< index for loop over statistic regions
496
497!
498!-- Allocate user-defined arrays and set flags for statistic regions.
499!-- Sample for user-defined output
500!    ALLOCATE( u2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
501!    ALLOCATE( ustvst(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
502
503!
504!-- Example for defining a statistic region:
505!-- ATTENTION: rmask = 0 is required at the ghost boundaries to guarantee correct statistic
506!--            evaluations (otherwise ghost points would be counted twice). This setting has
507!--            already been cared for in routine init_3d_model. Please don't set the ghost points
508!--            /= 0. i.e. run the following loop only over nxl,nxr and nys,nyn.
509!     IF ( statistic_regions >= 1 )  THEN
510!        region = 1
511!
512!        rmask(:,:,region) = 0.0_wp
513!        DO  i = nxl, nxr
514!           IF ( i >= INT( 0.25 * nx ) .AND. i <= INT( 0.75 * nx ) )  THEN
515!              DO  j = nys, nyn
516!                 IF ( i >= INT( 0.25 * ny ) .AND. i <= INT( 0.75 * ny ) )  THEN
517!                    rmask(j,i,region) = 1.0_wp
518!                 ENDIF
519!              ENDDO
520!           ENDIF
521!        ENDDO
522!
523!     ENDIF
524
525 END SUBROUTINE user_init_arrays
526
527
528!--------------------------------------------------------------------------------------------------!
529! Description:
530! ------------
531!> Execution of user-defined initializing actions
532!--------------------------------------------------------------------------------------------------!
533 SUBROUTINE user_init
534
535    USE grid_variables
536
537!    CHARACTER(LEN=20) :: field_char  !<
538
539INTEGER(iwp), DIMENSION(1:2) ::  eso_ind      !< index values of emission_stripe_orig
540    INTEGER(iwp)                 ::  esw_ind      !< index value of emission_stripe_width
541    INTEGER(iwp)                 ::  i, j, m      !< running index
542
543!
544!-- Here the user-defined initializing actions follow:
545!-- Sample for user-defined output
546!    ustvst = 0.0_wp
547
548!
549!-- Calculate indices for locations of additional timeseries output, used in
550!-- user_statistics
551    s_ts_pos_x_ind = NINT( s_ts_pos_x * ddx )
552    s_ts_pos_y_ind = NINT( s_ts_pos_y * ddy )
553   
554!
555!-- Passive scalar shall only be released from a line source of width
556!-- emission_stripe_width, stripe origin is precribed by parameter
557!-- emission_stripe_orig under &userpar
558    eso_ind = NINT( emission_stripe_orig_y * ddy )
559    esw_ind = NINT( emission_stripe_width_y * ddy )
560    WRITE(9,*) 'd', esw_ind
561    FLUSH(9)
562
563    DO i = nxl, nxr
564       DO  j = nys, nyn
565          DO m = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
566             IF ( ( eso_ind(1) <= j  .AND.  j < (eso_ind(1)+esw_ind) )  .OR.  ( eso_ind(2) <= j  .AND.  j < (eso_ind(2)+esw_ind) ) )  THEN
567                surf_def_h(0)%ssws(m) = surface_scalarflux
568             ELSE
569                surf_def_h(0)%ssws(m) = 0.0_wp
570            ENDIF
571          ENDDO
572       ENDDO
573    ENDDO   
574
575 END SUBROUTINE user_init
576
577
578!--------------------------------------------------------------------------------------------------!
579! Description:
580! ------------
581!> Set the grids on which user-defined output quantities are defined. Allowed values for grid_x are
582!> "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw".
583!--------------------------------------------------------------------------------------------------!
584 SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
585
586
587    CHARACTER (LEN=*) ::  grid_x     !<
588    CHARACTER (LEN=*) ::  grid_y     !<
589    CHARACTER (LEN=*) ::  grid_z     !<
590    CHARACTER (LEN=*) ::  variable   !<
591
592    LOGICAL ::  found   !<
593
594
595    SELECT CASE ( TRIM( variable ) )
596
597!
598!--    Uncomment and extend the following lines, if necessary
599!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
600!          found  = .TRUE.
601!          grid_x = 'xu'
602!          grid_y = 'y'
603!          grid_z = 'zu'
604
605!       CASE ( 'u*v*', 'u*v*_xy', 'u*v*_xz', 'u*v*_yz' )
606!          found  = .TRUE.
607!          grid_x = 'x'
608!          grid_y = 'y'
609!          grid_z = 'zu'
610
611       CASE DEFAULT
612          found  = .FALSE.
613          grid_x = 'none'
614          grid_y = 'none'
615          grid_z = 'none'
616
617    END SELECT
618
619
620 END SUBROUTINE user_define_netcdf_grid
621
622
623
624
625!--------------------------------------------------------------------------------------------------!
626! Description:
627! ------------
628!> Print a header with user-defined information.
629!--------------------------------------------------------------------------------------------------!
630 SUBROUTINE user_header( io )
631
632
633    INTEGER(iwp) ::  i   !<
634    INTEGER(iwp) ::  io  !<
635
636!
637!-- If no user-defined variables are read from the namelist-file, no information will be printed.
638    IF ( .NOT. user_module_enabled )  THEN
639       WRITE ( io, 100 )
640       RETURN
641    ENDIF
642
643!
644!-- Printing the information.
645    WRITE ( io, 110 )
646
647!
648!-- Parameters for traffic emission
649    WRITE ( io, 120 )
650    WRITE ( io, 121 ) emission_stripe_orig_y, emission_stripe_width_y
651   
652!
653!-- Parameters for timeseries of scalar concentration
654    WRITE ( io, 122 )
655    WRITE ( io, 123 ) s_ts_pos_x, s_ts_pos_y
656   
657    IF ( statistic_regions /= 0 )  THEN
658       WRITE ( io, 200 )
659       DO  i = 0, statistic_regions
660          WRITE ( io, 201 )  i, region(i)
661       ENDDO
662    ENDIF
663
664!
665!-- Format-descriptors
666100 FORMAT (//' *** no user-defined variables found'/)
667110 FORMAT (//1X,78('#') // ' User-defined variables and actions:' /                               &
668            ' -----------------------------------'//)
669120 FORMAT (' Parameters for traffic emission:' /)
670121 FORMAT ('stripe origin(s) in y-direction (in m): ',F5.1,', ',F5.1,' , stripe width in y-direction (in m): ',F5.1)
671122 FORMAT (' Parameters for timeseries of scalar concentration:' /)
672123 FORMAT ('x-pos of measurement (in m): ',F5.1,', ',F5.1,', ',F5.1,' , y-pos of measurement (in m): ',F5.1,', ',F5.1,', ',F5.1)
673200 FORMAT (' Output of profiles and time series for following regions:' /)
674201 FORMAT (4X,'Region ',I1,':   ',A)
675
676
677 END SUBROUTINE user_header
678
679
680!--------------------------------------------------------------------------------------------------!
681! Description:
682! ------------
683!> Call for all grid points
684!--------------------------------------------------------------------------------------------------!
685 SUBROUTINE user_actions( location )
686
687
688    CHARACTER(LEN=*) ::  location  !<
689
690!    INTEGER(iwp) ::  i  !<
691!    INTEGER(iwp) ::  j  !<
692!    INTEGER(iwp) ::  k  !<
693
694    CALL cpu_log( log_point(24), 'user_actions', 'start' )
695
696!
697!-- Here the user-defined actions follow. No calls for single grid points are allowed at locations
698!-- before and after the timestep, since these calls are not within an i,j-loop
699    SELECT CASE ( location )
700
701       CASE ( 'before_timestep' )
702!
703!--       Enter actions to be done before every timestep here
704
705       CASE ( 'before_prognostic_equations' )
706!
707!--       Enter actions to be done before all prognostic equations here
708
709       CASE ( 'after_integration' )
710!
711!--       Enter actions to be done after every time integration (before data output)
712!--       Sample for user-defined output:
713!          DO  i = nxlg, nxrg
714!             DO  j = nysg, nyng
715!                DO  k = nzb, nzt
716!                   u2(k,j,i) = u(k,j,i)**2
717!                ENDDO
718!             ENDDO
719!          ENDDO
720!          DO  i = nxlg, nxr
721!             DO  j = nysg, nyn
722!                DO  k = nzb, nzt+1
723!                   ustvst(k,j,i) =  &
724!                      ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) *                      &
725!                      ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) )
726!                ENDDO
727!             ENDDO
728!          ENDDO
729
730
731       CASE ( 'after_timestep' )
732!
733!--       Enter actions to be done after every timestep here
734
735
736       CASE ( 'u-tendency' )
737!
738!--       Enter actions to be done in the u-tendency term here
739
740
741       CASE ( 'v-tendency' )
742
743
744       CASE ( 'w-tendency' )
745
746
747       CASE ( 'pt-tendency' )
748
749
750       CASE ( 'sa-tendency' )
751
752
753       CASE ( 'e-tendency' )
754
755
756       CASE ( 'q-tendency' )
757
758
759       CASE ( 's-tendency' )
760
761
762       CASE DEFAULT
763          CONTINUE
764
765    END SELECT
766
767    CALL cpu_log( log_point(24), 'user_actions', 'stop' )
768
769 END SUBROUTINE user_actions
770
771
772!--------------------------------------------------------------------------------------------------!
773! Description:
774! ------------
775!> Call for grid point i,j
776!--------------------------------------------------------------------------------------------------!
777 SUBROUTINE user_actions_ij( i, j, location )
778
779
780    CHARACTER(LEN=*) ::  location  !<
781
782    INTEGER(iwp) ::  i  !<
783    INTEGER(iwp) ::  j  !<
784
785!
786!-- Here the user-defined actions follow
787    SELECT CASE ( location )
788
789       CASE ( 'u-tendency' )
790
791!
792!--       Next line is to avoid compiler warning about unused variables. Please remove.
793          IF ( i == 0  .OR.  j == 0 )  CONTINUE
794
795!
796!--       Enter actions to be done in the u-tendency term here
797
798
799       CASE ( 'v-tendency' )
800
801
802       CASE ( 'w-tendency' )
803
804
805       CASE ( 'pt-tendency' )
806
807
808       CASE ( 'sa-tendency' )
809
810
811       CASE ( 'e-tendency' )
812
813
814       CASE ( 'q-tendency' )
815
816
817       CASE ( 's-tendency' )
818
819
820       CASE DEFAULT
821          CONTINUE
822
823    END SELECT
824
825 END SUBROUTINE user_actions_ij
826
827
828!--------------------------------------------------------------------------------------------------!
829! Description:
830! ------------
831!> Sum up and time-average user-defined output quantities as well as allocate the array necessary
832!> for storing the average.
833!--------------------------------------------------------------------------------------------------!
834 SUBROUTINE user_3d_data_averaging( mode, variable )
835
836
837    CHARACTER(LEN=*) ::  mode      !<
838    CHARACTER(LEN=*) ::  variable  !<
839
840!    INTEGER(iwp) ::  i  !<
841!    INTEGER(iwp) ::  j  !<
842!    INTEGER(iwp) ::  k  !<
843
844    IF ( mode == 'allocate' )  THEN
845
846       SELECT CASE ( TRIM( variable ) )
847
848!
849!--       Uncomment and extend the following lines, if necessary.
850!--       The arrays for storing the user defined quantities (here u2_av) have to be declared and
851!--       defined by the user!
852!--       Sample for user-defined output:
853!          CASE ( 'u2' )
854!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
855!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
856!             ENDIF
857!             u2_av = 0.0_wp
858
859          CASE DEFAULT
860             CONTINUE
861
862       END SELECT
863
864    ELSEIF ( mode == 'sum' )  THEN
865
866       SELECT CASE ( TRIM( variable ) )
867
868!
869!--       Uncomment and extend the following lines, if necessary.
870!--       The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
871!--       and defined by the user!
872!--       Sample for user-defined output:
873!          CASE ( 'u2' )
874!             IF ( ALLOCATED( u2_av ) )  THEN
875!                DO  i = nxlg, nxrg
876!                   DO  j = nysg, nyng
877!                      DO  k = nzb, nzt+1
878!                         u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
879!                      ENDDO
880!                   ENDDO
881!                ENDDO
882!             ENDIF
883
884          CASE DEFAULT
885             CONTINUE
886
887       END SELECT
888
889    ELSEIF ( mode == 'average' )  THEN
890
891       SELECT CASE ( TRIM( variable ) )
892
893!
894!--       Uncomment and extend the following lines, if necessary.
895!--       The arrays for storing the user defined quantities (here u2_av) have to be declared and
896!--       defined by the user!
897!--       Sample for user-defined output:
898!          CASE ( 'u2' )
899!             IF ( ALLOCATED( u2_av ) )  THEN
900!                DO  i = nxlg, nxrg
901!                   DO  j = nysg, nyng
902!                      DO  k = nzb, nzt+1
903!                         u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d, KIND=wp )
904!                      ENDDO
905!                   ENDDO
906!                ENDDO
907!             ENDIF
908
909       END SELECT
910
911    ENDIF
912
913
914 END SUBROUTINE user_3d_data_averaging
915
916
917!--------------------------------------------------------------------------------------------------!
918! Description:
919! ------------
920!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
921!> (i,j,k) and sets the grid on which it is defined. Allowed values for grid are "zu" and "zw".
922!--------------------------------------------------------------------------------------------------!
923 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do )
924
925
926    CHARACTER(LEN=*) ::  grid      !<
927    CHARACTER(LEN=*) ::  variable  !<
928
929    INTEGER(iwp) ::  av      !< flag to control data output of instantaneous or time-averaged data
930!    INTEGER(iwp) ::  i       !< grid index along x-direction
931!    INTEGER(iwp) ::  j       !< grid index along y-direction
932!    INTEGER(iwp) ::  k       !< grid index along z-direction
933!    INTEGER(iwp) ::  m       !< running index surface elements
934    INTEGER(iwp) ::  nzb_do  !< lower limit of the domain (usually nzb)
935    INTEGER(iwp) ::  nzt_do  !< upper limit of the domain (usually nzt+1)
936
937    LOGICAL      ::  found  !<
938    LOGICAL      ::  two_d  !< flag parameter that indicates 2D variables (horizontal cross sections)
939
940!    REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
941
942    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
943
944!
945!-- Next line is to avoid compiler warning about unused variables. Please remove.
946    IF ( av == 0  .OR.  local_pf(nxl,nys,nzb_do) == 0.0_wp  .OR.  two_d )  CONTINUE
947
948
949    found = .TRUE.
950
951    SELECT CASE ( TRIM( variable ) )
952
953!
954!--    Uncomment and extend the following lines, if necessary.
955!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
956!--    and defined by the user!
957!--    Sample for user-defined output:
958!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
959!          IF ( av == 0 )  THEN
960!             DO  i = nxl, nxr
961!                DO  j = nys, nyn
962!                   DO  k = nzb_do, nzt_do
963!                      local_pf(i,j,k) = u2(k,j,i)
964!                   ENDDO
965!                ENDDO
966!             ENDDO
967!          ELSE
968!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
969!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
970!                u2_av = REAL( fill_value, KIND = wp )
971!             ENDIF
972!             DO  i = nxl, nxr
973!                DO  j = nys, nyn
974!                   DO  k = nzb_do, nzt_do
975!                      local_pf(i,j,k) = u2_av(k,j,i)
976!                   ENDDO
977!                ENDDO
978!             ENDDO
979!          ENDIF
980!
981!          grid = 'zu'
982!
983!--    In case two-dimensional surface variables are output, the user has to access related
984!--    surface-type. Uncomment and extend following lines appropriately (example output of vertical
985!--    surface momentum flux of u-component). Please note, surface elements can be distributed over
986!--    several data types, depending on their respective surface properties.
987!       CASE ( 'usws_xy' )
988!          IF ( av == 0 )  THEN
989!
990!--           Horizontal default-type surfaces
991!             DO  m = 1, surf_def_h(0)%ns
992!                i = surf_def_h(0)%i(m)
993!                j = surf_def_h(0)%j(m)
994!                local_pf(i,j,1) = surf_def_h(0)%usws(m)
995!             ENDDO
996!
997!--           Horizontal natural-type surfaces
998!             DO  m = 1, surf_lsm_h%ns
999!                i = surf_lsm_h%i(m)
1000!                j = surf_lsm_h%j(m)
1001!                local_pf(i,j,1) = surf_lsm_h%usws(m)
1002!             ENDDO
1003!
1004!--           Horizontal urban-type surfaces
1005!             DO  m = 1, surf_usm_h%ns
1006!                i = surf_usm_h%i(m)
1007!                j = surf_usm_h%j(m)
1008!                local_pf(i,j,1) = surf_usm_h%usws(m)
1009!             ENDDO
1010!          ENDIF
1011!
1012!          grid = 'zu'
1013!--
1014
1015
1016       CASE DEFAULT
1017          found = .FALSE.
1018          grid  = 'none'
1019
1020    END SELECT
1021
1022
1023 END SUBROUTINE user_data_output_2d
1024
1025
1026!--------------------------------------------------------------------------------------------------!
1027! Description:
1028! ------------
1029!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
1030!> (i,j,k).
1031!--------------------------------------------------------------------------------------------------!
1032 SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1033
1034
1035    CHARACTER(LEN=*) ::  variable  !<
1036
1037    INTEGER(iwp) ::  av     !<
1038!    INTEGER(iwp) ::  i      !<
1039!    INTEGER(iwp) ::  j      !<
1040!    INTEGER(iwp) ::  k      !<
1041    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
1042    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
1043
1044    LOGICAL      ::  found  !<
1045
1046!    REAL(wp) ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
1047
1048    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
1049
1050!
1051!-- Next line is to avoid compiler warning about unused variables. Please remove.
1052    IF ( av == 0  .OR.  local_pf(nxl,nys,nzb_do) == 0.0_wp )  CONTINUE
1053
1054
1055    found = .TRUE.
1056
1057    SELECT CASE ( TRIM( variable ) )
1058
1059!
1060!--    Uncomment and extend the following lines, if necessary.
1061!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
1062!--    and defined by the user!
1063!--    Sample for user-defined output:
1064!       CASE ( 'u2' )
1065!          IF ( av == 0 )  THEN
1066!             DO  i = nxl, nxr
1067!                DO  j = nys, nyn
1068!                   DO  k = nzb_do, nzt_do
1069!                      local_pf(i,j,k) = u2(k,j,i)
1070!                   ENDDO
1071!                ENDDO
1072!             ENDDO
1073!          ELSE
1074!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
1075!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1076!                u2_av = REAL( fill_value, KIND = wp )
1077!             ENDIF
1078!             DO  i = nxl, nxr
1079!                DO  j = nys, nyn
1080!                   DO  k = nzb_do, nzt_do
1081!                      local_pf(i,j,k) = u2_av(k,j,i)
1082!                   ENDDO
1083!                ENDDO
1084!             ENDDO
1085!          ENDIF
1086!
1087
1088       CASE DEFAULT
1089          found = .FALSE.
1090
1091    END SELECT
1092
1093
1094 END SUBROUTINE user_data_output_3d
1095
1096
1097!--------------------------------------------------------------------------------------------------!
1098! Description:
1099! ------------
1100!> Calculation of user-defined statistics, i.e. horizontally averaged profiles and time series.
1101!> This routine is called for every statistic region sr defined by the user, but at least for the
1102!> region "total domain" (sr=0). See section 3.5.4 on how to define, calculate, and output user
1103!> defined quantities.
1104!--------------------------------------------------------------------------------------------------!
1105 SUBROUTINE user_statistics( mode, sr, tn )
1106
1107    USE netcdf_interface,                                                      &
1108       ONLY:  dots_max
1109
1110    CHARACTER(LEN=*) ::  mode  !<
1111    INTEGER(iwp) ::  i   !<
1112!    INTEGER(iwp) ::  j   !<
1113!    INTEGER(iwp) ::  k   !<
1114    INTEGER(iwp) ::  sr  !<
1115    INTEGER(iwp) ::  tn  !<
1116
1117!    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ts_value_l  !<
1118    REAL(wp), DIMENSION(dots_num_palm+1:dots_max) ::  ts_value_l   !<
1119
1120!
1121!-- Next line is to avoid compiler warning about unused variables. Please remove.
1122    IF ( sr == 0  .OR.  tn == 0 )  CONTINUE
1123
1124    IF ( mode == 'profiles' )  THEN
1125
1126!
1127!--    Sample on how to calculate horizontally averaged profiles of user-defined quantities. Each
1128!--    quantity is identified by the index "pr_palm+#" where "#" is an integer starting from 1.
1129!--    These user-profile-numbers must also be assigned to the respective strings given by
1130!--    data_output_pr_user in routine user_check_data_output_pr.
1131!       !$OMP DO
1132!       DO  i = nxl, nxr
1133!          DO  j = nys, nyn
1134!             DO  k = nzb+1, nzt
1135!!
1136!!--             Sample on how to calculate the profile of the resolved-scale horizontal momentum
1137!!--             flux u*v*
1138!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +                                  &
1139!                                         ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *  &
1140!                                         ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) *  &
1141!                                         rmask(j,i,sr) * MERGE( 1.0_wp, 0.0_wp,                    &
1142!                                         BTEST( wall_flags_total_0(k,j,i), 0 ) )
1143!!
1144!!--             Further profiles can be defined and calculated by increasing the second index of
1145!!--             array sums_l (replace ... appropriately)
1146!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ...   * rmask(j,i,sr)
1147!             ENDDO
1148!          ENDDO
1149!       ENDDO
1150
1151    ELSEIF ( mode == 'time_series' )  THEN
1152
1153
1154!       ALLOCATE ( ts_value_l(dots_num_user) )
1155!
1156!--    Sample on how to add values for the user-defined time series quantities.
1157!--    These have to be defined before in routine user_init. This sample creates two time series for
1158!--    the absolut values of the horizontal velocities u and v.
1159!       ts_value_l = 0.0_wp
1160!       ts_value_l(1) = ABS( u_max )
1161!       ts_value_l(2) = ABS( v_max )
1162!
1163!--     Collect / send values to PE0, because only PE0 outputs the time series.
1164!--     CAUTION: Collection is done by taking the sum over all processors. You may have to normalize
1165!--              this sum, depending on the quantity that you like to calculate. For serial runs,
1166!--              nothing has to be done.
1167!--     HINT: If the time series value that you are calculating has the same value on all PEs, you
1168!--           can omit the MPI_ALLREDUCE call and assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly.
1169!#if defined( __parallel )
1170!       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
1171!       CALL MPI_ALLREDUCE( ts_value_l(1), ts_value(dots_num_palm+1,sr), dots_num_user, MPI_REAL,   &
1172!                           MPI_MAX, comm2d, ierr )
1173!#else
1174!       ts_value(dots_num_palm+1:dots_num_palm+dots_num_user,sr) = ts_value_l
1175!#endif
1176
1177       ts_value_l = 0.0_wp
1178
1179       DO  i = 1, size_of_pos_array
1180
1181          IF ( nxl <= s_ts_pos_x_ind(i)  .AND.  nxr >= s_ts_pos_x_ind(i) )  THEN
1182             IF ( nys <= s_ts_pos_y_ind(i)  .AND.  nyn >= s_ts_pos_y_ind(i) )  THEN
1183
1184                ts_value_l(dots_num_palm+i) = s(2,s_ts_pos_y_ind(i),s_ts_pos_x_ind(i))
1185
1186             ENDIF
1187          ENDIF
1188       ENDDO
1189       
1190!
1191!--     Collect / send values to PE0, because only PE0 outputs the time series.
1192!--     CAUTION: Collection is done by taking the sum over all processors.
1193!--              You may have to normalize this sum, depending on the quantity
1194!--              that you like to calculate. For serial runs, nothing has to be
1195!--              done.
1196!--     HINT: If the time series value that you are calculating has the same
1197!--           value on all PEs, you can omit the MPI_ALLREDUCE call and
1198!--           assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly.
1199#if defined( __parallel )
1200       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
1201       CALL MPI_ALLREDUCE( ts_value_l(dots_num_palm+1),                         &
1202                           ts_value(dots_num_palm+1,sr),                        &
1203                           dots_max-dots_num_palm, MPI_REAL, MPI_SUM, comm2d,   &
1204                           ierr )
1205#else
1206       ts_value(dots_num_palm+1:,sr) = ts_value_l
1207#endif
1208
1209    ENDIF
1210
1211 END SUBROUTINE user_statistics
1212
1213
1214!--------------------------------------------------------------------------------------------------!
1215! Description:
1216! ------------
1217!> Read module-specific global restart data (Fortran binary format).
1218!--------------------------------------------------------------------------------------------------!
1219 SUBROUTINE user_rrd_global_ftn( found )
1220
1221
1222    LOGICAL, INTENT(OUT)  ::  found  !<
1223
1224
1225    found = .TRUE.
1226
1227
1228    SELECT CASE ( restart_string(1:length) )
1229
1230       CASE ( 'global_paramter' )
1231!          READ ( 13 )  global_parameter
1232
1233       CASE DEFAULT
1234
1235          found = .FALSE.
1236
1237    END SELECT
1238
1239
1240 END SUBROUTINE user_rrd_global_ftn
1241
1242
1243!--------------------------------------------------------------------------------------------------!
1244! Description:
1245! ------------
1246!> Read module-specific global restart data (MPI-IO).
1247!--------------------------------------------------------------------------------------------------!
1248 SUBROUTINE user_rrd_global_mpi
1249
1250!    USE restart_data_mpi_io_mod,                                                                   &
1251!        ONLY:  rrd_mpi_io
1252
1253!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
1254    CONTINUE
1255
1256 END SUBROUTINE user_rrd_global_mpi
1257
1258
1259!--------------------------------------------------------------------------------------------------!
1260! Description:
1261! ------------
1262!> Read module-specific local restart data arrays (Fortran binary format).
1263!> Subdomain
1264!> index limits on file are given by nxl_on_file, etc. Indices nxlc, etc. indicate the range of
1265!> gridpoints to be mapped from the subdomain on file (f) to the subdomain of the current PE (c).
1266!> They have been calculated in routine rrd_local.
1267!--------------------------------------------------------------------------------------------------!
1268 SUBROUTINE user_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,   &
1269                                nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
1270
1271
1272    INTEGER(iwp) ::  idum            !<
1273    INTEGER(iwp) ::  k               !<
1274    INTEGER(iwp) ::  nxlc            !<
1275    INTEGER(iwp) ::  nxlf            !<
1276    INTEGER(iwp) ::  nxl_on_file     !<
1277    INTEGER(iwp) ::  nxrc            !<
1278    INTEGER(iwp) ::  nxrf            !<
1279    INTEGER(iwp) ::  nxr_on_file     !<
1280    INTEGER(iwp) ::  nync            !<
1281    INTEGER(iwp) ::  nynf            !<
1282    INTEGER(iwp) ::  nyn_on_file     !<
1283    INTEGER(iwp) ::  nysc            !<
1284    INTEGER(iwp) ::  nysf            !<
1285    INTEGER(iwp) ::  nys_on_file     !<
1286
1287    LOGICAL, INTENT(OUT)  ::  found  !<
1288
1289    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d  !<
1290
1291!
1292!-- Next line is to avoid compiler warning about unused variables. Please remove.
1293    idum = k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                             &
1294           INT( tmp_3d(nzb,nys_on_file,nxl_on_file) )
1295
1296!
1297!-- Here the reading of user-defined restart data follows:
1298!-- Sample for user-defined output
1299
1300    found = .TRUE.
1301
1302    SELECT CASE ( restart_string(1:length) )
1303
1304       CASE ( 'u2_av' )
1305!          IF ( .NOT. ALLOCATED( u2_av ) )  THEN
1306!               ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1307!          ENDIF
1308!          IF ( k == 1 )  READ ( 13 )  tmp_3d
1309!             u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
1310!             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1311!
1312       CASE DEFAULT
1313
1314          found = .FALSE.
1315
1316    END SELECT
1317
1318 END SUBROUTINE user_rrd_local_ftn
1319
1320
1321!--------------------------------------------------------------------------------------------------!
1322! Description:
1323! ------------
1324!> Read module-specific local restart data arrays (MPI-IO).
1325!--------------------------------------------------------------------------------------------------!
1326 SUBROUTINE user_rrd_local_mpi
1327
1328!    USE restart_data_mpi_io_mod,                                                                   &
1329!        ONLY:  rd_mpi_io_check_array, rrd_mpi_io
1330
1331!    CALL rd_mpi_io_check_array( 'u2_av' , found = array_found )
1332!    IF ( array_found )  THEN
1333!       IF ( .NOT. ALLOCATED( u2_av ) )  ALLOCATE( u2_av(nysg:nyng,nxlg:nxrg) )
1334!       CALL rrd_mpi_io( 'rad_u2_av', rad_u2_av )
1335!    ENDIF
1336
1337    CONTINUE
1338
1339 END SUBROUTINE user_rrd_local_mpi
1340
1341
1342!--------------------------------------------------------------------------------------------------!
1343! Description:
1344! ------------
1345!> Writes global and user-defined restart data into binary file(s) for restart runs.
1346!--------------------------------------------------------------------------------------------------!
1347 SUBROUTINE user_wrd_global
1348
1349!    USE restart_data_mpi_io_mod,                                                                   &
1350!        ONLY:  wrd_mpi_io
1351
1352    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
1353
1354!       CALL wrd_write_string( 'global_parameter' )
1355!       WRITE ( 14 )  global_parameter
1356
1357    ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' )  THEN
1358
1359!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
1360
1361    ENDIF
1362
1363 END SUBROUTINE user_wrd_global
1364
1365
1366!--------------------------------------------------------------------------------------------------!
1367! Description:
1368! ------------
1369!> Writes processor specific and user-defined restart data into binary file(s) for restart runs.
1370!--------------------------------------------------------------------------------------------------!
1371 SUBROUTINE user_wrd_local
1372
1373!    USE restart_data_mpi_io_mod,                                                                   &
1374!        ONLY:  wrd_mpi_io
1375
1376!
1377!-- Here the user-defined actions at the end of a job follow.
1378!-- Sample for user-defined output:
1379    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
1380
1381!       IF ( ALLOCATED( u2_av ) )  THEN
1382!          CALL wrd_write_string( 'u2_av' )
1383!          WRITE ( 14 )  u2_av
1384!       ENDIF
1385
1386    ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' )  THEN
1387
1388!       IF ( ALLOCATED( u2_av ) )  CALL wrd_mpi_io( 'u2_av', u2_av )
1389
1390    ENDIF
1391
1392 END SUBROUTINE user_wrd_local
1393
1394
1395!--------------------------------------------------------------------------------------------------!
1396! Description:
1397! ------------
1398!> Execution of user-defined actions at the end of a job.
1399!--------------------------------------------------------------------------------------------------!
1400 SUBROUTINE user_last_actions
1401
1402!
1403!-- Here the user-defined actions at the end of a job might follow.
1404
1405
1406 END SUBROUTINE user_last_actions
1407
1408 END MODULE user
Note: See TracBrowser for help on using the repository browser.