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

Last change on this file since 4287 was 4287, checked in by raasch, 3 years ago

reading of namelist file and actions in case of namelist errors revised so that statement labels and goto statements are not required any more; this revision also removes a previous bug which appeared when the namelist has been commented out in the namelist file

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