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

Last change on this file since 3890 was 3768, checked in by raasch, 6 years ago

variables commented out + statement added to avoid compiler warnings about unused variables

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