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

Last change on this file since 3755 was 3747, checked in by gronemeier, 6 years ago

bugfix: set user-defined statistic regions within new routine user_init_arrays and initialize rmask before this routine is called. This ensures that the correct number of grid points is calculated for each statistic region within init_3d_model.
(init_3d_model, module_interface, user_module)
bugfix: update former revisions section (modules, parin)

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