source: palm/trunk/SOURCE/average_3d_data.f90 @ 2707

Last change on this file since 2707 was 2696, checked in by kanani, 7 years ago

Merge of branch palm4u into trunk

  • Property svn:keywords set to Id
File size: 15.7 KB
Line 
1!> @file average_3d_data.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: average_3d_data.f90 2696 2017-12-14 17:12:51Z suehring $
27! Implement call for turbulence_closure_mod (TG)
28! Implementation of chemistry module (FK)
29!
30! 2292 2017-06-20 09:51:42Z schwenkel
31! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
32! includes two more prognostic equations for cloud drop concentration (nc) 
33! and cloud water content (qc).
34!
35! 2233 2017-05-30 18:08:54Z suehring
36!
37! 2232 2017-05-30 17:47:52Z suehring
38! Adjustments to new surface concept - additional ghost point exchange
39! of surface variable required
40!
41! 2031 2016-10-21 15:11:58Z knoop
42! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
43!
44! 2011 2016-09-19 17:29:57Z kanani
45! Flag urban_surface is now defined in module control_parameters,
46! changed prefix for urban surface model output to "usm_",
47! introduced control parameter varnamelength for LEN of trimvar.
48!
49! 2007 2016-08-24 15:47:17Z kanani
50! Added support for new urban surface model (temporary modifications of
51! SELECT CASE ( ) necessary, see variable trimvar),
52! added comments in variable declaration section
53!
54! 2000 2016-08-20 18:09:15Z knoop
55! Forced header and separation lines into 80 columns
56!
57! 1972 2016-07-26 07:52:02Z maronga
58! Output of land surface quantities is now done directly in the respective module
59!
60! 1960 2016-07-12 16:34:24Z suehring
61! Treat humidity and passive scalar separately
62!
63! 1691 2015-10-26 16:17:44Z maronga
64! Added output of Obukhov length and radiative heating rates for RRTMG.
65!
66! 1682 2015-10-07 23:56:08Z knoop
67! Code annotations made doxygen readable
68!
69! 1585 2015-04-30 07:05:52Z maronga
70! Adapted for RRTMG
71!
72! 1555 2015-03-04 17:44:27Z maronga
73! Added output of r_a and r_s
74!
75! 1551 2015-03-03 14:18:16Z maronga
76! Added support for land surface and radiation model parameters.
77!
78! 1322 2014-03-20 16:38:49Z raasch
79! REAL functions provided with KIND-attribute
80!
81! 1320 2014-03-20 08:40:49Z raasch
82! ONLY-attribute added to USE-statements,
83! kind-parameters added to all INTEGER and REAL declaration statements,
84! kinds are defined in new module kinds,
85! revision history before 2012 removed,
86! comment fields (!:) to be used for variable explanations added to
87! all variable declaration statements
88!
89! 1318 2014-03-17 13:35:16Z raasch
90! barrier argument removed from cpu_log,
91! module interfaces removed
92!
93! 1115 2013-03-26 18:16:16Z hoffmann
94! +qc
95!
96! 1053 2012-11-13 17:11:03Z hoffmann
97! averaging of nr, qr added
98!
99! 1036 2012-10-22 13:43:42Z raasch
100! code put under GPL (PALM 3.9)
101!
102! 978 2012-08-09 08:28:32Z fricke
103! +z0h_av
104!
105! Revision 1.1  2006/02/23 09:48:58  raasch
106! Initial revision
107!
108!
109! Description:
110! ------------
111!> Time-averaging of 3d-data-arrays.
112!------------------------------------------------------------------------------!
113 SUBROUTINE average_3d_data
114 
115
116    USE averaging
117
118#if defined( __chem )
119    USE chemistry_model_mod,                                                   &
120        ONLY:  chem_3d_data_averaging
121#endif
122
123    USE control_parameters,                                                    &
124        ONLY:  air_chemistry, average_count_3d, doav, doav_n, land_surface,    &
125               urban_surface, varnamelength
126
127    USE cpulog,                                                                &
128        ONLY:  cpu_log, log_point
129
130    USE indices,                                                               &
131        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
132
133    USE kinds
134
135    USE land_surface_model_mod,                                                &
136        ONLY:  lsm_3d_data_averaging
137
138    USE radiation_model_mod,                                                   &
139        ONLY:  radiation, radiation_3d_data_averaging
140
141    USE turbulence_closure_mod,                                                &
142        ONLY:  tcm_3d_data_averaging
143
144    USE urban_surface_mod,                                                     &
145        ONLY:  usm_average_3d_data
146
147
148
149
150    IMPLICIT NONE
151
152    INTEGER(iwp) ::  i  !< running index
153    INTEGER(iwp) ::  ii !< running index
154    INTEGER(iwp) ::  j  !< running index
155    INTEGER(iwp) ::  k  !< running index
156
157    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
158
159
160    CALL cpu_log (log_point(35),'average_3d_data','start')
161
162!
163!-- Check, if averaging is necessary
164    IF ( average_count_3d <= 1 )  RETURN
165
166!
167!-- Loop of all variables to be averaged.
168    DO  ii = 1, doav_n
169
170!
171!--    Temporary solution to account for data output within the new urban
172!--    surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
173       trimvar = TRIM( doav(ii) )
174       IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
175          trimvar = 'usm_output'
176       ENDIF
177
178!
179!--    Store the array chosen on the temporary array.
180       SELECT CASE ( trimvar )
181
182          CASE ( 'e' )
183             DO  i = nxlg, nxrg
184                DO  j = nysg, nyng
185                   DO  k = nzb, nzt+1
186                      e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d, KIND=wp )
187                   ENDDO
188                ENDDO
189             ENDDO
190
191          CASE ( 'qsws*' )
192             DO  i = nxlg, nxrg
193                DO  j = nysg, nyng
194                   qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d, KIND=wp )
195                ENDDO
196             ENDDO
197             CALL exchange_horiz_2d( qsws_av, nbgp )
198
199          CASE ( 'lpt' )
200             DO  i = nxlg, nxrg
201                DO  j = nysg, nyng
202                   DO  k = nzb, nzt+1
203                      lpt_av(k,j,i) = lpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
204                   ENDDO
205                ENDDO
206             ENDDO
207
208          CASE ( 'lwp*' )
209             DO  i = nxlg, nxrg
210                DO  j = nysg, nyng
211                   lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d, KIND=wp )
212                ENDDO
213             ENDDO
214
215          CASE ( 'nc' )
216             DO  i = nxlg, nxrg
217                DO  j = nysg, nyng
218                   DO  k = nzb, nzt+1
219                      nc_av(k,j,i) = nc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
220                   ENDDO
221                ENDDO
222             ENDDO
223
224          CASE ( 'nr' )
225             DO  i = nxlg, nxrg
226                DO  j = nysg, nyng
227                   DO  k = nzb, nzt+1
228                      nr_av(k,j,i) = nr_av(k,j,i) / REAL( average_count_3d, KIND=wp )
229                   ENDDO
230                ENDDO
231             ENDDO
232
233         CASE ( 'ol*' )
234             DO  i = nxlg, nxrg
235                DO  j = nysg, nyng
236                   ol_av(j,i) = ol_av(j,i) / REAL( average_count_3d, KIND=wp )
237                ENDDO
238             ENDDO
239             CALL exchange_horiz_2d( ol_av, nbgp )
240
241          CASE ( 'p' )
242             DO  i = nxlg, nxrg
243                DO  j = nysg, nyng
244                   DO  k = nzb, nzt+1
245                      p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d, KIND=wp )
246                   ENDDO
247                ENDDO
248             ENDDO
249
250          CASE ( 'pc' )
251             DO  i = nxl, nxr
252                DO  j = nys, nyn
253                   DO  k = nzb, nzt+1
254                      pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
255                   ENDDO
256                ENDDO
257             ENDDO
258
259          CASE ( 'pr' )
260             DO  i = nxl, nxr
261                DO  j = nys, nyn
262                   DO  k = nzb, nzt+1
263                      pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d, KIND=wp )
264                   ENDDO
265                ENDDO
266             ENDDO
267
268          CASE ( 'prr*' )
269             DO  i = nxlg, nxrg
270                DO  j = nysg, nyng
271                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) /   &
272                                                REAL( average_count_3d, KIND=wp )
273                ENDDO
274             ENDDO
275
276          CASE ( 'pt' )
277             DO  i = nxlg, nxrg
278                DO  j = nysg, nyng
279                   DO  k = nzb, nzt+1
280                      pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
281                   ENDDO
282                ENDDO
283             ENDDO
284
285          CASE ( 'q' )
286             DO  i = nxlg, nxrg
287                DO  j = nysg, nyng
288                   DO  k = nzb, nzt+1
289                      q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND=wp )
290                   ENDDO
291                ENDDO
292             ENDDO
293
294          CASE ( 'qc' )
295             DO  i = nxlg, nxrg
296                DO  j = nysg, nyng
297                   DO  k = nzb, nzt+1
298                      qc_av(k,j,i) = qc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
299                   ENDDO
300                ENDDO
301             ENDDO
302
303          CASE ( 'ql' )
304             DO  i = nxlg, nxrg
305                DO  j = nysg, nyng
306                   DO  k = nzb, nzt+1
307                      ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d, KIND=wp )
308                   ENDDO
309                ENDDO
310             ENDDO
311
312          CASE ( 'ql_c' )
313             DO  i = nxlg, nxrg
314                DO  j = nysg, nyng
315                   DO  k = nzb, nzt+1
316                      ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d, KIND=wp )
317                   ENDDO
318                ENDDO
319             ENDDO
320
321          CASE ( 'ql_v' )
322             DO  i = nxlg, nxrg
323                DO  j = nysg, nyng
324                   DO  k = nzb, nzt+1
325                      ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
326                   ENDDO
327                ENDDO
328             ENDDO
329
330          CASE ( 'ql_vp' )
331             DO  i = nxlg, nxrg
332                DO  j = nysg, nyng
333                   DO  k = nzb, nzt+1
334                      ql_vp_av(k,j,i) = ql_vp_av(k,j,i) /                      &
335                                        REAL( average_count_3d, KIND=wp )
336                   ENDDO
337                ENDDO
338             ENDDO
339
340          CASE ( 'qr' )
341             DO  i = nxlg, nxrg
342                DO  j = nysg, nyng
343                   DO  k = nzb, nzt+1
344                      qr_av(k,j,i) = qr_av(k,j,i) / REAL( average_count_3d, KIND=wp )
345                   ENDDO
346                ENDDO
347             ENDDO
348
349          CASE ( 'qv' )
350             DO  i = nxlg, nxrg
351                DO  j = nysg, nyng
352                   DO  k = nzb, nzt+1
353                      qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
354                   ENDDO
355                ENDDO
356             ENDDO
357
358          CASE ( 'rho_ocean' )
359             DO  i = nxlg, nxrg
360                DO  j = nysg, nyng
361                   DO  k = nzb, nzt+1
362                      rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) / REAL( average_count_3d, KIND=wp )
363                   ENDDO
364                ENDDO
365             ENDDO
366
367          CASE ( 's' )
368             DO  i = nxlg, nxrg
369                DO  j = nysg, nyng
370                   DO  k = nzb, nzt+1
371                      s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d, KIND=wp )
372                   ENDDO
373                ENDDO
374             ENDDO
375
376          CASE ( 'sa' )
377             DO  i = nxlg, nxrg
378                DO  j = nysg, nyng
379                   DO  k = nzb, nzt+1
380                      sa_av(k,j,i) = sa_av(k,j,i) / REAL( average_count_3d, KIND=wp )
381                   ENDDO
382                ENDDO
383             ENDDO
384
385         CASE ( 'shf*' )
386             DO  i = nxlg, nxrg
387                DO  j = nysg, nyng
388                   shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d, KIND=wp )
389                ENDDO
390             ENDDO
391             CALL exchange_horiz_2d( shf_av, nbgp )
392
393          CASE ( 'ssws*' )
394             DO  i = nxlg, nxrg
395                DO  j = nysg, nyng
396                   ssws_av(j,i) = ssws_av(j,i) / REAL( average_count_3d, KIND=wp )
397                ENDDO
398             ENDDO
399             CALL exchange_horiz_2d( ssws_av, nbgp )
400
401          CASE ( 't*' )
402             DO  i = nxlg, nxrg
403                DO  j = nysg, nyng
404                   ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d, KIND=wp )
405                ENDDO
406             ENDDO
407             CALL exchange_horiz_2d( ts_av, nbgp )
408
409          CASE ( 'u' )
410             DO  i = nxlg, nxrg
411                DO  j = nysg, nyng
412                   DO  k = nzb, nzt+1
413                      u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND=wp )
414                   ENDDO
415                ENDDO
416             ENDDO
417
418          CASE ( 'u*' )
419             DO  i = nxlg, nxrg
420                DO  j = nysg, nyng
421                   us_av(j,i) = us_av(j,i) / REAL( average_count_3d, KIND=wp )
422                ENDDO
423             ENDDO
424             CALL exchange_horiz_2d( us_av, nbgp )
425
426          CASE ( 'v' )
427             DO  i = nxlg, nxrg
428                DO  j = nysg, nyng
429                   DO  k = nzb, nzt+1
430                      v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
431                   ENDDO
432                ENDDO
433             ENDDO
434
435          CASE ( 'vpt' )
436             DO  i = nxlg, nxrg
437                DO  j = nysg, nyng
438                   DO  k = nzb, nzt+1
439                      vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
440                   ENDDO
441                ENDDO
442             ENDDO
443
444          CASE ( 'w' )
445             DO  i = nxlg, nxrg
446                DO  j = nysg, nyng
447                   DO  k = nzb, nzt+1
448                      w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND=wp )
449                   ENDDO
450                ENDDO
451             ENDDO
452
453          CASE ( 'z0*' )
454             DO  i = nxlg, nxrg
455                DO  j = nysg, nyng
456                   z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d, KIND=wp )
457                ENDDO
458             ENDDO
459             CALL exchange_horiz_2d( z0_av, nbgp )
460
461          CASE ( 'z0h*' )
462             DO  i = nxlg, nxrg
463                DO  j = nysg, nyng
464                   z0h_av(j,i) = z0h_av(j,i) / REAL( average_count_3d, KIND=wp )
465                ENDDO
466             ENDDO
467             CALL exchange_horiz_2d( z0h_av, nbgp )
468!             
469!--       Block of urban surface model outputs   
470          CASE ( 'usm_output' )
471             CALL usm_average_3d_data( 'average', doav(ii) )
472
473          CASE DEFAULT
474!
475!--          Turbulence closure module
476             CALL tcm_3d_data_averaging( 'average', doav(ii) )
477
478!
479!--          Land surface quantity
480             IF ( land_surface )  THEN
481                CALL lsm_3d_data_averaging( 'average', doav(ii) )
482             ENDIF
483!
484!--          Radiation quantity
485             IF ( radiation )  THEN
486                CALL radiation_3d_data_averaging( 'average', doav(ii) )
487             ENDIF
488!
489!--          Chemistry quantity
490#if defined( __chem )
491             IF ( air_chemistry )  THEN
492                CALL chem_3d_data_averaging( 'average', doav(ii) )
493             ENDIF
494#endif
495!
496!--          User-defined quantity
497             CALL user_3d_data_averaging( 'average', doav(ii) )
498
499       END SELECT
500
501    ENDDO
502
503!
504!-- Reset the counter
505    average_count_3d = 0.0
506
507    CALL cpu_log( log_point(35), 'average_3d_data', 'stop' )
508
509
510 END SUBROUTINE average_3d_data
Note: See TracBrowser for help on using the repository browser.