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

Last change on this file since 4313 was 4287, checked in by raasch, 20 months 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 suehring $
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.