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

Last change on this file since 4855 was 4853, checked in by raasch, 4 years ago

array sizes for output profiles increased from 300 to 400

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