source: palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90 @ 3995

Last change on this file since 3995 was 3995, checked in by suehring, 2 years ago

remove unused variable and fix non-standard string operation PGI compiler

  • Property svn:keywords set to Id
File size: 11.8 KB
Line 
1!> @file diagnostic_output_quantities_mod.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: diagnostic_output_quantities_mod.f90 3995 2019-05-22 18:59:54Z suehring $
27! Avoid compiler warnings about unused variable and fix string operation which
28! is not allowed with PGI compiler
29!
30! 3994 2019-05-22 18:08:09Z suehring
31! Initial revision
32!
33!
34! @author Farah Kanani-Suehring
35!
36! Description:
37! ------------
38!> ...
39!------------------------------------------------------------------------------!
40 MODULE diagnostic_output_quantities_mod
41 
42
43!     USE arrays_3d,                                                             &
44!         ONLY:  dzw, e, heatflux_output_conversion, nc, nr, p, pt,              &
45!                precipitation_amount, prr, q, qc, ql, ql_c, ql_v, qr, s, tend,  &
46!                u, v, vpt, w, zu, zw, waterflux_output_conversion, hyrho, d_exner
47!
48!     USE averaging
49!
50!     USE basic_constants_and_equations_mod,                                     &
51!         ONLY:  c_p, lv_d_cp, l_v
52!
53!     USE bulk_cloud_model_mod,                                                  &
54!         ONLY:  bulk_cloud_model
55!
56    USE control_parameters,                                                    &
57        ONLY:  current_timestep_number, varnamelength
58!
59!     USE cpulog,                                                                &
60!         ONLY:  cpu_log, log_point
61!
62!     USE indices,                                                               &
63!         ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,       &
64!                nzb, nzt, wall_flags_0
65!
66    USE kinds
67!
68!     USE land_surface_model_mod,                                                &
69!         ONLY:  zs
70!
71!     USE module_interface,                                                      &
72!         ONLY:  module_interface_data_output_2d
73!
74! #if defined( __netcdf )
75!     USE NETCDF
76! #endif
77!
78!     USE netcdf_interface,                                                      &
79!         ONLY:  fill_value, id_set_xy, id_set_xz, id_set_yz, id_var_do2d,       &
80!                id_var_time_xy, id_var_time_xz, id_var_time_yz, nc_stat,        &
81!                netcdf_data_format, netcdf_handle_error
82!
83!     USE particle_attributes,                                                   &
84!         ONLY:  grid_particles, number_of_particles, particle_advection_start,  &
85!                particles, prt_count
86!     
87!     USE pegrid
88!
89!     USE surface_mod,                                                           &
90!         ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_def_h,           &
91!                surf_lsm_h, surf_usm_h
92!
93!     USE turbulence_closure_mod,                                                &
94!         ONLY:  tcm_data_output_2d
95
96
97    IMPLICIT NONE
98
99    CHARACTER(LEN=varnamelength), DIMENSION(500) ::  do_all = ' '
100
101    INTEGER(iwp) ::  timestep_number_at_prev_calc = 0  !< ...at previous diagnostic output calculation
102
103    LOGICAL ::  initialized_diagnostic_output_quantities = .FALSE.
104    LOGICAL ::  prepared_diagnostic_output_quantities = .FALSE.
105
106    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ti     !< rotation(u,v,w) aka turbulence intensity
107    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ti_av  !< avg. rotation(u,v,w) aka turbulence intensity
108
109
110    SAVE
111
112    PRIVATE
113
114!
115!-- Public variables
116    PUBLIC do_all,                                                                                 &
117           initialized_diagnostic_output_quantities,                                               &
118           prepared_diagnostic_output_quantities,                                                  &
119           ti, ti_av,                                                                              &
120           timestep_number_at_prev_calc
121!
122!-- Public routines
123    PUBLIC diagnostic_output_quantities_calculate,                                                 &
124           diagnostic_output_quantities_init,                                                      &
125           diagnostic_output_quantities_prepare
126
127
128    INTERFACE diagnostic_output_quantities_init
129       MODULE PROCEDURE diagnostic_output_quantities_init
130    END INTERFACE diagnostic_output_quantities_init
131
132    INTERFACE diagnostic_output_quantities_calculate
133       MODULE PROCEDURE diagnostic_output_quantities_calculate
134    END INTERFACE diagnostic_output_quantities_calculate
135
136    INTERFACE diagnostic_output_quantities_prepare
137       MODULE PROCEDURE diagnostic_output_quantities_prepare
138    END INTERFACE diagnostic_output_quantities_prepare
139
140
141 CONTAINS
142
143!------------------------------------------------------------------------------!
144! Description:
145! ------------
146!> ...
147!------------------------------------------------------------------------------!
148 SUBROUTINE diagnostic_output_quantities_init
149
150
151    USE indices,                                                                                   &
152        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
153
154    IMPLICIT NONE
155!
156!-- Next line is to avoid compiler warnings about unused variables
157    IF ( timestep_number_at_prev_calc == 0 )  CONTINUE
158
159    initialized_diagnostic_output_quantities = .FALSE.
160
161    IF ( .NOT. ALLOCATED( ti ) )  THEN
162       ALLOCATE( ti(nzb:nzt+1,nys:nyn,nxl:nxr) )
163       ti = 0.0_wp
164    ENDIF
165
166    initialized_diagnostic_output_quantities = .TRUE.
167
168 END SUBROUTINE diagnostic_output_quantities_init
169
170
171!--------------------------------------------------------------------------------------------------!
172! Description:
173! ------------
174!> ...
175!--------------------------------------------------------------------------------------------------!
176 SUBROUTINE diagnostic_output_quantities_calculate
177
178
179    USE arrays_3d,                                                                                 &
180        ONLY:  ddzu, u, v, w
181
182    USE grid_variables,                                                                            &
183        ONLY:  ddx, ddy
184
185    USE indices,                                                                                   &
186        ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
187
188    IMPLICIT NONE
189
190    INTEGER(iwp) ::  i, j, k    !< grid loop index in x-, y-, z-direction
191    INTEGER(iwp) ::  ivar_all   !< loop index over all 2d/3d/mask output quantities
192
193
194!     CALL cpu_log( log_point(41), 'calculate_quantities', 'start' )
195!
196!-- Preparatory steps and initialization of output arrays
197    IF ( .NOT.  prepared_diagnostic_output_quantities )     CALL diagnostic_output_quantities_prepare
198    IF ( .NOT.  initialized_diagnostic_output_quantities )  CALL diagnostic_output_quantities_init
199!
200!-- Save timestep number to check in time_integration if diagnostic_output_quantities_calculate
201!-- has been called already, since the CALL occurs at two locations, but the calculations need to be
202!-- done only once per timestep.
203    timestep_number_at_prev_calc = current_timestep_number
204
205
206    ivar_all = 1
207
208    DO  WHILE ( do_all(ivar_all)(1:1) /= ' ' )
209
210       SELECT CASE ( TRIM( do_all(ivar_all) ) )
211!
212!--       Calculate 'turbulence intensity' from rot[(u,v,w)] at scalar grid point
213          CASE ( 'ti' )
214             DO  i = nxl, nxr
215                DO  j = nys, nyn
216                   DO  k = nzb+1, nzt
217
218                      ti(k,j,i) = 0.25_wp * SQRT(                                                  &
219                        (   (   w(k,j+1,i) + w(k-1,j+1,i)                                          &
220                              - w(k,j-1,i) - w(k-1,j-1,i) ) * ddy                                  &
221                          - (   v(k+1,j,i) + v(k+1,j+1,i)                                          &
222                              - v(k-1,j,i) - v(k-1,j+1,i) ) * ddzu(k) )**2                         &
223                      + (   (   u(k+1,j,i) + u(k+1,j,i+1)                                          &
224                              - u(k-1,j,i) - u(k-1,j,i+1) ) * ddzu(k)                              &
225                          - (   w(k,j,i+1) + w(k-1,j,i+1)                                          &
226                              - w(k,j,i-1) - w(k-1,j,i-1) ) * ddx     )**2                         &
227                      + (   (   v(k,j,i+1) + v(k,j+1,i+1)                                          &
228                              - v(k,j,i-1) - v(k,j+1,i-1) ) * ddx                                  &
229                          - (   u(k,j+1,i) + u(k,j+1,i+1)                                          &
230                              - u(k,j-1,i) - u(k,j-1,i+1) ) * ddy     )**2  )                      &
231                                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0) )
232                   ENDDO
233                ENDDO
234             ENDDO
235
236          END SELECT
237
238          ivar_all = ivar_all + 1
239    ENDDO
240
241!     CALL cpu_log( log_point(41), 'calculate_quantities', 'stop' )
242
243 END SUBROUTINE diagnostic_output_quantities_calculate
244
245
246!------------------------------------------------------------------------------!
247! Description:
248! ------------
249!> ...
250!------------------------------------------------------------------------------!
251 SUBROUTINE diagnostic_output_quantities_prepare
252
253
254    USE control_parameters,                                                                        &
255        ONLY:  do2d, do3d, domask, masks, mid
256
257    IMPLICIT NONE
258
259    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) ::  do2d_var = ' '  !<
260                                                          !< label array for 2d output quantities
261
262    INTEGER(iwp) ::  av         !< index defining type of output, av=0 instantaneous, av=1 averaged
263    INTEGER(iwp) ::  ivar       !< loop index
264    INTEGER(iwp) ::  ivar_all   !< loop index
265    INTEGER(iwp) ::  l          !< index for cutting string
266
267
268    prepared_diagnostic_output_quantities = .FALSE.
269
270    ivar     = 1
271    ivar_all = 1
272
273    DO  av = 0, 1
274!
275!--    Remove _xy, _xz, or _yz from string
276       l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
277       do2d_var(av,ivar)(0:l-2) = do2d(av,ivar)(0:l-2)
278!
279!--    Gather 2d output quantity names, check for double occurrence of output quantity
280       DO  WHILE ( do2d_var(av,ivar)(1:1) /= ' ' )
281          IF ( .NOT.  ANY( do_all == do2d_var(av,ivar) ) )  THEN
282             do_all(ivar_all) = do2d_var(av,ivar)
283          ENDIF
284          ivar = ivar + 1
285          ivar_all = ivar_all + 1
286          l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
287          do2d_var(av,ivar)(0:l-2) = do2d(av,ivar)(0:l-2)
288       ENDDO
289
290       ivar = 1
291!
292!--    Gather 3d output quantity names, check for double occurrence of output quantity
293       DO  WHILE ( do3d(av,ivar)(1:1) /= ' ' )
294          do_all(ivar_all) = do3d(av,ivar)
295
296          ivar = ivar + 1
297          ivar_all = ivar_all + 1
298       ENDDO
299
300       ivar = 1
301!
302!--    Gather masked output quantity names, check for double occurrence of output quantity
303       DO  mid = 1, masks
304          DO  WHILE ( domask(mid,av,ivar)(1:1) /= ' ' )
305             do_all(ivar_all) = domask(mid,av,ivar)
306
307             ivar = ivar + 1
308             ivar_all = ivar_all + 1
309          ENDDO
310          ivar = 1
311       ENDDO
312
313    ENDDO
314
315    prepared_diagnostic_output_quantities = .TRUE.
316
317 END SUBROUTINE diagnostic_output_quantities_prepare
318
319 END MODULE diagnostic_output_quantities_mod
Note: See TracBrowser for help on using the repository browser.