source: palm/trunk/SOURCE/user_data_output_mask.f90 @ 4858

Last change on this file since 4858 was 4828, checked in by Giersch, 4 years ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

  • Property svn:keywords set to Id
File size: 5.7 KB
Line 
1!> @file user_data_output_mask.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 terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: user_data_output_mask.f90 4828 2021-01-05 11:21:41Z raasch $
27! file re-formatted to follow the PALM coding standard
28!
29!
30! 4360 2020-01-07 11:25:50Z suehring
31! Corrected "Former revisions" section
32!
33! 4168 2019-08-16 13:50:17Z suehring
34! Remove dependency on surface_mod + example for terrain-following output
35! adjusted
36!
37! 4069 2019-07-01 14:05:51Z Giersch
38! Masked output running index mid has been introduced as a local variable to
39! avoid runtime error (Loop variable has been modified) in time_integration
40!
41! 3768 2019-02-27 14:35:58Z raasch
42! variables commented + statement added to avoid compiler warnings about unused variables
43!
44! 3655 2019-01-07 16:51:22Z knoop
45! Add terrain-following output
46! 1036 2012-10-22 13:43:42Z raasch
47! code put under GPL (PALM 3.9)
48!
49! Description:
50! ------------
51!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with
52!> indices (i,j,k) for masked data output.
53!--------------------------------------------------------------------------------------------------!
54 SUBROUTINE user_data_output_mask( av, variable, found, local_pf, mid )
55
56
57    USE control_parameters
58
59    USE indices
60
61    USE kinds
62
63    USE user
64
65    IMPLICIT NONE
66
67    CHARACTER(LEN=*) ::  variable  !<
68
69    INTEGER(iwp) ::  av              !<
70    INTEGER(iwp) ::  mid             !< masked output running index
71!    INTEGER(iwp) ::  i               !<
72!    INTEGER(iwp) ::  j               !<
73!    INTEGER(iwp) ::  k               !<
74!    INTEGER(iwp) ::  topo_top_index  !< k index of highest horizontal surface
75
76    LOGICAL ::  found  !<
77
78    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf  !<
79
80!
81!-- Next line is to avoid compiler warning about unused variables. Please remove.
82    IF ( av == 0  .OR.                                                                             &
83         local_pf(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) == 0.0_wp )  CONTINUE
84
85
86    found = .TRUE.
87
88    SELECT CASE ( TRIM( variable ) )
89
90!--    Uncomment and extend the following lines, if necessary.
91!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
92!--    and defined by the user!
93!--    Sample for user-defined output:
94!       CASE ( 'u2' )
95!          IF ( av == 0 )  THEN
96!             IF ( .NOT. mask_surface(mid) )  THEN
97!!
98!!--             Default masked output
99!                DO  i = 1, mask_size_l(mid,1)
100!                   DO  j = 1, mask_size_l(mid,2)
101!                      DO  k = 1, mask_size_l(mid,3)
102!                         local_pf(i,j,k) = u2(mask_k(mid,k),                                       &
103!                                              mask_j(mid,j),                                       &
104!                                              mask_i(mid,i))
105!                      ENDDO
106!                   ENDDO
107!                ENDDO
108!             ELSE
109!!
110!!--             Terrain-following masked output
111!                DO  i = 1, mask_size_l(mid,1)
112!                   DO  j = 1, mask_size_l(mid,2)
113!!
114!!--                   Get k index of highest horizontal surface
115!                      topo_top_index = topo_top_ind( mask_j(mid,j), mask_i(mid,i), 1 )
116!!
117!!--                   Save output array
118!                      DO  k = 1, mask_size_l(mid,3)
119!                         local_pf(i,j,k) = u2(MIN( topo_top_index + mask_k(mid,k), nzt+1 ),        &
120!                                              mask_j(mid,j), mask_i(mid,i) )
121!                      ENDDO
122!                   ENDDO
123!                ENDDO
124!             ENDIF
125!          ELSE
126!             IF ( .NOT. mask_surface(mid) )  THEN
127!!
128!!--             Default masked output
129!                DO  i = 1, mask_size_l(mid,1)
130!                   DO  j = 1, mask_size_l(mid,2)
131!                      DO  k = 1, mask_size_l(mid,3)
132!                          local_pf(i,j,k) = u2_av(mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
133!                       ENDDO
134!                    ENDDO
135!                 ENDDO
136!             ELSE
137!!
138!!--             Terrain-following masked output
139!                DO  i = 1, mask_size_l(mid,1)
140!                   DO  j = 1, mask_size_l(mid,2)
141!!
142!!--                   Get k index of highest horizontal surface
143!                      topo_top_index = topo_top_ind( mask_j(mid,j), mask_i(mid,i), 1 )
144!!
145!!--                   Save output array
146!                      DO  k = 1, mask_size_l(mid,3)
147!                         local_pf(i,j,k) = u2_av( MIN( topo_top_index+mask_k(mid,k), nzt+1 ),      &
148!                                                  mask_j(mid,j), mask_i(mid,i) )
149!                      ENDDO
150!                   ENDDO
151!                ENDDO
152!             ENDIF
153!          ENDIF
154
155       CASE DEFAULT
156          found = .FALSE.
157
158    END SELECT
159
160
161 END SUBROUTINE user_data_output_mask
Note: See TracBrowser for help on using the repository browser.