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

Last change on this file since 3687 was 3687, checked in by knoop, 3 years ago

Moved all user routunes that are dependencies of the PALM core only, to user_module.f90
The files that formerly contained these routines, have been deleted.
Also module_interface routines for init_mask and last_actions have been added.

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