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

Last change on this file since 4768 was 4768, checked in by suehring, 6 months ago

Enable 3D data output also with 64-bit precision

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