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

Last change on this file since 2618 was 2292, checked in by schwenkel, 7 years ago

implementation of new bulk microphysics scheme

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