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

Last change on this file since 3768 was 3655, checked in by knoop, 3 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

  • Property svn:keywords set to Id
File size: 18.0 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-2019 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: average_3d_data.f90 3655 2019-01-07 16:51:22Z raasch $
27! Implementation of the PALM module interface
28!
29! 3597 2018-12-04 08:40:18Z maronga
30! Added theta_2m
31!
32! 3589 2018-11-30 15:09:51Z suehring
33! Move the control parameter "salsa" from salsa_mod to control_parameters
34! (M. Kurppa)
35!
36! 3582 2018-11-29 19:16:36Z suehring
37! dom_dwd_user:
38! Clean up biometeorology call
39!
40! 3525 2018-11-14 16:06:14Z kanani
41! Changes related to clean-up of biometeorology (dom_dwd_user)
42!
43! 3467 2018-10-30 19:05:21Z suehring
44! Implementation of a new aerosol module salsa.
45!
46! 3448 2018-10-29 18:14:31Z kanani
47! Adjustment of biometeorology calls
48!
49! 3421 2018-10-24 18:39:32Z gronemeier
50! Renamed output variables
51!
52! 3419 2018-10-24 17:27:31Z gronemeier
53! (from resler branch)
54! Add biometeorology output,
55! fix for chemistry output,
56! move of urban surface output
57!
58! 3294 2018-10-01 02:37:10Z raasch
59! changes concerning modularization of ocean option
60!
61! 3274 2018-09-24 15:42:55Z knoop
62! Modularization of all bulk cloud physics code components
63!
64! 3004 2018-04-27 12:33:25Z Giersch
65! Further allocation checks implemented, case z0q* added
66!
67! 2885 2018-03-14 11:02:46Z Giersch
68! Preliminary gust module interface implemented
69!
70! 2797 2018-02-08 13:24:35Z suehring
71! Enable output of ground-heat flux also at urban surfaces.
72!
73! 2766 2018-01-22 17:17:47Z kanani
74! Removed preprocessor directive __chem
75!
76! 2742 2018-01-12 14:59:47Z suehring
77! Enable output of surface temperature
78!
79! 2735 2018-01-11 12:01:27Z suehring
80! output of r_a moved from land-surface to consider also urban-type surfaces
81!
82! 2718 2018-01-02 08:49:38Z maronga
83! Corrected "Former revisions" section
84!
85! 2696 2017-12-14 17:12:51Z kanani
86! Change in file header (GPL part)
87! Implement call for turbulence_closure_mod (TG)
88! Implementation of chemistry module (FK)
89!
90! 2292 2017-06-20 09:51:42Z schwenkel
91! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
92! includes two more prognostic equations for cloud drop concentration (nc) 
93! and cloud water content (qc). 
94!
95! 2233 2017-05-30 18:08:54Z suehring
96!
97! 2232 2017-05-30 17:47:52Z suehring
98! Adjustments to new surface concept - additional ghost point exchange
99! of surface variable required
100!
101! 2031 2016-10-21 15:11:58Z knoop
102! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
103!
104! 2011 2016-09-19 17:29:57Z kanani
105! Flag urban_surface is now defined in module control_parameters,
106! changed prefix for urban surface model output to "usm_",
107! introduced control parameter varnamelength for LEN of trimvar.
108!
109! 2007 2016-08-24 15:47:17Z kanani
110! Added support for new urban surface model (temporary modifications of
111! SELECT CASE ( ) necessary, see variable trimvar),
112! added comments in variable declaration section
113!
114! 2000 2016-08-20 18:09:15Z knoop
115! Forced header and separation lines into 80 columns
116!
117! 1972 2016-07-26 07:52:02Z maronga
118! Output of land surface quantities is now done directly in the respective module
119!
120! 1960 2016-07-12 16:34:24Z suehring
121! Treat humidity and passive scalar separately
122!
123! 1691 2015-10-26 16:17:44Z maronga
124! Added output of Obukhov length and radiative heating rates for RRTMG.
125!
126! 1682 2015-10-07 23:56:08Z knoop
127! Code annotations made doxygen readable
128!
129! 1585 2015-04-30 07:05:52Z maronga
130! Adapted for RRTMG
131!
132! 1555 2015-03-04 17:44:27Z maronga
133! Added output of r_a and r_s
134!
135! 1551 2015-03-03 14:18:16Z maronga
136! Added support for land surface and radiation model parameters.
137!
138! 1322 2014-03-20 16:38:49Z raasch
139! REAL functions provided with KIND-attribute
140!
141! 1320 2014-03-20 08:40:49Z raasch
142! ONLY-attribute added to USE-statements,
143! kind-parameters added to all INTEGER and REAL declaration statements,
144! kinds are defined in new module kinds,
145! revision history before 2012 removed,
146! comment fields (!:) to be used for variable explanations added to
147! all variable declaration statements
148!
149! 1318 2014-03-17 13:35:16Z raasch
150! barrier argument removed from cpu_log,
151! module interfaces removed
152!
153! 1115 2013-03-26 18:16:16Z hoffmann
154! +qc
155!
156! 1053 2012-11-13 17:11:03Z hoffmann
157! averaging of nr, qr added
158!
159! 1036 2012-10-22 13:43:42Z raasch
160! code put under GPL (PALM 3.9)
161!
162! 978 2012-08-09 08:28:32Z fricke
163! +z0h_av
164!
165! Revision 1.1  2006/02/23 09:48:58  raasch
166! Initial revision
167!
168!
169! Description:
170! ------------
171!> Time-averaging of 3d-data-arrays.
172!------------------------------------------------------------------------------!
173 SUBROUTINE average_3d_data
174 
175
176    USE averaging
177
178    USE control_parameters,                                                    &
179        ONLY:  average_count_3d, doav, doav_n, varnamelength
180
181    USE cpulog,                                                                &
182        ONLY:  cpu_log, log_point
183
184    USE indices,                                                               &
185        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
186
187    USE kinds
188
189    USE module_interface,                                                      &
190        ONLY:  module_interface_3d_data_averaging
191
192    USE turbulence_closure_mod,                                                &
193        ONLY:  tcm_3d_data_averaging
194
195
196
197
198    IMPLICIT NONE
199
200    INTEGER(iwp) ::  i   !< loop index
201    INTEGER(iwp) ::  ii  !< loop index
202    INTEGER(iwp) ::  j   !< loop index
203    INTEGER(iwp) ::  k   !< loop index
204
205    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
206
207
208    CALL cpu_log (log_point(35),'average_3d_data','start')
209
210!
211!-- Check, if averaging is necessary
212    IF ( average_count_3d <= 1 )  RETURN
213
214!
215!-- Loop of all variables to be averaged.
216    DO  ii = 1, doav_n
217
218       trimvar = TRIM( doav(ii) )
219
220!
221!--    Store the array chosen on the temporary array.
222       SELECT CASE ( trimvar )
223
224          CASE ( 'e' )
225             IF ( ALLOCATED( e_av ) ) THEN
226                DO  i = nxlg, nxrg
227                   DO  j = nysg, nyng
228                      DO  k = nzb, nzt+1
229                         e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d, KIND=wp )
230                      ENDDO
231                   ENDDO
232                ENDDO
233             ENDIF
234
235          CASE ( 'ghf*' )
236             IF ( ALLOCATED( ghf_av ) ) THEN
237                DO  i = nxl, nxr
238                   DO  j = nys, nyn
239                      ghf_av(j,i) = ghf_av(j,i)                                   &
240                                    / REAL( average_count_3d, KIND=wp )
241                   ENDDO
242                ENDDO
243                CALL exchange_horiz_2d( ghf_av, nbgp )
244             ENDIF
245
246          CASE ( 'qsws*' )
247             IF ( ALLOCATED( qsws_av ) ) THEN
248                DO  i = nxlg, nxrg
249                   DO  j = nysg, nyng
250                      qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d, KIND=wp )
251                   ENDDO
252                ENDDO
253                CALL exchange_horiz_2d( qsws_av, nbgp )
254             ENDIF
255
256          CASE ( 'thetal' )
257             IF ( ALLOCATED( lpt_av ) ) THEN
258                DO  i = nxlg, nxrg
259                   DO  j = nysg, nyng
260                      DO  k = nzb, nzt+1
261                         lpt_av(k,j,i) = lpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
262                      ENDDO
263                   ENDDO
264                ENDDO
265             ENDIF
266
267          CASE ( 'lwp*' )
268             IF ( ALLOCATED( lwp_av ) ) THEN
269                DO  i = nxlg, nxrg
270                   DO  j = nysg, nyng
271                      lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d, KIND=wp )
272                   ENDDO
273                ENDDO
274             ENDIF
275
276         CASE ( 'ol*' )
277             IF ( ALLOCATED( ol_av ) ) THEN
278                DO  i = nxlg, nxrg
279                   DO  j = nysg, nyng
280                      ol_av(j,i) = ol_av(j,i) / REAL( average_count_3d, KIND=wp )
281                   ENDDO
282                ENDDO
283                CALL exchange_horiz_2d( ol_av, nbgp )
284             ENDIF
285
286          CASE ( 'p' )
287             IF ( ALLOCATED( p_av ) ) THEN
288                DO  i = nxlg, nxrg
289                   DO  j = nysg, nyng
290                      DO  k = nzb, nzt+1
291                         p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d, KIND=wp )
292                      ENDDO
293                   ENDDO
294                ENDDO
295             ENDIF
296
297          CASE ( 'pc' )
298             IF ( ALLOCATED( pc_av ) ) THEN
299                DO  i = nxl, nxr
300                   DO  j = nys, nyn
301                      DO  k = nzb, nzt+1
302                         pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
303                      ENDDO
304                   ENDDO
305                ENDDO
306             ENDIF
307
308          CASE ( 'pr' )
309             IF ( ALLOCATED( pr_av ) ) THEN
310                DO  i = nxl, nxr
311                   DO  j = nys, nyn
312                      DO  k = nzb, nzt+1
313                         pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d, KIND=wp )
314                      ENDDO
315                   ENDDO
316                ENDDO
317             ENDIF
318
319          CASE ( 'theta' )
320             IF ( ALLOCATED( pt_av ) ) THEN
321                DO  i = nxlg, nxrg
322                   DO  j = nysg, nyng
323                      DO  k = nzb, nzt+1
324                         pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
325                      ENDDO
326                   ENDDO
327                ENDDO
328             ENDIF
329
330          CASE ( 'q' )
331             IF ( ALLOCATED( q_av ) ) THEN
332                DO  i = nxlg, nxrg
333                   DO  j = nysg, nyng
334                      DO  k = nzb, nzt+1
335                         q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND=wp )
336                      ENDDO
337                   ENDDO
338                ENDDO
339             ENDIF
340
341          CASE ( 'ql' )
342             IF ( ALLOCATED( ql_av ) ) THEN
343                DO  i = nxlg, nxrg
344                   DO  j = nysg, nyng
345                      DO  k = nzb, nzt+1
346                         ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d, KIND=wp )
347                      ENDDO
348                   ENDDO
349                ENDDO
350             ENDIF
351
352          CASE ( 'ql_c' )
353             IF ( ALLOCATED( ql_c_av ) ) THEN
354                DO  i = nxlg, nxrg
355                   DO  j = nysg, nyng
356                      DO  k = nzb, nzt+1
357                         ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d, KIND=wp )
358                      ENDDO
359                   ENDDO
360                ENDDO
361             ENDIF
362
363          CASE ( 'ql_v' )
364             IF ( ALLOCATED( ql_v_av ) ) THEN
365                DO  i = nxlg, nxrg
366                   DO  j = nysg, nyng
367                      DO  k = nzb, nzt+1
368                         ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
369                      ENDDO
370                   ENDDO
371                ENDDO
372             ENDIF
373
374          CASE ( 'ql_vp' )
375             IF ( ALLOCATED( ql_vp_av ) ) THEN
376                DO  i = nxlg, nxrg
377                   DO  j = nysg, nyng
378                      DO  k = nzb, nzt+1
379                         ql_vp_av(k,j,i) = ql_vp_av(k,j,i) /                      &
380                                           REAL( average_count_3d, KIND=wp )
381                      ENDDO
382                   ENDDO
383                ENDDO
384             ENDIF
385
386          CASE ( 'qv' )
387             IF ( ALLOCATED( qv_av ) ) THEN
388                DO  i = nxlg, nxrg
389                   DO  j = nysg, nyng
390                      DO  k = nzb, nzt+1
391                         qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
392                      ENDDO
393                   ENDDO
394                ENDDO
395             ENDIF
396
397         CASE ( 'r_a*' )
398             IF ( ALLOCATED( r_a_av ) ) THEN
399                DO  i = nxlg, nxrg
400                   DO  j = nysg, nyng
401                      r_a_av(j,i) = r_a_av(j,i) / REAL( average_count_3d, KIND=wp )
402                   ENDDO
403                ENDDO
404                CALL exchange_horiz_2d( r_a_av, nbgp )
405             ENDIF
406
407          CASE ( 's' )
408             IF ( ALLOCATED( s_av ) ) THEN
409                DO  i = nxlg, nxrg
410                   DO  j = nysg, nyng
411                      DO  k = nzb, nzt+1
412                         s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d, KIND=wp )
413                      ENDDO
414                   ENDDO
415                ENDDO
416             ENDIF
417
418         CASE ( 'shf*' )
419             IF ( ALLOCATED( shf_av ) ) THEN
420                DO  i = nxlg, nxrg
421                   DO  j = nysg, nyng
422                      shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d, KIND=wp )
423                   ENDDO
424                ENDDO
425                CALL exchange_horiz_2d( shf_av, nbgp )
426             ENDIF
427
428          CASE ( 'ssws*' )
429             IF ( ALLOCATED( ssws_av ) ) THEN
430                DO  i = nxlg, nxrg
431                   DO  j = nysg, nyng
432                      ssws_av(j,i) = ssws_av(j,i) / REAL( average_count_3d, KIND=wp )
433                   ENDDO
434                ENDDO
435                CALL exchange_horiz_2d( ssws_av, nbgp )
436             ENDIF
437
438          CASE ( 't*' )
439             IF ( ALLOCATED( ts_av ) ) THEN
440                DO  i = nxlg, nxrg
441                   DO  j = nysg, nyng
442                      ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d, KIND=wp )
443                   ENDDO
444                ENDDO
445                CALL exchange_horiz_2d( ts_av, nbgp )
446             ENDIF
447
448         CASE ( 'tsurf*' )
449             IF ( ALLOCATED( tsurf_av ) ) THEN
450                DO  i = nxlg, nxrg
451                   DO  j = nysg, nyng
452                      tsurf_av(j,i) = tsurf_av(j,i) / REAL( average_count_3d, KIND=wp )
453                   ENDDO
454                ENDDO
455                CALL exchange_horiz_2d( tsurf_av, nbgp )
456             ENDIF
457
458          CASE ( 'u' )
459             IF ( ALLOCATED( u_av ) ) THEN
460                DO  i = nxlg, nxrg
461                   DO  j = nysg, nyng
462                      DO  k = nzb, nzt+1
463                         u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND=wp )
464                      ENDDO
465                   ENDDO
466                ENDDO
467             ENDIF
468
469          CASE ( 'us*' )
470             IF ( ALLOCATED( us_av ) ) THEN
471                DO  i = nxlg, nxrg
472                   DO  j = nysg, nyng
473                      us_av(j,i) = us_av(j,i) / REAL( average_count_3d, KIND=wp )
474                   ENDDO
475                ENDDO
476                CALL exchange_horiz_2d( us_av, nbgp )
477             ENDIF
478
479          CASE ( 'v' )
480             IF ( ALLOCATED( v_av ) ) THEN
481                DO  i = nxlg, nxrg
482                   DO  j = nysg, nyng
483                      DO  k = nzb, nzt+1
484                         v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
485                      ENDDO
486                   ENDDO
487                ENDDO
488             ENDIF
489
490          CASE ( 'thetav' )
491             IF ( ALLOCATED( vpt_av ) ) THEN
492                DO  i = nxlg, nxrg
493                   DO  j = nysg, nyng
494                      DO  k = nzb, nzt+1
495                         vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
496                      ENDDO
497                   ENDDO
498                ENDDO
499             ENDIF
500
501          CASE ( 'theta_2m' )
502             IF ( ALLOCATED( pt_2m_av ) ) THEN
503                DO  i = nxlg, nxrg
504                   DO  j = nysg, nyng
505                      pt_2m_av(j,i) = pt_2m_av(j,i) / REAL( average_count_3d, KIND=wp )
506                   ENDDO
507                ENDDO
508                CALL exchange_horiz_2d( pt_2m_av, nbgp )
509             ENDIF
510             
511          CASE ( 'w' )
512             IF ( ALLOCATED( w_av ) ) THEN
513                DO  i = nxlg, nxrg
514                   DO  j = nysg, nyng
515                      DO  k = nzb, nzt+1
516                         w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND=wp )
517                      ENDDO
518                   ENDDO
519                ENDDO
520             ENDIF
521
522          CASE ( 'z0*' )
523             IF ( ALLOCATED( z0_av ) ) THEN
524                DO  i = nxlg, nxrg
525                   DO  j = nysg, nyng
526                      z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d, KIND=wp )
527                   ENDDO
528                ENDDO
529                CALL exchange_horiz_2d( z0_av, nbgp )
530             ENDIF
531
532          CASE ( 'z0h*' )
533             IF ( ALLOCATED( z0h_av ) ) THEN
534                DO  i = nxlg, nxrg
535                   DO  j = nysg, nyng
536                      z0h_av(j,i) = z0h_av(j,i) / REAL( average_count_3d, KIND=wp )
537                   ENDDO
538                ENDDO
539                CALL exchange_horiz_2d( z0h_av, nbgp )
540             ENDIF
541
542          CASE ( 'z0q*' )
543             IF ( ALLOCATED( z0q_av ) ) THEN
544                DO  i = nxlg, nxrg
545                   DO  j = nysg, nyng
546                      z0q_av(j,i) = z0q_av(j,i) / REAL( average_count_3d, KIND=wp )
547                   ENDDO
548                ENDDO
549                CALL exchange_horiz_2d( z0q_av, nbgp )
550             ENDIF
551
552          CASE DEFAULT
553
554!
555!--          Averaging of data from turbulence closure module
556             CALL tcm_3d_data_averaging( 'average', trimvar )
557!
558!--          Averaging of data from all other modules
559             CALL module_interface_3d_data_averaging( 'average', trimvar )
560
561       END SELECT
562
563    ENDDO
564
565!
566!-- Reset the counter
567    average_count_3d = 0.0
568
569    CALL cpu_log( log_point(35), 'average_3d_data', 'stop' )
570
571
572 END SUBROUTINE average_3d_data
Note: See TracBrowser for help on using the repository browser.