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

Last change on this file since 4180 was 4180, checked in by scharf, 2 years ago

removed comments in 'Former revisions' section that are older than 01.01.2019

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