source: palm/trunk/SOURCE/user_3d_data_averaging.f90 @ 216

Last change on this file since 216 was 211, checked in by raasch, 15 years ago

user interface was split into one single file per subroutine

  • Property svn:keywords set to Id
File size: 2.5 KB
Line 
1 SUBROUTINE user_3d_data_averaging( mode, variable )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Former file user_interface.f90 split into one file per subroutine
7!
8! Former revisions:
9! -----------------
10! $Id: user_3d_data_averaging.f90 211 2008-11-11 04:46:24Z raasch $
11!
12! Description:
13! ------------
14! Sum up and time-average user-defined output quantities as well as allocate
15! the array necessary for storing the average.
16!------------------------------------------------------------------------------!
17
18    USE control_parameters
19    USE indices
20    USE user
21
22    IMPLICIT NONE
23
24    CHARACTER (LEN=*) ::  mode, variable
25
26    INTEGER ::  i, j, k
27
28
29    IF ( mode == 'allocate' )  THEN
30
31       SELECT CASE ( TRIM( variable ) )
32
33!
34!--       Uncomment and extend the following lines, if necessary.
35!--       The arrays for storing the user defined quantities (here u2_av) have
36!--       to be declared and defined by the user!
37!--       Sample for user-defined output:
38!          CASE ( 'u2' )
39!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
40!                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
41!             ENDIF
42!             u2_av = 0.0
43
44          CASE DEFAULT
45             CONTINUE
46
47       END SELECT
48
49    ELSEIF ( mode == 'sum' )  THEN
50
51       SELECT CASE ( TRIM( variable ) )
52
53!
54!--       Uncomment and extend the following lines, if necessary.
55!--       The arrays for storing the user defined quantities (here u2 and
56!--       u2_av) have to be declared and defined by the user!
57!--       Sample for user-defined output:
58!          CASE ( 'u2' )
59!             DO  i = nxl-1, nxr+1
60!                DO  j = nys-1, nyn+1
61!                   DO  k = nzb, nzt+1
62!                      u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
63!                   ENDDO
64!                ENDDO
65!             ENDDO
66
67          CASE DEFAULT
68             CONTINUE
69
70       END SELECT
71
72    ELSEIF ( mode == 'average' )  THEN
73
74       SELECT CASE ( TRIM( variable ) )
75
76!
77!--       Uncomment and extend the following lines, if necessary.
78!--       The arrays for storing the user defined quantities (here u2_av) have
79!--       to be declared and defined by the user!
80!--       Sample for user-defined output:
81!          CASE ( 'u2' )
82!             DO  i = nxl-1, nxr+1
83!                DO  j = nys-1, nyn+1
84!                   DO  k = nzb, nzt+1
85!                      u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )
86!                   ENDDO
87!                ENDDO
88!             ENDDO
89
90       END SELECT
91
92    ENDIF
93
94
95 END SUBROUTINE user_3d_data_averaging
Note: See TracBrowser for help on using the repository browser.