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

Last change on this file since 4343 was 4329, checked in by motisi, 22 months ago

Renamed wall_flags_0 to wall_flags_static_0

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