source: palm/trunk/SOURCE/user_module.f90

Last change on this file was 4856, checked in by raasch, 4 months ago

array sizes for output profiles increased from 400 to 500

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