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

Last change on this file since 3700 was 3700, checked in by knoop, 5 years ago

Moved user_define_netdf_grid into user_module.f90
Added module interface for the definition of additional timeseries

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