Changeset 4583 for palm/trunk/SOURCE/disturb_field.f90
- Timestamp:
- Jun 29, 2020 12:36:47 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/disturb_field.f90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/disturb_field.f90
r4457 r4583 1 1 !> @file disturb_field.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 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/>. 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/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4457 2020-03-11 14:20:43Z raasch 27 29 ! use statement for exchange horiz added 28 ! 30 ! 29 31 ! 4360 2020-01-07 11:25:50Z suehring 30 ! Introduction of wall_flags_total_0, which currently sets bits based on static 31 ! topographyinformation used in wall_flags_static_032 ! 32 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 33 ! information used in wall_flags_static_0 34 ! 33 35 ! 4329 2019-12-10 15:46:36Z motisi 34 36 ! Renamed wall_flags_0 to wall_flags_static_0 35 ! 37 ! 36 38 ! 4237 2019-09-25 11:33:42Z knoop 37 39 ! Added missing OpenMP directives 38 ! 40 ! 39 41 ! 4182 2019-08-22 15:20:23Z scharf 40 42 ! Corrected "Former revisions" section 41 ! 43 ! 42 44 ! 3849 2019-04-01 16:35:16Z knoop 43 45 ! Corrected "Former revisions" section … … 50 52 ! ------------ 51 53 !> Imposing a random perturbation on a 3D-array. 52 !> On parallel computers, the random number generator is as well called for all 53 !> gridpoints of the total domain to ensure, regardless of the number of PEs 54 !> used, that the elements of the array have the same values in the same 55 !> order in every case. The perturbation range is steered by dist_range. 56 !------------------------------------------------------------------------------! 54 !> On parallel computers, the random number generator is as well called for all gridpoints of the 55 !> total domain to ensure, regardless of the number of PEs used, that the elements of the array have 56 !> the same values in the same order in every case. The perturbation range is steered by dist_range. 57 !--------------------------------------------------------------------------------------------------! 57 58 SUBROUTINE disturb_field( var_char, dist1, field ) 58 59 60 USE control_parameters, & 61 ONLY: dist_nxl, dist_nxr, dist_nyn, dist_nys, dist_range, & 62 disturbance_amplitude, disturbance_created, & 63 disturbance_level_ind_b, disturbance_level_ind_t, iran, & 59 60 61 USE control_parameters, & 62 ONLY: dist_nxl, dist_nxr, dist_nyn, dist_nys, dist_range, disturbance_amplitude, & 63 disturbance_created, disturbance_level_ind_b, disturbance_level_ind_t, iran, & 64 64 random_generator, topography 65 66 USE cpulog, &65 66 USE cpulog, & 67 67 ONLY: cpu_log, log_point 68 69 USE exchange_horiz_mod, &68 69 USE exchange_horiz_mod, & 70 70 ONLY: exchange_horiz 71 71 72 USE indices, &73 ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, &74 nzt,wall_flags_total_075 72 USE indices, & 73 ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, nzt, & 74 wall_flags_total_0 75 76 76 USE kinds 77 78 USE random_function_mod, &77 78 USE random_function_mod, & 79 79 ONLY: random_function 80 81 USE random_generator_parallel, & 82 ONLY: random_number_parallel, random_seed_parallel, random_dummy, & 83 seq_random_array 80 81 USE random_generator_parallel, & 82 ONLY: random_number_parallel, random_seed_parallel, random_dummy, seq_random_array 84 83 85 84 IMPLICIT NONE … … 87 86 CHARACTER (LEN = *) :: var_char !< flag to distinguish betwenn u- and v-component 88 87 89 INTEGER(iwp) :: flag_nr !< number of respective flag for u- or v-grid 88 INTEGER(iwp) :: flag_nr !< number of respective flag for u- or v-grid 90 89 INTEGER(iwp) :: i !< index variable 91 90 INTEGER(iwp) :: j !< index variable … … 93 92 94 93 REAL(wp) :: randomnumber !< 95 94 96 95 REAL(wp) :: dist1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) !< 97 96 REAL(wp) :: field(nzb:nzt+1,nysg:nyng,nxlg:nxrg) !< 98 97 99 98 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dist2 !< 100 99 … … 105 104 flag_nr = MERGE( 20, 21, TRIM(var_char) == 'u' ) 106 105 ! 107 !-- Create an additional temporary array and initialize the arrays needed 108 !-- to store the disturbance 106 !-- Create an additional temporary array and initialize the arrays needed to store the disturbance 109 107 ALLOCATE( dist2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 110 108 !$ACC DATA CREATE(dist2(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) … … 123 121 DO j = dist_nys(dist_range), dist_nyn(dist_range) 124 122 DO k = disturbance_level_ind_b, disturbance_level_ind_t 125 randomnumber = 3.0_wp * disturbance_amplitude * & 126 ( random_function( iran ) - 0.5_wp ) 127 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. & 128 nyn >= j ) & 129 THEN 123 randomnumber = 3.0_wp * disturbance_amplitude * ( random_function( iran ) - 0.5_wp ) 124 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) THEN 130 125 dist1(k,j,i) = randomnumber 131 126 ENDIF … … 139 134 DO k = disturbance_level_ind_b, disturbance_level_ind_t 140 135 CALL random_number_parallel( random_dummy ) 141 randomnumber = 3.0_wp * disturbance_amplitude * & 142 ( random_dummy - 0.5_wp ) 143 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. & 144 nyn >= j ) & 145 THEN 136 randomnumber = 3.0_wp * disturbance_amplitude * ( random_dummy - 0.5_wp ) 137 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) THEN 146 138 dist1(k,j,i) = randomnumber 147 139 ENDIF … … 155 147 DO k = disturbance_level_ind_b, disturbance_level_ind_t 156 148 CALL RANDOM_NUMBER( randomnumber ) 157 randomnumber = 3.0_wp * disturbance_amplitude * & 158 ( randomnumber - 0.5_wp ) 159 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) & 160 THEN 149 randomnumber = 3.0_wp * disturbance_amplitude * ( randomnumber - 0.5_wp ) 150 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) THEN 161 151 dist1(k,j,i) = randomnumber 162 152 ENDIF … … 177 167 ! 178 168 !-- Applying the Shuman filter in order to smooth the perturbations. 179 !-- Neighboured grid points in all three directions are used for the 180 !-- filter operation. 181 !-- Loop has been splitted to make runs reproducible on HLRN systems using 182 !-- compiler option -O3 169 !-- Neighboured grid points in all three directions are used for the filter operation. 170 !-- Loop has been splitted to make runs reproducible on HLRN systems using compiler option -O3 183 171 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) PRESENT(dist1, dist2) 184 172 !$OMP PARALLEL DO PRIVATE(i, j, k) … … 186 174 DO j = nys, nyn 187 175 DO k = disturbance_level_ind_b-1, disturbance_level_ind_t+1 188 dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1) &189 + dist1(k,j+1,i) + dist1(k+1,j,i) &176 dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1) & 177 + dist1(k,j+1,i) + dist1(k+1,j,i) & 190 178 ) / 12.0_wp 191 179 ENDDO 192 180 DO k = disturbance_level_ind_b-1, disturbance_level_ind_t+1 193 dist2(k,j,i) = dist2(k,j,i) + ( dist1(k,j-1,i) + dist1(k-1,j,i) &194 + 6.0_wp * dist1(k,j,i) &195 ) / 12.0_wp181 dist2(k,j,i) = dist2(k,j,i) + ( dist1(k,j-1,i) + dist1(k-1,j,i) & 182 + 6.0_wp * dist1(k,j,i) & 183 ) / 12.0_wp 196 184 ENDDO 197 185 ENDDO … … 208 196 DO j = nys, nyn 209 197 DO k = disturbance_level_ind_b-2, disturbance_level_ind_t+2 210 dist1(k,j,i) = ( dist2(k,j,i-1) + dist2(k,j,i+1) + dist2(k,j-1,i) &211 + dist2(k,j+1,i) + dist2(k+1,j,i) + dist2(k-1,j,i) &212 + 6.0_wp * dist2(k,j,i) &198 dist1(k,j,i) = ( dist2(k,j,i-1) + dist2(k,j,i+1) + dist2(k,j-1,i) & 199 + dist2(k,j+1,i) + dist2(k+1,j,i) + dist2(k-1,j,i) & 200 + 6.0_wp * dist2(k,j,i) & 213 201 ) / 12.0_wp 214 202 ENDDO … … 219 207 220 208 ! 221 !-- Remove perturbations below topography (including one gridpoint above it 222 !-- in order to allow for larger timesteps at the beginning of the simulation 223 !-- (diffusion criterion)) 209 !-- Remove perturbations below topography (including one gridpoint above it in order to allow for 210 !-- larger timesteps at the beginning of the simulation (diffusion criterion)) 224 211 IF ( TRIM( topography ) /= 'flat' ) THEN 225 212 DO i = nxlg, nxrg 226 213 DO j = nysg, nyng 227 214 DO k = nzb, nzb_max 228 dist1(k,j,i) = MERGE( dist1(k,j,i), 0.0_wp, &229 BTEST( wall_flags_total_0(k,j,i), flag_nr ) &215 dist1(k,j,i) = MERGE( dist1(k,j,i), 0.0_wp, & 216 BTEST( wall_flags_total_0(k,j,i), flag_nr ) & 230 217 ) 231 218 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
