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

Last change on this file since 4864 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
RevLine 
[1682]1!> @file user_data_output_mask.f90
[4498]2!--------------------------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[4498]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.
[1036]8!
[4498]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.
[1036]12!
[4498]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/>.
[1036]15!
[4828]16! Copyright 1997-2021 Leibniz Universitaet Hannover
[4498]17!--------------------------------------------------------------------------------------------------!
[1036]18!
[4498]19!
[300]20! Current revisions:
[4498]21! -----------------
[1683]22!
[2001]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: user_data_output_mask.f90 4828 2021-01-05 11:21:41Z raasch $
[4498]27! file re-formatted to follow the PALM coding standard
28!
29!
30! 4360 2020-01-07 11:25:50Z suehring
[4182]31! Corrected "Former revisions" section
[4498]32!
[4182]33! 4168 2019-08-16 13:50:17Z suehring
[4498]34! Remove dependency on surface_mod + example for terrain-following output
[4168]35! adjusted
[4498]36!
[4168]37! 4069 2019-07-01 14:05:51Z Giersch
[4498]38! Masked output running index mid has been introduced as a local variable to
[4069]39! avoid runtime error (Loop variable has been modified) in time_integration
[4498]40!
[4069]41! 3768 2019-02-27 14:35:58Z raasch
[3768]42! variables commented + statement added to avoid compiler warnings about unused variables
[4498]43!
[3768]44! 3655 2019-01-07 16:51:22Z knoop
[3435]45! Add terrain-following output
[4182]46! 1036 2012-10-22 13:43:42Z raasch
47! code put under GPL (PALM 3.9)
[1321]48!
[300]49! Description:
50! ------------
[4498]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!--------------------------------------------------------------------------------------------------!
[4069]54 SUBROUTINE user_data_output_mask( av, variable, found, local_pf, mid )
[300]55
[4498]56
[300]57    USE control_parameters
[4498]58
[300]59    USE indices
[4498]60
[1320]61    USE kinds
[4498]62
[300]63    USE user
64
65    IMPLICIT NONE
66
[4498]67    CHARACTER(LEN=*) ::  variable  !<
[300]68
[4498]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
[300]75
[4498]76    LOGICAL ::  found  !<
[300]77
[4498]78    REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  local_pf  !<
[300]79
[3768]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
[300]84
[3768]85
[300]86    found = .TRUE.
87
88    SELECT CASE ( TRIM( variable ) )
89
90!--    Uncomment and extend the following lines, if necessary.
[4498]91!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
92!--    and defined by the user!
[300]93!--    Sample for user-defined output:
94!       CASE ( 'u2' )
95!          IF ( av == 0 )  THEN
[3435]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)
[4498]102!                         local_pf(i,j,k) = u2(mask_k(mid,k),                                       &
103!                                              mask_j(mid,j),                                       &
[3435]104!                                              mask_i(mid,i))
105!                      ENDDO
[300]106!                   ENDDO
107!                ENDDO
[3435]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
[4498]115!                      topo_top_index = topo_top_ind( mask_j(mid,j), mask_i(mid,i), 1 )
[3435]116!!
117!!--                   Save output array
118!                      DO  k = 1, mask_size_l(mid,3)
[4498]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) )
[3435]121!                      ENDDO
122!                   ENDDO
123!                ENDDO
124!             ENDIF
[300]125!          ELSE
[3435]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)
[4498]132!                          local_pf(i,j,k) = u2_av(mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
[3435]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
[4498]143!                      topo_top_index = topo_top_ind( mask_j(mid,j), mask_i(mid,i), 1 )
[3435]144!!
145!!--                   Save output array
146!                      DO  k = 1, mask_size_l(mid,3)
[4498]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) )
[3435]149!                      ENDDO
[300]150!                   ENDDO
151!                ENDDO
[3435]152!             ENDIF
[300]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.