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

Last change on this file since 4504 was 4504, checked in by raasch, 14 months ago

file re-formatted to follow the PALM coding standard, hint for setting rmask arrays added

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