source: palm/trunk/SOURCE/user_module.f90 @ 4651

Last change on this file since 4651 was 4535, checked in by raasch, 4 years ago

bugfix for restart data format query

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