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

Last change on this file since 3939 was 3911, checked in by knoop, 5 years ago

Bugfix: added before_prognostic_equations case in user_actions and introduced user_interface testcase

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