Changeset 4591 for palm/trunk/SOURCE/sum_up_3d_data.f90
- Timestamp:
- Jul 6, 2020 3:56:08 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/sum_up_3d_data.f90
r4516 r4591 1 1 !> @file sum_up_3d_data.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 ! ----------------- -22 ! 23 ! 21 ! ----------------- 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! remove double index 28 ! 27 ! File re-formatted to follow the PALM coding standard 28 ! 29 ! 4516 2020-04-30 16:55:10Z suehring 30 ! Remove double index 31 ! 29 32 ! 4514 2020-04-30 16:29:59Z suehring 30 33 ! Enable output of qsurf and ssurf 31 ! 34 ! 32 35 ! 4442 2020-03-04 19:21:13Z suehring 33 ! Change order of dimension in surface array %frac to allow for better 34 ! vectorization. 35 ! 36 ! Change order of dimension in surface array %frac to allow for better vectorization. 37 ! 36 38 ! 4441 2020-03-04 19:20:35Z suehring 37 39 ! Move 2-m potential temperature output to diagnostic_output_quantities 38 ! 40 ! 39 41 ! 4182 2019-08-22 15:20:23Z scharf 40 42 ! Corrected "Former revisions" section 41 ! 43 ! 42 44 ! 4048 2019-06-21 21:00:21Z knoop 43 45 ! Moved tcm_3d_data_averaging to module_interface 44 ! 46 ! 45 47 ! 4039 2019-06-18 10:32:41Z suehring 46 48 ! Modularize diagnostic output 47 ! 49 ! 48 50 ! 3994 2019-05-22 18:08:09Z suehring 49 ! output of turbulence intensity added50 ! 51 ! Output of turbulence intensity added 52 ! 51 53 ! 3943 2019-05-02 09:50:41Z maronga 52 54 ! Added output of qsws_av for green roofs. 53 ! 55 ! 54 56 ! 3933 2019-04-25 12:33:20Z kanani 55 57 ! Formatting 56 ! 58 ! 57 59 ! 3773 2019-03-01 08:56:57Z maronga 58 60 ! Added output of theta_2m*_xy_av 59 ! 61 ! 60 62 ! 3761 2019-02-25 15:31:42Z raasch 61 63 ! unused variables removed 62 ! 64 ! 63 65 ! 3655 2019-01-07 16:51:22Z knoop 64 66 ! Implementation of the PALM module interface … … 70 72 ! Description: 71 73 ! ------------ 72 !> Sum-up the values of 3d-arrays. The real averaging is later done in routine 73 !> average_3d_data. 74 !------------------------------------------------------------------------------! 74 !> Sum-up the values of 3d-arrays. The real averaging is later done in routine average_3d_data. 75 !--------------------------------------------------------------------------------------------------! 75 76 SUBROUTINE sum_up_3d_data 76 77 78 USE arrays_3d, & 79 ONLY: dzw, d_exner, e, heatflux_output_conversion, p, & 80 pt, q, ql, ql_c, ql_v, s, u, v, vpt, w, & 77 78 79 USE arrays_3d, & 80 ONLY: dzw, & 81 d_exner, & 82 e, & 83 heatflux_output_conversion, & 84 p, & 85 pt, & 86 q, & 87 ql, & 88 ql_c, & 89 ql_v, & 90 s, & 91 u, & 92 v, & 93 vpt, & 94 w, & 81 95 waterflux_output_conversion 82 96 83 USE averaging, & 84 ONLY: e_av, ghf_av, lpt_av, lwp_av, ol_av, p_av, pc_av, pr_av, pt_av, & 85 q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsurf_av, qsws_av, & 86 qv_av, r_a_av, s_av, shf_av, ssurf_av, & 87 ssws_av, ts_av, tsurf_av, u_av, & 88 us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av 89 90 USE basic_constants_and_equations_mod, & 91 ONLY: c_p, lv_d_cp, l_v 92 93 USE bulk_cloud_model_mod, & 97 USE averaging, & 98 ONLY: e_av, & 99 ghf_av, & 100 lpt_av, & 101 lwp_av, & 102 ol_av, & 103 p_av, & 104 pc_av, & 105 pr_av, & 106 pt_av, & 107 q_av, & 108 ql_av, & 109 ql_c_av, & 110 ql_v_av, & 111 ql_vp_av, & 112 qsurf_av, & 113 qsws_av, & 114 qv_av, & 115 r_a_av, & 116 s_av, & 117 shf_av, & 118 ssurf_av, & 119 ssws_av, & 120 ts_av, & 121 tsurf_av, & 122 u_av, & 123 us_av, & 124 v_av, & 125 vpt_av, & 126 w_av, & 127 z0_av, & 128 z0h_av, & 129 z0q_av 130 131 USE basic_constants_and_equations_mod, & 132 ONLY: c_p, & 133 lv_d_cp, & 134 l_v 135 136 USE bulk_cloud_model_mod, & 94 137 ONLY: bulk_cloud_model 95 138 96 USE control_parameters, & 97 ONLY: average_count_3d, doav, doav_n, rho_surface, urban_surface, & 139 USE control_parameters, & 140 ONLY: average_count_3d, & 141 doav, & 142 doav_n, & 143 rho_surface, & 144 urban_surface, & 98 145 varnamelength 99 146 100 USE cpulog, & 101 ONLY: cpu_log, log_point 102 103 USE indices, & 104 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 147 USE cpulog, & 148 ONLY: cpu_log, & 149 log_point 150 151 USE indices, & 152 ONLY: nxl, & 153 nxlg, & 154 nxr, & 155 nxrg, & 156 nyn, & 157 nyng, & 158 nys, & 159 nysg, & 160 nzb, & 161 nzt, & 105 162 topo_top_ind 106 163 107 164 USE kinds 108 165 109 USE module_interface, &166 USE module_interface, & 110 167 ONLY: module_interface_3d_data_averaging 111 168 112 USE particle_attributes, & 113 ONLY: grid_particles, number_of_particles, particles, prt_count 114 115 USE surface_mod, & 116 ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, & 117 surf_def_h, surf_lsm_h, surf_usm_h 118 119 USE urban_surface_mod, & 169 USE particle_attributes, & 170 ONLY: grid_particles, & 171 number_of_particles, & 172 particles, & 173 prt_count 174 175 USE surface_mod, & 176 ONLY: ind_pav_green, & 177 ind_veg_wall, & 178 ind_wat_win, & 179 surf_def_h, & 180 surf_lsm_h, & 181 surf_usm_h 182 183 USE urban_surface_mod, & 120 184 ONLY: usm_3d_data_averaging 121 185 … … 123 187 IMPLICIT NONE 124 188 125 LOGICAL :: match_def !< flag indicating default-type surface 126 LOGICAL :: match_lsm !< flag indicating natural-type surface 127 LOGICAL :: match_usm !< flag indicating urban-type surface 128 189 CHARACTER(LEN=varnamelength) :: trimvar !< TRIM of output-variable string 190 129 191 INTEGER(iwp) :: i !< grid index x direction 130 192 INTEGER(iwp) :: ii !< running index … … 134 196 INTEGER(iwp) :: n !< running index over number of particles per grid box 135 197 136 REAL(wp) :: mean_r !< mean-particle radius witin grid box 137 REAL(wp) :: s_r2 !< mean-particle radius witin grid box to the power of two 138 REAL(wp) :: s_r3 !< mean-particle radius witin grid box to the power of three 139 140 CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string 198 LOGICAL :: match_def !< flag indicating default-type surface 199 LOGICAL :: match_lsm !< flag indicating natural-type surface 200 LOGICAL :: match_usm !< flag indicating urban-type surface 201 202 REAL(wp) :: mean_r !< mean-particle radius witin grid box 203 REAL(wp) :: s_r2 !< mean-particle radius witin grid box to the power of two 204 REAL(wp) :: s_r3 !< mean-particle radius witin grid box to the power of three 205 141 206 142 207 … … 144 209 145 210 ! 146 !-- Allocate and initialize the summation arrays if called for the very first 147 !-- time or the first time after average_3d_data has been called 148 !-- (some or all of the arrays may have been already allocated 211 !-- Allocate and initialize the summation arrays if called for the very first time or the first time 212 !-- after average_3d_data has been called (some or all of the arrays may have been already allocated 149 213 !-- in rrd_local) 150 214 IF ( average_count_3d == 0 ) THEN … … 286 350 ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) ) 287 351 ENDIF 288 ssws_av = 0.0_wp 352 ssws_av = 0.0_wp 289 353 290 354 CASE ( 't*' ) … … 376 440 DO j = nys, nyn 377 441 ! 378 !-- Check whether grid point is a natural- or urban-type 379 !-- surface. 380 match_lsm = surf_lsm_h%start_index(j,i) <= & 381 surf_lsm_h%end_index(j,i) 382 match_usm = surf_usm_h%start_index(j,i) <= & 383 surf_usm_h%end_index(j,i) 384 ! 385 !-- In order to avoid double-counting of surface properties, 386 !-- always assume that natural-type surfaces are below urban- 387 !-- type surfaces, e.g. in case of bridges. 388 !-- Further, take only the last suface element, i.e. the 389 !-- uppermost surface which would be visible from above 442 !-- Check whether grid point is a natural- or urban-type surface. 443 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 444 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 445 ! 446 !-- In order to avoid double-counting of surface properties, always assume that 447 !-- natural-type surfaces are below urban type surfaces, e.g. in case of bridges. 448 !-- Further, take only the last suface element, i.e. the uppermost surface which 449 !-- would be visible from above 390 450 IF ( match_lsm .AND. .NOT. match_usm ) THEN 391 451 m = surf_lsm_h%end_index(j,i) 392 ghf_av(j,i) = ghf_av(j,i) + & 393 surf_lsm_h%ghf(m) 394 ELSEIF ( match_usm ) THEN 395 m = surf_usm_h%end_index(j,i) 396 ghf_av(j,i) = ghf_av(j,i) + & 397 surf_usm_h%frac(m,ind_veg_wall) * & 398 surf_usm_h%wghf_eb(m) + & 399 surf_usm_h%frac(m,ind_pav_green) * & 400 surf_usm_h%wghf_eb_green(m) + & 401 surf_usm_h%frac(m,ind_wat_win) * & 402 surf_usm_h%wghf_eb_window(m) 452 ghf_av(j,i) = ghf_av(j,i) + surf_lsm_h%ghf(m) 453 ELSEIF ( match_usm ) THEN 454 m = surf_usm_h%end_index(j,i) 455 ghf_av(j,i) = ghf_av(j,i) + surf_usm_h%frac(m,ind_veg_wall) * & 456 surf_usm_h%wghf_eb(m) + & 457 surf_usm_h%frac(m,ind_pav_green) * & 458 surf_usm_h%wghf_eb_green(m) + & 459 surf_usm_h%frac(m,ind_wat_win) * & 460 surf_usm_h%wghf_eb_window(m) 403 461 ENDIF 404 462 ENDDO … … 432 490 DO i = nxlg, nxrg 433 491 DO j = nysg, nyng 434 lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) &435 * dzw(1:nzt+1) )* rho_surface492 lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * dzw(1:nzt+1) ) & 493 * rho_surface 436 494 ENDDO 437 495 ENDDO … … 442 500 DO i = nxl, nxr 443 501 DO j = nys, nyn 444 match_def = surf_def_h(0)%start_index(j,i) <= & 445 surf_def_h(0)%end_index(j,i) 446 match_lsm = surf_lsm_h%start_index(j,i) <= & 447 surf_lsm_h%end_index(j,i) 448 match_usm = surf_usm_h%start_index(j,i) <= & 449 surf_usm_h%end_index(j,i) 502 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 503 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 504 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 450 505 451 506 IF ( match_def ) THEN 452 507 m = surf_def_h(0)%end_index(j,i) 453 ol_av(j,i) = ol_av(j,i) + & 454 surf_def_h(0)%ol(m) 508 ol_av(j,i) = ol_av(j,i) + surf_def_h(0)%ol(m) 455 509 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 456 510 m = surf_lsm_h%end_index(j,i) 457 ol_av(j,i) = ol_av(j,i) + & 458 surf_lsm_h%ol(m) 459 ELSEIF ( match_usm ) THEN 460 m = surf_usm_h%end_index(j,i) 461 ol_av(j,i) = ol_av(j,i) + & 462 surf_usm_h%ol(m) 511 ol_av(j,i) = ol_av(j,i) + surf_lsm_h%ol(m) 512 ELSEIF ( match_usm ) THEN 513 m = surf_usm_h%end_index(j,i) 514 ol_av(j,i) = ol_av(j,i) + surf_usm_h%ol(m) 463 515 ENDIF 464 516 ENDDO … … 495 547 number_of_particles = prt_count(k,j,i) 496 548 IF ( number_of_particles <= 0 ) CYCLE 497 particles => & 498 grid_particles(k,j,i)%particles(1:number_of_particles) 549 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 499 550 s_r2 = 0.0_wp 500 551 s_r3 = 0.0_wp … … 502 553 DO n = 1, number_of_particles 503 554 IF ( particles(n)%particle_mask ) THEN 504 s_r2 = s_r2 + particles(n)%radius**2 * & 505 particles(n)%weight_factor 506 s_r3 = s_r3 + particles(n)%radius**3 * & 507 particles(n)%weight_factor 555 s_r2 = s_r2 + particles(n)%radius**2 * particles(n)%weight_factor 556 s_r3 = s_r3 + particles(n)%radius**3 * particles(n)%weight_factor 508 557 ENDIF 509 558 ENDDO … … 534 583 DO j = nysg, nyng 535 584 DO k = nzb, nzt+1 536 pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * &537 d_exner(k)* ql(k,j,i)585 pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * d_exner(k) & 586 * ql(k,j,i) 538 587 ENDDO 539 588 ENDDO … … 565 614 566 615 CASE ( 'ql_c' ) 567 IF ( ALLOCATED( ql_c_av ) ) THEN 616 IF ( ALLOCATED( ql_c_av ) ) THEN 568 617 DO i = nxlg, nxrg 569 618 DO j = nysg, nyng … … 576 625 577 626 CASE ( 'ql_v' ) 578 IF ( ALLOCATED( ql_v_av ) ) THEN 627 IF ( ALLOCATED( ql_v_av ) ) THEN 579 628 DO i = nxlg, nxrg 580 629 DO j = nysg, nyng … … 587 636 588 637 CASE ( 'ql_vp' ) 589 IF ( ALLOCATED( ql_vp_av ) ) THEN 638 IF ( ALLOCATED( ql_vp_av ) ) THEN 590 639 DO i = nxl, nxr 591 640 DO j = nys, nyn … … 593 642 number_of_particles = prt_count(k,j,i) 594 643 IF ( number_of_particles <= 0 ) CYCLE 595 particles => & 596 grid_particles(k,j,i)%particles(1:number_of_particles) 644 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 597 645 DO n = 1, number_of_particles 598 646 IF ( particles(n)%particle_mask ) THEN 599 ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + & 600 particles(n)%weight_factor / & 601 number_of_particles 647 ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + & 648 particles(n)%weight_factor / number_of_particles 602 649 ENDIF 603 650 ENDDO … … 611 658 DO i = nxl, nxr 612 659 DO j = nys, nyn 613 match_def = surf_def_h(0)%start_index(j,i) <= & 614 surf_def_h(0)%end_index(j,i) 615 match_lsm = surf_lsm_h%start_index(j,i) <= & 616 surf_lsm_h%end_index(j,i) 617 match_usm = surf_usm_h%start_index(j,i) <= & 618 surf_usm_h%end_index(j,i) 660 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 661 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 662 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 619 663 620 664 IF ( match_def ) THEN 621 665 m = surf_def_h(0)%end_index(j,i) 622 qsurf_av(j,i) = qsurf_av(j,i) + & 623 surf_def_h(0)%q_surface(m) 666 qsurf_av(j,i) = qsurf_av(j,i) + surf_def_h(0)%q_surface(m) 624 667 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 625 668 m = surf_lsm_h%end_index(j,i) 626 qsurf_av(j,i) = qsurf_av(j,i) + & 627 surf_lsm_h%q_surface(m) 628 ELSEIF ( match_usm ) THEN 629 m = surf_usm_h%end_index(j,i) 630 qsurf_av(j,i) = qsurf_av(j,i) + & 631 surf_usm_h%q_surface(m) 669 qsurf_av(j,i) = qsurf_av(j,i) + surf_lsm_h%q_surface(m) 670 ELSEIF ( match_usm ) THEN 671 m = surf_usm_h%end_index(j,i) 672 qsurf_av(j,i) = qsurf_av(j,i) + surf_usm_h%q_surface(m) 632 673 ENDIF 633 674 ENDDO … … 638 679 ! 639 680 !-- In case of default surfaces, clean-up flux by density. 640 !-- In case of land- and urban-surfaces, convert fluxes into 641 !-- dynamic units. 681 !-- In case of land- and urban-surfaces, convert fluxes into dynamic units. 642 682 !-- Question (maronga): are the .NOT. statements really required? 643 IF ( ALLOCATED( qsws_av ) ) THEN 644 DO i = nxl, nxr 645 DO j = nys, nyn 646 match_def = surf_def_h(0)%start_index(j,i) <= & 647 surf_def_h(0)%end_index(j,i) 648 match_lsm = surf_lsm_h%start_index(j,i) <= & 649 surf_lsm_h%end_index(j,i) 650 match_usm = surf_usm_h%start_index(j,i) <= & 651 surf_usm_h%end_index(j,i) 683 IF ( ALLOCATED( qsws_av ) ) THEN 684 DO i = nxl, nxr 685 DO j = nys, nyn 686 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 687 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 688 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 652 689 653 690 IF ( match_def ) THEN 654 691 m = surf_def_h(0)%end_index(j,i) 655 qsws_av(j,i) = qsws_av(j,i) + & 656 surf_def_h(0)%qsws(m) * & 657 waterflux_output_conversion(nzb) 692 qsws_av(j,i) = qsws_av(j,i) + surf_def_h(0)%qsws(m) * & 693 waterflux_output_conversion(nzb) 658 694 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 659 695 m = surf_lsm_h%end_index(j,i) 660 qsws_av(j,i) = qsws_av(j,i) + & 661 surf_lsm_h%qsws(m) * l_v 696 qsws_av(j,i) = qsws_av(j,i) + surf_lsm_h%qsws(m) * l_v 662 697 ELSEIF ( match_usm .AND. .NOT. match_lsm ) THEN 663 698 m = surf_usm_h%end_index(j,i) 664 qsws_av(j,i) = qsws_av(j,i) + & 665 surf_usm_h%qsws(m) * l_v 699 qsws_av(j,i) = qsws_av(j,i) + surf_usm_h%qsws(m) * l_v 666 700 ENDIF 667 701 ENDDO … … 670 704 671 705 CASE ( 'qv' ) 672 IF ( ALLOCATED( qv_av ) ) THEN 706 IF ( ALLOCATED( qv_av ) ) THEN 673 707 DO i = nxlg, nxrg 674 708 DO j = nysg, nyng … … 681 715 682 716 CASE ( 'r_a*' ) 683 IF ( ALLOCATED( r_a_av ) ) THEN 684 DO i = nxl, nxr 685 DO j = nys, nyn 686 match_lsm = surf_lsm_h%start_index(j,i) <= & 687 surf_lsm_h%end_index(j,i) 688 match_usm = surf_usm_h%start_index(j,i) <= & 689 surf_usm_h%end_index(j,i) 717 IF ( ALLOCATED( r_a_av ) ) THEN 718 DO i = nxl, nxr 719 DO j = nys, nyn 720 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 721 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 690 722 691 723 IF ( match_lsm .AND. .NOT. match_usm ) THEN 692 724 m = surf_lsm_h%end_index(j,i) 693 r_a_av(j,i) = r_a_av(j,i) + & 694 surf_lsm_h%r_a(m) 695 ELSEIF ( match_usm ) THEN 696 m = surf_usm_h%end_index(j,i) 697 r_a_av(j,i) = r_a_av(j,i) + & 698 surf_usm_h%frac(m,ind_veg_wall) * & 699 surf_usm_h%r_a(m) + & 700 surf_usm_h%frac(m,ind_pav_green) * & 701 surf_usm_h%r_a_green(m) + & 702 surf_usm_h%frac(m,ind_wat_win) * & 703 surf_usm_h%r_a_window(m) 725 r_a_av(j,i) = r_a_av(j,i) + surf_lsm_h%r_a(m) 726 ELSEIF ( match_usm ) THEN 727 m = surf_usm_h%end_index(j,i) 728 r_a_av(j,i) = r_a_av(j,i) + surf_usm_h%frac(m,ind_veg_wall) * & 729 surf_usm_h%r_a(m) + & 730 surf_usm_h%frac(m,ind_pav_green) * & 731 surf_usm_h%r_a_green(m) + & 732 surf_usm_h%frac(m,ind_wat_win) * & 733 surf_usm_h%r_a_window(m) 704 734 ENDIF 705 735 ENDDO … … 708 738 709 739 CASE ( 's' ) 710 IF ( ALLOCATED( s_av ) ) THEN 740 IF ( ALLOCATED( s_av ) ) THEN 711 741 DO i = nxlg, nxrg 712 742 DO j = nysg, nyng … … 721 751 ! 722 752 !-- In case of default surfaces, clean-up flux by density. 723 !-- In case of land- and urban-surfaces, convert fluxes into 724 !-- dynamic units. 725 IF ( ALLOCATED( shf_av ) ) THEN 726 DO i = nxl, nxr 727 DO j = nys, nyn 728 match_def = surf_def_h(0)%start_index(j,i) <= & 729 surf_def_h(0)%end_index(j,i) 730 match_lsm = surf_lsm_h%start_index(j,i) <= & 731 surf_lsm_h%end_index(j,i) 732 match_usm = surf_usm_h%start_index(j,i) <= & 733 surf_usm_h%end_index(j,i) 753 !-- In case of land- and urban-surfaces, convert fluxes into dynamic units. 754 IF ( ALLOCATED( shf_av ) ) THEN 755 DO i = nxl, nxr 756 DO j = nys, nyn 757 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 758 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 759 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 734 760 735 761 IF ( match_def ) THEN 736 762 m = surf_def_h(0)%end_index(j,i) 737 shf_av(j,i) = shf_av(j,i) + & 738 surf_def_h(0)%shf(m) * & 739 heatflux_output_conversion(nzb) 763 shf_av(j,i) = shf_av(j,i) + surf_def_h(0)%shf(m) * & 764 heatflux_output_conversion(nzb) 740 765 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 741 766 m = surf_lsm_h%end_index(j,i) 742 shf_av(j,i) = shf_av(j,i) + & 743 surf_lsm_h%shf(m) * c_p 744 ELSEIF ( match_usm ) THEN 745 m = surf_usm_h%end_index(j,i) 746 shf_av(j,i) = shf_av(j,i) + & 747 surf_usm_h%shf(m) * c_p 767 shf_av(j,i) = shf_av(j,i) + surf_lsm_h%shf(m) * c_p 768 ELSEIF ( match_usm ) THEN 769 m = surf_usm_h%end_index(j,i) 770 shf_av(j,i) = shf_av(j,i) + surf_usm_h%shf(m) * c_p 748 771 ENDIF 749 772 ENDDO … … 762 785 763 786 CASE ( 'ssws*' ) 764 IF ( ALLOCATED( ssws_av ) ) THEN 765 DO i = nxl, nxr 766 DO j = nys, nyn 767 match_def = surf_def_h(0)%start_index(j,i) <= & 768 surf_def_h(0)%end_index(j,i) 769 match_lsm = surf_lsm_h%start_index(j,i) <= & 770 surf_lsm_h%end_index(j,i) 771 match_usm = surf_usm_h%start_index(j,i) <= & 772 surf_usm_h%end_index(j,i) 787 IF ( ALLOCATED( ssws_av ) ) THEN 788 DO i = nxl, nxr 789 DO j = nys, nyn 790 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 791 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 792 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 773 793 774 794 IF ( match_def ) THEN 775 795 m = surf_def_h(0)%end_index(j,i) 776 ssws_av(j,i) = ssws_av(j,i) + & 777 surf_def_h(0)%ssws(m) 796 ssws_av(j,i) = ssws_av(j,i) + surf_def_h(0)%ssws(m) 778 797 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 779 798 m = surf_lsm_h%end_index(j,i) 780 ssws_av(j,i) = ssws_av(j,i) + & 781 surf_lsm_h%ssws(m) 782 ELSEIF ( match_usm ) THEN 783 m = surf_usm_h%end_index(j,i) 784 ssws_av(j,i) = ssws_av(j,i) + & 785 surf_usm_h%ssws(m) 799 ssws_av(j,i) = ssws_av(j,i) + surf_lsm_h%ssws(m) 800 ELSEIF ( match_usm ) THEN 801 m = surf_usm_h%end_index(j,i) 802 ssws_av(j,i) = ssws_av(j,i) + surf_usm_h%ssws(m) 786 803 ENDIF 787 804 ENDDO … … 790 807 791 808 CASE ( 't*' ) 792 IF ( ALLOCATED( ts_av ) ) THEN 793 DO i = nxl, nxr 794 DO j = nys, nyn 795 match_def = surf_def_h(0)%start_index(j,i) <= & 796 surf_def_h(0)%end_index(j,i) 797 match_lsm = surf_lsm_h%start_index(j,i) <= & 798 surf_lsm_h%end_index(j,i) 799 match_usm = surf_usm_h%start_index(j,i) <= & 800 surf_usm_h%end_index(j,i) 809 IF ( ALLOCATED( ts_av ) ) THEN 810 DO i = nxl, nxr 811 DO j = nys, nyn 812 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 813 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 814 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 801 815 802 816 IF ( match_def ) THEN 803 817 m = surf_def_h(0)%end_index(j,i) 804 ts_av(j,i) = ts_av(j,i) + & 805 surf_def_h(0)%ts(m) 818 ts_av(j,i) = ts_av(j,i) + surf_def_h(0)%ts(m) 806 819 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 807 820 m = surf_lsm_h%end_index(j,i) 808 ts_av(j,i) = ts_av(j,i) + & 809 surf_lsm_h%ts(m) 810 ELSEIF ( match_usm ) THEN 811 m = surf_usm_h%end_index(j,i) 812 ts_av(j,i) = ts_av(j,i) + & 813 surf_usm_h%ts(m) 821 ts_av(j,i) = ts_av(j,i) + surf_lsm_h%ts(m) 822 ELSEIF ( match_usm ) THEN 823 m = surf_usm_h%end_index(j,i) 824 ts_av(j,i) = ts_av(j,i) + surf_usm_h%ts(m) 814 825 ENDIF 815 826 ENDDO … … 818 829 819 830 CASE ( 'tsurf*' ) 820 IF ( ALLOCATED( tsurf_av ) ) THEN 821 DO i = nxl, nxr 822 DO j = nys, nyn 823 match_def = surf_def_h(0)%start_index(j,i) <= & 824 surf_def_h(0)%end_index(j,i) 825 match_lsm = surf_lsm_h%start_index(j,i) <= & 826 surf_lsm_h%end_index(j,i) 827 match_usm = surf_usm_h%start_index(j,i) <= & 828 surf_usm_h%end_index(j,i) 831 IF ( ALLOCATED( tsurf_av ) ) THEN 832 DO i = nxl, nxr 833 DO j = nys, nyn 834 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 835 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 836 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 829 837 830 838 IF ( match_def ) THEN 831 839 m = surf_def_h(0)%end_index(j,i) 832 tsurf_av(j,i) = tsurf_av(j,i) + & 833 surf_def_h(0)%pt_surface(m) 840 tsurf_av(j,i) = tsurf_av(j,i) + surf_def_h(0)%pt_surface(m) 834 841 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 835 842 m = surf_lsm_h%end_index(j,i) 836 tsurf_av(j,i) = tsurf_av(j,i) + & 837 surf_lsm_h%pt_surface(m) 838 ELSEIF ( match_usm ) THEN 839 m = surf_usm_h%end_index(j,i) 840 tsurf_av(j,i) = tsurf_av(j,i) + & 841 surf_usm_h%pt_surface(m) 843 tsurf_av(j,i) = tsurf_av(j,i) + surf_lsm_h%pt_surface(m) 844 ELSEIF ( match_usm ) THEN 845 m = surf_usm_h%end_index(j,i) 846 tsurf_av(j,i) = tsurf_av(j,i) + surf_usm_h%pt_surface(m) 842 847 ENDIF 843 848 ENDDO … … 857 862 858 863 CASE ( 'us*' ) 859 IF ( ALLOCATED( us_av ) ) THEN 860 DO i = nxl, nxr 861 DO j = nys, nyn 862 match_def = surf_def_h(0)%start_index(j,i) <= & 863 surf_def_h(0)%end_index(j,i) 864 match_lsm = surf_lsm_h%start_index(j,i) <= & 865 surf_lsm_h%end_index(j,i) 866 match_usm = surf_usm_h%start_index(j,i) <= & 867 surf_usm_h%end_index(j,i) 864 IF ( ALLOCATED( us_av ) ) THEN 865 DO i = nxl, nxr 866 DO j = nys, nyn 867 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 868 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 869 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 868 870 869 871 IF ( match_def ) THEN 870 872 m = surf_def_h(0)%end_index(j,i) 871 us_av(j,i) = us_av(j,i) + & 872 surf_def_h(0)%us(m) 873 us_av(j,i) = us_av(j,i) + surf_def_h(0)%us(m) 873 874 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 874 875 m = surf_lsm_h%end_index(j,i) 875 us_av(j,i) = us_av(j,i) + & 876 surf_lsm_h%us(m) 877 ELSEIF ( match_usm ) THEN 878 m = surf_usm_h%end_index(j,i) 879 us_av(j,i) = us_av(j,i) + & 880 surf_usm_h%us(m) 876 us_av(j,i) = us_av(j,i) + surf_lsm_h%us(m) 877 ELSEIF ( match_usm ) THEN 878 m = surf_usm_h%end_index(j,i) 879 us_av(j,i) = us_av(j,i) + surf_usm_h%us(m) 881 880 ENDIF 882 881 ENDDO … … 885 884 886 885 CASE ( 'v' ) 887 IF ( ALLOCATED( v_av ) ) THEN 886 IF ( ALLOCATED( v_av ) ) THEN 888 887 DO i = nxlg, nxrg 889 888 DO j = nysg, nyng … … 896 895 897 896 CASE ( 'thetav' ) 898 IF ( ALLOCATED( vpt_av ) ) THEN 897 IF ( ALLOCATED( vpt_av ) ) THEN 899 898 DO i = nxlg, nxrg 900 899 DO j = nysg, nyng … … 907 906 908 907 CASE ( 'w' ) 909 IF ( ALLOCATED( w_av ) ) THEN 908 IF ( ALLOCATED( w_av ) ) THEN 910 909 DO i = nxlg, nxrg 911 910 DO j = nysg, nyng … … 918 917 919 918 CASE ( 'z0*' ) 920 IF ( ALLOCATED( z0_av ) ) THEN 921 DO i = nxl, nxr 922 DO j = nys, nyn 923 match_def = surf_def_h(0)%start_index(j,i) <= & 924 surf_def_h(0)%end_index(j,i) 925 match_lsm = surf_lsm_h%start_index(j,i) <= & 926 surf_lsm_h%end_index(j,i) 927 match_usm = surf_usm_h%start_index(j,i) <= & 928 surf_usm_h%end_index(j,i) 919 IF ( ALLOCATED( z0_av ) ) THEN 920 DO i = nxl, nxr 921 DO j = nys, nyn 922 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 923 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 924 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 929 925 930 926 IF ( match_def ) THEN 931 927 m = surf_def_h(0)%end_index(j,i) 932 z0_av(j,i) = z0_av(j,i) + & 933 surf_def_h(0)%z0(m) 928 z0_av(j,i) = z0_av(j,i) + surf_def_h(0)%z0(m) 934 929 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 935 930 m = surf_lsm_h%end_index(j,i) 936 z0_av(j,i) = z0_av(j,i) + & 937 surf_lsm_h%z0(m) 938 ELSEIF ( match_usm ) THEN 939 m = surf_usm_h%end_index(j,i) 940 z0_av(j,i) = z0_av(j,i) + & 941 surf_usm_h%z0(m) 942 ENDIF 943 ENDDO 944 ENDDO 931 z0_av(j,i) = z0_av(j,i) + surf_lsm_h%z0(m) 932 ELSEIF ( match_usm ) THEN 933 m = surf_usm_h%end_index(j,i) 934 z0_av(j,i) = z0_av(j,i) + surf_usm_h%z0(m) 935 ENDIF 936 ENDDO 937 ENDDO 945 938 ENDIF 946 939 947 940 CASE ( 'z0h*' ) 948 IF ( ALLOCATED( z0h_av ) ) THEN 949 DO i = nxl, nxr 950 DO j = nys, nyn 951 match_def = surf_def_h(0)%start_index(j,i) <= & 952 surf_def_h(0)%end_index(j,i) 953 match_lsm = surf_lsm_h%start_index(j,i) <= & 954 surf_lsm_h%end_index(j,i) 955 match_usm = surf_usm_h%start_index(j,i) <= & 956 surf_usm_h%end_index(j,i) 941 IF ( ALLOCATED( z0h_av ) ) THEN 942 DO i = nxl, nxr 943 DO j = nys, nyn 944 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 945 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 946 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 957 947 958 948 IF ( match_def ) THEN 959 949 m = surf_def_h(0)%end_index(j,i) 960 z0h_av(j,i) = z0h_av(j,i) + & 961 surf_def_h(0)%z0h(m) 950 z0h_av(j,i) = z0h_av(j,i) + surf_def_h(0)%z0h(m) 962 951 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 963 952 m = surf_lsm_h%end_index(j,i) 964 z0h_av(j,i) = z0h_av(j,i) + & 965 surf_lsm_h%z0h(m) 966 ELSEIF ( match_usm ) THEN 967 m = surf_usm_h%end_index(j,i) 968 z0h_av(j,i) = z0h_av(j,i) + & 969 surf_usm_h%z0h(m) 970 ENDIF 971 ENDDO 972 ENDDO 973 ENDIF 974 953 z0h_av(j,i) = z0h_av(j,i) + surf_lsm_h%z0h(m) 954 ELSEIF ( match_usm ) THEN 955 m = surf_usm_h%end_index(j,i) 956 z0h_av(j,i) = z0h_av(j,i) + surf_usm_h%z0h(m) 957 ENDIF 958 ENDDO 959 ENDDO 960 ENDIF 961 975 962 CASE ( 'z0q*' ) 976 IF ( ALLOCATED( z0q_av ) ) THEN 977 DO i = nxl, nxr 978 DO j = nys, nyn 979 match_def = surf_def_h(0)%start_index(j,i) <= & 980 surf_def_h(0)%end_index(j,i) 981 match_lsm = surf_lsm_h%start_index(j,i) <= & 982 surf_lsm_h%end_index(j,i) 983 match_usm = surf_usm_h%start_index(j,i) <= & 984 surf_usm_h%end_index(j,i) 963 IF ( ALLOCATED( z0q_av ) ) THEN 964 DO i = nxl, nxr 965 DO j = nys, nyn 966 match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i) 967 match_lsm = surf_lsm_h%start_index(j,i) <= surf_lsm_h%end_index(j,i) 968 match_usm = surf_usm_h%start_index(j,i) <= surf_usm_h%end_index(j,i) 985 969 986 970 IF ( match_def ) THEN 987 971 m = surf_def_h(0)%end_index(j,i) 988 z0q_av(j,i) = z0q_av(j,i) + & 989 surf_def_h(0)%z0q(m) 972 z0q_av(j,i) = z0q_av(j,i) + surf_def_h(0)%z0q(m) 990 973 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 991 974 m = surf_lsm_h%end_index(j,i) 992 z0q_av(j,i) = z0q_av(j,i) + & 993 surf_lsm_h%z0q(m) 994 ELSEIF ( match_usm ) THEN 995 m = surf_usm_h%end_index(j,i) 996 z0q_av(j,i) = z0q_av(j,i) + & 997 surf_usm_h%z0q(m) 975 z0q_av(j,i) = z0q_av(j,i) + surf_lsm_h%z0q(m) 976 ELSEIF ( match_usm ) THEN 977 m = surf_usm_h%end_index(j,i) 978 z0q_av(j,i) = z0q_av(j,i) + surf_usm_h%z0q(m) 998 979 ENDIF 999 980 ENDDO … … 1003 984 CASE DEFAULT 1004 985 1005 !-- In case of urban surface variables it should be always checked 1006 !-- if respective arrays are allocated, at least in case of a restart1007 !-- run, as averaged usm arrays are not read fromfile at the moment.986 !-- In case of urban surface variables it should be always checked if respective arrays are 987 !-- allocated, at least in case of a restart run, as averaged usm arrays are not read from 988 !-- file at the moment. 1008 989 IF ( urban_surface ) THEN 1009 990 CALL usm_3d_data_averaging( 'allocate', trimvar )
Note: See TracChangeset
for help on using the changeset viewer.