source: palm/tags/release-3.2b/SOURCE/user_interface.f90 @ 3900

Last change on this file since 3900 was 90, checked in by raasch, 17 years ago

New:
---
Calculation and output of user-defined profiles. New &userpar parameters data_output_pr_user and max_pr_user.

check_parameters, flow_statistics, modules, parin, read_var_list, user_interface, write_var_list

Changed:


Division through dt_3d replaced by multiplication of the inverse. For performance optimisation, this is done in the loop calculating the divergence instead of using a seperate loop. (pres.f90) var_hom and var_sum renamed pr_palm.

data_output_profiles, flow_statistics, init_3d_model, modules, parin, pres, read_var_list, run_control, time_integration

Errors:


Bugfix: work_fft*_vec removed from some PRIVATE-declarations (poisfft).

Bugfix: field_chr renamed field_char (user_interface).

Bugfix: output of use_upstream_for_tke (header).

header, poisfft, user_interface

  • Property svn:keywords set to Id
File size: 26.4 KB
Line 
1 MODULE user
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: user_interface.f90 90 2007-05-30 09:18:47Z suehring $
11!
12! 89 2007-05-25 12:08:31Z raasch
13! Calculation and output of user-defined profiles: new routine
14! user_check_data_output_pr, +data_output_pr_user, max_pr_user in userpar,
15! routine user_statistics has got two more arguments
16! Bugfix: field_chr renamed field_char
17!
18! 60 2007-03-11 11:50:04Z raasch
19! New routine user_init_3d_model which allows the initial setting of all 3d
20! arrays under control of the user, new routine user_advec_particles,
21! routine user_statistics now has one argument (sr),
22! sample for generating time series quantities added
23! Bugfix in sample for reading user defined data from restart file (user_init)
24!
25! RCS Log replace by Id keyword, revision history cleaned up
26!
27! Revision 1.18  2006/06/02 15:25:00  raasch
28! +change of grid-defining arguments in routine user_define_netcdf_grid,
29! new argument "found" in user_data_output_2d and user_data_output_3d
30!
31! Revision 1.1  1998/03/24 15:29:04  raasch
32! Initial revision
33!
34!
35! Description:
36! ------------
37! Declaration of user-defined variables. This module may only be used
38! in the user-defined routines (contained in user_interface.f90).
39!------------------------------------------------------------------------------!
40
41    INTEGER ::  user_idummy
42    LOGICAL ::  user_defined_namelist_found = .FALSE.
43    REAL    ::  user_dummy
44
45!
46!-- Sample for user-defined output
47!    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  u2, u2_av
48
49    SAVE
50
51 END MODULE user
52
53
54 SUBROUTINE user_parin
55
56!------------------------------------------------------------------------------!
57!
58! Description:
59! ------------
60! Interface to read user-defined namelist-parameters.
61!------------------------------------------------------------------------------!
62
63    USE control_parameters
64    USE pegrid
65    USE statistics
66    USE user
67
68    IMPLICIT NONE
69
70    CHARACTER (LEN=80) ::  zeile
71
72    INTEGER ::  i, j
73
74
75    NAMELIST /userpar/  data_output_pr_user, data_output_user, region
76
77!
78!-- Position the namelist-file at the beginning (it was already opened in
79!-- parin), search for user-defined namelist-group ("userpar", but any other
80!-- name can be choosed) and position the file at this line.
81    REWIND ( 11 )
82
83    zeile = ' '
84    DO   WHILE ( INDEX( zeile, '&userpar' ) == 0 )
85       READ ( 11, '(A)', END=100 )  zeile
86    ENDDO
87    BACKSPACE ( 11 )
88
89!
90!-- Read user-defined namelist
91    READ ( 11, userpar )
92    user_defined_namelist_found = .TRUE.
93
94!
95!-- Determine the number of user-defined profiles and append them to the
96!-- standard data output (data_output_pr)
97    IF ( data_output_pr_user(1) /= ' ' )  THEN
98       i = 1
99       DO  WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
100          i = i + 1
101       ENDDO
102       j = 1
103       DO  WHILE ( data_output_pr_user(j) /= ' '  .AND.  j <= 100 )
104          data_output_pr(i) = data_output_pr_user(j)
105          max_pr_user       = max_pr_user + 1
106          i = i + 1
107          j = j + 1
108       ENDDO
109    ENDIF
110
111100 RETURN
112
113 END SUBROUTINE user_parin
114
115
116
117 SUBROUTINE user_header( io )
118
119!------------------------------------------------------------------------------!
120!
121! Description:
122! ------------
123! Print a header with user-defined informations.
124!------------------------------------------------------------------------------!
125
126    USE statistics
127    USE user
128
129    IMPLICIT NONE
130
131    INTEGER ::  i, io
132
133!
134!-- If no user-defined variables are read from the namelist-file, no
135!-- informations will be printed.
136    IF ( .NOT. user_defined_namelist_found )  THEN
137       WRITE ( io, 100 )
138       RETURN
139    ENDIF
140
141!
142!-- Printing the informations.
143    WRITE ( io, 110 )
144
145    IF ( statistic_regions /= 0 )  THEN
146       WRITE ( io, 200 )
147       DO  i = 0, statistic_regions
148          WRITE ( io, 201 )  i, region(i)
149       ENDDO
150    ENDIF
151
152
153
154!
155!-- Format-descriptors
156100 FORMAT (//' *** no user-defined variables found'/)
157110 FORMAT (//1X,78('#')                                      &
158            //' User-defined variables and actions:'/  &
159              ' -----------------------------------'//)
160200 FORMAT (' Output of profiles and time series for following regions:' /)
161201 FORMAT (4X,'Region ',I1,':   ',A)
162
163
164 END SUBROUTINE user_header
165
166
167
168 SUBROUTINE user_init
169
170!------------------------------------------------------------------------------!
171!
172! Description:
173! ------------
174! Execution of user-defined initializing actions
175!------------------------------------------------------------------------------!
176
177    USE control_parameters
178    USE indices
179    USE pegrid
180    USE user
181
182    IMPLICIT NONE
183
184    CHARACTER (LEN=20) :: field_char
185!
186!-- Here the user-defined initializing actions follow:
187!-- Sample for user-defined output
188!    ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
189!
190!    IF ( initializing_actions == 'read_restart_data' )  THEN
191!       READ ( 13 )  field_char
192!       DO  WHILE ( TRIM( field_char ) /= '*** end user ***' )
193!
194!          SELECT CASE ( TRIM( field_char ) )
195!
196!             CASE ( 'u2_av' )
197!                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
198!                READ ( 13 )  u2_av
199!
200!             CASE DEFAULT
201!                PRINT*, '+++ user_init: unknown variable named "', &
202!                        TRIM( field_char ), '" found in'
203!                PRINT*, '               data from prior run on PE ', myid
204!                CALL local_stop
205!
206!          END SELECT
207!
208!          READ ( 13 )  field_char
209!
210!       ENDDO
211!    ENDIF
212
213!
214!-- Sample for user-defined time series
215!-- For each time series quantity you have to give a label and a unit,
216!-- which will be used for the NetCDF file. They must not contain more than
217!-- seven characters. The value of dots_num has to be increased by the
218!-- number of new time series quantities. Its old value has to be store in
219!-- dots_num_palm. See routine user_statistics on how to output calculate
220!-- and output these quantities.
221!    dots_label(dots_num+1) = 'abs_umx'
222!    dots_unit(dots_num+1)  = 'm/s'
223!    dots_label(dots_num+2) = 'abs_vmx'
224!    dots_unit(dots_num+2)  = 'm/s'
225!
226!    dots_num_palm = dots_num
227!    dots_num = dots_num + 2
228
229 END SUBROUTINE user_init
230
231
232
233 SUBROUTINE user_init_grid( nzb_local )
234
235!------------------------------------------------------------------------------!
236!
237! Description:
238! ------------
239! Execution of user-defined grid initializing actions
240!------------------------------------------------------------------------------!
241
242    USE control_parameters
243    USE indices
244    USE user
245
246    IMPLICIT NONE
247
248    INTEGER, DIMENSION(-1:ny+1,-1:nx+1) ::  nzb_local
249
250!
251!-- Here the user-defined grid initializing actions follow:
252
253!
254!-- Set the index array nzb_local for non-flat topography.
255!-- Here consistency checks concerning domain size and periodicity are necessary
256    SELECT CASE ( TRIM( topography ) )
257
258       CASE ( 'flat', 'single_building' )
259!
260!--       Not allowed here since these are the standard cases used in init_grid.
261
262       CASE ( 'user_defined_topography_1' )
263!
264!--       Here the user can define his own topography. After definition, please
265!--       remove the following three lines!
266          PRINT*, '+++ user_init_grid: topography "', &
267               topography, '" not available yet'
268          CALL local_stop
269
270       CASE DEFAULT
271!
272!--       The DEFAULT case is reached if the parameter topography contains a
273!--       wrong character string that is neither recognized in init_grid nor
274!--       here in user_init_grid.
275          PRINT*, '+++ (user_)init_grid: unknown topography "', &
276               topography, '"'
277          CALL local_stop
278
279    END SELECT
280
281
282 END SUBROUTINE user_init_grid
283
284
285
286 SUBROUTINE user_init_3d_model
287
288!------------------------------------------------------------------------------!
289!
290! Description:
291! ------------
292! Allows the complete initialization of the 3d model.
293!
294! CAUTION: The user is responsible to set at least all those quantities which
295! ------   are normally set within init_3d_model!
296!------------------------------------------------------------------------------!
297
298    USE arrays_3d
299    USE control_parameters
300    USE indices
301    USE user
302
303    IMPLICIT NONE
304
305
306 END SUBROUTINE user_init_3d_model
307
308
309
310 MODULE user_actions_mod
311
312!------------------------------------------------------------------------------!
313!
314! Description:
315! ------------
316! Execution of user-defined actions before or after single timesteps
317!------------------------------------------------------------------------------!
318
319    PRIVATE
320    PUBLIC user_actions
321
322    INTERFACE user_actions
323       MODULE PROCEDURE user_actions
324       MODULE PROCEDURE user_actions_ij
325    END INTERFACE user_actions
326
327 CONTAINS
328
329
330!------------------------------------------------------------------------------!
331! Call for all grid points
332!------------------------------------------------------------------------------!
333    SUBROUTINE user_actions( location )
334
335       USE control_parameters
336       USE cpulog
337       USE indices
338       USE interfaces
339       USE pegrid
340       USE user
341       USE arrays_3d
342
343       IMPLICIT NONE
344
345       CHARACTER (LEN=*) ::  location
346
347       INTEGER ::  i, j, k
348
349       CALL cpu_log( log_point(24), 'user_actions', 'start' )
350
351!
352!--    Here the user-defined actions follow
353!--    No calls for single grid points are allowed at locations before and
354!--    after the timestep, since these calls are not within an i,j-loop
355       SELECT CASE ( location )
356
357          CASE ( 'before_timestep' )
358!
359!--          Enter actions to be done before every timestep here
360
361
362          CASE ( 'after_integration' )
363!
364!--          Enter actions to be done after every time integration (before
365!--          data output)
366!--          Sample for user-defined output:
367!             DO  i = nxl-1, nxr+1
368!                DO  j = nys-1, nyn+1
369!                   DO  k = nzb, nzt+1
370!                      u2(k,j,i) = u(k,j,i)**2
371!                   ENDDO
372!                ENDDO
373!             ENDDO
374
375
376          CASE ( 'after_timestep' )
377!
378!--          Enter actions to be done after every timestep here
379
380
381          CASE ( 'u-tendency' )
382!
383!--          Enter actions to be done in the u-tendency term here
384
385
386          CASE ( 'v-tendency' )
387
388
389          CASE ( 'w-tendency' )
390
391
392          CASE ( 'pt-tendency' )
393
394
395          CASE ( 'e-tendency' )
396
397
398          CASE ( 'q-tendency' )
399
400
401          CASE DEFAULT
402             IF ( myid == 0 )  PRINT*, '+++ user_actions: unknown location "', &
403                                       location, '"'
404             CALL local_stop
405
406       END SELECT
407
408       CALL cpu_log( log_point(24), 'user_actions', 'stop' )
409
410    END SUBROUTINE user_actions
411
412
413!------------------------------------------------------------------------------!
414! Call for grid point i,j
415!------------------------------------------------------------------------------!
416    SUBROUTINE user_actions_ij( i, j, location )
417
418       USE control_parameters
419       USE pegrid
420       USE user
421
422       IMPLICIT NONE
423
424       CHARACTER (LEN=*) ::  location
425
426       INTEGER ::  i, idum, j
427
428
429!
430!--    Here the user-defined actions follow
431       SELECT CASE ( location )
432
433          CASE ( 'u-tendency' )
434!
435!--          Enter actions to be done in the u-tendency term here
436
437
438          CASE ( 'v-tendency' )
439
440
441          CASE ( 'w-tendency' )
442
443
444          CASE ( 'pt-tendency' )
445
446
447          CASE ( 'e-tendency' )
448
449
450          CASE ( 'q-tendency' )
451
452
453          CASE ( 'before_timestep', 'after_integration', 'after_timestep' )
454             IF ( myid == 0 )  THEN
455                PRINT*, '+++ user_actions: location "', location, '" is not ', &
456                             'allowed to be called with parameters "i" and "j"'
457             ENDIF
458             CALL local_stop
459
460
461          CASE DEFAULT
462             IF ( myid == 0 )  PRINT*, '+++ user_actions: unknown location "', &
463                                       location, '"'
464             CALL local_stop
465
466
467       END SELECT
468
469    END SUBROUTINE user_actions_ij
470
471 END MODULE user_actions_mod
472
473
474
475 SUBROUTINE user_statistics( mode, sr, tn )
476
477!------------------------------------------------------------------------------!
478!
479! Description:
480! ------------
481! Calculation of user-defined statistics, i.e. horizontally averaged profiles
482! and time series.
483! This routine is called for every statistic region sr defined by the user,
484! but at least for the region "total domain" (sr=0).
485! See section 3.5.4 on how to define, calculate, and output user defined
486! quantities.
487!------------------------------------------------------------------------------!
488
489    USE arrays_3d
490    USE indices
491    USE statistics
492    USE user
493
494    IMPLICIT NONE
495
496    CHARACTER (LEN=*) ::  mode
497
498    INTEGER ::  i, j, k, sr, tn
499
500
501    IF ( mode == 'profiles' )  THEN
502
503!
504!--    Sample on how to calculate horizontally averaged profiles of user-
505!--    defined quantities. Each quantity is identified by the index
506!--    "pr_palm+#" where "#" is an integer starting from 1. These
507!--    user-profile-numbers must also be assigned to the respective strings
508!--    given by data_output_pr_user in routine user_check_data_output_pr.
509!       !$OMP DO
510!       DO  i = nxl, nxr
511!          DO  j = nys, nyn
512!             DO  k = nzb_s_outer(j,i)+1, nzt
513!!
514!!--             Sample on how to calculate the profile of the resolved-scale
515!!--             horizontal momentum flux u*v*
516!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +           &
517!                      ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) * &
518!                      ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) * &
519!                                                 * rmask(j,i,sr)
520!!
521!!--             Further profiles can be defined and calculated by increasing
522!!--             the second index of array sums_l (replace ... appropriately)
523!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... &
524!                                         * rmask(j,i,sr)
525!             ENDDO
526!          ENDDO
527!       ENDDO
528
529    ELSEIF ( mode == 'time_series' )  THEN
530
531!
532!--    Sample on how to add values for the user-defined time series quantities.
533!--    These have to be defined before in routine user_init. This sample
534!--    creates two time series for the absolut values of the horizontal
535!--    velocities u and v.
536!       ts_value(dots_num_palm+1,sr) = ABS( u_max )
537!       ts_value(dots_num_palm+2,sr) = ABS( v_max )
538
539    ENDIF
540
541 END SUBROUTINE user_statistics
542
543
544
545 SUBROUTINE user_last_actions
546
547!------------------------------------------------------------------------------!
548!
549! Description:
550! ------------
551! Execution of user-defined actions at the end of a job.
552!------------------------------------------------------------------------------!
553
554    USE user
555
556    IMPLICIT NONE
557
558!
559!-- Here the user-defined actions at the end of a job follow.
560!-- Sample for user-defined output:
561!    IF ( ALLOCATED( u2_av ) )  THEN
562!       WRITE ( 14 )  'u2_av               ';  WRITE ( 14 )  u2_av
563!    ENDIF
564
565    WRITE ( 14 )  '*** end user ***    '
566
567 END SUBROUTINE user_last_actions
568
569
570
571 SUBROUTINE user_init_particles
572
573!------------------------------------------------------------------------------!
574!
575! Description:
576! ------------
577! Modification of initial particles by the user.
578!------------------------------------------------------------------------------!
579
580    USE particle_attributes
581    USE user
582
583    IMPLICIT NONE
584
585    INTEGER ::  n
586
587!
588!-- Here the user-defined actions follow
589!    DO  n = 1, number_of_initial_particles
590!    ENDDO
591
592 END SUBROUTINE user_init_particles
593
594
595
596 SUBROUTINE user_advec_particles
597
598!------------------------------------------------------------------------------!
599!
600! Description:
601! ------------
602! Modification of initial particles by the user.
603!------------------------------------------------------------------------------!
604
605    USE particle_attributes
606    USE user
607
608    IMPLICIT NONE
609
610    INTEGER ::  n
611
612!
613!-- Here the user-defined actions follow
614!    DO  n = 1, number_of_initial_particles
615!    ENDDO
616
617 END SUBROUTINE user_advec_particles
618
619
620
621 SUBROUTINE user_particle_attributes
622
623!------------------------------------------------------------------------------!
624!
625! Description:
626! ------------
627! Define the actual particle attributes (size, colour) by the user.
628!------------------------------------------------------------------------------!
629
630    USE particle_attributes
631    USE user
632
633    IMPLICIT NONE
634
635    INTEGER ::  n
636
637!
638!-- Here the user-defined actions follow
639!    DO  n = 1, number_of_initial_particles
640!    ENDDO
641
642 END SUBROUTINE user_particle_attributes
643
644
645
646 SUBROUTINE user_dvrp_coltab( mode, variable )
647
648!------------------------------------------------------------------------------!
649!
650! Description:
651! ------------
652! Definition of the colour table to be used by the dvrp software.
653!------------------------------------------------------------------------------!
654
655    USE dvrp_variables
656    USE pegrid
657    USE user
658
659    IMPLICIT NONE
660
661    CHARACTER (LEN=*) ::  mode
662    CHARACTER (LEN=*) ::  variable
663
664
665!
666!-- Here the user-defined actions follow
667    SELECT CASE ( mode )
668
669       CASE ( 'particles' )
670
671       CASE ( 'slicer' )
672
673       CASE DEFAULT
674          IF ( myid == 0 )  PRINT*, '+++ user_dvrp_coltab: unknown mode "', &
675                                    mode, '"'
676          CALL local_stop
677
678    END SELECT
679
680 END SUBROUTINE user_dvrp_coltab
681
682
683
684 SUBROUTINE user_check_data_output( variable, unit )
685
686!------------------------------------------------------------------------------!
687!
688! Description:
689! ------------
690! Set the unit of user defined output quantities. For those variables
691! not recognized by the user, the parameter unit is set to "illegal", which
692! tells the calling routine that the output variable is not defined and leads
693! to a program abort.
694!------------------------------------------------------------------------------!
695
696    USE user
697
698    IMPLICIT NONE
699
700    CHARACTER (LEN=*) ::  unit, variable
701
702
703    SELECT CASE ( TRIM( variable ) )
704
705!
706!--    Uncomment and extend the following lines, if necessary
707!       CASE ( 'u2' )
708!          unit = 'm2/s2'
709!
710       CASE DEFAULT
711          unit = 'illegal'
712
713    END SELECT
714
715
716 END SUBROUTINE user_check_data_output
717
718
719
720 SUBROUTINE user_check_data_output_pr( variable, var_count, unit )
721
722!------------------------------------------------------------------------------!
723!
724! Description:
725! ------------
726! Set the unit of user defined profile output quantities. For those variables
727! not recognized by the user, the parameter unit is set to "illegal", which
728! tells the calling routine that the output variable is not defined and leads
729! to a program abort.
730!------------------------------------------------------------------------------!
731
732    USE arrays_3d
733    USE indices
734    USE netcdf_control
735    USE profil_parameter
736    USE statistics
737    USE user
738
739    IMPLICIT NONE
740
741    CHARACTER (LEN=*) ::  unit, variable
742
743    INTEGER ::  index, var_count
744
745
746    SELECT CASE ( TRIM( variable ) )
747
748!
749!--    Uncomment and extend the following lines, if necessary.
750!--    Add additional CASE statements depending on the number of quantities
751!--    for which profiles are to be calculated. The respective calculations
752!--    to be performed have to be added in routine user_statistics.
753!--    The quantities are (internally) identified by a user-profile-number
754!--    (see variable "index" below). The first user-profile must be assigned
755!--    the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
756!--    user-profile-numbers have also to be used in routine user_statistics!
757!       CASE ( 'u*v*' )                      ! quantity string as given in
758!                                            ! data_output_pr_user
759!          index = pr_palm + 1
760!          dopr_index(var_count)  = index    ! quantities' user-profile-number
761!          dopr_unit(var_count)   = 'm2/s2'  ! quantity unit
762!          hom(:,2,index,:)       = SPREAD( zu, 2, statistic_regions+1 )
763!                                            ! grid on which the quantity is
764!                                            ! defined (use zu or zw)
765
766       CASE DEFAULT
767          unit = 'illegal'
768
769    END SELECT
770
771
772 END SUBROUTINE user_check_data_output_pr
773
774
775
776 SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
777
778!------------------------------------------------------------------------------!
779!
780! Description:
781! ------------
782! Set the grids on which user-defined output quantities are defined.
783! Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and
784! for grid_z "zu" and "zw".
785!------------------------------------------------------------------------------!
786
787    USE user
788
789    IMPLICIT NONE
790
791    CHARACTER (LEN=*) ::  grid_x, grid_y, grid_z, variable
792
793    LOGICAL ::  found
794
795
796    SELECT CASE ( TRIM( variable ) )
797
798!
799!--    Uncomment and extend the following lines, if necessary
800!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
801!          grid_x = 'xu'
802!          grid_y = 'y'
803!          grid_z = 'zu'
804
805       CASE DEFAULT
806          found  = .FALSE.
807          grid_x = 'none'
808          grid_y = 'none'
809          grid_z = 'none'
810
811    END SELECT
812
813
814 END SUBROUTINE user_define_netcdf_grid
815
816
817
818 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf )
819
820!------------------------------------------------------------------------------!
821!
822! Description:
823! ------------
824! Resorts the user-defined output quantity with indices (k,j,i) to a
825! temporary array with indices (i,j,k) and sets the grid on which it is defined.
826! Allowed values for grid are "zu" and "zw".
827!------------------------------------------------------------------------------!
828
829    USE indices
830    USE user
831
832    IMPLICIT NONE
833
834    CHARACTER (LEN=*) ::  grid, variable
835
836    INTEGER ::  av, i, j, k
837
838    LOGICAL ::  found
839
840    REAL, DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) ::  local_pf
841
842
843    found = .TRUE.
844
845    SELECT CASE ( TRIM( variable ) )
846
847!
848!--    Uncomment and extend the following lines, if necessary.
849!--    The arrays for storing the user defined quantities (here u2 and u2_av)
850!--    have to be declared and defined by the user!
851!--    Sample for user-defined output:
852!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
853!          IF ( av == 0 )  THEN
854!             DO  i = nxl-1, nxr+1
855!                DO  j = nys-1, nyn+1
856!                   DO  k = nzb, nzt+1
857!                      local_pf(i,j,k) = u2(k,j,i)
858!                   ENDDO
859!                ENDDO
860!             ENDDO
861!          ELSE
862!             DO  i = nxl-1, nxr+1
863!                DO  j = nys-1, nyn+1
864!                   DO  k = nzb, nzt+1
865!                      local_pf(i,j,k) = u2_av(k,j,i)
866!                   ENDDO
867!                ENDDO
868!             ENDDO
869!          ENDIF
870!
871!          grid = 'zu'
872
873       CASE DEFAULT
874          found = .FALSE.
875          grid  = 'none'
876
877    END SELECT
878
879
880 END SUBROUTINE user_data_output_2d
881
882
883
884 SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nz_do )
885
886!------------------------------------------------------------------------------!
887!
888! Description:
889! ------------
890! Resorts the user-defined output quantity with indices (k,j,i) to a
891! temporary array with indices (i,j,k) and sets the grid on which it is defined.
892! Allowed values for grid are "zu" and "zw".
893!------------------------------------------------------------------------------!
894
895    USE array_kind
896    USE indices
897    USE user
898
899    IMPLICIT NONE
900
901    CHARACTER (LEN=*) ::  variable
902
903    INTEGER ::  av, i, j, k, nz_do
904
905    LOGICAL ::  found
906
907    REAL(spk), DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do) ::  local_pf
908
909
910    found = .TRUE.
911
912    SELECT CASE ( TRIM( variable ) )
913
914!
915!--    Uncomment and extend the following lines, if necessary.
916!--    The arrays for storing the user defined quantities (here u2 and u2_av)
917!--    have to be declared and defined by the user!
918!--    Sample for user-defined output:
919!       CASE ( 'u2' )
920!          IF ( av == 0 )  THEN
921!             DO  i = nxl-1, nxr+1
922!                DO  j = nys-1, nyn+1
923!                   DO  k = nzb, nz_do
924!                      local_pf(i,j,k) = u2(k,j,i)
925!                   ENDDO
926!                ENDDO
927!             ENDDO
928!          ELSE
929!             DO  i = nxl-1, nxr+1
930!                DO  j = nys-1, nyn+1
931!                   DO  k = nzb, nz_do
932!                      local_pf(i,j,k) = u2_av(k,j,i)
933!                   ENDDO
934!                ENDDO
935!             ENDDO
936!          ENDIF
937!
938!          grid = 'zu'
939
940       CASE DEFAULT
941          found = .FALSE.
942
943    END SELECT
944
945
946 END SUBROUTINE user_data_output_3d
947
948
949
950 SUBROUTINE user_3d_data_averaging( mode, variable )
951
952!------------------------------------------------------------------------------!
953!
954! Description:
955! ------------
956! Sum up and time-average user-defined output quantities as well as allocate
957! the array necessary for storing the average.
958!------------------------------------------------------------------------------!
959
960    USE control_parameters
961    USE indices
962    USE user
963
964    IMPLICIT NONE
965
966    CHARACTER (LEN=*) ::  mode, variable
967
968    INTEGER ::  i, j, k
969
970
971    IF ( mode == 'allocate' )  THEN
972
973       SELECT CASE ( TRIM( variable ) )
974
975!
976!--       Uncomment and extend the following lines, if necessary.
977!--       The arrays for storing the user defined quantities (here u2_av) have
978!--       to be declared and defined by the user!
979!--       Sample for user-defined output:
980!          CASE ( 'u2' )
981!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
982!                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
983!             ENDIF
984!             u2_av = 0.0
985
986          CASE DEFAULT
987             CONTINUE
988
989       END SELECT
990
991    ELSEIF ( mode == 'sum' )  THEN
992
993       SELECT CASE ( TRIM( variable ) )
994
995!
996!--       Uncomment and extend the following lines, if necessary.
997!--       The arrays for storing the user defined quantities (here u2 and
998!--       u2_av) have to be declared and defined by the user!
999!--       Sample for user-defined output:
1000!          CASE ( 'u2' )
1001!             DO  i = nxl-1, nxr+1
1002!                DO  j = nys-1, nyn+1
1003!                   DO  k = nzb, nzt+1
1004!                      u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
1005!                   ENDDO
1006!                ENDDO
1007!             ENDDO
1008
1009          CASE DEFAULT
1010             CONTINUE
1011
1012       END SELECT
1013
1014    ELSEIF ( mode == 'average' )  THEN
1015
1016       SELECT CASE ( TRIM( variable ) )
1017
1018!
1019!--       Uncomment and extend the following lines, if necessary.
1020!--       The arrays for storing the user defined quantities (here u2_av) have
1021!--       to be declared and defined by the user!
1022!--       Sample for user-defined output:
1023!          CASE ( 'u2' )
1024!             DO  i = nxl-1, nxr+1
1025!                DO  j = nys-1, nyn+1
1026!                   DO  k = nzb, nzt+1
1027!                      u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )
1028!                   ENDDO
1029!                ENDDO
1030!             ENDDO
1031
1032       END SELECT
1033
1034    ENDIF
1035
1036
1037 END SUBROUTINE user_3d_data_averaging
Note: See TracBrowser for help on using the repository browser.