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

Last change on this file since 4495 was 4495, checked in by raasch, 5 years ago

restart data handling with MPI-IO added, first part

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