source: palm/trunk/TESTS/cases/lsm_short/USER_CODE/user_module.f90 @ 4002

Last change on this file since 4002 was 4002, checked in by Giersch, 2 years ago

renaming of some test cases, exercises of PALM tutorial added as test cases with empty core list

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