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

Last change on this file since 4843 was 4843, checked in by raasch, 3 years ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

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