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

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