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

Last change on this file since 3767 was 3767, checked in by raasch, 2 years ago

unused variables removed from rrd-subroutines parameter list

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