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

Last change on this file since 3701 was 3701, checked in by knoop, 6 years ago

Added module switch for user_module.
User module is enabled as soon as the user_parameters namelist is found.

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