Changeset 4497 for palm/trunk/SOURCE/vdi_internal_controls.f90
- Timestamp:
- Apr 15, 2020 10:20:51 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/vdi_internal_controls.f90 (modified) (52 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/vdi_internal_controls.f90
r4481 r4497 1 1 !> @file vdi_internal_controls.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 Software7 ! Foundation, either version 3 of the License, or (at your option) any later8 ! version.9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! 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 with15 ! PALM. If not, see <http://www.gnu.org/licenses/>.16 ! 17 ! Copyright 2019-2020 Leibniz Universitaet Hannover18 ! --------------------------------------------------------------------------------!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-2020 Leibniz Universitaet Hannover 17 !--------------------------------------------------------------------------------------------------! 18 ! 19 19 ! 20 20 ! Current revisions: … … 25 25 ! ----------------- 26 26 ! $Id$ 27 ! file re-formatted to follow the PALM coding standard 28 ! 29 ! 30 ! 4481 2020-03-31 18:55:54Z maronga 27 31 ! missing preprocessor directive added 28 ! 32 ! 29 33 ! 4346 2019-12-18 11:55:56Z motisi 30 ! Introduction of wall_flags_total_0, which currently sets bits based on static 31 ! topographyinformation used in wall_flags_static_032 ! 34 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 35 ! information used in wall_flags_static_0 36 ! 33 37 ! 4329 2019-12-10 15:46:36Z motisi 34 38 ! Renamed wall_flags_0 to wall_flags_static_0 35 ! 39 ! 36 40 ! 4182 2019-08-22 15:20:23Z scharf 37 41 ! added "Authors" section 38 ! 42 ! 39 43 ! 4175 2019-08-20 13:19:16Z gronemeier 40 44 ! bugfix: removed unused variables … … 50 54 ! Description: 51 55 ! ------------ 52 !> According to VDI Guideline 3783 Part 9, internal assessment ha ve to be53 !> carried out within theprogram for the model to be considered as evaluated.54 !------------------------------------------------------------------------------ !56 !> According to VDI Guideline 3783 Part 9, internal assessment has to be carried out within the 57 !> program for the model to be considered as evaluated. 58 !--------------------------------------------------------------------------------------------------! 55 59 MODULE vdi_internal_controls 56 60 57 USE arrays_3d, &58 ONLY: dzw, &59 pt, &60 q, &61 u, &62 u_p, &63 v, &61 USE arrays_3d, & 62 ONLY: dzw, & 63 pt, & 64 q, & 65 u, & 66 u_p, & 67 v, & 64 68 w 65 69 66 USE control_parameters, &67 ONLY: bc_dirichlet_l, &68 bc_dirichlet_n, &69 bc_dirichlet_r, &70 bc_dirichlet_s, &71 bc_lr_cyc, &72 bc_ns_cyc, &73 humidity,&74 end_time,&75 message_string, &76 neutral, &70 USE control_parameters, & 71 ONLY: bc_dirichlet_l, & 72 bc_dirichlet_n, & 73 bc_dirichlet_r, & 74 bc_dirichlet_s, & 75 bc_lr_cyc, & 76 bc_ns_cyc, & 77 end_time, & 78 humidity, & 79 message_string, & 80 neutral, & 77 81 time_since_reference_point 78 82 79 USE indices, &80 ONLY: nx, &81 nxl, &82 nxlg, &83 nxr, &84 nxrg, &85 ny, &86 nyn, &87 nyng, &88 nys, &89 nysg, &90 nzb, &91 nzt, &83 USE indices, & 84 ONLY: nx, & 85 nxl, & 86 nxlg, & 87 nxr, & 88 nxrg, & 89 ny, & 90 nyn, & 91 nyng, & 92 nys, & 93 nysg, & 94 nzb, & 95 nzt, & 92 96 wall_flags_total_0 93 97 … … 95 99 96 100 #if defined( __parallel ) 97 USE pegrid, &98 ONLY: collective_wait, &99 comm2d, &100 ierr, &101 MPI_DOUBLE_PRECISION, &102 MPI_INTEGER, &103 MPI_MAX, &104 MPI_SUM, &101 USE pegrid, & 102 ONLY: collective_wait, & 103 comm2d, & 104 ierr, & 105 MPI_DOUBLE_PRECISION, & 106 MPI_INTEGER, & 107 MPI_MAX, & 108 MPI_SUM, & 105 109 myid 106 110 #else 107 USE pegrid, &111 USE pegrid, & 108 112 ONLY: myid 109 113 #endif 110 114 111 115 112 USE grid_variables, &113 ONLY: dx, &116 USE grid_variables, & 117 ONLY: dx, & 114 118 dy 115 119 116 USE pmc_interface, &120 USE pmc_interface, & 117 121 ONLY: nested_run 118 122 119 123 IMPLICIT NONE 120 124 121 125 INTEGER(iwp) :: internal_count = 0 !< counts calls to this module 122 126 … … 151 155 ! 152 156 !-- Public functions 153 PUBLIC &157 PUBLIC & 154 158 vdi_actions 155 159 … … 157 161 CONTAINS 158 162 159 !------------------------------------------------------------------------------ !163 !--------------------------------------------------------------------------------------------------! 160 164 ! Description: 161 165 ! ------------ 162 166 !> Call for all grid points 163 167 !> @todo Add proper description 164 !------------------------------------------------------------------------------ !168 !--------------------------------------------------------------------------------------------------! 165 169 SUBROUTINE vdi_actions( location ) 166 170 167 CHARACTER 171 CHARACTER(LEN=*), INTENT(IN) :: location !< call location string 168 172 169 173 … … 173 177 174 178 internal_count = internal_count + 1 175 179 176 180 CALL vdi_2_deltat_wave 177 181 … … 191 195 192 196 END SUBROUTINE vdi_actions 193 !------------------------------------------------------------------------------ !197 !--------------------------------------------------------------------------------------------------! 194 198 ! Description: 195 199 ! ------------ 196 !> At a control grid point in the interior of the model domain, 197 !> 2 * deltat waves are not to begenerated with increasing simulation time.198 !------------------------------------------------------------------------------ !200 !> At a control grid point in the interior of the model domain, 2 * delta t waves are not to be 201 !> generated with increasing simulation time. 202 !--------------------------------------------------------------------------------------------------! 199 203 SUBROUTINE vdi_2_deltat_wave 200 204 201 205 INTEGER(iwp) :: count_wave = 0 !< counts the number of consecutive waves 202 INTEGER(iwp) :: count_time = 0 !< counter, so that the waves follow each other without gaps 203 INTEGER(iwp) :: cgp_i = 0 !< x coordinate of the control grid point for testing 2deltat waves 204 INTEGER(iwp) :: cgp_j = 0 !< y coordinate of the control grid point for testing 2deltat waves 205 INTEGER(iwp) :: cgp_k = 0 !< z coordinate of the control grid point for testing 2deltat waves 206 207 INTEGER(iwp), DIMENSION(4) :: sig_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) of u in the last four time steps 206 INTEGER(iwp) :: count_time = 0 !< counter, so that the waves follow one another without gaps 207 INTEGER(iwp) :: cgp_i = 0 !< x coordinate of the control grid point for testing 2 delta t waves 208 INTEGER(iwp) :: cgp_j = 0 !< y coordinate of the control grid point for testing 2 delta t waves 209 INTEGER(iwp) :: cgp_k = 0 !< z coordinate of the control grid point for testing 2 delta t waves 210 211 INTEGER(iwp), DIMENSION(4) :: sig_arr = (/ 0, 0, 0, 0 /) !< indicates an increase(1) or a decrease (0) 212 !< of u in the last four time steps 208 213 209 214 REAL(wp) :: random !< random number … … 222 227 ! 223 228 !-- If there is topography in the entire grid column, a new x coordinate is chosen 224 IF ( cgp_k >= nzt -1 ) THEN229 IF ( cgp_k >= nzt -1 ) THEN 225 230 CALL RANDOM_NUMBER( random ) 226 231 cgp_i = nxl + FLOOR( ( nxr + 1 - nxl ) * random ) … … 230 235 ENDIF 231 236 232 CALL testing_2_deltat_wave( u_p(cgp_k,cgp_j,cgp_i), u(cgp_k,cgp_j,cgp_i), &237 CALL testing_2_deltat_wave( u_p(cgp_k,cgp_j,cgp_i), u(cgp_k,cgp_j,cgp_i), & 233 238 sig_arr, count_wave, count_time ) 234 239 … … 236 241 237 242 238 !------------------------------------------------------------------------------ !243 !--------------------------------------------------------------------------------------------------! 239 244 ! Description: 240 245 ! ------------ 241 !> In this subroutine a quantity quant is tested for 2 delta t waves. 242 !> For this, the size must have a wave-shaped course over 4*4 time steps 243 !> and the amplitude of the wave has to be greater than the change of quant with 244 !> increasing time. 245 !------------------------------------------------------------------------------! 246 SUBROUTINE testing_2_deltat_wave( quant_p_r, quant_r, sig_arr, count_wave, count_time ) 246 !> In this subroutine the quantity quant is tested for 2 delta t waves. For this, the size must have 247 !> a wave-shaped course over 4*4 time steps and the amplitude of the wave has to be greater than the 248 !> change of quant with increasing time. 249 !--------------------------------------------------------------------------------------------------! 250 SUBROUTINE testing_2_deltat_wave( quant_p_r, quant_r, sig_arr, count_wave, count_time ) 247 251 248 252 INTEGER(iwp), INTENT(INOUT) :: count_wave !< counts the number of consecutive waves 249 INTEGER(iwp), INTENT(INOUT) :: count_time !< counter, so that the waves follow eachother without gaps253 INTEGER(iwp), INTENT(INOUT) :: count_time !< counter, so that the waves follow one another without gaps 250 254 INTEGER(iwp), PARAMETER :: number_wave = 10 !< number of consecutive waves that are not allowed 251 255 252 REAL(wp), INTENT(IN) :: quant_p_r !< quantity from the previous time step as a real 253 REAL(wp), INTENT(IN) :: quant_r !< quantity as a real 254 REAL(wp) :: quant_rel = 0.0_wp !< rel. change of the quantity to the previous time step 255 256 INTEGER(iwp), DIMENSION(4), INTENT(INOUT) :: sig_arr !< indicates an increase(1) or a decrease (0) of 257 !> quantity quant in the last four time steps 256 INTEGER(iwp), DIMENSION(4), INTENT(INOUT) :: sig_arr !< indicates an increase (1) or a decrease (0) of 257 !> quantity quant in the last four time steps 258 259 REAL(wp), INTENT(IN) :: quant_p_r !< quantity from the previous time step as a real 260 REAL(wp), INTENT(IN) :: quant_r !< quantity as a real 261 REAL(wp) :: quant_rel = 0.0_wp !< rel. change of the quantity to the previous time step 262 263 258 264 259 265 … … 267 273 268 274 ! 269 !-- With this criterion 2 delta t waves are detected if the amplitude of 270 !-- the wave is greater than thechange of quant with increasing time275 !-- With this criterion 2 delta t waves are detected if the amplitude of the wave is greater than 276 !-- the change of quant with increasing time 271 277 IF ( ALL( sig_arr(1:4) == (/ 1, 0, 1, 0 /) ) .AND. quant_rel > 0.01 ) THEN 272 278 … … 297 303 298 304 299 !------------------------------------------------------------------------------ !305 !--------------------------------------------------------------------------------------------------! 300 306 ! Description: 301 307 ! ------------ 302 !> In this internal assessment the maxima of standarddifferences of the 303 !> meteorological variables, computed layer by layer will be checked. 304 !> The maxima should not to remain at the open edges of the model or 305 !> travel from there into the interior of the domain with increasing 306 !> simulation time. 308 !> In this internal assessment the maxima of standard differences of the meteorological variables, 309 !> computed layer by layer will be checked. The maxima should not remain at the open edges of the 310 !> model or travel from there into the interior of the domain with increasing simulation time. 307 311 !> @todo try to reduce repeating code. 308 !------------------------------------------------------------------------------! 309 SUBROUTINE vdi_standard_differences 310 311 INTEGER(iwp) :: position_u_deviation = 0 !< position of the maximum of the standard deviation of u 312 INTEGER(iwp) :: position_u_deviation_p = 0 !< position of the maximum of the standard deviation of u to the previous time step 313 INTEGER(iwp) :: position_u_deviation_pp = 0 !< position of the maximum of the standard deviation of u two time steps ago 314 INTEGER(iwp) :: position_v_deviation = 0 !< position of the maximum of the standard deviation of v 315 INTEGER(iwp) :: position_v_deviation_p = 0 !< position of the maximum of the standard deviation of v to the previous time step 316 INTEGER(iwp) :: position_v_deviation_pp = 0 !< position of the maximum of the standard deviation of v two time steps ago 317 INTEGER(iwp) :: position_w_deviation = 0 !< position of the maximum of the standard deviation of w 318 INTEGER(iwp) :: position_w_deviation_p = 0 !< position of the maximum of the standard deviation of w to the previous time step 319 INTEGER(iwp) :: position_w_deviation_pp = 0 !< position of the maximum of the standard deviation of w two time steps ago 320 INTEGER(iwp) :: position_pt_deviation = 0 !< position of the maximum of the standard deviation of pt 321 INTEGER(iwp) :: position_pt_deviation_p = 0 !< position of the maximum of the standard deviation of pt to the previous time step 322 INTEGER(iwp) :: position_pt_deviation_pp = 0 !< position of the maximum of the standard deviation of pt two time steps ago 323 INTEGER(iwp) :: position_q_deviation = 0 !< position of the maximum of the standard deviation of q 324 INTEGER(iwp) :: position_q_deviation_p = 0 !< position of the maximum of the standard deviation of q to the previous time step 325 INTEGER(iwp) :: position_q_deviation_pp = 0 !< position of the maximum of the standard deviation of q two time steps ago 326 327 REAL(wp), DIMENSION(nzb:nzt+1) :: u_deviation !< standard deviation of u depending on k 328 REAL(wp), DIMENSION(nzb:nzt+1) :: v_deviation !< standard deviation of v depending on k 329 REAL(wp), DIMENSION(nzb:nzt+1) :: w_deviation !< standard deviation of w depending on k 330 REAL(wp), DIMENSION(nzb:nzt+1) :: pt_deviation !< standard deviation of pt depending on k 331 REAL(wp), DIMENSION(nzb:nzt+1) :: q_deviation !< standard deviation of q depending on k 312 !--------------------------------------------------------------------------------------------------! 313 SUBROUTINE vdi_standard_differences 314 315 INTEGER(iwp) :: position_pt_deviation = 0 !< position of the maximum of the standard deviation of pt 316 INTEGER(iwp) :: position_pt_deviation_p = 0 !< position of the maximum of the standard deviation of pt 317 !< to the previous time step 318 INTEGER(iwp) :: position_pt_deviation_pp = 0 !< position of the maximum of the standard deviation of pt two time steps ago 319 INTEGER(iwp) :: position_q_deviation = 0 !< position of the maximum of the standard deviation of q 320 INTEGER(iwp) :: position_q_deviation_p = 0 !< position of the maximum of the standard deviation of q to 321 !< the previous time step 322 INTEGER(iwp) :: position_q_deviation_pp = 0 !< position of the maximum of the standard deviation of q two time steps ago 323 INTEGER(iwp) :: position_u_deviation = 0 !< position of the maximum of the standard deviation of u 324 INTEGER(iwp) :: position_u_deviation_p = 0 !< position of the maximum of the standard deviation of u to 325 !< the previous time step 326 INTEGER(iwp) :: position_u_deviation_pp = 0 !< position of the maximum of the standard deviation of u two time steps ago 327 INTEGER(iwp) :: position_v_deviation = 0 !< position of the maximum of the standard deviation of v 328 INTEGER(iwp) :: position_v_deviation_p = 0 !< position of the maximum of the standard deviation of v 329 !< to the previous time step 330 INTEGER(iwp) :: position_v_deviation_pp = 0 !< position of the maximum of the standard deviation of v two time steps ago 331 INTEGER(iwp) :: position_w_deviation = 0 !< position of the maximum of the standard deviation of w 332 INTEGER(iwp) :: position_w_deviation_p = 0 !< position of the maximum of the standard deviation of w 333 !< to the previous time step 334 INTEGER(iwp) :: position_w_deviation_pp = 0 !< position of the maximum of the standard deviation of w two time steps ago 335 336 REAL(wp), DIMENSION(nzb:nzt+1) :: pt_deviation !< standard deviation of pt depending on k 337 REAL(wp), DIMENSION(nzb:nzt+1) :: q_deviation !< standard deviation of q depending on k 338 REAL(wp), DIMENSION(nzb:nzt+1) :: u_deviation !< standard deviation of u depending on k 339 REAL(wp), DIMENSION(nzb:nzt+1) :: v_deviation !< standard deviation of v depending on k 340 REAL(wp), DIMENSION(nzb:nzt+1) :: w_deviation !< standard deviation of w depending on k 332 341 333 342 ! … … 337 346 ! 338 347 !-- Determination of the position of the maximum 339 position_u_deviation = MAXLOC( u_deviation, DIM =1 )348 position_u_deviation = MAXLOC( u_deviation, DIM = 1 ) 340 349 341 350 ! … … 354 363 ! 355 364 !-- Determination of the position of the maximum 356 position_v_deviation = MAXLOC( v_deviation, DIM =1 )365 position_v_deviation = MAXLOC( v_deviation, DIM = 1 ) 357 366 358 367 ! … … 371 380 ! 372 381 !-- Determination of the position of the maximum 373 position_w_deviation = MAXLOC( w_deviation, DIM =1 )382 position_w_deviation = MAXLOC( w_deviation, DIM = 1 ) 374 383 375 384 ! … … 389 398 ! 390 399 !-- Determination of the position of the maximum 391 position_pt_deviation = MAXLOC( pt_deviation, DIM =1 )400 position_pt_deviation = MAXLOC( pt_deviation, DIM = 1 ) 392 401 393 402 ! 394 403 !-- Check the position of the maximum of the standard deviation of pt 395 404 IF ( internal_count > 2 ) THEN 396 CALL check_position( position_pt_deviation, &397 position_pt_deviation_p, &405 CALL check_position( position_pt_deviation, & 406 position_pt_deviation_p, & 398 407 position_pt_deviation_pp ) 399 408 ENDIF … … 411 420 ! 412 421 !-- Determination of the position of the maximum 413 position_q_deviation = MAXLOC( q_deviation, DIM =1 )422 position_q_deviation = MAXLOC( q_deviation, DIM = 1 ) 414 423 415 424 ! 416 425 !-- Check the position of the maximum of the standard deviation of q 417 426 IF ( internal_count > 2 ) THEN 418 CALL check_position( position_q_deviation, &419 position_q_deviation_p, &427 CALL check_position( position_q_deviation, & 428 position_q_deviation_p, & 420 429 position_q_deviation_pp ) 421 430 ENDIF … … 426 435 ENDIF 427 436 428 END SUBROUTINE vdi_standard_differences429 430 431 !------------------------------------------------------------------------------ !437 END SUBROUTINE vdi_standard_differences 438 439 440 !--------------------------------------------------------------------------------------------------! 432 441 ! Description: 433 442 ! ------------ 434 443 !> Calculation of the standard deviation 435 !------------------------------------------------------------------------------ !436 SUBROUTINE calc_standard_deviation( quant, std_deviation, quant_type )444 !--------------------------------------------------------------------------------------------------! 445 SUBROUTINE calc_standard_deviation( quant, std_deviation, quant_type ) 437 446 438 447 INTEGER(iwp) :: i !< loop index … … 468 477 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), quant_type ) ) 469 478 quant_av_k_l(k) = quant_av_k_l(k) + quant(k,j,i) * flag 470 count_2d_l(k) = count_2d_l(k) + INT( flag, KIND =iwp )479 count_2d_l(k) = count_2d_l(k) + INT( flag, KIND = iwp ) 471 480 ENDDO 472 481 ENDDO … … 474 483 475 484 #if defined( __parallel ) 476 CALL MPI_ALLREDUCE( quant_av_k_l, quant_av_k, nzt+1-nzb+1, & 477 MPI_REAL, MPI_SUM, comm2d, ierr ) 478 479 CALL MPI_ALLREDUCE( count_2d_l, count_2d, nzt+1-nzb+1, & 480 MPI_INTEGER, MPI_SUM, comm2d, ierr ) 485 CALL MPI_ALLREDUCE( quant_av_k_l, quant_av_k, nzt+1 - nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr ) 486 487 CALL MPI_ALLREDUCE( count_2d_l, count_2d, nzt+1 - nzb+1, MPI_INTEGER, MPI_SUM, comm2d, ierr ) 481 488 #else 482 489 quant_av_k = quant_av_k_l … … 485 492 486 493 DO k = nzb+1, nzt+1 487 quant_av_k(k) = quant_av_k(k) / REAL( count_2d(k), KIND =wp )494 quant_av_k(k) = quant_av_k(k) / REAL( count_2d(k), KIND = wp ) 488 495 ENDDO 489 496 … … 491 498 DO j = nys, nyn 492 499 DO k = nzb+1, nzt+1 493 std_deviation_l(k) = std_deviation_l(k) &494 + ( quant(k,j,i) - quant_av_k(k) )**2 &495 * MERGE( 1.0_wp, 0.0_wp, &496 500 std_deviation_l(k) = std_deviation_l(k) & 501 + ( quant(k,j,i) - quant_av_k(k) )**2 & 502 * MERGE( 1.0_wp, 0.0_wp, & 503 BTEST( wall_flags_total_0(k,j,i), quant_type ) ) 497 504 ENDDO 498 505 ENDDO … … 501 508 502 509 #if defined( __parallel ) 503 CALL MPI_ALLREDUCE( std_deviation_l, std_deviation, nzt+1-nzb+1, & 504 MPI_REAL, MPI_SUM, comm2d, ierr ) 510 CALL MPI_ALLREDUCE( std_deviation_l, std_deviation, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr ) 505 511 #else 506 512 std_deviation = std_deviation_l … … 508 514 509 515 DO k = nzb+1, nzt+1 510 std_deviation(k) = SQRT( std_deviation(k) / REAL( count_2d(k), KIND =wp ) )516 std_deviation(k) = SQRT( std_deviation(k) / REAL( count_2d(k), KIND = wp ) ) 511 517 ENDDO 512 518 513 END SUBROUTINE calc_standard_deviation514 515 516 !------------------------------------------------------------------------------ !519 END SUBROUTINE calc_standard_deviation 520 521 522 !--------------------------------------------------------------------------------------------------! 517 523 ! Description: 518 524 ! ------------ 519 !> Tests for the position of the maxima of the standard deviation. 520 !> If the maxima remain at the open edges of the model or travel from 521 !> the open edges into the interior of the domain with increasing 525 !> Tests for the position of the maxima of the standard deviation. If the maxima remain at the open 526 !> edges of the model or travel from the open edges into the interior of the domain with increasing 522 527 !> simulation time, the simulation should be aborted. 523 !------------------------------------------------------------------------------ !528 !--------------------------------------------------------------------------------------------------! 524 529 SUBROUTINE check_position( position_std_deviation, position_std_deviation_p, & 525 530 position_std_deviation_pp ) … … 530 535 531 536 532 IF ( position_std_deviation == nzt .AND. &533 position_std_deviation_p == nzt .AND. &534 position_std_deviation_pp == nzt 535 message_string = 'The maxima of the standard deviation remain ' //&536 ' at the open edges of the model.'537 IF ( position_std_deviation == nzt .AND. & 538 position_std_deviation_p == nzt .AND. & 539 position_std_deviation_pp == nzt ) THEN 540 message_string = 'The maxima of the standard deviation' // & 541 'remain at the open edges of the model.' 537 542 CALL message( 'vdi_standard_differences', 'PA0663', 1, 2, 0, 6, 0 ) 538 543 ENDIF 539 544 540 IF ( position_std_deviation == nzt-2 .AND. &541 position_std_deviation_p == nzt-1 .AND. &545 IF ( position_std_deviation == nzt-2 .AND. & 546 position_std_deviation_p == nzt-1 .AND. & 542 547 position_std_deviation_pp == nzt ) THEN 543 message_string = 'The maxima of the standard deviation travel ' // &544 'from the open edges into the interior ' // &548 message_string = 'The maxima of the standard deviation travel ' // & 549 'from the open edges into the interior ' // & 545 550 'of the domain with increasing simulation time.' 546 551 CALL message( 'vdi_standard_differences', 'PA0664', 1, 2, 0, 6, 0 ) 547 552 ENDIF 548 553 549 END SUBROUTINE check_position550 551 552 !------------------------------------------------------------------------------ !554 END SUBROUTINE check_position 555 556 557 !--------------------------------------------------------------------------------------------------! 553 558 ! Description: 554 559 ! ------------ 555 !> In this control it will be checked, if the means of the meteorological 556 !> variables over the model grid are not to exhibit 2 deltat waves or 557 !> monotonic increase or decrease with increasing simulation time. 558 !------------------------------------------------------------------------------! 559 SUBROUTINE vdi_domain_averages 560 561 INTEGER(iwp) :: mono_count_u = 0 !< counter for monotonic decrease or increase of u 562 INTEGER(iwp) :: mono_count_v = 0 !< counter for monotonic decrease or increase of v 563 INTEGER(iwp) :: mono_count_w = 0 !< counter for monotonic decrease or increase of w 564 INTEGER(iwp) :: mono_count_q = 0 !< counter for monotonic decrease or increase of q 565 INTEGER(iwp) :: mono_count_pt = 0 !< counter for monotonic decrease or increase of pt 566 INTEGER(iwp) :: count_time_u = 0 !< counter, so that the waves of u follow each other without gaps 567 INTEGER(iwp) :: count_time_v = 0 !< counter, so that the waves of v follow each other without gaps 568 INTEGER(iwp) :: count_time_w = 0 !< counter, so that the waves of w follow each other without gaps 569 INTEGER(iwp) :: count_time_q = 0 !< counter, so that the waves of q follow each other without gaps 570 INTEGER(iwp) :: count_time_pt = 0 !< counter, so that the waves of pt follow each other without gaps 571 INTEGER(iwp) :: count_wave_u = 0 !< counts the number of consecutive waves of u 572 INTEGER(iwp) :: count_wave_v = 0 !< counts the number of consecutive waves of v 573 INTEGER(iwp) :: count_wave_w = 0 !< counts the number of consecutive waves of w 574 INTEGER(iwp) :: count_wave_q = 0 !< counts the number of consecutive waves of q 575 INTEGER(iwp) :: count_wave_pt = 0 !< counts the number of consecutive waves of pt 576 577 INTEGER(iwp), DIMENSION(4) :: sig_u_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) of u in the last four time steps 578 INTEGER(iwp), DIMENSION(4) :: sig_v_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) of v in the last four time steps 579 INTEGER(iwp), DIMENSION(4) :: sig_w_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) of w in the last four time steps 580 INTEGER(iwp), DIMENSION(4) :: sig_q_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) of q in the last four time steps 581 INTEGER(iwp), DIMENSION(4) :: sig_pt_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) of pt in the last four time steps 582 583 REAL(wp) :: u_av = 0.0_wp !< Mean of u 584 REAL(wp) :: u_av_p = 0.0_wp !< Mean of u at the previous time step 585 REAL(wp) :: v_av = 0.0_wp !< Mean of v 586 REAL(wp) :: v_av_p = 0.0_wp !< Mean of v at the previous time step 587 REAL(wp) :: w_av = 0.0_wp !< Mean of w 588 REAL(wp) :: w_av_p = 0.0_wp !< Mean of w at the previous time step 589 REAL(wp) :: q_av = 0.0_wp !< Mean of q 590 REAL(wp) :: q_av_p = 0.0_wp !< Mean of q at the previous time step 591 REAL(wp) :: pt_av = 0.0_wp !< Mean of pt 592 REAL(wp) :: pt_av_p = 0.0_wp !< Mean of pt at the previous time step 560 !> In this control it will be checked, if the means of the meteorological variables over the model 561 !> grid are not to exhibit 2 delta t waves or monotonic increase or decrease with increasing 562 !> simulation time. 563 !--------------------------------------------------------------------------------------------------! 564 SUBROUTINE vdi_domain_averages 565 566 INTEGER(iwp) :: count_time_u = 0 !< counter, so that the waves of u follow each other without gaps 567 INTEGER(iwp) :: count_time_v = 0 !< counter, so that the waves of v follow each other without gaps 568 INTEGER(iwp) :: count_time_w = 0 !< counter, so that the waves of w follow each other without gaps 569 INTEGER(iwp) :: count_time_q = 0 !< counter, so that the waves of q follow each other without gaps 570 INTEGER(iwp) :: count_time_pt = 0 !< counter, so that the waves of pt follow each other without gaps 571 INTEGER(iwp) :: count_wave_u = 0 !< counts the number of consecutive waves of u 572 INTEGER(iwp) :: count_wave_v = 0 !< counts the number of consecutive waves of v 573 INTEGER(iwp) :: count_wave_w = 0 !< counts the number of consecutive waves of w 574 INTEGER(iwp) :: count_wave_q = 0 !< counts the number of consecutive waves of q 575 INTEGER(iwp) :: count_wave_pt = 0 !< counts the number of consecutive waves of pt 576 INTEGER(iwp) :: mono_count_u = 0 !< counter for monotonic decrease or increase of u 577 INTEGER(iwp) :: mono_count_v = 0 !< counter for monotonic decrease or increase of v 578 INTEGER(iwp) :: mono_count_w = 0 !< counter for monotonic decrease or increase of w 579 INTEGER(iwp) :: mono_count_q = 0 !< counter for monotonic decrease or increase of q 580 INTEGER(iwp) :: mono_count_pt = 0 !< counter for monotonic decrease or increase of pt 581 582 INTEGER(iwp), DIMENSION(4) :: sig_u_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) 583 !< of u in the last four time steps 584 INTEGER(iwp), DIMENSION(4) :: sig_v_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) 585 !< of v in the last four time steps 586 INTEGER(iwp), DIMENSION(4) :: sig_w_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) 587 !< of w in the last four time steps 588 INTEGER(iwp), DIMENSION(4) :: sig_q_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) 589 !< of q in the last four time steps 590 INTEGER(iwp), DIMENSION(4) :: sig_pt_arr = (/ 0, 0, 0, 0/) !< indicates an increase(1) or a decrease (0) 591 !< of pt in the last four time steps 592 593 REAL(wp) :: pt_av = 0.0_wp !< Mean of pt 594 REAL(wp) :: pt_av_p = 0.0_wp !< Mean of pt at the previous time step 595 REAL(wp) :: q_av = 0.0_wp !< Mean of q 596 REAL(wp) :: q_av_p = 0.0_wp !< Mean of q at the previous time step 597 REAL(wp) :: u_av = 0.0_wp !< Mean of u 598 REAL(wp) :: u_av_p = 0.0_wp !< Mean of u at the previous time step 599 REAL(wp) :: v_av = 0.0_wp !< Mean of v 600 REAL(wp) :: v_av_p = 0.0_wp !< Mean of v at the previous time step 601 REAL(wp) :: w_av = 0.0_wp !< Mean of w 602 REAL(wp) :: w_av_p = 0.0_wp !< Mean of w at the previous time step 593 603 594 604 ! … … 626 636 ENDIF 627 637 628 IF ( time_since_reference_point >= end_time .AND. &638 IF ( time_since_reference_point >= end_time .AND. & 629 639 mono_count_u > 0.9_wp * internal_count ) THEN 630 640 631 message_string = 'Monotonic decrease or increase with ' // & 632 'increasing simulation time for u' 641 message_string = 'Monotonic decrease or increase with increasing simulation time for u' 633 642 CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 ) 634 643 ENDIF … … 640 649 ENDIF 641 650 642 IF ( time_since_reference_point >= end_time .AND. &651 IF ( time_since_reference_point >= end_time .AND. & 643 652 mono_count_v > 0.9_wp * internal_count ) THEN 644 message_string = 'Monotonic decrease or increase with ' // & 645 'increasing simulation time for v' 653 message_string = 'Monotonic decrease or increase with increasing simulation time for v' 646 654 CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 ) 647 655 ENDIF … … 653 661 ENDIF 654 662 655 IF ( time_since_reference_point >= end_time .AND. &663 IF ( time_since_reference_point >= end_time .AND. & 656 664 mono_count_w > 0.9_wp * internal_count ) THEN 657 message_string = 'Monotonic decrease or increase with ' // & 658 'increasing simulation time for w' 665 message_string = 'Monotonic decrease or increase with increasing simulation time for w' 659 666 CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 ) 660 667 ENDIF … … 667 674 ENDIF 668 675 669 IF ( time_since_reference_point >= end_time .AND. &676 IF ( time_since_reference_point >= end_time .AND. & 670 677 mono_count_pt > 0.9_wp * internal_count ) THEN 671 message_string = 'Monotonic decrease or increase with ' // & 672 'increasing simulation time for pt' 678 message_string = 'Monotonic decrease or increase with increasing simulation time for pt' 673 679 CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 ) 674 680 ENDIF … … 682 688 ENDIF 683 689 684 IF ( time_since_reference_point >= end_time .AND. &690 IF ( time_since_reference_point >= end_time .AND. & 685 691 mono_count_q > 0.9_wp * internal_count ) THEN 686 message_string = 'Monotonic decrease or increase with ' // & 687 'increasing simulation time for q' 692 message_string = 'Monotonic decrease or increase with increasing simulation time for q' 688 693 CALL message( 'vdi_domain_averages', 'PA0665', 0, 1, 0, 6, 0 ) 689 694 ENDIF … … 707 712 708 713 709 !------------------------------------------------------------------------------ !714 !--------------------------------------------------------------------------------------------------! 710 715 ! Description: 711 716 ! ------------ 712 717 !> Calculate the average of a quantity 'quant'. 713 !------------------------------------------------------------------------------ !718 !--------------------------------------------------------------------------------------------------! 714 719 SUBROUTINE calc_average( quant, quant_av, quant_type ) 715 720 716 INTEGER(iwp) :: average_count = 0!< counter for averaging721 INTEGER(iwp) :: average_count = 0 !< counter for averaging 717 722 INTEGER(iwp) :: average_count_l = 0 !< counter for averaging (local) 718 723 INTEGER :: i !< loop index … … 721 726 INTEGER(iwp) :: quant_type !< bit position (1 for u, 2 for v, 3 for w and 0 for scalar) 722 727 723 REAL(wp) :: flag 724 REAL(wp) :: quant_av 725 REAL(wp) :: quant_av_l = 0.0_wp 726 727 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: quant 728 REAL(wp) :: flag !< flag indicating atmosphere (1) or wall (0) grid point 729 REAL(wp) :: quant_av !< average of the quantity quant 730 REAL(wp) :: quant_av_l = 0.0_wp !< average of the quantity quant (local) 731 732 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: quant !< 728 733 729 734 ! … … 736 741 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), quant_type ) ) 737 742 quant_av_l = quant_av_l + quant(k,j,i) * flag 738 average_count_l = average_count_l + INT( flag, KIND =iwp )743 average_count_l = average_count_l + INT( flag, KIND = iwp ) 739 744 ENDDO 740 745 ENDDO … … 742 747 743 748 #if defined( __parallel ) 744 CALL MPI_ALLREDUCE( quant_av_l, quant_av, 1, & 745 MPI_REAL, MPI_SUM, comm2d, ierr ) 746 CALL MPI_ALLREDUCE( average_count_l, average_count, 1, & 747 MPI_INTEGER, MPI_SUM, comm2d, ierr ) 749 CALL MPI_ALLREDUCE( quant_av_l, quant_av, 1, MPI_REAL, MPI_SUM, comm2d, ierr ) 750 CALL MPI_ALLREDUCE( average_count_l, average_count, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr ) 748 751 #else 749 752 quant_av = quant_av_l … … 756 759 757 760 758 !------------------------------------------------------------------------------ !761 !--------------------------------------------------------------------------------------------------! 759 762 ! Description: 760 763 ! ------------ 761 764 !> Testing for conservation of mass. 762 !------------------------------------------------------------------------------ !765 !--------------------------------------------------------------------------------------------------! 763 766 SUBROUTINE vdi_conservation_of_mass 764 767 765 INTEGER(iwp) :: i 766 INTEGER(iwp) :: j 767 INTEGER(iwp) :: k 768 INTEGER(iwp) :: i !< loop index 769 INTEGER(iwp) :: j !< loop index 770 INTEGER(iwp) :: k !< loop index 768 771 769 772 REAL(wp) :: sum_mass_flux !< sum of the mass flow 770 773 774 REAL(wp), DIMENSION(1:3) :: volume_flow !< volume flow 771 775 REAL(wp), DIMENSION(1:3) :: volume_flow_l !< volume flow (local) 772 REAL(wp), DIMENSION(1:3) :: volume_flow !< volume flow773 776 774 777 … … 783 786 DO j = nys, nyn 784 787 DO k = nzb+1, nzt 785 volume_flow_l(1) = volume_flow_l(1) & 786 + u(k,j,i) * dzw(k) * dy & 787 * MERGE( 1.0_wp, 0.0_wp, & 788 BTEST( wall_flags_total_0(k,j,i), 1 ) & 789 ) 788 volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k) * dy & 789 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 790 790 ENDDO 791 791 ENDDO 792 792 ENDIF 793 ! 793 ! 794 794 !-- Sum up the volume flow through the right boundary 795 795 IF ( nxr == nx ) THEN … … 797 797 DO j = nys, nyn 798 798 DO k = nzb+1, nzt 799 volume_flow_l(1) = volume_flow_l(1) & 800 - u(k,j,i) * dzw(k) * dy & 801 * MERGE( 1.0_wp, 0.0_wp, & 802 BTEST( wall_flags_total_0(k,j,i), 1 ) & 803 ) 799 volume_flow_l(1) = volume_flow_l(1) - u(k,j,i) * dzw(k) * dy & 800 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 804 801 ENDDO 805 802 ENDDO … … 812 809 DO i = nxl, nxr 813 810 DO k = nzb+1, nzt 814 volume_flow_l(2) = volume_flow_l(2) & 815 + v(k,j,i) * dzw(k) * dx & 816 * MERGE( 1.0_wp, 0.0_wp, & 817 BTEST( wall_flags_total_0(k,j,i), 2 ) & 818 ) 811 volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k) * dx & 812 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 819 813 ENDDO 820 814 ENDDO … … 826 820 DO i = nxl, nxr 827 821 DO k = nzb+1, nzt 828 volume_flow_l(2) = volume_flow_l(2) & 829 - v(k,j,i) * dzw(k) * dx & 830 * MERGE( 1.0_wp, 0.0_wp, & 831 BTEST( wall_flags_total_0(k,j,i), 2 ) & 832 ) 822 volume_flow_l(2) = volume_flow_l(2) - v(k,j,i) * dzw(k) * dx & 823 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 833 824 ENDDO 834 825 ENDDO … … 857 848 ENDIF 858 849 859 END SUBROUTINE vdi_conservation_of_mass860 861 862 !------------------------------------------------------------------------------ !850 END SUBROUTINE vdi_conservation_of_mass 851 852 853 !--------------------------------------------------------------------------------------------------! 863 854 ! Description: 864 855 ! ------------ 865 !> The results will be checked for exceedance the specified limits. 866 !> The controls are performed at every time step and at every grid point. 867 !> No wind component is allowed to have a magnitude greater than ten times 868 !> the maximum wind velocity at the approach flow profile (Vdi 3783 part 9). 869 !> Note, that the supersaturation can not be higher than 10%. Therefore, no 870 !> test is required. 871 !------------------------------------------------------------------------------! 872 SUBROUTINE vdi_plausible_values 873 874 INTEGER(iwp) :: i !< loop index 875 INTEGER(iwp) :: j !< loop index 876 INTEGER(iwp) :: k !< loop index 877 856 !> The results will be checked for exceedance of the specified limits. The controls are performed at 857 !> every time step and at every grid point. No wind component is allowed to have a magnitude greater 858 !> than ten times the maximum wind velocity at the approach flow profile (Vdi 3783 part 9). 859 !> Note, that the supersaturation can not be higher than 10%. Therefore, no test is required. 860 !--------------------------------------------------------------------------------------------------! 861 SUBROUTINE vdi_plausible_values 862 863 INTEGER(iwp) :: i !< loop index 864 INTEGER(iwp) :: j !< loop index 865 INTEGER(iwp) :: k !< loop index 866 867 REAL(wp) :: max_uv !< maximum speed of all edges 878 868 REAL(wp) :: max_uv_l_l !< maximum speed at the left edge (local) 879 869 REAL(wp) :: max_uv_l !< maximum speed at the left edge 870 REAL(wp) :: max_uv_n_l !< maximum speed at the north edge (local) 871 REAL(wp) :: max_uv_n !< maximum speed at the north edge 880 872 REAL(wp) :: max_uv_r_l !< maximum speed at the right edge (local) 881 873 REAL(wp) :: max_uv_r !< maximum speed at the right edge 882 874 REAL(wp) :: max_uv_s_l !< maximum speed at the south edge (local) 883 875 REAL(wp) :: max_uv_s !< maximum speed at the south edge 884 REAL(wp) :: max_uv_n_l !< maximum speed at the north edge (local) 885 REAL(wp) :: max_uv_n !< maximum speed at the north edge 886 REAL(wp) :: max_uv !< maximum speed of all edges 887 888 REAL(wp), DIMENSION(4) :: max_arr !< 889 REAL(wp), DIMENSION(:), ALLOCATABLE :: uv !< wind velocity at the approach flow 890 REAL(wp), DIMENSION(:), ALLOCATABLE :: uv_l !< wind velocity at the approach flow (local) 876 877 REAL(wp), DIMENSION(4) :: max_arr !< 878 REAL(wp), DIMENSION(:), ALLOCATABLE :: uv !< wind velocity at the approach flow 879 REAL(wp), DIMENSION(:), ALLOCATABLE :: uv_l !< wind velocity at the approach flow (local) 891 880 892 881 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn) :: uv_l_nest !< wind profile at the left edge (nesting) … … 916 905 IF ( nxl == 0 ) THEN 917 906 i = nxl 918 DO j = nys, nyn919 DO k = nzb, nzt+1920 uv_l_nest(k,j) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 &921 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 907 DO j = nys, nyn 908 DO k = nzb, nzt+1 909 uv_l_nest(k,j) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 & 910 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 ) 922 911 ENDDO 923 912 ENDDO … … 926 915 ! 927 916 !-- Right boundary 928 IF ( nxr == nx ) THEN917 IF ( nxr == nx ) THEN 929 918 i = nxr 930 DO j = nys, nyn931 DO k = nzb, nzt+1932 uv_r_nest(k,j) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 &933 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 919 DO j = nys, nyn 920 DO k = nzb, nzt+1 921 uv_r_nest(k,j) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 & 922 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 ) 934 923 935 924 ENDDO … … 941 930 IF ( nys == 0 ) THEN 942 931 j = nys 943 DO i = nxl, nxr944 DO k = nzb, nzt+1945 uv_s_nest(k,i) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 &946 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 932 DO i = nxl, nxr 933 DO k = nzb, nzt+1 934 uv_s_nest(k,i) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 & 935 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 ) 947 936 ENDDO 948 937 ENDDO … … 953 942 IF ( nyn == ny ) THEN 954 943 j = nyn 955 DO i = nxl, nxr956 DO k = nzb, nzt+1957 uv_n_nest(k,i) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 &958 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 944 DO i = nxl, nxr 945 DO k = nzb, nzt+1 946 uv_n_nest(k,i) = SQRT( ( 0.5_wp * ( u(k,j,i-1) + u(k,j,i) ) )**2 & 947 + ( 0.5_wp * ( v(k,j-1,i) + v(k,j,i) ) )**2 ) 959 948 960 949 ENDDO … … 983 972 IF ( nxl == 0 .AND. nys == 0 ) THEN 984 973 DO k = nzb, nzt+1 985 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2 &986 + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 974 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2 & 975 + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 ) 987 976 ENDDO 988 977 ENDIF … … 993 982 IF ( nxl == 0 .AND. nys == 0 ) THEN 994 983 DO k = nzb, nzt+1 995 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2 &996 + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 984 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2 & 985 + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 ) 997 986 ENDDO 998 987 ENDIF … … 1001 990 IF ( nxr == nx .AND. nys == 0 ) THEN 1002 991 DO k = nzb, nzt+1 1003 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,nxr) + u(k,0,nxr+1) ) )**2 &1004 + ( 0.5_wp * ( v(k,-1,nxr) + v(k,0,nxr) ) )**2 992 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,nxr) + u(k,0,nxr+1) ) )**2 & 993 + ( 0.5_wp * ( v(k,-1,nxr) + v(k,0,nxr) ) )**2 ) 1005 994 ENDDO 1006 995 ENDIF … … 1010 999 IF ( nxl == 0 .AND. nyn == ny ) THEN 1011 1000 DO k = nzb, nzt+1 1012 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,nyn,-1) + u(k,nyn,0) ) )**2 &1001 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,nyn,-1) + u(k,nyn,0) ) )**2 & 1013 1002 + ( 0.5_wp * ( v(k,nyn+1,0) + v(k,nyn,0) ) )**2 ) 1014 1003 ENDDO … … 1018 1007 IF ( nxl == 0 .AND. nys == 0 ) THEN 1019 1008 DO k = nzb, nzt+1 1020 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2 &1021 + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 1009 uv_l(k) = SQRT( ( 0.5_wp * ( u(k,0,-1) + u(k,0,0) ) )**2 & 1010 + ( 0.5_wp * ( v(k,-1,0) + v(k,0,0) ) )**2 ) 1022 1011 ENDDO 1023 1012 ENDIF … … 1035 1024 1036 1025 ! 1037 !-- Test for exceedance the specified limits 1038 message_string = 'A wind component have a magnitude greater ' // & 1039 'than ten times the maximum wind velocity ' // & 1040 'at the approach flow profile.' 1026 !-- Test for exceedance of the specified limits 1027 message_string = 'A wind component have a magnitude greater than ten times the maximum' // & 1028 'wind velocity at the approach flow profile.' 1041 1029 1042 1030 IF ( MAXVAL( ABS( u ) ) > 10.0_wp * max_uv ) THEN … … 1055 1043 !-- Test if the potential temperature lies between 220 K and 330 K 1056 1044 IF ( MAXVAL( pt ) > 330.0_wp .OR. MAXVAL( pt ) < 220.0_wp ) THEN 1057 message_string = 'The potential temperature does not lie ' // & 1058 'between 220 K and 330 K.' 1045 message_string = 'The potential temperature does not lie between 220 K and 330 K.' 1059 1046 CALL message( 'vdi_plausible_values', 'PA0668', 2, 2, myid, 6, 0 ) 1060 1047 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
