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

Last change on this file since 3483 was 3467, checked in by suehring, 6 years ago

Branch salsa @3446 re-integrated into trunk

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