source: palm/trunk/SOURCE/sum_up_3d_data.f90 @ 1

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

Initial repository layout and content

File size: 11.2 KB
Line 
1 SUBROUTINE sum_up_3d_data
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Log: sum_up_3d_data.f90,v $
11! Revision 1.1  2006/02/23 12:55:23  raasch
12! Initial revision
13!
14!
15! Description:
16! ------------
17! Sum-up the values of 3d-arrays. The real averaging is later done in routine
18! average_3d_data.
19!------------------------------------------------------------------------------!
20
21    USE arrays_3d
22    USE averaging
23    USE cloud_parameters
24    USE control_parameters
25    USE cpulog
26    USE indices
27    USE interfaces
28    USE particle_attributes
29
30    IMPLICIT NONE
31
32    INTEGER ::  i, ii, j, k, n, psi
33
34    REAL    ::  mean_r, s_r3, s_r4
35
36
37    CALL cpu_log (log_point(34),'sum_up_3d_data','start')
38
39!
40!-- Allocate and initialize the summation arrays if called for the very first
41!-- time or the first time after average_3d_data has been called
42!-- (some or all of the arrays may have been already allocated
43!-- in read_3d_binary)
44    IF ( average_count_3d == 0 )  THEN
45
46       DO  ii = 1, doav_n
47
48          SELECT CASE ( TRIM( doav(ii) ) )
49
50             CASE ( 'e' )
51                IF ( .NOT. ALLOCATED( e_av ) )  THEN
52                   ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
53                ENDIF
54                e_av = 0.0
55
56             CASE ( 'lwp*' )
57                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
58                   ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
59                ENDIF
60                lwp_av = 0.0
61
62             CASE ( 'p' )
63                IF ( .NOT. ALLOCATED( p_av ) )  THEN
64                   ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
65                ENDIF
66                p_av = 0.0
67
68             CASE ( 'pc' )
69                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
70                   ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
71                ENDIF
72                pc_av = 0.0
73
74             CASE ( 'pr' )
75                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
76                   ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
77                ENDIF
78                pr_av = 0.0
79
80             CASE ( 'pt' )
81                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
82                   ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
83                ENDIF
84                pt_av = 0.0
85
86             CASE ( 'q' )
87                IF ( .NOT. ALLOCATED( q_av ) )  THEN
88                   ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
89                ENDIF
90                q_av = 0.0
91
92             CASE ( 'ql' )
93                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
94                   ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
95                ENDIF
96                ql_av = 0.0
97
98             CASE ( 'ql_c' )
99                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
100                   ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
101                ENDIF
102                ql_c_av = 0.0
103
104             CASE ( 'ql_v' )
105                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
106                   ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
107                ENDIF
108                ql_v_av = 0.0
109
110             CASE ( 'ql_vp' )
111                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
112                   ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
113                ENDIF
114                ql_vp_av = 0.0
115
116             CASE ( 'qv' )
117                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
118                   ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
119                ENDIF
120                qv_av = 0.0
121
122             CASE ( 's' )
123                IF ( .NOT. ALLOCATED( s_av ) )  THEN
124                   ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
125                ENDIF
126                s_av = 0.0
127
128             CASE ( 't*' )
129                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
130                   ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
131                ENDIF
132                ts_av = 0.0
133
134             CASE ( 'u' )
135                IF ( .NOT. ALLOCATED( u_av ) )  THEN
136                   ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
137                ENDIF
138                u_av = 0.0
139
140             CASE ( 'u*' )
141                IF ( .NOT. ALLOCATED( us_av ) )  THEN
142                   ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
143                ENDIF
144                us_av = 0.0
145
146             CASE ( 'v' )
147                IF ( .NOT. ALLOCATED( v_av ) )  THEN
148                   ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
149                ENDIF
150                v_av = 0.0
151
152             CASE ( 'vpt' )
153                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
154                   ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
155                ENDIF
156                vpt_av = 0.0
157
158             CASE ( 'w' )
159                IF ( .NOT. ALLOCATED( w_av ) )  THEN
160                   ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
161                ENDIF
162                w_av = 0.0
163
164             CASE DEFAULT
165!
166!--             User-defined quantity
167                CALL user_3d_data_averaging( 'allocate', doav(ii) )
168
169          END SELECT
170
171       ENDDO
172
173    ENDIF
174
175!
176!-- Loop of all variables to be averaged.
177    DO  ii = 1, doav_n
178
179!
180!--    Store the array chosen on the temporary array.
181       SELECT CASE ( TRIM( doav(ii) ) )
182
183          CASE ( 'e' )
184             DO  i = nxl-1, nxr+1
185                DO  j = nys-1, nyn+1
186                   DO  k = nzb, nzt+1
187                      e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
188                   ENDDO
189                ENDDO
190             ENDDO
191
192          CASE ( 'lwp*' )
193             DO  i = nxl-1, nxr+1
194                DO  j = nys-1, nyn+1
195                   lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * &
196                                                    dzw(1:nzt+1) )
197                ENDDO
198             ENDDO
199
200          CASE ( 'p' )
201             DO  i = nxl-1, nxr+1
202                DO  j = nys-1, nyn+1
203                   DO  k = nzb, nzt+1
204                      p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
205                   ENDDO
206                ENDDO
207             ENDDO
208
209          CASE ( 'pc' )
210             DO  i = nxl, nxr
211                DO  j = nys, nyn
212                   DO  k = nzb, nzt+1
213                      pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
214                   ENDDO
215                ENDDO
216             ENDDO
217
218          CASE ( 'pr' )
219             DO  i = nxl, nxr
220                DO  j = nys, nyn
221                   DO  k = nzb, nzt+1
222                      psi = prt_start_index(k,j,i)
223                      s_r3 = 0.0
224                      s_r4 = 0.0
225                      DO  n = psi, psi+prt_count(k,j,i)-1
226                         s_r3 = s_r3 + particles(n)%radius**3
227                         s_r4 = s_r4 + particles(n)%radius**4
228                      ENDDO
229                      IF ( s_r3 /= 0.0 )  THEN
230                         mean_r = s_r4 / s_r3
231                      ELSE
232                         mean_r = 0.0
233                      ENDIF
234                      pr_av(k,j,i) = pr_av(k,j,i) + mean_r
235                   ENDDO
236                ENDDO
237             ENDDO
238
239          CASE ( 'pt' )
240             IF ( .NOT. cloud_physics ) THEN
241                DO  i = nxl-1, nxr+1
242                   DO  j = nys-1, nyn+1
243                      DO  k = nzb, nzt+1
244                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
245                      ENDDO
246                   ENDDO
247                ENDDO
248             ELSE
249                DO  i = nxl-1, nxr+1
250                   DO  j = nys-1, nyn+1
251                      DO  k = nzb, nzt+1
252                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
253                                                       pt_d_t(k) * ql(k,j,i)
254                      ENDDO
255                   ENDDO
256                ENDDO
257             ENDIF
258
259          CASE ( 'q' )
260             DO  i = nxl-1, nxr+1
261                DO  j = nys-1, nyn+1
262                   DO  k = nzb, nzt+1
263                      q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
264                   ENDDO
265                ENDDO
266             ENDDO
267             
268          CASE ( 'ql' )
269             DO  i = nxl-1, nxr+1
270                DO  j = nys-1, nyn+1
271                   DO  k = nzb, nzt+1
272                      ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
273                   ENDDO
274                ENDDO
275             ENDDO
276
277          CASE ( 'ql_c' )
278             DO  i = nxl-1, nxr+1
279                DO  j = nys-1, nyn+1
280                   DO  k = nzb, nzt+1
281                      ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
282                   ENDDO
283                ENDDO
284             ENDDO
285
286          CASE ( 'ql_v' )
287             DO  i = nxl-1, nxr+1
288                DO  j = nys-1, nyn+1
289                   DO  k = nzb, nzt+1
290                      ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
291                   ENDDO
292                ENDDO
293             ENDDO
294
295          CASE ( 'ql_vp' )
296             DO  i = nxl-1, nxr+1
297                DO  j = nys-1, nyn+1
298                   DO  k = nzb, nzt+1
299                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + ql_vp(k,j,i)
300                   ENDDO
301                ENDDO
302             ENDDO
303
304          CASE ( 'qv' )
305             DO  i = nxl-1, nxr+1
306                DO  j = nys-1, nyn+1
307                   DO  k = nzb, nzt+1
308                      qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
309                   ENDDO
310                ENDDO
311             ENDDO
312
313          CASE ( 's' )
314             DO  i = nxl-1, nxr+1
315                DO  j = nys-1, nyn+1
316                   DO  k = nzb, nzt+1
317                      s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
318                   ENDDO
319                ENDDO
320             ENDDO
321             
322          CASE ( 't*' )
323             DO  i = nxl-1, nxr+1
324                DO  j = nys-1, nyn+1
325                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
326                ENDDO
327             ENDDO
328
329          CASE ( 'u' )
330             DO  i = nxl-1, nxr+1
331                DO  j = nys-1, nyn+1
332                   DO  k = nzb, nzt+1
333                      u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
334                   ENDDO
335                ENDDO
336             ENDDO
337
338          CASE ( 'u*' )
339             DO  i = nxl-1, nxr+1
340                DO  j = nys-1, nyn+1
341                   us_av(j,i) = us_av(j,i) + us(j,i)
342                ENDDO
343             ENDDO
344
345          CASE ( 'v' )
346             DO  i = nxl-1, nxr+1
347                DO  j = nys-1, nyn+1
348                   DO  k = nzb, nzt+1
349                      v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
350                   ENDDO
351                ENDDO
352             ENDDO
353
354          CASE ( 'vpt' )
355             DO  i = nxl-1, nxr+1
356                DO  j = nys-1, nyn+1
357                   DO  k = nzb, nzt+1
358                      vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
359                   ENDDO
360                ENDDO
361             ENDDO
362
363          CASE ( 'w' )
364             DO  i = nxl-1, nxr+1
365                DO  j = nys-1, nyn+1
366                   DO  k = nzb, nzt+1
367                      w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
368                   ENDDO
369                ENDDO
370             ENDDO
371
372          CASE DEFAULT
373!
374!--          User-defined quantity
375             CALL user_3d_data_averaging( 'sum', doav(ii) )
376
377       END SELECT
378
379    ENDDO
380
381    CALL cpu_log (log_point(34),'sum_up_3d_data','stop','nobarrier')
382
383
384 END SUBROUTINE sum_up_3d_data
Note: See TracBrowser for help on using the repository browser.