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

Last change on this file since 29 was 4, checked in by raasch, 18 years ago

Id keyword set as property for all *.f90 files

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