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

Last change on this file since 4452 was 4360, checked in by suehring, 5 years ago

Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update

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