Changeset 4591 for palm/trunk/SOURCE/subsidence_mod.f90
- Timestamp:
- Jul 6, 2020 3:56:08 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/subsidence_mod.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/subsidence_mod.f90
r4360 r4591 1 1 !> @file subsidence_mod.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 !--------------------------------------------------------------------------------------------------! 18 ! 19 19 ! 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 ! topography information used in wall_flags_static_0 29 ! 27 ! File re-formatted to follow the PALM coding standard 28 ! 29 ! 30 ! 4360 2020-01-07 11:25:50Z suehring 31 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 32 ! information used in wall_flags_static_0 33 ! 30 34 ! 4329 2019-12-10 15:46:36Z motisi 31 35 ! Renamed wall_flags_0 to wall_flags_static_0 32 ! 36 ! 33 37 ! 4182 2019-08-22 15:20:23Z scharf 34 38 ! Corrected "Former revisions" section 35 ! 39 ! 36 40 ! 3655 2019-01-07 16:51:22Z knoop 37 ! add subroutine and variable description41 ! Add subroutine and variable description 38 42 ! 39 43 ! Revision 3.7 2009-12-11 14:15:58Z heinze 40 ! Initial revision 44 ! Initial revision 41 45 ! 42 46 ! Description: 43 47 ! ------------ 44 !> Impact of large-scale subsidence or ascent as tendency term for use 45 !> in the prognostic equation of potential temperature. This enables the46 !> construction of a constant boundary layer height z_i withtime.47 !----------------------------------------------------------------------------- !48 !> Impact of large-scale subsidence or ascent as tendency term for use in the prognostic equation of 49 !> potential temperature. This enables the construction of a constant boundary layer height z_i with 50 !> time. 51 !--------------------------------------------------------------------------------------------------! 48 52 MODULE subsidence_mod 49 50 53 51 54 … … 66 69 CONTAINS 67 70 68 !------------------------------------------------------------------------------ !71 !--------------------------------------------------------------------------------------------------! 69 72 ! Description: 70 73 ! ------------ 71 74 !> Initialize vertical subsidence velocity w_subs. 72 !------------------------------------------------------------------------------! 73 SUBROUTINE init_w_subsidence 74 75 USE arrays_3d, & 76 ONLY: dzu, w_subs, zu 77 78 USE control_parameters, & 79 ONLY: message_string, ocean_mode, subs_vertical_gradient, & 80 subs_vertical_gradient_level, subs_vertical_gradient_level_i 81 82 USE indices, & 83 ONLY: nzb, nzt 75 !--------------------------------------------------------------------------------------------------! 76 SUBROUTINE init_w_subsidence 77 78 USE arrays_3d, & 79 ONLY: dzu, & 80 w_subs, & 81 zu 82 83 USE control_parameters, & 84 ONLY: message_string, & 85 ocean_mode, & 86 subs_vertical_gradient, & 87 subs_vertical_gradient_level, & 88 subs_vertical_gradient_level_i 89 90 USE indices, & 91 ONLY: nzb, & 92 nzt 84 93 85 94 USE kinds … … 87 96 IMPLICIT NONE 88 97 89 INTEGER(iwp) :: i !< loop index90 INTEGER(iwp) :: k !< loop index91 92 REAL(wp) :: gradient!< vertical gradient of subsidence velocity93 REAL(wp) :: ws_surface!< subsidence velocity at the surface98 INTEGER(iwp) :: i !< loop index 99 INTEGER(iwp) :: k !< loop index 100 101 REAL(wp) :: gradient !< vertical gradient of subsidence velocity 102 REAL(wp) :: ws_surface !< subsidence velocity at the surface 94 103 95 104 IF ( .NOT. ALLOCATED( w_subs ) ) THEN 96 105 ALLOCATE( w_subs(nzb:nzt+1) ) 97 106 w_subs = 0.0_wp 98 ENDIF 107 ENDIF 99 108 100 109 IF ( ocean_mode ) THEN 101 message_string = 'applying large scale vertical motion is not ' // & 102 'allowed for ocean mode' 110 message_string = 'applying large scale vertical motion is not allowed for ocean mode' 103 111 CALL message( 'init_w_subsidence', 'PA0324', 2, 2, 0, 6, 0 ) 104 112 ENDIF 105 113 106 114 ! 107 !-- Compute the profile of the subsidence/ascent velocity 108 !-- using the given gradients 115 !-- Compute the profile of the subsidence/ascent velocity using the given gradients 109 116 i = 1 110 117 gradient = 0.0_wp 111 118 ws_surface = 0.0_wp 112 119 113 120 114 121 subs_vertical_gradient_level_i(1) = 0 115 122 DO k = 1, nzt+1 116 123 IF ( i < 11 ) THEN 117 IF ( subs_vertical_gradient_level(i) < zu(k) .AND. &124 IF ( subs_vertical_gradient_level(i) < zu(k) .AND. & 118 125 subs_vertical_gradient_level(i) >= 0.0_wp ) THEN 119 126 gradient = subs_vertical_gradient(i) / 100.0_wp … … 134 141 135 142 ! 136 !-- In case of no given gradients for the subsidence/ascent velocity, 137 !-- choose zero gradient 143 !-- In case of no given gradients for the subsidence/ascent velocity, choose zero gradient 138 144 IF ( subs_vertical_gradient_level(1) == -9999999.9_wp ) THEN 139 145 subs_vertical_gradient_level(1) = 0.0_wp … … 143 149 144 150 145 !------------------------------------------------------------------------------ !151 !--------------------------------------------------------------------------------------------------! 146 152 ! Description: 147 153 ! ------------ 148 154 !> Add effect of large-scale subsidence to variable. 149 !------------------------------------------------------------------------------! 150 SUBROUTINE subsidence( tendency, var, var_init, ls_index ) 151 152 USE arrays_3d, & 153 ONLY: ddzu, w_subs 154 155 USE control_parameters, & 156 ONLY: dt_3d, intermediate_timestep_count, large_scale_forcing, & 155 !--------------------------------------------------------------------------------------------------! 156 SUBROUTINE subsidence( tendency, var, var_init, ls_index ) 157 158 USE arrays_3d, & 159 ONLY: ddzu, & 160 w_subs 161 162 USE control_parameters, & 163 ONLY: dt_3d, & 164 intermediate_timestep_count, & 165 large_scale_forcing, & 157 166 scalar_rayleigh_damping 158 167 159 USE indices, & 160 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 168 USE indices, & 169 ONLY: nxl, & 170 nxlg, & 171 nxr, & 172 nxrg, & 173 nyn, & 174 nyng, & 175 nys, & 176 nysg, & 177 nzb, & 178 nzt, & 161 179 wall_flags_total_0 162 180 163 181 USE kinds 164 182 165 USE statistics, & 166 ONLY: sums_ls_l, weight_substep 183 USE statistics, & 184 ONLY: sums_ls_l, & 185 weight_substep 167 186 168 187 IMPLICIT NONE 169 170 INTEGER(iwp) :: i !< loop index171 INTEGER(iwp) :: j !< loop index172 INTEGER(iwp) :: k !< loop index173 INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l174 175 REAL(wp) :: tmp_tend!< temporary tendency176 REAL(wp) :: tmp_grad !< temporary gradient177 178 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence179 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var180 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var181 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var188 189 INTEGER(iwp) :: i !< loop index 190 INTEGER(iwp) :: j !< loop index 191 INTEGER(iwp) :: k !< loop index 192 INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l 193 194 REAL(wp) :: tmp_tend !< temporary tendency 195 REAL(wp) :: tmp_grad !< temporary gradient 196 197 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence 198 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var 199 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var 200 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var 182 201 183 202 var_mod = var_init … … 188 207 DO j = nys, nyn 189 208 190 DO k = nzb+1, nzt 209 DO k = nzb+1, nzt 191 210 IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence 192 tmp_tend = - w_subs(k) * & 193 ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1) * & 194 MERGE( 1.0_wp, 0.0_wp, & 195 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 196 ELSE ! large-scale ascent 197 tmp_tend = - w_subs(k) * & 198 ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) * & 199 MERGE( 1.0_wp, 0.0_wp, & 200 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 211 tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1) * & 212 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 213 ELSE ! large-scale ascent 214 tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) * & 215 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 201 216 ENDIF 202 217 … … 204 219 205 220 IF ( large_scale_forcing ) THEN 206 sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend &207 * weight_substep(intermediate_timestep_count)&208 * MERGE( 1.0_wp, 0.0_wp,&209 BTEST( wall_flags_total_0(k,j,i), 0 ) )221 sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend & 222 * weight_substep(intermediate_timestep_count) & 223 * MERGE( 1.0_wp, 0.0_wp, & 224 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 210 225 ENDIF 211 226 ENDDO … … 219 234 220 235 ! 221 !-- Shifting of the initial profile is especially necessary with Rayleigh 222 !-- damping switched on 223 IF ( scalar_rayleigh_damping .AND. & 224 intermediate_timestep_count == 1 ) THEN 236 !-- Shifting of the initial profile is especially necessary with Rayleigh damping switched on 237 IF ( scalar_rayleigh_damping .AND. intermediate_timestep_count == 1 ) THEN 225 238 DO k = nzb, nzt 226 239 IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence 227 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &228 240 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * & 241 ( var_init(k+1) - var_init(k) ) * ddzu(k+1) 229 242 ENDIF 230 243 ENDDO 231 244 ! 232 !-- At the upper boundary, the initial profile is shifted with aid of 233 !-- the gradient tmp_grad.(This is ok if the gradients are linear.)245 !-- At the upper boundary, the initial profile is shifted with aid of the gradient tmp_grad. 246 !-- (This is ok if the gradients are linear.) 234 247 IF ( w_subs(nzt) < 0.0_wp ) THEN 235 248 tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1) 236 var_mod(nzt+1) = var_init(nzt+1) - & 237 dt_3d * w_subs(nzt+1) * tmp_grad 249 var_mod(nzt+1) = var_init(nzt+1) - dt_3d * w_subs(nzt+1) * tmp_grad 238 250 ENDIF 239 251 240 252 241 253 DO k = nzt+1, nzb+1, -1 242 254 IF ( w_subs(k) >= 0.0_wp ) THEN ! large-scale ascent 243 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &244 ( var_init(k) - var_init(k-1) ) * ddzu(k)255 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * & 256 ( var_init(k) - var_init(k-1) ) * ddzu(k) 245 257 ENDIF 246 258 ENDDO 247 259 ! 248 !-- At the lower boundary shifting is not necessary because the 249 !-- subsidence velocity w_subs(nzb)vanishes.260 !-- At the lower boundary shifting is not necessary because the subsidence velocity w_subs(nzb) 261 !-- vanishes. 250 262 IF ( w_subs(nzb+1) >= 0.0_wp ) THEN 251 263 var_mod(nzb) = var_init(nzb) … … 258 270 END SUBROUTINE subsidence 259 271 260 !------------------------------------------------------------------------------ !272 !--------------------------------------------------------------------------------------------------! 261 273 ! Description: 262 274 ! ------------ 263 275 !> Add effect of large-scale subsidence to variable. 264 !------------------------------------------------------------------------------! 265 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index ) 266 267 USE arrays_3d, & 268 ONLY: ddzu, w_subs 269 270 USE control_parameters, & 271 ONLY: dt_3d, intermediate_timestep_count, large_scale_forcing, & 276 !--------------------------------------------------------------------------------------------------! 277 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index ) 278 279 USE arrays_3d, & 280 ONLY: ddzu, & 281 w_subs 282 283 USE control_parameters, & 284 ONLY: dt_3d, & 285 intermediate_timestep_count, & 286 large_scale_forcing, & 272 287 scalar_rayleigh_damping 273 288 274 USE indices, & 275 ONLY: nxl, nxlg, nxrg, nyng, nys, nysg, nzb, nzt, & 289 USE indices, & 290 ONLY: nxl, & 291 nxlg, & 292 nxrg, & 293 nyng, & 294 nys, & 295 nysg, & 296 nzb, & 297 nzt, & 276 298 wall_flags_total_0 277 299 278 300 USE kinds 279 301 280 USE statistics, & 281 ONLY: sums_ls_l, weight_substep 302 USE statistics, & 303 ONLY: sums_ls_l, & 304 weight_substep 282 305 283 306 IMPLICIT NONE 284 285 INTEGER(iwp) :: i !< loop variable286 INTEGER(iwp) :: j !< loop variable287 INTEGER(iwp) :: k !< loop variable288 INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l289 290 REAL(wp) :: tmp_tend!< temporary tendency291 REAL(wp) :: tmp_grad!< temporary gradient292 293 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence294 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var295 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var296 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var307 308 INTEGER(iwp) :: i !< loop variable 309 INTEGER(iwp) :: j !< loop variable 310 INTEGER(iwp) :: k !< loop variable 311 INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l 312 313 REAL(wp) :: tmp_tend !< temporary tendency 314 REAL(wp) :: tmp_grad !< temporary gradient 315 316 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence 317 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var 318 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var 319 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var 297 320 298 321 var_mod = var_init … … 300 323 ! 301 324 !-- Influence of w_subsidence on the current tendency term 302 DO k = nzb+1, nzt 325 DO k = nzb+1, nzt 303 326 IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence 304 tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) & 305 * ddzu(k+1) & 306 * MERGE( 1.0_wp, 0.0_wp, & 307 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 327 tmp_tend = - w_subs(k) * ( var(k+1,j,i) - var(k,j,i) ) * ddzu(k+1) & 328 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 308 329 ELSE ! large-scale ascent 309 tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) & 310 * MERGE( 1.0_wp, 0.0_wp, & 311 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 330 tmp_tend = - w_subs(k) * ( var(k,j,i) - var(k-1,j,i) ) * ddzu(k) & 331 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 312 332 ENDIF 313 333 … … 315 335 316 336 IF ( large_scale_forcing ) THEN 317 sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend & 318 * weight_substep(intermediate_timestep_count)& 319 * MERGE( 1.0_wp, 0.0_wp, & 320 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 337 sums_ls_l(k,ls_index) = sums_ls_l(k,ls_index) + tmp_tend & 338 * weight_substep(intermediate_timestep_count) & 339 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 321 340 ENDIF 322 341 ENDDO … … 327 346 328 347 ! 329 !-- Shifting of the initial profile is especially necessary with Rayleigh 330 !-- damping switched on 331 IF ( scalar_rayleigh_damping .AND. & 332 intermediate_timestep_count == 1 ) THEN 333 IF ( i == nxl .AND. j == nys ) THEN ! shifting only once per PE 348 !-- Shifting of the initial profile is especially necessary with Rayleigh damping switched on 349 IF ( scalar_rayleigh_damping .AND. intermediate_timestep_count == 1 ) THEN 350 IF ( i == nxl .AND. j == nys ) THEN ! shifting only once per PE 334 351 335 352 DO k = nzb, nzt 336 353 IF ( w_subs(k) < 0.0_wp ) THEN ! large-scale subsidence 337 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &338 354 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * & 355 ( var_init(k+1) - var_init(k) ) * ddzu(k+1) 339 356 ENDIF 340 357 ENDDO 341 358 ! 342 !-- At the upper boundary, the initial profile is shifted with aid of 343 !-- t he gradient tmp_grad. (This is ok if the gradients are linear.)359 !-- At the upper boundary, the initial profile is shifted with aid of the gradient 360 !-- tmp_grad. (This is ok if the gradients are linear.) 344 361 IF ( w_subs(nzt) < 0.0_wp ) THEN 345 362 tmp_grad = ( var_init(nzt+1) - var_init(nzt) ) * ddzu(nzt+1) 346 var_mod(nzt+1) = var_init(nzt+1) - & 347 dt_3d * w_subs(nzt+1) * tmp_grad 363 var_mod(nzt+1) = var_init(nzt+1) - dt_3d * w_subs(nzt+1) * tmp_grad 348 364 ENDIF 349 365 350 366 351 367 DO k = nzt+1, nzb+1, -1 352 368 IF ( w_subs(k) >= 0.0_wp ) THEN ! large-scale ascent 353 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * &354 369 var_mod(k) = var_init(k) - dt_3d * w_subs(k) * & 370 ( var_init(k) - var_init(k-1) ) * ddzu(k) 355 371 ENDIF 356 372 ENDDO 357 373 ! 358 !-- At the lower boundary shifting is not necessary because the 359 !-- subsidence velocityw_subs(nzb) vanishes.374 !-- At the lower boundary shifting is not necessary because the subsidence velocity 375 !-- w_subs(nzb) vanishes. 360 376 IF ( w_subs(nzb+1) >= 0.0_wp ) THEN 361 377 var_mod(nzb) = var_init(nzb) 362 378 ENDIF 363 379 364 var_init = var_mod 380 var_init = var_mod 365 381 366 382 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
