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

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

more preliminary uncomplete changes for ocean version

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