source: palm/trunk/TUTORIALS/cases/lsm_short/USER_CODE/user_module.f90 @ 4370

Last change on this file since 4370 was 4370, checked in by raasch, 21 months ago

bugfixes for previous commit: unused variables removed, Temperton-fft usage on GPU, openacc porting of vector version of Obukhov length calculation, collective read switched off on NEC to avoid hanging; some vector directives added in prognostic equations to force vectorization on Intel19 compiler, configuration files for NEC Aurora added

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